\ NED ;S This file contain the source code for the NED Forth screen editor. It presumes the assembler has been loaded previously as well as the display words. \ LOAD SCREEN 3 999 THRU ( PINDEX AND SPRINT 08/26/83 ) PINDEX 0 300 SPRINT ( To Do 04/21/86 ) ;S End of line go to col 63 if empty Del -- beep if rest of line blank. Mouse -- needs real cursor Tab, back tab Watch max screen # always don't let char insert wipe out data Make Del left word pay attention to calc mode. do current style in calc mode, more traditional in other modes. Make delete word left not kill current char. ?? how in calc mode? make sure WAS-LINE maintained make sure search string never null. wipe out blank screens create hole go to screen# ( General Notes on NED compatibility 04/26/86 ) ;S In writing this editor, I constantly ran into this problem: I could make NED look exactly like some other editor I use daily, or I could "improve" on the other editor to make NED more suitable for editing Forth. I have tended to "improve" on the editor. The functions use the same keystrokes as other editors, but in micro-details behave quite differently. I have left notes on the micro-details of other editors if you want to make NED more compatible. The design of this editor was heavily influenced by Ray Duncan'sproprietary PC Forth Plus editor. It looks much the same on the outside but has quite different internals. ( General Notes on how NED works 04/26/86 ) ;S There are Three copies of the screen being edited. 1. THIS-BUF contains one copy with one byte per character. It contains the screen as edited so far. It is fast for string handling instructions like SCAN and <SCAN. 2. Another copy is in the visible screen Regen buffer with two bytes per character (one attribute and one data byte). The Regen copy lags slightly behind THIS-BUF. 3. A third copy exists on disk (or in SCREEN# @ BLOCK) as the block used to look. It can be used if the user hits Oops to put the screen back the way it was. It gets updated if we move to a new screen. ( General Notes on NED screen handling 04/26/86 ) ;S NED bypasses the ROM BIOS to write to the screen. This was done for speed. It also allows alternate writing to either colour or monochrome screen. It precalculates all the Regen addresses so that no multiplication need be done to address the screen. NED does use the ROM Bios for scrolling. This was done to have a single blanking for a scroll if necessary. For mouse tracking of the cursor to work we have to use ROM Bios calls to move the cursor rather than poking the 6845 chip directly. Since the cursor moves only once per keystroke, this is a quite acceptable speed penalty. ( THIS-BUF CURSOR 04/07/86 ) FORTH DEFINITIONS 4000 VOC-SIZE ! VOCABULARY EDITOR ( nfas only not bodies ) ONLY FORTH ALSO EDITOR DEFINITIONS CREATE THIS-BUF 1024 ALLOT \ how screen is now 16 x 64 VARIABLE CURSOR \ 0 .. 1023 where cursor is VARIABLE SCREEN# \ 0 .. 9999 which screen we are editing ( WAS-LINE SUCK-STACK SUCK-DEPTH 04/26/86 ) CREATE WAS-LINE 64 ALLOT \ how current line used to be VARIABLE WAS-CURSOR \ 0 .. 1023 where cursor used to be CREATE SUCK-STACK 1024 ALLOT \ up to 16 lines sucked up. Last in first out. Grows up. VARIABLE SUCK-DEPTH \ how many lines in suck stack 0 .. 16 ( SEARCH-BUF-UC SEARCH-FOR SEARCH-FOR-AS-KEYED SEARC 04/26/86 ) CREATE SEARCH-BUF-UC 1024 ALLOT \ for case insensitive searches, holds entire screen \ in upper case. CREATE SEARCH-FOR 64 ALLOT \ string we are searching for \ for case insensitive searches, holds what looking for \ in upper case. CREATE SEARCH-FOR-AS-KEYED 64 ALLOT \ string we are searching for VARIABLE SEARCH-LEN \ length of current search string 0=none ( SEARCH-SCREEN# SEARCH-CURSOR 04/26/86 ) VARIABLE SEARCH-SCREEN# \ 0 .. 9999 which screen we are searching VARIABLE SEARCH-CURSOR \ 0 .. 1023 where we have searched to so far. \ on SEARCH-SCREEN# VARIABLE CASE-SENSITIVE \ 0 = inexact match. ? matches any control char \ all accented letters match unaccented \ all lower case match upper case \ -1 = exact match on search -- faster. ( OTHER-BUF OTHER-CUR 04/07/86 ) CREATE OTHER-BUF 1024 ALLOT \ if have 2 monitors, contents of other \ if one, contents of invisible screen VARIABLE OTHER-CUR \ 0 .. 1023 where other cursor is \ INSERT-MODE YES NO VARIABLE INSERT-MODE \ 0 if in overstrike mode OVERSTRIKE \ 1 if in standard insert mode INSERT \ 2 if in right align insert mode CALCULATOR ' -1 ALIAS YES ' 0 ALIAS NO \ LC to UC TRT table LC>COMP ( 0 .. 63 ) DECIMAL CREATE LC>COMP \ converts lower case to plain upper case \ converts accented char to plain unaccented capital letter \ converts control chars to ? \ leaves symbols as they are 032 C, 063 C, 063 C, 063 C, 063 C, 063 C, 063 C, 063 C, 063 C, 063 C, 063 C, 063 C, 063 C, 063 C, 063 C, 063 C, 063 C, 063 C, 063 C, 063 C, 063 C, 063 C, 063 C, 063 C, 063 C, 063 C, 063 C, 063 C, 063 C, 063 C, 063 C, 063 C, 032 C, 033 C, 034 C, 035 C, 036 C, 037 C, 038 C, 039 C, 040 C, 041 C, 042 C, 043 C, 044 C, 045 C, 046 C, 047 C, 048 C, 049 C, 050 C, 051 C, 052 C, 053 C, 054 C, 055 C, 056 C, 057 C, 058 C, 059 C, 060 C, 061 C, 062 C, 063 C, ( LC to UC TRT table LC>COMP 07/30/85 ) ( 64 .. 127 ) DECIMAL 064 C, 065 C, 066 C, 067 C, 068 C, 069 C, 070 C, 071 C, 072 C, 073 C, 074 C, 075 C, 076 C, 077 C, 078 C, 079 C, 080 C, 081 C, 082 C, 083 C, 084 C, 085 C, 086 C, 087 C, 088 C, 089 C, 090 C, 091 C, 092 C, 093 C, 094 C, 095 C, 096 C, 065 C, 066 C, 067 C, 068 C, 069 C, 070 C, 071 C, 072 C, 073 C, 074 C, 075 C, 076 C, 077 C, 078 C, 079 C, 080 C, 081 C, 082 C, 083 C, 084 C, 085 C, 086 C, 087 C, 088 C, 089 C, 090 C, 123 C, 124 C, 125 C, 126 C, 063 C, ( LC to UC TRT table LC>COMP 07/30/85 ) ( 128 .. 191 ) DECIMAL 067 C, 085 C, 069 C, 065 C, 065 C, 065 C, 065 C, 067 C, 069 C, 069 C, 069 C, 073 C, 073 C, 073 C, 065 C, 065 C, 069 C, 065 C, 065 C, 079 C, 079 C, 079 C, 085 C, 085 C, 089 C, 079 C, 085 C, 155 C, 156 C, 157 C, 158 C, 159 C, 065 C, 073 C, 079 C, 085 C, 078 C, 078 C, 065 C, 079 C, 168 C, 169 C, 170 C, 171 C, 172 C, 173 C, 174 C, 175 C, 176 C, 177 C, 178 C, 179 C, 180 C, 181 C, 182 C, 183 C, 184 C, 185 C, 186 C, 187 C, 188 C, 189 C, 190 C, 191 C, ( LC to UC TRT table LC>COMP 07/30/85 ) ( 192 .. 255 ) DECIMAL 192 C, 193 C, 194 C, 195 C, 196 C, 198 C, 199 C, 200 C, 201 C, 202 C, 202 C, 203 C, 204 C, 205 C, 206 C, 207 C, 208 C, 209 C, 210 C, 211 C, 212 C, 213 C, 214 C, 215 C, 216 C, 217 C, 218 C, 219 C, 220 C, 221 C, 222 C, 223 C, 224 C, 225 C, 226 C, 227 C, 228 C, 229 C, 230 C, 231 C, 232 C, 233 C, 234 C, 235 C, 236 C, 237 C, 238 C, 239 C, 240 C, 242 C, 242 C, 242 C, 244 C, 245 C, 246 C, 247 C, 248 C, 249 C, 250 C, 251 C, 252 C, 253 C, 254 C, 032 C, ( Notes on C>SADD L>SADD 04/07/86 ) ;S Lines are numbered 0..15 Cursor positions are numbers 0..1023 Display screen rows are numbers 0..24 and columns 0..79. Screen offset addresses (sadds) are numbered 0 .. 3999 Each character on the screen takes 2 bytes - value and highlighting attribute. To centre the 16 x 54 forth screen on the 25 x 80 display screen, the upper left corner of the Forth screen goes at row 3 col 6. We need a fast way of converting from Cursor to SADD and Line to SADD. We precompute these and use a lookup table. ( C>SADD-TABLE C>SADD 04/07/86 ) CREATE C>SADD-TABLE 1024 2* ALLOT : TASK ; : C>SADD ( cursor -- sadd ) 64 /MOD ( col line ) 80 Q* + 80 3 * 6 + + ( offset of upper left corner ) 2* ( to account that each char takes 2 bytes ) ; : INIT-C>SADD ( initialize the C>SADD-TABLE ) 1024 0 DO I C>SADD I 2* C>SADD-TABLE + W! LOOP ; INIT-C>SADD FORGET TASK : C>SADD ( cursor -- sadd ) 2* C>SADD-TABLE + W@ ; ( L>SADD-TABLE L>SADD 04/07/86 ) CREATE L>SADD-TABLE 16 2* ALLOT : TASK ; : L>SADD ( line# -- sadd ) 80 Q* 80 3 * 6 + + ( offset of upper left corner ) 2* ( to account that each char takes 2 bytes ) ; : INIT-L>SADD ( initialize the L>SADD-TABLE ) 16 0 DO I L>SADD I 2* L>SADD-TABLE + W! LOOP ; INIT-L>SADD FORGET TASK : L>SADD ( line# -- sadd ) 2* L>SADD-TABLE + W@ ; \ START-OF-LINE CURSOR-COL CURSOR-ROW : START-OF-LINE ( cursor 0..1023 -- cursor 0..1023 ) ( given cursor offset anywhere in line, computes ) ( cursor offset of column 0 of that line ) ( mask off low 6 bits ) [ 15 64 Q* ] LITERAL AND ; : CURSOR-COL ( -- col cursor in now 0..63 ) CURSOR @ 63 AND ( mask off all but low 6 bits ) ; : CURSOR-ROW ( -- row cursor in now 0..15 ) CURSOR @ 64 Q/ ( shift 6 right ) ; ( THIS-ADDR THIS-CHAR@ 04/18/86 ) : THIS-ADDR ( --- 32 bit addr in THIS-BUFF of cursor ) CURSOR @ THIS-BUF + ; : THIS-CHAR@ ( -- char : char at current cursor posn ) THIS-ADDR C@ ; ( .CURSOR 04/21/86 ) : .CURSOR ( -- ) ( moves screen cursor ) CURSOR @ C>SADD ( sadd ) CURAT ( move cursor ) ; ( .CHAR THIS-CHAR! 04/18/86 ) : .CHAR ( -- ) ( refreshes the screen display from THIS-BUF ) ( 1 char pointed to by cursor. Also moves screen cursor ) THIS-CHAR@ ( char ) CURSOR @ C>SADD ( sadd ) DUP CURAT ( move cursor ) S! ( poke char ) ; : THIS-CHAR! ( char -- : paints char at current cursor posn ) THIS-ADDR C! .CHAR ; \ .LINE .SCREEN 04/07/86 ) : .LINE ( line# -- ) ( refreshes screen display from THIS-BUF ) ( one line only in DIM ) DUP 64 Q* THIS-BUF + ( addr in THIS-BUF ) SWAP L>SADD ( addr sadd ) 64 SCMOVE ; : .SCREEN ( -- ) ( refresh the entire screen display from THIS-BUF ) 6 1 GOTOXY SCREEN# @ 3 .R TDIM 16 0 DO I .LINE LOOP TBRIGHT .CURSOR ; ( HEAD .HEAD 04/21/86 ) : HEAD ( -- addr len ) ( string representing the line to left of cursor ) ( ending with the current cursor position ) CURSOR @ START-OF-LINE THIS-BUF + ( addr ) CURSOR-COL 1+ ( len ) ; : .HEAD ( -- ) ( refreshes screen display from THIS-BUF ) ( from cursor to end of line ) HEAD ( addr len ) CURSOR @ START-OF-LINE C>SADD ( sadd ) SWAP ( addr sadd len ) SCMOVE ; ( TAIL .TAIL 04/21/86 ) : TAIL ( -- addr len ) ( string representing the remainder of the line ) ( starting with the current cursor position ) THIS-ADDR 64 CURSOR-COL - ; : .TAIL ( -- ) ( refreshes screen display from THIS-BUF ) ( from cursor to end of line ) TAIL ( addr len ) CURSOR @ C>SADD ( sadd ) SWAP ( addr sadd len ) SCMOVE ; ( .EOS 04/21/86 ) : .EOS ( repaints the screen from current cursor to end of screen ) .TAIL ( handle current line ) 16 CURSOR-ROW ?DO I .LINE LOOP ; ( .SUCK 04/18/86 ) : .SUCK ( -- ) ( refreshes the screen bar from the top of Suck stack ) SUCK-DEPTH @ ?DUP IF 1- 64 Q* SUCK-STACK + ( addr of top item in suck stack ) ( display on row 21 col 6 ) [ 21 80 * 6 + 2* ] LITERAL ( sadd ) 64 TDIM-INV SCMOVE TBRIGHT ELSE [ 21 80 * 6 + 2* ] LITERAL ( sadd ) 64 SBLANK THEN ; ( .SEARCH 04/28/86 ) : .SEARCH ( displays what we are looking for ) ( shows in inverse to make spaces more visible ) CASE-SENSITIVE @ IF TBRIGHT _ = ELSE TBRIGHT-INV _ ≈ THEN ( display on row 20 col 4 ) [ 20 80 * 4 + 2* ] LITERAL ( sadd ) S! SEARCH-FOR-AS-KEYED ( display on row 20 col 6 ) [ 20 80 * 6 + 2* ] LITERAL ( addr sadd len ) SEARCH-LEN @ TDIM-INV SCMOVE TBRIGHT [ 20 80 * 6 + 2* ] LITERAL SEARCH-LEN @ 2* + ( sadd ) 64 SEARCH-LEN @ - ( len ) SBLANK ( blank out 2nd half ) ; ( .SEARCHING 10/06/86 ) : .SEARCHING ( blinks what we are looking for ) ( display on row 20 col 6 ) [ 20 80 * 6 + 2* ] LITERAL ( sadd ) SEARCH-LEN @ TBLINK-INV HIGHLIGHT TBRIGHT ; \ IG-TONE EXIT-TONE FOUND-TONE : IG-TONE ( eep ) 783 8 BEEP ; \ noise when keystroke ignored because it cannot be \ used in that context. : EXIT-TONE ( de da de ) 880 5 BEEP 440 10 BEEP 880 5 BEEP ; \ exit the editor : FOUND-TONE 400 1 BEEP ; \ found what looking for : NOT-FOUND-TONE ( oh no! ) 1046 5 BEEP 523 15 BEEP ; \ cannot find what looking for ( COPY-ON-COLOUR 05/13/86 ) : COPY-ON-COLOUR ( copies current mono screen to colour screen ) ( very primitive -- attribute bytes go unchanged ) ( works ok -- shows up in black and white ) [ HEX ] 0B0000000 0B8000000 [ DECIMAL ] [ 80 25 Q* 2* ] LITERAL CMOVE ; ( 1234-Row QWER-Row Tables to translate Alt to accen 10/11/85 ) CREATE 1234-Row \ 1 2 3 4 5 6 7 8 9 _ â C, _ ê C, _ î C, _ ô C, _ û C, _ φ C, _ Θ C, _ « C, _ » C, CREATE QWER-Row \ Q W E R T Y U I O _ á C, _ é C, _ í C, _ ó C, _ ú C, _ ÿ C, _ ç C, _ Ç C, _ ñ C, _ Ñ C, CREATE ASDF-Row \ A S D F G H J K L _ à C, _ è C, _ ì C, _ ò C, _ ù C, _ Ä C, _ É C, _ Ö C, _ Ü C, CREATE ZXCV-Row \ Z X C V B N M , . _ ä C, _ ë C, _ ï C, _ ö C, _ ü C, _ ¡ C, _ ¿ C, _ æ C, _ Æ C, ( KEY16 translates Alt-xxx to accented chars 09/19/85 ) DECIMAL : KEY16 ( -- 16-bit-char : allows fancy keys ) KEY ?DUP 0= IF KEY DUP CASE 120 128 RANGEOF 120 - 1234-Row + C@ ENDOF 16 25 RANGEOF 16 - QWER-Row + C@ ENDOF 30 38 RANGEOF 30 - ASDF-Row + C@ ENDOF 44 52 RANGEOF 44 - ZXCV-Row + C@ ENDOF OTHERS OF 256 + ENDOF ENDCASE THEN ; \ EXPECT - special version that uses KEY16 : EXPECT ( addr len -- ) ( see notes in BBLOINT.ASM on how this works ) SPAN 0! TUCK OVER + OVER ?DO ( n addr ) KEY16 DUP 8 = IF DROP SPAN @ IF -1 SPAN +! 8 EMIT SPACE 8 EMIT R> 2- >R ELSE 7 EMIT R> 1- >R THEN ELSE DUP 13 = IF DROP SPACE LEAVE THEN DUP 27 = IF DROP SPACE LEAVE THEN DUP 255 > IF ( treat as right arrow ) DROP I C@ ?DUP IF EMIT ELSE SPACE BL I C! THEN ELSE DUP EMIT I C! THEN 1 SPAN +! THEN LOOP SWAP SPAN @ <> IF 0 SWAP SPAN @ + C! THEN ; \ SAME-LINE? : SAME-LINE? ( proposed cursor posn -- flag ) ( true if we would be on the same line ) ( as we are on now ) START-OF-LINE ( col 0 of proposed line ) CURSOR @ START-OF-LINE ( col 0 current line ) = ; ( SAVE-LINE SAVE-CURSOR 04/26/86 ) : SAVE-LINE ( -- ) ( saves current line as it was ) ( so we can later restore it if Oops pressed ) CURSOR @ START-OF-LINE ( offset col 0 of this line ) THIS-BUF + WAS-LINE 64 CMOVE ; : SAVE-CURSOR ( -- ) CURSOR @ WAS-CURSOR ! ; ( READ-SCREEN WRITE-SCREEN 04/21/86 ) : READ-SCREEN ( reads and paints SCREEN# ) SCREEN# @ BLOCK THIS-BUF 1024 CMOVE .SCREEN ; : WRITE-SCREEN ( writes current SCREEN# to disk ) THIS-BUF SCREEN# @ BLOCK 1024 3DUP S= NOT IF CMOVE UPDATE ( ??? autodate ) ELSE 3DROP THEN ; ( GO-FIRST-SCREEN GO-LAST-SCREEN 04/21/86 ) : GO-FIRST-SCREEN SCREEN# @ IF WRITE-SCREEN 0 SCREEN# ! READ-SCREEN ELSE IG-TONE THEN ; : GO-LAST-SCREEN WRITE-SCREEN LAST-SCR @ SCREEN# ! READ-SCREEN ; ( GO-SCREEN- GO-SCREEN+ 04/26/86 ) : GO-SCREEN- ( -- : prev screen ) SCREEN# @ ?DUP IF WRITE-SCREEN 1- SCREEN# ! READ-SCREEN ELSE IG-TONE THEN ; : GO-SCREEN+ ( -- : next screen ) SCREEN# @ DUP LAST-SCR @ >= IF DROP IG-TONE EXIT THEN WRITE-SCREEN 1+ SCREEN# ! READ-SCREEN ; ( CURSOR! 04/21/86 ) : CURSOR! ( proposed cursor posn -- ) ( if new position would move to new line, save ) ( current value of line we are about to move to ) DUP 0< IF DROP IG-TONE EXIT THEN DUP 1023 > IF DROP IG-TONE EXIT THEN CURSOR @ ( old posn ) START-OF-LINE SWAP DUP CURSOR ! START-OF-LINE <> IF SAVE-LINE THEN .CURSOR ; ( REST-LINE REST-CURSOR 04/26/86 ) : REST-LINE ( -- ) ( restores current line as it was ) ( so we can later restore it if Oops pressed ) WAS-LINE CURSOR @ START-OF-LINE ( offset col 0 of this line) THIS-BUF + 64 CMOVE ; : REST-CURSOR ( -- ) WAS-CURSOR @ CURSOR ! ; ( GO-TOP 04/21/86 ) : GO-TOP ( -- : cursor to top left corner ) 0 CURSOR! ; ( GO-START-LINE 04/21/86 ) : GO-START-LINE ( cursor goes to start of current line ) ( same for all editors ) CURSOR @ START-OF-LINE CURSOR! ; ( GO-END-LINE 04/21/86 ) : GO-END-LINE ( cursor goes to the end of the current line ) ( first move cursor to start of line ) CURSOR @ START-OF-LINE CURSOR ! THIS-ADDR ( addr ) 64 ( len ) ( scan backwards in current line till find non blank ) BL <SCAN<> IF ( we found one ) ( offset = col ) 2+ 63 MIN CURSOR +! ELSE ( go to last col ) 63 CURSOR +! THEN .CURSOR ; ( GO-WAGGLE 04/21/86 ) : GO-WAGGLE ( alternate from beginning to end of line ) CURSOR-COL IF GO-START-LINE ELSE GO-END-LINE THEN ; ( Notes on GO-END-LINE 04/21/86 ) ;S We do not mean column 63. If the line is blank we go to col 1. If the line has a little stuff on it, we go to a place one space after the last word -- where we would write another word separated from the last by a space. Note this is different from most word processors that go to the space immediately after the last word. If there is no room after the last word, we go to col 63. ( GO-BOTTOM 04/21/86 ) : GO-BOTTOM ( cursor to bottom right corner ) THIS-BUF 1024 BL <SCAN<> IF ( found last char of screen ) CURSOR! GO-END-LINE ( usually to 2nd space after word ) ELSE 1023 CURSOR! ( screen totally blank ) THEN ; ( GO-INDENTED-LINE 04/21/86 ) : GO-INDENTED-LINE CURSOR-ROW 15 = IF IG-TONE EXIT THEN CURSOR @ START-OF-LINE 64 + THIS-BUF + 64 ( addr len next line ) BL SCAN<> IF ( n - go to first char next line ) CURSOR @ START-OF-LINE 64 + + CURSOR! ELSE HEAD DROP 64 BL SCAN<> IF ( n - go to col of first char this line ) CURSOR @ START-OF-LINE 64 + + CURSOR! ELSE ( go straight down ) CURSOR @ 64 + CURSOR! THEN THEN ; ( Notes on GO-INDENTED-LINE 04/21/86 ) ;S This behaves a little like the auto-indent feature of the Norton Editor. Carriage return invokes it. If there is data on the next line it goes to the first char. If there is none, it goes looks at the current line. It goes to the column that has data. If there is none, it goes straight down. If we are on the last line does nothing. ( GO-NEW-LINE 04/21/86 ) : GO-NEW-LINE ( always go to col 0 of next line ) ( if in last row, just go to start of line ) CURSOR-ROW 15 = IF GO-START-LINE ELSE CURSOR @ START-OF-LINE 64 + CURSOR! THEN ; ( GO-CHAR- 04/26/86 ) : GO-CHAR- ( move cursor 1 place left ) CURSOR @ 1- ( new suggested position ) CURSOR! ; ( GO-CHAR+ 04/26/86 ) : GO-CHAR+ ( move cursor 1 place right ) CURSOR @ 1+ ( new suggested position ) CURSOR! ; ( GO-UP 04/21/86 ) : GO-UP ( move cursor 1 line straight up ) CURSOR @ 64 - ( new suggested position ) CURSOR! ; ( GO-DOWN 04/21/86 ) : GO-DOWN ( move cursor 1 line straight down ) CURSOR @ 64 + ( new suggested position ) CURSOR! ; ( CURSOR- 04/26/86 ) : CURSOR- ( moves cursor back one position, perhaps to prev line ) ( if in upper left does nothing ) ( does not do a .CURSOR or noise ) CURSOR @ 1- DUP 0< ( off beginning of screen? ) IF DROP EXIT THEN CURSOR ! ; ( CURSOR+ 04/26/86 ) : CURSOR+ ( moves cursor forward one position, perhaps to next line ) ( if in bottom right does nothing ) ( does not do a .CURSOR or noise ) CURSOR @ 1+ DUP 1023 > ( off beginning of screen? ) IF DROP EXIT THEN CURSOR ! ; ( LOOK-TILL-BLANK- 04/26/86 ) : LOOK-TILL-BLANK- ( finds blank to left of current cursor pos ) ( if none ends up in upper left corner ) ( does NOT do a .CURSOR or make noise ) THIS-BUF ( start addr ) CURSOR @ ( len ) BL <SCAN ( scan back looking for blank ) IF ( found one ) CURSOR ! ELSE ( did not find one ) 0 CURSOR ! THEN ; ( LOOK-TILL-CHAR- 04/26/86 ) : LOOK-TILL-CHAR- ( finds non blank to left of current cursor pos ) ( if none ends up in upper left corner ) ( does NOT do a .CURSOR or make noise ) THIS-BUF ( start addr ) CURSOR @ ( len ) BL <SCAN<> ( scan back looking for non blank ) IF ( found one ) CURSOR ! ELSE ( did not find one ) 0 CURSOR ! THEN ; ( LOOK-TILL-BLANK+ 04/26/86 ) : LOOK-TILL-BLANK+ ( finds non blank to right of current cursor pos ) ( if none ends up in bottom right corner ) ( does NOT do a .CURSOR or make noise ) CURSOR+ THIS-ADDR ( start addr ) 1024 CURSOR @ - ( len rest of buffer ) BL SCAN ( scan forward looking for blank ) IF ( found one ) CURSOR +! ELSE ( did not find one ) 1023 CURSOR ! THEN ; ( LOOK-TILL-CHAR+ 04/26/86 ) : LOOK-TILL-CHAR+ ( finds non blank to right of current cursor pos ) ( if none ends up in bottom right corner ) ( does NOT do a .CURSOR or make noise ) CURSOR+ THIS-ADDR ( start addr ) 1024 CURSOR @ - ( len rest of buffer ) BL SCAN<> ( scan forward looking for non blank ) IF ( found one ) CURSOR +! ELSE ( did not find one ) 1023 CURSOR ! THEN ; ( GO-WORD- 04/26/86 ) : GO-WORD- ( go left one word ) CURSOR @ 0= ( in upper corner? ) IF IG-TONE EXIT THEN CURSOR- THIS-CHAR@ BL = IF LOOK-TILL-CHAR- THEN LOOK-TILL-BLANK- THIS-CHAR@ BL = IF CURSOR+ THEN WAS-CURSOR @ SAME-LINE? NOT IF SAVE-LINE THEN .CURSOR ; ( Notes on GO-WORD- 04/26/86 ) ;S Scans to beginning of current word. If we are on the first character, scans to the beginning of the previous word. If there is no previous word, ends up in upper left corner of the screen. If we are already in the upper left, it beeps. ( GO-WORD+ 04/26/86 ) : GO-WORD+ ( go right one word ) CURSOR @ 1023 = ( in bottom corner? ) IF IG-TONE EXIT THEN THIS-CHAR@ BL <> IF LOOK-TILL-BLANK+ THEN LOOK-TILL-CHAR+ WAS-CURSOR @ SAME-LINE? NOT IF SAVE-LINE THEN .CURSOR ; ( Notes on GO-WORD+ 04/26/86 ) ;S Scans to beginning of next word. If there is no next word, ends up in bottom right corner. If already there, beeps. ( ERASE-LINE- ERASE-LINE+ 04/26/86 ) : ERASE-LINE- ( erase line to left of cursor -- don't squeeze up ) CURSOR-COL IF HEAD 1- BLANK .HEAD ELSE IG-TONE THEN ; : ERASE-LINE+ ( erase line From cursor to end -- don't squeeze up ) TAIL BLANK .TAIL ; ( ERASE-LINE 04/21/86 ) : ERASE-LINE ( erases current line but does not squeeze up ) HEAD DROP 64 BLANK .HEAD .TAIL ; ( ERASE-TO-EOS 04/21/86 ) : ERASE-TO-EOS ( erases from current cursor position to end of screen ) THIS-BUF 1024 CURSOR @ - BLANK .EOS ; ( DELETE-LINE 04/21/86 ) : DELETE-LINE ( delete current line and squeeze up ) ( we don't simply repaint or all would go bright ) HEAD DROP DUP 64 + SWAP ( from addr, to addr ) 15 CURSOR-ROW - 64 Q* ( len ) CMOVE ( move up ) [ 15 64 Q* THIS-BUF + ] LITERAL 64 BLANK ( blank last line ) ( upper left is 3,6 in DOS coords ) [ 15 3 + >< 79 6 + + ] LITERAL CURSOR-ROW 3 + >< 6 + ( row/col-lr row/col-ul in DOS co-ordinates ) TBRIGHT HOW-SHOW@ >< ( attribute for blank line ) [ HEX ] 601 ( scroll up 1 line ) video-io 2DROP 2DROP [ DECIMAL ] ; ( Notes on DELETE-LINE 04/21/86 ) ;S We simply delete current line and squeeze up. We don't simply repaint or all would go bright. So we scroll the screen regen area directly preserving the dim/bright attributes on the lower lines. DOS will blank the screen during the scroll. This gets rid of snow and waiting for horizontal retrace. Note VMODE must be correctly set in DOS for this to work. If it is incorrectly set, the wrong screen will scroll. ( INSERT-LINE 04/21/86 ) : INSERT-LINE ( insert a line at current line and push rest down ) ( we don't simply repaint or all would go bright ) ( does not check if would push stuff off the deep end ) HEAD DROP DUP 64 + ( from addr, to addr ) 15 CURSOR-ROW - 64 Q* ( len ) CMOVE> ( move down ) CURSOR @ START-OF-LINE THIS-BUF + 64 BLANK ( blank line ) ( upper left is 3,6 in DOS coords ) [ 15 3 + >< 79 6 + + ] LITERAL CURSOR-ROW 3 + >< 6 + ( row/col-lr row/col-ul in DOS co-ordinates ) TBRIGHT HOW-SHOW@ >< ( attribute for blank line ) [ HEX ] 701 ( scroll down 1 line ) video-io 2DROP 2DROP [ DECIMAL ] ; ( Notes on INSERT-LINE 04/21/86 ) ;S Insert line is done with Alt-F3 in Volkswriter, but is done by hitting Return in Norton Editor and MS-Word. The Norton editor Return is like the split command unless the cursor is in column 1, in which case it is like the insert line. For our editor, we will use not use Return to create blank lines. Note VMODE must be correctly set in DOS for this to work. If it is incorrectly set, the wrong screen will scroll. ( SQUEEZE- 04/26/86 ) : SQUEEZE- ( n -- ) ( slides data n places right to land on CURSOR ) ( blanks out head end of line ) ( does not do a .HEAD ) >R HEAD ( from-addr len ) R@ - OVER R@ + ( to addr ) SWAP ( from-addr to-addr len ) CMOVE> ( shift right n places ) HEAD DROP ( start addr ) R> ( len ) BLANK ( blank out vacated area ) ; ( SQUEEZE+ 04/26/86 ) : SQUEEZE+ ( n -- ) ( slides data n places left to land on CURSOR ) ( blanks out tail end of line ) ( does not do a .TAIL ) >R TAIL ( from-addr len ) R@ - SWAP R@ + SWAP THIS-ADDR SWAP ( from-addr to-addr len ) CMOVE ( shift left n places ) CURSOR @ START-OF-LINE 64 + R@ - THIS-BUF + ( start addr ) R> ( len ) BLANK ( blank out vacated area ) ; ( SPREAD- 04/26/86 ) : SPREAD- ( n -- ) ( slides data n places left to open space at the cursor ) ( does not check if chars would be lost ) ( does not do a .HEAD ) >R HEAD R@ - SWAP DUP R@ + SWAP ROT ( from-addr to-addr len ) CMOVE ( shift left n places ) THIS-ADDR 1+ R@ - R> ( addr len ) BLANK ( blank out vacated area left of cursor and at cursor ) ; ( SPREAD+ 04/26/86 ) : SPREAD+ ( n -- ) ( slides data n places right to open space at the cursor ) ( does not check if chars would be lost ) ( does not do a .TAIL ) >R TAIL ( from-addr len ) R@ - THIS-ADDR R@ + SWAP ( from-addr to-addr len ) CMOVE> ( shift right n places ) THIS-ADDR R> ( len ) BLANK ( blank out vacated area ) ; ( DELETE-CHAR- 04/26/86 ) ;S : DELETE-CHAR- ( if Backspace does not erase in overstrike mode ) INSERT-MODE @ CASE 0 OF ( overstrike ) CURSOR @ 0= IF IG-TONE EXIT THEN CURSOR- ENDOF 1 OF ( slide rest of line 1 to left, blank last col ) CURSOR @ 0= IF IG-TONE EXIT THEN CURSOR- 1 SQUEEZE+ .TAIL ENDOF 2 OF 1 SQUEEZE- .HEAD ENDOF ENDCASE ; .CURSOR ; ( DELETE-CHAR- 04/26/86 ) : DELETE-CHAR- ( what backspace does for a living ) INSERT-MODE @ CASE 0 OF ( overstrike ) CURSOR @ 0= IF IG-TONE EXIT THEN CURSOR- BL THIS-CHAR! ENDOF 1 OF ( slide rest of line 1 to left, blank last col ) CURSOR @ 0= IF IG-TONE EXIT THEN CURSOR- 1 SQUEEZE+ .TAIL ENDOF 2 OF 1 SQUEEZE- .HEAD ENDOF ENDCASE .CURSOR ; ( Notes on DELETE-CHAR- 04/26/86 ) ;S There are many ways backspace can be handled. It may or may not squeeze up. It may or may not erase. You may or may not be allowed to wrap to the previous line. It way behave differently in Insert and overstrike mode. Both MS-Word and Norton Editor behave like this: Insert mode: move the cursor 1 left delete the char under the cursor squeeze up moving the char to the right under the cursor. Overstrike mode: move the cursor 1 left Don't erase anything Volkswriter erases in overstrike mode but does not squeeze up. ( Notes on DELETE-CHAR- 04/26/86 ) ;S Our editor always erases on backspace. For Calculator mode, we effectively undo the effect of the last keystroke by sliding the line to the left to remove the most recent keystroke. ( DELETE-CHAR+ 04/26/86 ) : DELETE-CHAR+ ( what Del does for a living ) ( slide rest of line 1 to left, blank last col ) INSERT-MODE @ 2 = IF ( calculator mode ) 1 SQUEEZE- .HEAD ELSE ( insert or overstrike ) 1 SQUEEZE+ .TAIL THEN .CURSOR ; ( Notes on DELETE-CHAR+ 04/26/86 ) ;S This is what the Del key does for a living. Norton Editor and MS Word both wrap the following line up as chars are deleted. Volkswriter does not wrap up the lines. Our Forth editors will not wrap up because of the dangers involved. All editors squeeze up as the char is deleted. Deleting a blank is no different than any other char. eg. Hitting Del repeatedly on a blank line is not an error. For Calculator mode, we get rid of current char and sqeeze up the other way so that right alignment is not disturbed. ( DELETE-TO-COL-1- 04/26/86 ) : DELETE-TO-COL-1- ( col -- ) ( insert style ) ( deletes from cursor left up to but not inc the col ) ( slides left moving cursor to left to the col ) ( does not do a .TAIL ) ( n ) CURSOR-COL - DUP 1+ CURSOR +! NEGATE SQUEEZE+ -1 CURSOR +! ; ( DELETE-TO-COL-2- 04/26/86 ) : DELETE-TO-COL-2- ( col -- ) ( calculator style ) ( deletes from cursor left up to but not including the col ) ( slides right leaving cursor where it is ) ( does not do a .HEAD ) ( n ) CURSOR-COL SWAP - ( n ) SQUEEZE- ; ( DELETE-LINE-1- 04/26/86 ) : DELETE-LINE-1- ( insert style ) ( deletes col 0 thru current cursor posn ) ( slides left. Leaves cursor in col 0 ) CURSOR-COL DUP NEGATE CURSOR +! 1+ SQUEEZE+ ; ( DELETE-LINE-2- 04/26/86 ) : DELETE-LINE-2- ( calculator style ) ( erases col 0 thru current cursor posn ) ( Leaves cursor where it is ) HEAD BLANK ; ( DELETE-WORD-1- 04/26/86 ) : DELETE-WORD-1- ( what Ctrl-W does for a living ) THIS-CHAR@ BL = ( insert style ) IF ( on space ) HEAD ( addr len ) BL <SCAN<> IF ( n ) DELETE-TO-COL-1- ELSE CURSOR-COL IF DELETE-LINE-1- ELSE IG-TONE EXIT THEN THEN ELSE ( in middle of word ) HEAD BL <SCAN IF ( found blank at start of word ) ( n ) DELETE-TO-COL-1- HEAD BL <SCAN<> IF DELETE-TO-COL-1- THEN ELSE ( word goes all the way to start of line ) DELETE-LINE-1- THEN THEN .TAIL .CURSOR ; ( DELETE-WORD-2- 04/26/86 ) : DELETE-WORD-2- ( what Ctrl-W does for a living ) THIS-CHAR@ BL = ( calculator style ) IF ( on space ) HEAD ( addr len ) BL <SCAN<> IF ( some spaces after a word ) DELETE-TO-COL-2- ELSE ( rest of line is blank ) IG-TONE EXIT THEN ELSE ( in middle of word ) HEAD BL <SCAN IF ( found blank at start of word ) ( n ) DELETE-TO-COL-2- HEAD BL <SCAN<> IF DELETE-TO-COL-2- THEN ELSE ( word goes all the way to start of line ) DELETE-LINE-2- THEN THEN .HEAD ; ( DELETE-WORD- 04/26/86 ) : DELETE-WORD- ( what Ctrl-W does for a living ) INSERT-MODE @ 2 = IF DELETE-WORD-2- ( calculator style ) ELSE DELETE-WORD-1- ( normal style ) THEN ; ( Notes on DELETE-WORD- 04/26/86 ) ;S Volkswriter has no delete left word. MS Word always deletes a word and its trailing spaces, but has no delete left word per se. Norton editor has a very strange delete left word. If the cursor is in the middle of a word it deletes the characters to the left of the cursor, but not the char at the cursor. If it is on the space after the end of a word it deletes the previous word. If it is on a space between words itdeletes the space to the left. ( Notes on DELETE-WORD- 04/26/86 ) ;S None of these behaviours is suitable for a Forth editor, so we do the following. When we are in calculator mode, If we are in the space between words, we want the spaces to the left and the current space to be deleted so that everything willright align on the current column. If we are on the last char of a word, we delete that word and its preceeding spaces so that the preceeding word will align. If we are in the middle of a word, we delete that char and all chars in the word to the left and the preceeding spaces. Note that space appears at the BEGINNING of the line as deleted.( Notes on DELETE-WORD- 04/26/86 ) ;S When we are in overstrike or insert mode, If we are in the space between words, we want the spaces to the left and the current space to be deleted with the cursor ending up on the last char of the previous word. If we are on the last char of a word, we delete that word and its preceeding spaces with cursor ending up on last char of the previous word. If we are in the middle of a word, we delete that char and all chars in the word to the left and the preceeding spaces, again with the cursor ending up on the last char of the previous word. Note that space appears at the END of the line as deleted. ( DELETE-WORD+ 04/26/86 ) : DELETE-WORD+ ( what Alt-W does for a living ) THIS-CHAR@ BL = IF ( on space ) TAIL ( addr len ) BL SCAN<> IF ( some spaces on front of word ) ( n ) SQUEEZE+ .TAIL ELSE ( rest of line is blank ) IG-TONE THEN ELSE ( in middle of word ) TAIL BL SCAN IF ( found blank at end of word ) ( n ) SQUEEZE+ ( get rid of word ) TAIL BL SCAN<> IF SQUEEZE+ ( rid spaces after word ) THEN .TAIL ELSE ( word goes all the way to the end of line ) TAIL BLANK .TAIL THEN THEN ; ( Notes on DELETE-WORD+ 04/26/86 ) ;S Norton Editor and MS Word wrap up the following line. Volkswriter moves the cursor to the following line if the rest is blank. MS-Word does not have such a feature Norton editor If in middle of a word, deletes that char to end of word If on space in front of word, deletes whole word If on space before the space before a word, just deletes the space. Volkswriter If in middle of a word, deletes that char to end of word and succeeding spaces. If in space in front of word, deletes spaces before word and the word. ( Notes on DELETE-WORD+ 04/26/86 ) ;S The approaches used by Norton and Volkswriter are NOT used by NED. We want to use DELETE-WORD+ to facilitate column alignment. If you hit DELETE-WORD+ you want just the space before the word removed -- not the word. However if you delete a word, you want its trailing spaces deleted as well so that the succeeding word will align where the deleted one was. ( SEARCH-BUF-1 04/26/86 ) : SEARCH-BUF-1 ( -- addr of buffer to search ) ( search this screen ) CASE-SENSITIVE @ IF THIS-BUF ( search directly ) ELSE THIS-BUF SEARCH-BUF-UC 1024 CMOVE SEARCH-BUF-UC 1024 LC>COMP TRT ( converts lower case to plain upper case ) ( converts accented char to ) ( plain unaccented capital letter ) ( converts control chars & symbols to ? ) SEARCH-BUF-UC THEN ; ( SEARCH-BUF-2 04/26/86 ) : SEARCH-BUF-2 ( -- addr of buffer to search ) ( search some other screen ) CASE-SENSITIVE @ IF SEARCH-SCREEN# @ BLOCK ( search directly ) ELSE SEARCH-SCREEN# @ BLOCK SEARCH-BUF-UC 1024 CMOVE SEARCH-BUF-UC 1024 LC>COMP TRT ( converts lower case to plain upper case ) ( converts accented char to ) ( plain unaccented capital letter ) ( converts control chars & symbols to ? ) SEARCH-BUF-UC THEN ; ( SEARCH-BUF 04/26/86 ) : SEARCH-BUF ( -- addr of buffer to search ) SEARCH-SCREEN# @ SCREEN# @ = IF ( searching the current screen ) SEARCH-BUF-1 ELSE ( searching some other screen ) SEARCH-BUF-2 THEN ; ( SEARCH-SCREEN- 04/26/86 ) : SEARCH-SCREEN- ( -- success flag ) ( searches search screen backward for string ) ( starts looking for the start of the string at the ) ( current cursor position not one before it. ) SEARCH-BUF SEARCH-CURSOR @ SEARCH-LEN @ + ( addr len top corner to end of poss match starting at cur ) SEARCH-FOR SEARCH-LEN @ ( addr len of thing to search for ) <SEARCH IF ( found it at offset, retreat cursor to it ) SEARCH-CURSOR ! YES ELSE ( not found ) NO THEN ; ( SEARCH-SCREEN+ 04/26/86 ) : SEARCH-SCREEN+ ( -- success flag ) ( searches search screen forward for string ) ( starts looking AT the current cursor pos ) ( not one past it. ) SEARCH-BUF SEARCH-CURSOR @ + 1024 SEARCH-CURSOR @ - ( addr len cursor to bottom corner ) SEARCH-FOR SEARCH-LEN @ ( addr len of thing to search for ) SEARCH IF ( found it at offset, advance cursor to it ) SEARCH-CURSOR +! YES ELSE ( not found ) NO THEN ; ( ?STOP-SEARCH 04/29/86 ) : ?STOP-SEARCH ( -- flag if search should stop ) ( Superkey can get in trouble if we do ?TERMINAL ) ( a keystroke gets interpreted as an Abort ) ( But there is not much we can do about this ) ?TERMINAL DUP IF KEY16 DROP EXIT-TONE ( warn we are aborting ) THEN ; ( SEARCH-FILE- 04/28/86 ) : SEARCH-FILE- ( -- success flag ) ( search previous screens ) NO ( presume not found ) .SEARCHING SCREEN# @ IF 0 SCREEN# @ 1- DO ( backwards ) I SEARCH-SCREEN# ! 1023 SEARCH-CURSOR ! SEARCH-SCREEN- ( -- success flag ) IF WRITE-SCREEN SEARCH-SCREEN# @ SCREEN# ! READ-SCREEN SEARCH-CURSOR @ CURSOR ! .CURSOR DROP YES LEAVE THEN ?STOP-SEARCH IF LEAVE THEN -1 +LOOP THEN ; ( SEARCH-FILE+ 04/28/86 ) : SEARCH-FILE+ ( -- success flag ) ( search subseqent screens ) NO ( presume not found ) .SEARCHING SCREEN# @ LAST-SCR @ < IF LAST-SCR @ 1+ SCREEN# @ 1+ DO I SEARCH-SCREEN# ! 0 SEARCH-CURSOR ! SEARCH-SCREEN+ ( -- success flag ) IF WRITE-SCREEN SEARCH-SCREEN# @ SCREEN# ! READ-SCREEN SEARCH-CURSOR @ CURSOR ! .CURSOR DROP YES LEAVE THEN ?STOP-SEARCH IF LEAVE THEN LOOP THEN ; ( SEARCH- 04/28/86 ) : SEARCH- ( -- success flag ) ( search from this screen back ) SCREEN# @ SEARCH-SCREEN# ! CURSOR @ ?DUP IF 1- SEARCH-CURSOR ! ( scan current screen ) SEARCH-SCREEN- ( -- success flag ) IF SEARCH-CURSOR @ CURSOR ! .CURSOR YES EXIT THEN THEN ( no luck on current screen, try earlier ones ) SEARCH-FILE- .SEARCH ; ( SEARCH+ 04/28/86 ) : SEARCH+ ( -- success flag ) ( search this and subsequent screens ) SCREEN# @ SEARCH-SCREEN# ! CURSOR @ 1023 < IF CURSOR @ 1+ SEARCH-CURSOR ! ( scan current screen ) SEARCH-SCREEN+ ( -- success flag ) IF SEARCH-CURSOR @ CURSOR ! .CURSOR YES EXIT THEN THEN ( no luck on current screen, try later ones ) SEARCH-FILE+ .SEARCH ; ( PREP-SEARCH-FOR 04/28/86 ) : PREP-SEARCH-FOR ( prepares SEARCH-FOR prior to starting a search ) SEARCH-FOR-AS-KEYED SEARCH-FOR SEARCH-LEN @ CMOVE CASE-SENSITIVE @ NOT IF SEARCH-FOR SEARCH-LEN @ LC>COMP TRT ( converts accented char to ) ( plain unaccented capital letter ) ( converts control chars & symbols to ? ) THEN ; ( CONTINUE-SEARCH+ CONTINUE-SEARCH- 04/28/86 ) : CONTINUE-SEARCH+ ( continues searching back for the same thing ) PREP-SEARCH-FOR SEARCH+ IF FOUND-TONE ELSE NOT-FOUND-TONE THEN ; : CONTINUE-SEARCH- ( continues searching back for the same thing ) PREP-SEARCH-FOR SEARCH- IF FOUND-TONE ELSE NOT-FOUND-TONE THEN ; ( POINT-AT-SEARCH-FOR 04/28/86 ) : POINT-AT-SEARCH-FOR ( get word pointed at by cursor as the thing to search for ) THIS-CHAR@ BL <> IF TAIL BL SCAN IF TAIL DROP OVER ( len addr len ) ELSE TAIL DUP ROT ROT THEN SEARCH-FOR-AS-KEYED SWAP CMOVE SEARCH-LEN ! .SEARCH THEN ; ( KEYIN-SEARCH-FOR 04/28/86 ) : KEYIN-SEARCH-FOR ( keyin the thing to search for ) SEARCH-FOR-AS-KEYED SEARCH-FOR SEARCH-LEN @ CMOVE ( save ) ( display on row 20 col 6 ) 6 20 GOTOXY ( we use standard DOS stuff to get this in ) ( we better be in the right MODE ) SEARCH-FOR-AS-KEYED 64 EXPECT ( Esc will terminate EXPECT in special version ) SPAN @ ?DUP IF ( got something ) SEARCH-LEN ! ELSE SEARCH-FOR SEARCH-FOR-AS-KEYED SEARCH-LEN @ CMOVE THEN .SEARCH .CURSOR ; ( GET-SEARCH-FOR 04/28/86 ) : GET-SEARCH-FOR ( start off with old search for. ) ( if is word pointed at, use that in preference ) ( if keys in something, use that in preference ) POINT-AT-SEARCH-FOR KEYIN-SEARCH-FOR ( possible to have a null SEARCH-FOR ) ( if so it will not match anything ) ; ( START-SEARCH- START-SEARCH+ 04/28/86 ) : START-SEARCH- GET-SEARCH-FOR CONTINUE-SEARCH- ; : START-SEARCH+ GET-SEARCH-FOR CONTINUE-SEARCH+ ; ( Notes on searching 04/26/86 ) ;S One problem of searching is this: How do you design the search so that it will find things in the upper left and lower right corner? If your search bypasses the match at the current cursor position, it would not find these corner elements in a multi- screen search because the cursor starts off in a corner. If your search does not bypass the match at the current cursor position, it continues to find the same thing over and over. The search must temporarily advance the cursor; if no find it retreats it again. ( Notes on searching 04/26/86 ) ;S Consider a screen that looked like this: abbbbbc and you were searching for: bb Presuming the cursor always lands on the start of a match, you should get 4 matches searching forward and 4 matches searching backward. You could also make an argument that you should get only one or two matches searching either way, especially for replace. I have decided to find 4 matches. Note that a simple-minded implementation would find 4 matches forward and 2 backward. ( Notes on searching 04/26/86 ) ;S While we are searching, we need to keep track of 3 things: 1. the current state of the screen we are on. ( THIS-BUF ) Where its cursor is CURSOR. 2. how that screen used to look ( SCREEN# @ BLOCK ) 3. what screen we are searching ( SEARCH-SCREEN# @ BLOCK ) Where its cursor is - SEARCH-CURSOR. ( Notes on searching case insensitivity 04/26/86 ) ;S If we need a case insensitive search, we need to translate the screen we are searching and the thing we are searching for (SEARCH-FOR) to upper case before we search. We cannot do this directly in the BLOCK buffer, so for case insensitive searches we need a copy of the screen being searched in SEARCH-BUF-UC. Searching is a mess. We sometimes have to search THIS-BUF, sometimes SEARCH-SCREEN# BLOCK and sometimes SEARCH-BUF-UC. So we invent a SEARCH-BUF that cleverly figures out which of the three we should be looking at. ( OOPS-SCREEN OOPS-LINE 04/21/86 ) : OOPS-SCREEN ( get screen back the way it was ) READ-SCREEN ; : OOPS-LINE ( exchange how Was and how is ) WAS-LINE THIS-BUF CURSOR @ START-OF-LINE + 64 EXCHANGE .HEAD .TAIL ; ( OVERSTRIKE INSERT CALCULATOR 04/21/86 ) : OVERSTRIKE 0 INSERT-MODE ! CURTHIN .CURSOR ; : INSERT 1 INSERT-MODE ! CURFAT .CURSOR ; : CALCULATOR 2 INSERT-MODE ! CURGROSS .CURSOR ; ( TOGGLE-INSERT 04/23/86 ) : TOGGLE-INSERT ( toggle insert through all 3 modes ) ( effectively adds 1 to INSERT-MODE ) INSERT-MODE @ CASE 0 OF INSERT ENDOF 1 OF CALCULATOR ENDOF 2 OF OVERSTRIKE ENDOF ENDCASE ; ( HIT-NORM 04/23/86 ) : HIT-NORM ( key -- ) ( hit a standard key a..z A..Z 0..9 etc. ) INSERT-MODE @ CASE 0 OF THIS-CHAR! GO-CHAR+ ENDOF 1 OF 1 SPREAD+ THIS-CHAR! .TAIL GO-CHAR+ ENDOF 2 OF 1 SPREAD- THIS-CHAR! .HEAD ENDOF ENDCASE ; ( HIT-FUNCT 04/23/86 ) : HIT-FUNCT ( key -- ) CASE 317 ( F3 ) OF GO-WAGGLE ENDOF 321 ( F7 ) OF CONTINUE-SEARCH- ENDOF 322 ( F8 ) OF CONTINUE-SEARCH+ ENDOF 324 ( F10 ) OF OOPS-LINE ENDOF OTHERS OF IG-TONE ENDOF ENDCASE ; ( HIT-ALT-FUNCT 04/23/86 ) : HIT-ALT-FUNCT ( key -- ) CASE 362 ( Alt-F3 ) OF INSERT-LINE ENDOF 363 ( Alt-F4 ) OF DELETE-LINE ENDOF 369 ( Alt-F10 ) OF OOPS-SCREEN ENDOF OTHERS OF IG-TONE ENDOF ENDCASE ; ( HIT-KEYPAD 04/23/86 ) : HIT-KEYPAD ( key - ) CASE 327 ( home ) OF GO-START-LINE ENDOF 328 ( up ) OF GO-UP ENDOF 329 ( PgUp ) OF GO-SCREEN- ENDOF 331 ( left ) OF GO-CHAR- ENDOF 333 ( right ) OF GO-CHAR+ ENDOF 335 ( End ) OF GO-END-LINE ENDOF 336 ( down ) OF GO-DOWN ENDOF 337 ( PgDn ) OF GO-SCREEN+ ENDOF 338 ( Ins ) OF TOGGLE-INSERT ENDOF 339 ( Del ) OF DELETE-CHAR+ ENDOF OTHERS OF IG-TONE ENDOF ENDCASE ; ( HIT-CTRL-KEYPAD 04/23/86 ) : HIT-CTRL-KEYPAD ( key - ) CASE 371 ( left ) OF GO-WORD- ENDOF 372 ( right ) OF GO-WORD+ ENDOF 373 ( End ) OF GO-BOTTOM ENDOF 374 ( PgDn ) OF GO-LAST-SCREEN ENDOF 375 ( home ) OF GO-TOP ENDOF 388 ( PgUp ) OF GO-FIRST-SCREEN ENDOF 416 ( up ) OF GO-UP ENDOF 420 ( down ) OF GO-DOWN ENDOF 421 ( Ins ) OF TOGGLE-INSERT ENDOF 422 ( Del ) OF DELETE-CHAR+ ENDOF OTHERS OF IG-TONE ENDOF ENDCASE ; ( HIT-OTHER 04/23/86 ) : HIT-OTHER ( key - ) CASE 3 ( Ctrl-C ) OF CONTINUE-SEARCH- ENDOF 6 ( Ctrl-F ) OF START-SEARCH- ENDOF 8 ( Bs ) OF DELETE-CHAR- ENDOF 9 ( Tab ) OF IG-TONE ENDOF 10 ( Ctrl-Cr ) OF GO-NEW-LINE ENDOF 12 ( Ctrl-L ) OF ERASE-LINE- ENDOF 13 ( Cr ) OF GO-INDENTED-LINE ENDOF 23 ( Ctrl-W ) OF DELETE-WORD- ENDOF 127 ( Ctrl-Bs ) OF DELETE-CHAR- ENDOF 407 ( Ctrl-Tab ) OF IG-TONE ENDOF OTHERS OF IG-TONE ENDOF ENDCASE ; \ EDIT FORTH DEFINITIONS : EDIT [ EDITOR ] CLEARSCREEN SCREEN# @ 0 LAST-SCR @ CORRAL SCREEN# 1 READ-SCREEN 0 CURSOR ! .CURSOR BEGIN KEY16 DUP CASE 32 126 RANGEOF HIT-NORM ENDOF 130 ( Alt-W ) OF DROP DELETE-WORD+ ENDOF 149 ( Alt-F ) OF DROP START-SEARCH+ ENDOF 153 ( Alt-K ) OF DROP DELETE-LINE ENDOF 154 ( Alt-L ) OF DROP ERASE-LINE+ ENDOF 128 255 RANGEOF HIT-NORM ENDOF 315 324 RANGEOF HIT-FUNCT ENDOF 327 339 RANGEOF HIT-KEYPAD ENDOF 360 369 RANGEOF HIT-ALT-FUNCT ENDOF 371 422 RANGEOF HIT-CTRL-KEYPAD ENDOF 27 ( Esc ) OF DROP WRITE-SCREEN EXIT ENDOF OTHERS OF HIT-OTHER ENDOF ENDCASE AGAIN ; ( Key assignments 04/21/86 ) ;S plain F1 F2 Home Up PgUp Bs 315 316 327 328 329 8 F3 F4 left 5 right 317 318 331 332 333 Enter F5 F6 End Down PgDn 13 319 320 335 336 337 F7 F8 321 322 Ins Del Tab F9 F10 338 339 9 323 324 ( Key assignments 04/21/86 ) ;S with Ctrl and Superkey running F1 F2 Home Up PgUp Bs 350 351 375 416 388 127 F3 F4 left 5 right 352 353 371 418 372 Enter F5 F6 End Down PgDn 10 354 355 373 420 374 F7 F8 356 357 Ins Del Tab F9 F10 421 422 407 358 359 ( Key assignments 04/21/86 ) ;S with Ctrl and no Superkey running F1 F2 Home Up PgUp Bs 350 351 375 x 388 127 F3 F4 left 5 right 352 353 371 418 372 Enter F5 F6 End Down PgDn 10 354 355 373 x 374 F7 F8 356 357 Ins Del Tab F9 F10 x x 428 358 359 ( Key assignments 04/21/86 ) ;S with Alt and Superkey running F1 F2 Home Up PgUp Bs 360 361 430 431 432 427 F3 F4 left 5 right 362 363 434 435 436 Enter F5 F6 End Down PgDn 284 364 365 438 439 440 F7 F8 366 367 Ins Del F9 F10 441 442 368 369 ( Key assignments 04/21/86 ) ;S with Alt and no Superkey running F1 F2 Home Up PgUp Bs 360 361 07 08 09 x F3 F4 left 5 right 362 363 04 05 06 Enter F5 F6 End Down PgDn x 364 365 01 02 03 F7 F8 366 367 Ins Del F9 F10 x x 368 369 ( Special Key assignments 04/21/86 ) ;S with KEY16 Ctrl-C Alt-C 3 139 Ctrl-F Alt-F 6 149 Ctrl-K Alt-K 11 153 Ctrl-L Alt-L 12 154 Ctrl-W Alt-W 23 273 130 ( 05/09/86 ) ( LAST SCREEN 04/23/86 ) This is very neat line of stuff a of stuff aoeu aoeu aoeu aoeuao aoeu aoeu
