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 s" arch-pc98" environment? [if]
  16         \ Single frames
  17         149 constant sh_el
  18         150 constant sv_el
  19         152 constant slt_el
  20         154 constant slb_el
  21         153 constant srt_el
  22         155 constant srb_el
  23         \ Double frames
  24         149 constant dh_el
  25         150 constant dv_el
  26         152 constant dlt_el
  27         154 constant dlb_el
  28         153 constant drt_el
  29         155 constant drb_el
  30         \ Fillings
  31         0 constant fill_none
  32         32 constant fill_blank
  33         135 constant fill_dark
  34         135 constant fill_med
  35         135 constant fill_bright
  36 [else]
  37         \ Single frames
  38         196 constant sh_el
  39         179 constant sv_el
  40         218 constant slt_el
  41         192 constant slb_el
  42         191 constant srt_el
  43         217 constant srb_el
  44         \ Double frames
  45         205 constant dh_el
  46         186 constant dv_el
  47         201 constant dlt_el
  48         200 constant dlb_el
  49         187 constant drt_el
  50         188 constant drb_el
  51         \ Fillings
  52         0 constant fill_none
  53         32 constant fill_blank
  54         176 constant fill_dark
  55         177 constant fill_med
  56         178 constant fill_bright
  57 [then]
  58
  59 : hline ( len x y -- )  \ Draw horizontal single line
  60         at-xy           \ move cursor
  61         0 do
  62                 h_el @ emit
  63         loop
  64 ;
  65
  66 : f_single      ( -- )  \ set frames to single
  67         sh_el h_el !
  68         sv_el v_el !
  69         slt_el lt_el !
  70         slb_el lb_el !
  71         srt_el rt_el !
  72         srb_el rb_el !
  73 ;
  74
  75 : f_double      ( -- )  \ set frames to double
  76         dh_el h_el !
  77         dv_el v_el !
  78         dlt_el lt_el !
  79         dlb_el lb_el !
  80         drt_el rt_el !
  81         drb_el rb_el !
  82 ;
  83
  84 : vline ( len x y -- )  \ Draw vertical single line
  85         2dup 4 pick
  86         0 do
  87                 at-xy
  88                 v_el @ emit
  89                 1+
  90                 2dup
  91         loop
  92         2drop 2drop drop
  93 ;
  94
  95 : box   ( w h x y -- )  \ Draw a box
  96         2dup 1+ 4 pick 1- -rot
  97         vline           \ Draw left vert line
  98         2dup 1+ swap 5 pick + swap 4 pick 1- -rot
  99         vline           \ Draw right vert line
 100         2dup swap 1+ swap 5 pick 1- -rot
 101         hline           \ Draw top horiz line
 102         2dup swap 1+ swap 4 pick + 5 pick 1- -rot
 103         hline           \ Draw bottom horiz line
 104         2dup at-xy lt_el @ emit \ Draw left-top corner
 105         2dup 4 pick + at-xy lb_el @ emit        \ Draw left bottom corner
 106         2dup swap 5 pick + swap at-xy rt_el @ emit      \ Draw right top corner
 107         2 pick + swap 3 pick + swap at-xy rb_el @ emit
 108         2drop
 109 ;
 110
 111 f_single
 112 fill_none fill !