VolksForth/8080/CPM/cpmfiles/xinout.fb

\ Erweiterte I/O-Funktionen 3.80a                     UH 08Oct87                                                                Dieses File enthaelt Definitionen, die eine erweiterte Bild-    schirmdarstellung ermoeglichen:                                                                                                        -  Installation eines Terminals mit Hilfe des Wortes               "Terminal:"                                                                                                                  -  Editieren von Eingabezeilen                                                                                           In der Version 3.80a sind diese Teile aus dem Kern genommen     worden, um diesen einfacher zu gestalten.                                                                                                                                                                                                                                                                                       \ Erweiterte I/O-Funktionen 3.80a  LOAD-Screen        UH 20Nov87                                                                                                                                1 3 +thru  \ Erweiterte Ausgabe                                                                                                 4 6 +thru  \ Erweiterte Eingabe                                                                                                                                                                 ' curon Is postlude                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             \ Erweiterte Ausgabe: Terminal-Defintionen            UH 08OCt87| Variable terminal                                                                                                             : Term: ( off -- off' )   Create  dup c, 2+                          Does>  c@  terminal @ +  perform ;                                                                                         : Terminal:   Create: Does> terminal ! ;                                                                                        0  Term: curon     Term: curoff                                    Term: rvson     Term: rvsoff                                    Term: dark      Term: locate    drop                                                                                         : curleft ( -- )  at? 1- at ;                                   : currite ( -- )  at? 1+ at ;                                                                                                   Terminal: dumb    noop noop noop noop noop 2drop ;      dumb    \ Erweiterte Ausgabe:                                 UH 06Mar88                                                                &80 Constant c/row              &24 Constant c/col                                                                              | Create 'at 0 , here 0 ,  | Constant 'row   ' 'at | Alias 'col                                                                 : (at ( row col -- )   c/row 1- min swap c/col 1- min swap          2dup 'at 2! locate ;                                        : (at? ( -- row col )  'at 2@ ;                                                                                                 : (page ( -- )   0 0 'at 2!  dark ;                                                                                             : (type ( addr len -- )  dup 'col +!                                0 ?DO count (emit LOOP drop ;                                                                                               : (emit ( c -- )   1 'col +! (emit ;                            \ Erweiterte Ausgabe:                                 UH 04Mar88                                                                : (cr  ( -- )  'row @ 1+  0  'at 2!  (cr ;                      : (del ( -- )  'col @ 0> 0=exit  -1 'col +!  (del ;                                                                             ' (emit   ' display    2+ !                                     ' (cr     ' display   4 + !                                     ' (type   ' display   6 + !                                     ' (del    ' display   8 + !                                     ' (page   ' display &10 + !                                     ' (at     ' display &12 + !                                     ' (at?    ' display &14 + !                                                                                                                                                                                                                                                                                                     \ Erweiterte Eingabe                                  UH 08OCt87| Variable maxchars        | Variable oldspan   oldspan off                                                                     | : redisplay ( addr pos -- )                                        at?  2swap  under  +   span @ rot - type space at ;        | : del   ( addr pos1 -- )  dup >r   + dup 1+ swap                    span @ r> - 1-  cmove -1 span +! ;                        | : ins   ( addr pos1 -- )  dup >r   + dup  dup 1+                    span @ r> - cmove>   bl swap c!  1 span +! ;                                                                              | : (ins  ( a p1 -- a p2 )  2dup ins  2dup redisplay ;          | : (del  ( a p1 -- a p2 )  2dup del  2dup redisplay ;          | : (back ( a p1 -- a p2 )  1-  curleft  (del ;                 | : (recall ( a p1 -- a p2 ) ?dup ?exit                                  oldspan @  span !  0  2dup redisplay ;                                                                                 \ Tastenbelegung fuer Zeilen-Editor CP/M              UH 18Mar88: (decode ( addr pos1 key -- addr pos2 )                             4  case? IF dup  span @ < 0=exit  currite 1+   exit THEN      &19  case? IF dup           0=exit  curleft 1-   exit THEN      &22  case? IF dup  span @ =  ?exit  (ins         exit THEN      #bs  case? IF dup           0=exit  (back        exit THEN      #del case? IF dup           0=exit  (back        exit THEN        7  case? IF span @ 2dup < and 0=exit (del      exit THEN      $1B  case? IF (recall                            exit THEN      #cr  case? IF span @  dup  maxchars ! oldspan !                               dup  at?  rot span @ -  - at space exit THEN      dup emit >r  2dup + r> swap c!  1+  dup span @ max span ! ;                                                                  : (expect ( addr len -- )  maxchars !   span off   0                BEGIN span @ maxchars @ u< WHILE key decode REPEAT 2drop ;                                                                  \ Patch                                               UH 08Oct87                                                                : (key    ( -- char )                                               curon  BEGIN  pause (key?  UNTIL curoff getkey ;                                                                            ' (key    ' keyboard  2+ !                                      ' (decode ' keyboard 6 + !                                      ' (expect ' keyboard 8 + !