Power-Programmierung

home *** CD-ROM | disk | FTP | other *** search

/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / source / jb_edit.seq < prev next >

Wrap

Text File | 1990-04-20 | 14.3 KB | 339 lines

\ File: JB#EDIT.SEQ \ Original Date: September 12, 1988 \ Last Modified: April 20, 1990 \ Author: Jack W. Brown \ Function: Single, Double, and Floating Variable editing \ and numeric input. \ Note: Floating point operators assume VP-Planner floating \ point routines are loaded. VPSFP101.ZIP or later. CR .( Requires VP-Planner Floating point to be loaded. ) \ ┌────────────────────────────────────────────────────────────────────┐ \ │ Description │ \ ├────────────────────────────────────────────────────────────────────┤ \ │ One characteristic ( perhaps novel ) of these operators is │ \ │ that they take the address of a variable ( single, double or │ \ │ floating ) and allow the user to edit the contents of the │ \ │ variable. │ \ │ │ \ │ VARIABLE A 123 A ! followed by: │ \ │ A S#ED would display 123 on the screen │ \ │ in a default field 6 spaces wide. │ \ │ │ \ │ User could then edit or modify the number and upon pressing │ \ │ return the changed value would be automatically stored back │ \ │ in the VARIABLE A │ \ │ │ \ │ 2VARIABLE B 123.45 B 2! followed by: │ \ │ B D#ED would do the same for doubles in │ \ │ a default field 12 wide. │ \ │ │ \ │ FVARIABLE C 1.56E-4 C F! followed by: │ \ │ C F#ED would do the same for floating │ \ │ point with 12 the default field. │ \ │ │ \ │ A similar family of words, WS#ED , WD#ED , and WF#ED │ \ │ allowed the user to specify his own field width, and yet │ \ │ another family of words, XYWS#ED , XYWD#ED , and XYWF#ED │ \ │ allow users to specify the column X , row Y , and the width W. │ \ │ │ \ │ Here is the whole family: adr = variable address, x is cursor │ \ │ column, y is cursor row, and w is input field width. │ \ │ │ \ │ S#ED ( adr -- ) WS#ED ( adr w -- ) XYWS#ED ( adr x y w -- ) │ \ │ D#ED ( adr -- ) WD#ED ( adr w -- ) XYWD#ED ( adr x y w -- ) │ \ │ F#ED ( adr -- ) WF#ED ( adr w -- ) XYWF#ED ( adr x y w -- ) │ \ │ │ \ │ Using the above operators it is a simple mater to implement │ \ │ a more traditional set of operators that leave their input on │ \ │ on the parameter or floating point stack. │ \ │ │ \ │ S#IN ( -- n ) WS#IN ( w -- n ) │ \ │ XYWS#IN ( x y w -- n ) │ \ │ D#IN ( -- dn) WD#IN ( w -- dn) │ \ │ XYWD#IN ( x y w -- dn) │ \ │ │ \ │ Floating point input operators left values on the floatinng │ \ │ point stack. │ \ │ parameter stack floating point stack │ \ │ F#IN ( P: -- ) ( F: -- r ) │ \ │ WF#IN ( P: w -- ) ( F: -- r ) │ \ │ XYWF#IN ( P: x y w -- ) ( F: -- r ) │ \ └────────────────────────────────────────────────────────────────────┘ ONLY FORTH ALSO DEFINITIONS CREATE TPAD 34 ALLOT TPAD 34 BLANK CREATE SNUM 10 ALLOT \ Scratch variable of ????IN operators. \ Leave a true flag if string begins with a -ve sign. \ Note we assume a counted string!! adr is 1 less than the \ the first string character. : ANY-SIGN? ( adr -- adr' flag ) DUP 1+ C@ DUP ASCII - = \ Increment adr , check for - IF DROP 1+ TRUE \ Leave true flag if found. ELSE ASCII + = \ Allow a +sign if desired. IF 1+ THEN \ Increment past + sign FALSE \ and leave false flag. THEN ; \ Move up to first non blank of string. Actually adr' points \ to position before first non blank!! : SKIP-BLANKS ( adr -- adr' ) BEGIN 1+ DUP C@ BL <> UNTIL 1- ; \ Set cursor from 16 bit hi-x lo-y format. : CUR! ( xy -- ) SPLIT AT ; \ Fetch cursor to 16 bit form. : CUR@ ( -- xy ) IBM-AT? FLIP + ; \ This character will fill unused digit posn 254 CONSTANT CHFL \ This routine edits a counted string and converts to double number. \ cur is cursor x y packed into one word. \ We are using F-PC's LINEEDITOR ( x y a n -- flag ) : ED_CONVERT ( adr n cur -- cur adr n dn ) BEGIN DUP >R \ a n c Position cursor. -ROT R> SPLIT 2OVER \ c a n x y a n LINEEDITOR DROP \ c a n Edit string. OVER SKIP-BLANKS \ c a n Move up to non-blank ANY-SIGN? \ c a n a' flg >R 0 0 ROT -1 \ c a n dn a' -1 BEGIN DPL ! CONVERT \ c a n dn a" DUP C@ ASCII . = \ c a n dn a" flg WHILE 0 REPEAT \ c a n dn a" 0 C@ DUP CHFL = SWAP BL = OR NOT \ c a n dn flag WHILE 2DROP R> DROP BEEP \ c a n ASCII ? 2 PICK 1+ C! ROT \ a n c marks error REPEAT R> ?DNEGATE \ c a n dn DPL @ 0< IF DPL OFF THEN ; \ DPL=0 if .pt not entered \ Fetch a double number using field with of n using adr for \ and input buffer. Invalid input is marked by ? and user is \ required to repeat until he makes a valid number. : (#ED) ( adr n -- dn ) CUR@ ED_CONVERT \ cur adr n dn >R >R \ Save double number. 1+ ROT + CUR! \ Restore cursor. DROP R> R> ; \ Recover our number. \ ┌───────────────────────────────────────────────────────┐ \ │ 32 bit Variable Editing and 32 bit numeric input. │ \ └───────────────────────────────────────────────────────┘ \ As above but field width is specified on the stack. : WD#ED ( adr w -- ) >R TPAD 1+ 32 CHFL FILL \ blank input field. R@ TPAD C! DUP 2@ 2DUP D0= \ Is number 0 ? IF 2DROP \ if so provide blank field ELSE TUCK DABS \ other wise <# #S ROT SIGN #> \ format number and move TPAD 1+ SWAP R@ \ to the edit buffer. MIN CMOVE THEN TPAD R> (#ED) ROT 2! ; \ Edit double number at current cursor position using default \ field with of 12. Input buffer is at TPAD : D#ED ( adr -- ) 12 WD#ED ; \ As above but cursor & field width are specified on the stack. : XYWD#ED ( adr x y w -- ) -ROT AT WD#ED ; \ Input double number with field width on stack \ and leave resulting double number on the parameter stack. : WD#IN ( w -- dn ) 0 0 SNUM 2! SNUM SWAP WD#ED SNUM 2@ ; \ Input double number and leave on parameter stack. : D#IN ( -- dn ) 12 WD#IN ; \ Input double number at cursor postion x y using a field width w \ and leave the resulting double number on the parameter stack. : XYWD#IN ( x y w -- dn ) -ROT AT WD#IN ; \ ┌───────────────────────────────────────────────────────┐ \ │ 16 bit Variable Editing and 16 bit Numeric Input. │ \ └───────────────────────────────────────────────────────┘ \ As above but field width is specified on the stack. : WS#ED ( adr w -- ) >R TPAD 1+ 32 CHFL FILL \ blank input field. R@ TPAD C! DUP @ DUP 0= \ Is number 0 ? IF DROP \ if so provide blank field ELSE S>D TUCK DABS \ other wise <# #S ROT SIGN #> \ format number and move TPAD 1+ SWAP R@ \ to the edit buffer. MIN CMOVE THEN TPAD R> (#ED) DROP SWAP ! ; \ Edit single number a current cursor position using default \ field with of 6. Edit buffer is at TPAD : S#ED ( adr -- ) 6 WS#ED ; \ As above but cursor & field width are specified on the stack. : XYWS#ED ( adr x y n -- ) -ROT AT WS#ED ; \ Input single number with field width on stack \ and leave resulting single number on the parameter stack. : WS#IN ( w -- n ) 0 SNUM ! SNUM SWAP WS#ED SNUM @ ; \ Input single number in a default field 6 wide \ and leave on parameter stack. : S#IN ( -- n ) 6 WS#IN ; \ Input single number at cursor postion x y using a field width w \ and leave the resulting single number on the parameter stack. : XYWS#IN ( x y w -- n ) 0 SNUM ! ROT SNUM SWAP 2SWAP XYWS#ED SNUM @ ; \ ┌────────────────────────────────────────────────────────────────────┐ \ │ Floating point varialbe editing and floating point numeric input. │ \ └────────────────────────────────────────────────────────────────────┘ HEX \ This routine edits a counted string and converts it to a double number. \ cur is cursor x y packed into one word. : ED_FCONVERT ( adr n cur -- cur adr n dn ) BEGIN DUP >R \ a n c Position cursor. -ROT R> SPLIT 2OVER \ c a n x y a n LINEEDITOR DROP \ c a n Edit string. OVER COUNT + BL SWAP C! \ FIX OVER SKIP-BLANKS \ c a n Move up to non-blank ANY-SIGN? \ c a n a' flg / sgn[dn] >R 0 0 ROT 8000 \ c a n |dn| a' -1 BEGIN DPL ! FCONVERT \ c a n |dn| a" DUP C@ ASCII . = \ c a n |dn| a" flg WHILE 0 REPEAT \ c a n |dn| a" 0 DUP C@ 0DF AND \ Allow lower case e for exponent. ASCII E = \ c a n |d| a3 f2 / sgn[dn] IF DPL @ 0 MAX >R \ c a n |d| a3 f2 / DPL sgn[dn] ANY-SIGN? >R \ c a n |d| a3 f2 / sgn[exp] DPL sgn[dn] DUP C@ \ c a n |dn| a5 c / sgn[exp] DPL sgn[dn] DUP CHFL = SWAP BL = OR IF R> R> 2DROP \ c a n |dn| a5 / sgn[D] ELSE DBL0 ROT FCONVERT \ c a n |dn| de a6 / sgn[de] DPL sgn[dn] NIP SWAP R> NOT ?NEGATE R> + DPL ! \ c a n |dn| a6 / sgn[dn] THEN THEN \ c a n |dn| a7 / sgn[dn] C@ DUP CHFL = SWAP BL = OR NOT \ c a n |dn| flag / sgn[dn] WHILE 2DROP R> DROP BEEP \ c a n ASCII ? 2 PICK 1+ C! ROT \ a n c Mark error REPEAT R> ?DNEGATE \ c a n dn DPL @ 8000 = IF DPL OFF THEN ; \ DPL=0 if .pt not entered DECIMAL \ Fetch a floating number using field with of n using adr for \ and input buffer. Invalid input is marked by ? and user is \ required to repeat until he makes a valid number. : (#FED) ( P: adr n -- ) ( F: -- r ) CUR@ ED_FCONVERT \ cur adr n dn >R >R \ Save double number. 1+ ROT + CUR! \ Restore cursor. DROP R> R> FLOAT ; \ Recover our number. \ Edit double number at current cursor position using field with \ field with of w. Input buffer is at TPAD : WF#ED ( adr w -- ) >R TPAD 1+ 32 CHFL FILL R@ TPAD C! DUP F@ FDUP F0= IF FDROP ELSE FDUP R@ 2- (..) ?DUP 0= IF DROP ?NONAN1 IF R@ 6 - (E.) ELSE (.NAN) THEN ELSE FDROP THEN \ adr adr" len TPAD 1+ SWAP R@ MIN CMOVE THEN TPAD R> (#FED) F! ; \ Edit floating number at current cursor position using default \ field with of 16. Input buffer is at TPAD : F#ED ( adr -- ) 16 WF#ED ; \ As above but cursor & field width are specified on the stack. : XYWF#ED ( adr x y w -- ) -ROT AT WF#ED ; \ Input floating point number with field width on stack \ and leave resulting floating point number on the floating point stack. : WF#IN ( P: w -- ) ( F: -- r ) 0. SNUM F! SNUM SWAP WF#ED SNUM F@ ; \ Input floating point number and leave on floating point stack. : F#IN ( F: -- r ) 16 WF#IN ; \ Input floating point number at cursor postion x y using a field width w \ and leave the resulting floating point number on the floating point stack. : XYWF#IN ( P: x y w -- ) ( F: -- r ) -ROT AT WF#IN ; comment: VARIABLE SS 123 SS ! DOUBLE 2VARIABLE DD 123.45 DD 2! FLOATING FVARIABLE FF 123.45 FF F! : TEST ( -- ) CLS CR ." Testing single variable editing." CR SS S#ED ( adr -- ) SS @ . CR SS 8 WS#ED ( adr w -- ) SS @ . CR SS 40 10 8 XYWS#ED ( adr x y w -- ) SS @ . CLS CR ." Testing double variable editing." CR DD D#ED ( adr -- ) DD 2@ D. CR DD 8 WD#ED ( adr w -- ) DD 2@ D. CR DD 40 10 8 XYWD#ED ( adr x y w -- ) DD 2@ D. CLS CR ." Testing floating point variable editing." CR FF F#ED ( adr -- ) FF F@ .. CR FF 12 WF#ED ( adr w -- ) FF F@ .. CR FF 40 10 12 XYWF#ED ( adr x y w -- ) FF F@ .. ; comment;