stand/forth/frames.4th

   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 \ $FreeBSD$
  27
  28 marker task-frames.4th
  29
  30 vocabulary frame-drawing
  31 only forth also frame-drawing definitions
  32
  33 \ XXX Filled boxes are left as an exercise for the reader... ;-/
  34
  35 variable h_el
  36 variable v_el
  37 variable lt_el
  38 variable lb_el
  39 variable rt_el
  40 variable rb_el
  41 variable fill
  42
  43 \ ASCII frames (used when serial console is detected)
  44  45 constant ascii_dash
  45  61 constant ascii_equal
  46 124 constant ascii_pipe
  47  43 constant ascii_plus
  48
  49 \ Single frames
  50 0x2500 constant sh_el
  51 0x2502 constant sv_el
  52 0x250c constant slt_el
  53 0x2514 constant slb_el
  54 0x2510 constant srt_el
  55 0x2518 constant srb_el
  56 \ Double frames
  57 0x2550 constant dh_el
  58 0x2551 constant dv_el
  59 0x2554 constant dlt_el
  60 0x255a constant dlb_el
  61 0x2557 constant drt_el
  62 0x255d constant drb_el
  63 \ Fillings
  64 0 constant fill_none
  65 32 constant fill_blank
  66 0x2591 constant fill_dark
  67 0x2592 constant fill_med
  68 0x2593 constant fill_bright
  69
  70 only forth definitions also frame-drawing
  71
  72 : hline ( len x y -- )  \ Draw horizontal single line
  73         at-xy           \ move cursor
  74         0 do
  75                 h_el @ xemit
  76         loop
  77 ;
  78
  79 : f_ascii ( -- )        ( -- )  \ set frames to ascii
  80         ascii_dash h_el !
  81         ascii_pipe v_el !
  82         ascii_plus lt_el !
  83         ascii_plus lb_el !
  84         ascii_plus rt_el !
  85         ascii_plus rb_el !
  86 ;
  87
  88 : f_single      ( -- )  \ set frames to single
  89         boot_serial? if f_ascii exit then
  90         sh_el h_el !
  91         sv_el v_el !
  92         slt_el lt_el !
  93         slb_el lb_el !
  94         srt_el rt_el !
  95         srb_el rb_el !
  96 ;
  97
  98 : f_double      ( -- )  \ set frames to double
  99         boot_serial? if
 100                 f_ascii
 101                 ascii_equal h_el !
 102                 exit
 103         then
 104         dh_el h_el !
 105         dv_el v_el !
 106         dlt_el lt_el !
 107         dlb_el lb_el !
 108         drt_el rt_el !
 109         drb_el rb_el !
 110 ;
 111
 112 : vline ( len x y -- )  \ Draw vertical single line
 113         2dup 4 pick
 114         0 do
 115                 at-xy
 116                 v_el @ xemit
 117                 1+
 118                 2dup
 119         loop
 120         2drop 2drop drop
 121 ;
 122
 123 : box   ( w h x y -- )  \ Draw a box
 124         2dup 1+ 4 pick 1- -rot
 125         vline           \ Draw left vert line
 126         2dup 1+ swap 5 pick + swap 4 pick 1- -rot
 127         vline           \ Draw right vert line
 128         2dup swap 1+ swap 5 pick 1- -rot
 129         hline           \ Draw top horiz line
 130         2dup swap 1+ swap 4 pick + 5 pick 1- -rot
 131         hline           \ Draw bottom horiz line
 132         2dup at-xy lt_el @ xemit        \ Draw left-top corner
 133         2dup 4 pick + at-xy lb_el @ xemit       \ Draw left bottom corner
 134         2dup swap 5 pick + swap at-xy rt_el @ xemit     \ Draw right top corner
 135         2 pick + swap 3 pick + swap at-xy rb_el @ xemit
 136         2drop
 137 ;
 138
 139 f_single
 140 fill_none fill !
 141
 142 only forth definitions