: under swap ove : under swap ove : under swap ove : under swap ove : under swap ove : under swap ove : under swap ove : under swap ove : under swap ove : under swap ove : under swap ove : under swap ove : under swap ove : under swap ove : under swap ove : under swap ove \ karl tools 6 views kutil.blk 6 view# ! only forth also 30 load 38 load \ basics 2 load \ keytables 4 load \ vi \ 32 34 thru \ fast display i/o 5 24 thru \ the rest of vi only forth also .( vi loaded) cr \ clockpc.blk 1 load \ V 4.0 key tables 890114kel variable curtab variable curkey : keytable \ lokey hikey keytable tablename create here curtab ! \ make it the current table 2dup swap , , \ save low and hi limits 1+ swap do ['] noop , loop \ fill vector space with noops does> over curkey ! under @ max over 4+ @ min over @ - 2+ 4* + @ execute ; : with ( with tablename, choose this table for does ) ' >body curtab ! ; --> \ V 4.0 key tables 890114kel : key>entry \ entry# -- get table entry address curtab @ dup @ swap 4+ dup @ swap 4+ >r rot min swap dup rot max swap - 4* r> + ; : does \ entry# does name point a table entry to word "name" key>entry ' swap ! ; : defrange \ val1 val2 defrange word point range of tab entrie 1+ swap ' rot rot do dup i key>entry ! loop drop ; : default \ default word - fill the table with ptrs to word ' curtab @ 4+ @ 4* curtab @ 8+ + curtab @ @ 4* curtab @ 8+ + do ['] noop i @ = if dup i ! then 4 +loop drop ; \ visual editor 890114kel only forth also vocabulary ved ved definitions 1024 constant c/s 16 constant l/s variable (cnt) variable icase variable r-m variable e-end variable r-end variable (ecur) variable (escr) c/s c/l - constant ll \ visual editor 890114kel only forth also editor also : bol line# 1- c/l * ; : xy col# line# ; : xyat col# 2+ line# at ; : range cursor dup c/s 1- > if c/s - else dup 0< if c/s + then then r# ! ; : cchar 'cursor c@ ; : addc 'cursor c! modified ; : .eol xyat 'cursor 64 col# 1- - type ; \ visual editor 25May87kel : cnt (cnt) @ 1 max 0 (cnt) ! ; : ucase dup ascii z <= if dup ascii a >= if bl - then then ; : iucase icase @ if ucase then ; : back r# 1-! cursor 0< if c/s 1- r# ! then ; : fwd r# 1+! cursor c/s >= if 0 r# ! then ; \ : up c/l negate r# +! range ; \ : down c/l r# +! range ; \ visual editor 31May87kel: disp ?stamp 'start burst ; : disp' disp .scr# ; : r-c curkey @ dup emit addc fwd ; : ins-bl 'cursor dup 1- swap c/l col# - cmove> bl addc ; : del-c 'cursor dup 1+ swap c/l col# - cmove bl bol c/l + 1- 'start + c! modified ; : i-c ins-bl r-c .eol ; : i/r iucase r-m @ if i-c else r-c then ; \ visual editor 25May87kel: >find >r cursor begin fwd cchar r@ = over cursor = or until drop r> drop ; : <find >r cursor begin back cchar r@ = over cursor = or until drop r> drop ; : ins-l bol 'start + dup c/l + ll bol - cmove> bol 'start + c/l blanks modified ; : del-l bol 'start + dup c/l + swap ll bol - cmove ll 'start + c/l blanks modified ; : >skipbl 1023 0 do cchar bl <> if leave then fwd loop ; : <skipbl 1023 0 do cchar bl <> if leave then back loop ; \ visual editor 31May87kel 0 256 keytable e-keys default beep 0 bl keytable r-keys default beep 0 128 keytable d-keys default beep defer vkey ' key is vkey : e-loop begin xyat vkey ucase e-keys e-end @ until ; : r-loop begin xyat vkey r-keys r-end @ until col# 0<> if back then ; : c-# 0 18 at stamp disp' ; \ visual editor 890114kel : cmd-ret down bol r# ! ; : cmd-endr 1 r-end ! ; : cmd-del-l cnt 0 do del-l loop bol r# ! disp ; : cmd-del-c back del-c .eol ; : 0-9 curkey @ 48 - (cnt) @ 10 * + (cnt) ! ; : cmd-disp disp ; : cmd-redisp resetsnap disp ; : qot vkey i/r ; \ visual editor 25May87kel : c-fwd cnt 0 do fwd loop ; : c-back cnt 0 do back loop ; : c-up cnt 0 do up loop ; : c-down cnt 0 do down loop ; : c-i 1 r-m ! 0 r-end ! r-loop ; : c-r 0 r-m ! 0 r-end ! r-loop ; : c-d vkey ucase d-keys ; : c-c c-d c-i ; : c-b vkey iucase cnt 0 do dup <find loop drop ; : c-e ll r# ! ; \ visual editor : c-f vkey iucase cnt 0 do dup >find loop drop ; : c-p snap cnt negate scr +! scr @ 0< if beep 0 scr ! then disp' ; : c-n snap cnt scr +! disp' ; : c-m scr @ (escr) ! cursor (ecur) ! ; : c-g snap (escr) @ scr ! (ecur) @ r# ! disp' ; : c-w cnt 0 do bl >find >skipbl loop ; : alternate a disp' ; : go.ed 0 18 at ed quit ; \ visual editor : wordback cnt 0 do back <skipbl bl <find fwd loop ; : c-o cnt 0 do ins-l loop bol r# ! disp ; : c-q save-buffers curkey @ e-end ! ; : c-s snap cnt scr ! disp' ; : c-u empty-buffers disp' ; : c-x cnt 0 do del-c loop .eol ; : c-z wipe disp' ; \ visual editor 31May87kelwith e-keys bl does c-fwd ascii Z does c-z control X does cmd-del-c control W does wordback ascii 0 ascii 9 defrange 0-9 ascii B does wordback ascii C does c-c ascii D does c-d ascii E does c-d ascii E does c-e ascii F does c-f ascii G does c-g ascii I does c-i ascii M does c-m ascii N does c-n ascii O does c-o ascii P does c-p ascii Q does c-q ascii R does c-r ascii S does c-s ascii T does top ascii U does c-u ascii W does c-w ascii X does c-x ascii K does c-up ascii L does c-fwd ascii H does c-back ascii J does c-down ascii \ does alternate ascii : does go.ed \ visual editor 31May87kel ascii K does c-up ascii L does c-fwd control H does c-back control J does c-down control K does c-up control L does c-fwd control M does cmd-ret control R does cmd-redisp control U does c-fwd : cmd-uc 1 icase ! ; : cmd-lc 0 icase ! ; \ visual editor with r-keys control A does cmd-uc control B does cmd-lc control H does c-back control J does c-down control [ does cmd-endr bl does i/r control M does cmd-ret control R does cmd-disp control X does cmd-del-c control V does qot control U does c-fwd \ beginning/end of line : c-$ bol 'start + c/l -trailing bol + r# ! drop ; with e-keys ascii $ does c-$ control E does c-$ with r-keys control E does c-$ \ visual editor 25May87kel: c-s6 bol r# ! ; with e-keys 94 does c-s6 control A does c-s6 : dr 2dup max >r min r# ! 'start r@ + 'cursor c/l r@ c/l mod - dup >r cmove 'cursor r@ + c/l r> c/l mod col# + - dup 0> if blanks else 2drop then r> c/l / line# - ?dup if (cnt) ! cursor >r down 1 cmd-del-l r> r# ! then ; : c-dr cursor curkey @ e-keys cursor 2dup - if dr modified then disp ; \ visual editor with d-keys ascii L does cmd-del-l ascii D does cmd-del-l ascii C does c-x ascii W does c-dr ascii F does c-dr ascii T does c-dr ascii E does c-dr ascii G does c-dr ascii B does c-dr ctrl W does c-dr ascii H does c-dr ascii J does c-dr ascii K does c-dr bl does c-dr control H does c-dr control J does c-dr control K does c-dr control L does c-dr control M does c-dr ascii $ does c-dr ascii ^ does c-dr 0 bl keytable w-keys variable w-end variable w-char : w-bs here c@ if here c@ 1- here c! 8 emit bl emit 8 emit then ; \ visual editor 25May87kel : w-cr 1 w-end ! ; : w-add curkey @ dup w-char @ = if emit 1 w-end ! else dup emit here c@ 1+ here c! here dup c@ + c! then ; : e-word curkey @ emit 0 here c! 0 w-end ! w-char ! begin vkey iucase w-keys w-end @ until ; with w-keys control H does w-bs control M does w-cr control [ does w-cr bl does w-add \ visual editor 25May87kel: match? 'cursor here count compare ; variable (dir) : >dir (dir) ! ; : mov (dir) @ r# +! range ; : search cursor begin mov match? over cursor = or until cursor = 0= ; : ?fail 0= if 0 23 at 0 blot ." fail" vkey then ; : getit 0 23 at 0 blot e-word 0 23 at ; : nsrch 0 cnt 0 do drop search dup 0= if leave then loop ; \ visual editor 860616kel : c-/ getit 1 >dir nsrch ?fail disp ; : c-? getit -1 >dir nsrch ?fail disp ; : pt (dir) @ 0< if 63 emit else 47 emit then ; : c-& 0 23 at 0 blot pt here count type pt nsrch ?fail disp ; with e-keys ascii / does c-/ ascii ? does c-? ascii & does c-& with d-keys ascii / does c-dr ascii ? does c-dr ascii & does c-dr \ visual editor 890118kel ved definitions \ n -- yank n lines to pad : c-y bol 'start + pad 2+ cnt l/s line# - min c/l * dup pad ! cmove ; \ n -- open and insert yanked lines n times : c-! cnt 0 do pad @ c/l / 0 do ins-l loop pad 2+ bol 'start + pad @ cmove loop disp ; with e-keys ascii Y does c-y ascii ! does c-! : c-A c-$ c-r ; : reload 0 18 at scr @ load cr ." [done, press a key to " ." resume vi]" key drop .background disp' ; with e-keys ascii @ does reload ascii A does c-A \ visual editor 25May87kel forth definitions ved also : v done .background disp' 0 e-end ! e-loop 0 23 at ; : vw dup (escr) ! scr ! dup r# ! (ecur) ! wordback v ; : vi 1 ?enough 0 swap vw ; : vwhere ." ...vedit? " key dup ascii y = swap ascii Y = or if vw else ." no" cr then ; \ where for vi ' vwhere is where forth \s Where is now pointing at the editor and if a block does not load properly, will start vi, with the cursor after the word not understood by the system. Normally this will be a word not yet defined. 890118kel \ karl basics 890114kel : under swap over ; : 1+! 1 swap +! ; : 1-! -1 swap +! ; : blanks bl fill ; : ctrl bl word 1+ c@ state @ if [compile] literal then ; \ amiga forth 'at' is backwards and 1-relative from L&P : at 1+ swap 1+ at ; \ visual editor karl 1024 constant c/s 64 constant c/l : burst \ addr -- quick output of entire screen dark dup c/s + swap do [ forth ] i c/l -trailing type cr c/l +loop ; : .scr# 75 0 at scr @ 3 .r ; 890119kel 890119kel 890119kel \ search file for blocks with high bit set 26May87kel only forth also forth definitions : hicheck in-file @ [ shadow ] displacement 2* 0 do i block dup 1024 + swap do i c@ 127 > if j . leave then loop loop ; \ amiga burst 890114kel decimal : burst \ addr -- 16 0 do 3 i 1+ at dup 64 type 64 + loop drop ; : .scr# 5 0 at scr @ 3 .r ; : .background dark ." (vi)" 9 0 at file? 16 0 do 0 i 1+ at i 2 .r bl emit 67 i 1+ at bl emit i . loop ; \ amiga faster burst 890118kel decimal editor also variable lastburst_buffer 1024 allot lastburst_buffer 1024 0 fill variable addr variable lastaddr : burst \ addr -- addr ! lastburst_buffer lastaddr ! 16 0 do lastaddr @ 64 -trailing >r drop addr @ 64 -trailing r> max ?dup if 3 i 1+ at type else drop then addr @ lastaddr @ 64 cmove 64 lastaddr +! 64 addr +! loop ; --> \ amiga faster burst (con't) 890118kel decimal : .scr# 5 0 at scr @ 3 .r ; : .background dark ." (vi)" 9 0 at file? 16 0 do 0 i 1+ at i 2 .r bl emit 67 i 1+ at bl emit i . loop ; : snap 'start lastburst_buffer 1024 cmove ; : resetsnap lastburst_buffer 1024 0 fill ; \ 890114kel now is the time for all good spudboys to come fuckin' A, man, it works! \ 890118kel asdjfklsajdfklsjdfklsajdflsajflksajflksajflksajflkasdfjlaaaa \ 890119kel glorp phone list 860616kel Federal Express (617) 391-4760
