forth/device/terminal.fs

   1 \ tag: terminal emulation
   2 \
   3 \ this code implements IEEE 1275-1994 ANNEX B
   4 \
   5 \ Copyright (C) 2003 Stefan Reinauer
   6 \
   7 \ See the file "COPYING" for further information about
   8 \ the copyright and warranty status of this work.
   9 \
  10
  11 0 value (escseq)
  12 10 buffer: (sequence)
  13
  14 : (match-number) ( x y [1|2] [1|2] -- x [z] )
  15   2dup = if \ 1 1 | 2 2
  16     drop exit
  17   then
  18   2dup > if
  19     2drop drop 1 exit
  20   then
  21   2drop 0
  22   ;
  23
  24 : (esc-number) ( maxchar -- ?? ?? num )
  25   >r depth >r  ( R: depth maxchar )
  26   0 (sequence) 2+ (escseq) 2- ( 0 seq+2 seqlen-2 )
  27   \ if numerical, scan until non-numerical
  28   0 ?do
  29     ( 0 seq+2 )
  30     dup i + c@ a
  31     digit if
  32       ( 0 ptr  n )
  33       rot a * + ( ptr val )
  34       swap
  35     else
  36       ( 0 ptr asc )
  37       ascii ; = if
  38         0 swap
  39       else
  40         drop leave
  41       then
  42     then
  43
  44   loop
  45   depth r> - r>
  46   0 to (escseq)
  47   (match-number)
  48   ;
  49
  50 : (match-seq)
  51   (escseq) 1- (sequence) + c@  \ get last character in sequence
  52   \ dup draw-character
  53   case
  54     ascii A of \ CUU - cursor up
  55       1 (esc-number)
  56       0> if
  57         1 max
  58       else
  59         1
  60       then
  61       negate line# +
  62       0 max to line#
  63     endof
  64     ascii B of \ CUD - cursor down
  65       1 (esc-number)
  66       0> if
  67         1 max
  68         line# +
  69         #lines 1- min to line#
  70       then
  71     endof
  72     ascii C of \ CUF - cursor forward
  73       1 (esc-number)
  74       0> if
  75         1 max
  76         column# +
  77         #columns 1- min to column#
  78       then
  79     endof
  80     ascii D of \ CUB - cursor backward
  81       1 (esc-number)
  82       0> if
  83         1 max
  84         negate column# +
  85         0 max to column#
  86       then
  87     endof
  88     ascii E of \ Cursor next line (CNL)
  89       \ FIXME - check agains ANSI3.64
  90       1 (esc-number)
  91       0> if
  92         1 max
  93         line# +
  94         #lines 1- min to line#
  95       then
  96       0 to column#
  97     endof
  98     ascii f of
  99       2 (esc-number)
 100       2 = if
 101         #columns 1- min to column#
 102         #lines 1- min to line#
 103       then
 104     endof
 105     ascii H of
 106       2 (esc-number)
 107       2 = if
 108         #columns 1- min to column#
 109         #lines 1- min to line#
 110       then
 111     endof
 112     ascii J of
 113       0 to (escseq)
 114       #columns column# - delete-characters
 115       #lines line# - delete-lines
 116     endof
 117     ascii K of
 118       0 to (escseq)
 119       #columns column# - delete-characters
 120     endof
 121     ascii L of
 122       1 (esc-number)
 123       0> if
 124         1 max
 125         insert-lines
 126       then
 127     endof
 128     ascii M of
 129       1 (esc-number)
 130       1 = if
 131         1 max
 132         delete-lines
 133       then
 134     endof
 135     ascii @ of
 136       1 (esc-number)
 137       1 = if
 138         1 max
 139         insert-characters
 140       then
 141     endof
 142     ascii P of
 143       1 (esc-number)
 144       1 = if
 145         1 max
 146         delete-characters
 147       then
 148     endof
 149     ascii m of
 150       1 (esc-number)
 151       1 = if
 152         7 = if
 153           true to inverse?
 154         else
 155           false to inverse?
 156         then
 157       then
 158     endof
 159     ascii p of \ normal text colors
 160       0 to (escseq)
 161       inverse-screen? if
 162         false to inverse-screen?
 163         inverse? 0= to inverse?
 164         invert-screen
 165       then
 166     endof
 167     ascii q of \ inverse text colors
 168       0 to (escseq)
 169       inverse-screen? not if
 170         true to inverse-screen?
 171         inverse? 0= to inverse?
 172         invert-screen
 173       then
 174     endof
 175     ascii s of
 176       \ Resets the display device associated with the terminal emulator.
 177       0 to (escseq)
 178       reset-screen
 179     endof
 180   endcase
 181   ;
 182
 183 : (term-emit) ( char -- )
 184   toggle-cursor
 185
 186   (escseq) 0> if
 187     (escseq) 10 = if
 188       0 to (escseq)
 189       ." overflow in esc" cr
 190       drop
 191     then
 192     (escseq) 1 = if
 193       dup ascii [ = if    \ not a [
 194         (sequence) 1+ c!
 195         2 to (escseq)
 196       else
 197         0 to (escseq)      \ break out of ESC sequence
 198         ." out of ESC" cr
 199         drop               \ don't print breakout character
 200       then
 201       toggle-cursor exit
 202     else
 203       (sequence) (escseq) + c!
 204       (escseq) 1+ to (escseq)
 205       (match-seq)
 206       toggle-cursor exit
 207     then
 208   then
 209
 210   case
 211   7 of \ BEL
 212     blink-screen
 213     s" /screen" s" ring-bell"
 214     execute-device-method
 215   endof
 216   8 of \ BS
 217     column# 0<> if
 218       column# 1- dup
 219       to column#
 220       20 draw-character
 221       to column#
 222     then
 223   endof
 224   9 of \ TAB
 225     column# dup #columns = if
 226       drop
 227     else
 228       8 + -8 and ff and to column#
 229     then
 230   endof
 231   a of \ LF
 232     line# 1+ to line# 0 to column#
 233   endof
 234   b of \ VT
 235     line# 0<> if
 236       line# 1- to line#
 237     then
 238   endof
 239   c of \ FF
 240     0 to column# 0 to line#
 241     erase-screen
 242   endof
 243   d of \ CR
 244     0 to column#
 245   endof
 246   1b of \ ESC
 247     1b (sequence) c!
 248     1 to (escseq)
 249   endof
 250   dup draw-character
 251   endcase
 252   toggle-cursor
 253   ;
 254
 255 ['] (term-emit) to fb-emit