| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933 |
- IMPLEMENTATION MODULE NumInput;
- (*
- * REPERTOIRE
- * Release 1.6
- * By Charles Bradford and Cole Brecheen
- * (c) Copyright 1985-1992 PMI
- * Green Bay, Wisconsin
- * All rights reserved
- * (414) 468-6040
- *
- * $Header: D:/logfiles/mods/numinput.mov 1.4 10 Mar 1991 15:35:32 coleb $
- *
- *)
- (*
- Author: Mike Carter
- Description:
- Enter or edit a numeric field.
- Replacement for PMI StrInput.ReadNumeric. Note that parameters
- are slightly different:
- 1. PMI FloatingPoint and InDecimals parameters have been
- removed. They simply have no meaning the way real number
- input is now handled.
- 2. minusOK has been added - see below.
- 3. The meaning of DecimalPlaces has been changed - see
- below.
- Some of the features of this version:
- * General editing functions are very close to PMI string
- input. (Keys like Ins, Del, Home, End, PgUp, PgDn, Left and
- Right Arrows, Up and Down Arrows, Backspace, Tab, Shift
- Tab, etc. work almost the same way as they do in string
- fields).
- * Numbers are entered from left to right, then right-
- justified on field exit.
- * Both insert and overstrike modes are supported.
- * The number of digits after the decimal place is strictly
- enforced. The user is beeped if too many are entered; if
- two few are entered, zeroes are appended. If there is not
- enough room in the field, the rightmost character is thrown
- out, the decimal point repositioned, and the user beeped.
- Notes on parameters:
- * A new field was added in ScrnTypes.InputFieldRecord called
- "decimalPlace", with corresponding type DecimalPlaceType.
- This was designed to be passed to this routine: a -1 value
- indicates user-specified decimal points (or none); a 0
- means no digits after the decimal point, a 1 one digit,
- etc.
- * The value of minusOK determines whether negative numbers
- are allowed; this can be set from rMin, iMin within
- UserOps. Must be FALSE for strings that are later to be
- interpreted as CARDINAL.
- Notes on Methodology:
- NumInput combines state transition tables with a series of
- rules. The three state tables reflect the current input mode
- and the character that the cursor is under; they generate
- actions to be taken based on each key that may be hit as well
- as the next state. The tables are:
- InputTable = entry on top of blanks.
- EditOverTable = overstrike mode.
- EditInsertTable = insert mode.
- The entries in the state tables are formed by three-character
- sequences. (See the initialization code at the end of this
- module).
- (1) The first character is a non-mnemonic that stands for a
- sequence of actions to be taken if a key in that keyclass
- is hit. See the KeyAction procedure guts to see which
- procedures are executed for which letters. Generally,
- these procedures are qualifying procedures that determine
- whether or not a keystroke is legal from a given state.
- (2) The next character specifies the action to take if the
- qualifications are met. "I" stands for insert; "E"
- stands for error.
- (3) The last character in the state table triplet is the next
- state. You'll notice that this is missing in many cases -
- that is because of the fact that during editing, the next
- state must be dynamically re-computed from the numeric
- string AFTER the change has been made.
- The state tables are difficult to understand without
- diagrams, from which they were created (state transition
- diagrams).
- The rules referred to above are generally conditions that
- would have caused the state tables to grow exponentially had
- they been included. InsertCharacter contains a number of
- these rules, such as what to do when you are on the last
- character in the field under a number of circumstances.
- *)
- IMPORT BigSets;
- IMPORT ErrorManager;
- IMPORT KbdInput;
- IMPORT Key;
- IMPORT LowLevel;
- IMPORT M2Strings;
- IMPORT Numbers;
- IMPORT PosUtils;
- IMPORT ScrnTypes;
- IMPORT Spkr;
- IMPORT StrConv;
- IMPORT StrEdit;
- IMPORT UserOps;
- IMPORT SYSTEM;
- IMPORT VWindows;
- VAR
- Initialized : BOOLEAN;
- TYPE
- TableIndexType = (InputTable, EditOverTable, EditInsertTable);
- (* InputTable = entry on top of blanks *)
- (* EditOverTable = overstrike mode *)
- (* EditInsertTable = insert mode *)
- KeyClassType = (DigitsClass, MinusClass, DecimalPointClass, DollarClass);
- CONST
- ActionLetters = 2; (* state table action letters + next state - 1 *)
- MaxStates = 6; (* max number of states in table *)
- VAR
- stateTable : ARRAY [InputTable..EditInsertTable],
- [DigitsClass..DollarClass],
- [0..MaxStates * (ActionLetters+1)] OF CHAR;
- (* actions and next states *)
- PROCEDURE ReadNumericField
- ( WindowHandle : VWindows.AWindowHandle; (* in *)
- VAR TheStr : ARRAY OF CHAR; (* in/out - field contents *)
- col1 : CARDINAL; (* in - field loc *)
- row1 : CARDINAL; (* in - field loc *)
- FieldWidth : CARDINAL; (* in - # chars. in field *)
- DecimalPlaces: ScrnTypes.DecimalPlaceType;
- (* in - # digits after . *)
- minusOK : BOOLEAN; (* in - "-" permitted *)
- VAR LastKey : CARDINAL; (* in/out - last key hit *)
- VAR ExitKeys : KbdInput.KeyNumSet (* in - keys to exit on *)
- );
- (*
- This is a general-purpose numeric input routine that replaces the PMI
- StrInput.ReadNumeric procedure. The parameters are slightly different.
- *)
- CONST
- Minus = ORD('-'); (* numerics required due to LastKey *)
- DecimalKey = ORD('.');
- DollarSignKey = ORD('$');
- ZeroKey = ORD('0');
- NineKey = ORD('9');
- CurrencySymbol = '$';
- blank = ' ';
- periodChar = '.';
- minusChar = '-';
- zeroChar = '0';
- MaxFieldSize = 255;
- ErrorState = 9999; (* arbitrary error state *)
- LeaveLast = TRUE; (* last character in field can't be overstruck *)
- VAR
- (* old PMI variables still used *)
- SavedHeight : CARDINAL;
- curPos : CARDINAL; (* index to TheStr *)
- curTable : TableIndexType; (* current state table *)
- editInProgress : BOOLEAN; (* TRUE if editing started *)
- escapeHit : BOOLEAN; (* ESC restores string *)
- fieldEnd : CARDINAL; (* FieldWidth - 1 *)
- originalStr : ARRAY [0..MaxFieldSize] OF CHAR;
- (* copy to restore by ESC *)
- periodOK : BOOLEAN; (* FALSE for INT and CARD *)
- states : ARRAY [InputTable..EditInsertTable] OF CARDINAL;
- (* state for each table *)
- (*
- The following group of procedures supports editing functions and are
- NOT involved with the state tables.
- *)
- PROCEDURE DeleteCharacter;
- (* Delete the character at the current cursor position *)
- (* Any characters to the right of curPos move left *)
- (* Implements part of DEL key. Doesn't move cursor position. *)
- VAR
- shiftIndex : CARDINAL;
- BEGIN (* procedure DeleteCharacter *)
- IF curPos < fieldEnd THEN
- FOR shiftIndex := curPos TO fieldEnd DO
- TheStr[ shiftIndex ] := TheStr[ shiftIndex + 1 ];
- END; (* for shiftIndex *)
- END; (* if curPos *)
- TheStr[ fieldEnd ] := blank;
- escapeHit := FALSE;
- END DeleteCharacter; (* procedure *)
- PROCEDURE PreviousContents;
- (* replace current contents of field with original contents *)
- (* Be sure to recompute table state afterwards *)
- (* Implements ESC key in part. *)
- BEGIN (* procedure PreviousContents *)
- StrEdit.AssignStr( originalStr, TheStr );
- curPos := 0;
- END PreviousContents; (* procedure *)
- PROCEDURE BlankOutField( startPos : CARDINAL );
- (* Replace the designated portion of the field with blanks. *)
- VAR
- strIndex : CARDINAL;
- BEGIN (* procedure BlankOutField *)
- FOR strIndex := startPos TO fieldEnd DO
- TheStr[ strIndex ] := blank;
- END; (* for strIndex *)
- END BlankOutField; (* procedure *)
- PROCEDURE CleanUpTheStr(): BOOLEAN;
- (* "Cleans up" the string in the field that the user wants to leave *)
- (* This procedure is meant to be executed whenever field movement keys *)
- (* have been hit. E.g. TAB, PgUp, PgDn, Shift TAB, etc. *)
- (* Actions performed: *)
- (* Leading Zeroes stripped. *)
- (* Decimal point forced in if not there. *)
- (* Trailing Zeroes added after decimal point without enough *)
- (* digits after it. *)
- (* Decimal point with too many digits after it causes truncation *)
- (* of extra digits, beep, and cursor left in field. *)
- (* Fields with no numeric digits are blanked out. *)
- (* Be sure to recompute table state afterwards *)
- VAR
- strIndex, decSpot, decDigits : CARDINAL;
- anyNumerics : BOOLEAN; (* TRUE if field contains any digits *)
- PROCEDURE StopFieldExit;
- (* An adjustment to the field has been made that requires user's *)
- (* attention - prevent exit from the field (aborting key action). *)
- BEGIN (* procedure StopFieldExit *)
- (* Don't allow the field to be exited - set up as just entered *)
- StrEdit.LeftJustify( TheStr, FieldWidth );
- LastKey := 0;
- curPos := 0;
- (* And try to wake up the user that this has happened! *)
- Spkr.Noise( Spkr.Beep, Spkr.High, Spkr.Medium );
- END StopFieldExit; (* procedure *)
- PROCEDURE NoDecimalPoint;
- (* Process a string that has no decimal point. For Reals only. *)
- PROCEDURE InsertLeftJustified
- ( insChar : CHAR; (* character to insert *)
- pos : CARDINAL (* position in TheStr *)
- );
- (* puts insChar into TheStr at location pos; rightmost char gone *)
- VAR
- strIndex : CARDINAL;
- BEGIN (* procedure InsertLeftJustified *)
- (* move what's there over; forget the leftmost character *)
- IF fieldEnd > 0 THEN
- FOR strIndex := fieldEnd-1 TO pos BY -1 DO
- TheStr[ strIndex+1 ] := TheStr[ strIndex ];
- END; (* for strIndex *)
- TheStr[ pos ] := insChar;
- END; (* if fieldEnd *)
- END InsertLeftJustified; (* procedure *)
- VAR
- decPointPos : CARDINAL; (* where the decimal point goes *)
- rightSubStr : ARRAY [0..80] OF CHAR; (* str in front of dec pt. *)
- trailingDig : BOOLEAN; (* true if digits after dec. point *)
- BEGIN (* procedure NoDecimalPoint *)
- (* note that TheStr does not necessarily have length = FieldWidth! *)
- StrEdit.LeftJustify( TheStr, FieldWidth );
- (* if necessary, sacrifice the last digit to make room for '.' *)
- decPointPos := FieldWidth-VAL(CARDINAL,DecimalPlaces)-1;
- InsertLeftJustified( periodChar, decPointPos );
- (* right justify with period as a boundary *)
- IF decPointPos > 0 THEN
- M2Strings.Copy( TheStr, 0, decPointPos, rightSubStr );
- StrEdit.RightJustify( rightSubStr, decPointPos );
- StrEdit.OverWrite( rightSubStr, TheStr, 0 ); (* put back in, shifted *)
- END; (* if decPointPos *)
- (* Fill in any gaps with zeroes. *)
- trailingDig := FALSE;
- FOR strIndex := decPointPos+1 TO fieldEnd DO
- IF TheStr[ strIndex ] = blank THEN
- TheStr[ strIndex ] := zeroChar;
- ELSE
- trailingDig := TRUE;
- END; (* if TheStr *)
- END; (* for strIndex *)
- (* Alert the user only if dec. point was added in middle of digits *)
- IF trailingDig THEN
- StopFieldExit;
- END; (* if trailingDig *)
- END NoDecimalPoint; (* procedure *)
- BEGIN (* procedure CleanUpTheStr *)
- (* Blank fields ignored *)
- IF PosUtils.IsBlank( TheStr ) THEN
- RETURN( TRUE );
- END; (* if PosUtils.IsBlank *)
- (* Another check - if there were no numeric digits, blank out. *)
- anyNumerics := FALSE;
- FOR strIndex := 0 TO fieldEnd DO
- anyNumerics := anyNumerics OR
- PosUtils.IsNumericChar( TheStr[ strIndex ] )
- END; (* for strIndex *)
- IF NOT anyNumerics THEN
- BlankOutField( 0 );
- RETURN( TRUE ); (* not much point in doing anything else *)
- END; (* if NOT *)
- (* First, out with the leading zeroes. Leave last one. *)
- (* Note also removes zeroes for -00.33 or $00.33 *)
- strIndex := 0;
- LOOP
- IF TheStr[ strIndex ] = zeroChar THEN
- TheStr[ strIndex ] := blank;
- END; (* if TheStr *)
- IF (strIndex = fieldEnd) OR (TheStr[strIndex] = periodChar) OR
- ((TheStr[strIndex] # zeroChar) AND (* stop on non-zero digit *)
- PosUtils.IsNumericChar( TheStr[strIndex] ))
- THEN
- EXIT;
- END; (* if strIndex *)
- INC( strIndex );
- END; (* loop *)
- (* Don't leave just a period in the field, though *)
- IF (TheStr[strIndex] = periodChar) AND
- (NOT PosUtils.IsNumericChar( TheStr[strIndex+1] )) THEN
- StrEdit.InsertRightJustified( zeroChar, TheStr, strIndex );
- END; (* if TheStr *)
- IF PosUtils.IsBlank( TheStr ) THEN
- TheStr[ 0 ] := zeroChar; (* at least one there *)
- END; (* if PosUtils.IsBlank *)
- (* Get rid of any blanks after punctuation ($ 33.) *)
- StrEdit.DeleteChar( blank, TheStr ); (* trailing gone too *)
- (* find decimal point (if real type) *)
- (* User-specified decimal points not enforced (DecimalPlaces=-1) *)
- IF DecimalPlaces > 0 THEN
- IF PosUtils.PresentPos( periodChar, TheStr, decSpot ) THEN
- (* count the number of digits after the decimal point *)
- decDigits := 0;
- FOR strIndex := decSpot+1 TO fieldEnd DO
- IF PosUtils.IsNumericChar( TheStr[ strIndex ] ) THEN
- INC( decDigits );
- END; (* if PosUtils.IsNumericChar *)
- END; (* for strIndex *)
- IF VAL(INTEGER,decDigits) < DecimalPlaces THEN
- (* not enough digits after decimal point *)
- (* so force-feed the zeroes *)
- FOR strIndex := decSpot+decDigits+1 TO
- Numbers.Min( decSpot+VAL(CARDINAL,DecimalPlaces), fieldEnd ) DO
- TheStr[ strIndex ] := zeroChar;
- END; (* for strIndex *)
- IF (fieldEnd - decSpot) < VAL(CARDINAL,DecimalPlaces) THEN
- (* not enough room in field for required decimal places *)
- (* take out the decimal point and shift it as necessary *)
- StrEdit.DeleteChar( periodChar, TheStr );
- NoDecimalPoint;
- RETURN( FALSE );
- END; (* if fieldEnd *)
- ELSIF VAL(INTEGER,decDigits) > DecimalPlaces THEN
- (* they typed in too many digits after the decimal point - remove *)
- FOR strIndex := decSpot+VAL(CARDINAL,DecimalPlaces)+1 TO
- decSpot+decDigits+1 DO
- TheStr[ strIndex ] := blank;
- END; (* for strIndex *)
- StopFieldExit;
- RETURN( FALSE ); (* Something typed was lost - notify *)
- END; (* if decDigits *)
- ELSE
- NoDecimalPoint;
- END; (* if PosUtils.PresentPos *)
- END; (* if DecimalPlaces *)
- RETURN( TRUE ); (* OK to go ahead and leave field *)
- END CleanUpTheStr; (* procedure *)
- PROCEDURE ComputeNextState;
- (* Used to switch state tables from the various modes *)
- (* (Numeric Entry, Insert Editing, Overstrike Editing) *)
- (* Called after keys that move the cursor in editing modes *)
- BEGIN (* procedure ComputeNextState *)
- CASE curTable OF
- InputTable:
- IF NOT((TheStr[ curPos ] = blank) OR (curPos = fieldEnd)) THEN
- (* Must change to an edit mode *)
- IF UserOps.InsertMode THEN
- curTable := EditInsertTable;
- ELSE
- curTable := EditOverTable;
- END; (* if UserOps.InsertMode *)
- END; (* if not *)
- | EditInsertTable, EditOverTable:
- (* change to InputTable if cursor is on a blank *)
- IF (TheStr[ curPos ] = blank) THEN
- curTable := InputTable;
- ELSIF NOT UserOps.InsertMode THEN
- curTable := EditOverTable;
- ELSE
- curTable := EditInsertTable;
- END; (* if TheStr *)
- END; (* case curTable *)
- (* Now, have to figure out which state we are left in *)
- (* This is because the editing actions change the states *)
- (* NOTE: This is where the states are documented. Each state *)
- (* is represented by three character positional substrings in the *)
- (* third dimension of the stateTable array. *)
- CASE curTable OF
- InputTable:
- IF PosUtils.IsBlank( TheStr ) THEN
- states[ InputTable ] := 0; (* back to initial *)
- ELSIF PosUtils.Present( periodChar, TheStr ) THEN
- states[ InputTable ] := 4; (* after period *)
- ELSIF PosUtils.Present( CurrencySymbol, TheStr ) THEN
- states[ InputTable ] := 3; (* after currency *)
- ELSIF PosUtils.Present( minusChar, TheStr ) THEN
- IF PosUtils.IsNumericChar( TheStr[curPos] ) THEN
- states[ InputTable ] := 5; (* no currency can follow *)
- ELSE
- states[ InputTable ] := 2; (* bare - *)
- END; (* if PosUtils.IsNumber *)
- ELSE
- states[ InputTable ] := 1; (* numbers only so far *)
- END; (* if IsBlank *)
- | EditInsertTable, EditOverTable: (* same 4 states for both *)
- CASE ORD( TheStr[curPos] ) OF
- ZeroKey..NineKey : states[ curTable ] := 0;
- | Minus : states[ curTable ] := 1;
- | DollarSignKey : states[ curTable ] := 2;
- | DecimalKey : states[ curTable ] := 3;
- ELSE
- states[ curTable ] := ErrorState;
- END; (* case TheStr *)
- END; (* case curTable *)
- END ComputeNextState; (* procedure *)
- PROCEDURE FirstSpaceOrEnd;
- (* position cursor on first space or at end of field *)
- BEGIN (* procedure FirstSpaceOrEnd *)
- IF NOT( PosUtils.PresentPos( blank, TheStr, curPos )) THEN
- curPos := fieldEnd;
- END; (* if NOT *)
- END FirstSpaceOrEnd; (* procedure *)
- PROCEDURE LeftMove() : BOOLEAN;
- (* Move the cursor to the left - TRUE if can do within field *)
- BEGIN (* procedure LeftMove *)
- IF curPos = 0 THEN
- (* Change of plans - you're headed out of the field! *)
- LastKey := Key.BackTab; (* get out of the field *)
- IF NOT CleanUpTheStr() THEN
- ComputeNextState;
- ELSE
- StrEdit.RightJustify( TheStr, FieldWidth );
- END; (* if NOT *)
- RETURN( FALSE );
- ELSE
- DEC( curPos );
- RETURN( TRUE );
- END; (* if curPos *)
- END LeftMove; (* procedure *)
- PROCEDURE RightMove;
- (* Move the cursor to the right *)
- BEGIN (* procedure RightMove *)
- IF curPos = fieldEnd THEN
- (* go to the next frame! *)
- LastKey := Key.Tab;
- StrEdit.RightJustify( TheStr, FieldWidth );
- ELSE
- INC( curPos );
- END; (* if curPos *)
- END RightMove; (* procedure *)
- (*
- Well, at last we've reached the end of the edit-oriented
- procedures. What follows are the procedures to support the
- stateTable actions and transitions. These substrings are coded
- "AAT" in the stateTable, where AA are characters indicating
- actions to take and T is an optional next state. Next states
- have to be computed for both EditOver and EditInsert tables.
- *)
- PROCEDURE KeyAction( keyClass : KeyClassType );
- (* process the key struck - keyClass indicates type of key struck *)
- (* The current table, the current state, and the key class all *)
- (* determine the actions to take and the next state, if any, to go to. *)
- (*
- Next state is only provided in input table; the edit tables
- must compute the next state based on the character that the
- cursor is on after the edit action; they are not input-driven.
- *)
- CONST
- MaxProcs = 3; (* max number of letters for one state *)
- VAR
- whichLetter : CARDINAL;
- procLetters : ARRAY [0..MaxProcs] OF CHAR;
- passedTests : BOOLEAN; (* used during edit modes *)
- nextState : CARDINAL;
- PROCEDURE ErrorInKeyStroke;
- (* What to do when an error occurs - also used for parsing errors *)
- (* Called by 'E' command. *)
- BEGIN (* procedure ErrorInKeyStroke *)
- Spkr.Noise( Spkr.Beep, Spkr.Normal, Spkr.Short );
- nextState := states[ curTable ]; (* stay where you are *)
- END ErrorInKeyStroke; (* procedure *)
- PROCEDURE InsertCharacter;
- (* Put the keystroke into TheStr at curPos *)
- (* If any tests done previous have failed, refuse character and beep. *)
- (* Called by 'I' command. *)
- VAR
- targetPos : CARDINAL; (* for moving characters *)
- BEGIN (* procedure InsertCharacter *)
- (* not OK to shift out characters *)
- IF passedTests AND NOT(UserOps.InsertMode AND (TheStr[ fieldEnd ] # blank))
- THEN
- IF UserOps.InsertMode THEN (* insert mode *)
- (* move string to the right by 1, then put in character *)
- (* NOT OK to shift right on out of the field *)
- IF (FieldWidth >= 2) AND (curPos < fieldEnd) THEN
- FOR targetPos := FieldWidth-2 TO curPos BY -1 DO
- TheStr[ targetPos+1 ] := TheStr[ targetPos ];
- END; (* for targetPos *)
- END; (* if FieldWidth *)
- END; (* if UserOps.InsertMode *)
- IF (curPos = FieldWidth - 1) AND (TheStr[ curPos ] # blank)
- AND (UserOps.InsertMode AND LeaveLast)
- THEN
- (* Don't replace character if you're on the last field position, *)
- (* a non-blank character is already there, and the constant *)
- (* LeaveLast is TRUE, and you're in insert mode. *)
- ErrorInKeyStroke;
- ELSE (* All other combinations generate replacement *)
- IF (curPos = FieldWidth - 1) AND (TheStr[ curPos ] # blank) THEN
- (* You're on the last character in the field *)
- Spkr.Noise( Spkr.Beep, Spkr.Normal, Spkr.Short );
- END; (* if curPos *)
- (* replace character under cursor and move cursor right *)
- TheStr[ curPos ] := VAL( CHAR, LastKey );
- INC( curPos );
- IF curPos >= FieldWidth THEN
- curPos := FieldWidth - 1;
- END; (* if curPos *)
- END; (* if curpos *)
- ELSE
- ErrorInKeyStroke;
- END; (* if passedTests *)
- END InsertCharacter; (* procedure *)
- PROCEDURE PresentChar;
- (* tests to see if the key struck is already present - fails if so. *)
- (* Called by 'P', 'A', 'B', 'F', 'G', 'H', 'J', and 'K' commands. *)
- VAR
- strKey : ARRAY [0..1] OF CHAR;
- BEGIN (* procedure PresentChar *)
- strKey[0] := CHR(LastKey);
- strKey[1] := CHR(0);
- passedTests := passedTests AND
- (NOT (PosUtils.Present( strKey, TheStr )));
- END PresentChar; (* procedure *)
- PROCEDURE DigitToLeft;
- (* Fails if there is a digit to the left of the current position *)
- (* Called by 'D', 'A', 'C', 'F', 'J', 'K' commands. *)
- BEGIN (* procedure DigitToLeft *)
- IF curPos > 0 THEN
- passedTests := passedTests AND
- (NOT PosUtils.IsNumericChar( TheStr[curPos-1] ));
- END; (* if curPos *)
- END DigitToLeft; (* procedure *)
- PROCEDURE LeftCurrency;
- (* Fails if there is a currency symbol to the left of the cursor *)
- (* Called by 'L', 'A', and 'C' commands. *)
- BEGIN (* procedure LeftCurrency *)
- IF curPos > 0 THEN
- passedTests := passedTests AND
- (NOT (TheStr[curPos-1] = CurrencySymbol ));
- END; (* if curPos *)
- END LeftCurrency; (* procedure *)
- PROCEDURE RightCurrency;
- (* Fails if there is a currency symbol to the right of the cursor *)
- (* Called by 'R' and 'H' commands. *)
- BEGIN (* procedure RightCurrency *)
- IF curPos < fieldEnd THEN
- passedTests := passedTests AND
- (NOT (TheStr[curPos+1] = CurrencySymbol ));
- END; (* if curPos *)
- END RightCurrency; (* procedure *)
- PROCEDURE PeriodToTheLeft;
- (* Fails if there is a period to the left of the cursor *)
- (* Called by 'Z', 'C', and 'K' commands. *)
- BEGIN (* procedure PeriodToTheLeft *)
- IF curPos > 0 THEN
- passedTests := passedTests AND
- (NOT (TheStr[curPos-1] = periodChar ));
- END; (* if curPos *)
- END PeriodToTheLeft; (* procedure *)
- PROCEDURE WithinDecimalPlaces;
- (* if REAL and decimal hit, have too many digits been typed? *)
- (* Called by 'W' command. *)
- VAR
- strIndex : CARDINAL;
- BEGIN (* procedure WithinDecimalPlaces *)
- IF (DecimalPlaces > 0 ) AND
- PosUtils.PresentPos( periodChar, TheStr, strIndex ) AND
- (strIndex < curPos) AND
- (VAL(INTEGER,(curPos - strIndex)) > DecimalPlaces) THEN
- passedTests := FALSE;
- END; (* if PosUtils.PresentPos *)
- END WithinDecimalPlaces; (* procedure *)
- PROCEDURE MinusOK;
- (* called only when minusChar key hit. Fails if minusOK FALSE. *)
- (* Called by 'M', 'A', 'B', 'C', and 'F' commands. *)
- BEGIN (* procedure MinusOK *)
- passedTests := passedTests AND minusOK;
- END MinusOK; (* procedure *)
- PROCEDURE PeriodOK;
- (* called only when '.' key hit. Fails if periodOK FALSE. *)
- (* Called by 'Y', 'G', and 'H' commands. *)
- BEGIN (* procedure PeriodOK *)
- passedTests := passedTests AND periodOK;
- END PeriodOK; (* procedure *)
- PROCEDURE GetNextState() : CARDINAL;
- (* compute the next state from the current state and state table *)
- BEGIN (* procedure GetNextState *)
- IF stateTable[ curTable ][ keyClass ][ states[curTable]*MaxProcs+2 ]
- = blank THEN
- RETURN( states[ curTable ] ); (* no change if blank *)
- ELSIF StrConv.StrToCardinal( stateTable[ curTable ][ keyClass ]
- [ states[curTable]*MaxProcs+2 ], 0,
- nextState ) THEN
- RETURN( nextState );
- ELSE
- RETURN( ErrorState );
- END; (* if stateTable *)
- END GetNextState; (* procedure *)
- BEGIN (* procedure KeyAction *)
- (* index into the state table to pick up the two action characters *)
- procLetters[0] := stateTable[ curTable ][ keyClass ]
- [ states[curTable]*MaxProcs ];
- procLetters[1] := stateTable[ curTable ][ keyClass ]
- [ states[curTable]*MaxProcs+1 ];
- IF states[ curTable ] = ErrorState THEN
- (* This is an internal error *)
- Spkr.Noise( Spkr.Beep, Spkr.RealHigh, Spkr.Long );
- BlankOutField( 0 );
- curPos := 0;
- ComputeNextState;
- ELSE
- (* Ever optimistic, set up the series of edit tests *)
- passedTests := TRUE;
- (* Execute all the procs called for in the state table *)
- FOR whichLetter := 0 TO MaxProcs-2 DO
- CASE procLetters[ whichLetter ] OF
- 'A' : MinusOK; (* MPLD *)
- PresentChar;
- LeftCurrency;
- DigitToLeft; |
- 'B' : MinusOK; (* MP *)
- PresentChar; |
- 'C' : MinusOK; (* MPLDZ *)
- PresentChar;
- LeftCurrency;
- DigitToLeft;
- PeriodToTheLeft; |
- 'D' : DigitToLeft; |
- 'E' : ErrorInKeyStroke; |
- 'F' : MinusOK; (* MPD *)
- PresentChar;
- DigitToLeft; |
- 'G' : PeriodOK; (* YP *)
- PresentChar; |
- 'H' : PeriodOK; (* YPR *)
- PresentChar;
- RightCurrency; |
- 'I' : InsertCharacter; |
- 'J' : PresentChar; (* PD *)
- DigitToLeft; |
- 'K' : PresentChar; (* PDZ *)
- DigitToLeft;
- PeriodToTheLeft; |
- 'L' : LeftCurrency; |
- 'M' : MinusOK; |
- 'P' : PresentChar; |
- 'R' : RightCurrency; |
- 'W' : WithinDecimalPlaces; |
- 'Y' : PeriodOK; |
- 'Z' : PeriodToTheLeft; |
- ' ' : ; (* do nothing on blank *)
- ELSE
- ErrorInKeyStroke;
- END; (* case ord *)
- END; (* for whichLetter *)
- escapeHit := FALSE; (* after a real character *)
- states[ curTable ] := GetNextState(); (* one change per keystroke *)
- END; (* if states *)
- END KeyAction; (* procedure *)
- (*
- Here is the start of ReadNumericField, proper.
- *)
- BEGIN
- (* First we make sure the FieldWidth is okay. *)
- IF FieldWidth = 0 THEN
- FieldWidth := HIGH( TheStr ) + 1;
- ELSE
- FieldWidth := Numbers.Min( HIGH(TheStr) + 1, FieldWidth );
- END;
- FieldWidth := Numbers.Min( VWindows.EndCol(WindowHandle) - col1,
- FieldWidth );
- SavedHeight := VWindows.GetCursorHeight(WindowHandle);
- IF UserOps.InsertMode THEN
- VWindows.SetCursorHeight( WindowHandle, 6 )
- ELSE
- VWindows.SetCursorHeight( WindowHandle, 2);
- END;
- fieldEnd := FieldWidth - 1;
- (* save the original string. ESC key will restore *)
- StrEdit.AssignStr( TheStr, originalStr );
- (* set the original states *)
- states[ InputTable ] := 0;
- states[ EditOverTable ] := 0;
- states[ EditInsertTable ] := 0;
- editInProgress := FALSE; (* must first hit editing key to start *)
- escapeHit := TRUE; (* allow esc exit until another key *)
- IF DecimalPlaces = 0 THEN (* Note: Real numbers with 0 decimal places *)
- periodOK := FALSE; (* cannot have a decimal point in them. *)
- ELSE
- periodOK := TRUE;
- END; (* if DecimalPlaces *)
- (* initially in input mode unless there is something already there. *)
- curPos := 0; (* appropriate for new entry *)
- curTable := InputTable; (* will be adjusted if required *)
- REPEAT
- VWindows.DrawStr( WindowHandle, col1, row1, SYSTEM.ADR(TheStr), 0 );
- VWindows.GotoXY( WindowHandle, col1 + curPos, row1 );
- LastKey := KbdInput.KeyHit( KbdInput.AnyKeyNum );
- IF NOT editInProgress THEN
- (* completely different actions until "editing" key hit. *)
- CASE LastKey OF
- Key.Home, Key.End, Key.Right, Key.Del, Key.Ins:
- StrEdit.LeftJustify( TheStr, FieldWidth );
- editInProgress := TRUE;
- | Key.AltD, Key.AltE, Key.Space:
- (* perform action in the next section *)
- editInProgress := TRUE;
- | ZeroKey..NineKey, Minus, DecimalKey, DollarSignKey :
- BlankOutField( 0 );
- editInProgress := TRUE;
- ComputeNextState;
- ELSE
- IF NOT BigSets.InSet( ExitKeys, LastKey ) THEN
- Spkr.Noise( Spkr.Beep, Spkr.Normal, Spkr.Short );
- END; (* if NOT *)
- END; (* case Lastkey *)
- END; (* if NOT *)
- IF editInProgress THEN
- CASE LastKey OF
- ZeroKey..NineKey: (* ASCII values of zeroChar to '9' *)
- KeyAction( DigitsClass );
- IF curTable # InputTable THEN
- ComputeNextState;
- END; (* if curtable *)
- | Minus: (* minusChar *)
- KeyAction( MinusClass );
- IF curTable # InputTable THEN
- ComputeNextState;
- END; (* if curtable *)
- | DecimalKey:
- KeyAction( DecimalPointClass );
- IF curTable # InputTable THEN
- ComputeNextState;
- END; (* if curtable *)
- | DollarSignKey:
- KeyAction( DollarClass );
- IF curTable # InputTable THEN
- ComputeNextState;
- END; (* if curtable *)
- | Key.Ins:
- UserOps.InsertMode := NOT UserOps.InsertMode;
- IF UserOps.InsertMode THEN
- VWindows.SetCursorHeight( WindowHandle, 6 )
- ELSE
- VWindows.SetCursorHeight( WindowHandle, 2);
- END;
- | Key.Del:
- DeleteCharacter;
- ComputeNextState;
- LastKey := 0; (* Don't want it seen as exit key *)
- | Key.BackSpace:
- IF LeftMove() THEN
- DeleteCharacter;
- ComputeNextState;
- END; (* if LeftMove *)
- | Key.Left: (* left arrow *)
- LastKey := 0; (* prevent leaving field *)
- IF LeftMove() THEN
- ComputeNextState;
- END; (* if LeftMove *)
- | Key.Right: (* right arrow *)
- LastKey := 0; (* prevent leaving field *)
- RightMove;
- ComputeNextState;
- | Key.Escape:
- IF NOT escapeHit THEN (* second escape gets out of frame *)
- PreviousContents; (* restore original value *)
- ComputeNextState;
- escapeHit := TRUE;
- LastKey := 0; (* prevent frame exit *)
- editInProgress := FALSE; (* and take out of edit mode *)
- ELSE
- StrEdit.RightJustify( TheStr, FieldWidth ); (* allow exit *)
- END; (* if not escapeHit *)
- | Key.Home:
- curPos := 0; (* move to leftmost char in field *)
- ComputeNextState;
- | Key.End:
- FirstSpaceOrEnd; (* put cursor after/on last char *)
- ComputeNextState;
- | Key.AltD, Key.Space: (* delete entire entry *)
- BlankOutField( 0 );
- curPos := 0;
- ComputeNextState;
- | Key.AltE: (* erase from cursor to field end *)
- BlankOutField( curPos );
- ComputeNextState;
- ELSE
- IF NOT BigSets.InSet( ExitKeys, LastKey ) THEN
- Spkr.Noise( Spkr.Beep, Spkr.Normal, Spkr.Short );
- ELSE (* always clean up before you can leave - might fail! *)
- (* CleanUpTheStr will change LastKey if it fails - prevent exit. *)
- IF NOT CleanUpTheStr() THEN
- ComputeNextState;
- ELSE
- StrEdit.RightJustify( TheStr, FieldWidth );
- END; (* if NOT *)
- END; (* if NOT *)
- END;
- END; (* if editInProgress *)
- UNTIL BigSets.InSet( ExitKeys, LastKey );
- VWindows.SetCursorHeight( WindowHandle, SavedHeight );
- END ReadNumericField;
- PROCEDURE LoadTableRow
- ( inputStr : ARRAY OF CHAR; (* action string for input *)
- overStr : ARRAY OF CHAR; (* string for overstrike *)
- insertStr : ARRAY OF CHAR; (* string for insert mode *)
- keyClass : KeyClassType (* second dimension of table *)
- );
- (* Loads the three action strings into the state table array *)
- (* Used to initialize the array *)
- BEGIN (* procedure LoadTableRow *)
- StrEdit.AssignStr( inputStr, stateTable[ InputTable ] [ keyClass ] );
- StrEdit.AssignStr( overStr, stateTable[ EditOverTable ] [ keyClass ] );
- StrEdit.AssignStr( insertStr, stateTable[ EditInsertTable ] [ keyClass ] );
- END LoadTableRow; (* procedure *)
- PROCEDURE InitStateTable;
- (* Initialize the state table; called once when field entered *)
- (* Invoke from the initialization section of the module *)
- BEGIN (* procedure InitStateTable *)
- LoadTableRow( " I1 I1 I5 I3WI4 I5", " I RI I I ", " I E E I ",
- DigitsClass );
- LoadTableRow( "MI2 E E E E E ", "AI MI BI AI ", "CI E FI AI ",
- MinusClass );
- LoadTableRow( "YI4YI4YI4YI4 E YI4", "GI HI GI YI ", "GI E E E ",
- DecimalPointClass );
- LoadTableRow( " I3 E I3 E E E ", "JI PI I JI ", "KI E E JI ",
- DollarClass );
- END InitStateTable; (* procedure *)
- PROCEDURE Init();
- BEGIN
- IF Initialized THEN
- RETURN;
- ELSE
- Initialized := TRUE;
- END;
- BigSets.Init();
- ErrorManager.Init();
- KbdInput.Init();
- Key.Init();
- LowLevel.Init();
- M2Strings.Init();
- Numbers.Init();
- PosUtils.Init();
- ScrnTypes.Init();
- Spkr.Init();
- StrConv.Init();
- StrEdit.Init();
- UserOps.Init();
- VWindows.Init();
- InitStateTable(); (* load the table with action strings *)
- END Init;
- BEGIN
- Initialized := FALSE;
- Init();
- END NumInput.
|