share/examples/bootforth/frames.4th

   1 \ Words implementing frame drawing
   2 \ XXX Filled boxes are left as an exercise for the reader... ;-/
   3 \ $FreeBSD: src/share/examples/bootforth/frames.4th,v 1.2 1999/08/28 00:19:09 peter Exp $
   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
  37 : hline ( len x y -- )  \ Draw horizontal single line
  38         at-xy           \ move cursor
  39         0 do
  40                 h_el @ emit
  41         loop
  42 ;
  43
  44 : f_single      ( -- )  \ set frames to single
  45         sh_el h_el !
  46         sv_el v_el !
  47         slt_el lt_el !
  48         slb_el lb_el !
  49         srt_el rt_el !
  50         srb_el rb_el !
  51 ;
  52
  53 : f_double      ( -- )  \ set frames to double
  54         dh_el h_el !
  55         dv_el v_el !
  56         dlt_el lt_el !
  57         dlb_el lb_el !
  58         drt_el rt_el !
  59         drb_el rb_el !
  60 ;
  61
  62 : vline ( len x y -- )  \ Draw vertical single line
  63         2dup 4 pick
  64         0 do
  65                 at-xy
  66                 v_el @ emit
  67                 1+
  68                 2dup
  69         loop
  70         2drop 2drop drop
  71 ;
  72
  73 : box   ( w h x y -- )  \ Draw a box
  74         2dup 1+ 4 pick 1- -rot
  75         vline           \ Draw left vert line
  76         2dup 1+ swap 5 pick + swap 4 pick 1- -rot
  77         vline           \ Draw right vert line
  78         2dup swap 1+ swap 5 pick 1- -rot
  79         hline           \ Draw top horiz line
  80         2dup swap 1+ swap 4 pick + 5 pick 1- -rot
  81         hline           \ Draw bottom horiz line
  82         2dup at-xy lt_el @ emit \ Draw left-top corner
  83         2dup 4 pick + at-xy lb_el @ emit        \ Draw left bottom corner
  84         2dup swap 5 pick + swap at-xy rt_el @ emit      \ Draw right top corner
  85         2 pick + swap 3 pick + swap at-xy rb_el @ emit
  86         2drop
  87 ;
  88
  89 f_single
  90 fill_none fill !