![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to display.fs CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Qemu by Fabrice Bellard] / qemu / roms / openbios / forth / device|
Return to display.fs CVS log | Up to [Qemu by Fabrice Bellard] / qemu / roms / openbios / forth / device |
1.1 root 1: \ tag: Display device management
2: \
3: \ this code implements IEEE 1275-1994 ch. 5.3.6
4: \
5: \ Copyright (C) 2003 Stefan Reinauer
6: \
7: \ See the file "COPYING" for further information about
8: \ the copyright and warranty status of this work.
9: \
10:
11: hex
12:
13: \
14: \ 5.3.6.1 Terminal emulator routines
15: \
16:
17: \ The following values are used and set by the terminal emulator
18: \ defined and described in 3.8.4.2
19: 0 value line# ( -- line# )
20: 0 value column# ( -- column# )
21: 0 value inverse? ( -- white-on-black? )
22: 0 value inverse-screen? ( -- black? )
23: 0 value #lines ( -- rows )
24: 0 value #columns ( -- columns )
25:
26: \ The following values are used internally by both the 1-bit and the
27: \ 8-bit frame-buffer support routines.
28:
29: 0 value frame-buffer-adr ( -- addr )
30: 0 value screen-height ( -- height )
31: 0 value screen-width ( -- width )
32: 0 value window-top ( -- border-height )
33: 0 value window-left ( -- border-width )
34: 0 value char-height ( -- height )
35: 0 value char-width ( -- width )
36: 0 value fontbytes ( -- bytes )
37:
38: \ these values are used internally and do not represent any
39: \ official open firmware words
40: 0 value char-min
41: 0 value char-num
42: 0 value font
43:
44: 0 value foreground-color
45: 0 value background-color
46:
47:
48: \ The following wordset is called the "defer word interface" of the
49: \ terminal-emulator support package. It gets overloaded by fb1-install
50: \ or fb8-install (initiated by the framebuffer fcode driver)
51:
52: defer draw-character ( char -- )
53: defer reset-screen ( -- )
54: defer toggle-cursor ( -- )
55: defer erase-screen ( -- )
56: defer blink-screen ( -- )
57: defer invert-screen ( -- )
58: defer insert-characters ( n -- )
59: defer delete-characters ( n -- )
60: defer insert-lines ( n -- )
61: defer delete-lines ( n -- )
62: defer draw-logo ( line# addr width height -- )
63:
64: defer fb-emit ( x -- )
65:
66: \
67: \ 5.3.6.2 Frame-buffer support routines
68: \
69:
70: : default-font ( -- addr width height advance min-char #glyphs )
71: \ (romfont-8x16) 8 10 10 0 100
72: ;
73:
74: : set-font ( addr width height advance min-char #glyphs -- )
75: to char-num
76: to char-min
77: to fontbytes
78: to char-height
79: to char-width
80: to font
81: ;
82:
83: : >font ( char -- addr )
84: char-min -
85: char-num min
86: fontbytes *
87: font +
88: ;
89:
90: \
91: \ 5.3.6.3 Display device support
92: \
93:
94: \
95: \ 5.3.6.3.1 Frame-buffer package interface
96: \
97:
98: : is-install ( xt -- )
99: external
100: \ Create open and other methods for this display device.
101: \ Methods to be created: open, write, draw-logo, restore
102: s" open" header
103: 1 , \ colon definition
104: ,
105: ['] (semis) ,
106: reveal
107: s" : write dup >r bounds do i c@ fb-emit loop r> ; " evaluate
108: s" : draw-logo draw-logo ; " evaluate
109: s" : restore reset-screen ; " evaluate
110: ;
111:
112: : is-remove ( xt -- )
113: external
114: \ Create close method for this display device.
115: s" close" header
116: 1 , \ colon definition
117: ,
118: ['] (semis) ,
119: reveal
120: ;
121:
122: : is-selftest ( xt -- )
123: external
124: \ Create selftest method for this display device.
125: s" selftest" header
126: 1 , \ colon definition
127: ,
128: ['] (semis) ,
129: reveal
130: ;
131:
132:
133: \ 5.3.6.3.2 Generic one-bit frame-buffer support (optional)
134:
135: : fb1-nonimplemented
136: ." Monochrome framebuffer support is not implemented." cr
137: end0
138: ;
139:
140: : fb1-draw-character fb1-nonimplemented ; \ historical
141: : fb1-reset-screen fb1-nonimplemented ;
142: : fb1-toggle-cursor fb1-nonimplemented ;
143: : fb1-erase-screen fb1-nonimplemented ;
144: : fb1-blink-screen fb1-nonimplemented ;
145: : fb1-invert-screen fb1-nonimplemented ;
146: : fb1-insert-characters fb1-nonimplemented ;
147: : fb1-delete-characters fb1-nonimplemented ;
148: : fb1-insert-lines fb1-nonimplemented ;
149: : fb1-delete-lines fb1-nonimplemented ;
150: : fb1-slide-up fb1-nonimplemented ;
151: : fb1-draw-logo fb1-nonimplemented ;
152: : fb1-install fb1-nonimplemented ;
153:
154:
155: \ 5.3.6.3.3 Generic eight-bit frame-buffer support
156:
157: \ The following two functions are unrolled for speed.
158:
159:
160: \ blit 8 continuous pixels described by the 8bit
161: \ value in bitmask8. The most significant bit is
162: \ painted first.
163:
164: \ this function should honour fg and bg colors
165:
166: : fb8-write-mask8 ( bitmask8 faddr -- )
167: over 1 and 0<> over 7 + c!
168: over 2 and 0<> over 6 + c!
169: over 4 and 0<> over 5 + c!
170: over 8 and 0<> over 4 + c!
171: over 10 and 0<> over 3 + c!
172: over 20 and 0<> over 2 + c!
173: over 40 and 0<> over 1 + c!
174: over 80 and 0<> over 0 + c!
175: 2drop
176: ;
177:
178: : fb8-blitmask ( fbaddr mask-addr width height -- )
179: over >r \ save width ( -- R: width )
180: * 3 >> \ fbaddr mask-addr width*height/8
181: bounds \ fbaddr mask-end mask
182: r> 0 2swap \ fbaddr width 0 mask-end mask
183: ?do \ ( fbaddr width l-cnt )
184: 2 pick over + \ fbaddr-current
185: i c@ \ bitmask8
186: swap fb8-write-mask8
187: ( fbaddr width l-cnt )
188: 8 + 2dup = if
189: drop swap screen-width +
190: swap 0
191: then
192: ( fbaddr width l-cnt )
193: loop
194: 2drop drop
195: ;
196:
197: : fb8-line2addr ( line -- addr )
198: window-top +
199: screen-width *
200: frame-buffer-adr +
201: window-left +
202: ;
203:
204: : fb8-copy-line ( from to -- )
205: fb8-line2addr swap
206: fb8-line2addr swap
207: #columns char-width * move
208: ;
209:
210: : fb8-clear-line ( line -- )
211: fb8-line2addr
212: #columns char-width *
213: background-color fill
214: \ 0 fill
215: ;
216:
217: : fb8-draw-character ( char -- )
218: \ draw the character:
219: >font
220: line# char-height * window-top + screen-width *
221: column# char-width * window-left + + frame-buffer-adr +
222: swap char-width char-height
223: fb8-blitmask
224: \ now advance the position
225: column# 1+
226: dup #columns = if
227: drop 0 to column#
228: line# 1+
229: dup #lines = if
230: drop
231: \ FIXME move up screen (and keep position)
232: else
233: to #lines
234: then
235: else
236: to column#
237: then
238: ;
239:
240: : fb8-reset-screen ( -- )
241: false to inverse?
242: false to inverse-screen?
243: 0 to foreground-color
244: d# 15 to background-color
245: ;
246:
247: : fb8-toggle-cursor ( -- )
248: line# char-height * window-top + screen-width *
249: column# char-width * window-left + + frame-buffer-adr +
250: char-height 0 ?do
251: char-width 0 ?do
252: dup i + dup c@ invert ff and swap c!
253: loop
254: screen-width +
255: loop
256: drop
257: ;
258:
259: : fb8-erase-screen ( -- )
260: frame-buffer-adr
261: screen-height screen-width *
262: inverse-screen? if
263: foreground-color
264: else
265: background-color
266: then
267: fill
268: ;
269:
270: : fb8-invert-screen ( -- )
271: frame-buffer-adr
272: screen-height screen-width *
273: bounds ?do
274: i c@ case
275: foreground-color of background-color endof
276: background-color of foreground-color endof
277: dup
278: endcase
279: i c!
280: loop
281: ;
282:
283: : fb8-blink-screen ( -- )
284: fb8-invert-screen fb8-invert-screen
285: ;
286:
287: : fb8-insert-characters ( n -- )
288: ;
289:
290: : fb8-delete-characters ( n -- )
291: ;
292:
293: : fb8-insert-lines ( n -- )
294: ;
295:
296: : fb8-delete-lines ( n -- )
297: \ numcopy = ( #lines - ( line# + n )) * char-height
298: #lines over #line + - char-height *
299:
300: ( numcopy ) 0 ?do
301: dup line# + char-height * i +
302: line# char-height * i +
303: swap fb8-copy-line
304: loop
305:
306: #lines over - char-height *
307: over char-height *
308: 0 ?do
309: dup i + fb8-clear-line
310: loop
311:
312: 2drop
313: ;
314:
315:
316: : fb8-draw-logo ( line# addr width height -- )
317: 2swap swap
318: char-height * window-top +
319: screen-width * window-left +
320: frame-buffer-adr +
321: swap 2swap
322: \ in-fb-start-adr logo-adr logo-width logo-height
323:
324: fb8-blitmask ( fbaddr mask-addr width height -- )
325: ;
326:
327:
328: : fb8-install ( width height #columns #lines -- )
329:
330: \ set state variables
331: to #lines
332: to #columns
333: to screen-height
334: to screen-width
335:
336: screen-width #columns char-width * - 2/ to window-left
337: screen-height #lines char-height * - 2/ to window-top
338:
339: 0 to column#
340: 0 to line#
341: 0 to inverse?
342: 0 to inverse-screen?
343:
344: \ set defer functions to 8bit versions
345:
346: ['] fb8-draw-character to draw-character
347: ['] fb8-toggle-cursor to toggle-cursor
348: ['] fb8-erase-screen to erase-screen
349: ['] fb8-blink-screen to blink-screen
350: ['] fb8-invert-screen to invert-screen
351: ['] fb8-insert-characters to insert-characters
352: ['] fb8-delete-characters to delete-characters
353: ['] fb8-insert-lines to insert-lines
354: ['] fb8-delete-lines to delete-lines
355: ['] fb8-draw-logo to draw-logo
356: ['] fb8-reset-screen to reset-screen
357:
358: \ recommended practice
359: s" iso6429-1983-colors" get-my-property if
360: 0 ff
361: else
362: 2drop d# 15 0
363: then
364: to foreground-color to background-color
365:
366: ;
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.