qemu/roms/openbios/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       case
 101         2 of
 102           1- #columns 1- min to column#
 103           1- #lines 1- min to line#
 104         endof
 105         1 of
 106           0 to column#
 107           1- #lines 1- min to line#
 108         endof
 109         0 of
 110           0 to column#
 111           0 to line#
 112           drop
 113         endof
 114       endcase
 115     endof
 116     ascii H of
 117       2 (esc-number)
 118       case
 119         2 of
 120           1- #columns 1- min to column#
 121           1- #lines 1- min to line#
 122         endof
 123         1 of
 124           0 to column#
 125           1- #lines 1- min to line#
 126         endof
 127         0 of
 128           0 to column#
 129           0 to line#
 130           drop
 131         endof
 132       endcase
 133     endof
 134     ascii J of
 135       0 to (escseq)
 136       #columns column# - delete-characters
 137       #lines line# - delete-lines
 138     endof
 139     ascii K of
 140       0 to (escseq)
 141       #columns column# - delete-characters
 142     endof
 143     ascii L of
 144       1 (esc-number)
 145       0> if
 146         1 max
 147         insert-lines
 148       then
 149     endof
 150     ascii M of
 151       1 (esc-number)
 152       1 = if
 153         1 max
 154         delete-lines
 155       then
 156     endof
 157     ascii @ of
 158       1 (esc-number)
 159       1 = if
 160         1 max
 161         insert-characters
 162       then
 163     endof
 164     ascii P of
 165       1 (esc-number)
 166       1 = if
 167         1 max
 168         delete-characters
 169       then
 170     endof
 171     ascii m of
 172       1 (esc-number)
 173       1 = if
 174         7 = if
 175           true to inverse?
 176         else
 177           false to inverse?
 178         then
 179       then
 180     endof
 181     ascii p of \ normal text colors
 182       0 to (escseq)
 183       inverse-screen? if
 184         false to inverse-screen?
 185         inverse? 0= to inverse?
 186         invert-screen
 187       then
 188     endof
 189     ascii q of \ inverse text colors
 190       0 to (escseq)
 191       inverse-screen? not if
 192         true to inverse-screen?
 193         inverse? 0= to inverse?
 194         invert-screen
 195       then
 196     endof
 197     ascii s of
 198       \ Resets the display device associated with the terminal emulator.
 199       0 to (escseq)
 200       reset-screen
 201     endof
 202   endcase
 203   ;
 204
 205 : (term-emit) ( char -- )
 206   toggle-cursor
 207
 208   (escseq) 0> if
 209     (escseq) 10 = if
 210       0 to (escseq)
 211       ." overflow in esc" cr
 212       drop
 213     then
 214     (escseq) 1 = if
 215       dup ascii [ = if    \ not a [
 216         (sequence) 1+ c!
 217         2 to (escseq)
 218       else
 219         0 to (escseq)      \ break out of ESC sequence
 220         ." out of ESC" cr
 221         drop               \ don't print breakout character
 222       then
 223       toggle-cursor exit
 224     else
 225       (sequence) (escseq) + c!
 226       (escseq) 1+ to (escseq)
 227       (match-seq)
 228       toggle-cursor exit
 229     then
 230   then
 231
 232   case
 233   0 of \ NULL
 234     toggle-cursor exit
 235   endof
 236   7 of \ BEL
 237     blink-screen
 238     s" /screen" s" ring-bell"
 239     execute-device-method
 240   endof
 241   8 of \ BS
 242     column# 0<> if
 243       column# 1- to column#
 244       toggle-cursor exit
 245     then
 246   endof
 247   9 of \ TAB
 248     column# dup #columns = if
 249       drop
 250     else
 251       8 + -8 and ff and to column#
 252     then
 253     toggle-cursor exit
 254   endof
 255   a of \ LF
 256     line# 1+ to line#
 257     0 to column#
 258     line# #lines >= if
 259       0 to line#
 260       1 delete-lines
 261       #lines 1- to line#
 262       toggle-cursor exit
 263     then
 264   endof
 265   b of \ VT
 266     line# 0<> if
 267       line# 1- to line#
 268     then
 269     toggle-cursor exit
 270   endof
 271   c of \ FF
 272     0 to column# 0 to line#
 273     erase-screen
 274   endof
 275   d of \ CR
 276     0 to column#
 277     toggle-cursor exit
 278   endof
 279   1b of \ ESC
 280     1b (sequence) c!
 281     1 to (escseq)
 282   endof
 283
 284   \ draw character and advance position
 285   column# #columns >= if
 286     0 to column#
 287     line# 1+ to line#
 288     line# #lines >= if
 289       0 to line#
 290       1 delete-lines
 291       #lines 1- to line#
 292     then
 293   then
 294
 295   dup draw-character
 296   column# 1+ to column#
 297
 298   endcase
 299   toggle-cursor
 300   ;
 301
 302 ['] (term-emit) to fb-emit