frames.4th revision 50476
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 50476 1999-08-28 00:22:10Z peter $ 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 1542004Sabial\ Single frames 1642004Sabial196 constant sh_el 1742004Sabial179 constant sv_el 1842004Sabial218 constant slt_el 1942004Sabial192 constant slb_el 2042004Sabial191 constant srt_el 2142004Sabial217 constant srb_el 2242004Sabial\ Double frames 2342004Sabial205 constant dh_el 2442004Sabial186 constant dv_el 2542004Sabial201 constant dlt_el 2642004Sabial200 constant dlb_el 2742004Sabial187 constant drt_el 2842004Sabial188 constant drb_el 2942004Sabial\ Fillings 3042004Sabial0 constant fill_none 3142004Sabial32 constant fill_blank 3242004Sabial176 constant fill_dark 3342004Sabial177 constant fill_med 3442004Sabial178 constant fill_bright 3542004Sabial 3642004Sabial 3742004Sabial: hline ( len x y -- ) \ Draw horizontal single line 3842004Sabial at-xy \ move cursor 3942004Sabial 0 do 4042004Sabial h_el @ emit 4142004Sabial loop 4242004Sabial; 4342004Sabial 4442004Sabial: f_single ( -- ) \ set frames to single 4542004Sabial sh_el h_el ! 4642004Sabial sv_el v_el ! 4742004Sabial slt_el lt_el ! 4842004Sabial slb_el lb_el ! 4942004Sabial srt_el rt_el ! 5042004Sabial srb_el rb_el ! 5142004Sabial; 5242004Sabial 5342004Sabial: f_double ( -- ) \ set frames to double 5442004Sabial dh_el h_el ! 5542004Sabial dv_el v_el ! 5642004Sabial dlt_el lt_el ! 5742004Sabial dlb_el lb_el ! 5842004Sabial drt_el rt_el ! 5942004Sabial drb_el rb_el ! 6042004Sabial; 6142004Sabial 6242004Sabial: vline ( len x y -- ) \ Draw vertical single line 6342004Sabial 2dup 4 pick 6442004Sabial 0 do 6542004Sabial at-xy 6642004Sabial v_el @ emit 6742004Sabial 1+ 6842004Sabial 2dup 6942004Sabial loop 7042004Sabial 2drop 2drop drop 7142004Sabial; 7242004Sabial 7342004Sabial: box ( w h x y -- ) \ Draw a box 7442004Sabial 2dup 1+ 4 pick 1- -rot 7542004Sabial vline \ Draw left vert line 7642004Sabial 2dup 1+ swap 5 pick + swap 4 pick 1- -rot 7742004Sabial vline \ Draw right vert line 7842004Sabial 2dup swap 1+ swap 5 pick 1- -rot 7942004Sabial hline \ Draw top horiz line 8042004Sabial 2dup swap 1+ swap 4 pick + 5 pick 1- -rot 8142004Sabial hline \ Draw bottom horiz line 8242004Sabial 2dup at-xy lt_el @ emit \ Draw left-top corner 8342004Sabial 2dup 4 pick + at-xy lb_el @ emit \ Draw left bottom corner 8442004Sabial 2dup swap 5 pick + swap at-xy rt_el @ emit \ Draw right top corner 8542004Sabial 2 pick + swap 3 pick + swap at-xy rb_el @ emit 8642004Sabial 2drop 8742004Sabial; 8842004Sabial 8942004Sabialf_single 9042004Sabialfill_none fill ! 91