===DOSEDIT style forth input line editor=== Screen 0 not modified 0 1 \ Last change: Screen 029 14:33JWB03/03/87 2 3 4 5 6 7 8 9 10 11 12 13 14 15 Screen 1 not modified 0 \ LEDIT LOAD SCREEN 11:29JWB11/23/85 1 2 ONLY FORTH DEFINITIONS ALSO 3 4 : LTASK ; 5 6 2 35 THRU 7 8 9 10 11 12 13 14 15 Screen 2 not modified 0 \ Line editor variables 09:49JWB02/07/86 1 2 ONLY EDITOR ALSO FORTH DEFINITIONS 3 4 VARIABLE %MOD \ Type-over/Insert flag. True=Insert. 5 VARIABLE %BUF \ Address of line buffer. 6 VARIABLE %MLEN \ Length of line buffer. 7 VARIABLE %OFF \ Offset to start of line. 8 VARIABLE %ROW \ Current row or vertical position on screen. 9 VARIABLE %POS \ Current position in the line. 10 VARIABLE %DONE \ Finished flag. If true then quit. 11 VARIABLE LKEY \ Last key code pressed. 12 13 14 15 Screen 3 not modified 0 \ #R POS@ 09:49JWB02/07/86 1 2 : #R ( -- n ) \ Leave n, characters to right of cursor. 3 4 %MLEN @ \ Fetch length of line buffer. 5 %POS @ \ Fetch current cursor position. 6 - ; \ Subtract leaving number of characters to 7 \ right of cursor. 8 9 : POS@ ( -- adr ) \ Leave address of current cursor position. 10 11 %BUF @ \ Fetch address of line buffer. 12 %POS @ \ Fetch current cursor position. 13 + ; \ Add leaving current address of cursor. 14 15 Screen 4 not modified 0 \ CUR 09:49JWB02/07/86 1 2 : CUR ( row col -- ) \ Position cursor at (col,row) 3 4 80 MOD \ Calculate column position. 5 SWAP \ Bring row to top of stack. 6 25 MOD \ Calculate row position. 7 GOTOXY ; \ Word that positions cursor. 8 9 10 11 12 13 14 15 Screen 5 not modified 0 \ .POS 09:49JWB02/07/86 1 2 : .POS ( -- -- ) \ Move cursor to its current position. 3 4 %POS @ \ Fetch current position in line. 5 %MLEN @ \ Fetch length of line buffer. 6 MOD \ Divide leaving cursor position. 7 %OFF @ + \ Fetch offset to start of line and add 8 \ to cursor position. 9 %ROW @ \ Fetch current row. 10 SWAP \ Put (col,row) in proper order for CUR 11 CUR ; \ Position cursor at (col,row). 12 13 14 15 Screen 6 not modified 0 \ !POS +POS 09:49JWB02/07/86 1 2 : !POS ( n -- ) \ Set current position to n. 3 4 %MLEN @ MOD \ Take top stack value and divide by 5 \ length of line buffer, leaving remainder 6 %POS ! ; \ which is stored at current position in 7 \ line. 8 9 : +POS ( n -- ) \ Increment current position by n. 10 11 %POS @ + \ Fetch current position in line and add 12 !POS ; \ value "n" to it. Store back at current 13 \ position in line. 14 15 Screen 7 not modified 0 \ +.POS HOM 09:49JWB02/07/86 1 2 : +.POS ( n -- ) \ Increment by n and display at new location 3 4 +POS \ Increments current position by "n" 5 .POS ; \ Moves cursor to its current position. 6 7 8 : HOM ( -- -- ) \ To begining of line, type-over mode. 9 10 %POS OFF \ Set current position in line to zero. 11 .POS \ Move cursor to current position in line. 12 %MOD OFF ; \ Set insert mode to false. 13 14 15 Screen 8 not modified 0 \ !CHAR ECHO 09:49JWB02/07/86 1 2 : !CHAR ( char -- ) \ Store character at current position. 3 4 POS@ C! \ Fetch address of current cursor position 5 \ and store character there. 6 1 +.POS ; \ Increment cursor position by one and 7 \ display at new location. 8 9 : ECHO ( char -- ) \ Echo character and store character. 10 11 DUP (CONSOLE) \ Output character to console device. 12 !CHAR ; \ Store character at current position. 13 14 15 Screen 9 not modified 0 \ CTYPE 09:49JWB02/07/86 1 2 : CTYPE ( adr cnt -- ) \ Send string to console only. 3 4 0 ?DO \ Set up loop with character count. 5 COUNT \ Fetch char from adr and increment 6 \ adr by one. 7 (CONSOLE) \ Output char to current console device. 8 LOOP \ Loop back. 9 DROP ; \ Clean up stack. 10 11 12 13 14 15 Screen 10 not modified 0 \ .LIN 09:49JWB02/07/86 1 2 : .LIN ( -- -- ) \ Update entire line. 3 %POS @ \ Fetch current position in line. 4 HOM \ Move cursor to beginning of line. 5 %BUF @ \ Fetch address of line buffer. 6 %MLEN @ \ Fetch length of line buffer. 7 CTYPE \ Output entire line buffer to console. 8 %POS ! \ Restore previous cursor position in line 9 .POS ; \ and move cursor to the current position. 10 11 12 13 14 15 Screen 11 not modified 0 \ RUB 09:49JWB02/07/86 1 2 : RUB ( -- -- ) \ Rub out character behind cursor. 3 4 -1 +.POS \ Decrement current cursor position by one 5 BL ECHO \ Store a blank and echo to console. 6 -1 +.POS ; \ Echo incremented cursor position by one 7 \ so we must decrement by one again. 8 9 10 11 12 13 14 15 Screen 12 not modified 0 \ MEOL 09:49JWB02/07/86 1 2 : MEOL ( -- -- ) \ Move to end of line. 3 4 %BUF @ %MLEN @ \ Get address and length of line buffer. 5 -TRAILING \ Leave length excluding trailing spaces 6 %MLEN @ 1- MIN \ Leave line buffer length minus one 7 \ or string length whichever is smaller. 8 !POS DROP .POS \ Move cursor to that position. 9 %MOD OFF ; \ Turn off insert mode. 10 11 12 13 14 15 Screen 13 not modified 0 \ DEOL DEALL 09:49JWB02/07/86 1 2 : DEOL ( -- -- ) \ Delete to end of field. 3 4 POS@ #R \ Get cursor position leaving number of 5 \ characters to right of cursor. 6 BL FILL \ Blanks from right of cursor to end of line. 7 .LIN ; \ Update entire line. 8 9 10 : DEALL ( -- -- ) \ Delete entire line. 11 12 %BUF @ %MLEN @ \ Get address and length of line buffer. 13 BL FILL \ Fill line with blanks. 14 .LIN \ Update entire line. 15 HOM ; \ Move cursor to beginning of line. Screen 14 not modified 0 \ DCHAR 09:49JWB02/07/86 1 2 \ Delete character at cursor position and close gap created. 3 : DCHAR ( -- -- ) 4 5 POS@ 1+ POS@ \ From adr and To adr 6 #R MOVE \ Number to move, move string 7 BL %BUF @ %MLEN @ 1- + C! \ Put blank in line buf at eol 8 POS@ #R -TRAILING \ Cursor position and number of 9 \ char less trailing blanks. 10 1+ CTYPE \ Add one to cursor and send 11 .POS ; \ string to console. Move cursor 12 \ to current position. 13 14 15 Screen 15 not modified 0 \ ICHAR 09:49JWB02/07/86 1 2 \ Insert character char at current position and update display. 3 : ICHAR ( char -- ) 4 5 #R >R POS@ DUP R@ + 1- C@ BL = \ Blank at end of line? 6 IF DUP 1+ R@ 1- \ Yes, set up from adr to adr. 7 MOVE POS@ C! \ Move string, insert character. 8 POS@ R@ -TRAILING \ Strip off trailing blanks. 9 CTYPE 1 +.POS \ Output to console and move 10 \ cursor one to right. 11 ELSE BEEP 2DROP \ No, beep then clean up stack. 12 THEN R> DROP ; \ Clean up return and parameter 13 \ stack. 14 15 Screen 16 not modified 0 \ OVER-STRIKE INSERT 09:49JWB02/07/86 1 2 : OVER-STRIKE ( -- -- ) \ Set over-strike mode. 3 4 %MOD @ IF \ If insert mode then 5 LITTLE-CURSOR \ set cursor to small 6 %MOD OFF \ set over-strike mode 7 THEN ; \ otherwise continue. 8 9 10 : INSERT ( -- -- ) \ Set insert mode. 11 12 %MOD @ NOT IF \ If over-strike mode then 13 BIG-CURSOR \ set cursor to large 14 %MOD ON \ set insert mode 15 THEN ; \ otherwise continue. Screen 17 not modified 0 \ L-ARROW R-ARROW CLR 09:49JWB02/07/86 1 2 : L-ARROW ( -- -- ) \ Move cursor left one position. 3 -1 +.POS OVER-STRIKE ; 4 5 : R-ARROW ( -- -- ) \ Move cursor right one position. 6 1 +.POS OVER-STRIKE ; 7 8 9 : CLR ( -- -- ) \ Clear screen, & redisplay at home. 10 11 0 0 79 24 15 INIT-WINDOW \ Clear screen. 12 %ROW OFF .LIN ; \ Update entire first line. 13 14 15 Screen 18 not modified 0 \ INSS +TRANS -TRANS 10:05JWB02/07/86 1 2 : INSS ( -- -- ) \ Insert/overstrike toggle. 3 %MOD @ IF OVER-STRIKE ELSE INSERT THEN ; 4 5 : +TRANS ( -- -- ) \ 6 %POS @ %MLEN @ 1- < \ Cursor at end of line? 7 IF POS@ @ 256 /MOD \ Transpose two char at cursor. 8 ECHO ECHO \ Echo and store both char. 9 L-ARROW \ Reposition cursor. 10 THEN ; \ 11 12 13 : -TRANS ( -- -- ) 14 %POS @ 15 IF -1 +.POS +TRANS L-ARROW THEN ; Screen 19 not modified 0 \ BK.PTR PR.PTR 09:50JWB02/07/86 1 256 CONSTANT BK.SIZE \ Size of command line backup buffer. 2 VARIABLE BK.PTR \ Pointer to top of backup buffer. 3 VARIABLE PR.PTR \ Pointer to previous line in bkup buf. 4 CREATE BK.BUF BK.SIZE ALLOT \ This is the backup buf. 5 \ Leave address of the top of the backup buffer. 6 : BK.ADR ( -- adr ) 7 BK.BUF BK.PTR @ + ; 8 9 \ Increment pointer to top of backup buffer by n. 10 : +BK.PTR ( n -- ) BK.PTR +! ; 11 \ Leave address of the previous line. 12 : PR.ADR ( -- adr ) 13 BK.BUF PR.PTR @ + ; 14 \ Increment pointer to previous line by n. 15 : +PR.PTR ( n -- ) PR.PTR +! ; Screen 20 not modified 0 \ DELETE-1ST-LINE NO-ROOM? MAKE-ROOM 09:50JWB02/07/86 1 \ Delete first line in backup buffer and adjust pointer counts. 2 : DELETE-1ST-LINE ( -- -- ) 3 BK.BUF 1+ C@ 2+ >R 4 BK.BUF R@ + BK.BUF BK.PTR @ R@ - CMOVE 5 R> NEGATE DUP +BK.PTR +PR.PTR ; 6 7 \ Leave a true flag if there is no room for string of size n. 8 : NO-ROOM? ( n flag ) 9 2+ BK.SIZE BK.PTR @ - < NOT ; 10 11 \ Delete lines till there is room for string of size n. 12 : MAKE-ROOM ( n -- ) 13 BEGIN DUP NO-ROOM? 14 WHILE DELETE-1ST-LINE 15 REPEAT DROP ; Screen 21 not modified 0 \ SAVE-LINE 09:50JWB02/07/86 1 VARIABLE RLFLAG 2 3 : RLFLAG? RLFLAG @ ; 4 5 \ Save current line in the backup buffer. 6 : SAVE-LINE ( -- -- ) 7 %BUF @ %MLEN @ -TRAILING ?DUP \ adr & count of line 8 IF DUP MAKE-ROOM \ Make room if required 9 BK.ADR OFF DUP BK.ADR 1+ C! \ Save line count. 10 TUCK BK.ADR 2+ SWAP CMOVE \ Move the line. 11 2+ +BK.PTR \ Update pointers. 12 BK.PTR @ PR.PTR ! 13 RLFLAG ON 14 ELSE DROP THEN ; 15 Screen 22 not modified 0 \ LINE 09:50JWB02/07/86 1 \ Decrement previous line pointer to start of the previous line. 2 : LINE ( -- -- ) 10 PR.PTR @ BK.PTR @ < \ Not at top of bk buf? 11 IF BEGIN 1 +PR.PTR PR.ADR C@ \ Then move forward one 12 0= UNTIL \ line in bkup buf. 13 THEN 14 PR.PTR @ BK.PTR @ >= \ Did we reach the top? 15 IF PR.PTR OFF THEN ; \ If so point to bottom. Screen 23 not modified 0 \ RECALL-LINE -RECALL-LINE +RECALL-LINE 11:27JWB11/23/85 1 \ Move previous line to the editing buffer. 2 : RECALL-LINE ( -- -- ) 3 %BUF @ %MLEN @ BL FILL \ Clear editing buffer. 4 RLFLAG? 5 IF PR.ADR 1+ 6 COUNT %MLEN @ MIN \ From adr and count. 7 %BUF @ SWAP CMOVE \ To adr and moveit. 8 THEN .LIN MEOL ; \ Display & move to end. 9 \ Back up one line and move it to editing buffer. 10 : -RECALL-LINE ( -- -- ) 11 RLFLAG? IF LINE THEN RECALL-LINE ; 15 Screen 24 not modified 0 \ Read screen location. SC@ 18:06JWB11/25/85 1 ALSO 2 CODE SC@ ( -- char ) 3 8 # AH MOV 4 BH BH SUB 16 INT AH AH SUB 5 128 # AX CMP 6 U>= IF 32 # AL MOV THEN 7 31 # AX CMP 8 U< IF 32 # AL MOV THEN 9 1PUSH END-CODE PREVIOUS 10 : +MARK ( n -- ) 11 CUR@ 0 ROT AT ATRIB @ SC@ 12 112 ATRIB ! VEMIT ATRIB ! CUR! ; 13 : -MARK ( n -- ) 14 CUR@ 0 ROT AT SC@ VEMIT CUR! ; 15 Screen 25 not modified 0 \ READ-SCREEN 15:21JWB11/25/85 1 VARIABLE SLINE 2 : SINC SLINE @ 1+ 25 MOD SLINE ! ; 3 : SDEC SLINE @ 24 + 25 MOD SLINE ! ; 4 5 CREATE SLINE-BUF 80 ALLOT 6 7 \ Copy line n of screen into SLINE-BUF . 8 : READ-SCREEN ( n -- ) 9 25 MOD CUR@ >R 10 80 0 DO I OVER AT SC@ 11 SLINE-BUF I + C! 12 LOOP DROP 13 R> CUR! ; 14 15 Screen 26 not modified 0 \ 09:50JWB02/07/86 1 \ Recall next line from screen. 2 : +RECALL-SLINE ( -- -- ) 3 NO-CURSOR 4 SLINE @ -MARK SINC SLINE @ DUP +MARK READ-SCREEN 5 %BUF @ %MLEN @ BL FILL 6 SLINE-BUF 79 -TRAILING %MLEN @ MIN %BUF @ SWAP CMOVE 7 .LIN MEOL LITTLE-CURSOR ; 8 9 \ Recall previous line from screen. 10 : -RECALL-SLINE ( -- -- ) 11 NO-CURSOR 12 SLINE @ -MARK SDEC SLINE @ DUP +MARK READ-SCREEN 13 %BUF @ %MLEN @ BL FILL 14 SLINE-BUF 79 -TRAILING %MLEN @ MIN %BUF @ SWAP CMOVE 15 .LIN MEOL LITTLE-CURSOR ; Screen 27 not modified 0 \ F-WORD B-WORD 13:42JWB03/03/87 1 : F-WORD ( -- -- ) 2 BEGIN POS@ C@ BL <> 3 WHILE 1 +POS REPEAT 4 BEGIN POS@ C@ BL = 5 WHILE 1 +POS REPEAT .POS ; 6 7 : B-WORD ( -- -- ) 8 BEGIN POS@ C@ BL <> 9 WHILE -1 +POS REPEAT 10 BEGIN POS@ C@ BL = 11 WHILE -1 +POS REPEAT 12 BEGIN POS@ C@ BL <> 13 WHILE -1 +POS REPEAT 14 1 +.POS ; 15 Screen 28 not modified 0 \ D-WORD F-CHAR 14:32JWB03/03/87 1 : D-WORD ( -- -- ) 2 POS@ C@ BL <> IF 3 BEGIN POS@ C@ BL <> 4 WHILE -1 +POS REPEAT 5 1 +POS .POS 6 BEGIN POS@ C@ BL <> 7 WHILE DCHAR 8 REPEAT DCHAR THEN ; 9 10 : PCKEY ( -- n flag ) 11 {KEY} 12 ?DUP IF TRUE ELSE {KEY} FALSE THEN ; 13 14 15 Screen 29 not modified 0 \ 14:33JWB03/03/87 1 \ Clear backup buffer. 2 : CLR.BK.BUF ( -- -- ) 3 RLFLAG OFF 4 BK.BUF BK.SIZE BL FILL 5 BK.PTR OFF PR.PTR OFF ; 6 7 : F-CHAR ( -- -- ) 8 PCKEY 9 IF %MLEN @ %POS @ 1+ 10 DO I %BUF @ + C@ OVER = 11 IF I !POS LEAVE THEN 12 LOOP .POS 13 THEN DROP ; 14 15 Screen 30 not modified 0 \ RET PCKEY 14:24JWB03/03/87 1 : DBOL ( -- -- ) 2 SLINE-BUF 80 BL FILL 3 POS@ SLINE-BUF #R DUP >R CMOVE 4 %BUF @ %MLEN @ BL FILL 5 SLINE-BUF %BUF @ R> CMOVE .LIN HOM ; 6 7 8 : RET ( -- -- ) \ Finished, move to eol, set %DONE ON 9 SLINE @ -MARK MEOL %DONE ON OVER-STRIKE ; 10 11 12 13 14 15 Screen 31 not modified 0 \ CTRL.KEY 14:17JWB03/03/87 1 : CTRL.KEY 2 CASE 3 CONTROL M OF RET ENDOF 4 CONTROL H OF RUB ENDOF 5 CONTROL L OF CLR ENDOF 6 CONTROL Q OF F-CHAR ENDOF 7 CONTROL S OF L-ARROW ENDOF 8 CONTROL T OF D-WORD ENDOF 9 CONTROL D OF R-ARROW ENDOF 10 CONTROL I OF 5 +.POS OVER-STRIKE ENDOF 11 CONTROL U OF DEALL ENDOF 12 27 OF DEALL ENDOF 13 CONTROL X OF DEOL ENDOF 14 ( OTHERS ) ( BEEP ) 15 ENDCASE ; Screen 32 not modified 0 \ FUNC.KEY 09:51JWB02/07/86 1 2 : FUNC.KEY 3 CASE 4 31 OF -TRANS ENDOF 32 OF +TRANS ENDOF 5 75 OF L-ARROW ENDOF 77 OF R-ARROW ENDOF 6 71 OF HOM ENDOF 79 OF MEOL ENDOF 7 81 OF +RECALL-LINE ENDOF 73 OF -RECALL-LINE ENDOF 8 83 OF DCHAR ENDOF 82 OF INSS ENDOF 9 80 OF +RECALL-SLINE ENDOF 72 OF -RECALL-SLINE ENDOF 10 117 OF DEOL ENDOF 119 OF DBOL ENDOF 11 115 OF B-WORD ENDOF 116 OF F-WORD ENDOF 12 132 OF CLR.BK.BUF ENDOF 13 ( OTHERS ) ( BEEP ) 14 ENDCASE ; 15 Screen 33 not modified 0 \ (LEDIT) 09:51JWB02/07/86 1 \ Edit line of length len at address adr. If flag is true move 2 \ to beginning of line, if false move to end of line. 3 : (LEDIT) ( adr len flag -- ) 4 -ROT 79 MIN 2DUP %MLEN ! %BUF ! 5 %POS OFF %DONE OFF 7 ATRIB ! 6 CUR@ 256 /MOD %ROW ! %OFF ! 7 -TRAILING CTYPE IF HOM ELSE MEOL THEN 8 BEGIN PCKEY 2DUP FLIP + LKEY ! 9 IF DUP 31 < IF CTRL.KEY 10 ELSE %MOD @ IF ICHAR ELSE ECHO THEN THEN 11 ELSE FUNC.KEY THEN 12 %DONE @ UNTIL SAVE-LINE ; 13 14 15 Screen 34 not modified 0 \ LEDIT 09:51JWB02/07/86 1 ALSO FORTH DEFINITIONS 2 3 \ Edit line of length n at adr. Begin by displaying string at 4 \ adr and then sit cursor at end of string. 5 : LEDIT ( adr n -- ) 6 FALSE (LEDIT) ; 7 \ As above, but put cursor at beginning of line. 8 : ( adr n -- ) 12 2DUP BL FILL 2DUP ['] EXPECT 2+ ! 2 ['] EXIT ['] EXPECT 4 + ! ; 3 4 : OLD-EXP ['] DUP ['] EXPECT 2+ ! 5 ['] SPAN ['] EXPECT 4 + ! ; 6 7 ONLY FORTH ALSO 8 9 10 11 12 13 14 15