diff --git a/msdos/cursor/ced.fb b/msdos/cursor/ced.fb new file mode 100644 index 0000000..96bad38 --- /dev/null +++ b/msdos/cursor/ced.fb @@ -0,0 +1 @@ +\ Commandline EDitor fr volksFORTH rev. 3.80 UH 05feb89Dieses File enthaelt Definitionen, die es erm”glichen die Kommandozeile zu editieren. Es gibt eine Commandline History, die es erm”glicht alte Eingaben wiederzuholen. Diese werden zyklisch auf Screen 0 im File History gesichert und bleiben so auch ber ein SAVESYSTEM erhalten. Tasten: Cursor links/rechts   Zeichen l”schen und <- Zeile l”schen Einfgen an aus Zeile abschlieáen Anfang/Ende der Zeile alte Zeilen wiederholen   \ Commandline EDitor LOAD-Screen UH 20Nov87 jrg 14m„r89 : curleft ( -- ) at? 1- at ; : currite ( -- ) at? 1+ at ; 1 5 +thru \ Erweiterte Eingabe .( Kommandozeilen Editor geladen ) cr \ History -- Kommandogeschichte jrg 14m„r89makefile history 1 more | Variable line# line# off | Variable lastline# lastline# off | : 'history ( n -- addr ) pushfile history c/l * b/blk /mod block + ; | : @line ( n -- addr len ) 'history c/l -trailing ; | : !history ( addr line# -- ) 'history dup c/l blank span @ c/l min cmove update ; | : @history ( addr line# -- ) @line rot swap dup span ! cmove ; | : +line ( n addr -- ) dup @ rot + l/s mod swap ! ; \ Ende der Eingabe jrg 18dez89 | Variable maxchars | Variable cinsert cinsert on | : -text ( a1 a2 l -- 0=equal ) bounds ?DO count I c@ - ?dup IF nip ENDLOOP exit THEN LOOP 0= ; | : done ( a p1 -- a p2 ) 2dup at? rot - span @ dup maxchars ! + at space blankline line# @ @line span @ = IF span @ -text 0=exit 2dup THEN drop lastline# @ !history 1 lastline# +line ; \ Erweiterte Eingabe UH 08OCt87 jrg 19dez89 : redisplay ( addr pos -- ) at? 2swap span @ swap /string type blankline at ; | : del ( addr pos -- ) span @ 0=exit dup >r + dup 1+ swap span @ r> - cmove -1 span +! ; | : ins ( addr pos1 -- ) dup >r + dup dup 1+ span @ r> - cmove> bl swap c! 1 span +! ; | : delete ( a p1 -- a p2 ) 2dup del 2dup redisplay ; | : back ( a p1 -- a p2 ) 1- curleft delete ; | : recall ( a p1 -- a p2 ) at? rot - at dup line# @ @history dup 0 redisplay at? span @ + at span @ ; | : r cinsert @ IF 2dup ins THEN 2dup + r> swap c! 1+ dup span @ max span ! 2dup redisplay ; \ Patch UH 08Oct87 jrg 19dez89 : showcur ( -- ) curshape? swap drop \ bot top cinsert @ IF dup 2/ \ top = bot/2 ELSE dup 1- THEN swap curshape ; : (expect ( addr len -- ) maxchars ! span off lastline# @ line# ! 0 BEGIN span @ maxchars @ u< WHILE key decode showcur REPEAT 2drop ; ' (decode ' keyboard 6 + ! ' (expect ' keyboard 8 + ! \ No newline at end of file diff --git a/msdos/cursor/cursor.txt b/msdos/cursor/cursor.txt new file mode 100644 index 0000000..03c7768 --- /dev/null +++ b/msdos/cursor/cursor.txt @@ -0,0 +1,27 @@ +Im volksFORTH rev.3.81.41 treten, bedingt durch die Vielfalt an +Grafik-Karten fr den PC, unter Umst„nden Probleme mit dem CURSOR +auf. Denn in dem meisten PCs verrichtet eine Hercules-Karte ihre +Dienste, auf die einige Worte im EDITOR und im Kommando-zeilen- +Editor CED zugeschnitten sind. +Die Worte CURON und CUROFF bestimmen das Erscheinungsbild des +Cursors durch Zahlenwerte fr CURSHAPE, die grafikkartenabh„ngig +sind. Hier bietet sich eine Žnderung mit Hilfe des Video- +Interrupts INT$10 an, dessen Funktion $3 im C-Register die +aktuelle Start- und End-Zeile des Cursors wiedergibt. Als +Warnung: Im Zuge meiner amateurhaften Versuche zur +Interruptprogrammierung hat, nach ungesichertem R-Register, ein V +(aktuellen Screen editieren) dafr gesorgt, daá meine gesamte +freie Festplattenkapazit„t der Datei EDITOR.SCR zugeschlagen +wurde. +Mit den neuen Varianten von CURON/OFF máten auch EGA und andere +Karten einen Cursor auf dem Schirm anzeigen. Mit dem +Kommandozeilen-Editor CED h„ngt auch das zweite Problem zusammen: +Wie man in SHOWCUR sieht, wird der Einfge- oder šberschreibmodus +durch das Erscheinungsbild des Cursors verdeutlicht. Da liegt es +auf der Hand, daá in (EXPECT die Wortfolge KEY DECODE SHOWCUR +nach jeder Zeicheneingabe das Aussehen des Cursor in Abh„ngigkeit +vom jeweiligen Modus festlegt und ein etwaiges ( top bot) CURSHAPE +unwirksam machen. Soll dem nicht so sein, k”nnte man eventuell +die jetzt gel”schte Cursor-Anfangszeile in einem der beiden Modi +INS/OVER beibehalten. + \ No newline at end of file diff --git a/msdos/cursor/editor.fb b/msdos/cursor/editor.fb new file mode 100644 index 0000000..9c9387b --- /dev/null +++ b/msdos/cursor/editor.fb @@ -0,0 +1 @@ + volksFORTH Full-Screen-Editor HELP Screen Editor verlassen : flushed: ESC updated: ^E Žnderungen verwerfen: ^U (UNDO) Cursor bewegen : Cursortasten (l”schen mit DEL oder <- ) Einfgen : INS (an/aus), ^ENTER (Screen einfgen) Tabs : TAB (nach rechts), SHIFT TAB (nach links) Bl„ttern : Pg Dn (n„chster), Pg Up (voriger) : F9 (alternate), SHIFT F9 (shadow) mark alternate Scr. : F10 Zeile l”schen/einf. : ^Y (l”schen), ^N (einfgen) Zeile teilen : ^PgDn (split), ^PgUp (join) Suchen und Ersetzen : F2 (Break mit ESC, replace mit 'R' ) Zeilenpuffer : F3 (push&delete), F5 (push), F7 (pop) Zeichenpuffer : F4 (push&delete), F6 (push), F8 (pop) Sonstige : ^F (Fix), ^L (Showload), ^S (Screen #) --> \ Full-Screen Editor ks 22 dez 87 Dieses File enthaelt den Full-Screen Editor fuer die IBM - volksFORTH-Version. Er enthaelt Line- und Chararcter-Stacks, Find&Replace-Funktion sowie Unterstuetzung des Shadow-Screen-Konzepts, der view- Funktion und des sichtbaren Laden von Screens (showload). Durch die integrierte Tastaturtabelle (keytable) laesst sich dieKommandobelegung der Tasten auf einfache Art und Weise aendern. Angepaát fr den IBM PC von K.Schleisiek am 22 dez 87 Anregungen, Kritik und Verbesserungsvorschlaege bitte an: U. Hoffmann Harmsstrasse 71 2300 Kiel \ Load Screen for the Editor jrg 18dez89 Onlyforth \needs Assembler 2 loadfrom asm.scr 3 load \ PC adaption \ &10 load \ ANSI display interface \ &11 load \ BIOS display interface \ &12 load \ MULTItasking display interface &4 &40 thru \ Editor Onlyforth .( Screen Editor geladen) cr \ curshape? curon curoff jrg 20dez89\ gleiches Konzept wie curat? , nur C nach D geschoben \ da C die Cursor-Start & -End-Reihe enth„lt Code curshape? ( -- top bot ) D push R push $F # A+ mov $10 int \ in AL der Videomodus !! 3 # A+ mov $10 int R pop C D mov 0 # A mov D+ A- xchg A push Next end-code : curon curshape? curshape ; \ VGA hat max. 15 Reihen! : curoff &16 dup curshape ; \ BIM adaption jrg 18dez89| : ?range ( n -- n ) isfile@ 0=exit ( n) dup 0< 9 and ?diskerror dup capacity - 1+ 0 max ?dup 0=exit more ; | : block ( n -- adr ) ?range block ; $1B Constant #esc Variable caps caps off Label ?capital 1 # caps #) byte test 0= ?[ (capital # jmp ]? ret end-code \ search delete insert replace ks 20 dez 87 | : delete ( buffer size count -- ) over min >r r@ - ( left over ) dup 0> IF 2dup swap dup r@ + -rot swap cmove THEN + r> bl fill ; | : insert ( string length buffer size -- ) rot over min >r r@ - ( left over ) over dup r@ + rot cmove> r> cmove ; | : replace ( string length buffer size -- ) rot min cmove ; \ usefull definitions and Editor vocabulary UH 11mai88 Vocabulary Editor ' Forth | Alias [F] immediate ' Editor | Alias [E] immediate Editor also definitions | : c ( n --) \ moves cyclic thru the screen r# @ + b/blk mod r# ! ; | Variable r#' r#' off | Variable scr' scr' off ' fromfile | Alias isfile' | Variable lastfile | Variable lastscr | Variable lastr# \\ move cursor with position-checking ks 18 dez 87 \ different versions of cursor positioning error reporting | : c ( n --) \ checks the cursor position r# @ + dup 0 b/blk uwithin not Abort" There is a border!" r# ! ; | : c ( n --) \ goes thru the screens r# @ + dup b/blk 1- > IF 1 scr +! THEN dup 0< IF -1 scr +! THEN b/blk mod r# ! ; | : c ( n --) \ moves cyclic thru the screen r# @ + b/blk mod r# ! ; \ calculate addresses ks 20 dez 87 | : *line ( l -- adr ) c/l * ; | : /line ( n -- c l ) c/l /mod ; | : top ( -- ) r# off ; | : cursor ( -- n ) r# @ ; | : 'start ( -- adr ) scr @ block ; | : 'end ( -- adr ) 'start b/blk + ; | : 'cursor ( -- adr ) 'start cursor + ; | : position ( -- c l ) cursor /line ; | : line# ( -- l ) position nip ; | : col# ( -- c ) position drop ; | : 'line ( -- adr ) 'start line# *line + ; | : 'line-end ( -- adr ) 'line c/l + 1- ; | : #after ( -- n ) c/l col# - ; | : #remaining ( -- n ) b/blk cursor - ; | : #end ( -- n ) b/blk line# *line - ; \ move cursor directed UH 11dez88| Create >at 0 , 0 , | : curup c/l negate c ; | : curdown c/l c ; | : curleft -1 c ; | : curright 1 c ; | : +tab ( 1/4 -> ) cursor $10 / 1+ $10 * cursor - c ; | : -tab ( 1/8 <- ) cursor 8 mod negate dup 0= 8 * + c ; | : >last ( adr len -- ) -trailing nip b/blk min r# ! ; | : #after c ; | : ( -- ) 'start line# 1+ *line 1- >last ; | : >""end ( -- ) 'start b/blk >last ; \ show border UH 29Sep87 &14 | Constant dx 1 | Constant dy | : horizontal ( row eck1 eck2 -- row' ) rot dup >r dx 1- at swap emit c/l 0 DO Ascii Ä emit LOOP emit r> 1+ ; | : vertical ( row -- row' ) l/s 0 DO dup dx 1- at Ascii ł emit row dx c/l + at Ascii ł emit 1+ LOOP ; | : border dy 1- Ascii Ú Ascii ż horizontal vertical Ascii À Ascii Ù horizontal drop ; | : edit-at ( -- ) position swap dy dx d+ at ; \\ ANSI display interface ksjrg 18dez89 | : redisplay ( line# -- ) dup dy + dx at *line 'start + c/l type ; | : (done ( -- ) ; immediate | : install-screen ( -- ) l/s 6 + 0 >at 2! page ; \\ BIOS-display interface ksjrg 18dez89| Code (.line ( line addr videoseg -- ) A pop W pop I push E: push D E: mov $0E # W add W W add A I xchg c/l # C mov attribut #) A+ mov [[ byte lods stos C0= ?] E: pop I pop D pop Next end-code | : redisplay ( line# -- ) dup 1+ c/row * swap c/l * 'start + video@ (.line ; | : (done ( -- ) ; immediate | : install-screen ( -- ) l/s 6 + 0 >at 2! page ; \ MULTI-display interface ks UH 10Sep87| Code (.line ( line addr videoseg -- ) C pop W pop I push E: push D E: mov $0E # W add W W add u' area U D) I mov u' catt I D) A+ mov C I mov c/l # C mov [[ byte lods stos C0= ?] E: pop I pop D pop Next end-code | : redisplay ( line# -- ) dup 1+ c/row * swap c/l * 'start + video@ (.line ; | : (done ( -- ) line# 2+ c/col 2- window ; | : cleartop ( -- ) 0 l/s 5 + window (page ; | : install-screen ( -- ) row l/s 6 + u< IF l/s 6 + 0 full page ELSE at? cleartop THEN >at 2! ; \ display screen jrg 18dez89Forth definitions : updated? ( -- f) 'start 2- @ 0< ; Editor definitions | : .updated ( -- ) 9 0 at updated? IF 4 spaces ELSE ." not " THEN ." updated" ; | : .screen l/s 0 DO I redisplay LOOP ; \ | : .file ( fcb -- ) \ ?dup IF body> >name .name exit THEN ." direct" ; | : .title [ DOS ] 1 0 at isfile@ invers .file normal dx 1- tab 2 0 at drv (.drv scr @ 6 .r 4 0 at fromfile @ underline .file normal dx 1- tab 5 0 at fswap drv (.drv scr' @ 6 .r fswap .updated ; | : .all .title .screen ; \ check errors UH 02Nov86 | : ?bottom ( -- ) 'end c/l - c/l -trailing nip Abort" You would lose a line" ; | : ?fit ( n -- ) 'line c/l -trailing nip + c/l > IF line# redisplay true Abort" You would lose a char" THEN ; | : ?end 1 ?fit ; \ programmer's id ks jrg 24nov89 $12 | Constant id-len Create id id-len allot id id-len erase | : stamp ( -- ) id 1+ count 'start c/l + over - swap cmove ; | : ?stamp ( -- ) updated? IF stamp THEN ; | : ## ( n -- ) base push decimal 0 <# # # #> id 1+ attach ; | : get-id ( -- ) id c@ ?exit ID on cr ." Enter your ID : " at? 3 0 DO Ascii . emit LOOP at id 2+ 3 expect span @ dup id 1+ c! 0=exit bl id 1+ append date@ rot ## swap >months id 1+ attach ## ; \ update screen-display UH 28Aug87 | : emptybuf prev @ 2+ dup on 4+ off ; | : undo emptybuf .all ; | : modified updated? ?exit update .updated ; | : linemodified modified line# redisplay ; | : screenmodified modified l/s line# ?DO I redisplay LOOP ; | : .modified ( -- ) >at 2@ at space scr @ . updated? not IF ." un" THEN ." modified" ?stamp ; \ leave editor jrg 04jul88| Variable (pad (pad off | : memtop ( -- adr) sp@ $100 - ; | Create char 1 allot | Variable imode imode off | : .imode at? 7 0 at imode @ IF ." insert " ELSE bright ." overwrite" normal THEN at ; | : setimode imode on .imode ; | : clrimode imode off .imode ; | : done ( -- ) (done ['] (quit is 'quit ['] (error errorhandler ! quit ; | : update-exit ( -- ) .modified done ; | : flushed-exit ( -- ) .modified save-buffers done ; \ handle screens UH 21jan89 | : insert-screen ( scr -- ) \ before scr 1 more fromfile push isfile@ fromfile ! capacity 2- over 1+ convey ; | : wipe-screen ( -- ) 'start b/blk blank ; | : new-screen ( -- ) scr @ insert-screen wipe-screen top screenmodified ; \ handle lines UH 01Nov86 | : (clear-line 'line c/l blank ; | : clear-line (clear-line linemodified ; | : clear> 'cursor #after blank linemodified ; | : delete-line 'line #end c/l delete screenmodified ; | : backline curup delete-line ; | : (insert-line ?bottom 'line c/l over #end insert (clear-line ; | : insert-line (insert-line screenmodified ; \ join and split lines UH 11dez88 | : insert-spaces ( n -- ) 'cursor swap 2dup over #remaining insert blank ; | : split ( -- ) ?bottom cursor col# insert-spaces r# ! #after insert-spaces screenmodified ; | : delete-characters ( n -- ) 'cursor #remaining rot delete ; | : join ( -- ) cursor line> col# Abort" next line will not fit!" #after + dup delete-characters cursor c/l rot - dup 0< IF negate insert-spaces ELSE delete-characters THEN r# ! screenmodified ; \ handle characters UH 01Nov86 | : delete-char 'cursor #after 1 delete linemodified ; | : backspace curleft delete-char ; | : (insert-char ?end 'cursor 1 over #after insert ; | : insert-char (insert-char bl 'cursor c! linemodified ; | : putchar ( --) char c@ imode @ IF (insert-char THEN 'cursor c! linemodified curright ; \ stack lines UH 31Oct86 | Create lines 4 allot \ { 2+pointer | 2base } | : 'lines ( -- adr) lines 2@ + ; | : @line 'lines memtop u> Abort" line buffer full" 'line 'lines c/l cmove c/l lines +! ; | : copyline @line curdown ; | : line>buf @line delete-line ; | : !line c/l negate lines +! 'lines 'line c/l cmove ; | : buf>line lines @ 0= Abort" line buffer empty" ?bottom (insert-line !line screenmodified ; \ stack characters UH 01Nov86 | Create chars 4 allot \ { 2+pointer | 2base } | : 'chars ( -- adr) chars 2@ + ; | : @char 'chars 1- lines 2+ @ u> Abort" char buffer full" 'cursor c@ 'chars c! 1 chars +! ; | : copychar @char curright ; | : char>buf @char delete-char ; | : !char -1 chars +! 'chars c@ 'cursor c! ; | : buf>char chars @ 0= Abort" char buffer empty" ?end (insert-char !char linemodified ; \ switch screens UH 11mai88 | : imprint ( -- ) \ remember valid file isfile@ lastfile ! scr @ lastscr ! r# @ lastr# ! ; | : remember ( -- ) lastfile @ isfile ! lastscr @ scr ! lastr# @ r# ! ; | : associate \ switch to alternate screen isfile' @ isfile@ isfile' ! isfile ! scr' @ scr @ scr' ! scr ! r#' @ r# @ r#' ! r# ! ; | : mark isfile@ isfile' ! scr @ scr' ! r# @ r#' ! .all ; | : n ?stamp 1 scr +! .all ; | : b ?stamp -1 scr +! .all ; | : a ?stamp associate .all ; \ shadow screens UH 03Nov86 Variable shadow shadow off | : (shadow isfile@ IF capacity 2/ exit THEN shadow @ ; | : >shadow ?stamp \ switch to shadow screen (shadow dup scr @ u> not IF negate THEN scr +! .all ; \ load and show screens ks 02 m„r 88 | : showoff ['] exit 'name ! normal ; | : show ( -- ) blk @ 0= IF showoff exit THEN >in @ 1- r# ! edit-at imprint blk @ scr @ - 0=exit blk @ scr ! normal curoff .all invers curon ; | : showload ( -- ) ?stamp save-buffers ['] show 'name ! curon invers adr .status push ['] noop is .status scr @ scr push scr off r# push r# @ (load showoff ; \ find strings ks 20 dez 87 | Variable insert-buffer | Variable find-buffer | : 'insert ( -- addr ) insert-buffer @ ; | : 'find ( -- addr ) find-buffer @ ; | : .buf ( addr -- ) count type ." ł" &80 col - spaces ; | : get ( addr -- ) >r at? r@ .buf 2dup at r@ 1+ c/l expect span @ ?dup IF r@ c! THEN at r> .buf ; | : get-buffers dy l/s + 2+ dx 1- 2dup at ." find: ł" 'find get swap 1+ swap 2- at ." ? replace: ł" 'insert get ; \ ks 20 dez 87 Code match ( addr1 len1 string -- addr2 len2 ) D W mov W ) D- mov $FF # D and 0= ?[ D pop Next ]? W inc D dec C pop I A mov I pop A push W ) A- mov W inc ?capital # call A- A+ mov D C sub >= ?[ I inc Label done I dec A pop I push A I mov C D add Next ]? [[ byte lods ?capital # call A+ A- cmp 0= ?[ D D or done 0= not ?] I push W push C push A push D C mov [[ byte lods ?capital # call A+ A- xchg W ) A- mov W inc ?capital # call A+ A- cmp 0= ?[[ C0= ?] A pop C pop W pop I pop done ]] ]? A pop C pop W pop I pop ]? C0= ?] I inc done ]] end-code \ search for string UH 11mai88 | : skip ( addr -- addr' ) 'find c@ + ; | : search ( buf len string -- offset flag ) >r stash r@ match r> c@ < IF drop 0= false exit THEN swap - true ; | : find? ( -- r# f ) 'cursor #remaining 'find search ; | : searchthru ( -- r# scr ) find? IF skip cursor + scr @ exit THEN drop capacity scr @ 1+ ?DO I 2 3 at 6 .r I block b/blk 'find search IF skip I endloop exit THEN stop? Abort" Break!" LOOP true Abort" not found!" ; \ replace strings UH 14mai88| : replace? ( -- f ) dy l/s + 3+ dx 3 - at key dup #cr = IF line# redisplay true Abort" Break!" THEN capital Ascii R = ; | : "mark ( -- ) r# push 'find count dup negate c edit-at invers type normal ; | : (replace 'insert c@ 'find c@ - ?fit r# push 'find c@ negate c 'cursor #after 'find c@ delete 'insert count 'cursor #after insert modified ; | : "replace get-buffers BEGIN searchthru scr @ - ?dup IF ?stamp scr +! .all THEN r# ! imprint "mark replace? IF (replace THEN line# redisplay REPEAT ;\ Display Help-Screen, misc commands jrg 24nov89 | : helpfile ( -- ) fromfile push editor.scr ; | : .help ( --) isfile push scr push helpfile scr off .screen ; | : help ( -- ) .help key drop .screen ; | : screen# ( -- scr ) scr @ ; | Defer (fix-word | : fix-word ( -- ) isfile@ loadfile ! scr @ blk ! cursor >in ! (fix-word ; \ Control-Characters IBM-PC Functionkeys UH 10Sep87 Forth definitions : Ctrl ( -- c ) name 1+ c@ $1F and state @ IF [compile] Literal THEN ; immediate \needs #del $7F Constant #del Editor definitions | : flipimode imode @ 0= imode ! .imode ; | : F ( # -- 16b ) $FFC6 swap - ; | : shift ( n -- n' ) dup 0< + &24 - ; \ Control-Characters IBM-PC Functionkeys UH 11dez88 Create keytable -&72 , -&75 , -&80 , -&77 , 3 F , 4 F , 7 F , 8 F , Ctrl F , Ctrl S , 5 F , 6 F , 1 F , Ctrl H , #del , -&83 , Ctrl Y , Ctrl N , -&82 , #cr , #tab , #tab shift , -&119 , -&117 , 2 F , Ctrl U , Ctrl E , #esc , Ctrl L , 9 F shift , -&81 , -&73 , 9 F , &10 F , -&71 , -&79 , -&118 , -&132 , #lf , here keytable - 2/ Constant #keys \ Try a screen Editor UH 11dez88 Create: actiontable curup curleft curdown curright line>buf char>buf buf>line buf>char fix-word screen# copyline copychar help backspace backspace delete-char ( insert-char ) delete-line insert-line flipimode ( clear-line clear> ) +tab -tab top >""end "replace undo update-exit flushed-exit showload >shadow n b a mark split join new-screen ; here actiontable - 2/ 1- #keys - abort( # of actions) \ find keys ks 20 dez 87 | : findkey ( key -- adr/default ) #keys 0 DO dup keytable [F] I 2* + @ = IF drop [E] actiontable [F] I 2* + @ endloop exit THEN LOOP drop ['] putchar ; \ allocate buffers UH 01Nov86 c/l 2* | Constant cstack-size | : nextbuf ( adr -- adr' ) cstack-size + ; | : ?clearbuffer pad (pad @ = ?exit pad dup (pad ! nextbuf dup find-buffer ! 'find off nextbuf dup insert-buffer ! 'insert off nextbuf dup 0 chars 2! nextbuf 0 lines 2! ; \ enter and exit the editor, editor's loop UH 11mai88 | Variable jingle jingle on | : bell 07 charout jingle off ; | : clear-error ( -- ) jingle @ ?exit dy l/s + 1+ dx at c/l spaces jingle on ; | : fullquit ( -- ) BEGIN ?clearbuffer edit-at key dup char c! findkey imprint execute ( .status ) clear-error REPEAT ; | : fullerror ( string -- ) jingle @ IF bell THEN count dy l/s + 1+ over 2/ dx $20 + swap - at invers type normal &80 col - spaces remember .all quit ; | : install ( -- ) ['] fullquit Is 'quit ['] fullerror errorhandler ! ; \ enter and exit the Editor jrg 30m„r89 Forth definitions : v ( -- ) [E] 'start drop get-id install-screen install ?clearbuffer border .all .imode .status quit ; \ ' v Alias ed : l ( scr -- ) 1 arguments scr ! [E] top [F] v ; ' l Alias edit \ savesystem enhanced view UH 24jun88 : savesystem [E] id off (pad off savesystem ; Editor definitions | : >find ?clearbuffer >in push name dup c@ 2+ >r bl over c! r> 'find place ; Forth definitions : fix [ Dos ] >find ' @view >file isfile ! scr ! [E] top curdown find? IF skip 1- THEN c v ; ' fix Is (fix-word \\ Ecken und Macken jrg 18dez89 Das Problem fr einige GrafikKarten, keinen Cursor zu haben, wird im CED.scr verursacht, denn SHOWCUR macht ein konstantes, GrafikKarten-abh„ngiges CURSHAPE. Ein zweites Problem ist das sinnlose Arbeiten des Wortes CURSHAPE selbst: Die Cursorgr”áe wird neu eingestellt, dann abervon einem der Ausgabeworte (welchem?) gel”scht. Verdacht: (TYPE \ No newline at end of file diff --git a/sources/msdos/cursor/ced.fth b/sources/msdos/cursor/ced.fth new file mode 100644 index 0000000..1e581b4 --- /dev/null +++ b/sources/msdos/cursor/ced.fth @@ -0,0 +1,171 @@ + +\ *** Block No. 0, Hexblock 0 + +\ Commandline EDitor fĂŒr volksFORTH rev. 3.80 UH 05feb89 +Dieses File enthaelt Definitionen, die es ermöglichen die +Kommandozeile zu editieren. +Es gibt eine Commandline History, die es ermöglicht alte +Eingaben wiederzuholen. Diese werden zyklisch auf Screen 0 +im File History gesichert und bleiben so auch ĂŒber ein +SAVESYSTEM erhalten. + +Tasten: + Cursor links/rechts   + Zeichen löschen und <- + Zeile löschen + EinfĂŒgen an aus + Zeile abschließen + Anfang/Ende der Zeile + alte Zeilen wiederholen   + +\ *** Block No. 1, Hexblock 1 + +\ Commandline EDitor LOAD-Screen UH 20Nov87 jrg 14mĂ€r89 + + +: curleft ( -- ) at? 1- at ; +: currite ( -- ) at? 1+ at ; + +1 5 +thru \ Erweiterte Eingabe + +.( Kommandozeilen Editor geladen ) cr + + + + + + + + +\ *** Block No. 2, Hexblock 2 + +\ History -- Kommandogeschichte jrg 14mĂ€r89 +makefile history 1 more + +| Variable line# line# off +| Variable lastline# lastline# off + +| : 'history ( n -- addr ) pushfile history + c/l * b/blk /mod block + ; + +| : @line ( n -- addr len ) 'history c/l -trailing ; +| : !history ( addr line# -- ) + 'history dup c/l blank span @ c/l min cmove update ; +| : @history ( addr line# -- ) + @line rot swap dup span ! cmove ; + +| : +line ( n addr -- ) dup @ rot + l/s mod swap ! ; + +\ *** Block No. 3, Hexblock 3 + +\ Ende der Eingabe jrg 18dez89 + +| Variable maxchars | Variable cinsert cinsert on + +| : -text ( a1 a2 l -- 0=equal ) bounds + ?DO count I c@ - ?dup IF nip ENDLOOP exit THEN LOOP 0= ; + +| : done ( a p1 -- a p2 ) 2dup + at? rot - span @ dup maxchars ! + at space blankline + line# @ @line span @ = IF span @ -text 0=exit 2dup THEN + drop lastline# @ !history 1 lastline# +line ; + + + + + + +\ *** Block No. 4, Hexblock 4 + +\ Erweiterte Eingabe UH 08OCt87 jrg 19dez89 + : redisplay ( addr pos -- ) + at? 2swap span @ swap /string type blankline at ; + +| : del ( addr pos -- ) span @ 0=exit dup >r + dup 1+ swap + span @ r> - cmove -1 span +! ; +| : ins ( addr pos1 -- ) dup >r + dup dup 1+ + span @ r> - cmove> bl swap c! 1 span +! ; + +| : delete ( a p1 -- a p2 ) 2dup del 2dup redisplay ; +| : back ( a p1 -- a p2 ) 1- curleft delete ; + +| : recall ( a p1 -- a p2 ) at? rot - at dup line# @ @history + dup 0 redisplay at? span @ + at span @ ; + +| : r cinsert @ IF 2dup ins THEN 2dup + + r> swap c! 1+ dup span @ max span ! 2dup redisplay ; + +\ *** Block No. 6, Hexblock 6 + +\ Patch UH 08Oct87 jrg 19dez89 + +: showcur ( -- ) + curshape? swap drop \ bot top + cinsert @ IF dup 2/ \ top = bot/2 + ELSE dup 1- + THEN swap curshape ; + +: (expect ( addr len -- ) maxchars ! span off + lastline# @ line# ! 0 + BEGIN span @ maxchars @ u< + WHILE key decode showcur REPEAT 2drop ; + +' (decode ' keyboard 6 + ! +' (expect ' keyboard 8 + ! + + +\ *** Block No. 7, Hexblock 7 + + + + + + + + + + + + + + + + + + +\ *** Block No. 8, Hexblock 8 + + + + + + + + + + + + + + + + + diff --git a/sources/msdos/cursor/editor.fth b/sources/msdos/cursor/editor.fth new file mode 100644 index 0000000..113397c --- /dev/null +++ b/sources/msdos/cursor/editor.fth @@ -0,0 +1,798 @@ + +\ *** Block No. 0, Hexblock 0 + + volksFORTH Full-Screen-Editor HELP Screen + +Editor verlassen : flushed: ESC updated: ^E +Änderungen verwerfen: ^U (UNDO) +Cursor bewegen : Cursortasten (löschen mit DEL oder <- ) +EinfĂŒgen : INS (an/aus), ^ENTER (Screen einfĂŒgen) +Tabs : TAB (nach rechts), SHIFT TAB (nach links) +BlĂ€ttern : Pg Dn (nĂ€chster), Pg Up (voriger) + : F9 (alternate), SHIFT F9 (shadow) +mark alternate Scr. : F10 +Zeile löschen/einf. : ^Y (löschen), ^N (einfĂŒgen) +Zeile teilen : ^PgDn (split), ^PgUp (join) +Suchen und Ersetzen : F2 (Break mit ESC, replace mit 'R' ) +Zeilenpuffer : F3 (push&delete), F5 (push), F7 (pop) +Zeichenpuffer : F4 (push&delete), F6 (push), F8 (pop) +Sonstige : ^F (Fix), ^L (Showload), ^S (Screen #) + +\ *** Block No. 1, Hexblock 1 + +--> \ Full-Screen Editor ks 22 dez 87 +Dieses File enthaelt den Full-Screen Editor fuer die IBM - +volksFORTH-Version. + +Er enthaelt Line- und Chararcter-Stacks, Find&Replace-Funktion +sowie Unterstuetzung des Shadow-Screen-Konzepts, der view- +Funktion und des sichtbaren Laden von Screens (showload). + +Durch die integrierte Tastaturtabelle (keytable) laesst sich die +Kommandobelegung der Tasten auf einfache Art und Weise aendern. + +Angepaßt fĂŒr den IBM PC von K.Schleisiek am 22 dez 87 +Anregungen, Kritik und Verbesserungsvorschlaege bitte an: + U. Hoffmann + Harmsstrasse 71 + 2300 Kiel + +\ *** Block No. 2, Hexblock 2 + +\ Load Screen for the Editor jrg 18dez89 + + Onlyforth \needs Assembler 2 loadfrom asm.scr + + 3 load \ PC adaption + +\ &10 load \ ANSI display interface +\ &11 load \ BIOS display interface +\ &12 load \ MULTItasking display interface + + &4 &40 thru \ Editor + +Onlyforth .( Screen Editor geladen) cr + + + + +\ *** Block No. 3, Hexblock 3 + +\ curshape? curon curoff jrg 20dez89 +\ gleiches Konzept wie curat? , nur C nach D geschoben +\ da C die Cursor-Start & -End-Reihe enthĂ€lt + Code curshape? ( -- top bot ) + D push R push + $F # A+ mov $10 int \ in AL der Videomodus !! + 3 # A+ mov $10 int + R pop + C D mov + 0 # A mov + D+ A- xchg + A push Next end-code + + : curon curshape? curshape ; +\ VGA hat max. 15 Reihen! + : curoff &16 dup curshape ; + +\ *** Block No. 4, Hexblock 4 + +\ BIM adaption jrg 18dez89 +| : ?range ( n -- n ) + isfile@ 0=exit + ( n) dup 0< 9 and ?diskerror + dup capacity - 1+ 0 max + ?dup 0=exit more ; + +| : block ( n -- adr ) ?range block ; + + $1B Constant #esc + + + Variable caps caps off + Label ?capital 1 # caps #) byte test + 0= ?[ (capital # jmp ]? ret end-code + + +\ *** Block No. 5, Hexblock 5 + +\ search delete insert replace ks 20 dez 87 + +| : delete ( buffer size count -- ) + over min >r r@ - ( left over ) dup 0> + IF 2dup swap dup r@ + -rot swap cmove THEN + + r> bl fill ; + +| : insert ( string length buffer size -- ) + rot over min >r r@ - ( left over ) + over dup r@ + rot cmove> r> cmove ; + +| : replace ( string length buffer size -- ) + rot min cmove ; + + + + +\ *** Block No. 6, Hexblock 6 + +\ usefull definitions and Editor vocabulary UH 11mai88 + +Vocabulary Editor + +' Forth | Alias [F] immediate +' Editor | Alias [E] immediate + +Editor also definitions + +| : c ( n --) \ moves cyclic thru the screen + r# @ + b/blk mod r# ! ; + +| Variable r#' r#' off +| Variable scr' scr' off +' fromfile | Alias isfile' +| Variable lastfile | Variable lastscr | Variable lastr# + +\ *** Block No. 7, Hexblock 7 + +\\ move cursor with position-checking ks 18 dez 87 +\ different versions of cursor positioning error reporting + +| : c ( n --) \ checks the cursor position + r# @ + dup 0 b/blk uwithin not + Abort" There is a border!" r# ! ; + +| : c ( n --) \ goes thru the screens + r# @ + dup b/blk 1- > IF 1 scr +! THEN + dup 0< IF -1 scr +! THEN b/blk mod r# ! ; + +| : c ( n --) \ moves cyclic thru the screen + r# @ + b/blk mod r# ! ; + + + + +\ *** Block No. 8, Hexblock 8 + +\ calculate addresses ks 20 dez 87 +| : *line ( l -- adr ) c/l * ; +| : /line ( n -- c l ) c/l /mod ; +| : top ( -- ) r# off ; +| : cursor ( -- n ) r# @ ; +| : 'start ( -- adr ) scr @ block ; +| : 'end ( -- adr ) 'start b/blk + ; +| : 'cursor ( -- adr ) 'start cursor + ; +| : position ( -- c l ) cursor /line ; +| : line# ( -- l ) position nip ; +| : col# ( -- c ) position drop ; +| : 'line ( -- adr ) 'start line# *line + ; +| : 'line-end ( -- adr ) 'line c/l + 1- ; +| : #after ( -- n ) c/l col# - ; +| : #remaining ( -- n ) b/blk cursor - ; +| : #end ( -- n ) b/blk line# *line - ; + +\ *** Block No. 9, Hexblock 9 + +\ move cursor directed UH 11dez88 +| Create >at 0 , 0 , +| : curup c/l negate c ; +| : curdown c/l c ; +| : curleft -1 c ; +| : curright 1 c ; + +| : +tab ( 1/4 -> ) cursor $10 / 1+ $10 * cursor - c ; +| : -tab ( 1/8 <- ) cursor 8 mod negate dup 0= 8 * + c ; + +| : >last ( adr len -- ) -trailing nip b/blk min r# ! ; +| : #after c ; +| : ( -- ) 'start line# 1+ *line 1- >last ; +| : >""end ( -- ) 'start b/blk >last ; + +\ *** Block No. 10, Hexblock a + +\ show border UH 29Sep87 + +&14 | Constant dx 1 | Constant dy + +| : horizontal ( row eck1 eck2 -- row' ) + rot dup >r dx 1- at swap emit + c/l 0 DO Ascii ─ emit LOOP emit r> 1+ ; + +| : vertical ( row -- row' ) + l/s 0 DO dup dx 1- at Ascii │ emit + row dx c/l + at Ascii │ emit 1+ LOOP ; + +| : border dy 1- Ascii ┌ Ascii ┐ horizontal + vertical Ascii └ Ascii ┘ horizontal drop ; + +| : edit-at ( -- ) position swap dy dx d+ at ; + +\ *** Block No. 11, Hexblock b + +\\ ANSI display interface ksjrg 18dez89 + + + + + + + +| : redisplay ( line# -- ) + dup dy + dx at *line 'start + c/l type ; + +| : (done ( -- ) ; immediate + + +| : install-screen ( -- ) l/s 6 + 0 >at 2! page ; + + +\ *** Block No. 12, Hexblock c + +\\ BIOS-display interface ksjrg 18dez89 +| Code (.line ( line addr videoseg -- ) + A pop W pop I push E: push D E: mov + $0E # W add W W add A I xchg c/l # C mov + attribut #) A+ mov [[ byte lods stos C0= ?] + E: pop I pop D pop Next end-code + + +| : redisplay ( line# -- ) + dup 1+ c/row * swap c/l * 'start + video@ (.line ; + +| : (done ( -- ) ; immediate + + +| : install-screen ( -- ) l/s 6 + 0 >at 2! page ; + + +\ *** Block No. 13, Hexblock d + +\ MULTI-display interface ks UH 10Sep87 +| Code (.line ( line addr videoseg -- ) + C pop W pop I push E: push D E: mov + $0E # W add W W add u' area U D) I mov + u' catt I D) A+ mov C I mov + c/l # C mov [[ byte lods stos C0= ?] + E: pop I pop D pop Next end-code + +| : redisplay ( line# -- ) + dup 1+ c/row * swap c/l * 'start + video@ (.line ; + +| : (done ( -- ) line# 2+ c/col 2- window ; + +| : cleartop ( -- ) 0 l/s 5 + window (page ; +| : install-screen ( -- ) row l/s 6 + u< + IF l/s 6 + 0 full page ELSE at? cleartop THEN >at 2! ; + +\ *** Block No. 14, Hexblock e + +\ display screen jrg 18dez89 +Forth definitions + : updated? ( -- f) 'start 2- @ 0< ; +Editor definitions +| : .updated ( -- ) 9 0 at + updated? IF 4 spaces ELSE ." not " THEN ." updated" ; + +| : .screen l/s 0 DO I redisplay LOOP ; +\ | : .file ( fcb -- ) +\ ?dup IF body> >name .name exit THEN ." direct" ; +| : .title [ DOS ] 1 0 at isfile@ invers .file normal dx 1- tab + 2 0 at drv (.drv scr @ 6 .r + 4 0 at fromfile @ underline .file normal dx 1- tab + 5 0 at fswap drv (.drv scr' @ 6 .r fswap .updated ; + +| : .all .title .screen ; + +\ *** Block No. 15, Hexblock f + +\ check errors UH 02Nov86 + +| : ?bottom ( -- ) 'end c/l - c/l -trailing nip + Abort" You would lose a line" ; + +| : ?fit ( n -- ) 'line c/l -trailing nip + c/l > + IF line# redisplay + true Abort" You would lose a char" THEN ; + +| : ?end 1 ?fit ; + + + + + + + +\ *** Block No. 16, Hexblock 10 + +\ programmer's id ks jrg 24nov89 + +$12 | Constant id-len +Create id id-len allot id id-len erase + +| : stamp ( -- ) id 1+ count 'start c/l + over - swap cmove ; + +| : ?stamp ( -- ) updated? IF stamp THEN ; + +| : ## ( n -- ) base push decimal 0 <# # # #> id 1+ attach ; + +| : get-id ( -- ) id c@ ?exit ID on + cr ." Enter your ID : " at? 3 0 DO Ascii . emit LOOP at + id 2+ 3 expect span @ dup id 1+ c! 0=exit + bl id 1+ append date@ rot ## swap >months id 1+ attach ## ; + + +\ *** Block No. 17, Hexblock 11 + +\ update screen-display UH 28Aug87 + +| : emptybuf prev @ 2+ dup on 4+ off ; + +| : undo emptybuf .all ; + +| : modified updated? ?exit update .updated ; + +| : linemodified modified line# redisplay ; + +| : screenmodified modified + l/s line# ?DO I redisplay LOOP ; + +| : .modified ( -- ) >at 2@ at space scr @ . + updated? not IF ." un" THEN ." modified" ?stamp ; + + +\ *** Block No. 18, Hexblock 12 + +\ leave editor jrg 04jul88 +| Variable (pad (pad off +| : memtop ( -- adr) sp@ $100 - ; + +| Create char 1 allot +| Variable imode imode off +| : .imode at? 7 0 at + imode @ IF ." insert " + ELSE bright ." overwrite" normal THEN at ; +| : setimode imode on .imode ; +| : clrimode imode off .imode ; +| : done ( -- ) (done + ['] (quit is 'quit ['] (error errorhandler ! quit ; + +| : update-exit ( -- ) .modified done ; +| : flushed-exit ( -- ) .modified save-buffers done ; + +\ *** Block No. 19, Hexblock 13 + +\ handle screens UH 21jan89 + +| : insert-screen ( scr -- ) \ before scr + 1 more fromfile push isfile@ fromfile ! + capacity 2- over 1+ convey ; + +| : wipe-screen ( -- ) 'start b/blk blank ; + +| : new-screen ( -- ) + scr @ insert-screen wipe-screen top screenmodified ; + + + + + + + +\ *** Block No. 20, Hexblock 14 + +\ handle lines UH 01Nov86 + +| : (clear-line 'line c/l blank ; +| : clear-line (clear-line linemodified ; + +| : clear> 'cursor #after blank linemodified ; + +| : delete-line 'line #end c/l delete screenmodified ; + +| : backline curup delete-line ; + +| : (insert-line + ?bottom 'line c/l over #end insert (clear-line ; + +| : insert-line (insert-line screenmodified ; + + +\ *** Block No. 21, Hexblock 15 + +\ join and split lines UH 11dez88 + +| : insert-spaces ( n -- ) 'cursor swap + 2dup over #remaining insert blank ; + +| : split ( -- ) ?bottom cursor col# insert-spaces r# ! + #after insert-spaces screenmodified ; + +| : delete-characters ( n -- ) 'cursor #remaining rot delete ; + +| : join ( -- ) cursor line> col# Abort" next line will not fit!" + #after + dup delete-characters + cursor c/l rot - dup 0< + IF negate insert-spaces ELSE delete-characters THEN r# ! + screenmodified ; + +\ *** Block No. 22, Hexblock 16 + +\ handle characters UH 01Nov86 + +| : delete-char 'cursor #after 1 delete linemodified ; + +| : backspace curleft delete-char ; + +| : (insert-char ?end 'cursor 1 over #after insert ; + + +| : insert-char (insert-char bl 'cursor c! linemodified ; + +| : putchar ( --) char c@ + imode @ IF (insert-char THEN + 'cursor c! linemodified curright ; + + + +\ *** Block No. 23, Hexblock 17 + +\ stack lines UH 31Oct86 + +| Create lines 4 allot \ { 2+pointer | 2base } +| : 'lines ( -- adr) lines 2@ + ; + +| : @line 'lines memtop u> Abort" line buffer full" + 'line 'lines c/l cmove c/l lines +! ; + +| : copyline @line curdown ; +| : line>buf @line delete-line ; + +| : !line c/l negate lines +! 'lines 'line c/l cmove ; + +| : buf>line lines @ 0= Abort" line buffer empty" + ?bottom (insert-line !line screenmodified ; + + +\ *** Block No. 24, Hexblock 18 + +\ stack characters UH 01Nov86 + +| Create chars 4 allot \ { 2+pointer | 2base } +| : 'chars ( -- adr) chars 2@ + ; + +| : @char 'chars 1- lines 2+ @ u> Abort" char buffer full" + 'cursor c@ 'chars c! 1 chars +! ; + +| : copychar @char curright ; +| : char>buf @char delete-char ; + +| : !char -1 chars +! 'chars c@ 'cursor c! ; + +| : buf>char chars @ 0= Abort" char buffer empty" + ?end (insert-char !char linemodified ; + + +\ *** Block No. 25, Hexblock 19 + +\ switch screens UH 11mai88 + +| : imprint ( -- ) \ remember valid file + isfile@ lastfile ! scr @ lastscr ! r# @ lastr# ! ; + +| : remember ( -- ) + lastfile @ isfile ! lastscr @ scr ! lastr# @ r# ! ; + +| : associate \ switch to alternate screen + isfile' @ isfile@ isfile' ! isfile ! + scr' @ scr @ scr' ! scr ! r#' @ r# @ r#' ! r# ! ; + +| : mark isfile@ isfile' ! scr @ scr' ! r# @ r#' ! .all ; +| : n ?stamp 1 scr +! .all ; +| : b ?stamp -1 scr +! .all ; +| : a ?stamp associate .all ; + +\ *** Block No. 26, Hexblock 1a + +\ shadow screens UH 03Nov86 + +Variable shadow shadow off + +| : (shadow isfile@ IF capacity 2/ exit THEN shadow @ ; + +| : >shadow ?stamp \ switch to shadow screen + (shadow dup scr @ u> not IF negate THEN scr +! .all ; + + + + + + + + + +\ *** Block No. 27, Hexblock 1b + +\ load and show screens ks 02 mĂ€r 88 + +| : showoff ['] exit 'name ! normal ; + +| : show ( -- ) blk @ 0= IF showoff exit THEN + >in @ 1- r# ! edit-at imprint blk @ scr @ - 0=exit + blk @ scr ! normal curoff .all invers curon ; + +| : showload ( -- ) ?stamp save-buffers + ['] show 'name ! curon invers + adr .status push ['] noop is .status + scr @ scr push scr off r# push r# @ (load showoff ; + + + + + +\ *** Block No. 28, Hexblock 1c + +\ find strings ks 20 dez 87 +| Variable insert-buffer +| Variable find-buffer + +| : 'insert ( -- addr ) insert-buffer @ ; +| : 'find ( -- addr ) find-buffer @ ; + +| : .buf ( addr -- ) count type ." │" &80 col - spaces ; + +| : get ( addr -- ) >r at? r@ .buf + 2dup at r@ 1+ c/l expect span @ ?dup IF r@ c! THEN + at r> .buf ; + +| : get-buffers dy l/s + 2+ dx 1- 2dup at + ." find: │" 'find get swap 1+ swap 2- at + ." ? replace: │" 'insert get ; + +\ *** Block No. 29, Hexblock 1d + +\ ks 20 dez 87 + Code match ( addr1 len1 string -- addr2 len2 ) + D W mov W ) D- mov $FF # D and 0= ?[ D pop Next ]? + W inc D dec C pop I A mov I pop A push + W ) A- mov W inc ?capital # call A- A+ mov D C sub + >= ?[ I inc Label done I dec + A pop I push A I mov C D add Next ]? + [[ byte lods ?capital # call A+ A- cmp 0= + ?[ D D or done 0= not ?] + I push W push C push A push D C mov + [[ byte lods ?capital # call A+ A- xchg + W ) A- mov W inc ?capital # call A+ A- cmp + 0= ?[[ C0= ?] A pop C pop + W pop I pop done ]] + ]? A pop C pop W pop I pop + ]? C0= ?] I inc done ]] end-code + +\ *** Block No. 30, Hexblock 1e + +\ search for string UH 11mai88 + +| : skip ( addr -- addr' ) 'find c@ + ; + +| : search ( buf len string -- offset flag ) + >r stash r@ match r> c@ < + IF drop 0= false exit THEN swap - true ; + +| : find? ( -- r# f ) 'cursor #remaining 'find search ; + +| : searchthru ( -- r# scr ) + find? IF skip cursor + scr @ exit THEN drop + capacity scr @ 1+ + ?DO I 2 3 at 6 .r I block b/blk 'find search + IF skip I endloop exit THEN stop? Abort" Break!" + LOOP true Abort" not found!" ; + +\ *** Block No. 31, Hexblock 1f + +\ replace strings UH 14mai88 +| : replace? ( -- f ) dy l/s + 3+ dx 3 - at + key dup #cr = IF line# redisplay true Abort" Break!" THEN + capital Ascii R = ; + +| : "mark ( -- ) r# push + 'find count dup negate c edit-at invers type normal ; + +| : (replace 'insert c@ 'find c@ - ?fit + r# push 'find c@ negate c + 'cursor #after 'find c@ delete + 'insert count 'cursor #after insert modified ; + +| : "replace get-buffers BEGIN searchthru + scr @ - ?dup IF ?stamp scr +! .all THEN r# ! imprint + "mark replace? IF (replace THEN line# redisplay REPEAT ; + +\ *** Block No. 32, Hexblock 20 + +\ Display Help-Screen, misc commands jrg 24nov89 + +| : helpfile ( -- ) fromfile push editor.scr ; + +| : .help ( --) + isfile push scr push helpfile scr off .screen ; +| : help ( -- ) .help key drop .screen ; + +| : screen# ( -- scr ) scr @ ; + +| Defer (fix-word + +| : fix-word ( -- ) isfile@ loadfile ! + scr @ blk ! cursor >in ! (fix-word ; + + + +\ *** Block No. 33, Hexblock 21 + +\ Control-Characters IBM-PC Functionkeys UH 10Sep87 + +Forth definitions + +: Ctrl ( -- c ) + name 1+ c@ $1F and state @ IF [compile] Literal THEN ; +immediate + +\needs #del $7F Constant #del + +Editor definitions + +| : flipimode imode @ 0= imode ! .imode ; + +| : F ( # -- 16b ) $FFC6 swap - ; +| : shift ( n -- n' ) dup 0< + &24 - ; + +\ *** Block No. 34, Hexblock 22 + +\ Control-Characters IBM-PC Functionkeys UH 11dez88 + +Create keytable +-&72 , -&75 , -&80 , -&77 , + 3 F , 4 F , 7 F , 8 F , +Ctrl F , Ctrl S , 5 F , 6 F , + 1 F , Ctrl H , #del , -&83 , + Ctrl Y , Ctrl N , +-&82 , + #cr , #tab , #tab shift , + -&119 , -&117 , 2 F , Ctrl U , +Ctrl E , #esc , Ctrl L , 9 F shift , +-&81 , -&73 , 9 F , &10 F , +-&71 , -&79 , -&118 , -&132 , +#lf , +here keytable - 2/ Constant #keys + +\ *** Block No. 35, Hexblock 23 + +\ Try a screen Editor UH 11dez88 + +Create: actiontable +curup curleft curdown curright +line>buf char>buf buf>line buf>char +fix-word screen# copyline copychar +help backspace backspace delete-char +( insert-char ) delete-line insert-line +flipimode ( clear-line clear> ) + +tab -tab +top >""end "replace undo +update-exit flushed-exit showload >shadow +n b a mark + split join +new-screen ; +here actiontable - 2/ 1- #keys - abort( # of actions) + +\ *** Block No. 36, Hexblock 24 + +\ find keys ks 20 dez 87 + +| : findkey ( key -- adr/default ) + #keys 0 DO dup keytable [F] I 2* + @ = + IF drop [E] actiontable [F] I 2* + @ endloop exit THEN + LOOP drop ['] putchar ; + + + + + + + + + + + +\ *** Block No. 37, Hexblock 25 + +\ allocate buffers UH 01Nov86 + +c/l 2* | Constant cstack-size + +| : nextbuf ( adr -- adr' ) cstack-size + ; + +| : ?clearbuffer pad (pad @ = ?exit + pad dup (pad ! + nextbuf dup find-buffer ! 'find off + nextbuf dup insert-buffer ! 'insert off + nextbuf dup 0 chars 2! + nextbuf 0 lines 2! ; + + + + + +\ *** Block No. 38, Hexblock 26 + +\ enter and exit the editor, editor's loop UH 11mai88 + +| Variable jingle jingle on | : bell 07 charout jingle off ; + +| : clear-error ( -- ) + jingle @ ?exit dy l/s + 1+ dx at c/l spaces jingle on ; + +| : fullquit ( -- ) BEGIN ?clearbuffer edit-at key dup char c! + findkey imprint execute ( .status ) clear-error REPEAT ; + +| : fullerror ( string -- ) jingle @ IF bell THEN count + dy l/s + 1+ over 2/ dx $20 + swap - at invers type normal + &80 col - spaces remember .all quit ; + +| : install ( -- ) + ['] fullquit Is 'quit ['] fullerror errorhandler ! ; + +\ *** Block No. 39, Hexblock 27 + +\ enter and exit the Editor jrg 30mĂ€r89 + +Forth definitions + +: v ( -- ) + [E] 'start drop get-id install-screen + install ?clearbuffer + border .all .imode .status quit ; + +\ ' v Alias ed + +: l ( scr -- ) 1 arguments scr ! [E] top [F] v ; + + ' l Alias edit + + + +\ *** Block No. 40, Hexblock 28 + +\ savesystem enhanced view UH 24jun88 + +: savesystem [E] id off (pad off savesystem ; + +Editor definitions +| : >find ?clearbuffer >in push + name dup c@ 2+ >r bl over c! r> 'find place ; + +Forth definitions +: fix [ Dos ] >find ' @view >file + isfile ! scr ! [E] top curdown + find? IF skip 1- THEN c v ; + +' fix Is (fix-word + + + +\ *** Block No. 41, Hexblock 29 + +\\ Ecken und Macken jrg 18dez89 + +Das Problem fĂŒr einige GrafikKarten, keinen Cursor zu haben, +wird im CED.scr verursacht, denn SHOWCUR macht ein konstantes, +GrafikKarten-abhĂ€ngiges CURSHAPE. + +Ein zweites Problem ist das sinnlose Arbeiten des Wortes +CURSHAPE selbst: Die CursorgrĂ¶ĂŸe wird neu eingestellt, dann aber +von einem der Ausgabeworte (welchem?) gelöscht. +Verdacht: (TYPE + + + + + +