1 : tab ( col -- spaces) 8 mod 8 swap - dup 0 = if drop 8 then ;
\r
3 : calccol ( b g r -- c )
\r
4 2B / 24 * swap 2B / 6 * + swap 2B / + ;
\r
6 : imgalloc ( x y -- handle )
\r
7 2dup * 8 + dynal ( x y handle )
\r
8 dup push dynp ( x y addr )
\r
9 rot over ! 4 + ! pop ;
\r
11 280 1E0 imgalloc const screen
\r
13 : imgsize ( screen -- x y )
\r
14 dynp dup @ swap 4 + @ ;
\r
16 : copyscreen ( srcDhand destDhand -- )
\r
17 swap dynp swap dup dynp swap dyns cmove ;
\r
19 : update ( -- ) screen dynp 8 + vidmap ;
\r
21 : point ( x y screen -- addr )
\r
22 dynp dup @ ( x y addr xs )
\r
23 rot * ( x addr y*xs)
\r
26 : pset ( c x y screen -- ) point c! ;
\r
29 : boxf ( x1 x2 y1 y2 screen c -- )
\r
34 over i2 tmp2 @ point
\r
35 tmp1 @ swap pop cfill
\r
40 dynp dup @ swap 4 + dup @ ( x addr y )
\r
41 rot * swap 4 + ( len addr )
\r
42 0 rot rot swap ( c addr len)
\r
45 : setpal ( b g r color -- ) 3C8 cprt! 3C9 cprt! 3C9 cprt! 3C9 cprt! ;
\r
52 dup i C * swap i2 C * swap i3 C * swap setpal
\r
61 D" \listF\FNT_SYSTEM" fsDloadnew const font
\r
63 : scroll ( x y screen -- )
\r
64 dynp dup @ swap 4 + dup @ swap 4 + push ( x y xsize ysize R: addr )
\r
65 over * push ( x y xsize R: addr size )
\r
66 * + i2 + pop pop swap cmove ;
\r
68 var tmp1 var tmp2 var tmp3 var tmp4 var tmp5 var tmp6 var tmp7
\r
69 : scrollf ( color x y screen -- )
\r
70 dup push tmp1 ! ( screen )
\r
71 dup push tmp2 ! ( y )
\r
75 tmp1 @ dynp dup @ tmp4 ! ( xsize )
\r
76 4 + @ tmp5 ! ( ysize )
\r
79 0 dup tmp6 ! tmp4 @ tmp5 @ tmp2 @ - dup tmp7 !
\r
80 tmp5 @ tmp1 @ i boxf
\r
83 0 tmp4 @ 0 tmp2 @ neg dup tmp6 ! tmp1 @ i boxf
\r
88 0 tmp6 ! tmp5 @ tmp7 !
\r
93 tmp4 @ dup tmp3 @ - swap tmp6 @ tmp7 @ tmp1 @ i boxf
\r
95 0 tmp3 @ neg tmp6 @ tmp7 @ tmp1 @ i boxf
\r
101 rh tmp1 rh tmp2 rh tmp3 rh tmp4 rh tmp5 rh tmp6 rh tmp7
\r
109 screen emitscreen !
\r
111 : at! ( x y -- ) cury ! curx ! ;
\r
112 : at@ ( -- x y ) curx @ cury @ ;
\r
113 : curc! calccol curc ! ;
\r
114 : curb! calccol curb ! ;
\r
116 : colnorm FF FF FF curc! 0 0 0 curb! ;
\r
117 : colneg 0 0 0 curc! FF FF FF curb! ;
\r
118 : colhigh 0 FF FF curc! 0 0 0 curb! ;
\r
126 0 0 8 emitscreen @ scrollf
\r
133 curx @ 4F > if FE emit then
\r
135 curc @ swap curb @ swap emitscreen @ dynp
\r
136 curx @ 8 * cury @ 8 * charput
\r
139 drop curx @ tab do space loop
\r
143 dup 0 < if drop 0 then curx !
\r