[openfirmware] r1058 - cpu/x86/pc/olpc dev/geode/display dev/video dev/video/common dev/video/controlr dev/video/dacs ofw/termemu
svn at openfirmware.info
svn at openfirmware.info
Sun Jan 4 00:29:47 CET 2009
Author: wmb
Date: 2009-01-04 00:29:47 +0100 (Sun, 04 Jan 2009)
New Revision: 1058
Modified:
cpu/x86/pc/olpc/disptest.fth
dev/geode/display/gp.fth
dev/geode/display/gxfb.fth
dev/video/common/defer.fth
dev/video/common/display.fth
dev/video/common/graphics.fth
dev/video/common/rectangl.fth
dev/video/common/rectangle16.fth
dev/video/controlr/cirrus.fth
dev/video/controlr/vga.fth
dev/video/controlr/vmsvga.fth
dev/video/dacs/cirrus.fth
dev/video/loadcirrus.fth
ofw/termemu/fb8.fth
ofw/termemu/framebuf.fth
Log:
Big reorganization of display drivers to clean up support
for multiple bit depths.
Modified: cpu/x86/pc/olpc/disptest.fth
===================================================================
--- cpu/x86/pc/olpc/disptest.fth 2009-01-03 01:52:19 UTC (rev 1057)
+++ cpu/x86/pc/olpc/disptest.fth 2009-01-03 23:29:47 UTC (rev 1058)
@@ -69,7 +69,7 @@
;
: selftest ( -- error? )
- bytes/pixel 2 <> if false exit then
+ depth d# 16 <> if false exit then
.horizontal-bars16
d# 2000 ms
.vertical-bars16
Modified: dev/geode/display/gp.fth
===================================================================
--- dev/geode/display/gp.fth 2009-01-03 01:52:19 UTC (rev 1057)
+++ dev/geode/display/gp.fth 2009-01-03 23:29:47 UTC (rev 1058)
@@ -31,10 +31,10 @@
: gp-setup ( -- )
frame-buffer-adr >physical dup dup offset!
bytes/line dup stride!
- bytes/pixel case
- 1 of 0 endof \ 8-bpp 3:3:2
- 2 of h# 6000.0000 endof \ 16-bpp 5:6:5
- 4 of h# 8000.0000 endof \ 32-bpp 8:8:8:8
+ depth case
+ 8 of 0 endof \ 8-bpp 3:3:2
+ d# 16 of h# 6000.0000 endof \ 16-bpp 5:6:5
+ d# 32 of h# 8000.0000 endof \ 32-bpp 8:8:8:8
endcase
to rop-high
;
@@ -97,9 +97,9 @@
: display-install ( -- )
init-all
default-font set-font
- /scanline bytes/pixel / #scanlines ( width height )
+ width height ( width height )
over char-width / over char-height / ( width height rows cols )
- bytes/pixel fb-install gp-install ( )
+ /scanline depth fb-install gp-install ( )
init-hook
;
Modified: dev/geode/display/gxfb.fth
===================================================================
--- dev/geode/display/gxfb.fth 2009-01-03 01:52:19 UTC (rev 1057)
+++ dev/geode/display/gxfb.fth 2009-01-03 23:29:47 UTC (rev 1058)
@@ -4,24 +4,24 @@
hex
headers
-2 value bytes/pixel
-d# 1024 value /scanline \ Frame buffer line width
-d# 1024 value /displine \ Displayed line width
-d# 768 value #scanlines \ Screen height
+d# 1024 instance value width \ Frame buffer line width
+d# 768 instance value height \ Screen height
+d# 16 instance value depth \ Bits per pixel
+d# 1024 instance value /scanline \ Frame buffer line width
: declare-props ( -- ) \ Instantiate screen properties
" width" get-my-property if
- /displine bytes/pixel / encode-int " width" property
- #scanlines encode-int " height" property
- bytes/pixel 8 * encode-int " depth" property
- /scanline encode-int " linebytes" property
+ width encode-int " width" property
+ height encode-int " height" property
+ depth encode-int " depth" property
+ /scanline encode-int " linebytes" property
else
2drop
then
;
-: /fb ( -- ) /scanline #scanlines * ; \ Size of framebuffer
+: /fb ( -- ) /scanline height * ; \ Size of framebuffer
0 instance value dc-base
0 instance value gp-base
@@ -123,8 +123,8 @@
: set-timing ( -- )
timing 3 na+ ( adr )
- @+ bytes/pixel * 3 rshift h# 34 dc! \ Graphics pitch ( adr )
- @+ bytes/pixel * 3 rshift 2 + h# 30 dc! \ Line size ( adr )
+ @+ depth * 6 rshift h# 34 dc! \ Graphics pitch ( adr )
+ @+ depth * 6 rshift 2 + h# 30 dc! \ Line size ( adr )
@+ h# 40 dc! \ H_ACTIVE
@+ h# 44 dc! \ H_BLANK
@@ -279,10 +279,10 @@
\ The "c" part (A20M, A18M) is unnecessary for LX, but harmless
\ The "2" part (PALB) is unnecessary for GX, but harmless
h# c200.0019
- bytes/pixel case
- 1 of 0 endof
- 2 of h# 100 endof
- 4 of h# 300 endof
+ depth case
+ 8 of 0 endof
+ d# 16 of h# 100 endof
+ d# 32 of h# 300 endof
endcase
or 8 dc!
@@ -489,20 +489,20 @@
\ change the mode back to VGA timing and resolution
dcon? tft-mode? and if
- d# 1200 bytes/pixel * to /displine
- d# 1200 bytes/pixel * to /scanline
- d# 900 to #scanlines
+ d# 1200 to width
+ width depth * 3 rshift to /scanline
+ d# 900 to height
else
set-mode \ Redo the mode for VGA
- d# 1024 bytes/pixel * to /displine
- d# 1024 bytes/pixel * to /scanline
- d# 768 to #scanlines
+ d# 1024 to width
+ width depth * 3 rshift to /scanline
+ d# 768 to height
then
;
: init-hook ( -- )
- /displine " emu-bytes/line" eval - 2/ to window-left
+ width #columns char-width * - 2/ to window-left
;
external
@@ -567,10 +567,10 @@
video-on \ Turn on video
map-frame-buffer
- bytes/pixel case
- 1 of frame-buffer-adr /fb h# 0f fill endof
- 2 of frame-buffer-adr /fb background-rgb rgb>565 wfill endof
- 4 of frame-buffer-adr /fb h# ffff.ffff lfill endof
+ depth case
+ 8 of frame-buffer-adr /fb h# 0f fill endof
+ d# 16 of frame-buffer-adr /fb background-rgb rgb>565 wfill endof
+ d# 32 of frame-buffer-adr /fb h# ffff.ffff lfill endof
endcase
h# f to background-color
Modified: dev/video/common/defer.fth
===================================================================
--- dev/video/common/defer.fth 2009-01-03 01:52:19 UTC (rev 1057)
+++ dev/video/common/defer.fth 2009-01-03 23:29:47 UTC (rev 1058)
@@ -60,31 +60,45 @@
: pl@ ( offset -- lwrd ) io-base + rl@ ;
: pl! ( lwrd offset -- ) io-base + rl! ;
-d# 640 value /scanline \ Screen width
-d# 480 value #scanlines \ Screen height
+d# 640 instance value width \ Screen width
+d# 480 instance value height \ Screen height
+8 instance value depth \ Bits per pixel
-: 640-resolution ( -- )
- d# 640 to /scanline
- d# 480 to #scanlines
-;
+d# 640 instance value /scanline \ Bytes per line
-: 1024-resolution ( -- )
- d# 1024 to /scanline
- d# 768 to #scanlines
+: set-depth ( depth -- )
+ to depth
+ \ The following is correct for framebuffers without extra padding
+ \ at the end of each scanline. Adjust /scanline for others.
+ width depth * 8 / to /scanline
;
+: (set-resolution) ( width height depth -- )
+ >r to height to width r> set-depth
+;
+: 640x480x8 ( -- ) d# 640 d# 480 8 (set-resolution) ;
+: 1024x768x8 ( -- ) d# 1024 d# 768 8 (set-resolution) ;
+: 1024x768x16 ( -- ) d# 1024 d# 768 d# 16 (set-resolution) ;
+: 1024x768x32 ( -- ) d# 1024 d# 768 d# 32 (set-resolution) ;
+: 1280x1024x8 ( -- ) d# 1280 d# 1024 8 (set-resolution) ;
+: 1280x1024x16 ( -- ) d# 1280 d# 1024 d# 16 (set-resolution) ;
+: 1280x1024x32 ( -- ) d# 1280 d# 1024 d# 32 (set-resolution) ;
+
+: 640-resolution ( -- ) d# 640 d# 480 8 (set-resolution) ;
+: 1024-resolution ( -- ) d# 1024 d# 768 8 (set-resolution) ;
+
: declare-props ( -- ) \ Instantiate screen properties
" width" get-my-property if
- /scanline encode-int " width" property
- #scanlines encode-int " height" property
- 8 encode-int " depth" property
+ width encode-int " width" property
+ height encode-int " height" property
+ depth encode-int " depth" property
/scanline encode-int " linebytes" property
else
2drop
then
;
-: /fb ( -- ) /scanline #scanlines * ; \ Size of framebuffer
+: /fb ( -- ) /scanline height * ; \ Size of framebuffer
\ Helper words...
Modified: dev/video/common/display.fth
===================================================================
--- dev/video/common/display.fth 2009-01-03 01:52:19 UTC (rev 1057)
+++ dev/video/common/display.fth 2009-01-03 23:29:47 UTC (rev 1058)
@@ -11,7 +11,8 @@
: display-install ( -- )
init
default-font set-font
- /scanline #scanlines over char-width / over char-height / fb8-install
+ width height over char-width / over char-height /
+ /scanline depth " fb-install" eval
init-hook
;
Modified: dev/video/common/graphics.fth
===================================================================
--- dev/video/common/graphics.fth 2009-01-03 01:52:19 UTC (rev 1057)
+++ dev/video/common/graphics.fth 2009-01-03 23:29:47 UTC (rev 1058)
@@ -20,7 +20,7 @@
0 swap 3 /
;
-headerless
+\ headerless
\ For 6-to-8 conversion, we set the low bits to the same as the high bits,
\ so that the colors are spread out evenly
Modified: dev/video/common/rectangl.fth
===================================================================
--- dev/video/common/rectangl.fth 2009-01-03 01:52:19 UTC (rev 1057)
+++ dev/video/common/rectangl.fth 2009-01-03 23:29:47 UTC (rev 1058)
@@ -29,10 +29,8 @@
loop
3drop
;
-: dimensions ( -- width height )
- /scanline ( width )
- #scanlines ( width height )
-;
+: dimensions ( -- width height ) width height ;
+
\ LICENSE_BEGIN
\ Copyright (c) 2006 FirmWorks
\
Modified: dev/video/common/rectangle16.fth
===================================================================
--- dev/video/common/rectangle16.fth 2009-01-03 01:52:19 UTC (rev 1057)
+++ dev/video/common/rectangle16.fth 2009-01-03 23:29:47 UTC (rev 1058)
@@ -4,23 +4,25 @@
external
: rectangle-setup ( x y w h -- wb fbadr h )
- swap bytes/pixel * swap ( x y wbytes h )
+ swap depth * 3 rshift swap ( x y wbytes h )
2swap /scanline * frame-buffer-adr + ( wbytes h x line-adr )
- swap bytes/pixel * + ( wbytes h fbadr )
+ swap depth * 3 rshift + ( wbytes h fbadr )
swap ( wbytes fbadr h )
;
: fill-rectangle ( color x y w h -- )
- rectangle-setup 0 ?do ( color wbytes fbadr )
- 3dup swap rot ( color wbytes fbadr adr wb color )
- bytes/pixel case ( color wbytes fbadr adr wb color )
- 1 of fill endof
- 2 of wfill endof
- 4 of lfill endof
- endcase ( color wbytes fbadr )
- /scanline + ( color wbytes fbadr' )
- loop ( color wbytes fbadr' )
+ rot /scanline * frame-buffer-adr + ( color x w h fbadr )
+ -rot >r ( color x fbadr w r: h )
+ \ The loop is inside the case for speed
+ depth case ( color x fbadr w r: h )
+ \ The stack before ?do is ( color width-bytes fbadr h 0 )
+ 8 of -rot + r> 0 ?do 3dup swap rot fill /scanline + loop endof
+ d# 16 of /w* -rot swap wa+ r> 0 ?do 3dup swap rot wfill /scanline + loop endof
+ d# 32 of /l* -rot swap la+ r> 0 ?do 3dup swap rot lfill /scanline + loop endof
+ ( default ) r> drop nip ( color x fbadr bytes/pixel )
+ endcase ( color width-bytes fbadr )
3drop
;
+
: draw-rectangle ( adr x y w h -- )
rectangle-setup 0 ?do ( adr wbytes fbadr )
3dup swap move ( adr wbytes fbadr )
@@ -55,10 +57,7 @@
loop ( adr' wbytes fbadr' )
3drop
;
-: dimensions ( -- width height )
- /scanline bytes/pixel / ( width )
- #scanlines ( width height )
-;
+: dimensions ( -- width height ) width height ;
\ LICENSE_BEGIN
\ Copyright (c) 2006 FirmWorks
Modified: dev/video/controlr/cirrus.fth
===================================================================
--- dev/video/controlr/cirrus.fth 2009-01-03 01:52:19 UTC (rev 1057)
+++ dev/video/controlr/cirrus.fth 2009-01-03 23:29:47 UTC (rev 1058)
@@ -4,7 +4,7 @@
\ This file contains the Cirrus Controller specific code.
hex
-headerless
+\ headerless
: .driver-info ( -- )
.driver-info
." Cirrus Code Version" cr
@@ -13,17 +13,70 @@
\ The Cirrus BIOS extension stores a code indicating the memory size
\ in sequencer register 15. That register doesn't do anything to the
\ hardware, but OS drivers sometimes use that memory size information.
-: cirrus-memsize ( -- ) 2 15 seq! ;
+: cirrus-memsize ( -- )
+ \ 2 15 seq! \ Don't need to do this for QEMU
+;
+: cirrus-hidden@ ( b -- )
+ 0 vga-rmr! \ Clear DAC index and hidden DAC index
+ vga-rmr@ drop vga-rmr@ drop vga-rmr@ drop vga-rmr@ drop
+ vga-rmr@
+;
+
+: cirrus-hidden! ( b -- )
+ 0 vga-rmr! \ 0 to pixel mask
+ h# 3c8 pc@ drop \ Read pixel address
+ vga-rmr@ drop vga-rmr@ drop vga-rmr@ drop vga-rmr@ drop
+ vga-rmr!
+;
+
+d# 25 instance buffer: crt-buf
+
+: cirrus-crt-table \ 640x480, byte mode
+ " "(5f 4f 50 82 54 80 0b 3e 00 40 00 00 00 00 07 80 ea 0c df 50 00 e7 04 e3 ff)"
+;
+: set-geom ( -- )
+ width 8 / 1- crt-buf 1 + c!
+ height 1 - ( n )
+ dup 3 rshift h# 40 and ( n bits )
+ over 7 rshift 2 and or crt-buf 7 + c! ( n )
+ crt-buf h# 12 + c! ( )
+;
+
+: set-offset ( offset -- )
+ dup crt-buf h# 13 + c! ( offset )
+ h# 100 and if h# 32 else h# 22 then h# 1b crt!
+;
+
\ Set linear addressing
: cirrus-linear ( -- )
+ cirrus-crt-table crt-buf swap move
+
\ ef: c0 - 480 lines, 20 - high page, 0c - ext clock, 2 - ena RAM, 1 - color
\ For higher resolutions (1024x768, 1280x1024, 1600x1200),
\ the appropriate value is 2f
\ ef misc!
- 11 7 seq!
+ depth case
+ d# 32 of
+ h# 29 7 seq!
+ h# c5 cirrus-hidden!
+ width 2 / set-offset
+ endof
+
+ d# 16 of
+ h# 27 7 seq!
+ h# c0 cirrus-hidden!
+\ 1 cirrus-hidden!
+ width 4 / set-offset
+ endof
+ 8 of
+ h# 11 7 seq!
+ width 8 / set-offset
+ endof
+ endcase
+ set-geom
;
: cirrus-textmode ( -- ) 0 7 seq! ;
@@ -39,14 +92,15 @@
vga-reset
- seq-regs cirrus-linear start-seq cirrus-memsize start-seq
+ seq-regs cirrus-linear start-seq cirrus-memsize start-seq
high-attr-regs
- grf-regs graphics-memory crt-regs
+ grf-regs graphics-memory
+ crt-buf d# 25 (crt-regs)
- 55 f seq!
- 2 1b crt!
+\ 55 f seq! \ Don't need this for QEMU
+\ 2 1b crt! \ set-offset handles this
0 feature-ctl! \ Vertical sync ctl
@@ -54,6 +108,18 @@
hsync-on
;
+: set-resolution ( width height depth -- )
+ unmap-frame-buffer
+ (set-resolution)
+ map-io-regs
+ cirrus-linear
+ crt-buf d# 25 (crt-regs)
+ width height over char-width / over char-height /
+ /scanline depth " fb-install" eval
+ unmap-io-regs
+ map-frame-buffer
+ frame-buffer-adr /fb h# ff fill
+;
: use-cirrus-words ( -- ) \ Turns on the Cirrus-specific words
['] init-cirrus-controller to init-controller
Modified: dev/video/controlr/vga.fth
===================================================================
--- dev/video/controlr/vga.fth 2009-01-03 01:52:19 UTC (rev 1057)
+++ dev/video/controlr/vga.fth 2009-01-03 23:29:47 UTC (rev 1058)
@@ -176,11 +176,13 @@
0 ?do dup i + c@ i crt! loop drop
;
-: crt-regs ( -- )
+0 value crt-reg4
+: (crt-regs) ( adr len -- )
\ Don't program hsync (at offset 4) until later
- crt-table 0 ?do i 4 <> if dup i + c@ i crt! then loop drop
+ 0 ?do dup i + c@ i 4 = if to crt-reg4 else i crt! then loop drop
;
-: hsync-on ( -- ) crt-table drop 4 + c@ 4 crt! ; \ Set hsync position
+: crt-regs ( -- ) crt-table (crt-regs) ;
+: hsync-on ( -- ) crt-reg4 4 crt! ; \ Set hsync position
: vga-video-on ( -- ) palette-on hsync-on ;
Modified: dev/video/controlr/vmsvga.fth
===================================================================
--- dev/video/controlr/vmsvga.fth 2009-01-03 01:52:19 UTC (rev 1057)
+++ dev/video/controlr/vmsvga.fth 2009-01-03 23:29:47 UTC (rev 1058)
@@ -16,22 +16,24 @@
\ operation - it transmits the current change box to the virtual hardware,
\ thus telling it to update the physical display on the host system.
-d# 640 value /scanline \ Active screen width
-d# 480 value #scanlines \ Active screen height
-: /fb ( -- ) /scanline #scanlines * ; \ Size of active framebuffer
-
-: 640-resolution ( -- )
- d# 640 to /scanline
- d# 480 to #scanlines
+d# 640 instance value width \ Active screen width
+d# 480 instance value height \ Active screen height
+8 instance value depth
+d# 640 instance value /scanline \ Active screen width
+: (set-resolution) ( width height depth -- )
+ to depth to height to width
;
-: 1024-resolution ( -- )
- d# 1024 to /scanline
- d# 768 to #scanlines
-;
+: 640-resolution ( -- ) d# 640 d# 480 8 (set-resolution) ;
-0 value regs \ Base address of index/data registers
+: 1024-resolution ( -- ) d# 1024 d# 768 8 (set-resolution) ;
+: 1024x768x16 ( -- ) d# 1024 d# 768 d# 16 (set-resolution) ;
+: 1200x900x16 ( -- ) d# 1200 d# 900 d# 16 (set-resolution) ;
+: 1200x900x32 ( -- ) d# 1200 d# 900 d# 32 (set-resolution) ;
+: 640x480x32 ( -- ) d# 640 d# 480 d# 32 (set-resolution) ;
+0 instance value regs \ Base address of index/data registers
+
\ It seems strange to access a 32-bit port at an odd address (1+),
\ but that's the way it works. It's not a real hardware port.
: reg@ ( index -- value ) regs rl! regs 1+ rl@ ;
@@ -75,13 +77,24 @@
-1 value fifo
: /fb ( -- #bytes ) d# 15 reg@ ;
: /fifo ( -- #bytes ) d# 19 reg@ ;
+
+\ 1200x900x32
+\ 640x480x32
+1024x768x16
+
+h# 200.0000 instance value /mem
: map-regs ( -- )
- 0 0 h# 01007810 h# 10 " map-in" $call-parent to regs
+ 0 0 my-space h# 0100.0010 + h# 10 " map-in" $call-parent to regs
;
: map-mem ( -- )
- 0 0 h# 02007814 /fb " map-in" $call-parent to frame-buffer-adr
- 0 0 h# 02007818 /fifo " map-in" $call-parent to fifo
- 3 h# 7804 " config-w!" $call-parent
+ my-space h# 14 + " config-l@" $call-parent if
+ 0 0 my-space h# 0200.0014 + /fb " map-in" $call-parent to frame-buffer-adr
+ 0 0 my-space h# 0200.0018 + /fifo " map-in" $call-parent to fifo
+ else
+ 0 0 my-space h# 0200.0018 + /fb " map-in" $call-parent to frame-buffer-adr
+ /fb 0 my-space h# 0200.0018 + /fifo " map-in" $call-parent to fifo
+ then
+ 3 my-space h# 04 + " config-w!" $call-parent
;
: unmap-regs ( -- ) regs h# 10 " map-out" $call-parent ;
: unmap-mem ( -- )
@@ -104,7 +117,11 @@
abort \ We don't support version 0
;
: init-fb ( -- )
- /scanline 2 reg! #scanlines 3 reg! d# 8 7 reg! \ Dimensions
+ depth 7 reg! 7 reg@ depth <> if 7 reg@ to depth then
+
+ width 2 reg! height 3 reg! \ Dimensions
+ d# 12 reg@ to /scanline
+
1 1 reg! \ Enable SVGA
;
: init-fifo ( -- )
@@ -114,7 +131,7 @@
d# 16 d# 10 d# 1024 * + fifo-max!
d# 16 fifo-next!
d# 16 fifo-stop!
- 1 d# 20 reg!
+ 1 d# 20 reg! \ Config done; adapter accepts fifo values
;
: sync-fifo ( -- ) 1 d# 21 reg! begin d# 22 reg@ 0= until ;
: fifo-full? ( -- flag ) fifo-next@ la1+ fifo-stop@ = ;
@@ -133,12 +150,28 @@
fifo-max@ = if fifo-min@ fifo-next! then \ Wrap back at the end
;
+: +fifo ( offset -- offset' )
+ fifo-next@ swap la+ dup fifo-max@ >= if ( n fifo-offset )
+ fifo-max@ - fifo-min@ + ( n fifo-offset' )
+ then ( n fifo-offset )
+;
+: fifo! ( n offset -- ) +fifo fifo + l! ;
+
+: need-fifo-entries ( n -- )
+ fifo-next@ swap la+ ( next+ )
+ fifo-stop@ dup fifo-next@ < if ( next+ stop )
+ fifo-max@ + fifo-min@ - ( next+ stop' )
+ then ( next+ stop )
+ < if sync-fifo then ( )
+;
+
\ Pass the change box to the display engine
: fb-update ( xmin xlen ymin ylen -- )
- 1 fifo-put
- 2swap swap fifo-put ( ymin ylen xlen )
- rot fifo-put ( ymin xlen )
- fifo-put fifo-put ( )
+ 5 need-fifo-entries
+
+ 1 0 fifo! ( xmin xlen ymin ylen ) \ command
+ 4 fifo! 2 fifo! 3 fifo! 1 fifo! ( )
+ 5 +fifo fifo-next!
;
: cursor-x ( -- n ) column# char-width * window-left + ;
@@ -149,7 +182,7 @@
;
\ For a whole-screen update we set the box to emcompass the entire screen
-: screen-changed ( -- ) 0 /scanline 0 #scanlines fb-update ;
+: screen-changed ( -- ) 0 width 0 height fb-update ;
\ Extend by the size of a character at the current position
: char-changed ( -- )
@@ -157,11 +190,11 @@
;
\ Extend to include the remainder of the current line
: line-changed ( -- )
- cursor-x /scanline cursor-y char-height fb-update
+ cursor-x width cursor-y char-height fb-update
;
\ Extend from the current line to the bottom of the screen, full width
: changed-to-end ( -- )
- 0 /scanline cursor-y #scanlines fb-update
+ 0 width cursor-y height fb-update
;
\ Color map (palette) access words
@@ -205,9 +238,9 @@
: declare-props ( -- ) \ Instantiate screen properties
" width" get-my-property if
- /scanline encode-int " width" property
- #scanlines encode-int " height" property
- 8 encode-int " depth" property
+ width encode-int " width" property
+ height encode-int " height" property
+ depth encode-int " depth" property
/scanline encode-int " linebytes" property
else
2drop
@@ -256,7 +289,8 @@
init
set-dac-colors
default-font set-font
- d# 12 reg@ #scanlines over char-width / over char-height / fb8-install
+ width height over char-width / over char-height /
+ /scanline depth " fb-install" eval
\ Replace the fb8-version of toggle-cursor with the wrapped version
['] vm-toggle-cursor to toggle-cursor
Modified: dev/video/dacs/cirrus.fth
===================================================================
--- dev/video/dacs/cirrus.fth 2009-01-03 01:52:19 UTC (rev 1057)
+++ dev/video/dacs/cirrus.fth 2009-01-03 23:29:47 UTC (rev 1058)
@@ -2,7 +2,7 @@
purpose: Initialize Cirrus RAMDAC
hex
-headerless
+\ headerless
: init-cirrus-dac ( -- )
ff rmr!
Modified: dev/video/loadcirrus.fth
===================================================================
--- dev/video/loadcirrus.fth 2009-01-03 01:52:19 UTC (rev 1057)
+++ dev/video/loadcirrus.fth 2009-01-03 23:29:47 UTC (rev 1058)
@@ -3,6 +3,7 @@
" vga" device-name
fload ${BP}/dev/video/common/defer.fth \ Defered words
+1024x768x16
fload ${BP}/dev/video/controlr/pcimap.fth \ Generic PCI implementations
fload ${BP}/dev/video/dacs/cirrus.fth
fload ${BP}/dev/video/controlr/vga.fth \ Load generic VGA routines
Modified: ofw/termemu/fb8.fth
===================================================================
--- ofw/termemu/fb8.fth 2009-01-03 01:52:19 UTC (rev 1057)
+++ ofw/termemu/fb8.fth 2009-01-03 23:29:47 UTC (rev 1058)
@@ -137,7 +137,6 @@
\ defer fb-paint ' fb8-paint to fb-paint
headers
-: bytes/line ( -- n ) screen-width pix* ;
: bytes/char ( -- n ) char-width pix* ;
: bytes/screen ( -- n ) bytes/line screen-height * ;
@@ -155,8 +154,8 @@
headerless
: screen-adr ( column# line# -- adr )
- char-height * window-top + ( column# ypixels )
- swap bytes/char * window-left + swap ( xpixels ypixels )
+ char-height * window-top + ( column# ypixels )
+ swap char-width * window-left + pix* swap ( xpixels ypixels )
bytes/line * + frame-buffer-adr +
;
: line-adr ( line# -- adr ) 0 swap screen-adr ;
@@ -260,9 +259,9 @@
;
headers
-: fb-install ( screen-width screen-height #columns #lines bytes/pixel -- )
+: fb-install ( screen-width screen-height #columns #lines bytes/line depth -- )
case
- 1 of
+ 8 of
['] noop to pix*
['] fb8-invert to fb-invert
['] fill to fb-fill
@@ -270,7 +269,7 @@
['] colors-8bpp to fb-16map
endof
- 2 of
+ d# 16 of
['] /w* to pix*
['] fb16-invert to fb-invert
['] wfill to fb-fill
@@ -278,7 +277,7 @@
['] colors-565 to fb-16map
endof
- 4 of
+ d# 32 of
['] /l* to pix*
['] fb32-invert to fb-invert
['] lfill to fb-fill
@@ -291,11 +290,12 @@
true to 16-color?
['] not-dark to light
- \ my-self is display device's ihandle
- screen-#rows min is #lines
- screen-#columns min is #columns
- is screen-height is screen-width
- #columns bytes/char * is emu-bytes/line
+ \ my-self is display device's ihandle ( width height #columns #lines bytes/line )
+ is bytes/line ( width height #columns #lines )
+ screen-#rows min is #lines ( width height #columns )
+ screen-#columns min is #columns ( width height )
+ is screen-height is screen-width ( )
+ #columns bytes/char * is emu-bytes/line ( )
center-display
['] fb8-reset-screen is reset-screen
['] fb8-toggle-cursor is toggle-cursor
@@ -312,4 +312,4 @@
['] fb8-draw-character is draw-character
['] fb8-draw-logo is draw-logo
;
-: fb8-install ( width height #cols #lines -- ) 1 fb-install ;
+: fb8-install ( width height #cols #lines -- ) 3 pick 8 fb-install ;
Modified: ofw/termemu/framebuf.fth
===================================================================
--- ofw/termemu/framebuf.fth 2009-01-03 01:52:19 UTC (rev 1057)
+++ ofw/termemu/framebuf.fth 2009-01-03 23:29:47 UTC (rev 1058)
@@ -64,6 +64,7 @@
0 termemu-value window-left \ Pixel position of left of text area
0 termemu-value emu-bytes/line
+0 termemu-value bytes/line \ Framebuffer pitch
\ Interfaces to device-dependent graphics primitives:
d# 34 termemu-value #lines
More information about the openfirmware
mailing list