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