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 !