--- /dev/null
+\ tag: terminal emulation
+\
+\ this code implements IEEE 1275-1994 ANNEX B
+\
+\ Copyright (C) 2003 Stefan Reinauer
+\
+\ See the file "COPYING" for further information about
+\ the copyright and warranty status of this work.
+\
+
+0 value (escseq)
+10 buffer: (sequence)
+
+: (match-number) ( x y [1|2] [1|2] -- x [z] )
+ 2dup = if \ 1 1 | 2 2
+ drop exit
+ then
+ 2dup > if
+ 2drop drop 1 exit
+ then
+ 2drop 0
+ ;
+
+: (esc-number) ( maxchar -- ?? ?? num )
+ >r depth >r ( R: depth maxchar )
+ 0 (sequence) 2+ (escseq) 2- ( 0 seq+2 seqlen-2 )
+ \ if numerical, scan until non-numerical
+ 0 ?do
+ ( 0 seq+2 )
+ dup i + c@ a
+ digit if
+ ( 0 ptr n )
+ rot a * + ( ptr val )
+ swap
+ else
+ ( 0 ptr asc )
+ ascii ; = if
+ 0 swap
+ else
+ drop leave
+ then
+ then
+
+ loop
+ depth r> - r>
+ 0 to (escseq)
+ (match-number)
+ ;
+
+: (match-seq)
+ (escseq) 1- (sequence) + c@ \ get last character in sequence
+ \ dup draw-character
+ case
+ ascii A of \ CUU - cursor up
+ 1 (esc-number)
+ 0> if
+ 1 max
+ else
+ 1
+ then
+ negate line# +
+ 0 max to line#
+ endof
+ ascii B of \ CUD - cursor down
+ 1 (esc-number)
+ 0> if
+ 1 max
+ line# +
+ #lines 1- min to line#
+ then
+ endof
+ ascii C of \ CUF - cursor forward
+ 1 (esc-number)
+ 0> if
+ 1 max
+ column# +
+ #columns 1- min to column#
+ then
+ endof
+ ascii D of \ CUB - cursor backward
+ 1 (esc-number)
+ 0> if
+ 1 max
+ negate column# +
+ 0 max to column#
+ then
+ endof
+ ascii E of \ Cursor next line (CNL)
+ \ FIXME - check agains ANSI3.64
+ 1 (esc-number)
+ 0> if
+ 1 max
+ line# +
+ #lines 1- min to line#
+ then
+ 0 to column#
+ endof
+ ascii f of
+ 2 (esc-number)
+ case
+ 2 of
+ 1- #columns 1- min to column#
+ 1- #lines 1- min to line#
+ endof
+ 1 of
+ 0 to column#
+ 1- #lines 1- min to line#
+ endof
+ 0 of
+ 0 to column#
+ 0 to line#
+ drop
+ endof
+ endcase
+ endof
+ ascii H of
+ 2 (esc-number)
+ case
+ 2 of
+ 1- #columns 1- min to column#
+ 1- #lines 1- min to line#
+ endof
+ 1 of
+ 0 to column#
+ 1- #lines 1- min to line#
+ endof
+ 0 of
+ 0 to column#
+ 0 to line#
+ drop
+ endof
+ endcase
+ endof
+ ascii J of
+ 0 to (escseq)
+ #columns column# - delete-characters
+ #lines line# - delete-lines
+ endof
+ ascii K of
+ 0 to (escseq)
+ #columns column# - delete-characters
+ endof
+ ascii L of
+ 1 (esc-number)
+ 0> if
+ 1 max
+ insert-lines
+ then
+ endof
+ ascii M of
+ 1 (esc-number)
+ 1 = if
+ 1 max
+ delete-lines
+ then
+ endof
+ ascii @ of
+ 1 (esc-number)
+ 1 = if
+ 1 max
+ insert-characters
+ then
+ endof
+ ascii P of
+ 1 (esc-number)
+ 1 = if
+ 1 max
+ delete-characters
+ then
+ endof
+ ascii m of
+ 1 (esc-number)
+ 1 = if
+ 7 = if
+ true to inverse?
+ else
+ false to inverse?
+ then
+ then
+ endof
+ ascii p of \ normal text colors
+ 0 to (escseq)
+ inverse-screen? if
+ false to inverse-screen?
+ inverse? 0= to inverse?
+ invert-screen
+ then
+ endof
+ ascii q of \ inverse text colors
+ 0 to (escseq)
+ inverse-screen? not if
+ true to inverse-screen?
+ inverse? 0= to inverse?
+ invert-screen
+ then
+ endof
+ ascii s of
+ \ Resets the display device associated with the terminal emulator.
+ 0 to (escseq)
+ reset-screen
+ endof
+ endcase
+ ;
+
+: (term-emit) ( char -- )
+ toggle-cursor
+
+ (escseq) 0> if
+ (escseq) 10 = if
+ 0 to (escseq)
+ ." overflow in esc" cr
+ drop
+ then
+ (escseq) 1 = if
+ dup ascii [ = if \ not a [
+ (sequence) 1+ c!
+ 2 to (escseq)
+ else
+ 0 to (escseq) \ break out of ESC sequence
+ ." out of ESC" cr
+ drop \ don't print breakout character
+ then
+ toggle-cursor exit
+ else
+ (sequence) (escseq) + c!
+ (escseq) 1+ to (escseq)
+ (match-seq)
+ toggle-cursor exit
+ then
+ then
+
+ case
+ 0 of \ NULL
+ toggle-cursor exit
+ endof
+ 7 of \ BEL
+ blink-screen
+ s" /screen" s" ring-bell"
+ execute-device-method
+ endof
+ 8 of \ BS
+ column# 0<> if
+ column# 1- to column#
+ toggle-cursor exit
+ then
+ endof
+ 9 of \ TAB
+ column# dup #columns = if
+ drop
+ else
+ 8 + -8 and ff and to column#
+ then
+ toggle-cursor exit
+ endof
+ a of \ LF
+ line# 1+ to line#
+ 0 to column#
+ line# #lines >= if
+ 0 to line#
+ 1 delete-lines
+ #lines 1- to line#
+ toggle-cursor exit
+ then
+ endof
+ b of \ VT
+ line# 0<> if
+ line# 1- to line#
+ then
+ toggle-cursor exit
+ endof
+ c of \ FF
+ 0 to column# 0 to line#
+ erase-screen
+ endof
+ d of \ CR
+ 0 to column#
+ toggle-cursor exit
+ endof
+ 1b of \ ESC
+ 1b (sequence) c!
+ 1 to (escseq)
+ endof
+
+ \ draw character and advance position
+ column# #columns >= if
+ 0 to column#
+ line# 1+ to line#
+ line# #lines >= if
+ 0 to line#
+ 1 delete-lines
+ #lines 1- to line#
+ then
+ then
+
+ dup draw-character
+ column# 1+ to column#
+
+ endcase
+ toggle-cursor
+ ;
+
+['] (term-emit) to fb-emit
Code Review / kvmfornfv.git / blobdiff