1 line
30 KiB
Plaintext
1 line
30 KiB
Plaintext
\ Information A full-screen editor for DX-Forth. Based on the editor from "Forth - A Text and Reference" by Kelly & Spies. Usage: n SED ( edit screen n ) SED ( edit screen where error occured ) Ctl-D Right cursor Ctl-Y Delete line Ctl-C Next block Ctl-S Left cursor Ctl-N Insert line Ctl-R Prev Block Ctl-E Up cursor Ctl-T Erase to EOL Ctl-L Restore blk Ctl-X Down cursor Ctl-A Save line Ctl-J Jump to blk Ctl-I Tab cursor Ctl-P Restore line Ctl-K Update block Ctl-Q Home cursor Ctl-O Open-up line Ctl-V Insert toggleCtl-G Del next char Ctl-W Split line Ctl-B Redraw screenCtl-H Del prev char Ctl-F Join line Ctl-Z Functions Ctl-U Exit editor Esc Graphic toggle \ Load block forth definitions decimal sys @ system cr .( loading Screen Editor ) 2 #screens 1- thru forth definitions decimal sys ! \ Constants, variables vocabulary EDITOR editor definitions \ 1024 constant B/BUF \ bytes per block buffer \ 64 constant C/L \ columns per line : L/S b/buf c/l / ; \ lines per screen 4 constant X \ screen x offset 2 constant Y \ screen y offset 4 constant TBS \ tab size increment variable R# \ cursor row position variable C# \ cursor col position variable INS \ insert flag variable QF \ quit flag variable GF \ graphics flag \ WAIT HI RNG? \ Short pause : WAIT ( -- ) 500 ms ; \ Highest block number : HI ( -- u ) #screens 1- 0 max ; \ Test if block u is within range : RNG? ( u -- u f ) dup 0 #screens within ; \ COPY COPIES \ Copy screen u1 to u2 : COPY ( u1 u2 -- ) swap block swap buffer b/buf cmove update save-buffers ; \ Copy u3 screens from screen u1 to u2 : COPIES ( u1 u2 u3 -- ) ?dup if swap 2 pick - >r over + r@ 0< if swap 1 else 1- -1 then r> 2swap do i 2dup + copy over +loop then 2drop ; \ ?EXTEND EXPAND \ Extend file if block u is not in range : ?EXTEND ( u -- ) rng? if drop else 1+ fileblocks then ; \ Insert blank screen at block u : EXPAND ( u -- ) dup dup 1+ over #screens dup ?extend swap - copies block b/buf blank update ; \ SHRINK \ Delete screen u, copying it to buffer : SHRINK ( u -- ) rng? if pad dup b/buf + b/buf cmove dup 1+ swap over #screens swap - copies #screens 1- dup fileblocks 1- scr @ min scr ! else drop then ; \ !XY @XY CXY UP DN \ Save cursor pos : !XY ( y x -- ) c# ! r# ! ; \ Get cursor pos : @XY ( -- y x ) r# @ c# @ ; \ Restore cursor pos : CXY ( -- ) @xy x + swap y + at-xy ; \ ^E move cursor up one position -? : UP ( -- ) r# @ 0> if -1 r# +! cxy then ; \ ^X move cursor down one position : DN ( -- ) r# @ l/s 1- < if 1 r# +! cxy then ; \ LFT RT HOM TAB \ ^S move cursor left one position : LFT ( -- ) c# @ 0> if -1 c# +! cxy then ; \ ^D move cursor right one position : RT ( -- ) c# @ c/l < if 1 c# +! cxy then ; \ ^Q Move cursor to home position : HOM ( -- ) 0 0 !xy cxy ; \ ^I Move cursor to next tab position : TAB ( -- ) tbs c# @ over mod - 0 do rt loop cxy ; \ SOL NEWL LSTART LEND \ Move cursor to start of current line : SOL ( -- ) 0 c# ! cxy ; \ ^M Move cursor to start of next line : NEWL ( -- ) sol dn ; \ Line start address : LSTART ( -- a ) pad r# @ c/l * + ; \ Line end address : LEND ( -- a ) lstart c/l 1- + ; \ CPOS BLINE LB BELOW BLEFT \ Cursor position address : CPOS ( -- a ) lstart c# @ + ; \ Buffer address : BLINE ( -- a ) b/buf 2* pad + ; \ Line buffer address : LB ( -- a ) bline c/l + ; \ : BELOW ( -- n ) l/s r# @ - c/l * b/buf + ; \ Number of chars from cursor to end-of-line : BLEFT ( -- n ) lend cpos - ; \ BORDER .LINE .LINES \ Draw border : .BORDER ( -- ) x y 1- at-xy c/l 1- 0 do i tbs 2* mod if [char] - else [char] ! then emit loop [char] ! emit 0 y at-xy l/s 0 do i 2 .r cr loop ( cr ." B:") ; \ Display line from cursor position to end : .LINE ( -- ) clear-line cpos bleft 1+ -trailing type cxy ; \ Display all screen lines : .LINES ( -- ) @xy l/s r# @ do i r# ! sol .line loop !xy cxy ; \ .MODE ~INS ~ESC \ Display mode : .MODE ( -- ) 10 0 at-xy gf @ if ." GFX " else ." Norm " then ins @ if ." Ins" else ." Ovr" then ; \ ^V Toggle insert mode : ~INS ( -- ) ins @ not ins ! .mode cxy ; \ ESC Toggle graphic mode : ~ESC ( -- ) gf @ not gf ! .mode cxy ; \ .STAT .LB .BLK .SCR CLS \ Display status line : .STAT ( -- ) 0 0 at-xy ." Scr " scr @ . space 20 0 at-xy loadfile type cxy ; \ Display line buffer : .LB ( -- ) x y l/s + 1+ 0 over at-xy ." B:" at-xy lb c/l type cxy ; \ Display status line and screen lines : .BLK ( -- ) @xy hom .stat .lines !xy cxy ; \ ^B Redraw screen : .SCR ( -- ) page .border .mode .blk .lb ; \ Clear screen : CLS ( -- ) pad b/buf blank .blk ; \ CLB CLL @BLK !BLK RESTORE \ Clear circular buffer : CLB ( -- ) pad b/buf + b/buf c/l + blank ; \ Clear one line buffer : CLL ( -- ) lb c/l blank ; \ Load block : @BLK ( -- ) scr @ block pad b/buf cmove ; \ Save block and update : !BLK ( -- ) pad scr @ buffer b/buf cmove> update ; \ ^L Reload block and display it : RESTORE ( -- ) @blk .scr ; \ +BLK -BLK ?KEY INP \ ^C Go to next block : +BLK ( -- ) scr @ hi < if 1 scr +! restore then ; \ ^R Go to previous block : -BLK ( -- ) scr @ 0> if -1 scr +! restore then ; \ Get key and display if printable : ?KEY ( -- c ) key upcase dup 32 127 within if dup emit then ; \ Get input string 0=empty : INP ( -- a u -1 | 0 ) here dup 20 accept bl skip dup if -1 else and then ; \ CLM CLM2 CLRMSG \ Clear space for msg : CLM ( y-offs -- ) y + l/s + 0 swap at-xy clear-line ; \ Clear space for msg2 : CLM2 ( -- ) 2 clm ; \ Clear space for msgs : CLRMSG ( -- ) clm2 1 clm ; \ FUNC \ ^Z Function select : FUNC ( -- ) clrmsg ." *** SCREEN: (I)nsert, (D)elete " clm2 ." CLEAR: (B)uffer, (S)creen ? " ?key case [char] I of scr @ expand restore endof [char] D of scr @ shrink restore endof [char] B of clb endof [char] S of cls hom endof endcase clrmsg .lb cxy ; \ ?EXIT JMP \ ^U Quit editor : ?EXIT ( -- ) clrmsg ." *** EXIT: (S)ave, (Q)uit ? " ?key case [char] S of update flush qf on endof [char] Q of empty-buffers qf on endof clrmsg .lb cxy endcase ; \ ^J Jump to block : JMP ( -- ) begin clrmsg ." *** JUMP: Screen (0-" hi 0 .r ." )? " inp 0= if clrmsg .lb cxy end number? until drop dup ?extend scr ! clrmsg hom restore ; \ (OPN) OPN TRIM \ Open up line at cursor : (OPN) ( -- ) c# @ c/l < lend c@ bl = and if cpos dup 1+ bleft cmove> bl cpos c! else beep then ; \ ^O Open up line at cursor : OPN ( -- ) (opn) .line ; \ ^T Delete from cursor to end of line -? : TRIM ( -- ) cpos bleft 1+ dup spaces cxy blank ; \ DEL UPD OTYPE \ Delete char at cursor : DEL ( -- ) c# @ c/l < if cpos 1+ cpos bleft cmove bl lend c! .line then ; \ ^K Update and save screen : UPD ( -- ) !blk clrmsg ." *** UPDATED BLOCK: " scr @ . wait clrmsg .lb cxy ; \ Overtype char at cursor : OTYPE ( c -- ) c# @ c/l < if dup emit cpos c! 1 c# +! else drop beep then ; \ INSERT BSP GET \ Insert char at cursor : INSERT ( c -- ) lend c@ bl = if (opn) otype .line else drop beep then ; \ ^H Backspace (delete prev character) : BSP ( -- ) c# @ if lft del then ; \ ^P Copy from one-line buffer : GET ( -- ) lb lstart c/l cmove @xy sol .line !xy cxy ; \ PUT KILL INSL \ ^A Copy line to line buffer : PUT ( -- ) lstart lb c/l cmove .lb ; \ ^Y Kill line, push to circular buffer : KILL ( -- ) lstart bline c/l cmove lstart c/l + lstart below cmove .lines ; \ ^N Insert line from circular buffer : INSL ( -- ) lstart dup c/l + below cmove> bline lstart c/l cmove .lines ; \ SPLIT JOIN \ ^W Split line at cursor : SPLIT ( -- ) cpos dup below bleft + c/l /string cmove> cpos c/l blank .lines ; \ ^F Join line with next : JOIN ( -- ) lstart c/l + 0 c/l 0 do drop count bl - if i leave then i loop >r 1- c/l r> - bleft 1+ min cpos swap cmove .lines ; \ 'CMD create 'CMD ] put ( A save line ) .scr ( B redraw scr ) +blk ( C next blk ) rt ( D right curs ) up ( E up curs ) join ( F join line ) del ( G del char ) bsp ( H destruct bs ) tab ( I tab key ) jmp ( J jump to blk ) upd ( K update ) restore ( L restore blk ) newl ( M cr ) insl ( N insert line ) opn ( O open txt ) get ( P restore line) hom ( Q home curs ) -blk ( R prev block ) lft ( S left curs ) trim ( T delet to EOL) ?exit ( U exit ) ~ins ( V insert toggl) split ( W split line) dn ( X down curs ) kill ( Y kill line ) func ( Z function ) ~esc ( \ graphic ) [ \ INIT CMD !CHR \ Initialisation : INIT ( scr offs -- ) dup 0 b/buf within and \ check offset c/l /mod swap !xy 0 tuck max hi min scr 2! \ check scr clear offset clb cll \ clear buffers ins on gf off \ set mode restore \ load and display scr cxy ; \ position cursor \ Execute command n : CMD ( n -- ) 1- 2* 'cmd + @ execute ; \ Insert character : !CHR ( c -- ) ins @ if insert else otype then ; \ MAPKEY \ Map IBM PC extended keys : KMAP ( c -- c' ) 200 of 5 end \ up arrow 208 of 24 end \ down arrow 205 of 4 end \ right arrow 203 of 19 end \ left arrow 210 of 22 end \ insert 211 of 7 end \ delete 201 of 18 end \ page up 209 of 3 end \ page down 199 of 17 end \ home ( c) ; \ (E) \ Edit screen/offset : (E) ( scr offs -- ) init qf off begin key gf @ if dup 27 = if drop ~esc else !chr then else kmap dup 1 28 within if cmd else dup 32 127 within if !chr else drop beep then then then qf @ until cr ; \ IMPORT EXPORT \ Copy screens n1-n2 from secondary file : IMPORT ( n1 n2 -- ) scr @ -rot 1+ swap ?do dup expand swap-file i block drop swap-file dup buffer drop update flush 1+ dup scr ! loop drop ; \ Copy screens n1-n2 to secondary file : EXPORT ( n1 n2 -- ) swap-file import swap-file ; \ SED forth definitions editor \ Edit screen u or where LOAD error occured -? : SED ( ? -- ) application unused b/buf 2* c/l + u< abort" out of memory" 0 ?extend depth if 0 else scr 2@ swap then (e) ; \ aka SED EDIT behead l/s (e) forth |