OLPC XO-3 - Better management of on-screen keyboard. Fewer/no glitches in transitions from menu to scroller, etc.

git-svn-id: svn://coreboot.org/openfirmware@2772 1552c027-8020-0410-b4b5-a757f869b4ce
This commit is contained in:
Mitch Bradley 2011-12-13 21:37:03 +00:00
parent 68549a92a1
commit d9ab242dab
6 changed files with 50 additions and 23 deletions

View File

@ -541,7 +541,6 @@ warning !
\ so exiting from emacs doesn't invoke the diag menu.
' quit to user-interface
fload ${BP}/cpu/x86/pc/olpc/via/mfgtest.fth
fload ${BP}/cpu/arm/olpc/testitems.fth
[ifdef] notyet
fload ${BP}/cpu/x86/pc/olpc/via/bootmenu.fth
@ -619,8 +618,6 @@ fload ${BP}/cpu/arm/olpc/help.fth
fload ${BP}/cpu/x86/pc/olpc/gui.fth
fload ${BP}/cpu/x86/pc/olpc/strokes.fth
fload ${BP}/cpu/x86/pc/olpc/plot.fth
\+ olpc-cl3 fload ${BP}/cpu/arm/olpc/3.0/testinstructions.fth
\+ olpc-cl2 fload ${BP}/cpu/arm/olpc/1.75/testinstructions.fth
fload ${BP}/cpu/arm/mmp2/dramrecal.fth
@ -954,6 +951,10 @@ dev /client-services patch noop visible enter dend
: ?text-on ( -- ) key? if text-on visible then ;
[then]
fload ${BP}/cpu/arm/olpc/testitems.fth
\+ olpc-cl3 fload ${BP}/cpu/arm/olpc/3.0/testinstructions.fth
\+ olpc-cl2 fload ${BP}/cpu/arm/olpc/1.75/testinstructions.fth
fload ${BP}/cpu/arm/mmp2/clocks.fth
: startup ( -- )

View File

@ -8,12 +8,9 @@ my-space encode-int my-address encode-int encode+ " reg" property
0 value screen-w
0 value screen-h
: open ( -- okay? )
my-unit " set-address" $call-parent true
\ Read once to prime the interrupt
d# 10 " get" $call-parent 4drop 4drop 2drop
" dimensions" $call-screen to screen-h to screen-w
;
: dimensions ( -- w h ) screen-w screen-h ;
: #contacts ( -- n ) 2 ;
h# 7fff constant touchscreen-max-x
h# 7fff constant touchscreen-max-y
@ -248,7 +245,15 @@ false value selftest-failed? \ Success/failure flag for final test mode
then
;
: flush ( -- ) begin pad? while 2drop 3drop repeat ;
: flush ( -- ) begin d# 10 ms pad? while 2drop 3drop repeat ;
: open ( -- okay? )
my-unit " set-address" $call-parent true
\ Read once to prime the interrupt
d# 10 " get" $call-parent 4drop 4drop 2drop
" dimensions" $call-screen to screen-h to screen-w
flush
;
: close ( -- ) flush ;

View File

