--- \ screen editor load screen 9/18/86 13 load \ get case statement 60 load \ get string functions next_screen 64 loads forth definitions \ Author: Henry Laxen \ (adapted to the IPC by Bob Shreeve, \ with changes by Lawrence Woestman) \ This editor is in the public domain and may be distributed \ further with the inclusion of this notice. --- \ (s (p : (s ( --- ) 41 word ; \ skip to ) immediate ( (s is used for stack comments. A utility may be written later to extract these ) : (p ( --- ) 41 word ; \ skip to ) immediate ( (p is used for description comments. A utility may be written later to extract these ) --- \ ascii : ascii (s --- n ) bl word \ get following word from input stream here 1+ c@ \ get the first char of the word state @ \ check the state if \ if compiling compile lit , \ compile lit and the value of the char \ screen editor load screen 12/23/86 " forth.data" 13 fload \ get case statement " forth.data" 60 fload \ get string functions 10 64 loads forth definitions \ Author: Henry Laxen \ (adapted to the IPC by Bob Shreeve, \ with changes by Lawrence Woestman) \ This editor is in the public domain and may be distributed \ further with the inclusion of this notice. \ error messages 11/25/86 empty stack dictionary full wrong addressing mode isn't unique out of range disc range ? full stack disc error ! string stack empty string stack overflow can't redirect input string too small wrong operand size Hewlett Packard Integral Personal Computer forth \ error messages compilation only, use in definition execution only conditionals not paired definition not finished in protected dictionary use only when loading off current editing screen declare vocabulary \ (s (p : (s ( --- ) 41 word ; \ skip to ) immediate ( (s is used for stack comments. A utility may be written later to extract these ) : (p ( --- ) 41 word ; \ skip to ) immediate ( (p is used for description comments. A utility may be written later to extract these ) \ ascii : ascii (s --- n ) bl word \ get following word from input stream here 1+ c@ \ get the first char of the word state @ \ check the state if \ if compiling compile lit , \ compile lit and the value of the char endif ; immediate (p Ascii picks up the next word in the input stream and returns the value of the first char of the word. ) \ depth : depth (s --- n ) sp@ \ get current stack pointer value s0 @ \ get original stack pointer value swap - \ get difference between values 4 / \ divide by size of stack (in bytes) 0 max ; \ bounds check depth of stack (p Depth returns the current depth of the stack. ) \ 1- <> : 1- (s n --- n-1 ) 1 - ; : <> (s n1 n2 --- bool ) = 0= ; \ 2dup 2drop beep : 2dup (s n1 n2 --- n1 n2 n1 n2 ) over over ; (p 2dup duplicates the top two items on the parameter stack ) : 2drop (s n1 n2 --- ) drop drop ; (p 2drop drops 2 items off of the parameter stack ) : beep (s --- ) 7 emit ; (p ring the bell on the terminal. Usually after an error ) \ bounds : bounds (s addr len --- addr+len addr ) over + swap ; (p Bounds is a common do loop setup word. It assumes there is an address and a length on the stack. Bounds converts this into a high address and a low address. The I index of a DO LOOP will then run through this range of values while executing. ) \ bmove : bmove (s from to len --- ) -dup \ anything to move? if >r r + 1- swap 1- \ yes, move from high r> bounds swap \ memory to low memory do \ loop on "from" addresses i c@ over c! \ move one byte 1- \ adjust "to" address -1 +loop \ next "from" address drop \ drop left over "to" address else 2drop \ nothing to do, so forget it endif ; (p Bmove is identical to cmove except it moves characters in the other direction. ) \ move : move (s from to len --- ) rot rot 2dup u< if rot bmove else rot cmove endif ; (p Move will move 'len' bytes from address 'from' to address 'to' and will not overlap them, no matter what the relative values of 'from', 'to', and 'len' are. Move should always be used whenever there is danger of overlapping fields. ) \ case: 9/16/86 : case: (s n --- ) swap 4 * + @ execute ; (p Case: is a poor man's case statement. At compile time, it compiles code field addresses like ':'. At run time, it expects an index on the stack, and indexes into the defined words and executes one. ) \ -tidy : -tidy (s addr len --- ) bounds \ run through the string do i c@ bl < \ is it a control char? if bl i c! \ yes, replace it with a blank endif loop ; (p -tidy replaces all control characters in a specified range with blanks. ) \ editor variables 9/18/86 vocabulary editor immediate editor definitions 0 variable &mode \ current mode (overstrike or insert) 0 variable &cursor \ cursor position 0 variable &update \ update flag 0 variable &buf-adr \ address of current buffer 0 variable &e-id \ date and user id last modified 12 allot &e-id 16 blanks \ initialize to blanks 5 constant %x-off \ x offset for cursor positioning 2 constant %y-off \ y offset for cursor positioning 1024 constant c/scr \ characters per screen 16 constant l/scr \ lines per screen 0 variable e-fcn \ cfa of edit routine 0 variable &end-screen \ block number of last screen \ cursor positioning vectors 0 variable 'crtxy \ cfa of routine that moves cursor 0 variable 'crtclr-scr \ cfa of routine that clears screen 0 variable 'clear-to-eol \ cfa of routine that clears to eol : crtxy (s x y --- ) 'crtxy @ execute ; : crtclr-scr (s --- ) 'crtclr-scr @ execute ; : clear-to-eol (s n --- ) 'clear-to-eol @ execute ; \ curpos +curpos move-cursor : curpos (s --- pos ) &cursor @ ; \ return current cursor position : +curpos (s n --- ) &cursor +! curpos 0 max \ and do bounds checking [ c/scr 1- ] literal \ chars per screen - 1 min &cursor ! ; : move-cursor (s 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 crtxy ; \ buf-adr bufpos : buf-adr (s pos --- addr ) &buf-adr @ + ; (p Buf-adr converts the cursor position it is called with to the address within the disk buffer which corresponds to that position. ) : bufpos (s --- addr ) curpos buf-adr ; (p Bufpos returns the address in the disk buffer of the current character. ) \ e-update init-variables 9/18/86 : e-update (s --- ) 1 &update ! ; \ set update flag (p E-update is called whenever the contents of the buffer has changed. It sets the update flag. ) : init-variables (s --- ) \ initialize variables 0 &mode ! 0 &cursor ! 0 &update ! ; \ buf-move : buf-move (s from to len --- ) rot buf-adr rot buf-adr rot move e-update ; (p Buf-move performs a move operation on the characters in the disk buffer corresponding to the given cursor positions. ) \ ?printable 9/16/86 : ?printable (s char --- bool ) dup 32 < swap 126 > or 0= ; (p ?printable returns a true flag if the character is printable. Otherwise it returns a false flag. ) \ >line# line#> : >line# (s pos --- line# ) c/l / ; (p Convert a character position to a line number. ) : line#> (s line# --- pos ) c/l * ; (p Convert a line number to a character position. ) \ chars-to-eol chars-to-eos 9/16/86 : chars-to-eol (s pos --- n ) c/l mod c/l swap - ; (p Chars-to-eol returns the number of characters left on the line given the current character position. ) : chars-to-eos (s pos --- n ) c/scr swap - ; (p Chars-to-eos returns the number of characters left on the screen given the current character position. ) \ display-to-eol : display-to-eol (s pos --- ) dup buf-adr \ get address in buffer over chars-to-eol \ rest of line -trailing \ ignore blanks rot over + >r \ save resultant cursor position type \ display what's there r> clear-to-eol \ and remove the rest ; (p Display-to-eol displays the rest of the line starting from the current cursor position. It assumes that the terminal cursor is properly positioned before it executes. ) \ ?empty-line : ?empty-line (s line# --- bool ) line#> buf-adr c/l \ addr len -trailing \ remove trailing blanks swap drop 0= \ report success if all blanks ; (p ?empty-line returns true if the specified line number is completely blank. Otherwise it returns false. ) \ display-to-eos : display-to-eos (s line# --- ) curpos swap \ save current cursor position l/scr swap \ run through rest of screen do i line#> dup &cursor ! \ set cursor position 0 move-cursor display-to-eol \ and display line from there loop &cursor ! \ restore cursor position 0 move-cursor ; (p Display the entire screen from the given line number to the end of the screen. This is used when a line is inserted or deleted from the middle of the screen. ) \ expand : expand (s pos --- ) 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 blanks \ insert blank line e-update ; (p Expand moves all of the lines down by one and inserts a blank line at the specified position. ) \ shrink 9/16/86 : shrink (s pos --- ) 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 blanks \ at the bottom of the screen e-update ; (p Shrink deletes a line starting at the specified position and replaces the last line of the screen with a blank line. ) \ insert-line : insert-line (s pos --- ) [ l/scr 1- ] literal \ last line number ?empty-line \ is it empty? if dup expand \ yes, expand the buffer >line# display-to-eos \ and redisplay the screen else beep endif ; (p Insert-line checks to see that there is no text on the last line of the screen. If there is none, it expands the screen at the given cursor position and re-displays the altered screen. ) \ delete-line 9/16/86 : delete-line (s pos --- ) dup shrink >line# display-to-eos ; (p Delete-line removes a line at the current cursor position and re-displays the resulting screen. ) \ ins-char : ins-char (s char pos --- ) dup dup 1+ \ char pos from to over chars-to-eol 1- \ char pos from to len buf-move \ move it buf-adr c! ; \ and stick in char (p Ins-char inserts the given character into the disk buffer. Note that characters falling off the right end of the line are lost if caution is not used. ) \ del-char : del-char (s pos --- ) dup dup 1+ swap \ pos from to over chars-to-eol \ pos from to len buf-move \ move it dup chars-to-eol + 1- \ position at eol buf-adr bl swap c! ; \ and stick in a blank (p Del-char deletes the character at the specified cursor position. ) \ arrow commands : r-arrow (s --- ) 1 +curpos ; \ move right by one : l-arrow (s --- ) -1 +curpos ; \ move left by one : u-arrow (s --- ) c/l minus +curpos ; \ move up by one : d-arrow (s --- ) c/l +curpos ; \ move down by one \ i-line d-line d-char insert-mode : i-line (s --- ) curpos insert-line ; : d-line (s --- ) curpos delete-line ; : d-char (s --- ) curpos del-char curpos display-to-eol ; : insert-mode (s --- ) &mode 1 toggle 40 0 crtxy &mode @ if ." Insert ON" else 9 spaces endif ; \ return : return (s --- ) curpos >line# \ get number of current line 1+ \ increment by one [ l/scr 1- ] literal min \ don't move below bottom line#> &cursor ! ; \ and move there (p Return is executed whenever the carriage return key is pressed. It moves the cursor to the beginning of the next line. If the cursor is at the bottom of the screen, it remains there. ) \ e-tab 9/17/86 : e-tab (s --- ) 4 curpos 4 mod - +curpos ; (p Move the cursor to the next tab stop. Tabs are currently defined as being 4 apart, can be re-defined by simply altering e-tab. ) \ clr-screen 9/16/86 : clr-screen (s --- ) curpos buf-adr \ get buffer address curpos chars-to-eos \ and number of chars to clear blanks \ set chars to blanks curpos >line# \ figure out the line number display-to-eos \ and re-display e-update ; \ indicate screen changed \ $xy 24 $variable $xy \ cursor x-y display and positioning \ construct "\033&a00r28C00 00\033&a00r00C" string to init $xy " &a00r00C" 27 chr$ & \ get cursor position escape sequence " 00 00" & \ add row-col string to front " &a00r28C" 27 chr$ & \ get cursor position escape sequence & \ add it to front to make entire string $xy $! \ initialize $xy \ store_num_as_chars : store_num_as_chars ( number addr _ ) \ convert 'number' (0 <= 'number' <= 99) to two chars; \ store the most significant char at 'addr' and \ the least significant char at 'addr'+1 >r \ save the address for later 10 /mod \ isolate the digits of the number 48 + \ convert most sig. digit to char r c! \ store char at 'addr' 48 + \ convert least sig. digit to char r> 1+ c! ; \ store char at 'addr'+1 \ .xydisp : .xydisp (s --- ) curpos c/l /mod \ convert curpos to col and row 2dup \ get another copy of col and row $xy 9 + store_num_as_chars \ store row in $xy $xy 12 + store_num_as_chars \ store column in $xy %y-off + \ add y offset to row $xy 17 + store_num_as_chars \ store row + y-offset in $xy %x-off + \ add x offset to col $xy 20 + store_num_as_chars \ store col + x-offset in $xy $xy 23 type ; \ output $xy (p .xydisp positions the cursor at the correct location and displays that location at the top of the screen. ) \ clr-line 9/16/86 : clr-line (s --- ) curpos \ save current cursor position dup buf-adr \ buffer address of cursor position curpos chars-to-eol \ get number of chars to clear blanks \ blank out rest of line e-update \ indicate text has changed 0 move-cursor \ move cursor to current position curpos clear-to-eol \ and clear the line &cursor ! ; \ restore the cursor (p Clr-line sets the part of the current line after the cursor position to blanks. ) \ mark-update : mark-update (s --- ) c/scr move-cursor \ get to bottom of screen cr cr \ skip two lines scr ? \ tell user screen number &update @ \ has it changed? if &e-id \ from [ c/l 10 - ] literal \ to buf-adr 10 cmove \ copy user ID ." modified " \ yes, tell user update flush else ." unmodified " \ no, let him know endif ; (p Mark-update puts the user ID on line 0 if the screen was modified, and tells the user. ) \ ?empty-screen 9/18/86 : ?empty-screen (s scr# --- bool ) block c/scr \ start at beginning of screen -trailing \ remove trailing blanks swap drop 0= \ report success if screen all blanks ; (p ?empty-screen returns true if the specified screen is completely blank. Otherwise it returns false. ) \ scr-expand 9/18/86 : scr-expand (s scr# end_screen# --- ) flush empty-buffers \ make sure buffers are empty do \ copy screens from high to low i 1 - i copy \ to avoid overwriting screens -1 +loop ; (p Scr-expand will move the screens between the specified screen and the end screen up by one, duplicating the specified screen. ) \ scr-shrink 9/18/86 : scr-shrink (s scr# end_screen# --- ) flush empty-buffers \ make sure the buffers are empty dup >r \ save the end screen number swap do \ copy screens from low to high i 1+ i copy \ to avoid overwriting screens loop scr @ \ save scr r> clear \ clear the end screen scr ! \ restore scr ; (p Scr-shrink will move the screens between the specified screen and the end screen down one, overwriting the specified screen and clearing the end screen. ) \ query-user 9/18/86 : query-user (s --- ??? ) blk @ >r \ save block number in @ >r \ save input buffer offset 0 blk ! \ make sure to read from the console query interpret \ interpret one line from console r> in ! \ restore input buffer offset r> blk ! \ restore block number ; (p Query-user interprets one line from the console. ) \ get-a-number 9/18/86 : get-a-number (s default_number --- n ) depth >r \ save the current stack depth query-user \ interpret a line from the user depth r> = 0= \ has the stack depth changed? if swap drop \ yes, return the new number endif \ else, return the default number ; (p Get-a-number interprets a line from the user, and returns the number the user typed in or the default value provided if the user just hit "Return". ) \ get-end-screen# 9/18/86 : get-end-screen# (s --- n ) 0 19 crtxy \ move to a clear place ." enter end screen number? " &end-screen ? \ output current screen number 25 19 crtxy \ move cursor to the number &end-screen @ get-a-number \ get a number from the user &end-screen ! \ set the end screen number 0 19 crtxy 0 clear-to-eol \ clean up the question 0 move-cursor \ put the cursor back &end-screen @ \ leave the end screen number ; (p Get-end-screen# asks the user for the end screen number. It defaults to the current end screen number. ) \ del-screen 9/18/86 : del-screen (s --- ) scr @ get-end-screen# \ get start and end screen numbers 2dup < \ check numbers for sanity if mark-update \ mark screen as changed if needed scr-shrink \ delete the current screen scr @ block &buf-adr ! \ get & save new buffer address init-variables \ reset the variables for new screen 0 display-to-eos \ show new screen else beep drop drop \ not sane, beep, clean up stack endif ; (p Del-screen copies all the screens between the current screen and the end screen down by one. ) \ do-ins-screen 9/18/86 : do-ins-screen (s scr# end-scr# --- ) dup ?empty-screen \ check for empty screen if scr-expand \ move the screens up by one else beep \ won't expand over non-empty screen drop drop \ clean up the stack endif ; (p Do-ins-screen checks to make sure that the end screen is empty and moves the screens up by one, leaving a copy of the specified screen. ) \ ins-screen 9/18/86 : ins-screen (s --- ) scr @ get-end-screen# \ get start and end screen numbers 2dup < \ check numbers for sanity if curpos >r \ save the current cursor position mark-update \ update current screen if changed do-ins-screen \ insert a copy of the screen r> &cursor ! \ restore the cursor position scr @ block &buf-adr ! \ get & save new buffer address else beep drop drop \ not sane, beep, clean up the stack endif ; (p Ins-screen inserts a copy of the current screen, moving all the screens between the current screen and the end screen up by one. ) \ get-user-id : get-user-id (s --- ) &e-id 10 -trailing 0= if \ is user id blank cr ." enter your id: " \ prompt user 10 0 do 46 ( . ) emit loop \ display field length 10 0 do 8 ( bs ) emit loop \ and back up 10 expect \ let the user enter it &e-id 10 -tidy \ replace control chars with bl else \ already entered user id drop \ if here endif ; (p Get-user-id checks to see if the user's id has been set, and if not, prompts him for it and saves it. ) \ init-terminal 9/18/86 : init-terminal (s --- ) 27 emit ." &s1A" \ set 'transmit function keys' \ set up the softkeys 27 emit ." &f2a5k8d2L Ins Scr" 27 emit ." t" 27 emit ." &f2a6k8d2L Del Scr" 27 emit ." u" 27 emit ." &f2a7k8d2L Abort " 27 emit ." v" 27 emit ." &f2a8k8d2L Exit " 27 emit ." w" ; (p Init-terminal initializes the Integral PC's terminal. ) \ restore-terminal 9/18/86 : restore-terminal (s --- ) 27 emit ." &s0A" \ clear 'transmit function keys' 27 emit ." &f2a5k-1d-1L" \ clear the softkeys 27 emit ." &f2a6k-1d-1L" 27 emit ." &f2a7k-1d-1L" 27 emit ." &f2a8k-1d-1L" ; (p Restore-terminal restores the Integral PC's terminal. ) \ previous next 11/27/85 : previous ( --- ) mark-update r> drop r> drop r> drop r> drop r> drop scr @ 1 - e-fcn @ execute ; : next ( --- ) mark-update r> drop r> drop r> drop r> drop r> drop scr @ 1+ e-fcn @ execute ; \ exit-edit 11/27/85 : exit-edit (s --- ) restore-terminal cr r> drop r> drop r> drop r> drop r> drop r> drop ; (p Get out of the editor and return to previous activity. ) \ exit-update : exit-update (s --- ) mark-update exit-edit ; \ get out of editor (p Exit-update leaves the editor and returns to forth. If the screen has been modified, the user id is inserted on line 0 in the right hand corner. ) \ exit-scratch : exit-scratch (s --- ) c/scr move-cursor \ go to bottom of screen cr cr \ skip two lines scr ? \ tell user screen number ." abandoned " \ and warn about status exit-edit ; \ get out of editor (p Exit-scratch will leave the editor and not flush the screen to disk. The screen is not marked as updated, but this can be done manually with the update command. It may then be flushed with the flush command, or erased with the empty-buffers command. ) \ special-keys 9/18/86 : special-keys (s --- ) key case ascii A of u-arrow endof ascii B of d-arrow endof ascii C of r-arrow endof ascii D of l-arrow endof ascii J of clr-screen endof ascii K of clr-line endof ascii L of i-line endof ascii M of d-line endof ascii P of d-char endof ascii Q of insert-mode endof ascii U of next endof ascii V of previous endof ascii h of 0 &cursor ! endof ascii t of ins-screen endof ascii u of del-screen endof ascii v of exit-scratch endof ascii w of exit-update endof beep endcase ; (p Special-keys handles the special function keys on the Integral PC's keyboard. ) \ (control-char) 11/27/85 case: (control-char) (s n --- ) \ there is an entry for each character from 0 through 27 beep beep beep beep \ ^@ ^a ^b ^c beep beep beep beep \ ^d ^e ^f ^g l-arrow e-tab return beep \ ^h ^i ^j ^k beep return beep beep \ ^l ^m ^n ^o beep beep beep beep \ ^p ^q ^r ^s beep beep beep beep \ ^t ^u ^v ^w beep beep beep special-keys \ ^x ^y ^z esc ; \ control-char : control-char (s char --- ) dup 127 = \ if it is a delete if drop 8 endif \ then turn it into a backspace dup 28 < \ might it be a valid control char? if (control-char) \ yes, so go do it else drop beep \ no, complain endif ; (p Control-char processes a control character. If the character is a delete, it is changed into a backspace. If it is less than or equal to an escape, it is executed, otherwise we beep. ) \ e-overstrike : e-overstrike (s --- ) key \ get next keystroke dup ?printable \ is key printable? if \ if it is printable dup emit \ show it on the screen bufpos c! \ stick it in the buffer e-update \ buffer has changed 1 +curpos \ and move the cursor else control-char \ else see if it is a control char endif ; (p E-overstrike is called whenever the editor is in overstrike mode. ) \ e-insert : e-insert (s --- ) key \ get the next character dup ?printable \ check if it is printable if curpos ins-char \ if so, insert it here curpos display-to-eol \ re-display the line 1 +curpos \ and move over 1 else control-char \ else process the command endif ; (p E-insert is called whenever the editor is in insert mode. ) \ disp_line_numbers 9/18/86 : disp_line_numbers (s --- ) l/scr 0 do i 3 .r cr \ display a line number loop ; \ e-init : e-init (s --- ) scr @ block \ get the buffer address of screen &buf-adr ! \ save the buffer address init-terminal \ initialize the terminal get-user-id \ get date and name crtclr-scr \ clear terminal init-variables \ init variables 0 %y-off crtxy \ move cursor to start of terminal disp_line_numbers \ display line numbers for user 16 0 crtxy \ move to top center of terminal ." scr:" scr @ 4 .r \ display screen number 0 display-to-eos ; \ show the screen (p E-init initializes the editor. ) \ e 9/16/86 forth definitions : e (s [n] --- ) editor \ look through the editor vocabulary depth if scr ! endif \ edit last screen if stack empty e-init \ initialize the screen begin .xydisp \ display the status, move cursor &mode @ \ check the mode if e-insert \ if insert mode, do e-insert else e-overstrike \ if overstrike mode, do e-overstrike endif again ; ' e cfa e-fcn ! \ fill in e-fcn variable \ hp terminal customization editor definitions : hpcrtclr-scr (s --- ) 27 emit ascii h emit \ home up 27 emit ascii J emit ; \ clear screen : hpcrtclr-eol (s position --- ) drop \ don't need position 27 emit ascii K emit ; \ clear to end-of-line ' hpcrtclr-scr cfa 'crtclr-scr ! ' hpcrtclr-eol cfa 'clear-to-eol ! \ crtxy 9/18/86 10 $variable xystring " &a00r00C" 27 chr$ & \ construct cursor position esc seq xystring $! \ intialize xystring : hpcrtxy (s col row --- ) xystring 3 + store_num_as_chars \ set up row chars xystring 6 + store_num_as_chars \ set up col chars xystring 9 type ; \ output string ' hpcrtxy cfa 'crtxy ! ." last screen loaded " \ warning about loading too far screen 9/18/86 cr ." loaded too far" cr