| Server IP : 82.208.35.60 / Your IP : 216.73.216.89 Web Server : Apache/2.4.55 (FreeBSD) OpenSSL/1.1.1q-freebsd PHP/7.3.31 System : FreeBSD server7.d2m.cz 12.4-RELEASE-p9 FreeBSD 12.4-RELEASE-p9 GENERIC amd64 User : studiokobylisy_cz ( 1008) PHP Version : 7.3.31 Disable Function : NONE MySQL : OFF | cURL : ON | WGET : OFF | Perl : OFF | Python : OFF | Sudo : OFF | Pkexec : OFF Directory : /usr/share/examples/bootforth/ |
Upload File : |
\ Words implementing frame drawing \ XXX Filled boxes are left as an exercise for the reader... ;-/ \ $FreeBSD: releng/12.4/share/examples/bootforth/frames.4th 312910 2017-01-28 02:22:15Z nyan $ marker task-frames.4th variable h_el variable v_el variable lt_el variable lb_el variable rt_el variable rb_el variable fill \ Single frames 196 constant sh_el 179 constant sv_el 218 constant slt_el 192 constant slb_el 191 constant srt_el 217 constant srb_el \ Double frames 205 constant dh_el 186 constant dv_el 201 constant dlt_el 200 constant dlb_el 187 constant drt_el 188 constant drb_el \ Fillings 0 constant fill_none 32 constant fill_blank 176 constant fill_dark 177 constant fill_med 178 constant fill_bright : hline ( len x y -- ) \ Draw horizontal single line at-xy \ move cursor 0 do h_el @ emit loop ; : f_single ( -- ) \ set frames to single sh_el h_el ! sv_el v_el ! slt_el lt_el ! slb_el lb_el ! srt_el rt_el ! srb_el rb_el ! ; : f_double ( -- ) \ set frames to double dh_el h_el ! dv_el v_el ! dlt_el lt_el ! dlb_el lb_el ! drt_el rt_el ! drb_el rb_el ! ; : vline ( len x y -- ) \ Draw vertical single line 2dup 4 pick 0 do at-xy v_el @ emit 1+ 2dup loop 2drop 2drop drop ; : box ( w h x y -- ) \ Draw a box 2dup 1+ 4 pick 1- -rot vline \ Draw left vert line 2dup 1+ swap 5 pick + swap 4 pick 1- -rot vline \ Draw right vert line 2dup swap 1+ swap 5 pick 1- -rot hline \ Draw top horiz line 2dup swap 1+ swap 4 pick + 5 pick 1- -rot hline \ Draw bottom horiz line 2dup at-xy lt_el @ emit \ Draw left-top corner 2dup 4 pick + at-xy lb_el @ emit \ Draw left bottom corner 2dup swap 5 pick + swap at-xy rt_el @ emit \ Draw right top corner 2 pick + swap 3 pick + swap at-xy rb_el @ emit 2drop ; f_single fill_none fill !