[OpenSPARC-T2-SAM] / obp / obp / pkg / termemu / fwritstr.fth

\ ========== Copyright Header Begin ==========================================
\ 
\ Hypervisor Software File: fwritstr.fth
\ 
\ Copyright (c) 2006 Sun Microsystems, Inc. All Rights Reserved.
\ 
\  - Do no alter or remove copyright notices
\ 
\  - Redistribution and use of this software in source and binary forms, with 
\    or without modification, are permitted provided that the following 
\    conditions are met: 
\ 
\  - Redistribution of source code must retain the above copyright notice, 
\    this list of conditions and the following disclaimer.
\ 
\  - Redistribution in binary form must reproduce the above copyright notice,
\    this list of conditions and the following disclaimer in the
\    documentation and/or other materials provided with the distribution. 
\ 
\    Neither the name of Sun Microsystems, Inc. or the names of contributors 
\ may be used to endorse or promote products derived from this software 
\ without specific prior written permission. 
\ 
\     This software is provided "AS IS," without a warranty of any kind. 
\ ALL EXPRESS OR IMPLIED CONDITIONS, REPRESENTATIONS AND WARRANTIES, 
\ INCLUDING ANY IMPLIED WARRANTY OF MERCHANTABILITY, FITNESS FOR A 
\ PARTICULAR PURPOSE OR NON-INFRINGEMENT, ARE HEREBY EXCLUDED. SUN 
\ MICROSYSTEMS, INC. ("SUN") AND ITS LICENSORS SHALL NOT BE LIABLE FOR 
\ ANY DAMAGES SUFFERED BY LICENSEE AS A RESULT OF USING, MODIFYING OR 
\ DISTRIBUTING THIS SOFTWARE OR ITS DERIVATIVES. IN NO EVENT WILL SUN 
\ OR ITS LICENSORS BE LIABLE FOR ANY LOST REVENUE, PROFIT OR DATA, OR 
\ FOR DIRECT, INDIRECT, SPECIAL, CONSEQUENTIAL, INCIDENTAL OR PUNITIVE 
\ DAMAGES, HOWEVER CAUSED AND REGARDLESS OF THE THEORY OF LIABILITY, 
\ ARISING OUT OF THE USE OF OR INABILITY TO USE THIS SOFTWARE, EVEN IF 
\ SUN HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
\ 
\ You acknowledge that this software is not designed, licensed or
\ intended for use in the design, construction, operation or maintenance of
\ any nuclear facility. 
\ 
\ ========== Copyright Header End ============================================
id: @(#)fwritstr.fth 3.15 04/03/30
purpose: ANSI X3.64 terminal emulator (escape sequence parser)
copyright: Copyright 1990-2004 Sun Microsystems, Inc.  All Rights Reserved
copyright: Use is subject to license terms.

\ ANSI 3.64 Terminal Emulator.
decimal
headerless
\ ansi-emit is the routine which handles the current character.
\ It is deferred because the terminal emulator can be in one of several
\ states, depending on the previous characters.  For each distinct state,
\ a different routine is installed as the action performed by ansi-emit.
\ The states are:
\
\   alpha-state		This is the "normal" state.  Printable characters
\			are displayed, control characters are interpreted,
\			and the ESCAPE character switches to escape-state .
\
\   escape-state 	In this state, an ESCAPE has been seen and we
\			are expecting a "[" character to switch us to
\			escbrkt-state.  In escape-state, a few control
\			characters are recognized, and apart from that,
\			any non-"[" character switches to alpha-state .
\
\   escbrkt-state	An ESCAPE [  pair has been seen.  We collect numeric
\			arguments until an alphabetic command character
\			is received, then we execute the command and switch
\			to alpha-state .  Command characters are those
\			with ASCII codes numerically greater than or equal
\			to the ASCII code for the "@" character.
\
\   skipping-state	Entered from escbrkt-state if an invalid character
\			is received while waiting for a command character.
\			In skipping state, all non-command characters are
\			ignored, and the next command character switches
\			to alpha-state .

: ring-bell  ( -- )
   " ring-bell" stdin @  ['] $call-method catch  if
      3drop blink-screen
   then
;

\ set-line is also used by fb1-draw-logo
\ which is defined outside the termemu package
also forth definitions
: set-line  ( line -- )
   0 max  #lines    1- min  is line#    \ ['] line#    >body >user !
;
previous definitions

: set-column  ( column# -- )
   0 max  #columns  1- min  is column#  \ ['] column#  >body >user !
;
: +column  ( delta-columns -- )  column# +   set-column  ;
: +line  ( delta-lines -- )  line# +  set-line  ;

: /string  ( adr len n -- adr+n len-n )  over min  rot over + -rot -  ;

\ #newlines counts the number of newlines up to the end of the
\ string to be printed, or up to the next escape or form feed.
\ This is used to "batch" scrolls.
: #newlines  ( adr len -- adr len #newlines )
   2dup 1 -rot                          ( adr len 1 adr len )
   1 /string   bounds  ?do              ( adr len #newlines-so-far )
      i c@  bl <  if                    ( adr len #newlines-so-far )
         i c@  case
	    control J  of 1+     endof  \ Count linefeeds
	    control [  of leave  endof  \ Bail out on escapes
	    control L  of leave  endof  \ Bail out on formfeeds
         endcase
      then
   loop   ( adr len #newlines )
;

: kill-1line  ( -- )  #columns column# -  delete-characters  ;

: kill-line  ( -- )
   column#
   arginit  case
      0  of
         kill-1line
      endof
   endcase
   set-column
;

: do-newline  ( adr len -- adr len )
   line#  #lines 1-  <  if

      \ We're not at the bottom of the screen, so we don't need to scroll
      line# 1+ set-line  ( adr len )

      \ Clear next line unless we're in wrap mode
      #scroll-lines 0=  if   kill-1line   then

   else  \ We're at the bottom of the screen, so we have to scroll

      \ In wrap mode, we just go to the top of the screen
      #scroll-lines 0=  if  0 set-line  kill-1line  exit  then

      \ In single-line scroll mode, we try to optimize out multiple scrolls
\        #scroll-lines  1 =  if               ( adr len )
\           #newlines                         ( adr len #newlines )
\        else
\           #scroll-lines                     ( adr len #scroll-lines )
\        then

      #scroll-lines                        ( adr len #scroll-lines )

      #lines min                           ( adr len #lines-to-scroll )
      line#                                ( adr len #lines line# )
      0 set-line   swap dup delete-lines   ( adr len line# #lines-to-scroll )
      - 1+  set-line                       ( adr len )
   then
;

\ Moves the cursor to the position indicated by arg0 and arg1
: move-cursor  ( -- )
   next-arg 0=  if  0  else  1 arg 1-  then  0 arg 1-
   set-line set-column
;
: kill-screen  ( -- )
   line# column#       ( line# column# )
   arginit case
      0 of		
         kill-1line
         1 +line  #lines  line# -  delete-lines
      endof
   endcase
   set-column set-line
;
: form-feed  ( -- )  0 set-line 0 set-column  erase-screen  ;

\   alpha-state		This is the "normal" state.  Printable characters
\			are displayed, control characters are interpreted,
\			and the ESCAPE character switches to escape-state .
\
: alpha-emit  ( char -- )
\   pending-newline?  if
\      false to pending-newline?  0 set-column  do-newline
\   then
\   draw-character
\   column# #columns 1- u<  if  1 +column  else  true to pending-newline?  then
\   Firmworks added pending-newline? to delay moving cursor to next line.
\   This does not work for "vi", so put back moving cursor.
    draw-character
    column# #columns 1- u<  if  1 +column  else  0 set-column   do-newline then
;

: alpha-state  ( adr len char -- adr len )
   dup h# 7f and bl >=  if		\ Printable character
      alpha-emit  ( adr len )
   else					\ Control character
      false to pending-newline?
      case
         control G of  ring-bell                                endof
         control H of  -1 +column                               endof
         control I of  column# -8 and 8 +  set-column           endof
         control J of  ( adr len )  do-newline  ( adr len )     endof
         control M of  0 set-column                             endof
         control [ of  ansi-terminal?  if
			  ['] escape-state is ansi-emit
		       else
			  ascii ^ alpha-emit  ascii [ alpha-emit
		       then					endof
         h# 9b     of  ansi-terminal?  if
			  ascii [ escape-state
		       else
			  ascii ^ alpha-emit  ascii [ alpha-emit
		       then					endof
         \ ARC wants FF (^L) to be handled like linefeed
         control L of  form-feed                                endof
         \ ARC wants VT (^K) to be handled like linefeed
         control K of  -1 +line                                 endof
      endcase
   then
;
: enter-alpha-state  ( -- )  ['] alpha-state is ansi-emit  ;
: reset-modes  ( -- )
   1 is #scroll-lines
   enter-alpha-state
;
headers
also forth definitions
\ XXX we should probably do this with an escape sequence. Does ANSI define one?
: hide-text-cursor  ( -- )  false to showing-cursor?  toggle-cursor  ;
: reveal-text-cursor  ( -- )  true to showing-cursor?  toggle-cursor  ;
: reset-emulator  ( -- )  0 set-line  reset-modes  ;
previous definitions

headerless
0 value bold
: default-colors  ( -- )
   0 to bold
   0 to foreground-color
   d# 15 to background-color
   false to inverse?
;
: do-color  ( param -- )
   case
       0  of  default-colors   endof
       1  of  8  to bold       endof
       2  of  0  to bold       endof
       7  of  true  to inverse?  endof
   d# 27  of  false to inverse?  endof
   ( default )
      dup d# 30 d# 37 between  if
         dup d# 30 - bold or  to foreground-color
      else
         dup d# 40 d# 47 between  if
            dup d# 40 - bold or  to background-color
         then
      then
   endcase
;
: set-colors  ( -- )
   16-color?  if
      next-arg 1+  0  do  i arg do-color  loop
   else
      inverse-screen? next-arg arg 0<>  xor  is inverse?
   then
;
: skipping-state  ( char -- )
   ascii @  >=  if  enter-alpha-state  then
;
: arg0  ( -- n )  0 arg  ?dup  0=  if  1  then  ;
: do-command  ( char -- )
   enter-alpha-state
   0 arg  to arginit
   case
      ascii @  of  arg0 insert-characters  endof
      ascii A  of  arg0 negate  +line      endof
      ascii B  of  arg0         +line      endof
      ascii C  of  arg0         +column    endof
      ascii D  of  arg0 negate  +column    endof
      ascii E  of  line# arg0 +  set-line  0 set-column  endof
      ascii f  of  move-cursor  endof
      ascii H  of  move-cursor  endof
      ascii J  of  kill-screen  endof
      ascii K  of  kill-line    endof
      ascii L  of  arg0 insert-lines    endof
      ascii M  of  arg0 delete-lines    endof
      ascii P  of  arg0 delete-characters    endof
      ascii m  of  set-colors  endof
      ascii p  of  inverse-screen?  if
                      invert-screen
                      inverse? 0= is inverse?
                      false is inverse-screen?
		   then  endof
      ascii q  of  inverse-screen? 0=  if
	              invert-screen
                      inverse? 0= is inverse?
                      true is inverse-screen?
		   then  endof
      ascii r  of  arginit is #scroll-lines  endof
      ascii s  of  reset-modes  reset-screen  endof
         ( default )  dup ascii @  <  if  ['] skipping-state is ansi-emit  then
   endcase
;
: escbrkt-state  ( char -- )
   dup  ascii 0  ascii 9  between  if	\ Collect number
      next-arg arg  10 *  ascii 0  -  +  next-arg to arg
   else  dup  ascii ;  =  if		\ Shift arguments
      drop
      next-arg 1+ to next-arg
      0 next-arg  to arg
   else
      do-command
   then then
;
: (escape-state  ( char -- )
   0 to next-arg
   0 0  to arg
   case
      ascii [    of  ['] escbrkt-state is ansi-emit    endof
      control L  of  enter-alpha-state  form-feed      endof
      control J  of  endof
      control M  of  endof
      control [  of  endof
      control ?  of  endof
      ( default )    enter-alpha-state
   endcase
;
\ Fix the forward reference
' (escape-state is escape-state

also forth definitions
headers
: ansi-type  ( adr len -- )
\ XXX here we should test for terminal locked, and if it is already
\ locked, we are being re-entered, so we save the current state
\ and switch to alpha state.
   terminal-locked? on
   showing-cursor?  if  toggle-cursor  then         ( adr len )
   \ We save the string extent in variables so #newlines can
   \ find the current position.
   begin  dup  while       ( adr len )
      over c@  ansi-emit   ( adr len )
      1 /string            ( adr' len' )
   repeat                  ( adr 0 )
   2drop                   ( )
   showing-cursor?  if  toggle-cursor  then
\ XXX Here we should restore the previous state if necessary.
   terminal-locked? off
;

: install-terminal-emulator  ( -- )
   \ Set the terminal emulator's frame-buffer-adr
   \ to be the same as the device that opened it
   \ in the first place.
   frame-buffer-adr my-termemu package( is frame-buffer-adr )package
   reboot?  if
      \ Restore the cursor to the position that was saved before the reset
      get-reboot-info          ( bootpath,len line# column# )
      #columns min  is column# ( bootpath,len line# )
      #lines  min  is line#    ( bootpath,len )
      2drop                    (  )
   else
      erase-screen
   then

   reset-screen     \ Enables video
   #lines termemu-#lines !
   toggle-cursor
;
previous definitions

headers
: open ( -- success? )
   my-self is my-termemu
   ['] romfont is font
   reset-emulator
   font 0<>
;
: close ( -- )  ;
Commit	Line	Data
920dae64 AT	1	\ ========== Copyright Header Begin ==========================================
	2	\
	3	\ Hypervisor Software File: fwritstr.fth
	4	\
	5	\ Copyright (c) 2006 Sun Microsystems, Inc. All Rights Reserved.
	6	\
	7	\ - Do no alter or remove copyright notices
	8	\
	9	\ - Redistribution and use of this software in source and binary forms, with
	10	\ or without modification, are permitted provided that the following
	11	\ conditions are met:
	12	\
	13	\ - Redistribution of source code must retain the above copyright notice,
	14	\ this list of conditions and the following disclaimer.
	15	\
	16	\ - Redistribution in binary form must reproduce the above copyright notice,
	17	\ this list of conditions and the following disclaimer in the
	18	\ documentation and/or other materials provided with the distribution.
	19	\
	20	\ Neither the name of Sun Microsystems, Inc. or the names of contributors
	21	\ may be used to endorse or promote products derived from this software
	22	\ without specific prior written permission.
	23	\
	24	\ This software is provided "AS IS," without a warranty of any kind.
	25	\ ALL EXPRESS OR IMPLIED CONDITIONS, REPRESENTATIONS AND WARRANTIES,
	26	\ INCLUDING ANY IMPLIED WARRANTY OF MERCHANTABILITY, FITNESS FOR A
	27	\ PARTICULAR PURPOSE OR NON-INFRINGEMENT, ARE HEREBY EXCLUDED. SUN
	28	\ MICROSYSTEMS, INC. ("SUN") AND ITS LICENSORS SHALL NOT BE LIABLE FOR
	29	\ ANY DAMAGES SUFFERED BY LICENSEE AS A RESULT OF USING, MODIFYING OR
	30	\ DISTRIBUTING THIS SOFTWARE OR ITS DERIVATIVES. IN NO EVENT WILL SUN
	31	\ OR ITS LICENSORS BE LIABLE FOR ANY LOST REVENUE, PROFIT OR DATA, OR
	32	\ FOR DIRECT, INDIRECT, SPECIAL, CONSEQUENTIAL, INCIDENTAL OR PUNITIVE
	33	\ DAMAGES, HOWEVER CAUSED AND REGARDLESS OF THE THEORY OF LIABILITY,
	34	\ ARISING OUT OF THE USE OF OR INABILITY TO USE THIS SOFTWARE, EVEN IF
	35	\ SUN HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
	36	\
	37	\ You acknowledge that this software is not designed, licensed or
	38	\ intended for use in the design, construction, operation or maintenance of
	39	\ any nuclear facility.
	40	\
	41	\ ========== Copyright Header End ============================================
	42	id: @(#)fwritstr.fth 3.15 04/03/30
	43	purpose: ANSI X3.64 terminal emulator (escape sequence parser)
	44	copyright: Copyright 1990-2004 Sun Microsystems, Inc. All Rights Reserved
	45	copyright: Use is subject to license terms.
	46
	47	\ ANSI 3.64 Terminal Emulator.
	48	decimal
	49	headerless
	50	\ ansi-emit is the routine which handles the current character.
	51	\ It is deferred because the terminal emulator can be in one of several
	52	\ states, depending on the previous characters. For each distinct state,
	53	\ a different routine is installed as the action performed by ansi-emit.
	54	\ The states are:
	55	\
	56	\ alpha-state This is the "normal" state. Printable characters
	57	\ are displayed, control characters are interpreted,
	58	\ and the ESCAPE character switches to escape-state .
	59	\
	60	\ escape-state In this state, an ESCAPE has been seen and we
	61	\ are expecting a "[" character to switch us to
	62	\ escbrkt-state. In escape-state, a few control
	63	\ characters are recognized, and apart from that,
	64	\ any non-"[" character switches to alpha-state .
65	\
66	\ escbrkt-state An ESCAPE [ pair has been seen. We collect numeric
67	\ arguments until an alphabetic command character
68	\ is received, then we execute the command and switch
69	\ to alpha-state . Command characters are those
70	\ with ASCII codes numerically greater than or equal
71	\ to the ASCII code for the "@" character.
72	\
73	\ skipping-state Entered from escbrkt-state if an invalid character
74	\ is received while waiting for a command character.
75	\ In skipping state, all non-command characters are
76	\ ignored, and the next command character switches
77	\ to alpha-state .
78
79	: ring-bell ( -- )
80	" ring-bell" stdin @ ['] $call-method catch if
81	3drop blink-screen
82	then
83	;
84
85	\ set-line is also used by fb1-draw-logo
86	\ which is defined outside the termemu package
87	also forth definitions
88	: set-line ( line -- )
89	0 max #lines 1- min is line# \ ['] line# >body >user !
90	;
91	previous definitions
92
93	: set-column ( column# -- )
94	0 max #columns 1- min is column# \ ['] column# >body >user !
95	;
96	: +column ( delta-columns -- ) column# + set-column ;
97	: +line ( delta-lines -- ) line# + set-line ;
98
99	: /string ( adr len n -- adr+n len-n ) over min rot over + -rot - ;
100
101	\ #newlines counts the number of newlines up to the end of the
102	\ string to be printed, or up to the next escape or form feed.
103	\ This is used to "batch" scrolls.
104	: #newlines ( adr len -- adr len #newlines )
105	2dup 1 -rot ( adr len 1 adr len )
106	1 /string bounds ?do ( adr len #newlines-so-far )
107	i c@ bl < if ( adr len #newlines-so-far )
108	i c@ case
109	control J of 1+ endof \ Count linefeeds
110	control [ of leave endof \ Bail out on escapes
111	control L of leave endof \ Bail out on formfeeds
112	endcase
113	then
114	loop ( adr len #newlines )
115	;
116
117	: kill-1line ( -- ) #columns column# - delete-characters ;
118
119	: kill-line ( -- )
120	column#
121	arginit case
122	0 of
123	kill-1line
124	endof
125	endcase
126	set-column
127	;
128
129	: do-newline ( adr len -- adr len )
130	line# #lines 1- < if
131
132	\ We're not at the bottom of the screen, so we don't need to scroll
133	line# 1+ set-line ( adr len )
134
135	\ Clear next line unless we're in wrap mode
136	#scroll-lines 0= if kill-1line then
137
138	else \ We're at the bottom of the screen, so we have to scroll
139
140	\ In wrap mode, we just go to the top of the screen
141	#scroll-lines 0= if 0 set-line kill-1line exit then
142
143	\ In single-line scroll mode, we try to optimize out multiple scrolls
144	\ #scroll-lines 1 = if ( adr len )
145	\ #newlines ( adr len #newlines )
146	\ else
147	\ #scroll-lines ( adr len #scroll-lines )
148	\ then
149
150	#scroll-lines ( adr len #scroll-lines )
151
152	#lines min ( adr len #lines-to-scroll )
153	line# ( adr len #lines line# )
154	0 set-line swap dup delete-lines ( adr len line# #lines-to-scroll )
155	- 1+ set-line ( adr len )
156	then
157	;
158
159	\ Moves the cursor to the position indicated by arg0 and arg1
160	: move-cursor ( -- )
161	next-arg 0= if 0 else 1 arg 1- then 0 arg 1-
162	set-line set-column
163	;
164	: kill-screen ( -- )
165	line# column# ( line# column# )
166	arginit case
167	0 of
168	kill-1line
169	1 +line #lines line# - delete-lines
170	endof
171	endcase
172	set-column set-line
173	;
174	: form-feed ( -- ) 0 set-line 0 set-column erase-screen ;
175
176	\ alpha-state This is the "normal" state. Printable characters
177	\ are displayed, control characters are interpreted,
178	\ and the ESCAPE character switches to escape-state .
179	\
180	: alpha-emit ( char -- )
181	\ pending-newline? if
182	\ false to pending-newline? 0 set-column do-newline
183	\ then
184	\ draw-character
185	\ column# #columns 1- u< if 1 +column else true to pending-newline? then
186	\ Firmworks added pending-newline? to delay moving cursor to next line.
187	\ This does not work for "vi", so put back moving cursor.
188	draw-character
189	column# #columns 1- u< if 1 +column else 0 set-column do-newline then
190	;
191
192	: alpha-state ( adr len char -- adr len )
193	dup h# 7f and bl >= if \ Printable character
194	alpha-emit ( adr len )
195	else \ Control character
196	false to pending-newline?
197	case
198	control G of ring-bell endof
199	control H of -1 +column endof
200	control I of column# -8 and 8 + set-column endof
201	control J of ( adr len ) do-newline ( adr len ) endof
202	control M of 0 set-column endof
203	control [ of ansi-terminal? if
204	['] escape-state is ansi-emit
205	else
206	ascii ^ alpha-emit ascii [ alpha-emit
207	then endof
208	h# 9b of ansi-terminal? if
209	ascii [ escape-state
210	else
211	ascii ^ alpha-emit ascii [ alpha-emit
212	then endof
213	\ ARC wants FF (^L) to be handled like linefeed
214	control L of form-feed endof
215	\ ARC wants VT (^K) to be handled like linefeed
216	control K of -1 +line endof
217	endcase
218	then
219	;
220	: enter-alpha-state ( -- ) ['] alpha-state is ansi-emit ;
221	: reset-modes ( -- )
222	1 is #scroll-lines
223	enter-alpha-state
224	;
225	headers
226	also forth definitions
227	\ XXX we should probably do this with an escape sequence. Does ANSI define one?
228	: hide-text-cursor ( -- ) false to showing-cursor? toggle-cursor ;
229	: reveal-text-cursor ( -- ) true to showing-cursor? toggle-cursor ;
230	: reset-emulator ( -- ) 0 set-line reset-modes ;
231	previous definitions
232
233	headerless
234	0 value bold
235	: default-colors ( -- )
236	0 to bold
237	0 to foreground-color
238	d# 15 to background-color
239	false to inverse?
240	;
241	: do-color ( param -- )
242	case
243	0 of default-colors endof
244	1 of 8 to bold endof
245	2 of 0 to bold endof
246	7 of true to inverse? endof
247	d# 27 of false to inverse? endof
248	( default )
249	dup d# 30 d# 37 between if
250	dup d# 30 - bold or to foreground-color
251	else
252	dup d# 40 d# 47 between if
253	dup d# 40 - bold or to background-color
254	then
255	then
256	endcase
257	;
258	: set-colors ( -- )
259	16-color? if
260	next-arg 1+ 0 do i arg do-color loop
261	else
262	inverse-screen? next-arg arg 0<> xor is inverse?
263	then
264	;
265	: skipping-state ( char -- )
266	ascii @ >= if enter-alpha-state then
267	;
268	: arg0 ( -- n ) 0 arg ?dup 0= if 1 then ;
269	: do-command ( char -- )
270	enter-alpha-state
271	0 arg to arginit
272	case
273	ascii @ of arg0 insert-characters endof
274	ascii A of arg0 negate +line endof
275	ascii B of arg0 +line endof
276	ascii C of arg0 +column endof
277	ascii D of arg0 negate +column endof
278	ascii E of line# arg0 + set-line 0 set-column endof
279	ascii f of move-cursor endof
280	ascii H of move-cursor endof
281	ascii J of kill-screen endof
282	ascii K of kill-line endof
283	ascii L of arg0 insert-lines endof
284	ascii M of arg0 delete-lines endof
285	ascii P of arg0 delete-characters endof
286	ascii m of set-colors endof
287	ascii p of inverse-screen? if
288	invert-screen
289	inverse? 0= is inverse?
290	false is inverse-screen?
291	then endof
292	ascii q of inverse-screen? 0= if
293	invert-screen
294	inverse? 0= is inverse?
295	true is inverse-screen?
296	then endof
297	ascii r of arginit is #scroll-lines endof
298	ascii s of reset-modes reset-screen endof
299	( default ) dup ascii @ < if ['] skipping-state is ansi-emit then
300	endcase
301	;
302	: escbrkt-state ( char -- )
303	dup ascii 0 ascii 9 between if \ Collect number
304	next-arg arg 10 * ascii 0 - + next-arg to arg
305	else dup ascii ; = if \ Shift arguments
306	drop
307	next-arg 1+ to next-arg
308	0 next-arg to arg
309	else
310	do-command
311	then then
312	;
313	: (escape-state ( char -- )
314	0 to next-arg
315	0 0 to arg
316	case
317	ascii [ of ['] escbrkt-state is ansi-emit endof
318	control L of enter-alpha-state form-feed endof
319	control J of endof
320	control M of endof
321	control [ of endof
322	control ? of endof
323	( default ) enter-alpha-state
324	endcase
325	;
326	\ Fix the forward reference
327	' (escape-state is escape-state
328
329	also forth definitions
330	headers
331	: ansi-type ( adr len -- )
332	\ XXX here we should test for terminal locked, and if it is already
333	\ locked, we are being re-entered, so we save the current state
334	\ and switch to alpha state.
335	terminal-locked? on
336	showing-cursor? if toggle-cursor then ( adr len )
337	\ We save the string extent in variables so #newlines can
338	\ find the current position.
339	begin dup while ( adr len )
340	over c@ ansi-emit ( adr len )
341	1 /string ( adr' len' )
342	repeat ( adr 0 )
343	2drop ( )
344	showing-cursor? if toggle-cursor then
345	\ XXX Here we should restore the previous state if necessary.
346	terminal-locked? off
347	;
348
349	: install-terminal-emulator ( -- )
350	\ Set the terminal emulator's frame-buffer-adr
351	\ to be the same as the device that opened it
352	\ in the first place.
353	frame-buffer-adr my-termemu package( is frame-buffer-adr )package
354	reboot? if
355	\ Restore the cursor to the position that was saved before the reset
356	get-reboot-info ( bootpath,len line# column# )
357	#columns min is column# ( bootpath,len line# )
358	#lines min is line# ( bootpath,len )
359	2drop ( )
360	else
361	erase-screen
362	then
363
364	reset-screen \ Enables video
365	#lines termemu-#lines !
366	toggle-cursor
367	;
368	previous definitions
369
370	headers
371	: open ( -- success? )
372	my-self is my-termemu
373	['] romfont is font
374	reset-emulator
375	font 0<>
376	;
377	: close ( -- ) ;