1*7b753b61SAndrzej Bialecki\ Words implementing frame drawing
2*7b753b61SAndrzej Bialecki\ XXX Filled boxes are left as an exercise for the reader... ;-/
3*7b753b61SAndrzej Bialecki
4*7b753b61SAndrzej Bialeckimarker task-frames.4th
5*7b753b61SAndrzej Bialecki
6*7b753b61SAndrzej Bialeckivariable h_el
7*7b753b61SAndrzej Bialeckivariable v_el
8*7b753b61SAndrzej Bialeckivariable lt_el
9*7b753b61SAndrzej Bialeckivariable lb_el
10*7b753b61SAndrzej Bialeckivariable rt_el
11*7b753b61SAndrzej Bialeckivariable rb_el
12*7b753b61SAndrzej Bialeckivariable fill
13*7b753b61SAndrzej Bialecki
14*7b753b61SAndrzej Bialecki\ Single frames
15*7b753b61SAndrzej Bialecki196 constant sh_el
16*7b753b61SAndrzej Bialecki179 constant sv_el
17*7b753b61SAndrzej Bialecki218 constant slt_el
18*7b753b61SAndrzej Bialecki192 constant slb_el
19*7b753b61SAndrzej Bialecki191 constant srt_el
20*7b753b61SAndrzej Bialecki217 constant srb_el
21*7b753b61SAndrzej Bialecki\ Double frames
22*7b753b61SAndrzej Bialecki205 constant dh_el
23*7b753b61SAndrzej Bialecki186 constant dv_el
24*7b753b61SAndrzej Bialecki201 constant dlt_el
25*7b753b61SAndrzej Bialecki200 constant dlb_el
26*7b753b61SAndrzej Bialecki187 constant drt_el
27*7b753b61SAndrzej Bialecki188 constant drb_el
28*7b753b61SAndrzej Bialecki\ Fillings
29*7b753b61SAndrzej Bialecki0 constant fill_none
30*7b753b61SAndrzej Bialecki32 constant fill_blank
31*7b753b61SAndrzej Bialecki176 constant fill_dark
32*7b753b61SAndrzej Bialecki177 constant fill_med
33*7b753b61SAndrzej Bialecki178 constant fill_bright
34*7b753b61SAndrzej Bialecki
35*7b753b61SAndrzej Bialecki: hline	( len x y -- )	\ Draw horizontal single line
36*7b753b61SAndrzej Bialecki	at-xy		\ move cursor
37*7b753b61SAndrzej Bialecki	0 do
38*7b753b61SAndrzej Bialecki		h_el @ emit
39*7b753b61SAndrzej Bialecki	loop
40*7b753b61SAndrzej Bialecki;
41*7b753b61SAndrzej Bialecki
42*7b753b61SAndrzej Bialecki: f_single	( -- )	\ set frames to single
43*7b753b61SAndrzej Bialecki	sh_el h_el !
44*7b753b61SAndrzej Bialecki	sv_el v_el !
45*7b753b61SAndrzej Bialecki	slt_el lt_el !
46*7b753b61SAndrzej Bialecki	slb_el lb_el !
47*7b753b61SAndrzej Bialecki	srt_el rt_el !
48*7b753b61SAndrzej Bialecki	srb_el rb_el !
49*7b753b61SAndrzej Bialecki;
50*7b753b61SAndrzej Bialecki
51*7b753b61SAndrzej Bialecki: f_double	( -- )	\ set frames to double
52*7b753b61SAndrzej Bialecki	dh_el h_el !
53*7b753b61SAndrzej Bialecki	dv_el v_el !
54*7b753b61SAndrzej Bialecki	dlt_el lt_el !
55*7b753b61SAndrzej Bialecki	dlb_el lb_el !
56*7b753b61SAndrzej Bialecki	drt_el rt_el !
57*7b753b61SAndrzej Bialecki	drb_el rb_el !
58*7b753b61SAndrzej Bialecki;
59*7b753b61SAndrzej Bialecki
60*7b753b61SAndrzej Bialecki: vline	( len x y -- )	\ Draw vertical single line
61*7b753b61SAndrzej Bialecki	2dup 4 pick
62*7b753b61SAndrzej Bialecki	0 do
63*7b753b61SAndrzej Bialecki		at-xy
64*7b753b61SAndrzej Bialecki		v_el @ emit
65*7b753b61SAndrzej Bialecki		1+
66*7b753b61SAndrzej Bialecki		2dup
67*7b753b61SAndrzej Bialecki	loop
68*7b753b61SAndrzej Bialecki	2drop 2drop drop
69*7b753b61SAndrzej Bialecki;
70*7b753b61SAndrzej Bialecki
71*7b753b61SAndrzej Bialecki: box	( w h x y -- )	\ Draw a box
72*7b753b61SAndrzej Bialecki	2dup 1+ 4 pick 1- -rot
73*7b753b61SAndrzej Bialecki	vline		\ Draw left vert line
74*7b753b61SAndrzej Bialecki	2dup 1+ swap 5 pick + swap 4 pick 1- -rot
75*7b753b61SAndrzej Bialecki	vline		\ Draw right vert line
76*7b753b61SAndrzej Bialecki	2dup swap 1+ swap 5 pick 1- -rot
77*7b753b61SAndrzej Bialecki	hline		\ Draw top horiz line
78*7b753b61SAndrzej Bialecki	2dup swap 1+ swap 4 pick + 5 pick 1- -rot
79*7b753b61SAndrzej Bialecki	hline		\ Draw bottom horiz line
80*7b753b61SAndrzej Bialecki	2dup at-xy lt_el @ emit	\ Draw left-top corner
81*7b753b61SAndrzej Bialecki	2dup 4 pick + at-xy lb_el @ emit	\ Draw left bottom corner
82*7b753b61SAndrzej Bialecki	2dup swap 5 pick + swap at-xy rt_el @ emit	\ Draw right top corner
83*7b753b61SAndrzej Bialecki	2 pick + swap 3 pick + swap at-xy rb_el @ emit
84*7b753b61SAndrzej Bialecki	2drop
85*7b753b61SAndrzej Bialecki;
86*7b753b61SAndrzej Bialecki
87*7b753b61SAndrzej Bialeckif_single
88*7b753b61SAndrzej Bialeckifill_none fill !
89