142004Sabial\ Words implementing frame drawing
242004Sabial\ XXX Filled boxes are left as an exercise for the reader... ;-/
350476Speter\ $FreeBSD$
442004Sabial
542004Sabialmarker task-frames.4th
642004Sabial
742004Sabialvariable h_el
842004Sabialvariable v_el
942004Sabialvariable lt_el
1042004Sabialvariable lb_el
1142004Sabialvariable rt_el
1242004Sabialvariable rb_el
1342004Sabialvariable fill
1442004Sabial
15124676Snyans" arch-pc98" environment? [if]
16124676Snyan	\ Single frames
17124676Snyan	149 constant sh_el
18124676Snyan	150 constant sv_el
19124676Snyan	152 constant slt_el
20124676Snyan	154 constant slb_el
21124676Snyan	153 constant srt_el
22124676Snyan	155 constant srb_el
23124676Snyan	\ Double frames
24124676Snyan	149 constant dh_el
25124676Snyan	150 constant dv_el
26124676Snyan	152 constant dlt_el
27124676Snyan	154 constant dlb_el
28124676Snyan	153 constant drt_el
29124676Snyan	155 constant drb_el
30124676Snyan	\ Fillings
31124676Snyan	0 constant fill_none
32124676Snyan	32 constant fill_blank
33124676Snyan	135 constant fill_dark
34124676Snyan	135 constant fill_med
35124676Snyan	135 constant fill_bright
36124676Snyan[else]
37124676Snyan	\ Single frames
38124676Snyan	196 constant sh_el
39124676Snyan	179 constant sv_el
40124676Snyan	218 constant slt_el
41124676Snyan	192 constant slb_el
42124676Snyan	191 constant srt_el
43124676Snyan	217 constant srb_el
44124676Snyan	\ Double frames
45124676Snyan	205 constant dh_el
46124676Snyan	186 constant dv_el
47124676Snyan	201 constant dlt_el
48124676Snyan	200 constant dlb_el
49124676Snyan	187 constant drt_el
50124676Snyan	188 constant drb_el
51124676Snyan	\ Fillings
52124676Snyan	0 constant fill_none
53124676Snyan	32 constant fill_blank
54124676Snyan	176 constant fill_dark
55124676Snyan	177 constant fill_med
56124676Snyan	178 constant fill_bright
57124676Snyan[then]
5842004Sabial
5942004Sabial: hline	( len x y -- )	\ Draw horizontal single line
6042004Sabial	at-xy		\ move cursor
6142004Sabial	0 do
6242004Sabial		h_el @ emit
6342004Sabial	loop
6442004Sabial;
6542004Sabial
6642004Sabial: f_single	( -- )	\ set frames to single
6742004Sabial	sh_el h_el !
6842004Sabial	sv_el v_el !
6942004Sabial	slt_el lt_el !
7042004Sabial	slb_el lb_el !
7142004Sabial	srt_el rt_el !
7242004Sabial	srb_el rb_el !
7342004Sabial;
7442004Sabial
7542004Sabial: f_double	( -- )	\ set frames to double
7642004Sabial	dh_el h_el !
7742004Sabial	dv_el v_el !
7842004Sabial	dlt_el lt_el !
7942004Sabial	dlb_el lb_el !
8042004Sabial	drt_el rt_el !
8142004Sabial	drb_el rb_el !
8242004Sabial;
8342004Sabial
8442004Sabial: vline	( len x y -- )	\ Draw vertical single line
8542004Sabial	2dup 4 pick
8642004Sabial	0 do
8742004Sabial		at-xy
8842004Sabial		v_el @ emit
8942004Sabial		1+
9042004Sabial		2dup
9142004Sabial	loop
9242004Sabial	2drop 2drop drop
9342004Sabial;
9442004Sabial
9542004Sabial: box	( w h x y -- )	\ Draw a box
9642004Sabial	2dup 1+ 4 pick 1- -rot
9742004Sabial	vline		\ Draw left vert line
9842004Sabial	2dup 1+ swap 5 pick + swap 4 pick 1- -rot
9942004Sabial	vline		\ Draw right vert line
10042004Sabial	2dup swap 1+ swap 5 pick 1- -rot
10142004Sabial	hline		\ Draw top horiz line
10242004Sabial	2dup swap 1+ swap 4 pick + 5 pick 1- -rot
10342004Sabial	hline		\ Draw bottom horiz line
10442004Sabial	2dup at-xy lt_el @ emit	\ Draw left-top corner
10542004Sabial	2dup 4 pick + at-xy lb_el @ emit	\ Draw left bottom corner
10642004Sabial	2dup swap 5 pick + swap at-xy rt_el @ emit	\ Draw right top corner
10742004Sabial	2 pick + swap 3 pick + swap at-xy rb_el @ emit
10842004Sabial	2drop
10942004Sabial;
11042004Sabial
11142004Sabialf_single
11242004Sabialfill_none fill !
113