share/examples/bootforth/frames.4th

   1 \ Words implementing frame drawing
   2 \ XXX Filled boxes are left as an exercise for the reader... ;-/
   3 \ $FreeBSD$
   4
   5 marker task-frames.4th
   6
   7 variable h_el
   8 variable v_el
   9 variable lt_el
  10 variable lb_el
  11 variable rt_el
  12 variable rb_el
  13 variable fill
  14
  15 \ Single frames
  16 196 constant sh_el
  17 179 constant sv_el
  18 218 constant slt_el
  19 192 constant slb_el
  20 191 constant srt_el
  21 217 constant srb_el
  22 \ Double frames
  23 205 constant dh_el
  24 186 constant dv_el
  25 201 constant dlt_el
  26 200 constant dlb_el
  27 187 constant drt_el
  28 188 constant drb_el
  29 \ Fillings
  30 0 constant fill_none
  31 32 constant fill_blank
  32 176 constant fill_dark
  33 177 constant fill_med
  34 178 constant fill_bright
  35
  36 : hline ( len x y -- )  \ Draw horizontal single line
  37         at-xy           \ move cursor
  38         0 do
  39                 h_el @ emit
  40         loop
  41 ;
  42
  43 : f_single      ( -- )  \ set frames to single
  44         sh_el h_el !
  45         sv_el v_el !
  46         slt_el lt_el !
  47         slb_el lb_el !
  48         srt_el rt_el !
  49         srb_el rb_el !
  50 ;
  51
  52 : f_double      ( -- )  \ set frames to double
  53         dh_el h_el !
  54         dv_el v_el !
  55         dlt_el lt_el !
  56         dlb_el lb_el !
  57         drt_el rt_el !
  58         drb_el rb_el !
  59 ;
  60
  61 : vline ( len x y -- )  \ Draw vertical single line
  62         2dup 4 pick
  63         0 do
  64                 at-xy
  65                 v_el @ emit
  66                 1+
  67                 2dup
  68         loop
  69         2drop 2drop drop
  70 ;
  71
  72 : box   ( w h x y -- )  \ Draw a box
  73         2dup 1+ 4 pick 1- -rot
  74         vline           \ Draw left vert line
  75         2dup 1+ swap 5 pick + swap 4 pick 1- -rot
  76         vline           \ Draw right vert line
  77         2dup swap 1+ swap 5 pick 1- -rot
  78         hline           \ Draw top horiz line
  79         2dup swap 1+ swap 4 pick + 5 pick 1- -rot
  80         hline           \ Draw bottom horiz line
  81         2dup at-xy lt_el @ emit \ Draw left-top corner
  82         2dup 4 pick + at-xy lb_el @ emit        \ Draw left bottom corner
  83         2dup swap 5 pick + swap at-xy rt_el @ emit      \ Draw right top corner
  84         2 pick + swap 3 pick + swap at-xy rb_el @ emit
  85         2drop
  86 ;
  87
  88 f_single
  89 fill_none fill !