1199767f8SToomas Soome\ Copyright (c) 2003 Scott Long <scottl@FreeBSD.org> 2199767f8SToomas Soome\ Copyright (c) 2012-2015 Devin Teske <dteske@FreeBSD.org> 333d05bc1SAndy Fiddaman\ Copyright 2019 OmniOS Community Edition (OmniOSce) Association. 4199767f8SToomas Soome\ All rights reserved. 59890ff83SToomas Soome\ 6199767f8SToomas Soome\ Redistribution and use in source and binary forms, with or without 7199767f8SToomas Soome\ modification, are permitted provided that the following conditions 8199767f8SToomas Soome\ are met: 9199767f8SToomas Soome\ 1. Redistributions of source code must retain the above copyright 10199767f8SToomas Soome\ notice, this list of conditions and the following disclaimer. 11199767f8SToomas Soome\ 2. Redistributions in binary form must reproduce the above copyright 12199767f8SToomas Soome\ notice, this list of conditions and the following disclaimer in the 13199767f8SToomas Soome\ documentation and/or other materials provided with the distribution. 149890ff83SToomas Soome\ 15199767f8SToomas Soome\ THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND 16199767f8SToomas Soome\ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 17199767f8SToomas Soome\ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 18199767f8SToomas Soome\ ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE 19199767f8SToomas Soome\ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 20199767f8SToomas Soome\ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 21199767f8SToomas Soome\ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 22199767f8SToomas Soome\ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 23199767f8SToomas Soome\ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY 24199767f8SToomas Soome\ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 25199767f8SToomas Soome\ SUCH DAMAGE. 269890ff83SToomas Soome\ 27199767f8SToomas Soome 28199767f8SToomas Soomemarker task-frames.4th 29199767f8SToomas Soome 30199767f8SToomas Soomevocabulary frame-drawing 31199767f8SToomas Soomeonly forth also frame-drawing definitions 32199767f8SToomas Soome 33199767f8SToomas Soome\ XXX Filled boxes are left as an exercise for the reader... ;-/ 34199767f8SToomas Soome 35199767f8SToomas Soomevariable h_el 36199767f8SToomas Soomevariable v_el 37199767f8SToomas Soomevariable lt_el 38199767f8SToomas Soomevariable lb_el 39199767f8SToomas Soomevariable rt_el 40199767f8SToomas Soomevariable rb_el 41199767f8SToomas Soomevariable fill 42199767f8SToomas Soome 43199767f8SToomas Soome\ ASCII frames (used when serial console is detected) 44199767f8SToomas Soome 45 constant ascii_dash 45199767f8SToomas Soome 61 constant ascii_equal 46199767f8SToomas Soome124 constant ascii_pipe 47199767f8SToomas Soome 43 constant ascii_plus 48199767f8SToomas Soome 49d276822bSToomas Soome\ Single frames 509890ff83SToomas Soome$2500 constant sh_el 519890ff83SToomas Soome$2502 constant sv_el 529890ff83SToomas Soome$250c constant slt_el 539890ff83SToomas Soome$2514 constant slb_el 549890ff83SToomas Soome$2510 constant srt_el 559890ff83SToomas Soome$2518 constant srb_el 56d276822bSToomas Soome\ Double frames 579890ff83SToomas Soome$2550 constant dh_el 589890ff83SToomas Soome$2551 constant dv_el 599890ff83SToomas Soome$2554 constant dlt_el 609890ff83SToomas Soome$255a constant dlb_el 619890ff83SToomas Soome$2557 constant drt_el 629890ff83SToomas Soome$255d constant drb_el 63d276822bSToomas Soome\ Fillings 64d276822bSToomas Soome0 constant fill_none 65d276822bSToomas Soome32 constant fill_blank 669890ff83SToomas Soome$2591 constant fill_dark 679890ff83SToomas Soome$2592 constant fill_med 689890ff83SToomas Soome$2593 constant fill_bright 69199767f8SToomas Soome 70199767f8SToomas Soomeonly forth definitions also frame-drawing 71199767f8SToomas Soome 72199767f8SToomas Soome: hline ( len x y -- ) \ Draw horizontal single line 73199767f8SToomas Soome at-xy \ move cursor 74199767f8SToomas Soome 0 do 759890ff83SToomas Soome h_el @ xemit 76199767f8SToomas Soome loop 77199767f8SToomas Soome; 78199767f8SToomas Soome 79199767f8SToomas Soome: f_ascii ( -- ) ( -- ) \ set frames to ascii 80199767f8SToomas Soome ascii_dash h_el ! 81199767f8SToomas Soome ascii_pipe v_el ! 82199767f8SToomas Soome ascii_plus lt_el ! 83199767f8SToomas Soome ascii_plus lb_el ! 84199767f8SToomas Soome ascii_plus rt_el ! 85199767f8SToomas Soome ascii_plus rb_el ! 86199767f8SToomas Soome; 87199767f8SToomas Soome 88199767f8SToomas Soome: f_single ( -- ) \ set frames to single 89199767f8SToomas Soome boot_serial? if f_ascii exit then 90199767f8SToomas Soome sh_el h_el ! 91199767f8SToomas Soome sv_el v_el ! 92199767f8SToomas Soome slt_el lt_el ! 93199767f8SToomas Soome slb_el lb_el ! 94199767f8SToomas Soome srt_el rt_el ! 95199767f8SToomas Soome srb_el rb_el ! 96199767f8SToomas Soome; 97199767f8SToomas Soome 98199767f8SToomas Soome: f_double ( -- ) \ set frames to double 99199767f8SToomas Soome boot_serial? if 100199767f8SToomas Soome f_ascii 101199767f8SToomas Soome ascii_equal h_el ! 102199767f8SToomas Soome exit 103199767f8SToomas Soome then 104199767f8SToomas Soome dh_el h_el ! 105199767f8SToomas Soome dv_el v_el ! 106199767f8SToomas Soome dlt_el lt_el ! 107199767f8SToomas Soome dlb_el lb_el ! 108199767f8SToomas Soome drt_el rt_el ! 109199767f8SToomas Soome drb_el rb_el ! 110199767f8SToomas Soome; 111199767f8SToomas Soome 112199767f8SToomas Soome: vline ( len x y -- ) \ Draw vertical single line 113199767f8SToomas Soome 2dup 4 pick 114199767f8SToomas Soome 0 do 115199767f8SToomas Soome at-xy 1169890ff83SToomas Soome v_el @ xemit 117199767f8SToomas Soome 1+ 118199767f8SToomas Soome 2dup 119199767f8SToomas Soome loop 120199767f8SToomas Soome 2drop 2drop drop 121199767f8SToomas Soome; 122199767f8SToomas Soome 123199767f8SToomas Soome: box ( w h x y -- ) \ Draw a box 12433d05bc1SAndy Fiddaman framebuffer? if 1259890ff83SToomas Soome rot ( w x y h ) 1269890ff83SToomas Soome over + >R ( w x y -- R: y+h ) 1279890ff83SToomas Soome swap rot ( y x w -- R: y+h ) 1289890ff83SToomas Soome over + >R ( y x -- R: y+h x+w ) 1299890ff83SToomas Soome swap R> R> term-drawrect 1309890ff83SToomas Soome exit 1319890ff83SToomas Soome then 13233d05bc1SAndy Fiddaman \ Non-framebuffer version 133199767f8SToomas Soome 2dup 1+ 4 pick 1- -rot 134199767f8SToomas Soome vline \ Draw left vert line 135199767f8SToomas Soome 2dup 1+ swap 5 pick + swap 4 pick 1- -rot 136199767f8SToomas Soome vline \ Draw right vert line 137199767f8SToomas Soome 2dup swap 1+ swap 5 pick 1- -rot 138199767f8SToomas Soome hline \ Draw top horiz line 139199767f8SToomas Soome 2dup swap 1+ swap 4 pick + 5 pick 1- -rot 140199767f8SToomas Soome hline \ Draw bottom horiz line 1419890ff83SToomas Soome 2dup at-xy lt_el @ xemit \ Draw left-top corner 1429890ff83SToomas Soome 2dup 4 pick + at-xy lb_el @ xemit \ Draw left bottom corner 1439890ff83SToomas Soome 2dup swap 5 pick + swap at-xy rt_el @ xemit \ Draw right top corner 1449890ff83SToomas Soome 2 pick + swap 3 pick + swap at-xy rb_el @ xemit 145199767f8SToomas Soome 2drop 146199767f8SToomas Soome; 147199767f8SToomas Soome 148199767f8SToomas Soomef_single 149199767f8SToomas Soomefill_none fill ! 150199767f8SToomas Soome 151199767f8SToomas Soomeonly forth definitions 152