@ -32,10 +32,12 @@ d# 672 constant touchscreen-max-y
touchscreen-present? dup if ( okay? )
0 1 ts-b! ( okay? ) \ Set to polled mode
then ( okay? )
" dimensions" $call-screen to screen-h to screen-w
;
: close ( -- )
h# 82 1 ts-b! \ Restore default interrupt mode
;
: dimensions ( -- w h ) screen-w screen-h ;
: #contacts ( -- n ) d# 10 ;
: pad-events ( -- n*[ x.hi x.lo y.hi y.lo z ] #contacts )
d# 99 gpio-pin@ if false exit then
@ -102,6 +104,8 @@ variable ptr
then
;
: flush ( -- ) begin d# 10 ms pad? while 2drop 3drop repeat ;
\ Display raw data from the device, stopping when a key is typed.
: show-pad ( -- )
begin
@ -110,6 +114,11 @@ variable ptr
;
[then]
: close ( -- )
\ flush
h# 82 1 ts-b! \ Restore default interrupt mode
;
: button ( color x -- )
screen-h d# 50 - d# 200 d# 30 fill-rectangle-noff
;
@ -147,7 +156,6 @@ false value right-hit?
;
: track-init ( -- )
" dimensions" $call-screen to screen-h to screen-w
screen-ih package( bytes/line )package to /line
load-base ptr !
;

View File

@ -20,6 +20,10 @@ d# 15 to #mfgtests
d# 5 to #mfgcols
d# 4 to #mfgrows
\+ olpc-cl3 : screen-kbd-scroller ( -- ) blank-screen open-screen-keyboard ;
\+ olpc-cl3 ' screen-kbd-scroller to scroller-on
\+ olpc-cl3 ' close-screen-keyboard to scroller-off
: cpu-item ( -- ) " /cpu" mfg-test-dev ;
: battery-item ( -- ) " /battery" mfg-test-dev ;
: spiflash-item ( -- ) " /flash" mfg-test-dev ;
@ -30,14 +34,14 @@ d# 4 to #mfgrows
: int-sd-item ( -- ) " int:0" mfg-test-dev ;
\- olpc-cl3 : ext-sd-item ( -- ) " ext:0" mfg-test-dev ;
: rtc-item ( -- ) " /rtc" mfg-test-dev ;
: display-item ( -- ) " /display" mfg-test-dev ;
: display-item ( -- ) " /display" gfx-test-dev ;
: audio-item ( -- ) " /audio" mfg-test-dev ;
: camera-item ( -- ) " /camera" mfg-test-dev ;
: camera-item ( -- ) " /camera" gfx-test-dev ;
: wlan-item ( -- ) " /wlan" mfg-test-dev ;
: timer-item ( -- ) " /timer" mfg-test-dev ;
\- olpc-cl3 : touchpad-item ( -- ) " /touchpad" mfg-test-dev ;
\+ olpc-cl3 : touchscreen-item ( -- ) " /touchscreen" mfg-test-dev ;
\- olpc-cl3 : keyboard-item ( -- ) " keyboard" mfg-test-dev ;
\+ olpc-cl3 : touchscreen-item ( -- ) " /touchscreen" gfx-test-dev ;
\- olpc-cl3 : keyboard-item ( -- ) " keyboard" gfx-test-dev ;
: switch-item ( -- ) " /accelerometer" mfg-test-dev " /switches" mfg-test-dev ;
: leds-item ( -- ) " /leds" mfg-test-dev ;

View File

@ -48,7 +48,7 @@ warning on
;
: mfg-test-result ( error? -- )
if ( return-code )
if ( return-code )
?dup if ( return-code )
??cr ." Selftest failed. Return code = " .d cr
mfg-color-red sq-border!
@ -75,15 +75,23 @@ if ( return-code )
cursor-off scroller-off gui-alerts refresh
flush-keyboard
;
: mfg-test-dev ( $ -- )
scroller-on
??cr ." Testing " 2dup type cr ( $ )
: (mfg-test-dev) ( $ -- error? )
2dup locate-device if ( $ )
." Can't find device node " type cr exit ( -- )
else ( $ phandle )
drop ( $ )
then ( $ )
" selftest" execute-device-method ( error? )
;
: mfg-test-dev ( $ -- )
scroller-on
??cr ." Testing " 2dup type cr ( $ )
(mfg-test-dev)
mfg-test-result
;
: gfx-test-dev ( $ -- )
(mfg-test-dev)
scroller-on
mfg-test-result
;

View File

@ -487,10 +487,11 @@ variable buf
: open ( -- okay? )
make-keys
draw-keyboard
flush
" flush" $call-parent
true
;
: close ( -- )
flush
erase-keyboard
;