frames.4th revision 124676
142004Sabial\ Words implementing frame drawing 242004Sabial\ XXX Filled boxes are left as an exercise for the reader... ;-/ 350476Speter\ $FreeBSD: head/share/examples/bootforth/frames.4th 124676 2004-01-18 15:16:12Z nyan $ 442004Sabial 542004Sabialmarker task-frames.4th 642004Sabial 742004Sabialvariable h_el 842004Sabialvariable v_el 942004Sabialvariable lt_el 1042004Sabialvariable lb_el 1142004Sabialvariable rt_el 1242004Sabialvariable rb_el 1342004Sabialvariable fill 1442004Sabial 15124676Snyans" arch-pc98" environment? [if] 16124676Snyan \ Single frames 17124676Snyan 149 constant sh_el 18124676Snyan 150 constant sv_el 19124676Snyan 152 constant slt_el 20124676Snyan 154 constant slb_el 21124676Snyan 153 constant srt_el 22124676Snyan 155 constant srb_el 23124676Snyan \ Double frames 24124676Snyan 149 constant dh_el 25124676Snyan 150 constant dv_el 26124676Snyan 152 constant dlt_el 27124676Snyan 154 constant dlb_el 28124676Snyan 153 constant drt_el 29124676Snyan 155 constant drb_el 30124676Snyan \ Fillings 31124676Snyan 0 constant fill_none 32124676Snyan 32 constant fill_blank 33124676Snyan 135 constant fill_dark 34124676Snyan 135 constant fill_med 35124676Snyan 135 constant fill_bright 36124676Snyan[else] 37124676Snyan \ Single frames 38124676Snyan 196 constant sh_el 39124676Snyan 179 constant sv_el 40124676Snyan 218 constant slt_el 41124676Snyan 192 constant slb_el 42124676Snyan 191 constant srt_el 43124676Snyan 217 constant srb_el 44124676Snyan \ Double frames 45124676Snyan 205 constant dh_el 46124676Snyan 186 constant dv_el 47124676Snyan 201 constant dlt_el 48124676Snyan 200 constant dlb_el 49124676Snyan 187 constant drt_el 50124676Snyan 188 constant drb_el 51124676Snyan \ Fillings 52124676Snyan 0 constant fill_none 53124676Snyan 32 constant fill_blank 54124676Snyan 176 constant fill_dark 55124676Snyan 177 constant fill_med 56124676Snyan 178 constant fill_bright 57124676Snyan[then] 5842004Sabial 5942004Sabial: hline ( len x y -- ) \ Draw horizontal single line 6042004Sabial at-xy \ move cursor 6142004Sabial 0 do 6242004Sabial h_el @ emit 6342004Sabial loop 6442004Sabial; 6542004Sabial 6642004Sabial: f_single ( -- ) \ set frames to single 6742004Sabial sh_el h_el ! 6842004Sabial sv_el v_el ! 6942004Sabial slt_el lt_el ! 7042004Sabial slb_el lb_el ! 7142004Sabial srt_el rt_el ! 7242004Sabial srb_el rb_el ! 7342004Sabial; 7442004Sabial 7542004Sabial: f_double ( -- ) \ set frames to double 7642004Sabial dh_el h_el ! 7742004Sabial dv_el v_el ! 7842004Sabial dlt_el lt_el ! 7942004Sabial dlb_el lb_el ! 8042004Sabial drt_el rt_el ! 8142004Sabial drb_el rb_el ! 8242004Sabial; 8342004Sabial 8442004Sabial: vline ( len x y -- ) \ Draw vertical single line 8542004Sabial 2dup 4 pick 8642004Sabial 0 do 8742004Sabial at-xy 8842004Sabial v_el @ emit 8942004Sabial 1+ 9042004Sabial 2dup 9142004Sabial loop 9242004Sabial 2drop 2drop drop 9342004Sabial; 9442004Sabial 9542004Sabial: box ( w h x y -- ) \ Draw a box 9642004Sabial 2dup 1+ 4 pick 1- -rot 9742004Sabial vline \ Draw left vert line 9842004Sabial 2dup 1+ swap 5 pick + swap 4 pick 1- -rot 9942004Sabial vline \ Draw right vert line 10042004Sabial 2dup swap 1+ swap 5 pick 1- -rot 10142004Sabial hline \ Draw top horiz line 10242004Sabial 2dup swap 1+ swap 4 pick + 5 pick 1- -rot 10342004Sabial hline \ Draw bottom horiz line 10442004Sabial 2dup at-xy lt_el @ emit \ Draw left-top corner 10542004Sabial 2dup 4 pick + at-xy lb_el @ emit \ Draw left bottom corner 10642004Sabial 2dup swap 5 pick + swap at-xy rt_el @ emit \ Draw right top corner 10742004Sabial 2 pick + swap 3 pick + swap at-xy rb_el @ emit 10842004Sabial 2drop 10942004Sabial; 11042004Sabial 11142004Sabialf_single 11242004Sabialfill_none fill ! 113