December 2011 - openfirmware - mail.coreboot.org

[commit] r2775 - cpu/arm/olpc
by repository service Dec. 16, 2011

Dec. 16, 2011

Author: pgf Date: Fri Dec 16 00:03:06 2011 New Revision: 2775 URL: http://tracker.coreboot.org/trac/openfirmware/changeset/2775 Log: fix minor build error in raydium touchscreen driver Modified: cpu/arm/olpc/rm3150-touchscreen.fth Modified: cpu/arm/olpc/rm3150-touchscreen.fth ============================================================================== --- cpu/arm/olpc/rm3150-touchscreen.fth Tue Dec 13 22:45:33 2011 (r2774) +++ cpu/arm/olpc/rm3150-touchscreen.fth Fri Dec 16 00:03:06 2011 (r2775) @@ -5,6 +5,9 @@ my-space encode-int my-address encode-int encode+ " reg" property " touchscreen" name +0 value screen-w +0 value screen-h + : ts-b! ( b reg# -- ) " smbus-b!" $call-parent ; : ts-b@ ( reg# -- b ) " smbus-b@" $call-parent ; @@ -60,8 +63,6 @@ variable pixcolor h# 4 value y-offset -0 value screen-w -0 value screen-h 0 value /line 2 value /pixel

1 0

[commit] r2774 - cpu/arm/olpc
by repository service Dec. 13, 2011

Dec. 13, 2011

Author: wmb Date: Tue Dec 13 22:45:33 2011 New Revision: 2774 URL: http://tracker.coreboot.org/trac/openfirmware/changeset/2774 Log: Checked in dummy.img Added: cpu/arm/olpc/dummy.img Added: cpu/arm/olpc/dummy.img ============================================================================== Files /dev/null 00:00:00 1970 (empty, because file is newly added) and cpu/arm/olpc/dummy.img Tue Dec 13 22:45:33 2011 (r2774) differ

1 0

[commit] r2773 - cpu/arm/olpc/3.0
by repository service Dec. 13, 2011

Dec. 13, 2011

Author: wmb Date: Tue Dec 13 22:37:08 2011 New Revision: 2773 URL: http://tracker.coreboot.org/trac/openfirmware/changeset/2773 Log: Q5A03 Modified: cpu/arm/olpc/3.0/fw-version.fth Modified: cpu/arm/olpc/3.0/fw-version.fth ============================================================================== --- cpu/arm/olpc/3.0/fw-version.fth Tue Dec 13 22:37:03 2011 (r2772) +++ cpu/arm/olpc/3.0/fw-version.fth Tue Dec 13 22:37:08 2011 (r2773) @@ -1,4 +1,5 @@ \ The overall firmware revision macro: FW_PREFIX Q5 macro: FW_MAJOR A -macro: FW_MINOR 02me +macro: FW_MINOR 03 +

1 0

[commit] r2772 - cpu/arm/olpc cpu/x86/pc/olpc/via dev
by repository service Dec. 13, 2011

Dec. 13, 2011

