projects:ledit.blk
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 >LINE 09:50JWB02/07/86
1 \ Decrement previous line pointer to start of the previous line.
2 : <LINE ( -- -- )
3 PR.PTR @ 0 <= \ At bottom of bkup buf?
4 IF BK.PTR @ PR.PTR ! THEN \ If so point to top!!
5 BEGIN -1 +PR.PTR PR.ADR C@ \ Now back up one line.
6 0= UNTIL ;
7
8 \ Increment previous line pointer to start of the next line.
9 : >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 ;
12 \ Move forward one line then move it to the editing buffer.
13 : +RECALL-LINE ( -- -- )
14 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 <LEDIT <EXPECT> 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 : <LEDIT ( adr n -- )
9 TRUE (LEDIT) ;
10
11 : <EXPECT> ( adr n -- )
12 2DUP BL FILL 2DUP <LEDIT -TRAILING
13 PRINTING @ IF 2DUP HOM TYPE THEN
14 DUP SPAN ! #OUT ! DROP SPACE ;
15
Screen 35 not modified
0 \ NEW-EXP OLD-EXP 09:51JWB02/07/86
1 : NEW-EXP ['] <EXPECT> ['] 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
projects/ledit.blk.txt · Zuletzt geändert: 2013-06-06 21:27 von 127.0.0.1