Topspeed_JPI/TS-V3/REP16/NUMINPUT.LST

Listing:

    1  IMPLEMENTATION MODULE NumInput;
    2  (*
    3   *  REPERTOIRE
    4   *  Release 1.6
    5   *  By Charles Bradford and Cole Brecheen
    6   *  (c) Copyright 1985-1992 PMI
    7   *  Green Bay, Wisconsin
    8   *  All rights reserved
    9   *  (414) 468-6040
   10   *
   11   *  $Header:   D:/logfiles/mods/numinput.mov   1.4   10 Mar 1991 15:35:32   coleb  $
   12   *
   13   *)
   14  
   15  
   16  (*
   17  Author:     Mike Carter
   18  Description:
   19    Enter or edit a numeric field.
   20    Replacement for PMI StrInput.ReadNumeric.  Note that parameters
   21    are slightly different:
   22      1.  PMI FloatingPoint and InDecimals parameters have been
   23          removed. They simply have no meaning the way real number
   24          input is now handled.
   25      2.  minusOK has been added - see below.
   26      3.  The meaning of DecimalPlaces has been changed - see
   27          below.
   28  
   29    Some of the features of this version:
   30      * General editing functions are very close to PMI string
   31        input. (Keys like Ins, Del, Home, End, PgUp, PgDn, Left and
   32        Right Arrows, Up and Down Arrows, Backspace, Tab, Shift
   33        Tab, etc. work almost the same way as they do in string
   34        fields).
   35      * Numbers are entered from left to right, then right-
   36        justified on field exit.
   37      * Both insert and overstrike modes are supported.
   38      * The number of digits after the decimal place is strictly
   39        enforced. The user is beeped if too many are entered; if
   40        two few are entered, zeroes are appended.  If there is not
   41        enough room in the field, the rightmost character is thrown
   42        out, the decimal point repositioned, and the user beeped.
   43  
   44    Notes on parameters:
   45      * A new field was added in ScrnTypes.InputFieldRecord called
   46        "decimalPlace", with corresponding type DecimalPlaceType.
   47        This was designed to be passed to this routine: a -1 value
   48        indicates user-specified decimal points (or none); a 0
   49        means no digits after the decimal point, a 1 one digit,
   50        etc.
   51      * The value of minusOK determines whether negative numbers
   52        are allowed; this can be set from rMin, iMin within
   53        UserOps.  Must be FALSE for strings that are later to be
   54        interpreted as CARDINAL.
   55  
   56    Notes on Methodology:
   57      NumInput combines state transition tables with a series of
   58      rules.  The three state tables reflect the current input mode
   59      and the character that the cursor is under; they generate
   60      actions to be taken based on each key that may be hit as well
   61      as the next state.  The tables are:
   62        InputTable = entry on top of blanks.
   63        EditOverTable = overstrike mode.
   64        EditInsertTable = insert mode.
   65      The entries in the state tables are formed by three-character
   66      sequences. (See the initialization code at the end of this
   67      module).
   68  
   69      (1) The first character is a non-mnemonic that stands for a
   70          sequence of actions to be taken if a key in that keyclass
   71          is hit.  See the KeyAction procedure guts to see which
   72          procedures are executed for which letters. Generally,
   73          these procedures are qualifying procedures that determine
   74          whether or not a keystroke is legal from a given state.
   75      (2) The next character specifies the action to take if the
   76          qualifications are met.  "I" stands for insert; "E"
   77          stands for error.
   78      (3) The last character in the state table triplet is the next
   79          state. You'll notice that this is missing in many cases -
   80          that is because of the fact that during editing, the next
   81          state must be dynamically re-computed from the numeric
   82          string AFTER the change has been made.
   83  
   84      The state tables are difficult to understand without
   85      diagrams, from which they were created (state transition
   86      diagrams).
   87  
   88      The rules referred to above are generally conditions that
   89      would have caused the state tables to grow exponentially had
   90      they been included. InsertCharacter contains a number of
   91      these rules, such as what to do when you are on the last
   92      character in the field under a number of circumstances.
   93  
   94  *)
   95  
   96  IMPORT BigSets;
   97  IMPORT ErrorManager;
   98  IMPORT KbdInput;
   99  IMPORT Key;
  100  IMPORT LowLevel;
  101  IMPORT M2Strings;
  102  IMPORT Numbers;
  103  IMPORT PosUtils;
  104  IMPORT ScrnTypes;
  105  IMPORT Spkr;
  106  IMPORT StrConv;
  107  IMPORT StrEdit;
  108  IMPORT UserOps;
  109  IMPORT SYSTEM;
  110  IMPORT VWindows;
  111  
  112  VAR
  113    Initialized : BOOLEAN;
  114  
  115  
  116  TYPE
  117    TableIndexType = (InputTable, EditOverTable, EditInsertTable);
  118      (* InputTable = entry on top of blanks *)
  119      (* EditOverTable = overstrike mode *)
  120      (* EditInsertTable = insert mode *)
  121    KeyClassType = (DigitsClass, MinusClass, DecimalPointClass, DollarClass);
  122  
  123  CONST
  124    ActionLetters = 2;    (* state table action letters + next state - 1 *)
  125    MaxStates = 6;        (* max number of states in table *)
  126  
  127  VAR
  128    stateTable      : ARRAY [InputTable..EditInsertTable],
