mirror of
https://github.com/openbios/openfirmware.git
synced 2025-05-09 00:21:49 +08:00
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:
parent
68549a92a1
commit
d9ab242dab
@ -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 ( -- )
|
||||
|
@ -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 ;
|
||||
|
||||
|
@ -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 !
|
||||
;
|
||||
|
@ -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 ;
|
||||
|
||||
|
@ -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
|
||||
;
|
||||
|
||||
|
@ -487,10 +487,11 @@ variable buf
|
||||
: open ( -- okay? )
|
||||
make-keys
|
||||
draw-keyboard
|
||||
flush
|
||||
" flush" $call-parent
|
||||
true
|
||||
;
|
||||
: close ( -- )
|
||||
flush
|
||||
erase-keyboard
|
||||
;
|
||||
|
||||
|
Loading…
x
Reference in New Issue
Block a user