frames.4th revision 124676
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 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