Author: wmb Date: Tue Dec 13 22:37:03 2011 New Revision: 2772 URL: http://tracker.coreboot.org/trac/openfirmware/changeset/2772 Log: OLPC XO-3 - Better management of on-screen keyboard. Fewer/no glitches in transitions from menu to scroller, etc. Modified: cpu/arm/olpc/build-fw.fth cpu/arm/olpc/exc7200-touchscreen.fth cpu/arm/olpc/rm3150-touchscreen.fth cpu/arm/olpc/testitems.fth cpu/x86/pc/olpc/via/mfgtest.fth dev/softkeyboard.fth Modified: cpu/arm/olpc/build-fw.fth ============================================================================== --- cpu/arm/olpc/build-fw.fth Tue Dec 13 22:36:57 2011 (r2771) +++ cpu/arm/olpc/build-fw.fth Tue Dec 13 22:37:03 2011 (r2772) @@ -541,7 +541,6 @@ \ 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/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 @@ : ?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 ( -- ) Modified: cpu/arm/olpc/exc7200-touchscreen.fth ============================================================================== --- cpu/arm/olpc/exc7200-touchscreen.fth Tue Dec 13 22:36:57 2011 (r2771) +++ cpu/arm/olpc/exc7200-touchscreen.fth Tue Dec 13 22:37:03 2011 (r2772) @@ -8,12 +8,9 @@ 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 @@ 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 ; Modified: cpu/arm/olpc/rm3150-touchscreen.fth ============================================================================== --- cpu/arm/olpc/rm3150-touchscreen.fth Tue Dec 13 22:36:57 2011 (r2771) +++ cpu/arm/olpc/rm3150-touchscreen.fth Tue Dec 13 22:37:03 2011 (r2772) @@ -32,10 +32,12 @@ 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 @@ 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 @@ ; [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 @@ ; : track-init ( -- ) - " dimensions" $call-screen to screen-h to screen-w screen-ih package( bytes/line )package to /line load-base ptr ! ; Modified: cpu/arm/olpc/testitems.fth ============================================================================== --- cpu/arm/olpc/testitems.fth Tue Dec 13 22:36:57 2011 (r2771) +++ cpu/arm/olpc/testitems.fth Tue Dec 13 22:37:03 2011 (r2772) @@ -20,6 +20,10 @@ 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 @@ : 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 ; Modified: cpu/x86/pc/olpc/via/mfgtest.fth ============================================================================== --- cpu/x86/pc/olpc/via/mfgtest.fth Tue Dec 13 22:36:57 2011 (r2771) +++ cpu/x86/pc/olpc/via/mfgtest.fth Tue Dec 13 22:37:03 2011 (r2772) @@ -48,7 +48,7 @@ ; : 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 @@ 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 ; Modified: dev/softkeyboard.fth ============================================================================== --- dev/softkeyboard.fth Tue Dec 13 22:36:57 2011 (r2771) +++ dev/softkeyboard.fth Tue Dec 13 22:37:03 2011 (r2772) @@ -487,10 +487,11 @@ : open ( -- okay? ) make-keys draw-keyboard - flush + " flush" $call-parent true ; : close ( -- ) + flush erase-keyboard ;

1 0

[commit] r2771 - dev
by repository service Dec. 13, 2011

Dec. 13, 2011

