[openfirmware] [commit] r2767 - cpu/arm/olpc cpu/x86/pc/olpc/via dev ofw/gui
repository service
svn at openfirmware.info
Tue Dec 13 03:14:06 CET 2011
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
More information about the openfirmware
mailing list