1 \ Words implementing frame drawing
2 \ XXX Filled boxes are left as an exercise for the reader... ;-/
3 \ $FreeBSD: src/sys/boot/forth/frames.4th,v 1.2 2004/01/18 04:13:27 nyan Exp $
4
5 marker task-frames.4th
6
7 variable h_el
8 variable v_el
9 variable lt_el
10 variable lb_el
11 variable rt_el
12 variable rb_el
13 variable fill
14
15 s" 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
111 f_single
112 fill_none fill !
Cache object: b76c6fd221b58398f6c56a88b4a3e230
|