Author: wmb Date: Tue Dec 13 22:36:57 2011 New Revision: 2771 URL: http://tracker.coreboot.org/trac/openfirmware/changeset/2771 Log: New "touchgrid.fth" package - not used yet. Added: dev/touchgrid.fth Added: dev/touchgrid.fth ============================================================================== --- /dev/null 00:00:00 1970 (empty, because file is newly added) +++ dev/touchgrid.fth Tue Dec 13 22:36:57 2011 (r2771) @@ -0,0 +1,110 @@ +dev /packages +new-device + +" touchgrid" device-name + +0 instance value offset-x +0 instance value offset-y +0 instance value pitch-x +0 instance value pitch-y +0 instance value x-cols +0 instance value y-rows +0 instance value full? + +: full-grid ( x-cols y-rows -- ) + to y-rows to x-cols ( ) + + screen-wh ( w h ) + + dup y-rows / to pitch-y ( w h ) + y-rows pitch-y * - 2/ to offset-y ( w ) + + dup x-cols / to pitch-x ( w ) + x-cols pitch-x * - 2/ to offset-x ( ) + + true to full? ( ) +; +: exact-grid ( offset-x offset-y pitch-x pitch-y x-cols y-rows -- ) + to y-rows to x-cols to pitch-y to pitch-x to offset-y to offset-x + false to full? +; + +: dimensions ( -- w h ) " dimensions" $call-parent ; +: pad? ( -- false | x y z down? contact# true ) " pad?" $call-parent ; + +: hit? ( -- false | x-col y-row down? contact# true ) + pad? 0= if false exit then ( x y z down? contact# ) + rot drop 2>r ( x y r: down? contact# ) + swap offset-x - pitch-x / ( y x-col r: down? contact# ) + swap offset-y - pitch-y / ( x-col y-row r: down? contact# ) + full? if ( x-col y-row r: down? contact# ) + swap 0 max x-cols min ( y-row x-col' r: down? contact# ) + swap 0 max y-rows min ( x-col y-row' r: down? contact# ) + else ( x-col y-row r: down? contact# ) + over 0 x-cols within 0= if ( x-col y-row r: down? contact# ) + 2r> 4drop false exit ( -- false ) + then ( x-col y-row r: down? contact# ) + dup 0 y-rows within 0= if ( x-col y-row r: down? contact# ) + 2r> 4drop false exit ( -- false ) + then ( x-col y-row r: down? contact# ) + then ( x-col y-row r: down? contact# ) + 2r> true +; + +0 instance value down? +: one-hit? ( -- false | x-col y-row true ) + hit? if ( x-col y-row down? contact# ) + if ( x-col y-row down? ) + \ Primary contact + if ( x-col y-row ) + \ Touch event + down? if ( x-col y-row ) + \ Suppress repetition + 2drop false ( false ) + else ( x-col y-row ) + \ Initial touch - return coordinates + true to down? ( x-col y-row ) + true ( x-col y-row true ) + then ( false | x-col y-row true ) + else ( x-col y-row ) + \ Release event + false to down? ( x-col y-row ) + 2drop false ( false ) + then ( false | x-col y-row true ) + else ( x-col y-row down? ) + \ Ignore non-primary contacts + 3drop false ( false ) + then ( false | x-col y-row true ) + else ( ) + false ( false ) + then ( false | x-col y-row true ) +; +: #contacts ( -- n ) " #contacts" $call-parent ; +: open ( -- okay? ) true ; +: close ( -- ) ; + +0 [if] +0 value #contacts +0 value contacts + +: one-hit? ( -- false | x-col y-row true ) + hit? if ( x-col y-row down? contact# ) + contacts na+ ( x-col y-row down? 'contact ) + swap if ( x-col y-row 'contact ) + dup @ if ( x-col y-row 'contact ) + 3drop false ( false ) \ Ignore continued down + else ( x-col y-row 'contact ) + on ( x-col y-row ) + true ( x-col y-row true ) + then ( false | x-col y-row true ) + else ( x-col y-row 'contact ) + off ( x-col y-row ) + 2drop false ( false ) + else ( ) + false ( false ) + then ( false | x-col y-row true ) +; +[then] + +finish-device +device-end

1 0

[commit] r2770 - cpu/arm/olpc/3.0
by repository service Dec. 13, 2011

Dec. 13, 2011

Author: wmb Date: Tue Dec 13 03:14:18 2011 New Revision: 2770 URL: http://tracker.coreboot.org/trac/openfirmware/changeset/2770 Log: OLPC XO-3 - Q5A02me Modified: cpu/arm/olpc/3.0/fw-version.fth Modified: cpu/arm/olpc/3.0/fw-version.fth ============================================================================== --- cpu/arm/olpc/3.0/fw-version.fth Tue Dec 13 03:14:14 2011 (r2769) +++ cpu/arm/olpc/3.0/fw-version.fth Tue Dec 13 03:14:18 2011 (r2770) @@ -1,4 +1,4 @@ \ The overall firmware revision macro: FW_PREFIX Q5 macro: FW_MAJOR A -macro: FW_MINOR 02 +macro: FW_MINOR 02me

1 0

[commit] r2769 - in cpu/arm/olpc: . 3.0
by repository service Dec. 13, 2011

Dec. 13, 2011

