xref: /freebsd/stand/forth/frames.4th (revision ca987d4641cdcd7f27e153db17c5bf064934faf5)
1*ca987d46SWarner Losh\ Copyright (c) 2003 Scott Long <scottl@FreeBSD.org>
2*ca987d46SWarner Losh\ Copyright (c) 2012-2015 Devin Teske <dteske@FreeBSD.org>
3*ca987d46SWarner Losh\ All rights reserved.
4*ca987d46SWarner Losh\
5*ca987d46SWarner Losh\ Redistribution and use in source and binary forms, with or without
6*ca987d46SWarner Losh\ modification, are permitted provided that the following conditions
7*ca987d46SWarner Losh\ are met:
8*ca987d46SWarner Losh\ 1. Redistributions of source code must retain the above copyright
9*ca987d46SWarner Losh\    notice, this list of conditions and the following disclaimer.
10*ca987d46SWarner Losh\ 2. Redistributions in binary form must reproduce the above copyright
11*ca987d46SWarner Losh\    notice, this list of conditions and the following disclaimer in the
12*ca987d46SWarner Losh\    documentation and/or other materials provided with the distribution.
13*ca987d46SWarner Losh\
14*ca987d46SWarner Losh\ THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
15*ca987d46SWarner Losh\ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
16*ca987d46SWarner Losh\ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
17*ca987d46SWarner Losh\ ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
18*ca987d46SWarner Losh\ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
19*ca987d46SWarner Losh\ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
20*ca987d46SWarner Losh\ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
21*ca987d46SWarner Losh\ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
22*ca987d46SWarner Losh\ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
23*ca987d46SWarner Losh\ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
24*ca987d46SWarner Losh\ SUCH DAMAGE.
25*ca987d46SWarner Losh\
26*ca987d46SWarner Losh\ $FreeBSD$
27*ca987d46SWarner Losh
28*ca987d46SWarner Loshmarker task-frames.4th
29*ca987d46SWarner Losh
30*ca987d46SWarner Loshvocabulary frame-drawing
31*ca987d46SWarner Loshonly forth also frame-drawing definitions
32*ca987d46SWarner Losh
33*ca987d46SWarner Losh\ XXX Filled boxes are left as an exercise for the reader... ;-/
34*ca987d46SWarner Losh
35*ca987d46SWarner Loshvariable h_el
36*ca987d46SWarner Loshvariable v_el
37*ca987d46SWarner Loshvariable lt_el
38*ca987d46SWarner Loshvariable lb_el
39*ca987d46SWarner Loshvariable rt_el
40*ca987d46SWarner Loshvariable rb_el
41*ca987d46SWarner Loshvariable fill
42*ca987d46SWarner Losh
43*ca987d46SWarner Losh\ ASCII frames (used when serial console is detected)
44*ca987d46SWarner Losh 45 constant ascii_dash
45*ca987d46SWarner Losh 61 constant ascii_equal
46*ca987d46SWarner Losh124 constant ascii_pipe
47*ca987d46SWarner Losh 43 constant ascii_plus
48*ca987d46SWarner Losh
49*ca987d46SWarner Losh\ Single frames
50*ca987d46SWarner Losh196 constant sh_el
51*ca987d46SWarner Losh179 constant sv_el
52*ca987d46SWarner Losh218 constant slt_el
53*ca987d46SWarner Losh192 constant slb_el
54*ca987d46SWarner Losh191 constant srt_el
55*ca987d46SWarner Losh217 constant srb_el
56*ca987d46SWarner Losh\ Double frames
57*ca987d46SWarner Losh205 constant dh_el
58*ca987d46SWarner Losh186 constant dv_el
59*ca987d46SWarner Losh201 constant dlt_el
60*ca987d46SWarner Losh200 constant dlb_el
61*ca987d46SWarner Losh187 constant drt_el
62*ca987d46SWarner Losh188 constant drb_el
63*ca987d46SWarner Losh\ Fillings
64*ca987d46SWarner Losh0 constant fill_none
65*ca987d46SWarner Losh32 constant fill_blank
66*ca987d46SWarner Losh176 constant fill_dark
67*ca987d46SWarner Losh177 constant fill_med
68*ca987d46SWarner Losh178 constant fill_bright
69*ca987d46SWarner Losh
70*ca987d46SWarner Loshonly forth definitions also frame-drawing
71*ca987d46SWarner Losh
72*ca987d46SWarner Losh: hline	( len x y -- )	\ Draw horizontal single line
73*ca987d46SWarner Losh	at-xy		\ move cursor
74*ca987d46SWarner Losh	0 do
75*ca987d46SWarner Losh		h_el @ emit
76*ca987d46SWarner Losh	loop
77*ca987d46SWarner Losh;
78*ca987d46SWarner Losh
79*ca987d46SWarner Losh: f_ascii ( -- )	( -- )	\ set frames to ascii
80*ca987d46SWarner Losh	ascii_dash h_el !
81*ca987d46SWarner Losh	ascii_pipe v_el !
82*ca987d46SWarner Losh	ascii_plus lt_el !
83*ca987d46SWarner Losh	ascii_plus lb_el !
84*ca987d46SWarner Losh	ascii_plus rt_el !
85*ca987d46SWarner Losh	ascii_plus rb_el !
86*ca987d46SWarner Losh;
87*ca987d46SWarner Losh
88*ca987d46SWarner Losh: f_single	( -- )	\ set frames to single
89*ca987d46SWarner Losh	boot_serial? if f_ascii exit then
90*ca987d46SWarner Losh	sh_el h_el !
91*ca987d46SWarner Losh	sv_el v_el !
92*ca987d46SWarner Losh	slt_el lt_el !
93*ca987d46SWarner Losh	slb_el lb_el !
94*ca987d46SWarner Losh	srt_el rt_el !
95*ca987d46SWarner Losh	srb_el rb_el !
96*ca987d46SWarner Losh;
97*ca987d46SWarner Losh
98*ca987d46SWarner Losh: f_double	( -- )	\ set frames to double
99*ca987d46SWarner Losh	boot_serial? if
100*ca987d46SWarner Losh		f_ascii
101*ca987d46SWarner Losh		ascii_equal h_el !
102*ca987d46SWarner Losh		exit
103*ca987d46SWarner Losh	then
104*ca987d46SWarner Losh	dh_el h_el !
105*ca987d46SWarner Losh	dv_el v_el !
106*ca987d46SWarner Losh	dlt_el lt_el !
107*ca987d46SWarner Losh	dlb_el lb_el !
108*ca987d46SWarner Losh	drt_el rt_el !
109*ca987d46SWarner Losh	drb_el rb_el !
110*ca987d46SWarner Losh;
111*ca987d46SWarner Losh
112*ca987d46SWarner Losh: vline	( len x y -- )	\ Draw vertical single line
113*ca987d46SWarner Losh	2dup 4 pick
114*ca987d46SWarner Losh	0 do
115*ca987d46SWarner Losh		at-xy
116*ca987d46SWarner Losh		v_el @ emit
117*ca987d46SWarner Losh		1+
118*ca987d46SWarner Losh		2dup
119*ca987d46SWarner Losh	loop
120*ca987d46SWarner Losh	2drop 2drop drop
121*ca987d46SWarner Losh;
122*ca987d46SWarner Losh
123*ca987d46SWarner Losh: box	( w h x y -- )	\ Draw a box
124*ca987d46SWarner Losh	2dup 1+ 4 pick 1- -rot
125*ca987d46SWarner Losh	vline		\ Draw left vert line
126*ca987d46SWarner Losh	2dup 1+ swap 5 pick + swap 4 pick 1- -rot
127*ca987d46SWarner Losh	vline		\ Draw right vert line
128*ca987d46SWarner Losh	2dup swap 1+ swap 5 pick 1- -rot
129*ca987d46SWarner Losh	hline		\ Draw top horiz line
130*ca987d46SWarner Losh	2dup swap 1+ swap 4 pick + 5 pick 1- -rot
131*ca987d46SWarner Losh	hline		\ Draw bottom horiz line
132*ca987d46SWarner Losh	2dup at-xy lt_el @ emit	\ Draw left-top corner
133*ca987d46SWarner Losh	2dup 4 pick + at-xy lb_el @ emit	\ Draw left bottom corner
134*ca987d46SWarner Losh	2dup swap 5 pick + swap at-xy rt_el @ emit	\ Draw right top corner
135*ca987d46SWarner Losh	2 pick + swap 3 pick + swap at-xy rb_el @ emit
136*ca987d46SWarner Losh	2drop
137*ca987d46SWarner Losh;
138*ca987d46SWarner Losh
139*ca987d46SWarner Loshf_single
140*ca987d46SWarner Loshfill_none fill !
141*ca987d46SWarner Losh
142*ca987d46SWarner Loshonly forth definitions
143