[openfirmware] r1362 - cpu/x86/pc/olpc
svn at openfirmware.info
svn at openfirmware.info
Fri Sep 18 03:02:27 CEST 2009
Author: wmb
Date: 2009-09-18 03:02:26 +0200 (Fri, 18 Sep 2009)
New Revision: 1362
Modified:
cpu/x86/pc/olpc/disptest.fth
Log:
OLPC display selftest - added additional test patterns, DCON test, and brightness test.
Modified: cpu/x86/pc/olpc/disptest.fth
===================================================================
--- cpu/x86/pc/olpc/disptest.fth 2009-09-14 07:45:46 UTC (rev 1361)
+++ cpu/x86/pc/olpc/disptest.fth 2009-09-18 01:02:26 UTC (rev 1362)
@@ -9,24 +9,30 @@
\ white magenta yellow red green blue cyan black
ffff w, f81f w, ffe0 w, f800 w, 07e0 w, 001f w, 07ff w, 0000 w,
+: fill-rect ( -- ) " fill-rectangle" $call-screen ;
+
+: whole-screen ( -- x y w h ) 0 0 dimensions ;
+
+: black-screen ( -- ) 0 whole-screen fill-rect ;
+
: test-color16 ( n -- color )
test-colors16 swap bar-int / test-colors16-mask and wa+ w@
;
: .horizontal-bars16 ( -- )
dimensions ( width height )
0 ?do ( width )
- i test-color16 0 i 3 pick bar-int " fill-rectangle" $call-screen
+ i test-color16 0 i 3 pick bar-int fill-rect
bar-int +loop drop
;
: .vertical-bars16 ( -- )
dimensions ( width height )
swap 0 ?do ( height )
- i test-color16 i 0 bar-int 4 pick " fill-rectangle" $call-screen
+ i test-color16 i 0 bar-int 4 pick fill-rect
bar-int +loop drop
;
instance variable rn \ Random number
-d# 60,000 constant burnin-time \ 1 minute
+d# 5,000 constant burnin-time \ 5 seconds
: random ( -- n )
rn @ d# 1103515245 * d# 12345 + h# 7FFFFFFF and dup rn !
@@ -68,17 +74,110 @@
drop
;
+0 value xbias
+0 value ybias
+0 value hstripe
+0 value vstripe
+: set-stripes ( -- )
+ width d# 256 / to hstripe
+ height d# 256 / to vstripe
+ width hstripe d# 256 * - to xbias
+ height vstripe d# 256 * - to ybias
+;
+: gvsr ( -- )
+ set-stripes black-screen ( )
+ d# 256 0 do ( )
+ d# 256 0 do ( )
+ i j 0 rgb>565 ( color )
+ hstripe i * xbias + ( color x )
+ vstripe j * ybias + ( color x y )
+ hstripe vstripe ( color x y )
+ fill-rect
+ loop
+ loop
+;
+: gvsb ( -- )
+ set-stripes black-screen ( )
+ d# 256 0 do ( )
+ d# 256 0 do ( )
+ 0 j i rgb>565 ( color )
+ hstripe i * xbias + ( color x )
+ vstripe j * ybias + ( color x y )
+ hstripe vstripe ( color x y )
+ fill-rect
+ loop
+ loop
+;
+: hgradient ( -- )
+ set-stripes black-screen ( )
+ d# 256 0 do ( )
+ i i i rgb>565 ( color )
+ hstripe i * xbias + 0 ( color x y )
+ hstripe height ( color x y sw h )
+ fill-rect ( )
+ loop ( )
+;
+
+: vgradient ( -- )
+ set-stripes black-screen ( )
+ d# 256 0 do ( )
+ i i i rgb>565 ( color )
+ 0 vstripe i * ybias + ( color x y )
+ width vstripe ( color x y w sh )
+ fill-rect ( )
+ loop ( )
+;
+
+
+h# ff h# ff h# ff rgb>565 constant white-color
+
+: hline ( y -- ) >r white-color 0 r> width 1 fill-rect ;
+: vline ( y -- ) >r white-color r> 0 1 height fill-rect ;
+
+: crosshatch ( -- )
+ black-screen
+ height 0 do i hline d# 10 +loop
+ width 0 do i vline d# 10 +loop
+;
+: short-wait ( -- ) d# 500 ms ;
+: brightness-ramp ( -- )
+ 0 h# 0f do i bright! short-wait -1 +loop
+ backlight-off short-wait backlight-on
+ h# f bright!
+;
+
+: red-screen ( -- )
+ load-base whole-screen " read-rectangle" $call-screen
+ h# ff 00 00 rgb>565 whole-screen fill-rect
+ d# 1000 ms
+ load-base whole-screen fill-rect
+;
+: wait ( -- )
+ d# 1000 ms
+ 0 set-source \ Freeze image
+ d# 1000 ms
+ 1 set-source \ Unfreeze image
+ d# 1000 ms
+;
+
warning @ warning off
: selftest ( -- error? )
depth d# 16 <> if false exit then
- .horizontal-bars16
- d# 2000 ms
- .vertical-bars16
- d# 2000 ms
- ." Press a key to stop early." cr
- d# 1000 ms
+ .horizontal-bars16 wait
+ .vertical-bars16 wait
+ gvsr wait
+ gvsb wait
+ hgradient wait
+ vgradient wait
+ crosshatch wait
+ brightness-ramp
+
+ burnin-time d# 5000 > if
+ ." Press a key to stop early." cr
+ d# 1000 ms
+ then
random-selftest
- false
+ confirm-selftest?
;
warning !
More information about the openfirmware
mailing list