\ load screen 910516jb ) decimal 2 32 thru \ Screeneditor variables constants 910513jb ) decimal vocabulary Screeneditor immediate Screeneditor definitions variable &old-mode variable &mode \ current mode (overstrike or insert) variable &cursor \ cursor position variable &update \ update flag variable &update-id \ update id flag variable &e-id 10 allot &e-id 12 32 fill 1 &mode ! 0 &cursor ! 0 &update ! 1 &update-id ! 6 constant %x-off \ x offset for cursor positioning 2 constant %y-off \ y offset for cursor positioning 16 constant l/scr \ lines per screen l/scr c/l * constant c/scr \ characters per screen \ -tidy e-update 910508jb ) : -tidy ( addr len --- ) over + swap do \ run through the string i c@ dup bl < swap 126 > or \ is it a control char? if bl i c! then \ yes, replace it with a blank loop ; ( -tidy replaces all control characters in a specified range with blanks ) : e-update ( --- ) 1 &update ! ; \ get-user-id 910516jb ) : get-user-id ( --- ) &e-id 10 -trailing 0= if \ is user id blank? cr ." enter date and id, e.g as 910430jb ) " 10 expect \ let the user enter 10 chars &e-id 10 -tidy \ replace control chars with blanks &e-id 10 -trailing 0= \ is user id blank? If so if 0 &update-id ! then drop \ don't bother to update id else drop then ; ( get-user-id checks to see if the user's id has been set, and if not, prompts him/her for it and saves it ) \ cfind 910509jb ) : cfind ( char addr len --- [n] flag ) >r >r 0 0 rot r> r> \ 0 0 c a l over + swap do \ 0 0 c dup i c@ = \ are the chars equal if rot 1+ \ indicate success rot rot \ put it back leave \ and get out else swap 1+ swap \ increment count then loop drop swap \ get rid of char if 1 else drop 0 then ; \ and report back \ >line# line#> ?printable f2key=free 910511jb ) : >line# ( pos --- line# ) c/l / ; ( convert a character position to a line number ) : line#> ( line# --- pos ) c/l * ; ( convert a line number to a character position ) : ?printable ( char --- flag ) dup 31 > swap 127 < and ; : f2key ; \ make it whatever you want \ curpos +curpos move-cursor 910509jb ) : curpos ( --- pos ) &cursor @ ; : +curpos ( n --- ) &cursor +! curpos 0 max \ and do bounds checking [ c/scr 1- ] literal \ char per screen - 1 min &cursor ! ; \ always valid : move-cursor ( n --- ) +curpos \ move the cursor curpos c/l /mod \ raw x y %y-off + swap \ add in y offset %x-off + swap \ add in x offset xycur ; \ and move there \ buf-adr bufadr buf-move 910520jb ) : buf-adr ( pos --- addr ) scr @ block + ; : bufadr ( --- addr ) curpos scr @ block + ; ( bufadr converts the current cursor position to the address within the disk buffer which corresponds to that position ) : buf-move ( from to len --- ) rot buf-adr \ address of curpos-from rot buf-adr \ address of curpos-to rot bmove \ get length back on top and move e-update ; ( buf-move performs a move operation on the characters in the disk buffer corresponding to the given cursor positions. ) \ ?empty-line r-l-u-d-arrowkeys 910509jb ) : ?empty-line ( line# --- bool ) line#> buf-adr c/l \ addr len -trailing \ remove trailing blanks swap drop 0= ; \ report success if all blanks ( ?empty-line returns true if the specified line number is completely blank. Otherwise it returns false. ) : r-arrowkey ( --- ) 1 +curpos ; \ move right by one : l-arrowkey ( --- ) -1 +curpos ; \ move left by one : u-arrowkey ( --- ) c/l negate +curpos ; \ move up by one : d-arrowkey ( --- ) c/l +curpos ; \ move down by one \ returnkey tabkey f6key=insert/replaceMode 910511jb ) : returnkey ( --- ) curpos >line# \ get line number of current line 1+ \ increment by one [ l/scr 1- ] literal min \ don't move below bottom line#> &cursor ! ; \ and move there ( returnkey moves the cursor to the beginning of the next line. if the cursor is at the bottom of the screen, it remains there) : tabkey ( --- ) \ move cursor 8 places per tab 8 curpos 8 mod - +curpos ; : f6key ( --- ) \ toggle between one and zero 1 &mode @ - &mode ! ; \ for insert or replace mode \ ?in-screen display-status 910509jb ) : ?in-screen ( direction --- bool ) dup curpos + 0< \ at beginning? swap curpos + [ c/scr 1- ] literal > or 0= ; \ at end? ( ?in-screen returns true if the current cursor position is within the proper confines of the screen. ) : display-status ( --- ) &mode @ &old-mode @ <> if 71 0 xycur &mode @ if ." insert " else ." replace" then &mode @ &old-mode ! then ; \ chrs2eol display2eol 910520jb ) : chrs2eol ( --- n ) curpos c/l mod c/l swap - ; ( returns the number of characters from cursor to end of line ) : display2eol ( --- ) bufadr chrs2eol -trailing type eeol ; ( display2eol displays the rest of the line starting from the current cursor position. ) \ display-to-eos to-pad 910520jb ) : display-to-eos ( line# --- ) curpos swap \ save current cursor position l/scr swap do \ run through rest of screen i line#> &cursor ! \ set cursor position 0 move-cursor display2eol \ and display line from there loop &cursor ! 0 move-cursor ; \ restore cursor position : to-pad ( --- ) \ move text from cursor to eeol to pad pad 74 32 fill bufadr pad \ fromadr toadr chrs2eol bmove ; \ count and move to pad \ paste-pad f10key=paste-words 910520jb ) : paste-pad ( --- ) \ append from cursor to eol pad bufadr \ fromadr toadr chrs2eol bmove \ count and move to buffer display2eol e-update ; \ show it on screen : f10key pad chrs2eol -trailing 1+ \ add a space chrs2eol min \ length to use &mode @ if bufadr over over over + swap \ insert mode chrs2eol swap - bmove then \ move chars bufadr swap bmove \ paste pad display2eol e-update ; \ display it \ open-line 910520jb ) : open-line ( --- ) curpos [ l/scr 1- ] literal \ last line number ?empty-line if >line# dup 1+ \ expand if empty line#> dup dup \ p p p c/l + \ p from to c/scr over - \ p from to len buf-move \ text moved in buffer buf-adr c/l 32 fill \ insert blank line e-update curpos >line# 1+ line#> &cursor ! display-to-eos else beep then ; ( open-line checks that the last line is empty. If so it inserts a blank line below the cursor ) \ delete-line 910509jb ) : delete-line ( --- ) curpos >line# dup dup line#> &cursor ! to-pad line#> dup \ pos pos c/l + swap \ from to over c/scr swap - \ from to len buf-move \ move it [ l/scr 1- ] literal \ insert a blank line line#> buf-adr c/l 32 fill \ at the bottom of the screen e-update display-to-eos ; ( deletes the specified line and replaces the last line of the screen with a blank line ) \ blank-line erase-eol transfer-line 910520jb ) : blank-line ( --- ) \ fill current line with blanks curpos \ get current cursor position >line# line#> &cursor ! \ get to beginning of line to-pad \ save in pad bufadr c/l 32 fill \ blank out line in buffer 0 move-cursor eeol e-update ; \ erase line from beginning : erase-eol ( --- ) \ erase from cursor to eol to-pad \ save in pad bufadr chrs2eol 32 fill 0 move-cursor eeol e-update ; \ erase line : transfer-line ( --- ) to-pad scr @ 0 scr ! paste-pad update scr ! d-arrowkey 0 &update ! ; \ split-line clr-eos 910511jb ) : split-line ( --- ) \ split line at cursor erase-eol open-line paste-pad ; : clr-eos ( --- ) \ clear from cursor to end of screen curpos erase-eol \ save cursor position 15 curpos >line# do d-arrowkey blank-line loop &cursor ! 0 move-cursor ; \ cursor back to old spot \ ins-char f3key f4key f5key ( printing keys ) 910520jb ) : ins-char ( char --- ) \ insert a character curpos dup 1+ \ char pos from to chrs2eol 1- \ char pos from to len buf-move \ move it bufadr c! ; \ and stick in char ( ins-char inserts the character into the disk buffer. The characters falling off the right end of the line are lost.) : f3key scr @ triad ; \ requires a printer : f4key scr @ printscreen ; \ requires a printer : f5key printpad ; \ requires a printer \ del-char delkey bspkey 910520jb ) : del-char ( --- ) curpos dup dup 1+ swap \ pos from to chrs2eol 1- \ pos from to len buf-move \ move it chrs2eol + 1- \ position at eol buf-adr bl swap c! ; \ and stick in a blank ( del-char deletes the character at the cursor position ) : delkey ( --- ) \ delete char and close up from the right del-char display2eol e-update ; : bspkey ( --- ) \ delete char to the left and move there -1 +curpos 0 move-cursor delkey ; \ move-word advance-word reverse-word 910520jb ) : move-word ( direction --- n ) \ negative num moves back curpos swap 0 begin \ save current cursor pos over ?in-screen \ within screen bufadr c@ bl <> and while \ and while not a blank over +curpos 1+ \ move and bump count repeat begin \ must be a blank here over ?in-screen \ within screen bufadr c@ bl = and while \ and still a blank over +curpos 1+ \ move and bump count repeat \ at a non-blank when here swap drop swap &cursor ! ; \ remove direction : advance-word ( --- ) 1 move-word +curpos ; : reverse-word ( --- ) -1 move-word negate +curpos ; \ join-lines e-list name-change 910520jb ) : join-lines ( --- ) \ join lower line at cursor curpos erase-eol returnkey bufadr c@ bl = if advance-word then erase-eol &cursor ! 0 move-cursor paste-pad ; : e-list ( --- ) \ show current screen without line numbers 1 &mode @ - &old-mode ! 0 &cursor ! 0 &update ! csi 72 emit colm 13 emit scr @ 3 .r cr 0 display-to-eos display-status ; : name-change ( --- ) \ ^n update the user id c/scr move-cursor csi 66 emit csi 67 emit eeos cr 1 &update-id ! &e-id 12 32 fill get-user-id e-list ; \ word-delete 910520jb ) : word-delete ( --- ) \ deletes until colour of char changes 1 move-word \ move over 1 word bufadr \ but less than last blank chrs2eol 1- \ on the current line -trailing swap drop min \ for speed pad 72 32 fill \ blank pad for undo with ^P bufadr over \ fromadr length for undo pad swap bmove \ toadr length for undo 0 do del-char loop \ delete text display2eol ; \ and show result ( word-delete deletes from the cursor to the right the remaining characters of the word or leading spaces ) \ flush-scr esckey 910516jb ) : flush-scr ( --- ) \ ^f flush all updated buffers &update @ if \ has screen changed? &update-id @ if \ update id ? &e-id [ c/l 10 - ] literal \ from to buf-adr 10 cmove then update \ write new id then flush 0 &update ! ; \ save block : esckey ( --- ) flush-scr c/scr move-cursor \ go to end of screen csi 66 emit csi 67 emit eeos \ clear bottom of screen oldbase @ base ! [compile] forth quit ; \ return to Forth \ if the screen has been modified, the user id is inserted in \ the top right hand corner and the screen is saved to disk. \ quit-editor f1key f8key f9key 910516jb ) : quit-editor ( --- ) \ ^q leave editor c/scr move-cursor empty-buffers \ go to end of screen csi 66 emit csi 67 emit eeos cr ." All changes canceled " \ tell user oldbase @ base ! [compile] forth quit ; \ get out of editor : f1key ( --- ) empty-buffers e-list ; \ Oops key, redisplay : f8key ( --- ) \ save any changes and display previous scr. flush-scr scr @ if -1 scr +! then e-list ; : f9key ( --- ) \ save any changes and display next screen. flush-scr scr @ file# filesize @ 1 - < if 1 scr +! then e-list ; \ e-init helpkey 910516jb ) : e-init ( [n] --- ) depth if dup file# filesize @ < \ edit last screen if stack if scr ! then then \ is empty or not valid &update-id @ if get-user-id then \ get date and name once base @ oldbase ! decimal \ save base and go decimal csi 72 emit colm 13 emit \ home cursor, show divider scr @ 3 .r cr \ print screen number l/scr 0 do i 4 .r \ build the screen outline eeol cr loop colm ; \ cleared, show bottom line : helpkey empty-buffers scr @ var ! 33 scr ! 12 emit e-list 12 21 xycur ." Press space bar to continue" key drop 1 scr +! e-list key drop 1 scr +! e-list key drop var @ scr ! 12 emit e-init e-list ; \ %c-chars 910516jb )hex create %c-chars 22 c, \ length of table 1 c, 2 c, 3 c, \ ^advance-word ^blank-line ^clear-eos 4 c, 5 c, 6 c, \ ^delete-line ^eeol ^flush-scr 8 c, 9 c, a c, \ ^h-backspacekey ^i-tabkey ^join-lines d c, e c, f c, \ ^m-returnkey ^name-change ^open-line 10 c, 11 c, 12 c, \ ^paste-pad ^quit-editor ^reverse-w 13 c, 14 c, 17 c, \ ^split-line ^transfer-line ^word-del 1b c, \ esckey 30 c, 31 c, 32 c, \ f1key f2key f3key 33 c, 34 c, 35 c, \ f4key f5key f6key 37 c, 38 c, 39 c, \ f8key f9key f10key 3f c, 41 c, 42 c, \ helpkey u-arrowkey d-arrowkey 43 c, 44 c, 7f c, \ r-arrowkey l-arrowkey ^delkey decimal \ case: #c-char 910511jb ): case: ( n --- ) create ] smudge does> swap 2* + @ execute ; ( At compile time it compiles cfa. At run time, it expects an index on the stack and indexes into the defined words ) case: #c-char ( n --- ) advance-word blank-line clr-eos delete-line erase-eol flush-scr bspkey tabkey join-lines returnkey name-change open-line paste-pad quit-editor reverse-word split-line transfer-line word-delete esckey f1key f2key f3key f4key f5key f6key f8key f9key f10key helpkey u-arrowkey d-arrowkey r-arrowkey l-arrowkey delkey ; \ editinput control-char 910508jb ) : editinput \ -- char | if esc sequence, char+256 key dup 155 = if drop key dup 65 < if \ it's a function key key 126 <> if key drop then then 256 or then ; : control-char ( char --- ) 255 and \ strip hi byte %c-chars count cfind if #c-char else beep then ; ( lookup the character in the %c-chars table and if found execute its corresponding command. if not found, beep ) \ e-replace 910520jb ) : e-replace ( --- ) editinput dup \ get next keystroke ?printable if \ if its printable dup emit \ show it on the screen bufadr c! \ stick it in the buffer e-update \ buffer has changed 1 +curpos \ and move the cursor else control-char \ else process it as a command then ; ( e-replace is called whenever the editor is in replace mode. Note that only a single character is processed. Control is always returned to the main processing loop ) \ e-insert 910520jb ) : e-insert ( --- ) editinput dup \ get the next character ?printable if \ check if its printable ins-char \ if so, insert it here display2eol \ re-display the line 1 +curpos \ and move over 1 else control-char \ else process the command then ; ( e-insert is called whenever the editor is in insert mode. note that only a single character is processed and control is returned immediately to the calling routine. ) \ ed 910509jb ) forth definitions : ed ( [n] --- ) ScreenEditor \ select the editor vocabulary e-init \ initialize the variables e-list \ show screen begin \ this is the only loop in the editor display-status \ display the status on line 0 0 move-cursor \ move the cursor to where it should be &mode @ \ check the mode, 0=replace 1=insert if e-insert \ mode is insert else e-replace \ mode is replace ( over strike ) then again ; forth Editor Commands ^ = control key 910516jb ) ^a Advance cursor to the beginning of the next word. ^b Blank the cursor line. (Undo with ^p or f10 ) ^c Clear to end of screen. (Recover with: f1 or ^q ) ^d Delete line. (Undo with ^p or f10 on a blank line or f1) ^e Erase from cursor to end of line.(Undo with f1 ^p or f10 ) ^f Flush all changed screens to disk. ^j Join from cursor as much as fits from the line below. ^n Name-change (Change id. in top rh corner of screen) ^o Open (insert) new blank line under the cursor. ^p Paste from cursor the last deleted text to end of line. ^q Quit-editor. Leave editor with all changes canceled. ^r Reverse. Move cursor to the end of the previous word. ^s Split line at cursor, move rest of line one line down. ^t Transfer to screen 0 from cursor to end of line. ^w Word-delete. Delete chars till space, or spaces till char f1 Oops key. Cancel changes and redisplay original screen f2 Spare, make it whatever you want. f3 Triad. Print three screens ( Requires printer ) f4 Print the current screen. ( Requires printer ) f5 Print PAD ( Requires printer ) f6 Toggle insert/replace mode ( See top rh corner ) f8 Save any changes and show previous screen. f9 Save any changes and show next screen. f10 From cursor insert or replace text from buffer ARROW Arrow keys move the cursor in required direction. BSP Eat character to the left of the cursor. DEL Eat character under cursor and feed from the right. ESC Save if changes were made and exit the editor. HELP List the available editor commands. RETURN Move to the beginning of the next line. TAB Move cursor 8 places to the right. All keys repeat!! - Hints for usage of 'ed' 910517jb ) To enter the screeneditor for screen 9, type: 9 ed <return> If no screen number is given ( empty stack ) and you type 'ed', 'ed' will use the screen number stored in the variable 'scr', which is initialized by a previous use of the 'list' or 'ed' command with a screen number on the stack. The f10 key drops trailing spaces, the ^p key does not. The mode key f6 toggles the insert and replace mode. This affects the character input and the f10 paste key. The ^t transfer key will mark the source screens as not being modified. This will allow to rearrange screen lines to suit the transfer of lines to screen 0. If you want to save a modified source screen anyway then use the ^f (flush) key.
