VolksForth/sources/msdos/cursor/editor.fth

\ *** 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# ! ;
| : <cr>   #after c ;
| : <line ( -- )   col# negate c  'line c/l -trailing nip 0=exit
      BEGIN 'cursor c@ bl = WHILE curright REPEAT ;
| : line> ( -- )   '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#  <cr> insert-spaces  r# !
     #after insert-spaces  screenmodified ;

| : delete-characters ( n -- ) 'cursor #remaining rot delete ;

| : join ( -- ) cursor <cr>  line> col#  <line col# under -
     rot r# ! #after > Abort" next line will not fit!"
     #after +  dup delete-characters
     cursor  <cr> 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>  )
<cr>            +tab            -tab
top             >""end          "replace        undo
update-exit     flushed-exit    showload        >shadow
n               b               a               mark
<line           line>           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