Author: wmb Date: Tue Dec 13 03:14:06 2011 New Revision: 2767 URL: http://tracker.coreboot.org/trac/openfirmware/changeset/2767
Log: OLPC XO-3 - integration of touchscreen and menu is getting better, still not perfect.
Modified: cpu/arm/olpc/build-fw.fth cpu/arm/olpc/exc7200-touchscreen.fth cpu/x86/pc/olpc/via/mfgtest.fth dev/softkeyboard.fth ofw/gui/iconmenu.fth
Modified: cpu/arm/olpc/build-fw.fth ============================================================================== --- cpu/arm/olpc/build-fw.fth Tue Dec 13 03:13:59 2011 (r2766) +++ cpu/arm/olpc/build-fw.fth Tue Dec 13 03:14:06 2011 (r2767) @@ -2,6 +2,8 @@ \ See license at end of file
hex +: xrn $report-name my-self . cr ; +\ ' xrn is include-hook \ ' $report-name is include-hook \ ' noop is include-hook
@@ -287,7 +289,7 @@
devalias screen /display
-devalias keyboard /keyboard +- olpc-cl3 devalias keyboard /keyboard
+ olpc-cl2 create 15x30pc " ${BP}/ofw/termemu/15x30pc.psf" $file, + olpc-cl2 ' 15x30pc to romfont @@ -899,6 +901,51 @@ game-key-mask = if protect-fw try-fs-update then ;
+[ifdef] olpc-cl3 +0 value screen-kbd-ih +: open-screen-keyboard ( -- ) + " /touchscreen/keyboard" open-dev to screen-kbd-ih + screen-kbd-ih if + 0 background 0 0 d# 1024 d# 400 set-text-region + screen-kbd-ih add-input + then +; +: close-screen-keyboard ( -- ) + screen-kbd-ih if + screen-kbd-ih remove-input + screen-kbd-ih close-dev + 0 to screen-kbd-ih + then +; +\ ' open-screen-keyboard to scroller-on +\ ' close-screen-keyboard to scroller-off +' close-screen-keyboard to save-scroller +' open-screen-keyboard to restore-scroller + +: (go-hook) ( -- ) + [ ' go-hook behavior compile, ] + close-screen-keyboard +; +' (go-hook) to go-hook + +0 value screen-hot-ih +: open-hotspot ( -- ) + " /touchscreen/hotspot" open-dev to screen-hot-ih + screen-hot-ih if + d# 412 d# 284 d# 200 d# 200 " "(00)" " set-hotspot" screen-hot-ih $call-method + screen-hot-ih add-input + then +; +: close-hotspot ( -- ) + screen-hot-ih if + screen-hot-ih remove-input + screen-hot-ih close-dev + 0 to screen-hot-ih + then +; +: ?text-on ( -- ) key? if text-on visible then ; +[then] + fload ${BP}/cpu/arm/mmp2/clocks.fth
: startup ( -- ) @@ -932,6 +979,7 @@ update-ec-flash then then ++ olpc-cl3 open-hotspot
install-alarm ?sound @@ -939,6 +987,7 @@ ?games
['] false to interrupt-auto-boot? ++ olpc-cl3 ?text-on [ifdef] probe-usb factory-test? if d# 1000 ms then \ Extra USB probe delay in the factory probe-usb @@ -949,6 +998,7 @@
interpreter-init
++ olpc-cl3 ?text-on ?diags ?fs-update
@@ -956,11 +1006,16 @@ unblock-exceptions ['] (interrupt-auto-boot?) to interrupt-auto-boot?
++ olpc-cl3 ?text-on ?usb-keyboard
auto-banner? if banner then
++ olpc-cl3 ?text-on auto-boot ++ olpc-cl3 close-hotspot + ++ olpc-cl3 open-screen-keyboard banner
frozen? text-on? 0= and ( no-banner? ) unfreeze visible cursor-on ( no-banner? ) @@ -993,6 +1048,10 @@ ;
tag-file @ fclose tag-file off +my-self [if] + ." WARNING: my-self is not 0" cr + bye +[then]
.( --- Saving fw.dic ...) " fw.dic" $save-forth cr
Modified: cpu/arm/olpc/exc7200-touchscreen.fth ============================================================================== --- cpu/arm/olpc/exc7200-touchscreen.fth Tue Dec 13 03:13:59 2011 (r2766) +++ cpu/arm/olpc/exc7200-touchscreen.fth Tue Dec 13 03:14:06 2011 (r2767) @@ -14,7 +14,6 @@ d# 10 " get" $call-parent 4drop 4drop 2drop " dimensions" $call-screen to screen-h to screen-w ; -: close ( -- ) ;
h# 7fff constant touchscreen-max-x h# 7fff constant touchscreen-max-y @@ -251,6 +250,8 @@
: flush ( -- ) begin pad? while 2drop 3drop repeat ;
+: close ( -- ) flush ; + : selftest ( -- error? ) open 0= if ." Touchscreen open failed" true exit
Modified: cpu/x86/pc/olpc/via/mfgtest.fth ============================================================================== --- cpu/x86/pc/olpc/via/mfgtest.fth Tue Dec 13 03:13:59 2011 (r2766) +++ cpu/x86/pc/olpc/via/mfgtest.fth Tue Dec 13 03:14:06 2011 (r2767) @@ -13,9 +13,14 @@
: clear-n-restore-scroller ( -- ) blank-screen - restore-scroller + restore-scroller-bg ;
+defer scroller-on +defer scroller-off +' clear-n-restore-scroller to scroller-on +' noop to scroller-off + : sq-border! ( bg -- ) current-sq sq >border ! ;
warning off @@ -36,7 +41,7 @@ mouse-ih if mouse-event? if \ Ignore movement, act only on a button down event - nip nip if wait-buttons-up refresh exit then + nip nip if wait-buttons-up exit then then then again @@ -67,11 +72,11 @@ flush-keyboard mfg-wait-return then - cursor-off gui-alerts refresh + cursor-off scroller-off gui-alerts refresh flush-keyboard ; : mfg-test-dev ( $ -- ) - clear-n-restore-scroller ( $ ) + scroller-on ??cr ." Testing " 2dup type cr ( $ ) 2dup locate-device if ( $ ) ." Can't find device node " type cr exit ( -- ) @@ -83,12 +88,12 @@ ;
: all-tests-passed ( -- ) - restore-scroller + restore-scroller-bg clear-screen ." All automatic tests passed successfully." cr cr cr green-screen wait-return - cursor-off gui-alerts refresh + cursor-off scroller-off gui-alerts refresh flush-keyboard ;
@@ -148,6 +153,7 @@ d# 128 to image-size d# 128 to icon-size cursor-off + scroller-off ;
defer test-menu-items @@ -175,7 +181,7 @@ ['] test-menu-items ['] nest-menu catch drop r> to run-menu false to diag-switch? - restore-scroller + restore-scroller-bg ;
: autorun-from-gamekey ( -- )
Modified: dev/softkeyboard.fth ============================================================================== --- dev/softkeyboard.fth Tue Dec 13 03:13:59 2011 (r2766) +++ dev/softkeyboard.fth Tue Dec 13 03:14:06 2011 (r2767) @@ -24,7 +24,10 @@
0 0 instance 2value hit-xy 0 0 instance 2value hit-wh -: set-hotspot ( x y w h -- ) to hit-wh to hit-xy ; +0 0 instance 2value the$ +0 0 instance 2value returning$ + +: set-hotspot ( x y w h $ -- ) ?save-string to the$ to hit-wh to hit-xy ; : hit? ( -- flag ) " pad?" $call-parent 0= if ( ) false exit ( -- false ) @@ -33,15 +36,32 @@ drop hit-xy hit-wh inside? ( flag ) else ( pad-x,y,z ) 3drop false ( false ) - then ( flag ) + then ( flag ) ; : read ( adr len -- actual | -1 ) 0= if drop -1 exit then ( adr ) + + returning$ dup if ( adr adr1 len1 ) + over c@ -rot ( adr char adr1 len1 ) + 1 /string to returning$ ( adr char ) + swap c! 1 exit ( -- actual ) + else ( adr adr1 len1 ) + 2drop ( adr ) + then ( adr ) + hit? if ( adr ) - carret swap c! 1 ( 1 ) - else ( adr ) - drop -1 ( -1 ) - then ( 1 | -1 ) + the$ to returning$ ( ) + then ( adr ) + + returning$ dup if ( adr adr1 len1 ) + over c@ -rot ( adr char adr1 len1 ) + 1 /string to returning$ ( adr char ) + swap c! 1 exit ( -- actual ) + else ( adr adr1 len1 ) + 2drop ( adr ) + then ( adr ) + + drop -1 ;
finish-device @@ -227,10 +247,10 @@ h# 1b of " Esc" r> string-label endof h# 80 of " Ctrl" r> string-label endof h# 81 of " Shift" r> string-label endof - h# 82 of " Up" r> string-label endof - h# 83 of " Left" r> string-label endof - h# 84 of " Down" r> string-label endof - h# 85 of " Right" r> string-label endof + h# 86 of " Up" r> string-label endof + h# 87 of " Left" r> string-label endof + h# 88 of " Down" r> string-label endof + h# 89 of " Right" r> string-label endof h# 0d of " Enter" d# 35 d# 55 r> key-inset type-at-xy endof ( default ) r> drop endcase @@ -263,32 +283,47 @@ then ;
+0 0 instance 2value returning$ +1 instance buffer: the-char +: return-string ( adr len -- ) to returning$ ; +: return-char ( ascii -- ) + the-char c! the-char 1 return-string +; + 0 value ctrl? 0 value shift?
-: get-ascii? ( key# -- false | ascii true ) - key-adr ( 'key ) +: return-key# ( key# -- ) + key-adr ( 'key ) shift? if >key-code2 else >key-code1 then c@ ( code )
- dup h# 80 >= if ( code ) + dup h# 80 >= if ( code ) case h# 80 of true to ctrl? endof h# 81 of true to shift? endof + h# 82 of " "(1b)[A" return-string endof \ Up + h# 83 of " "(1b)[D" return-string endof \ Left + h# 84 of " "(1b)[B" return-string endof \ Down + h# 85 of " "(1b)[C" return-string endof \ Right + h# 86 of " "(1b)[5~" return-string endof \ PgUp + h# 87 of " "(1b)[1~" return-string endof \ Home + h# 88 of " "(1b)[6~" return-string endof \ PgDn + h# 89 of " "(1b)[4~" return-string endof \ End \ Rest are reserved endcase - false exit ( -- false ) + exit ( -- ) then ( code )
ctrl? if ( code ) dup h# 40 h# 7f between if ( code ) - h# 1f and true ( ascii true ) + h# 1f and return-char ( ) else ( code ) - drop false ( false ) - then ( false | ascii true ) - exit ( -- false | ascii true ) + drop ( ) + then ( ) + exit then ( code )
- true + return-char ( ) ; : cancel-shifts ( key# -- ) key-adr >key-code1 c@ ( code ) @@ -337,87 +372,94 @@ : get-repeat ( contact# -- time ) >contact >contact-time @ ;
\ Records the contact and returns the key code if there is one -: return-key-code ( adr contact# key# -- -1 | 1 ) - over long set-repeat ( adr contact# key# ) \ Set repeat time - tuck set-contact-key# ( adr key# ) \ Remember key - get-ascii? if ( adr ascii ) - swap c! 1 ( 1 ) - else ( adr ) - \ There was no ASCII code - probably it was ctrl or shift - - \ so nothing to return. - drop -1 ( -1 ) - then ( 1 | -1 ) +: return-key-code ( contact# key# -- ) + over long set-repeat ( contact# key# ) \ Set repeat time + tuck set-contact-key# ( key# ) \ Remember key + return-key# ( ) ;
\ Called when a finger is still down in the same key area as before. \ Repeats the key code when the time is right. -: ?repeated ( adr contact# key# -- ) - get-ascii? if ( adr contact# ascii ) - swap dup get-repeat ( adr ascii contact# time ) - get-msecs - 0<= if ( adr ascii contact# ) - short set-repeat ( adr ascii ) - swap c! 1 ( 1 ) - else ( adr ascii contact# ) - 3drop -1 ( -1 ) - then ( 1 | -1 ) - else ( adr contact# ) - \ No code value, so no need to auto-repeat - 2drop -1 ( -1 ) - then ( 1 | -1 ) +: ?repeated ( contact# key# -- ) + swap dup get-repeat ( key# contact# time ) + get-msecs - 0<= if ( key# contact# ) + short set-repeat ( key# ) + return-key# ( ) + else ( key# contact# ) + 2drop ( ) + then ( ) ;
-: press-key ( adr x y contact# -- 1 | -1 ) - -rot find-key? if ( adr contact# key# ) +: press-key ( x y contact# -- ) + -rot find-key? if ( contact# key# ) \ The event happened in a key area - over get-contact-key#? if ( adr contact# key# old-key# ) + over get-contact-key#? if ( contact# key# old-key# ) \ Continued press - 2dup = if ( adr contact# key# old-key# ) + 2dup = if ( contact# key# old-key# ) \ Same - check for auto-repeat - drop ( adr contact# key# ) - ?repeated ( -1 | 1 ) - else ( adr contact# key# old-key# ) + drop ( contact# key# ) + ?repeated ( ) + else ( contact# key# old-key# ) \ Different - release old key and activate new one - key-up ( adr contact# key# ) - dup key-down ( adr contact# key# ) - return-key-code ( -1 | 1 ) - then ( -1 | 1 ) - else ( adr contact# key# ) + key-up ( contact# key# ) + dup key-down ( contact# key# ) + return-key-code ( ) + then ( ) + else ( contact# key# ) \ New keypress - dup key-down ( adr contact# key# ) - return-key-code ( 1 ) + dup key-down ( contact# key# ) + return-key-code ( ) then - else ( adr contact# ) + else ( contact# ) \ The event happened outside a key area - dup get-contact-key#? if ( adr contact# old-key# ) + dup get-contact-key#? if ( contact# old-key# ) \ Moved out of key area - release key - key-up ( adr contact# ) - cancel-contact ( adr ) - drop -1 ( -1 ) - else ( adr contact# ) + key-up ( contact# ) + cancel-contact ( ) + else ( contact# ) \ Press in blank area with nothing down - 2drop -1 ( -1 ) - then ( -1 ) - then ( 1 | -1 ) + drop ( ) + then ( ) + then ( ) ;
-: release-key ( adr x y contact# -- -1 ) - dup get-contact-key#? if ( adr x y contact# key# ) - key-up ( adr x y contact# ) - then ( adr x y contact# ) - cancel-contact ( adr x y ) - 3drop -1 ( -1 ) +: release-key ( x y contact# -- ) + dup get-contact-key#? if ( x y contact# key# ) + key-up ( x y contact# ) + then ( x y contact# ) + cancel-contact ( x y ) + 2drop ( ) ;
: read ( adr len -- actual | -1) 0= if drop -1 exit then ( adr ) + + returning$ dup if ( adr adr1 len1 ) + over c@ -rot ( adr char adr1 len1 ) + 1 /string to returning$ ( adr char ) + swap c! 1 exit ( -- actual ) + else ( adr adr1 len1 ) + 2drop ( adr ) + then ( adr ) + " pad?" $call-parent 0= if ( adr ) drop -1 exit ( -- -1 ) then ( adr x y z down? contact# ) rot drop swap if ( adr x y contact# ) - press-key ( 1 | -1 ) + press-key ( adr ) else ( adr x y contact# ) - release-key ( -1 ) - then ( 1 | -1 ) + release-key ( adr ) + then ( adr ) + + returning$ dup if ( adr adr1 len1 ) + over c@ -rot ( adr char adr1 len1 ) + 1 /string to returning$ ( adr char ) + swap c! 1 exit ( -- actual ) + else ( adr adr1 len1 ) + 2drop ( adr ) + then ( adr ) + + drop -1 ;
0 [if]
Modified: ofw/gui/iconmenu.fth ============================================================================== --- ofw/gui/iconmenu.fth Tue Dec 13 03:13:59 2011 (r2766) +++ ofw/gui/iconmenu.fth Tue Dec 13 03:14:06 2011 (r2767) @@ -298,6 +298,8 @@ : restore-scroller-bg ( -- ) 0 background (restore-scroller) ; : restore-scroller-white ( -- ) 0 f (restore-scroller) ; headers +defer save-scroller ' noop to save-scroller + defer restore-scroller ' restore-scroller-bg to restore-scroller
@@ -505,6 +507,7 @@ ?open-screen set-menu-colors ; : setup-menu ( -- ) + save-scroller setup-graphics \ ?open-mouse cursor-off