1 \ *****************************************************************************
2 \ * Copyright (c) 2004, 2008 IBM Corporation
3 \ * All rights reserved.
4 \ * This program and the accompanying materials
5 \ * are made available under the terms of the BSD License
6 \ * which accompanies this distribution, and is available at
7 \ * http://www.opensource.org/licenses/bsd-license.php
10 \ * IBM Corporation - initial implementation
11 \ ****************************************************************************/
13 #include "terminal.fs"
16 \ \\\\\\\\\\\\\\ Global Data
18 0 VALUE frame-buffer-adr
22 0 VALUE screen-line-bytes
28 : screen-#rows ( -- rows )
30 screen-height char-height /
38 : screen-#columns ( -- columns )
40 screen-width char-width /
43 s" screen-#columns" eval
48 \ \\\\\\\\\\\\\\ Structure/Implementation Dependent Methods
51 \ \\\\\\\\\\\\\\ Implementation Independent Methods (Depend on Previous)
55 : fb8-background inverse? ;
56 : fb8-foreground inverse? invert ;
58 : fb8-lines2bytes ( #lines -- #bytes ) char-height * screen-line-bytes * ;
59 : fb8-columns2bytes ( #columns -- #bytes ) char-width * screen-depth * ;
60 : fb8-line2addr ( line# -- addr )
61 char-height * window-top + screen-line-bytes *
62 frame-buffer-adr + window-left screen-depth * +
65 : fb8-erase-block ( addr len ) fb8-background rfill ;
69 CREATE bitmap-buffer 400 4 * allot
71 : active-bits ( -- new ) .ab dup 8 > IF 8 - to .ab 8 ELSE
72 char-width to .ab ?dup 0= IF recurse THEN
75 : fb8-char2bitmap ( font-height font-addr -- bitmap-buffer )
77 char-height rot 0> IF r> char-width 2dup fb8-erase-block + >r 1- THEN
79 r> -rot char-width to .ab
80 ( fb-addr font-addr font-height )
81 fontbytes * bounds ?DO
82 i c@ active-bits 0 ?DO
83 dup 80 and IF fb8-foreground ELSE fb8-background THEN
84 ( fb-addr fbyte colr ) 2 pick ! 1 lshift
85 swap screen-depth + swap
91 \ \\\\\\\\\\\\\\ Exported Interface:
93 \ * IEEE 1275: Frame buffer support routines
96 : fb8-draw-logo ( line# addr width height -- ) ." fb8-draw-logo ( " .s ." )" cr
100 : fb8-toggle-cursor ( -- )
101 line# fb8-line2addr column# fb8-columns2bytes +
102 char-height 2 - screen-line-bytes * +
104 dup char-width screen-depth * invert-region
109 : fb8-draw-character ( char -- )
110 >r default-font over + r@ -rot between IF
111 2swap 3drop r> >font fb8-char2bitmap ( bitmap-buf )
112 line# fb8-line2addr column# fb8-columns2bytes + ( bitmap-buf fb-addr )
114 2dup char-width screen-depth * mrmove
115 screen-line-bytes + >r char-width screen-depth * + r>
117 ELSE 2drop r> 3drop THEN
120 : fb8-insert-lines ( n -- )
121 fb8-lines2bytes >r line# fb8-line2addr dup dup r@ +
122 #lines line# - fb8-lines2bytes r@ - rmove
126 : fb8-delete-lines ( n -- )
127 fb8-lines2bytes >r line# fb8-line2addr dup dup r@ + swap
128 #lines fb8-lines2bytes r@ - dup >r rmove
129 r> + r> fb8-erase-block
132 : fb8-insert-characters ( n -- )
133 line# fb8-line2addr column# fb8-columns2bytes + >r
134 #columns column# - 2dup >= IF
135 nip dup 0> IF fb8-columns2bytes r> ELSE r> 2drop EXIT THEN
137 fb8-columns2bytes swap fb8-columns2bytes tuck -
138 over r@ tuck + rot char-height 0 ?DO
140 -rot screen-line-bytes tuck + -rot + swap rot
145 dup 2 pick fb8-erase-block screen-line-bytes +
150 : fb8-delete-characters ( n -- )
151 line# fb8-line2addr column# fb8-columns2bytes + >r
152 #columns column# - 2dup >= IF
153 nip dup 0> IF fb8-columns2bytes r> ELSE r> 2drop EXIT THEN
155 fb8-columns2bytes swap fb8-columns2bytes tuck -
156 over r@ + 2dup + r> swap >r rot char-height 0 ?DO
158 -rot screen-line-bytes tuck + -rot + swap rot
163 dup 2 pick fb8-erase-block screen-line-bytes +
168 : fb8-reset-screen ( -- ) ( Left as no-op by design ) ;
170 : fb8-erase-screen ( -- )
171 frame-buffer-adr screen-height screen-line-bytes * fb8-erase-block
174 : fb8-invert-screen ( -- )
175 frame-buffer-adr screen-height screen-line-bytes * invert-region
178 : fb8-blink-screen ( -- ) fb8-invert-screen fb8-invert-screen ;
180 : fb8-install ( width height #columns #lines -- )
182 2swap to screen-height to screen-width
183 screen-width to screen-line-bytes
184 screen-#rows min to #lines
185 screen-#columns min to #columns
186 screen-height char-height #lines * - 2/ to window-top
187 screen-width char-width #columns * - 2/ to window-left
188 ['] fb8-toggle-cursor to toggle-cursor
189 ['] fb8-draw-character to draw-character
190 ['] fb8-insert-lines to insert-lines
191 ['] fb8-delete-lines to delete-lines
192 ['] fb8-insert-characters to insert-characters
193 ['] fb8-delete-characters to delete-characters
194 ['] fb8-erase-screen to erase-screen
195 ['] fb8-blink-screen to blink-screen
196 ['] fb8-invert-screen to invert-screen
197 ['] fb8-reset-screen to reset-screen
198 ['] fb8-draw-logo to draw-logo
201 : fb-install ( width height #columns #lines depth -- )
205 screen-width screen-depth * to screen-line-bytes
209 \ Install display related FCODE evaluator tokens
210 : fb8-set-tokens ( -- )
211 ['] is-install 0 11C set-token
212 ['] is-remove 0 11D set-token
213 ['] is-selftest 0 11E set-token
215 ['] #lines 0 150 set-token
216 ['] #columns 0 151 set-token
217 ['] line# 0 152 set-token
218 ['] column# 0 153 set-token
219 ['] inverse? 0 154 set-token
220 ['] inverse-screen? 0 155 set-token
221 ['] draw-character 0 157 set-token
222 ['] reset-screen 0 158 set-token
223 ['] toggle-cursor 0 159 set-token
224 ['] erase-screen 0 15A set-token
225 ['] blink-screen 0 15B set-token
226 ['] invert-screen 0 15C set-token
227 ['] insert-characters 0 15D set-token
228 ['] delete-characters 0 15E set-token
229 ['] insert-lines 0 15F set-token
230 ['] delete-lines 0 160 set-token
231 ['] draw-logo 0 161 set-token
232 ['] frame-buffer-adr 0 162 set-token
233 ['] screen-height 0 163 set-token
234 ['] screen-width 0 164 set-token
235 ['] window-top 0 165 set-token
236 ['] window-left 0 166 set-token
237 \ ['] foreground-color 0 168 set-token \ 16-color extension - n/a
238 \ ['] background-color 0 169 set-token \ 16-color extension - n/a
239 ['] default-font 0 16A set-token
240 ['] set-font 0 16B set-token
241 ['] char-height 0 16C set-token
242 ['] char-width 0 16D set-token
243 ['] >font 0 16E set-token
244 ['] fontbytes 0 16F set-token
246 ['] fb8-draw-character 0 180 set-token
247 ['] fb8-reset-screen 0 181 set-token
248 ['] fb8-toggle-cursor 0 182 set-token
249 ['] fb8-erase-screen 0 183 set-token
250 ['] fb8-blink-screen 0 184 set-token
251 ['] fb8-invert-screen 0 185 set-token
252 ['] fb8-insert-characters 0 186 set-token
253 ['] fb8-delete-characters 0 187 set-token
254 ['] fb8-insert-lines 0 188 set-token
255 ['] fb8-delete-lines 0 189 set-token
256 ['] fb8-draw-logo 0 18A set-token
257 ['] fb8-install 0 18B set-token
262 \ \\\\\\\\\\\\ Debug Stuff \\\\\\\\\\\\\\\\
264 : fb8-dump-bitmap cr char-height 0 ?do char-width 0 ?do dup c@ if ." @" else ." ." then 1+ loop cr loop drop ;
266 : fb8-dump-char >font -b swap fb8-char2bitmap fb8-dump-bitmap ;