: tab (	col -- spaces) 8 mod 8 swap - dup 0 = if drop 8	then ;

: calccol ( b g	r -- c )
2B / 24	* swap 2B / 6 *	+ swap 2B / + ;

: imgalloc ( x y -- handle )
2dup * 8 + dynal	( x y handle )
dup push dynp		( x y addr )
rot over ! 4 + ! pop ;

280 1E0	imgalloc const screen

: imgsize ( screen -- x	y )
dynp dup @ swap	4 + @ ;

: copyscreen ( srcDhand	destDhand -- )
swap dynp swap dup dynp	swap dyns cmove	;

: update ( -- )	screen dynp 8 +	vidmap ;

: point	( x y screen --	addr )
dynp dup @	( x y addr xs )
rot *		( x addr y*xs)
+ + 8 +	;

: pset ( c x y screen -- ) point c! ;

var tmp1 var tmp2
: boxf ( x1 x2 y1 y2 screen c -- )
tmp1 !
tmp2 !
for	( x1 x2	)
	2dup swap - push
	over i2	tmp2 @ point
	tmp1 @ swap pop	cfill
loop 2drop ;
rh tmp1	rh tmp2

: cls (	screen -- )
dynp dup @ swap	4 + dup	@	( x addr y )
rot * swap 4 +			( len addr )
0 rot rot swap			( c addr len)
cfill ;

: setpal ( b g r color -- ) 3C8	cprt! 3C9 cprt!	3C9 cprt! 3C9 cprt! ;

: setupal
D7
6 do
	6 do
		6 do
			dup i C	* swap i2 C * swap i3 C	* swap setpal
			1 -
		loop
	loop
loop
drop ;

setupal

D" \listF\FNT_SYSTEM" fsDloadnew const font

: scroll ( x y screen -- )
dynp dup @ swap	4 + dup	@ swap 4 + push	( x y xsize ysize  R: addr )
over * push				( x y xsize	   R: addr size	)
* + i2 + pop pop swap cmove ;

var tmp1 var tmp2 var tmp3 var tmp4 var	tmp5 var tmp6 var tmp7
: scrollf ( color x y screen --	)
dup push tmp1 !	( screen )
dup push tmp2 !	( y )
dup tmp3 !	( x )
pop pop	scroll
push
tmp1 @ dynp dup	@ tmp4 !	( xsize	)
4 + @ tmp5 !			( ysize	)
tmp2 @ dup 0 - if
	0 > if
		0 dup tmp6 ! tmp4 @ tmp5 @ tmp2	@ - dup	tmp7 !
		tmp5 @ tmp1 @ i	boxf

	else
		0 tmp4 @ 0 tmp2	@ neg dup tmp6 ! tmp1 @	i boxf
		tmp5 @ tmp7 !
	then
else
	drop
	0 tmp6 ! tmp5 @	tmp7 !
then

tmp3 @ dup 0 - if
	0 > if
		tmp4 @ dup tmp3	@ - swap tmp6 @	tmp7 @ tmp1 @ i	boxf
	else
		0 tmp3 @ neg tmp6 @ tmp7 @ tmp1	@ i boxf
	then
else
	drop
then
pop drop ;
rh tmp1	rh tmp2	rh tmp3	rh tmp4	rh tmp5	rh tmp6	rh tmp7

var curx
var cury
var curc
var curb
var emitscreen

screen emitscreen !

: at! (	x y -- ) cury !	curx ! ;
: at@ (	-- x y ) curx @	cury @ ;
: curc!	calccol	curc ! ;
: curb!	calccol	curb ! ;

: colnorm	FF FF FF curc! 0  0  0	curb! ;
: colneg	0  0  0	 curc! FF FF FF	curb! ;
: colhigh	0  FF FF curc! 0  0  0	curb! ;

colnorm

: (emit2
dup FE = if drop
	0 curx ! cury @	1+
	dup 3B > if
		0 0 8 emitscreen @ scrollf
		drop 3B
	then
	cury !
else
	dup FC - if
		dup FD - if
			curx @ 4F > if FE emit then
			8 * font dynp +
			curc @ swap curb @ swap	emitscreen @ dynp
			curx @ 8 * cury	@ 8 * charput
			curx @ 1+ curx !
		else
			drop curx @ tab	do space loop
		then
	else
		drop curx @ 1-
		dup 0 <	if drop	0 then curx !
	then
then ;

screen cls
FC emit
' (emit2 ' emit	is