Author: wmb Date: Tue Dec 13 03:14:14 2011 New Revision: 2769 URL: http://tracker.coreboot.org/trac/openfirmware/changeset/2769 Log: OLPC XO-3 - LED stuff. Modified: cpu/arm/olpc/3.0/leds.fth cpu/arm/olpc/build-fw.fth Modified: cpu/arm/olpc/3.0/leds.fth ============================================================================== --- cpu/arm/olpc/3.0/leds.fth Tue Dec 13 03:14:10 2011 (r2768) +++ cpu/arm/olpc/3.0/leds.fth Tue Dec 13 03:14:14 2011 (r2769) @@ -10,13 +10,13 @@ : selftest ( -- ) ." Flashing LEDs" cr - d# 10 0 do ols-led-on d# 200 ms ols-led-off d# 200 ms loop - ols-led-ec-control - ols-assy-mode-on +\ d# 10 0 do ols-led-on d# 200 ms ols-led-off d# 200 ms loop +\ ols-led-ec-control +\ ols-assy-mode-on " /wlan:quiet" test-dev " /wlan:quiet" test-dev \ Twice for longer flashing - ols-assy-mode-off +\ ols-assy-mode-off confirm-selftest? ; Modified: cpu/arm/olpc/build-fw.fth ============================================================================== --- cpu/arm/olpc/build-fw.fth Tue Dec 13 03:14:10 2011 (r2768) +++ cpu/arm/olpc/build-fw.fth Tue Dec 13 03:14:14 2011 (r2769) @@ -170,9 +170,16 @@ false constant tethered? \ We only support reprogramming our own FLASH +[ifdef] olpc-cl3 +: hdd-led-off ( -- ) ; +: hdd-led-on ( -- ) ; +: hdd-led-toggle ( -- ) ; +[then] +[ifdef] olpc-cl2 : hdd-led-off ( -- ) d# 10 gpio-clr ; : hdd-led-on ( -- ) d# 10 gpio-set ; : hdd-led-toggle ( -- ) d# 10 gpio-pin@ if hdd-led-off else hdd-led-on then ; +[then] fload ${BP}/cpu/arm/olpc/bbedi.fth fload ${BP}/cpu/arm/olpc/edi.fth

1 0

[commit] r2768 - cpu/arm/olpc
by repository service Dec. 13, 2011

Dec. 13, 2011

Author: wmb Date: Tue Dec 13 03:14:10 2011 New Revision: 2768 URL: http://tracker.coreboot.org/trac/openfirmware/changeset/2768 Log: OLPC XO-3 - reinstate display test (inadvertently omitted from build). Modified: cpu/arm/olpc/build-fw.fth Modified: cpu/arm/olpc/build-fw.fth ============================================================================== --- cpu/arm/olpc/build-fw.fth Tue Dec 13 03:14:06 2011 (r2767) +++ cpu/arm/olpc/build-fw.fth Tue Dec 13 03:14:10 2011 (r2768) @@ -722,8 +722,9 @@ fload ${BP}/dev/logdev.fth -[ifndef] olpc-cl3 fload ${BP}/cpu/x86/pc/olpc/disptest.fth + +[ifndef] olpc-cl3 dev /ap-sp/keyboard fload ${BP}/dev/olpc/keyboard/selftest.fth \ Keyboard diagnostic device-end

1 0

[commit] r2767 - cpu/arm/olpc cpu/x86/pc/olpc/via dev ofw/gui
by repository service Dec. 13, 2011

Dec. 13, 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

1 0

[commit] r2766 - dev
by repository service Dec. 13, 2011

Dec. 13, 2011

