![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to terminal.fs CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Qemu by Fabrice Bellard] / qemu / roms / openbios / forth / device|
Return to terminal.fs CVS log | Up to [Qemu by Fabrice Bellard] / qemu / roms / openbios / forth / device |
1.1 root 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
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.