1\ Copyright (c) 2003 Scott Long <scottl@FreeBSD.org> 2\ Copyright (c) 2012-2015 Devin Teske <dteske@FreeBSD.org> 3\ All rights reserved. 4\ 5\ Redistribution and use in source and binary forms, with or without 6\ modification, are permitted provided that the following conditions 7\ are met: 8\ 1. Redistributions of source code must retain the above copyright 9\ notice, this list of conditions and the following disclaimer. 10\ 2. Redistributions in binary form must reproduce the above copyright 11\ notice, this list of conditions and the following disclaimer in the 12\ documentation and/or other materials provided with the distribution. 13\ 14\ THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND 15\ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 16\ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 17\ ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE 18\ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 19\ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 20\ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 21\ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 22\ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY 23\ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 24\ SUCH DAMAGE. 25\ 26 27marker task-frames.4th 28 29vocabulary frame-drawing 30only forth also frame-drawing definitions 31 32\ XXX Filled boxes are left as an exercise for the reader... ;-/ 33 34variable h_el 35variable v_el 36variable lt_el 37variable lb_el 38variable rt_el 39variable rb_el 40variable fill 41 42\ ASCII frames (used when serial console is detected) 43 45 constant ascii_dash 44 61 constant ascii_equal 45124 constant ascii_pipe 46 43 constant ascii_plus 47 48\ Single frames 490x2500 constant sh_el 500x2502 constant sv_el 510x250c constant slt_el 520x2514 constant slb_el 530x2510 constant srt_el 540x2518 constant srb_el 55\ Double frames 560x2550 constant dh_el 570x2551 constant dv_el 580x2554 constant dlt_el 590x255a constant dlb_el 600x2557 constant drt_el 610x255d constant drb_el 62\ Fillings 630 constant fill_none 6432 constant fill_blank 650x2591 constant fill_dark 660x2592 constant fill_med 670x2593 constant fill_bright 68 69only forth definitions also frame-drawing 70 71: hline ( len x y -- ) \ Draw horizontal single line 72 at-xy \ move cursor 73 0 do 74 h_el @ xemit 75 loop 76; 77 78: f_ascii ( -- ) ( -- ) \ set frames to ascii 79 ascii_dash h_el ! 80 ascii_pipe v_el ! 81 ascii_plus lt_el ! 82 ascii_plus lb_el ! 83 ascii_plus rt_el ! 84 ascii_plus rb_el ! 85; 86 87: f_single ( -- ) \ set frames to single 88 boot_serial? if f_ascii exit then 89 sh_el h_el ! 90 sv_el v_el ! 91 slt_el lt_el ! 92 slb_el lb_el ! 93 srt_el rt_el ! 94 srb_el rb_el ! 95; 96 97: f_double ( -- ) \ set frames to double 98 boot_serial? if 99 f_ascii 100 ascii_equal h_el ! 101 exit 102 then 103 dh_el h_el ! 104 dv_el v_el ! 105 dlt_el lt_el ! 106 dlb_el lb_el ! 107 drt_el rt_el ! 108 drb_el rb_el ! 109; 110 111: vline ( len x y -- ) \ Draw vertical single line 112 2dup 4 pick 113 0 do 114 at-xy 115 v_el @ xemit 116 1+ 117 2dup 118 loop 119 2drop 2drop drop 120; 121 122: box ( w h x y -- ) \ Draw a box 123 framebuffer? if 124 s" term-drawrect" sfind if 125 >R 126 rot ( w x y h ) 127 over + >R ( w x y -- R: y+h ) 128 swap rot ( y x w -- R: y+h ) 129 over + >R ( y x -- R: y+h x+w ) 130 swap R> R> R> execute 131 exit 132 else 133 drop 134 then 135 then 136 \ Non-framebuffer version 137 2dup 1+ 4 pick 1- -rot 138 vline \ Draw left vert line 139 2dup 1+ swap 5 pick + swap 4 pick 1- -rot 140 vline \ Draw right vert line 141 2dup swap 1+ swap 5 pick 1- -rot 142 hline \ Draw top horiz line 143 2dup swap 1+ swap 4 pick + 5 pick 1- -rot 144 hline \ Draw bottom horiz line 145 2dup at-xy lt_el @ xemit \ Draw left-top corner 146 2dup 4 pick + at-xy lb_el @ xemit \ Draw left bottom corner 147 2dup swap 5 pick + swap at-xy rt_el @ xemit \ Draw right top corner 148 2 pick + swap 3 pick + swap at-xy rb_el @ xemit 149 2drop 150; 151 152f_single 153fill_none fill ! 154 155only forth definitions 156