423 lines
9.5 KiB
Forth
423 lines
9.5 KiB
Forth
|
\ tag: Display device management
|
||
|
|
\
|
||
|
|
\ this code implements IEEE 1275-1994 ch. 5.3.6
|
||
|
|
\
|
||
|
|
\ Copyright (C) 2003 Stefan Reinauer
|
||
|
|
\
|
||
|
|
\ See the file "COPYING" for further information about
|
||
|
|
\ the copyright and warranty status of this work.
|
||
|
|
\
|
||
|
|
|
||
|
|
hex
|
||
|
|
|
||
|
|
\
|
||
|
|
\ 5.3.6.1 Terminal emulator routines
|
||
|
|
\
|
||
|
|
|
||
|
|
\ The following values are used and set by the terminal emulator
|
||
|
|
\ defined and described in 3.8.4.2
|
||
|
|
0 value line# ( -- line# )
|
||
|
|
0 value column# ( -- column# )
|
||
|
|
0 value inverse? ( -- white-on-black? )
|
||
|
|
0 value inverse-screen? ( -- black? )
|
||
|
|
0 value #lines ( -- rows )
|
||
|
|
0 value #columns ( -- columns )
|
||
|
|
|
||
|
|
\ The following values are used internally by both the 1-bit and the
|
||
|
|
\ 8-bit frame-buffer support routines.
|
||
|
|
|
||
|
|
0 value frame-buffer-adr ( -- addr )
|
||
|
|
0 value screen-height ( -- height )
|
||
|
|
0 value screen-width ( -- width )
|
||
|
|
0 value window-top ( -- border-height )
|
||
|
|
0 value window-left ( -- border-width )
|
||
|
|
0 value char-height ( -- height )
|
||
|
|
0 value char-width ( -- width )
|
||
|
|
0 value fontbytes ( -- bytes )
|
||
|
|
|
||
|
|
\ these values are used internally and do not represent any
|
||
|
|
\ official open firmware words
|
||
|
|
0 value char-min
|
||
|
|
0 value char-num
|
||
|
|
0 value font
|
||
|
|
|
||
|
|
0 value foreground-color
|
||
|
|
0 value background-color
|
||
|
|
create color-palette 100 cells allot
|
||
|
|
|
||
|
|
2 value font-spacing
|
||
|
|
0 value depth-bits
|
||
|
|
0 value line-bytes
|
||
|
|
0 value display-ih
|
||
|
|
|
||
|
|
\ internal values
|
||
|
|
0 value openbios-video-height
|
||
|
|
0 value openbios-video-width
|
||
|
|
|
||
|
|
\ The following wordset is called the "defer word interface" of the
|
||
|
|
\ terminal-emulator support package. It gets overloaded by fb1-install
|
||
|
|
\ or fb8-install (initiated by the framebuffer fcode driver)
|
||
|
|
|
||
|
|
defer draw-character ( char -- )
|
||
|
|
defer reset-screen ( -- )
|
||
|
|
defer toggle-cursor ( -- )
|
||
|
|
defer erase-screen ( -- )
|
||
|
|
defer blink-screen ( -- )
|
||
|
|
defer invert-screen ( -- )
|
||
|
|
defer insert-characters ( n -- )
|
||
|
|
defer delete-characters ( n -- )
|
||
|
|
defer insert-lines ( n -- )
|
||
|
|
defer delete-lines ( n -- )
|
||
|
|
defer draw-logo ( line# addr width height -- )
|
||
|
|
|
||
|
|
defer fb-emit ( x -- )
|
||
|
|
|
||
|
|
: depth-bytes ( -- bytes )
|
||
|
|
depth-bits 1+ 8 /
|
||
|
|
;
|
||
|
|
|
||
|
|
\
|
||
|
|
\ 5.3.6.2 Frame-buffer support routines
|
||
|
|
\
|
||
|
|
|
||
|
|
: default-font ( -- addr width height advance min-char #glyphs )
|
||
|
|
(romfont) (romfont-width) (romfont-height) (romfont-height) 0 100
|
||
|
|
;
|
||
|
|
|
||
|
|
: set-font ( addr width height advance min-char #glyphs -- )
|
||
|
|
to char-num
|
||
|
|
to char-min
|
||
|
|
to fontbytes
|
||
|
|
font-spacing + to char-height
|
||
|
|
to char-width
|
||
|
|
to font
|
||
|
|
;
|
||
|
|
|
||
|
|
: >font ( char -- addr )
|
||
|
|
char-min -
|
||
|
|
char-num min
|
||
|
|
fontbytes *
|
||
|
|
font +
|
||
|
|
;
|
||
|
|
|
||
|
|
\
|
||
|
|
\ 5.3.6.3 Display device support
|
||
|
|
\
|
||
|
|
|
||
|
|
\
|
||
|
|
\ 5.3.6.3.1 Frame-buffer package interface
|
||
|
|
\
|
||
|
|
|
||
|
|
: is-install ( xt -- )
|
||
|
|
external
|
||
|
|
\ Create open and other methods for this display device.
|
||
|
|
\ Methods to be created: open, write, draw-logo, restore
|
||
|
|
s" open" header
|
||
|
|
1 , \ colon definition
|
||
|
|
,
|
||
|
|
['] (lit) ,
|
||
|
|
-1 ,
|
||
|
|
['] (semis) ,
|
||
|
|
reveal
|
||
|
|
s" : write dup >r bounds do i c@ fb-emit loop r> ; " evaluate
|
||
|
|
s" : draw-logo draw-logo ; " evaluate
|
||
|
|
s" : restore reset-screen ; " evaluate
|
||
|
|
;
|
||
|
|
|
||
|
|
: is-remove ( xt -- )
|
||
|
|
external
|
||
|
|
\ Create close method for this display device.
|
||
|
|
s" close" header
|
||
|
|
1 , \ colon definition
|
||
|
|
,
|
||
|
|
['] (semis) ,
|
||
|
|
reveal
|
||
|
|
;
|
||
|
|
|
||
|
|
: is-selftest ( xt -- )
|
||
|
|
external
|
||
|
|
\ Create selftest method for this display device.
|
||
|
|
s" selftest" header
|
||
|
|
1 , \ colon definition
|
||
|
|
,
|
||
|
|
['] (semis) ,
|
||
|
|
reveal
|
||
|
|
;
|
||
|
|
|
||
|
|
|
||
|
|
\ 5.3.6.3.2 Generic one-bit frame-buffer support (optional)
|
||
|
|
|
||
|
|
: fb1-nonimplemented
|
||
|
|
." Monochrome framebuffer support is not implemented." cr
|
||
|
|
end0
|
||
|
|
;
|
||
|
|
|
||
|
|
: fb1-draw-character fb1-nonimplemented ; \ historical
|
||
|
|
: fb1-reset-screen fb1-nonimplemented ;
|
||
|
|
: fb1-toggle-cursor fb1-nonimplemented ;
|
||
|
|
: fb1-erase-screen fb1-nonimplemented ;
|
||
|
|
: fb1-blink-screen fb1-nonimplemented ;
|
||
|
|
: fb1-invert-screen fb1-nonimplemented ;
|
||
|
|
: fb1-insert-characters fb1-nonimplemented ;
|
||
|
|
: fb1-delete-characters fb1-nonimplemented ;
|
||
|
|
: fb1-insert-lines fb1-nonimplemented ;
|
||
|
|
: fb1-delete-lines fb1-nonimplemented ;
|
||
|
|
: fb1-slide-up fb1-nonimplemented ;
|
||
|
|
: fb1-draw-logo fb1-nonimplemented ;
|
||
|
|
: fb1-install fb1-nonimplemented ;
|
||
|
|
|
||
|
|
|
||
|
|
\ 5.3.6.3.3 Generic eight-bit frame-buffer support
|
||
|
|
|
||
|
|
\ bind to low-level C function later
|
||
|
|
defer fb8-blitmask
|
||
|
|
defer fb8-fillrect
|
||
|
|
defer fb8-invertrect
|
||
|
|
|
||
|
|
: fb8-line2addr ( line -- addr )
|
||
|
|
window-top +
|
||
|
|
screen-width * depth-bytes *
|
||
|
|
frame-buffer-adr +
|
||
|
|
window-left depth-bytes * +
|
||
|
|
;
|
||
|
|
|
||
|
|
: fb8-curpos2addr ( col line -- addr )
|
||
|
|
char-height * fb8-line2addr
|
||
|
|
swap char-width * depth-bytes * +
|
||
|
|
;
|
||
|
|
|
||
|
|
: fb8-copy-lines ( count from to -- )
|
||
|
|
fb8-line2addr swap
|
||
|
|
fb8-line2addr swap
|
||
|
|
#columns char-width * depth-bytes *
|
||
|
|
3 pick * move drop
|
||
|
|
;
|
||
|
|
|
||
|
|
: fb8-clear-lines ( count line -- )
|
||
|
|
background-color 0
|
||
|
|
2 pick window-top +
|
||
|
|
#columns char-width *
|
||
|
|
5 pick
|
||
|
|
fb8-fillrect
|
||
|
|
2drop
|
||
|
|
;
|
||
|
|
|
||
|
|
: fb8-draw-character ( char -- )
|
||
|
|
\ erase the current character
|
||
|
|
background-color
|
||
|
|
column# char-width * window-left +
|
||
|
|
line# char-height * window-top +
|
||
|
|
char-width char-height fb8-fillrect
|
||
|
|
\ draw the character:
|
||
|
|
>font
|
||
|
|
line# char-height * window-top + screen-width * depth-bytes *
|
||
|
|
column# char-width * depth-bytes *
|
||
|
|
window-left depth-bytes * + + frame-buffer-adr +
|
||
|
|
swap char-width char-height font-spacing -
|
||
|
|
\ normal or inverse?
|
||
|
|
foreground-color background-color
|
||
|
|
inverse? if
|
||
|
|
swap
|
||
|
|
then
|
||
|
|
fb8-blitmask
|
||
|
|
;
|
||
|
|
|
||
|
|
: fb8-reset-screen ( -- )
|
||
|
|
false to inverse?
|
||
|
|
false to inverse-screen?
|
||
|
|
0 to foreground-color
|
||
|
|
d# 15 to background-color
|
||
|
|
|
||
|
|
\ override with OpenBIOS defaults
|
||
|
|
0 to background-color
|
||
|
|
ff to foreground-color
|
||
|
|
;
|
||
|
|
|
||
|
|
: fb8-toggle-cursor ( -- )
|
||
|
|
column# char-width * window-left +
|
||
|
|
line# char-height * window-top +
|
||
|
|
char-width char-height font-spacing -
|
||
|
|
foreground-color background-color
|
||
|
|
fb8-invertrect
|
||
|
|
;
|
||
|
|
|
||
|
|
: fb8-erase-screen ( -- )
|
||
|
|
inverse-screen? if
|
||
|
|
foreground-color
|
||
|
|
else
|
||
|
|
background-color
|
||
|
|
then
|
||
|
|
0 0 screen-width screen-height
|
||
|
|
fb8-fillrect
|
||
|
|
;
|
||
|
|
|
||
|
|
: fb8-invert-screen ( -- )
|
||
|
|
0 0 screen-width screen-height
|
||
|
|
background-color foreground-color
|
||
|
|
fb8-invertrect
|
||
|
|
;
|
||
|
|
|
||
|
|
: fb8-blink-screen ( -- )
|
||
|
|
fb8-invert-screen 2000 ms
|
||
|
|
fb8-invert-screen
|
||
|
|
;
|
||
|
|
|
||
|
|
: fb8-insert-characters ( n -- )
|
||
|
|
\ numcopy = ( #columns - column# - n )
|
||
|
|
#columns over - column# -
|
||
|
|
char-width * depth-bytes * ( n numbytescopy )
|
||
|
|
|
||
|
|
over column# + line# fb8-curpos2addr
|
||
|
|
column# line# fb8-curpos2addr ( n numbytescopy destaddr srcaddr )
|
||
|
|
char-height 0 do
|
||
|
|
3dup swap rot move
|
||
|
|
line-bytes + swap line-bytes + swap
|
||
|
|
loop 3drop
|
||
|
|
|
||
|
|
background-color
|
||
|
|
column# char-width * window-left + line# char-height * window-top +
|
||
|
|
3 pick char-width * char-height
|
||
|
|
fb8-fillrect
|
||
|
|
drop
|
||
|
|
;
|
||
|
|
|
||
|
|
: fb8-delete-characters ( n -- )
|
||
|
|
\ numcopy = ( #columns - column# - n )
|
||
|
|
#columns over - column# -
|
||
|
|
char-width * depth-bytes * ( n numbytescopy )
|
||
|
|
|
||
|
|
over column# + line# fb8-curpos2addr
|
||
|
|
column# line# fb8-curpos2addr swap ( n numbytescopy destaddr srcaddr )
|
||
|
|
char-height 0 do
|
||
|
|
3dup swap rot move
|
||
|
|
line-bytes + swap line-bytes + swap
|
||
|
|
loop 3drop
|
||
|
|
|
||
|
|
background-color
|
||
|
|
over #columns swap - char-width * window-left + line# char-height * window-top +
|
||
|
|
3 pick char-width * char-height
|
||
|
|
fb8-fillrect
|
||
|
|
drop
|
||
|
|
;
|
||
|
|
|
||
|
|
: fb8-insert-lines ( n -- )
|
||
|
|
\ numcopy = ( #lines - n )
|
||
|
|
#lines over - char-height *
|
||
|
|
over line# char-height *
|
||
|
|
swap char-height * over +
|
||
|
|
fb8-copy-lines
|
||
|
|
|
||
|
|
char-height * line# char-height *
|
||
|
|
fb8-clear-lines
|
||
|
|
;
|
||
|
|
|
||
|
|
: fb8-delete-lines ( n -- )
|
||
|
|
\ numcopy = ( #lines - ( line# + n )) * char-height
|
||
|
|
#lines over line# + - char-height *
|
||
|
|
over line# + char-height *
|
||
|
|
line# char-height *
|
||
|
|
fb8-copy-lines
|
||
|
|
|
||
|
|
#lines over - char-height *
|
||
|
|
dup #lines char-height * swap - swap
|
||
|
|
fb8-clear-lines
|
||
|
|
drop
|
||
|
|
;
|
||
|
|
|
||
|
|
|
||
|
|
: fb8-draw-logo ( line# addr width height -- )
|
||
|
|
2swap swap
|
||
|
|
char-height * window-top +
|
||
|
|
screen-width * window-left +
|
||
|
|
frame-buffer-adr +
|
||
|
|
swap 2swap
|
||
|
|
\ in-fb-start-adr logo-adr logo-width logo-height
|
||
|
|
|
||
|
|
fb8-blitmask ( fbaddr mask-addr width height -- )
|
||
|
|
;
|
||
|
|
|
||
|
|
|
||
|
|
: fb8-install ( width height #columns #lines -- )
|
||
|
|
|
||
|
|
\ set state variables
|
||
|
|
to #lines
|
||
|
|
to #columns
|
||
|
|
to screen-height
|
||
|
|
to screen-width
|
||
|
|
|
||
|
|
screen-width #columns char-width * - 2/ to window-left
|
||
|
|
screen-height #lines char-height * - 2/ to window-top
|
||
|
|
|
||
|
|
0 to column#
|
||
|
|
0 to line#
|
||
|
|
0 to inverse?
|
||
|
|
0 to inverse-screen?
|
||
|
|
|
||
|
|
my-self to display-ih
|
||
|
|
|
||
|
|
\ set /chosen display property
|
||
|
|
my-self active-package 0 to my-self
|
||
|
|
" /chosen" (find-dev) 0<> if
|
||
|
|
active-package!
|
||
|
|
display-ih encode-int " display" property
|
||
|
|
then
|
||
|
|
active-package! to my-self
|
||
|
|
|
||
|
|
\ set defer functions to 8bit versions
|
||
|
|
|
||
|
|
['] fb8-draw-character to draw-character
|
||
|
|
['] fb8-toggle-cursor to toggle-cursor
|
||
|
|
['] fb8-erase-screen to erase-screen
|
||
|
|
['] fb8-blink-screen to blink-screen
|
||
|
|
['] fb8-invert-screen to invert-screen
|
||
|
|
['] fb8-insert-characters to insert-characters
|
||
|
|
['] fb8-delete-characters to delete-characters
|
||
|
|
['] fb8-insert-lines to insert-lines
|
||
|
|
['] fb8-delete-lines to delete-lines
|
||
|
|
['] fb8-draw-logo to draw-logo
|
||
|
|
['] fb8-reset-screen to reset-screen
|
||
|
|
|
||
|
|
\ recommended practice
|
||
|
|
s" iso6429-1983-colors" get-my-property if
|
||
|
|
0 ff
|
||
|
|
else
|
||
|
|
2drop d# 15 0
|
||
|
|
then
|
||
|
|
to foreground-color to background-color
|
||
|
|
|
||
|
|
\ setup palette
|
||
|
|
10101 ['] color-palette cell+ 100 0 do
|
||
|
|
dup 2 pick i * swap ! cell+
|
||
|
|
loop 2drop
|
||
|
|
|
||
|
|
\ special foreground and background colors
|
||
|
|
ffffcc ['] color-palette cell+ 0 cells + !
|
||
|
|
000000 ['] color-palette cell+ ff cells + !
|
||
|
|
|
||
|
|
\ load palette onto the hardware
|
||
|
|
['] color-palette cell+ 100 0 do
|
||
|
|
dup @ ff0000 and d# 16 rshift
|
||
|
|
1 pick @ ff00 and d# 8 rshift
|
||
|
|
2 pick @ ff and
|
||
|
|
i
|
||
|
|
s" color!" $find if
|
||
|
|
execute
|
||
|
|
else
|
||
|
|
2drop
|
||
|
|
then
|
||
|
|
cell+
|
||
|
|
loop drop
|
||
|
|
|
||
|
|
\ ... but let's override with some better defaults
|
||
|
|
0 to background-color
|
||
|
|
ff to foreground-color
|
||
|
|
|
||
|
|
fb8-erase-screen
|
||
|
|
|
||
|
|
\ If we have a startup splash then display it
|
||
|
|
[IFDEF] CONFIG_MOL
|
||
|
|
mol-startup-splash 2000 ms
|
||
|
|
fb8-erase-screen
|
||
|
|
[THEN]
|
||
|
|
;
|