frames.4th revision 50476
1\ Words implementing frame drawing 2\ XXX Filled boxes are left as an exercise for the reader... ;-/ 3\ $FreeBSD: head/share/examples/bootforth/frames.4th 50476 1999-08-28 00:22:10Z peter $ 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 15\ Single frames 16196 constant sh_el 17179 constant sv_el 18218 constant slt_el 19192 constant slb_el 20191 constant srt_el 21217 constant srb_el 22\ Double frames 23205 constant dh_el 24186 constant dv_el 25201 constant dlt_el 26200 constant dlb_el 27187 constant drt_el 28188 constant drb_el 29\ Fillings 300 constant fill_none 3132 constant fill_blank 32176 constant fill_dark 33177 constant fill_med 34178 constant fill_bright 35 36 37: hline ( len x y -- ) \ Draw horizontal single line 38 at-xy \ move cursor 39 0 do 40 h_el @ emit 41 loop 42; 43 44: f_single ( -- ) \ set frames to single 45 sh_el h_el ! 46 sv_el v_el ! 47 slt_el lt_el ! 48 slb_el lb_el ! 49 srt_el rt_el ! 50 srb_el rb_el ! 51; 52 53: f_double ( -- ) \ set frames to double 54 dh_el h_el ! 55 dv_el v_el ! 56 dlt_el lt_el ! 57 dlb_el lb_el ! 58 drt_el rt_el ! 59 drb_el rb_el ! 60; 61 62: vline ( len x y -- ) \ Draw vertical single line 63 2dup 4 pick 64 0 do 65 at-xy 66 v_el @ emit 67 1+ 68 2dup 69 loop 70 2drop 2drop drop 71; 72 73: box ( w h x y -- ) \ Draw a box 74 2dup 1+ 4 pick 1- -rot 75 vline \ Draw left vert line 76 2dup 1+ swap 5 pick + swap 4 pick 1- -rot 77 vline \ Draw right vert line 78 2dup swap 1+ swap 5 pick 1- -rot 79 hline \ Draw top horiz line 80 2dup swap 1+ swap 4 pick + 5 pick 1- -rot 81 hline \ Draw bottom horiz line 82 2dup at-xy lt_el @ emit \ Draw left-top corner 83 2dup 4 pick + at-xy lb_el @ emit \ Draw left bottom corner 84 2dup swap 5 pick + swap at-xy rt_el @ emit \ Draw right top corner 85 2 pick + swap 3 pick + swap at-xy rb_el @ emit 86 2drop 87; 88 89f_single 90fill_none fill ! 91