Add a cvsup example to track the 1.4 release.
[dragonfly.git] / share / examples / bootforth / frames.4th
1 \ Words implementing frame drawing
2 \ XXX Filled boxes are left as an exercise for the reader... ;-/
3 \ $FreeBSD: src/share/examples/bootforth/frames.4th,v 1.2 1999/08/28 00:19:09 peter Exp $
4 \ $DragonFly: src/share/examples/bootforth/frames.4th,v 1.2 2003/06/17 04:36:57 dillon Exp $
5
6 marker task-frames.4th
7
8 variable h_el
9 variable v_el
10 variable lt_el
11 variable lb_el
12 variable rt_el
13 variable rb_el
14 variable fill
15
16 \ Single frames
17 196 constant sh_el
18 179 constant sv_el
19 218 constant slt_el
20 192 constant slb_el
21 191 constant srt_el
22 217 constant srb_el
23 \ Double frames
24 205 constant dh_el
25 186 constant dv_el
26 201 constant dlt_el
27 200 constant dlb_el
28 187 constant drt_el
29 188 constant drb_el
30 \ Fillings
31 0 constant fill_none
32 32 constant fill_blank
33 176 constant fill_dark
34 177 constant fill_med
35 178 constant fill_bright
36
37
38 : hline ( len x y -- )  \ Draw horizontal single line
39         at-xy           \ move cursor
40         0 do
41                 h_el @ emit
42         loop
43 ;
44
45 : f_single      ( -- )  \ set frames to single
46         sh_el h_el !
47         sv_el v_el !
48         slt_el lt_el !
49         slb_el lb_el !
50         srt_el rt_el !
51         srb_el rb_el !
52 ;
53
54 : f_double      ( -- )  \ set frames to double
55         dh_el h_el !
56         dv_el v_el !
57         dlt_el lt_el !
58         dlb_el lb_el !
59         drt_el rt_el !
60         drb_el rb_el !
61 ;
62
63 : vline ( len x y -- )  \ Draw vertical single line
64         2dup 4 pick
65         0 do
66                 at-xy
67                 v_el @ emit
68                 1+
69                 2dup
70         loop
71         2drop 2drop drop
72 ;
73
74 : box   ( w h x y -- )  \ Draw a box
75         2dup 1+ 4 pick 1- -rot
76         vline           \ Draw left vert line
77         2dup 1+ swap 5 pick + swap 4 pick 1- -rot
78         vline           \ Draw right vert line
79         2dup swap 1+ swap 5 pick 1- -rot
80         hline           \ Draw top horiz line
81         2dup swap 1+ swap 4 pick + 5 pick 1- -rot
82         hline           \ Draw bottom horiz line
83         2dup at-xy lt_el @ emit \ Draw left-top corner
84         2dup 4 pick + at-xy lb_el @ emit        \ Draw left bottom corner
85         2dup swap 5 pick + swap at-xy rt_el @ emit      \ Draw right top corner
86         2 pick + swap 3 pick + swap at-xy rb_el @ emit
87         2drop
88 ;
89
90 f_single
91 fill_none fill !