xref: /freebsd/stand/forth/frames.4th (revision 6be3386466ab79a84b48429ae66244f21526d3df)
1\ Copyright (c) 2003 Scott Long <scottl@FreeBSD.org>
2\ Copyright (c) 2012-2015 Devin Teske <dteske@FreeBSD.org>
3\ All rights reserved.
4\
5\ Redistribution and use in source and binary forms, with or without
6\ modification, are permitted provided that the following conditions
7\ are met:
8\ 1. Redistributions of source code must retain the above copyright
9\    notice, this list of conditions and the following disclaimer.
10\ 2. Redistributions in binary form must reproduce the above copyright
11\    notice, this list of conditions and the following disclaimer in the
12\    documentation and/or other materials provided with the distribution.
13\
14\ THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
15\ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
16\ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
17\ ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
18\ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
19\ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
20\ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
21\ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
22\ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
23\ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
24\ SUCH DAMAGE.
25\
26\ $FreeBSD$
27
28marker task-frames.4th
29
30vocabulary frame-drawing
31only forth also frame-drawing definitions
32
33\ XXX Filled boxes are left as an exercise for the reader... ;-/
34
35variable h_el
36variable v_el
37variable lt_el
38variable lb_el
39variable rt_el
40variable rb_el
41variable fill
42
43\ ASCII frames (used when serial console is detected)
44 45 constant ascii_dash
45 61 constant ascii_equal
46124 constant ascii_pipe
47 43 constant ascii_plus
48
49\ Single frames
500x2500 constant sh_el
510x2502 constant sv_el
520x250c constant slt_el
530x2514 constant slb_el
540x2510 constant srt_el
550x2518 constant srb_el
56\ Double frames
570x2550 constant dh_el
580x2551 constant dv_el
590x2554 constant dlt_el
600x255a constant dlb_el
610x2557 constant drt_el
620x255d constant drb_el
63\ Fillings
640 constant fill_none
6532 constant fill_blank
660x2591 constant fill_dark
670x2592 constant fill_med
680x2593 constant fill_bright
69
70only forth definitions also frame-drawing
71
72: hline	( len x y -- )	\ Draw horizontal single line
73	at-xy		\ move cursor
74	0 do
75		h_el @ xemit
76	loop
77;
78
79: f_ascii ( -- )	( -- )	\ set frames to ascii
80	ascii_dash h_el !
81	ascii_pipe v_el !
82	ascii_plus lt_el !
83	ascii_plus lb_el !
84	ascii_plus rt_el !
85	ascii_plus rb_el !
86;
87
88: f_single	( -- )	\ set frames to single
89	boot_serial? if f_ascii exit then
90	sh_el h_el !
91	sv_el v_el !
92	slt_el lt_el !
93	slb_el lb_el !
94	srt_el rt_el !
95	srb_el rb_el !
96;
97
98: f_double	( -- )	\ set frames to double
99	boot_serial? if
100		f_ascii
101		ascii_equal h_el !
102		exit
103	then
104	dh_el h_el !
105	dv_el v_el !
106	dlt_el lt_el !
107	dlb_el lb_el !
108	drt_el rt_el !
109	drb_el rb_el !
110;
111
112: vline	( len x y -- )	\ Draw vertical single line
113	2dup 4 pick
114	0 do
115		at-xy
116		v_el @ xemit
117		1+
118		2dup
119	loop
120	2drop 2drop drop
121;
122
123: box	( w h x y -- )	\ Draw a box
124	framebuffer? if
125		s" term-drawrect" sfind if
126			>R
127			rot		( w x y h )
128			over + >R	( w x y -- R: y+h )
129			swap rot	( y x w -- R: y+h )
130			over + >R	( y x -- R: y+h x+w )
131			swap R> R> R> execute
132			exit
133		else
134			drop
135		then
136	then
137	\ Non-framebuffer version
138	2dup 1+ 4 pick 1- -rot
139	vline		\ Draw left vert line
140	2dup 1+ swap 5 pick + swap 4 pick 1- -rot
141	vline		\ Draw right vert line
142	2dup swap 1+ swap 5 pick 1- -rot
143	hline		\ Draw top horiz line
144	2dup swap 1+ swap 4 pick + 5 pick 1- -rot
145	hline		\ Draw bottom horiz line
146	2dup at-xy lt_el @ xemit	\ Draw left-top corner
147	2dup 4 pick + at-xy lb_el @ xemit	\ Draw left bottom corner
148	2dup swap 5 pick + swap at-xy rt_el @ xemit	\ Draw right top corner
149	2 pick + swap 3 pick + swap at-xy rb_el @ xemit
150	2drop
151;
152
153f_single
154fill_none fill !
155
156only forth definitions
157