[openfirmware] r1362 - cpu/x86/pc/olpc

[svn at openfirmware.info]

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 !