*****                             ^ not supported yet
*****                                         ^ not supported yet
  129                            [DigitsClass..DollarClass],
  130                            [0..MaxStates * (ActionLetters+1)] OF CHAR;
  131                                         (* actions and next states *)
  132  
  133  PROCEDURE ReadNumericField
  134          (    WindowHandle : VWindows.AWindowHandle;    (* in *)
  135            VAR TheStr       : ARRAY OF CHAR;   (* in/out - field contents *)
  136                col1         : CARDINAL;        (* in - field loc *)
  137                row1         : CARDINAL;        (* in - field loc *)
  138                FieldWidth   : CARDINAL;        (* in - # chars. in field *)
  139                DecimalPlaces: ScrnTypes.DecimalPlaceType;
  140                                                (* in - # digits after . *)
  141                minusOK      : BOOLEAN;         (* in - "-" permitted *)
  142            VAR LastKey      : CARDINAL;        (* in/out - last key hit *)
  143            VAR ExitKeys     : KbdInput.KeyNumSet  (* in - keys to exit on *)
  144          );
  145    (*
  146    This is a general-purpose numeric input routine that replaces the PMI
  147    StrInput.ReadNumeric procedure.  The parameters are slightly different.
  148    *)
  149  
  150    CONST
  151      Minus = ORD('-');                  (* numerics required due to LastKey *)
  152      DecimalKey = ORD('.');
  153      DollarSignKey = ORD('$');
  154      ZeroKey = ORD('0');
  155      NineKey = ORD('9');
  156      CurrencySymbol = '$';
  157      blank = ' ';
  158      periodChar = '.';
  159      minusChar = '-';
  160      zeroChar = '0';
  161      MaxFieldSize = 255;
  162      ErrorState = 9999;    (* arbitrary error state *)
  163      LeaveLast = TRUE;     (* last character in field can't be overstruck *)
  164    VAR
  165      (* old PMI variables still used *)
  166      SavedHeight : CARDINAL;
  167  
  168      curPos          : CARDINAL;                (* index to TheStr *)
  169      curTable        : TableIndexType;          (* current state table *)
  170      editInProgress  : BOOLEAN;                 (* TRUE if editing started *)
  171      escapeHit       : BOOLEAN;                 (* ESC restores string *)
  172      fieldEnd        : CARDINAL;                (* FieldWidth - 1 *)
  173      originalStr     : ARRAY [0..MaxFieldSize] OF CHAR;
  174                                                 (* copy to restore by ESC *)
  175      periodOK        : BOOLEAN;                 (* FALSE for INT and CARD *)
  176      states          : ARRAY [InputTable..EditInsertTable] OF CARDINAL;
  177                                                 (* state for each table *)
  178  
  179  (*
  180    The following group of procedures supports editing functions and are
  181    NOT involved with the state tables.
  182  *)
  183    PROCEDURE DeleteCharacter;
  184      (* Delete the character at the current cursor position *)
  185      (* Any characters to the right of curPos move left *)
  186      (* Implements part of DEL key.  Doesn't move cursor position. *)
  187      VAR
  188        shiftIndex : CARDINAL;
  189    BEGIN (* procedure DeleteCharacter *)
  190      IF curPos < fieldEnd THEN
  191        FOR shiftIndex := curPos TO fieldEnd DO
  192          TheStr[ shiftIndex ] := TheStr[ shiftIndex + 1 ];
  193        END; (* for shiftIndex *)
  194      END; (* if curPos *)
  195      TheStr[ fieldEnd ] := blank;
  196      escapeHit := FALSE;
  197    END DeleteCharacter; (* procedure *)
  198  
  199    PROCEDURE PreviousContents;
  200      (* replace current contents of field with original contents *)
  201      (* Be sure to recompute table state afterwards *)
  202      (* Implements ESC key in part. *)
  203    BEGIN (* procedure PreviousContents *)
  204      StrEdit.AssignStr( originalStr, TheStr );
  205      curPos := 0;
  206    END PreviousContents; (* procedure *)
  207  
  208    PROCEDURE BlankOutField( startPos : CARDINAL );
  209      (* Replace the designated portion of the field with blanks. *)
  210      VAR
  211        strIndex : CARDINAL;
  212    BEGIN (* procedure BlankOutField *)
  213      FOR strIndex := startPos TO fieldEnd DO
  214        TheStr[ strIndex ] := blank;
  215      END; (* for strIndex *)
  216    END BlankOutField; (* procedure *)
  217  
  218  
  219    PROCEDURE CleanUpTheStr(): BOOLEAN;
  220      (* "Cleans up" the string in the field that the user wants to leave *)
  221      (* This procedure is meant to be executed whenever field movement keys *)
  222      (* have been hit.  E.g. TAB, PgUp, PgDn, Shift TAB, etc. *)
  223      (* Actions performed: *)
  224      (*    Leading Zeroes stripped. *)
  225      (*    Decimal point forced in if not there. *)
  226      (*    Trailing Zeroes added after decimal point without enough *)
  227      (*       digits after it. *)
  228      (*    Decimal point with too many digits after it causes truncation *)
  229      (*       of extra digits, beep, and cursor left in field. *)
  230      (*    Fields with no numeric digits are blanked out. *)
  231      (* Be sure to recompute table state afterwards *)
  232      VAR
  233        strIndex, decSpot, decDigits : CARDINAL;
  234        anyNumerics : BOOLEAN;       (* TRUE if field contains any digits *)
  235  
  236      PROCEDURE StopFieldExit;
  237        (* An adjustment to the field has been made that requires user's *)
  238        (* attention - prevent exit from the field (aborting key action). *)
  239      BEGIN (* procedure StopFieldExit *)
  240        (* Don't allow the field to be exited - set up as just entered *)
  241        StrEdit.LeftJustify( TheStr, FieldWidth );
  242        LastKey := 0;
  243        curPos := 0;
  244        (* And try to wake up the user that this has happened! *)
  245        Spkr.Noise( Spkr.Beep, Spkr.High, Spkr.Medium );
  246      END StopFieldExit; (* procedure *)
  247  
  248      PROCEDURE NoDecimalPoint;
  249        (* Process a string that has no decimal point.  For Reals only. *)
  250  
  251        PROCEDURE InsertLeftJustified
  252                  (    insChar   : CHAR;           (* character to insert *)
  253                       pos       : CARDINAL        (* position in TheStr *)
  254                  );
  255          (* puts insChar into TheStr at location pos; rightmost char gone *)
  256          VAR
  257            strIndex : CARDINAL;
  258        BEGIN (* procedure InsertLeftJustified *)
  259          (* move what's there over; forget the leftmost character *)
  260          IF fieldEnd > 0 THEN
  261            FOR strIndex := fieldEnd-1 TO pos BY -1 DO
  262              TheStr[ strIndex+1 ] := TheStr[ strIndex ];
  263            END; (* for strIndex *)
  264            TheStr[ pos ] := insChar;
  265          END; (* if fieldEnd *)
  266        END InsertLeftJustified; (* procedure *)
  267  
  268        VAR
  269          decPointPos : CARDINAL;        (* where the decimal point goes *)
  270          rightSubStr : ARRAY [0..80] OF CHAR;     (* str in front of dec pt. *)
  271          trailingDig : BOOLEAN;         (* true if digits after dec. point *)
  272  
  273      BEGIN (* procedure NoDecimalPoint *)
  274        (* note that TheStr does not necessarily have length = FieldWidth! *)
  275        StrEdit.LeftJustify( TheStr, FieldWidth );
  276        (* if necessary, sacrifice the last digit to make room for '.' *)
  277        decPointPos := FieldWidth-VAL(CARDINAL,DecimalPlaces)-1;
  278        InsertLeftJustified( periodChar, decPointPos );
  279        (* right justify with period as a boundary *)
  280        IF decPointPos > 0 THEN
  281          M2Strings.Copy( TheStr, 0, decPointPos, rightSubStr );
  282          StrEdit.RightJustify( rightSubStr, decPointPos );
  283          StrEdit.OverWrite( rightSubStr, TheStr, 0 );  (* put back in, shifted *)
  284        END; (* if decPointPos *)
  285        (* Fill in any gaps with zeroes. *)
  286        trailingDig := FALSE;
  287        FOR strIndex := decPointPos+1 TO fieldEnd DO
  288          IF TheStr[ strIndex ] = blank THEN
  289            TheStr[ strIndex ] := zeroChar;
  290          ELSE
  291            trailingDig := TRUE;
  292          END; (* if TheStr *)
  293        END; (* for strIndex *)
  294  
  295        (* Alert the user only if dec. point was added in middle of digits *)
  296        IF trailingDig THEN
  297          StopFieldExit;
  298        END; (* if trailingDig *)
  299      END NoDecimalPoint; (* procedure *)
  300  
  301  
  302    BEGIN (* procedure CleanUpTheStr *)
  303      (* Blank fields ignored *)
  304      IF PosUtils.IsBlank( TheStr ) THEN
  305        RETURN( TRUE );
  306      END; (* if PosUtils.IsBlank *)
  307  
  308      (* Another check - if there were no numeric digits, blank out. *)
  309      anyNumerics := FALSE;
  310      FOR strIndex := 0 TO fieldEnd DO
  311        anyNumerics := anyNumerics OR
  312                    PosUtils.IsNumericChar( TheStr[ strIndex ] )
  313      END; (* for strIndex *)
  314      IF NOT anyNumerics THEN
  315        BlankOutField( 0 );
  316        RETURN( TRUE );        (* not much point in doing anything else *)
  317      END; (* if NOT *)
  318  
  319      (* First, out with the leading zeroes.  Leave last one. *)
  320      (* Note also removes zeroes for -00.33 or $00.33 *)
  321      strIndex := 0;
  322      LOOP
  323        IF TheStr[ strIndex ] = zeroChar  THEN
  324          TheStr[ strIndex ] := blank;
  325        END; (* if TheStr *)
  326        IF (strIndex = fieldEnd) OR (TheStr[strIndex] = periodChar) OR
  327           ((TheStr[strIndex] # zeroChar) AND     (* stop on non-zero digit *)
  328           PosUtils.IsNumericChar( TheStr[strIndex] ))
  329        THEN
  330          EXIT;
  331        END; (* if strIndex *)
  332        INC( strIndex );
  333      END; (* loop *)
  334      (* Don't leave just a period in the field, though *)
  335      IF (TheStr[strIndex] = periodChar) AND
  336         (NOT PosUtils.IsNumericChar( TheStr[strIndex+1] )) THEN
  337        StrEdit.InsertRightJustified( zeroChar, TheStr, strIndex );
  338      END; (* if TheStr *)
  339      IF PosUtils.IsBlank( TheStr ) THEN
  340        TheStr[ 0 ] := zeroChar;                    (* at least one there *)
  341      END; (* if PosUtils.IsBlank *)
  342      (* Get rid of any blanks after punctuation ($  33.) *)
  343      StrEdit.DeleteChar( blank, TheStr );       (* trailing gone too *)
  344  
  345      (* find decimal point (if real type) *)
  346      (* User-specified decimal points not enforced (DecimalPlaces=-1) *)
  347      IF DecimalPlaces > 0 THEN
  348        IF PosUtils.PresentPos( periodChar, TheStr, decSpot ) THEN
  349          (* count the number of digits after the decimal point *)
  350          decDigits := 0;
  351          FOR strIndex := decSpot+1 TO fieldEnd DO
  352            IF PosUtils.IsNumericChar( TheStr[ strIndex ] ) THEN
  353              INC( decDigits );
  354            END; (* if PosUtils.IsNumericChar *)
  355          END; (* for strIndex *)
  356          IF VAL(INTEGER,decDigits) < DecimalPlaces THEN
  357            (* not enough digits after decimal point *)
  358            (* so force-feed the zeroes *)
  359            FOR strIndex := decSpot+decDigits+1 TO
  360                Numbers.Min( decSpot+VAL(CARDINAL,DecimalPlaces), fieldEnd ) DO
  361              TheStr[ strIndex ] := zeroChar;
  362            END; (* for strIndex *)
  363            IF (fieldEnd - decSpot) < VAL(CARDINAL,DecimalPlaces) THEN
  364              (* not enough room in field for required decimal places *)
  365              (* take out the decimal point and shift it as necessary *)
  366              StrEdit.DeleteChar( periodChar, TheStr );
  367              NoDecimalPoint;
  368              RETURN( FALSE );
  369            END; (* if fieldEnd *)
  370          ELSIF VAL(INTEGER,decDigits) > DecimalPlaces THEN
  371            (* they typed in too many digits after the decimal point - remove *)
  372            FOR strIndex := decSpot+VAL(CARDINAL,DecimalPlaces)+1 TO
  373                decSpot+decDigits+1 DO
  374              TheStr[ strIndex ] := blank;
  375            END; (* for strIndex *)
  376            StopFieldExit;
  377            RETURN( FALSE );             (* Something typed was lost - notify *)
  378          END; (* if decDigits *)
  379        ELSE
  380          NoDecimalPoint;
  381        END; (* if PosUtils.PresentPos *)
  382      END; (* if DecimalPlaces *)
  383  
  384      RETURN( TRUE );                (* OK to go ahead and leave field *)
  385    END CleanUpTheStr; (* procedure *)
  386  
  387  
  388    PROCEDURE ComputeNextState;
  389      (* Used to switch state tables from the various modes *)
  390      (* (Numeric Entry, Insert Editing, Overstrike Editing) *)
  391      (* Called after keys that move the cursor in editing modes *)
  392    BEGIN (* procedure ComputeNextState *)
  393      CASE curTable OF
  394        InputTable:
  395          IF NOT((TheStr[ curPos ] = blank) OR (curPos = fieldEnd)) THEN
  396            (* Must change to an edit mode *)
  397            IF UserOps.InsertMode THEN
  398              curTable := EditInsertTable;
  399            ELSE
  400              curTable := EditOverTable;
  401            END; (* if UserOps.InsertMode *)
  402          END; (* if not *)
  403      | EditInsertTable, EditOverTable:
  404        (* change to InputTable if cursor is on a blank *)
  405          IF (TheStr[ curPos ] = blank) THEN
  406            curTable := InputTable;
  407          ELSIF NOT UserOps.InsertMode THEN
  408            curTable := EditOverTable;
  409          ELSE
  410            curTable := EditInsertTable;
  411          END; (* if TheStr *)
  412      END; (* case curTable *)
  413      (* Now, have to figure out which state we are left in *)
  414      (* This is because the editing actions change the states *)
  415      (* NOTE: This is where the states are documented.  Each state *)
  416      (* is represented by three character positional substrings in the *)
  417      (* third dimension of the stateTable array. *)
  418      CASE curTable OF
  419        InputTable:
  420          IF PosUtils.IsBlank( TheStr ) THEN
  421            states[ InputTable ] := 0;     (* back to initial *)
  422          ELSIF PosUtils.Present( periodChar, TheStr ) THEN
  423            states[ InputTable ] := 4;     (* after period *)
  424          ELSIF PosUtils.Present( CurrencySymbol, TheStr )  THEN
  425            states[ InputTable ] := 3;     (* after currency *)
  426          ELSIF PosUtils.Present( minusChar, TheStr ) THEN
  427            IF PosUtils.IsNumericChar( TheStr[curPos] ) THEN
  428              states[ InputTable ] := 5;     (* no currency can follow *)
  429            ELSE
  430              states[ InputTable ] := 2;     (* bare - *)
  431            END; (* if PosUtils.IsNumber *)
  432          ELSE
  433            states[ InputTable ] := 1;     (* numbers only so far *)
  434          END; (* if IsBlank *)
  435        | EditInsertTable, EditOverTable:       (* same 4 states for both *)
  436          CASE ORD( TheStr[curPos] ) OF
  437            ZeroKey..NineKey   : states[ curTable ] := 0;
  438            | Minus            : states[ curTable ] := 1;
  439            | DollarSignKey    : states[ curTable ] := 2;
  440            | DecimalKey       : states[ curTable ] := 3;
  441          ELSE
  442            states[ curTable ] := ErrorState;
  443          END; (* case TheStr *)
  444      END; (* case curTable *)
  445    END ComputeNextState; (* procedure *)
  446  
  447  
  448    PROCEDURE FirstSpaceOrEnd;
  449      (* position cursor on first space or at end of field *)
  450    BEGIN (* procedure FirstSpaceOrEnd *)
  451      IF NOT( PosUtils.PresentPos( blank, TheStr, curPos )) THEN
  452        curPos := fieldEnd;
  453      END; (* if NOT *)
  454    END FirstSpaceOrEnd; (* procedure *)
  455  
  456  
  457    PROCEDURE LeftMove() : BOOLEAN;
  458      (* Move the cursor to the left - TRUE if can do within field *)
  459    BEGIN (* procedure LeftMove *)
  460      IF curPos = 0 THEN
  461        (* Change of plans - you're headed out of the field! *)
  462        LastKey := Key.BackTab;          (* get out of the field *)
  463        IF NOT CleanUpTheStr() THEN
  464          ComputeNextState;
  465        ELSE
  466          StrEdit.RightJustify( TheStr, FieldWidth );
  467        END; (* if NOT *)
  468        RETURN( FALSE );
  469      ELSE
  470        DEC( curPos );
  471        RETURN( TRUE );
  472      END; (* if curPos *)
  473    END LeftMove; (* procedure *)
  474  
  475    PROCEDURE RightMove;
  476      (* Move the cursor to the right *)
  477    BEGIN (* procedure RightMove *)
  478      IF curPos = fieldEnd THEN
  479        (* go to the next frame! *)
  480        LastKey := Key.Tab;
  481        StrEdit.RightJustify( TheStr, FieldWidth );
  482      ELSE
  483        INC( curPos );
  484      END; (* if curPos *)
  485    END RightMove; (* procedure *)
  486  
  487  
  488  (*
  489    Well, at last we've reached the end of the edit-oriented
  490    procedures. What follows are the procedures to support the
  491    stateTable actions and transitions.  These substrings are coded
  492    "AAT" in the stateTable, where AA are characters indicating
  493    actions to take and T is an optional next state.  Next states
  494    have to be computed for both EditOver and EditInsert tables.
  495  *)
  496  
  497    PROCEDURE KeyAction( keyClass : KeyClassType );
  498      (* process the key struck - keyClass indicates type of key struck *)
  499      (* The current table, the current state, and the key class all *)
  500      (* determine the actions to take and the next state, if any, to go to. *)
  501      (*
  502         Next state is only provided in input table; the edit tables
  503         must compute the next state based on the character that the
  504         cursor is on after the edit action; they are not input-driven.
  505      *)
  506      CONST
  507        MaxProcs = 3;          (* max number of letters for one state *)
  508      VAR
  509        whichLetter : CARDINAL;
  510        procLetters : ARRAY [0..MaxProcs] OF CHAR;
  511        passedTests : BOOLEAN;         (* used during edit modes *)
  512        nextState : CARDINAL;
  513  
  514  
  515      PROCEDURE ErrorInKeyStroke;
  516        (* What to do when an error occurs - also used for parsing errors *)
  517        (* Called by 'E' command. *)
  518      BEGIN (* procedure ErrorInKeyStroke *)
  519        Spkr.Noise( Spkr.Beep, Spkr.Normal, Spkr.Short );
  520        nextState := states[ curTable ];         (* stay where you are *)
  521      END ErrorInKeyStroke; (* procedure *)
  522  
  523      PROCEDURE InsertCharacter;
  524        (* Put the keystroke into TheStr at curPos *)
  525        (* If any tests done previous have failed, refuse character and beep. *)
  526        (* Called by 'I' command. *)
  527        VAR
  528          targetPos : CARDINAL;        (* for moving characters *)
  529      BEGIN (* procedure InsertCharacter *)
  530        (* not OK to shift out characters *)
  531        IF passedTests AND NOT(UserOps.InsertMode AND (TheStr[ fieldEnd ] # blank))
  532        THEN
  533          IF UserOps.InsertMode THEN              (* insert mode *)
  534            (* move string to the right by 1, then put in character *)
  535            (* NOT OK to shift right on out of the field *)
  536            IF (FieldWidth >= 2) AND (curPos < fieldEnd) THEN
  537              FOR targetPos := FieldWidth-2 TO curPos BY -1 DO
  538                TheStr[ targetPos+1 ] := TheStr[ targetPos ];
  539              END; (* for targetPos *)
  540            END; (* if FieldWidth *)
  541          END; (* if UserOps.InsertMode *)
  542          IF (curPos = FieldWidth - 1) AND (TheStr[ curPos ] # blank)
  543             AND (UserOps.InsertMode AND LeaveLast)
  544          THEN
  545            (* Don't replace character if you're on the last field position, *)
  546            (* a non-blank character is already there, and the constant *)
  547            (* LeaveLast is TRUE, and you're in insert mode. *)
  548            ErrorInKeyStroke;
  549          ELSE  (* All other combinations generate replacement *)
  550            IF (curPos = FieldWidth - 1) AND (TheStr[ curPos ] # blank) THEN
  551              (* You're on the last character in the field *)
  552              Spkr.Noise( Spkr.Beep, Spkr.Normal, Spkr.Short );
  553            END; (* if curPos *)
  554            (* replace character under cursor and move cursor right *)
  555            TheStr[ curPos ] := VAL( CHAR, LastKey );
  556            INC( curPos );
  557            IF curPos >= FieldWidth THEN
  558              curPos := FieldWidth - 1;
  559            END; (* if curPos *)
  560          END; (* if curpos *)
  561        ELSE
  562          ErrorInKeyStroke;
  563        END; (* if passedTests *)
  564      END InsertCharacter; (* procedure *)
  565  
  566      PROCEDURE PresentChar;
  567        (* tests to see if the key struck is already present - fails if so. *)
  568        (* Called by 'P', 'A', 'B', 'F', 'G', 'H', 'J', and 'K' commands. *)
  569        VAR
  570          strKey : ARRAY [0..1] OF CHAR;
  571      BEGIN (* procedure PresentChar *)
  572        strKey[0] := CHR(LastKey);
  573        strKey[1] := CHR(0);
  574        passedTests := passedTests AND
  575                      (NOT (PosUtils.Present( strKey, TheStr )));
  576      END PresentChar; (* procedure *)
  577  
  578      PROCEDURE DigitToLeft;
  579        (* Fails if there is a digit to the left of the current position *)
  580        (* Called by 'D', 'A', 'C', 'F', 'J', 'K' commands. *)
  581      BEGIN (* procedure DigitToLeft *)
  582        IF curPos > 0 THEN
  583          passedTests := passedTests AND
  584                      (NOT PosUtils.IsNumericChar( TheStr[curPos-1] ));
  585        END; (* if curPos *)
  586      END DigitToLeft; (* procedure *)
  587  
  588      PROCEDURE LeftCurrency;
  589        (* Fails if there is a currency symbol to the left of the cursor *)
  590        (* Called by 'L', 'A', and 'C' commands. *)
  591      BEGIN (* procedure LeftCurrency *)
  592        IF curPos > 0 THEN
  593          passedTests := passedTests AND
  594                      (NOT (TheStr[curPos-1] = CurrencySymbol ));
  595        END; (* if curPos *)
  596      END LeftCurrency; (* procedure *)
  597  
  598      PROCEDURE RightCurrency;
  599        (* Fails if there is a currency symbol to the right of the cursor *)
  600        (* Called by 'R' and 'H' commands. *)
  601      BEGIN (* procedure RightCurrency *)
  602        IF curPos < fieldEnd THEN
  603          passedTests := passedTests AND
  604                      (NOT (TheStr[curPos+1] = CurrencySymbol ));
  605        END; (* if curPos *)
  606      END RightCurrency; (* procedure *)
  607  
  608      PROCEDURE PeriodToTheLeft;
  609        (* Fails if there is a period to the left of the cursor *)
  610        (* Called by 'Z', 'C', and 'K' commands. *)
  611      BEGIN (* procedure PeriodToTheLeft *)
  612        IF curPos > 0 THEN
  613          passedTests := passedTests AND
  614                      (NOT (TheStr[curPos-1] = periodChar ));
  615        END; (* if curPos *)
  616      END PeriodToTheLeft; (* procedure *)
  617  
  618      PROCEDURE WithinDecimalPlaces;
  619        (* if REAL and decimal hit, have too many digits been typed? *)
  620        (* Called by 'W' command. *)
  621        VAR
  622          strIndex : CARDINAL;
  623      BEGIN (* procedure WithinDecimalPlaces *)
  624        IF (DecimalPlaces > 0 ) AND
  625            PosUtils.PresentPos( periodChar, TheStr, strIndex ) AND
  626            (strIndex < curPos) AND
  627            (VAL(INTEGER,(curPos - strIndex)) > DecimalPlaces) THEN
  628          passedTests := FALSE;
  629        END; (* if PosUtils.PresentPos *)
  630      END WithinDecimalPlaces; (* procedure *)
  631  
  632      PROCEDURE MinusOK;
  633        (* called only when minusChar key hit.  Fails if minusOK FALSE. *)
  634        (* Called by 'M', 'A', 'B', 'C', and 'F' commands. *)
  635      BEGIN (* procedure MinusOK *)
  636        passedTests := passedTests AND minusOK;
  637      END MinusOK; (* procedure *)
  638  
  639      PROCEDURE PeriodOK;
  640        (* called only when '.' key hit.  Fails if periodOK FALSE. *)
  641        (* Called by 'Y', 'G', and 'H' commands. *)
  642      BEGIN (* procedure PeriodOK *)
  643        passedTests := passedTests AND periodOK;
  644      END PeriodOK; (* procedure *)
  645  
  646      PROCEDURE GetNextState() : CARDINAL;
  647        (* compute the next state from the current state and state table *)
  648      BEGIN (* procedure GetNextState *)
  649        IF stateTable[ curTable ][ keyClass ][ states[curTable]*MaxProcs+2 ]
  650           = blank THEN
  651          RETURN( states[ curTable ] );  (* no change if blank *)
  652        ELSIF StrConv.StrToCardinal( stateTable[ curTable ][ keyClass ]
  653                                     [ states[curTable]*MaxProcs+2 ], 0,
  654                                     nextState ) THEN
  655          RETURN( nextState );
  656        ELSE
  657          RETURN( ErrorState );
  658        END; (* if stateTable *)
  659      END GetNextState; (* procedure *)
  660  
  661    BEGIN (* procedure KeyAction *)
  662      (* index into the state table to pick up the two action characters *)
  663      procLetters[0] := stateTable[ curTable ][ keyClass ]
  664                                  [ states[curTable]*MaxProcs ];
  665      procLetters[1] := stateTable[ curTable ][ keyClass ]
  666                                  [ states[curTable]*MaxProcs+1 ];
  667      IF states[ curTable ] = ErrorState THEN
  668        (* This is an internal error *)
  669        Spkr.Noise( Spkr.Beep, Spkr.RealHigh, Spkr.Long );
  670        BlankOutField( 0 );
  671        curPos := 0;
  672        ComputeNextState;
  673      ELSE
  674  
  675        (* Ever optimistic, set up the series of edit tests *)
  676        passedTests := TRUE;
  677        (* Execute all the procs called for in the state table *)
  678        FOR whichLetter := 0 TO MaxProcs-2 DO
  679          CASE procLetters[ whichLetter ] OF
  680            'A' : MinusOK;               (* MPLD *)
  681                  PresentChar;
  682                  LeftCurrency;
  683                  DigitToLeft; |
  684            'B' : MinusOK;               (* MP *)
  685                  PresentChar; |
  686            'C' : MinusOK;               (* MPLDZ *)
  687                  PresentChar;
  688                  LeftCurrency;
  689                  DigitToLeft;
  690                  PeriodToTheLeft; |
  691            'D' : DigitToLeft; |
  692            'E' : ErrorInKeyStroke; |
  693            'F' : MinusOK;               (* MPD *)
  694                  PresentChar;
  695                  DigitToLeft; |
  696            'G' : PeriodOK;              (* YP *)
  697                  PresentChar; |
  698            'H' : PeriodOK;              (* YPR *)
  699                  PresentChar;
  700                  RightCurrency; |
  701            'I' : InsertCharacter; |
  702            'J' : PresentChar;           (* PD *)
  703                  DigitToLeft; |
  704            'K' : PresentChar;           (* PDZ *)
  705                  DigitToLeft;
  706                  PeriodToTheLeft; |
  707            'L' : LeftCurrency; |
  708            'M' : MinusOK; |
  709            'P' : PresentChar; |
  710            'R' : RightCurrency; |
  711            'W' : WithinDecimalPlaces; |
  712            'Y' : PeriodOK; |
  713            'Z' : PeriodToTheLeft; |
  714            ' ' : ;                             (* do nothing on blank *)
  715          ELSE
  716            ErrorInKeyStroke;
  717          END; (* case ord *)
  718        END; (* for whichLetter *)
  719        escapeHit := FALSE;                     (* after a real character *)
  720        states[ curTable ] := GetNextState();   (* one change per keystroke *)
  721      END; (* if states *)
  722    END KeyAction; (* procedure *)
  723  
  724  
  725  (*
  726    Here is the start of ReadNumericField, proper.
  727  *)
  728  BEGIN
  729    (* First we make sure the FieldWidth is okay. *)
  730    IF FieldWidth = 0 THEN
  731      FieldWidth := HIGH( TheStr ) + 1;
  732    ELSE
  733      FieldWidth := Numbers.Min( HIGH(TheStr) + 1, FieldWidth );
  734    END;
  735    FieldWidth := Numbers.Min( VWindows.EndCol(WindowHandle) - col1,
  736        FieldWidth );
  737    SavedHeight := VWindows.GetCursorHeight(WindowHandle);
  738    IF UserOps.InsertMode THEN
  739      VWindows.SetCursorHeight( WindowHandle, 6 )
  740    ELSE
  741      VWindows.SetCursorHeight( WindowHandle, 2);
  742    END;
  743  
  744    fieldEnd := FieldWidth - 1;
  745    (* save the original string.  ESC key will restore *)
  746    StrEdit.AssignStr( TheStr, originalStr );
  747    (* set the original states *)
  748    states[ InputTable ] := 0;
  749    states[ EditOverTable ] := 0;
  750    states[ EditInsertTable ] := 0;
  751    editInProgress := FALSE;     (* must first hit editing key to start *)
  752    escapeHit := TRUE;           (* allow esc exit until another key *)
  753    IF DecimalPlaces = 0 THEN    (* Note: Real numbers with 0 decimal places *)
  754      periodOK := FALSE;         (*   cannot have a decimal point in them. *)
  755    ELSE
  756      periodOK := TRUE;
  757    END; (* if DecimalPlaces *)
  758    (* initially in input mode unless there is something already there. *)
  759    curPos := 0;                     (* appropriate for new entry *)
  760    curTable := InputTable;          (* will be adjusted if required *)
  761  
  762    REPEAT
  763      VWindows.DrawStr( WindowHandle, col1, row1, SYSTEM.ADR(TheStr), 0 );
  764      VWindows.GotoXY( WindowHandle, col1 + curPos, row1 );
  765      LastKey := KbdInput.KeyHit( KbdInput.AnyKeyNum );
  766  
  767      IF NOT editInProgress THEN
  768        (* completely different actions until "editing" key hit. *)
  769        CASE LastKey OF
  770            Key.Home, Key.End, Key.Right, Key.Del, Key.Ins:
  771            StrEdit.LeftJustify( TheStr, FieldWidth );
  772            editInProgress := TRUE;
  773          | Key.AltD, Key.AltE, Key.Space:
  774            (* perform action in the next section *)
  775            editInProgress := TRUE;
  776          | ZeroKey..NineKey, Minus, DecimalKey, DollarSignKey :
  777            BlankOutField( 0 );
  778            editInProgress := TRUE;
  779            ComputeNextState;
  780        ELSE
  781          IF NOT BigSets.InSet( ExitKeys, LastKey ) THEN
  782            Spkr.Noise( Spkr.Beep, Spkr.Normal, Spkr.Short );
  783          END; (* if NOT *)
  784        END; (* case Lastkey *)
  785      END; (* if NOT *)
  786  
  787      IF editInProgress THEN
  788        CASE LastKey OF
  789          ZeroKey..NineKey: (* ASCII values of zeroChar to '9' *)
  790            KeyAction( DigitsClass );
  791            IF curTable # InputTable THEN
  792              ComputeNextState;
  793            END;  (* if curtable *)
  794          | Minus: (* minusChar *)
  795            KeyAction( MinusClass );
  796            IF curTable # InputTable THEN
  797              ComputeNextState;
  798            END;  (* if curtable *)
  799          | DecimalKey:
  800            KeyAction( DecimalPointClass );
  801            IF curTable # InputTable THEN
  802              ComputeNextState;
  803            END;  (* if curtable *)
  804          | DollarSignKey:
  805            KeyAction( DollarClass );
  806            IF curTable # InputTable THEN
  807              ComputeNextState;
  808            END;  (* if curtable *)
  809  
  810          | Key.Ins:
  811            UserOps.InsertMode := NOT UserOps.InsertMode;
  812            IF UserOps.InsertMode THEN
  813              VWindows.SetCursorHeight( WindowHandle, 6 )
  814            ELSE
  815              VWindows.SetCursorHeight( WindowHandle, 2);
  816            END;
  817          | Key.Del:
  818            DeleteCharacter;
  819            ComputeNextState;
  820            LastKey := 0;              (* Don't want it seen as exit key *)
  821          | Key.BackSpace:
  822            IF LeftMove() THEN
  823              DeleteCharacter;
  824              ComputeNextState;
  825            END; (* if LeftMove *)
  826          | Key.Left:            (* left arrow *)
  827            LastKey := 0;        (* prevent leaving field *)
  828            IF LeftMove() THEN
  829              ComputeNextState;
  830            END; (* if LeftMove *)
  831          | Key.Right:           (* right arrow *)
  832            LastKey := 0;        (* prevent leaving field *)
  833            RightMove;
  834            ComputeNextState;
  835          | Key.Escape:
  836            IF NOT escapeHit THEN          (* second escape gets out of frame *)
  837              PreviousContents;           (* restore original value *)
  838              ComputeNextState;
  839              escapeHit := TRUE;
  840              LastKey := 0;               (* prevent frame exit *)
  841              editInProgress := FALSE;    (* and take out of edit mode *)
  842            ELSE
  843              StrEdit.RightJustify( TheStr, FieldWidth );      (* allow exit *)
  844            END; (* if not escapeHit *)
  845          | Key.Home:
  846            curPos := 0;                   (* move to leftmost char in field *)
  847            ComputeNextState;
  848          | Key.End:
  849            FirstSpaceOrEnd;               (* put cursor after/on last char *)
  850            ComputeNextState;
  851          | Key.AltD, Key.Space:           (* delete entire entry *)
  852            BlankOutField( 0 );
  853            curPos := 0;
  854            ComputeNextState;
  855          | Key.AltE:                      (* erase from cursor to field end *)
  856            BlankOutField( curPos );
  857            ComputeNextState;
  858  
  859        ELSE
  860          IF NOT BigSets.InSet( ExitKeys, LastKey ) THEN
  861            Spkr.Noise( Spkr.Beep, Spkr.Normal, Spkr.Short );
  862          ELSE  (* always clean up before you can leave - might fail! *)
  863            (* CleanUpTheStr will change LastKey if it fails - prevent exit. *)
  864            IF NOT CleanUpTheStr() THEN
  865              ComputeNextState;
  866            ELSE
  867              StrEdit.RightJustify( TheStr, FieldWidth );
  868            END; (* if NOT *)
  869          END; (* if NOT *)
  870        END;
  871      END; (* if editInProgress *)
  872    UNTIL BigSets.InSet( ExitKeys, LastKey );
  873    VWindows.SetCursorHeight( WindowHandle, SavedHeight );
  874  END ReadNumericField;
  875  
  876  PROCEDURE LoadTableRow
  877            (    inputStr    : ARRAY OF CHAR;    (* action string for input *)
  878                 overStr     : ARRAY OF CHAR;    (* string for overstrike  *)
  879                 insertStr   : ARRAY OF CHAR;    (* string for insert mode *)
  880                 keyClass    : KeyClassType      (* second dimension of table *)
  881            );
  882    (* Loads the three action strings into the state table array *)
  883    (* Used to initialize the array *)
  884  BEGIN (* procedure LoadTableRow *)
  885    StrEdit.AssignStr( inputStr,  stateTable[ InputTable ]      [ keyClass ] );
  886    StrEdit.AssignStr( overStr,   stateTable[ EditOverTable ]   [ keyClass ] );
  887    StrEdit.AssignStr( insertStr, stateTable[ EditInsertTable ] [ keyClass ] );
  888  END LoadTableRow; (* procedure *)
  889  
  890  PROCEDURE InitStateTable;
  891    (* Initialize the state table; called once when field entered *)
  892    (* Invoke from the initialization section of the module *)
  893  BEGIN (* procedure InitStateTable *)
  894    LoadTableRow( " I1 I1 I5 I3WI4 I5", " I RI  I  I ", " I  E  E  I ",
  895                                                   DigitsClass );
  896    LoadTableRow( "MI2 E  E  E  E  E ", "AI MI BI AI ", "CI  E FI AI ",
  897                                                   MinusClass );
  898    LoadTableRow( "YI4YI4YI4YI4 E YI4", "GI HI GI YI ", "GI  E  E  E ",
  899                                                   DecimalPointClass );
  900    LoadTableRow( " I3 E  I3 E  E  E ", "JI PI  I JI ", "KI  E  E JI ",
  901                                                   DollarClass );
  902  END InitStateTable; (* procedure *)
  903  
  904  
  905    PROCEDURE Init();
  906      BEGIN
  907        IF Initialized THEN
  908          RETURN;
  909        ELSE
  910          Initialized := TRUE;
  911        END;
  912        BigSets.Init();
  913        ErrorManager.Init();
  914        KbdInput.Init();
  915        Key.Init();
  916        LowLevel.Init();
  917        M2Strings.Init();
  918        Numbers.Init();
  919        PosUtils.Init();
  920        ScrnTypes.Init();
  921        Spkr.Init();
  922        StrConv.Init();
  923        StrEdit.Init();
  924        UserOps.Init();
  925        VWindows.Init();
  926  
  927        InitStateTable();            (* load the table with action strings *)
  928      END Init;
  929  
  930  BEGIN
  931    Initialized := FALSE;
  932    Init();
  933  END NumInput.

    2 errors