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