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
  27 marker task-frames.4th
  28
  29 vocabulary frame-drawing
  30 only forth also frame-drawing definitions
  31
  32 \ XXX Filled boxes are left as an exercise for the reader... ;-/
  33
  34 variable h_el
  35 variable v_el
  36 variable lt_el
  37 variable lb_el
  38 variable rt_el
  39 variable rb_el
  40 variable fill
  41
  42 \ ASCII frames (used when serial console is detected)
  43  45 constant ascii_dash
  44  61 constant ascii_equal
  45 124 constant ascii_pipe
  46  43 constant ascii_plus
  47
  48 \ Single frames
  49 0x2500 constant sh_el
  50 0x2502 constant sv_el
  51 0x250c constant slt_el
  52 0x2514 constant slb_el
  53 0x2510 constant srt_el
  54 0x2518 constant srb_el
  55 \ Double frames
  56 0x2550 constant dh_el
  57 0x2551 constant dv_el
  58 0x2554 constant dlt_el
  59 0x255a constant dlb_el
  60 0x2557 constant drt_el
  61 0x255d constant drb_el
  62 \ Fillings
  63 0 constant fill_none
  64 32 constant fill_blank
  65 0x2591 constant fill_dark
  66 0x2592 constant fill_med
  67 0x2593 constant fill_bright
  68
  69 only 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
 152 f_single
 153 fill_none fill !
 154
 155 only forth definitions