home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / source / jbledit.seq < prev    next >
Text File  |  1990-04-27  |  21KB  |  581 lines
  1. \ File:          JBLEDIT.SEQ
  2. \ Original Date: November 23, 1985
  3. \ Last Modified: October 3, 1988
  4. \ Program:       LEDIT - A DOSEDIT style line editor for Forth.
  5. \ Author:        Jack Brown
  6. \ Function:      Can be used as a replacement for EXPECT or for
  7. \                string input.
  8.  
  9. \ Modification History:
  10. \ JWB 03 10 88  Converted from L&P F83 Screens to F-PC *.SEQ file.
  11. \ JWB 04 22 90  Verified operational with F-PC 3.5
  12.  
  13. \ Line editor variables                        09:49JWB02/07/86
  14.  
  15. ONLY FORTH ALSO DEFINITIONS
  16. VARIABLE %MOD   \ Type-over/Insert flag.   True=Insert.
  17. VARIABLE %BUF   \ Address of line buffer.
  18. VARIABLE %MLEN  \ Length of line buffer.
  19. VARIABLE %OFF   \ Offset to start of line.
  20. VARIABLE %ROW   \ Current row or vertical position on screen.
  21. VARIABLE %POS   \ Current position in the line.
  22. VARIABLE %DONE  \ Finished flag.  If true then quit.
  23. VARIABLE LKEY   \ Last key code pressed.
  24.  
  25.  
  26. \ #R  POS@                                     09:49JWB02/07/86
  27. : #R    ( -- n )  \ Leave n, characters to right of cursor.
  28.         %MLEN @    \ Fetch length of line buffer.
  29.         %POS @     \ Fetch current cursor position.
  30.         - ;        \ Subtract leaving number of characters to
  31.                    \ right of cursor.
  32.  
  33. : POS@  ( -- adr ) \ Leave address of current cursor position.
  34.         %BUF @     \ Fetch address of line buffer.
  35.         %POS @     \ Fetch current cursor position.
  36.         + ;        \ Add leaving current address of cursor.
  37.  
  38.  
  39. \ CUR                                          09:49JWB02/07/86
  40. : CUR   ( row col -- ) \ Position cursor at  (col,row)
  41.         80 MOD          \ Calculate column position.
  42.         SWAP            \ Bring row to top of stack.
  43.         25 MOD          \ Calculate row position.
  44.         AT ;        \ Word that positions cursor.
  45.  
  46.  
  47. \ .POS                                         09:49JWB02/07/86
  48. : .POS  ( -- ) \ Move cursor to its current position.
  49.         %POS @      \ Fetch current position in line.
  50.         %MLEN @     \ Fetch length of line buffer.
  51.         MOD         \ Divide leaving cursor position.
  52.         %OFF @ +    \ Fetch offset to start of line and add
  53.                     \ to cursor position.
  54.         %ROW @      \ Fetch current row.
  55.         SWAP        \ Put (col,row) in proper order for CUR
  56.         CUR ;       \ Position cursor at (col,row).
  57.  
  58.  
  59. \ !POS  +POS                                   09:49JWB02/07/86
  60. : !POS  ( n -- ) \ Set current position to n.
  61.         %MLEN @ MOD   \ Take top stack value and divide by
  62.                       \ length of line buffer, leaving remainder
  63.         %POS ! ;      \ which is stored at current position in
  64.                       \ line.
  65.  
  66. : +POS  ( n -- ) \ Increment current position by n.
  67.         %POS @ +      \ Fetch current position in line and add
  68.         !POS ;        \ value "n" to it. Store back at current
  69.                       \ position in line.
  70.  
  71. \ +.POS  HOM                                   09:49JWB02/07/86
  72. : +.POS ( n -- ) \ Increment by n and display at new location
  73.         +POS        \ Increments current position by "n"
  74.         .POS ;      \ Moves cursor to its current position.
  75.  
  76. : HOM   ( -- )     \ To begining of line, type-over mode.
  77.         %POS OFF    \ Set current position in line to zero.
  78.         .POS        \ Move cursor to current position in line.
  79.         %MOD OFF ;  \ Set insert mode to false.
  80.  
  81.  
  82. \ !CHAR  ECHO                                  09:49JWB02/07/86
  83. : !CHAR ( char -- )   \ Store character at current position.
  84.         POS@ C!     \ Fetch address of current cursor position
  85.                     \ and store character there.
  86.         1 +.POS ;   \ Increment cursor position by one and
  87.                     \ display at new location.
  88.  
  89. : ECHO  ( char -- )   \ Echo character and store character.
  90.         DUP  (CONSOLE)  \ Output character to console device.
  91.         !CHAR ;         \ Store character at current position.
  92.  
  93.  
  94. \ CTYPE                                        09:49JWB02/07/86
  95. : CTYPE  ( adr cnt -- ) \ Send string to console only.
  96.         0 ?DO           \ Set up loop with character count.
  97.             COUNT       \ Fetch char from adr and increment
  98.                         \ adr by one.
  99.             (CONSOLE)   \ Output char to current console device.
  100.           LOOP          \ Loop back.
  101.           DROP ;        \ Clean up stack.
  102.  
  103.  
  104. \ .LIN                                         09:49JWB02/07/86
  105. : .LIN  ( -- )     \ Update entire line.
  106.         %POS @     \ Fetch current position in line.
  107.         HOM        \ Move cursor to beginning of line.
  108.         %BUF @     \ Fetch address of line buffer.
  109.         %MLEN @    \ Fetch length of line buffer.
  110.         CTYPE      \ Output entire line buffer to console.
  111.         %POS !     \ Restore previous cursor position in line
  112.         .POS   ;   \ and move cursor to the current position.
  113.  
  114.  
  115. \ RUB                                          09:49JWB02/07/86
  116. : RUB   ( -- )     \ Rub out character behind cursor.
  117.         -1 +.POS     \ Decrement current cursor position by one
  118.         BL  ECHO     \ Store a blank and echo to console.
  119.         -1 +.POS ;   \ Echo incremented cursor position by one
  120.                      \ so we must decrement by one again.
  121.  
  122.  
  123. \ MEOL                                         09:49JWB02/07/86
  124. : MEOL  ( -- )     \ Move to end of line.
  125.         %BUF @ %MLEN @  \ Get address and length of line buffer.
  126.         -TRAILING       \ Leave length excluding trailing spaces
  127.         %MLEN @ 1- MIN  \ Leave line buffer length minus one
  128.                         \ or string length whichever is smaller.
  129.         !POS DROP .POS  \ Move cursor to that position.
  130.         %MOD OFF ;      \ Turn off insert mode.
  131.  
  132.  
  133. \ DEOL  DEALL                                  09:49JWB02/07/86
  134. : DEOL  ( -- )     \ Delete to end of field.
  135.         POS@  #R   \ Get cursor position leaving number of
  136.                    \ characters to right of cursor.
  137.         BL FILL    \ Blanks from right of cursor to end of line.
  138.         .LIN ;     \ Update entire line.
  139.  
  140. : DEALL ( -- )     \ Delete entire line.
  141.         %BUF @ %MLEN @  \ Get address and length of line buffer.
  142.         BL FILL         \ Fill line with blanks.
  143.         .LIN            \ Update entire line.
  144.         HOM ;           \ Move cursor to beginning of line.
  145.  
  146.  
  147. \ DCHAR                                        09:49JWB02/07/86
  148. \ Delete character at cursor position and close gap created.
  149. : DCHAR ( -- )
  150.         POS@ 1+ POS@              \ From adr and To adr
  151.         #R MOVE                   \ Number to move, move string
  152.         BL %BUF @ %MLEN @ 1- + C! \ Put blank in line buf at eol
  153.         POS@ #R -TRAILING         \ Cursor position and number of
  154.                                   \ char less trailing blanks.
  155.         1+ CTYPE                  \ Add one to cursor and send
  156.         .POS ;                    \ string to console. Move cursor
  157.                                   \ to current position.
  158.  
  159.  
  160. \ ICHAR                                        09:49JWB02/07/86
  161. \ Insert character char  at current position and update display.
  162. : ICHAR ( char -- )
  163.         #R >R POS@ DUP R@ + 1- C@ BL =  \ Blank at end of line?
  164.         IF   DUP 1+  R@ 1-      \ Yes, set up from adr to adr.
  165.              MOVE POS@ C!       \ Move string, insert character.
  166.              POS@ R@ -TRAILING  \ Strip off trailing blanks.
  167.              CTYPE   1 +.POS    \ Output to console and move
  168.                                 \ cursor one to right.
  169.         ELSE BEEP 2DROP         \ No, beep then clean up stack.
  170.         THEN R> DROP ;          \ Clean up return and parameter
  171.                                 \ stack.
  172.  
  173. : LITTLE-CURSOR  NORM-CURSOR ;
  174.  
  175. \ OVER-STRIKE  INSERT                          09:49JWB02/07/86
  176. : OVER-STRIKE ( -- )  \ Set over-strike mode.
  177.   %MOD @ IF             \ If insert mode then
  178.   LITTLE-CURSOR         \ set cursor to small
  179.   %MOD OFF              \ set over-strike mode
  180.   THEN ;                \ otherwise continue.
  181.  
  182. : INSERT     ( -- )   \ Set insert mode.
  183.   %MOD @ NOT IF         \ If over-strike mode then
  184.   BIG-CURSOR            \ set cursor to large
  185.   %MOD ON               \ set insert mode
  186.   THEN ;                \ otherwise continue.
  187.  
  188.  
  189. \ L-ARROW  R-ARROW  CLR                        09:49JWB02/07/86
  190. : L-ARROW  ( -- )      \ Move cursor left one position.
  191.         -1 +.POS OVER-STRIKE ;
  192.  
  193. : R-ARROW  ( -- )      \ Move cursor right one position.
  194.         1 +.POS OVER-STRIKE ;
  195.  
  196. : CLR  ( -- )          \ Clear screen, & redisplay at home.
  197.   DARK (  0 0 79 24 15 INIT-WINDOW )  \ Clear screen.
  198.   %ROW OFF   .LIN ;        \ Update entire first line.
  199.  
  200.  
  201. \ INSS  +TRANS   -TRANS                        10:05JWB02/07/86
  202. : INSS ( -- )          \ Insert/overstrike  toggle.
  203.    %MOD @ IF  OVER-STRIKE  ELSE  INSERT THEN ;
  204.  
  205. : +TRANS ( -- )    \
  206.         %POS @ %MLEN @ 1- <     \ Cursor at end of line?
  207.         IF  POS@  @ 256 /MOD    \ Transpose two char at cursor.
  208.             ECHO  ECHO          \ Echo and store both char.
  209.             L-ARROW             \ Reposition cursor.
  210.         THEN ;                  \
  211.  
  212. : -TRANS ( -- )
  213.         %POS @
  214.         IF -1 +.POS  +TRANS L-ARROW  THEN ;
  215.  
  216.  
  217. \ BK.PTR  PR.PTR                               09:50JWB02/07/86
  218. 256 CONSTANT BK.SIZE    \ Size of command line backup buffer.
  219.     VARIABLE BK.PTR     \ Pointer to top of backup buffer.
  220.     VARIABLE PR.PTR     \ Pointer to previous line in bkup buf.
  221.     CREATE   BK.BUF  BK.SIZE ALLOT    \ This is the backup buf.
  222.  
  223. \ Leave address of the top of the backup buffer.
  224. : BK.ADR ( -- adr )
  225.         BK.BUF  BK.PTR @ + ;
  226.  
  227. \ Increment pointer to top of backup buffer by n.
  228. : +BK.PTR ( n -- ) BK.PTR +! ;
  229.  
  230. \ Leave address of the previous line.
  231. : PR.ADR ( --  adr )
  232.         BK.BUF  PR.PTR @ + ;
  233.  
  234. \ Increment pointer to previous line by n.
  235. : +PR.PTR ( n -- )  PR.PTR +! ;
  236.  
  237.  
  238. \ DELETE-1ST-LINE  NO-ROOM?  MAKE-ROOM         09:50JWB02/07/86
  239. \ Delete first line in backup buffer and adjust pointer counts.
  240. : DELETE-1ST-LINE ( -- )
  241.         BK.BUF 1+ C@ 2+ >R
  242.         BK.BUF R@ + BK.BUF  BK.PTR @ R@ - CMOVE
  243.         R> NEGATE DUP +BK.PTR  +PR.PTR  ;
  244.  
  245. \ Leave a true flag if there is no room for string of size n.
  246. : NO-ROOM?  ( n -- flag )
  247.        2+ BK.SIZE  BK.PTR @  -  <  NOT ;
  248.  
  249. \ Delete lines till there is room for string of size n.
  250. : MAKE-ROOM ( n -- )
  251.         BEGIN  DUP  NO-ROOM?
  252.         WHILE  DELETE-1ST-LINE
  253.         REPEAT DROP ;
  254.  
  255.  
  256. \ SAVE-LINE                                    09:50JWB02/07/86
  257.   VARIABLE   RLFLAG
  258. : RLFLAG?  RLFLAG @ ;
  259.  
  260. \ Save current line in the backup buffer.
  261. : SAVE-LINE ( -- )
  262.    %BUF @ %MLEN @ -TRAILING ?DUP        \ adr & count of line
  263.    IF   DUP MAKE-ROOM                   \ Make room if required
  264.         BK.ADR OFF  DUP BK.ADR 1+ C!    \ Save line count.
  265.         TUCK BK.ADR 2+ SWAP CMOVE       \ Move the line.
  266.         2+   +BK.PTR                    \ Update pointers.
  267.         BK.PTR @ PR.PTR !
  268.         RLFLAG  ON
  269.    ELSE DROP  THEN  ;
  270.  
  271.  
  272. \ <LINE   >LINE                                09:50JWB02/07/86
  273. \ Decrement previous line pointer to start of the previous line.
  274. : <LINE    ( -- )
  275.         PR.PTR @ 0 <=                   \ At bottom of bkup buf?
  276.         IF   BK.PTR @ PR.PTR !  THEN    \ If so point to top!!
  277.         BEGIN -1 +PR.PTR  PR.ADR C@     \ Now back up one line.
  278.         0= UNTIL ;
  279.  
  280. \ Increment previous line pointer to start of the next line.
  281. : >LINE    ( -- )
  282.         PR.PTR @  BK.PTR @ <            \ Not at top of bk buf?
  283.         IF BEGIN  1 +PR.PTR  PR.ADR C@  \ Then move forward one
  284.            0= UNTIL                     \ line in bkup buf.
  285.         THEN
  286.         PR.PTR @ BK.PTR @ >=            \ Did we reach the top?
  287.         IF PR.PTR OFF  THEN  ;          \ If so point to bottom.
  288.  
  289.  
  290. \ RECALL-LINE  -RECALL-LINE +RECALL-LINE       11:27JWB11/23/85
  291. \ Move previous line to the editing buffer.
  292. : RECALL-LINE ( -- )
  293.       %BUF @ %MLEN @ BL FILL            \ Clear editing buffer.
  294.       RLFLAG?
  295.       IF    PR.ADR  1+
  296.             COUNT %MLEN @ MIN   \ From adr and count.
  297.             %BUF @ SWAP CMOVE   \ To adr and moveit.
  298.       THEN .LIN MEOL   ;        \ Display & move to end.
  299.  
  300. \ Back up one line and move it to editing buffer.
  301. : -RECALL-LINE ( -- )
  302.    RLFLAG? IF <LINE THEN   RECALL-LINE ;
  303.  
  304. \ Move forward one line then move it to the editing buffer.
  305. : +RECALL-LINE ( --  -- )
  306.    RLFLAG? IF >LINE THEN  RECALL-LINE ;
  307.  
  308. VARIABLE  ATRIB    \ Current character attribute.
  309.  
  310. ALSO POSTFIX
  311. \ Emit character according to current attribute in ATRIB
  312. CODE VEMIT   ( char   -- )
  313.        ATRIB # DI MOV     \ First output a space with
  314.         0 [DI] BX MOV     \ with the color attribute.
  315.         2336 # AX MOV     \ 0920HEX
  316.            1 # CX MOV     \ Number of spaces to output.
  317.                16 INT     \ Bios function call.
  318.                AX POP     \ Fetch character to output.
  319.           14 # AH MOV     \ Now output actual character
  320.                16 INT     \ this time cursor will advance
  321.        #OUT #  DI MOV     \ to the next legal position.
  322.            0 [DI] INC     \ Increment FORTH's character count.
  323.             NEXT    END-CODE
  324.  
  325.  
  326.  
  327. \ Read screen location.  SC@                   18:06JWB11/25/85
  328. CODE  SC@   ( -- char )
  329.         8 #  AH MOV
  330.           BH BH SUB 16 INT AH AH SUB
  331.        128 # AX CMP
  332. U>= IF  32 # AL MOV  THEN
  333.         31 # AX CMP
  334. U<  IF  32 # AL MOV  THEN
  335.                 1PUSH END-CODE
  336. PREVIOUS
  337.  
  338. : CUR@ ( -- rc ) \ Fetch cursor position as 16bit word.
  339.        IBM-AT? 256 * OR ;
  340.  
  341. : CUR! ( rc -- ) \ Restore cursor position, row in hi byte, col in low byte.
  342.        256 /MOD AT ;
  343.  
  344. : +MARK  ( n -- )
  345.         CUR@ 0 ROT  AT ATRIB @ SC@
  346.         112 ATRIB ! VEMIT ATRIB ! CUR! ;
  347.  
  348. : -MARK  ( n -- )
  349.         CUR@ 0 ROT  AT SC@  VEMIT   CUR! ;
  350.  
  351.  
  352. \  READ-SCREEN                                 15:21JWB11/25/85
  353.  VARIABLE SLINE
  354.  
  355. : SINC   SLINE @ 1+   25 MOD SLINE ! ;
  356.  
  357. : SDEC   SLINE @ 24 + 25 MOD SLINE ! ;
  358.  
  359.  CREATE SLINE-BUF   80 ALLOT
  360.  
  361. \ Copy line n of screen into SLINE-BUF .
  362. : READ-SCREEN  ( n -- )
  363.         25 MOD  CUR@ >R
  364.         80 0 DO  I OVER AT SC@
  365.                  SLINE-BUF I + C!
  366.              LOOP  DROP
  367.         R> CUR!  ;
  368.  
  369. \                                              09:50JWB02/07/86
  370. \ Recall next line from screen.
  371. : +RECALL-SLINE  ( -- )
  372.    CURSOR-OFF
  373.    SLINE @ -MARK SINC SLINE @ DUP +MARK READ-SCREEN
  374.    %BUF @ %MLEN @ BL FILL
  375.    SLINE-BUF 79 -TRAILING %MLEN @ MIN %BUF @ SWAP CMOVE
  376.    .LIN  MEOL  LITTLE-CURSOR ;
  377.  
  378. \ Recall previous line from screen.
  379. : -RECALL-SLINE ( -- )
  380.    CURSOR-OFF
  381.    SLINE @ -MARK SDEC SLINE @ DUP +MARK READ-SCREEN
  382.    %BUF @ %MLEN @ BL FILL
  383.    SLINE-BUF 79 -TRAILING %MLEN @ MIN %BUF @ SWAP CMOVE
  384.    .LIN  MEOL LITTLE-CURSOR ;
  385.  
  386.  
  387. \  F-WORD B-WORD                               13:42JWB03/03/87
  388.  : F-WORD  ( -- )
  389.         BEGIN   POS@ C@ BL <>
  390.         WHILE   1 +POS   REPEAT
  391.         BEGIN   POS@ C@ BL =
  392.         WHILE   1 +POS   REPEAT  .POS ;
  393.  
  394.  : B-WORD ( -- )
  395.         BEGIN  POS@ C@ BL <>
  396.         WHILE  -1 +POS  REPEAT
  397.         BEGIN  POS@ C@ BL =
  398.         WHILE  -1 +POS  REPEAT
  399.         BEGIN  POS@ C@ BL <>
  400.         WHILE  -1 +POS  REPEAT
  401.         1 +.POS ;
  402.  
  403. \ Switch lower case character to upper case.
  404. : U-CHAR ( char -- CHAR )
  405.        DUP ASCII a  >=  OVER ASCII z <= AND
  406.        IF  32 -  THEN    ;
  407.  
  408. \ Switch upper case character to lower case.
  409. : L-CHAR ( CHAR -- char )
  410.        DUP ASCII A >= OVER ASCII Z <= AND
  411.        IF  32 +  THEN    ;
  412.  
  413. \ Toggle case of charater.
  414. : T-CHAR ( chAR -- CHar )
  415.        DUP  ASCII a >= OVER ASCII z <= AND
  416.        OVER DUP ASCII A >= SWAP ASCII Z <= AND
  417.        OR IF  32 XOR THEN  ;
  418.  
  419.  
  420. : U-WORD  ( -- )
  421.        %POS @
  422.        BEGIN POS@ C@ BL <>
  423.        WHILE -1 +POS REPEAT
  424.        1 +.POS
  425.        BEGIN POS@ C@ BL <>
  426.        WHILE POS@ C@ U-CHAR ECHO
  427.        REPEAT
  428.        %POS !   .POS  ;
  429.  
  430. : L-WORD ( -- )
  431.        %POS @
  432.        BEGIN POS@ C@ BL <>
  433.        WHILE -1 +POS REPEAT
  434.        1 +.POS
  435.        BEGIN POS@ C@ BL <>
  436.        WHILE POS@ C@ L-CHAR ECHO
  437.        REPEAT
  438.        %POS !   .POS  ;
  439.  
  440.  
  441. : T-WORD ( -- )
  442.        %POS @
  443.        BEGIN POS@ C@ BL <>
  444.        WHILE -1 +POS REPEAT
  445.        1 +.POS
  446.        BEGIN POS@ C@ BL <>
  447.        WHILE POS@ C@ T-CHAR ECHO
  448.        REPEAT
  449.        %POS !   .POS  ;
  450.  
  451.  
  452.  
  453.  
  454. \  D-WORD  F-CHAR                              14:32JWB03/03/87
  455.  : D-WORD ( -- )
  456.         POS@ C@ BL <> IF
  457.         BEGIN  POS@ C@ BL <>
  458.         WHILE  -1 +POS  REPEAT
  459.         1 +POS .POS
  460.         BEGIN  POS@ C@ BL <>
  461.         WHILE  DCHAR
  462.         REPEAT DCHAR  THEN ;
  463.  
  464. \ Wait for keypress without checking the break key.
  465. : {KEY}  ( --  char )
  466.         0 7 BDOS 255 AND ;
  467.  
  468. \ Wait for key press. If flag is true then n is and ascii char code.
  469. \ if flag is false then n is the function key code.
  470. : PCKEY ( -- n flag )
  471.         {KEY}
  472.             ?DUP IF TRUE ELSE {KEY} FALSE THEN ;
  473.  
  474. \                                              14:33JWB03/03/87
  475. \ Clear backup buffer.
  476. : CLR.BK.BUF ( -- )
  477.   RLFLAG  OFF
  478.   BK.BUF BK.SIZE BL FILL
  479.   BK.PTR OFF PR.PTR OFF ;
  480.  
  481.  : F-CHAR  ( -- )
  482.         PCKEY
  483.         IF  %MLEN @ %POS @ 1+
  484.             DO I %BUF @ + C@ OVER =
  485.                IF  I !POS LEAVE THEN
  486.             LOOP  .POS
  487.         THEN DROP ;
  488.  
  489.  
  490. \  RET  PCKEY                                  14:24JWB03/03/87
  491. : DBOL  ( -- )
  492.     SLINE-BUF 80 BL FILL
  493.     POS@ SLINE-BUF #R DUP >R CMOVE
  494.     %BUF @ %MLEN @ BL FILL
  495.     SLINE-BUF %BUF @ R> CMOVE .LIN  HOM ;
  496.  
  497. : RET   ( -- )     \ Finished, move to eol, set %DONE ON
  498.        SLINE @  -MARK  MEOL  %DONE ON OVER-STRIKE  ;
  499.  
  500.  
  501. \ CTRL.KEY                                     14:17JWB03/03/87
  502. : CTRL.KEY
  503.         CASE
  504. CONTROL M OF RET                     ENDOF
  505. CONTROL H OF RUB                     ENDOF
  506. CONTROL L OF CLR                     ENDOF
  507. CONTROL Q OF F-CHAR                  ENDOF
  508. CONTROL S OF L-ARROW                 ENDOF
  509. CONTROL T OF D-WORD                  ENDOF
  510. CONTROL D OF R-ARROW                 ENDOF
  511. CONTROL I OF 5 +.POS OVER-STRIKE     ENDOF
  512. CONTROL U OF DEALL                   ENDOF
  513.        27 OF DEALL                   ENDOF
  514. CONTROL X OF DEOL                    ENDOF
  515.         ( OTHERS ) ( BEEP ) DROP    \ Required by F-PC ENDCASE
  516.         ENDCASE ;
  517.  
  518.  
  519. \  FUNC.KEY                                    09:51JWB02/07/86
  520. : FUNC.KEY
  521.         CASE
  522.   20 OF  T-WORD         ENDOF
  523.   22 OF  U-WORD         ENDOF       38 OF  L-WORD         ENDOF
  524.   31 OF  -TRANS         ENDOF       32 OF  +TRANS         ENDOF
  525.   75 OF  L-ARROW        ENDOF       77 OF  R-ARROW        ENDOF
  526.   71 OF  HOM            ENDOF       79 OF  MEOL           ENDOF
  527.   81 OF  +RECALL-LINE   ENDOF       73 OF  -RECALL-LINE   ENDOF
  528.   83 OF  DCHAR          ENDOF       82 OF  INSS           ENDOF
  529.   80 OF  +RECALL-SLINE  ENDOF       72 OF  -RECALL-SLINE  ENDOF
  530.  117 OF  DEOL           ENDOF      119 OF  DBOL           ENDOF
  531.  115 OF  B-WORD         ENDOF      116 OF  F-WORD         ENDOF
  532.  132 OF  CLR.BK.BUF     ENDOF
  533.         ( OTHERS ) ( BEEP )  DROP
  534.         ENDCASE ;
  535.  
  536.  
  537. \ (LEDIT)                                      09:51JWB02/07/86
  538. \ Edit line of length len at address adr. If flag is true move
  539. \ to beginning of line, if false move to end of line.
  540. : (LEDIT)  ( adr len flag   -- )
  541.         -ROT 79 MIN 2DUP %MLEN ! %BUF !
  542.         %POS OFF  %DONE OFF   7 ATRIB !
  543.         CUR@ 256 /MOD  %ROW !  %OFF !
  544.         -TRAILING CTYPE IF HOM ELSE MEOL THEN
  545.         BEGIN PCKEY 2DUP FLIP + LKEY !
  546.         IF   DUP  31 < IF  CTRL.KEY
  547.                        ELSE %MOD @ IF ICHAR ELSE ECHO THEN THEN
  548.         ELSE FUNC.KEY  THEN
  549.         %DONE @ UNTIL SAVE-LINE  ;
  550.  
  551.  
  552. \  LEDIT  <LEDIT  <EXPECT>                     09:51JWB02/07/86
  553. \ Edit line of length n at adr. Begin by displaying string at
  554. \ adr and then sit cursor at end of string.
  555. : LEDIT ( adr n -- )
  556.         FALSE (LEDIT) ;
  557.  
  558. \ As above, but put cursor at beginning of line.
  559. : <LEDIT ( adr n   -- )
  560.         TRUE (LEDIT) ;
  561.  
  562. \ Replacement for Forth's EXPECT
  563. : <EXPECT> ( adr n   -- )
  564.         2DUP BL FILL 2DUP <LEDIT -TRAILING
  565.         PRINTING @ IF 2DUP HOM TYPE THEN
  566.         DUP SPAN !  #OUT ! DROP SPACE ;
  567.  
  568. : IQUERY TIB 80 <EXPECT> SPAN @ #TIB ! >IN OFF ;
  569.  
  570.  
  571. : NEW-EXPECT ( -- )
  572.       ['] IQUERY   ['] QUIT >BODY @ XSEG @ + 22 !L ;
  573.  
  574. : OLD-EXPECT  ( -- )
  575.       ['] QUERY    ['] QUIT >BODY @ XSEG @ + 22 !L ;
  576.  
  577.  
  578. ONLY FORTH ALSO
  579.  
  580.  
  581.