Author: wmb Date: Tue Dec 13 03:13:59 2011 New Revision: 2766 URL: http://tracker.coreboot.org/trac/openfirmware/changeset/2766 Log: On-screen keyboard driver - added hotspot driver. Modified: dev/softkeyboard.fth Modified: dev/softkeyboard.fth ============================================================================== --- dev/softkeyboard.fth Tue Dec 13 03:13:56 2011 (r2765) +++ dev/softkeyboard.fth Tue Dec 13 03:13:59 2011 (r2766) @@ -1,6 +1,53 @@ purpose: Interactive keyboard test shows which keys are pressed \ See license at end of file +: bounded? ( n lower size -- flag ) bounds swap within ; + +: inside? ( tx ty x y w h -- flag ) + >r ( tx ty x y w r: h ) + swap >r ( tx ty x w r: h y ) + rot >r ( tx x w r: h y ty ) + bounded? if ( r: h y ty ) + r> r> r> bounded? ( flag ) + else ( r: h y ty ) + r> r> r> 3drop ( ) + false ( flag ) + then ( flag ) +; + +dev /touchscreen +new-device + +" hotspot" device-name +: open ( -- okay? ) true ; +: close ; + +0 0 instance 2value hit-xy +0 0 instance 2value hit-wh +: set-hotspot ( x y w h -- ) to hit-wh to hit-xy ; +: hit? ( -- flag ) + " pad?" $call-parent 0= if ( ) + false exit ( -- false ) + then ( pad-x,y,z down? contact# ) + drop if ( pad-x,y,z ) + drop hit-xy hit-wh inside? ( flag ) + else ( pad-x,y,z ) + 3drop false ( false ) + then ( flag ) +; +: read ( adr len -- actual | -1 ) + 0= if drop -1 exit then ( adr ) + hit? if ( adr ) + carret swap c! 1 ( 1 ) + else ( adr ) + drop -1 ( -1 ) + then ( 1 | -1 ) +; + +finish-device +device-end + + dev /touchscreen new-device @@ -31,7 +78,7 @@ d# 60 constant single-key-h d# 90 constant shift-key-w d# 460 constant space-key-w -d# 340 constant top-row-offset +d# 400 constant top-row-offset d# 34 constant button-w d# 34 constant button-h @@ -99,12 +146,8 @@ : make-keys ( -- ) 0 to #keys - top-key-row -\ " "(1b)" -\ " "(1b)" set-codes -\ make-single-key - next-key-row + top-key-row " ~!@#$%^&*()_+"b" " '1234567890-="b" set-codes d# 13 0 do make-single-key loop @@ -126,7 +169,7 @@ make-shift-key d# 10 0 do make-single-key loop make-shift-key -\ make-single-key \ Omit up arrow for now + make-single-key next-key-row " "(1b) "(878889)" @@ -135,24 +178,11 @@ 2 0 do blank-single-key loop make-space-key 2 0 do blank-single-key loop -\ 3 0 do make-single-key loop \ Omit arrows for now + 3 0 do make-single-key loop \ make-buttons ; -: bounded? ( n lower size -- flag ) bounds swap within ; - -: inside? ( tx ty x y w h -- flag ) - >r ( tx ty x y w r: h ) - swap >r ( tx ty x w r: h y ) - rot >r ( tx x w r: h y ty ) - bounded? if ( r: h y ty ) - r> r> r> bounded? ( flag ) - else ( r: h y ty ) - r> r> r> 3drop ( ) - false ( flag ) - then ( flag ) -; : >key-bounds ( 'key -- x y w h ) >r r@ >key-x w@ r@ >key-y w@ r@ >key-w w@ r> >key-h w@ ; @@ -197,6 +227,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# 0d of " Enter" d# 35 d# 55 r> key-inset type-at-xy endof ( default ) r> drop endcase @@ -326,9 +360,9 @@ else ( adr ascii contact# ) 3drop -1 ( -1 ) then ( 1 | -1 ) - else ( adr ) + else ( adr contact# ) \ No code value, so no need to auto-repeat - drop -1 ( -1 ) + 2drop -1 ( -1 ) then ( 1 | -1 ) ; @@ -385,24 +419,37 @@ release-key ( -1 ) then ( 1 | -1 ) ; + +0 [if] : poller ( -- ) begin here 1 read 0> if here c@ emit then ukey? until ; +[then] + +: erase-keyboard ( color -- ) + kbd-bc 0 top-row-offset ( color x y ) + " dimensions" $call-screen 2over xy- ( color x y w h ) + " fill-rectangle" $call-screen ( ) +; : draw-keyboard ( -- ) kbd-bc fill-screen #keys 0 ?do i key-up loop ; +variable buf +: flush ( -- ) + begin buf 1 read 0< until +; + : open ( -- okay? ) - false exit -\ save-background make-keys draw-keyboard + flush true ; : close ( -- ) -\ restore-background + erase-keyboard ; finish-device

1 0