1\ Words implementing frame drawing
2\ XXX Filled boxes are left as an exercise for the reader... ;-/
3\ $FreeBSD: releng/10.3/share/examples/bootforth/frames.4th 124676 2004-01-18 15:16:12Z nyan $
4
5marker task-frames.4th
6
7variable h_el
8variable v_el
9variable lt_el
10variable lb_el
11variable rt_el
12variable rb_el
13variable fill
14
15s" arch-pc98" environment? [if]
16	\ Single frames
17	149 constant sh_el
18	150 constant sv_el
19	152 constant slt_el
20	154 constant slb_el
21	153 constant srt_el
22	155 constant srb_el
23	\ Double frames
24	149 constant dh_el
25	150 constant dv_el
26	152 constant dlt_el
27	154 constant dlb_el
28	153 constant drt_el
29	155 constant drb_el
30	\ Fillings
31	0 constant fill_none
32	32 constant fill_blank
33	135 constant fill_dark
34	135 constant fill_med
35	135 constant fill_bright
36[else]
37	\ Single frames
38	196 constant sh_el
39	179 constant sv_el
40	218 constant slt_el
41	192 constant slb_el
42	191 constant srt_el
43	217 constant srb_el
44	\ Double frames
45	205 constant dh_el
46	186 constant dv_el
47	201 constant dlt_el
48	200 constant dlb_el
49	187 constant drt_el
50	188 constant drb_el
51	\ Fillings
52	0 constant fill_none
53	32 constant fill_blank
54	176 constant fill_dark
55	177 constant fill_med
56	178 constant fill_bright
57[then]
58
59: hline	( len x y -- )	\ Draw horizontal single line
60	at-xy		\ move cursor
61	0 do
62		h_el @ emit
63	loop
64;
65
66: f_single	( -- )	\ set frames to single
67	sh_el h_el !
68	sv_el v_el !
69	slt_el lt_el !
70	slb_el lb_el !
71	srt_el rt_el !
72	srb_el rb_el !
73;
74
75: f_double	( -- )	\ set frames to double
76	dh_el h_el !
77	dv_el v_el !
78	dlt_el lt_el !
79	dlb_el lb_el !
80	drt_el rt_el !
81	drb_el rb_el !
82;
83
84: vline	( len x y -- )	\ Draw vertical single line
85	2dup 4 pick
86	0 do
87		at-xy
88		v_el @ emit
89		1+
90		2dup
91	loop
92	2drop 2drop drop
93;
94
95: box	( w h x y -- )	\ Draw a box
96	2dup 1+ 4 pick 1- -rot
97	vline		\ Draw left vert line
98	2dup 1+ swap 5 pick + swap 4 pick 1- -rot
99	vline		\ Draw right vert line
100	2dup swap 1+ swap 5 pick 1- -rot
101	hline		\ Draw top horiz line
102	2dup swap 1+ swap 4 pick + 5 pick 1- -rot
103	hline		\ Draw bottom horiz line
104	2dup at-xy lt_el @ emit	\ Draw left-top corner
105	2dup 4 pick + at-xy lb_el @ emit	\ Draw left bottom corner
106	2dup swap 5 pick + swap at-xy rt_el @ emit	\ Draw right top corner
107	2 pick + swap 3 pick + swap at-xy rb_el @ emit
108	2drop
109;
110
111f_single
112fill_none fill !
113