Author: wmb Date: Thu Mar 15 00:19:06 2012 New Revision: 2893 URL: http://tracker.coreboot.org/trac/openfirmware/changeset/2893
Log: OLPC XO-1,75 - trac #11695 - Added touchscreen support for graphical menu, factoring out common code in the touchscreen drivers and cleaning up some dead menu code in the process. For the older XO-3 build, the touchscreen could already be used to drive the menu in lieu of the nonexistent touchpad/mouse; now machines with both a touchscreen and a touchpad/mouse can use either interchangeably.
Added: cpu/arm/olpc/touchscreen-common.fth Modified: cpu/arm/olpc/build-fw.fth cpu/arm/olpc/exc7200-touchscreen.fth cpu/arm/olpc/rm3150-touchscreen.fth cpu/x86/pc/olpc/via/mfgtest.fth ofw/gui/dialog.fth ofw/gui/graphics.fth ofw/gui/iconmenu.fth ofw/gui/mouse.fth ofw/gui/textfld.fth
Modified: cpu/arm/olpc/build-fw.fth ============================================================================== --- cpu/arm/olpc/build-fw.fth Tue Mar 13 23:02:15 2012 (r2892) +++ cpu/arm/olpc/build-fw.fth Thu Mar 15 00:19:06 2012 (r2893) @@ -752,7 +752,6 @@ fload ${BP}/cpu/x86/pc/olpc/via/copynand.fth + olpc-cl3 fload ${BP}/cpu/arm/olpc/exc7200-touchscreen.fth \ Touchscreen driver and diagnostic + olpc-cl3 fload ${BP}/dev/softkeyboard.fth \ On-screen keyboard -+ olpc-cl3 devalias mouse /touchscreen + olpc-cl2 fload ${BP}/cpu/arm/olpc/rm3150-touchscreen.fth \ Touchscreen driver and diagnostic fload ${BP}/cpu/arm/olpc/roller.fth \ Accelerometer test
Modified: cpu/arm/olpc/exc7200-touchscreen.fth ============================================================================== --- cpu/arm/olpc/exc7200-touchscreen.fth Tue Mar 13 23:02:15 2012 (r2892) +++ cpu/arm/olpc/exc7200-touchscreen.fth Thu Mar 15 00:19:06 2012 (r2893) @@ -3,31 +3,17 @@
0 0 " 4,8" " /twsi" begin-package my-space encode-int my-address encode-int encode+ " reg" property -" touchscreen" name
-0 value screen-w -0 value screen-h -0 instance value invert-x? -0 instance value invert-y? - -: dimensions ( -- w h ) screen-w screen-h ; - -: #contacts ( -- n ) 2 ; +\ XXX these are really platform-related, not touchscreen-related +: targets? ( -- flag ) true ; \ Used to be "final-test?" +: .tsmsg ( -- ) 0 d# 27 at-xy ." Touchscreen test. Hit both targets to exit" cr ;
-h# 7fff constant touchscreen-max-x -h# 7fff constant touchscreen-max-y +fload ${BP}/cpu/arm/olpc/touchscreen-common.fth
-: invert-x ( x -- x' ) touchscreen-max-x swap - ; -: invert-y ( y -- y' ) touchscreen-max-y swap - ; +h# 7fff to touchscreen-max-x +h# 7fff to touchscreen-max-y
-: scale-x ( x -- x' ) - invert-x? if invert-x then - screen-w touchscreen-max-x */ -; -: scale-y ( y -- y' ) - invert-y? if invert-y then - screen-h touchscreen-max-y */ -; +2 to #contacts
\ Try to receive a mouse report packet. If one arrives within \ 20 milliseconds, return true and the decoded information. @@ -43,15 +29,13 @@ r> r> r> 4drop false exit ( -- false ) then ( flags r: z y x )
- r> scale-x ( flags x' r: z y ) - r> scale-y ( flags x y' r: z ) + r> r> scale-xy ( flags x' y' r: z )
r> 3 roll ( x y z flags ) dup 1 and 0<> ( x y z flags down? ) swap 2 rshift h# 1f and ( x y z down? contact# ) true ( x y z down? contact# true ) ; -true value absolute? : stream-poll? ( -- false | x y buttons true ) pad? if ( x y z down? contact# ) 0= if ( x y z down? ) @@ -64,42 +48,6 @@ then ( false | x y buttons true ) ;
-h# f800 constant red -h# 07e0 constant green -h# 001f constant blue -h# ffe0 constant yellow -h# f81f constant magenta -h# 07ff constant cyan -h# ffff constant white -h# 0000 constant black - -variable pixcolor - -h# 4 value y-offset -\ 0 value /line -\ 2 value /pixel - - -variable ptr - -\ The following code receives and decodes touchpad packets - -: show-packets ( adr len -- ) - push-hex - bounds ?do - i 6 bounds ?do i c@ 3 u.r loop cr - 6 +loop - pop-base -; -: last-10 ( -- ) - ptr @ load-base - d# 60 > if - ptr @ d# 60 - d# 60 - else - load-base ptr @ over - - then - show-packets -; - \ Display raw data from the device, stopping when a key is typed. : show-pad ( -- ) begin @@ -107,90 +55,10 @@ key? until ;
-: button ( color x -- ) - screen-h d# 50 - d# 200 d# 30 fill-rectangle-noff -; -d# 300 d# 300 2constant target-wh -: left-target ( -- x y w h ) 0 0 target-wh ; -: right-target ( -- x y w h ) screen-w screen-h target-wh xy- target-wh ; -false value left-hit? -false value right-hit? -: inside? ( mouse-x,y x y w h -- flag ) - >r >r ( mouse-x mouse-y x y r: h w ) - xy- ( dx dy ) - swap r> u< ( dy x-inside? ) - swap r> u< ( x-inside? y-inside? ) - and ( flag ) -; - -: draw-left-target ( -- ) green left-target fill-rectangle-noff ; -: draw-right-target ( -- ) red right-target fill-rectangle-noff ; - -: ?hit-target ( -- ) - pixcolor @ cyan = if \ touch1 ( x y ) - 2dup left-target inside? if ( x y ) - yellow left-target fill-rectangle-noff ( x y ) - true to left-hit? ( x y ) - exit - then ( x y ) - then ( x y ) - pixcolor @ yellow = if \ touch2 ( x y ) - 2dup right-target inside? if ( x y ) - yellow right-target fill-rectangle-noff ( x y ) - true to right-hit? ( x y ) - exit - then ( x y ) - then ( x y ) -; - -: targets? ( -- flag ) true ; \ Used to be "final-test?" - -: track-init ( -- ) -\ screen-ih package( bytes/line )package to /line - load-base ptr ! -; - -: dot ( x y -- ) - swap screen-w 3 - min swap y-offset + screen-h 3 - min ( x' y' ) - pixcolor @ -rot 3 3 ( color x y w h ) - fill-rectangle-noff ( ) -; - -: background ( -- ) - black 0 0 screen-w screen-h fill-rectangle-noff - targets? if - false to left-hit? - false to right-hit? - draw-left-target - draw-right-target - else - 0 d# 27 at-xy ." Touchscreen test. Hit both targets to exit" cr - then -; - -: setcolor ( contact# -- ) - case - 0 of cyan endof - 1 of yellow endof - 2 of magenta endof - 3 of blue endof - ( default ) white swap - endcase - - pixcolor ! -; -0 value pressure - -: *3/5 ( n -- n' ) 3 5 */ ; -: dimmer ( color -- color' ) - 565>rgb rot *3/5 rot *3/5 rot *3/5 rgb>565 -; - : track ( x y z down? contact# -- ) setcolor ( x y z down? ) - 0= if - pixcolor @ dup dimmer " replace-color" $call-screen - 3drop exit + 0= if ( x y z ) + 3drop undot exit ( -- ) then ( x y z ) to pressure ( x y )
@@ -202,43 +70,6 @@
dot ; - -: handle-key ( -- exit? ) - key upc case - [char] P of - cursor-on - cr last-10 - key drop - background - false - endof - - ( key ) true swap - endcase -; - -false value selftest-failed? \ Success/failure flag for final test mode -: exit-test? ( -- flag ) - targets? if ( ) - \ If the targets have been hit, we exit with successa - left-hit? right-hit? and if ( ) - false to selftest-failed? ( ) - true ( flag ) - exit - then ( ) - - \ Otherwise we give the tester a chance to bail out by typing a key, - \ thus indicating failure - key? 0= if false exit then ( ) - key drop ( ) - true to selftest-failed? ( ) - true ( flag ) - exit - then ( ) - - \ If not final test mode, we only exit via a key - no targets - key? if handle-key else false then ( exit ? ) -; : touchscreen-present? ( -- flag ) d# 10 " get" ['] $call-parent catch if ( x x x ) 3drop false @@ -253,21 +84,8 @@ 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
- \ The "TI" tag controls the inverson of X and Y axes. - \ If the tag is missing, axes are not inverted. If present - \ and the value contains either of the letters x or y, the - \ corresponding axis is inverted. This is primarily for - \ development, using prototype touchscreens. - " TI" find-tag if ( adr len ) - begin dup while ( adr len ) - over c@ upc [char] x = if true to invert-x? then - over c@ upc [char] y = if true to invert-y? then - 1 /string ( adr' len' ) - repeat ( adr len ) - 2drop ( ) - then ( ) + set-geometry
flush ; @@ -291,7 +109,7 @@ d# 4000 ms then
- cursor-off track-init + cursor-off
\ Consume already-queued keys to prevent premature exit begin key? while key drop repeat @@ -313,7 +131,6 @@ targets? if selftest-failed? else false then ;
- end-package
\ LICENSE_BEGIN
Modified: cpu/arm/olpc/rm3150-touchscreen.fth ============================================================================== --- cpu/arm/olpc/rm3150-touchscreen.fth Tue Mar 13 23:02:15 2012 (r2892) +++ cpu/arm/olpc/rm3150-touchscreen.fth Thu Mar 15 00:19:06 2012 (r2893) @@ -3,17 +3,21 @@
0 0 " 4,60" " /twsi" begin-package my-space encode-int my-address encode-int encode+ " reg" property -" touchscreen" name
-0 value screen-w -0 value screen-h +\ XXX these are really platform-related, not touchscreen-related +: targets? ( -- flag ) final-test? ; +: .tsmsg ( -- ) 0 d# 27 at-xy ." Touchscreen test. Type a key to exit" cr ; + +fload ${BP}/cpu/arm/olpc/touchscreen-common.fth + +d# 896 to touchscreen-max-x +d# 672 to touchscreen-max-y + +d# 10 to #contacts
: ts-b! ( b reg# -- ) " smbus-b!" $call-parent ; : ts-b@ ( reg# -- b ) " smbus-b@" $call-parent ;
-d# 896 constant touchscreen-max-x -d# 672 constant touchscreen-max-y - : 4b>xy ( x.hi x.lo y.hi y.lo -- x y ) swap bwjoin >r swap bwjoin r> ;
: touchscreen-present? ( -- flag ) @@ -35,227 +39,60 @@ 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 -; - -: 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 - h# 10 ts-b@ h# 7f and >r ( r: #contacts ) - r@ if ( r: #contacts ) - h# 11 1 r@ 5 * " smbus-out-in" $call-parent ( n*[ x.hi x.lo y.hi y.lo z ] r: #contacts ) - then ( n*[ x.hi x.lo y.hi y.lo z ] r: #contacts ) - r> ( n*[ x.hi x.lo y.hi y.lo z ] #contacts ) -; - -h# f800 constant red -h# 07e0 constant green -h# 001f constant blue -h# ffe0 constant yellow -h# f81f constant magenta -h# 07ff constant cyan -h# ffff constant white -h# 0000 constant black - -variable pixcolor - -h# 4 value y-offset -0 value /line -2 value /pixel - - -variable ptr - -\ The following code receives and decodes touchpad packets - -: show-packets ( adr len -- ) - push-hex - bounds ?do - i 6 bounds ?do i c@ 3 u.r loop cr - 6 +loop - pop-base -; -: last-10 ( -- ) - ptr @ load-base - d# 60 > if - ptr @ d# 60 - d# 60 - else - load-base ptr @ over - - then - show-packets -; - -: scale-xy ( x y -- x' y' ) - swap screen-w touchscreen-max-x */ - swap screen-h touchscreen-max-y */ -; - -0 [if] -\ Try to receive a mouse report packet. If one arrives within -\ 20 milliseconds, return true and the decoded information. -\ Otherwise return false. -: pad? ( -- false | x y z down? contact# true ) - get-touch? if ( x dy buttons ) - 2>r >r scale-xy r> 2r> ( x' y' z down? contact# ) - true - else - false - then + set-geometry ;
-: flush ( -- ) begin d# 10 ms pad? while 2drop 3drop repeat ; +: touched? ( -- flag ) d# 99 gpio-pin@ 0= ; +: #touches ( -- n ) h# 10 ts-b@ h# 7f and ;
-\ Display raw data from the device, stopping when a key is typed. -: show-pad ( -- ) - begin - pad? if . . . . . cr then - key? until +: pad-events ( -- n*[ x.hi x.lo y.hi y.lo z ] #touches ) + touched? 0= if false exit then + #touches >r r@ if ( r: #touches ) + h# 11 1 r@ 5 * " smbus-out-in" $call-parent ( n*[ x.hi x.lo y.hi y.lo z ] r: #touches ) + then ( n*[ x.hi x.lo y.hi y.lo z ] r: #touches ) + r> ( n*[ x.hi x.lo y.hi y.lo z ] #touches ) ; -[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 -; -d# 300 d# 300 2constant target-wh -: left-target ( -- x y w h ) 0 0 target-wh ; -: right-target ( -- x y w h ) screen-w screen-h target-wh xy- target-wh ; -false value left-hit? -false value right-hit? -: inside? ( mouse-x,y x y w h -- flag ) - >r >r ( mouse-x mouse-y x y r: h w ) - xy- ( dx dy ) - swap r> u< ( dy x-inside? ) - swap r> u< ( x-inside? y-inside? ) - and ( flag ) -; - -: draw-left-target ( -- ) green left-target fill-rectangle-noff ; -: draw-right-target ( -- ) red right-target fill-rectangle-noff ; - -: ?hit-target ( -- ) - pixcolor @ cyan = if \ touch1 ( x y ) - 2dup left-target inside? if ( x y ) - yellow left-target fill-rectangle-noff ( x y ) - true to left-hit? ( x y ) - exit - then ( x y ) - then ( x y ) - pixcolor @ yellow = if \ touch2 ( x y ) - 2dup right-target inside? if ( x y ) - yellow right-target fill-rectangle-noff ( x y ) - true to right-hit? ( x y ) - exit - then ( x y ) - then ( x y ) -; - -: track-init ( -- ) - screen-ih package( bytes/line )package to /line - load-base ptr ! -; - -: dot ( x y -- ) - swap screen-w 3 - min swap y-offset + screen-h 3 - min ( x' y' ) - pixcolor @ -rot 3 3 ( color x y w h ) - fill-rectangle-noff ( ) -; - -: background ( -- ) - black 0 0 screen-w screen-h fill-rectangle-noff - final-test? if - false to left-hit? - false to right-hit? - draw-left-target - draw-right-target - else - 0 d# 27 at-xy ." Touchscreen test. Type a key to exit" cr - then -; - -: *3/5 ( n -- n' ) 3 5 */ ; -: dimmer ( color -- color' ) - 565>rgb rot *3/5 rot *3/5 rot *3/5 rgb>565 -; - -: setcolor ( contact# -- ) - case - 0 of cyan endof - 1 of yellow endof - 2 of magenta endof - 3 of blue endof - 4 of red endof - 5 of green endof - 6 of cyan dimmer endof - 7 of yellow dimmer endof - 8 of magenta dimmer endof - 9 of blue dimmer endof - d# 10 of red dimmer endof - d# 11 of green dimmer endof - ( default ) white swap - endcase - - pixcolor ! -; -0 value pressure - -: track-n ( .. xhi xlo yhi ylo z #contacts -- ) - ?dup 0= if exit then ( .. xhi xlo yhi ylo z #contacts -- ) +: track-n ( .. xhi xlo yhi ylo z #touches -- ) + ?dup 0= if exit then ( .. xhi xlo yhi ylo z #touches -- ) 1- 0 swap do ( .. xhi xlo yhi ylo z ) i setcolor ( .. xhi xlo yhi ylo z ) to pressure ( .. xhi xlo yhi ylo ) 4b>xy scale-xy ( .. x y )
- final-test? if ( .. x y ) - ?hit-target ( .. x y ) - then ( .. x y ) + targets? if ?hit-target then ( .. x y ) + dot -1 +loop ;
-: handle-key ( -- exit? ) - key upc case - [char] P of - cursor-on - cr last-10 - key drop - background - false - endof - - ( key ) true swap - endcase +0 0 2value last-xy +false value last-down? +: no-touch ( -- false | x y buttons true ) + last-down? if + \ Return up event for last "mouse" position + false to last-down? + last-xy 0 true + else + false + then ; - -false value selftest-failed? \ Success/failure flag for final test mode -: exit-test? ( -- flag ) - final-test? if ( ) - \ If the targets have been hit, we exit with successa - left-hit? right-hit? and if ( ) - false to selftest-failed? ( ) - true ( flag ) - exit - then ( ) - - \ Otherwise we give the tester a chance to bail out by typing a key, - \ thus indicating failure - key? 0= if false exit then ( ) - key drop ( ) - true to selftest-failed? ( ) - true ( flag ) - exit - then ( ) - - \ If not final test mode, we only exit via a key - no targets - key? if handle-key else false then ( exit ? ) +: touch ( -- false | x y buttons true ) + #touches 0= if false exit then + h# 11 1 4 " smbus-out-in" $call-parent ( x.hi x.lo y.hi y.lo ) + 4b>xy scale-xy ( x y ) + 2dup to last-xy ( x y ) + true to last-down? ( x y ) + 1 true ( x y buttons true ) +; +: stream-poll? ( -- false | x y buttons true ) + touched? if touch else no-touch then ; - : discard-n ( .. #events -- ) 5 * 0 ?do drop loop ;
: selftest ( -- error? ) @@ -272,7 +109,7 @@ d# 4000 ms then
- cursor-off track-init + cursor-off
\ Consume already-queued keys to prevent premature exit begin key? while key drop repeat
Added: cpu/arm/olpc/touchscreen-common.fth ============================================================================== --- /dev/null 00:00:00 1970 (empty, because file is newly added) +++ cpu/arm/olpc/touchscreen-common.fth Thu Mar 15 00:19:06 2012 (r2893) @@ -0,0 +1,195 @@ +\ See license at end of file +purpose: Common code for touchscreen drivers and diags + +" touchscreen" name + +true value absolute? + +0 value touchscreen-max-x +0 value touchscreen-max-y + +0 value screen-w +0 value screen-h + +0 value #contacts + +\ External interface method +: dimensions ( -- w h ) screen-w screen-h ; + +0 instance value invert-x? +0 instance value invert-y? + +: set-geometry ( -- ) + " dimensions" $call-screen to screen-h to screen-w + + \ The "TI" tag controls the inverson of X and Y axes. + \ If the tag is missing, axes are not inverted. If present + \ and the value contains either of the letters x or y, the + \ corresponding axis is inverted. This is primarily for + \ development, using prototype touchscreens. + " TI" find-tag if ( adr len ) + begin dup while ( adr len ) + over c@ upc [char] x = if true to invert-x? then + over c@ upc [char] y = if true to invert-y? then + 1 /string ( adr' len' ) + repeat ( adr len ) + 2drop ( ) + then ( ) +; + +: scale-x ( x -- x' ) + invert-x? if touchscreen-max-x swap - then + screen-w touchscreen-max-x */ +; +: scale-y ( y -- y' ) + invert-y? if touchscreen-max-y swap - then + screen-h touchscreen-max-y */ +; + +: scale-xy ( x y -- x' y' ) swap scale-x swap scale-y ; + + +h# f800 constant red +h# 07e0 constant green +h# 001f constant blue +h# ffe0 constant yellow +h# f81f constant magenta +h# 07ff constant cyan +h# ffff constant white +h# 0000 constant black + +variable pixcolor + +: *3/5 ( n -- n' ) 3 5 */ ; +: dimmer ( color -- color' ) + 565>rgb rot *3/5 rot *3/5 rot *3/5 rgb>565 +; + +h# 4 value y-offset + +: button ( color x -- ) + screen-h d# 50 - d# 200 d# 30 fill-rectangle-noff +; +d# 300 d# 300 2constant target-wh +: left-target ( -- x y w h ) 0 0 target-wh ; +: right-target ( -- x y w h ) screen-w screen-h target-wh xy- target-wh ; +false value left-hit? +false value right-hit? +: inside? ( mouse-x,y x y w h -- flag ) + >r >r ( mouse-x mouse-y x y r: h w ) + xy- ( dx dy ) + swap r> u< ( dy x-inside? ) + swap r> u< ( x-inside? y-inside? ) + and ( flag ) +; + +: draw-left-target ( -- ) green left-target fill-rectangle-noff ; +: draw-right-target ( -- ) red right-target fill-rectangle-noff ; + +: ?hit-target ( -- ) + pixcolor @ cyan = if \ touch1 ( x y ) + 2dup left-target inside? if ( x y ) + yellow left-target fill-rectangle-noff ( x y ) + true to left-hit? ( x y ) + exit + then ( x y ) + then ( x y ) + pixcolor @ yellow = if \ touch2 ( x y ) + 2dup right-target inside? if ( x y ) + yellow right-target fill-rectangle-noff ( x y ) + true to right-hit? ( x y ) + exit + then ( x y ) + then ( x y ) +; + +: dot ( x y -- ) + swap screen-w 3 - min swap y-offset + screen-h 3 - min ( x' y' ) + pixcolor @ -rot 3 3 ( color x y w h ) + fill-rectangle-noff ( ) +; + +: undot ( -- ) pixcolor @ dup dimmer " replace-color" $call-screen ; + +: background ( -- ) + black 0 0 screen-w screen-h fill-rectangle-noff + targets? if + false to left-hit? + false to right-hit? + draw-left-target + draw-right-target + else + .tsmsg + then +; + +: setcolor ( contact# -- ) + case + 0 of cyan endof + 1 of yellow endof + 2 of magenta endof + 3 of blue endof + 4 of red endof + 5 of green endof + 6 of cyan dimmer endof + 7 of yellow dimmer endof + 8 of magenta dimmer endof + 9 of blue dimmer endof + d# 10 of red dimmer endof + d# 11 of green dimmer endof + ( default ) white swap + endcase + + pixcolor ! +; + +: handle-key ( -- exit? ) true ; + +false value selftest-failed? \ Success/failure flag for final test mode +: exit-test? ( -- flag ) + targets? if ( ) + \ If the targets have been hit, we exit with successa + left-hit? right-hit? and if ( ) + false to selftest-failed? ( ) + true ( flag ) + exit + then ( ) + + \ Otherwise we give the tester a chance to bail out by typing a key, + \ thus indicating failure + key? 0= if false exit then ( ) + key drop ( ) + true to selftest-failed? ( ) + true ( flag ) + exit + then ( ) + + \ If not final test mode, we only exit via a key - no targets + key? if handle-key else false then ( exit ? ) +; + +0 value pressure + +\ LICENSE_BEGIN +\ Copyright (c) 2012 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END
Modified: cpu/x86/pc/olpc/via/mfgtest.fth ============================================================================== --- cpu/x86/pc/olpc/via/mfgtest.fth Tue Mar 13 23:02:15 2012 (r2892) +++ cpu/x86/pc/olpc/via/mfgtest.fth Thu Mar 15 00:19:06 2012 (r2893) @@ -155,7 +155,7 @@ : quit-item ( -- ) menu-done ;
: init-menu ( -- ) - ?open-screen ?open-mouse + ?open-screen ?open-mouse ?open-touchscreen #mfgrows to rows #mfgcols to cols d# 180 to sq-size
Modified: ofw/gui/dialog.fth ============================================================================== --- ofw/gui/dialog.fth Tue Mar 13 23:02:15 2012 (r2892) +++ ofw/gui/dialog.fth Thu Mar 15 00:19:06 2012 (r2893) @@ -201,6 +201,21 @@ ['] selected? find-node nip ( node ) " next-enum" run-method ( ) ; +: get-key-code ( -- c | c 9b ) + key case + \ Distinguish between a bare ESC and an ESC-[ sequence + esc of + d# 10 ms key? if + key [char] [ = if key csi else esc then + else + esc + then + endof + + csi of key csi endof + dup + endcase +; : controls-key ( list -- done? ) key? if >r
Modified: ofw/gui/graphics.fth ============================================================================== --- ofw/gui/graphics.fth Tue Mar 13 23:02:15 2012 (r2892) +++ ofw/gui/graphics.fth Thu Mar 15 00:19:06 2012 (r2893) @@ -22,7 +22,6 @@ \ \\\\\\\\
\needs screen-ih 0 value screen-ih -0 value mouse-ih
: $call-screen ( ??? adr len -- ??? ) screen-ih $call-method ; : screen-execute ( ?? xt -- ?? ) screen-ih package( execute )package ; @@ -58,10 +57,6 @@ then ;
-: get-event ( #msecs -- false | x y buttons true ) - " get-event" mouse-ih $call-method -; - : screen-color! ( r g b color# -- ) " color!" $call-screen ; : screen-color@ ( color# -- r g b ) " color@" $call-screen ; : screen-set-colors ( clut color# #colors -- )
Modified: ofw/gui/iconmenu.fth ============================================================================== --- ofw/gui/iconmenu.fth Tue Mar 13 23:02:15 2012 (r2892) +++ ofw/gui/iconmenu.fth Thu Mar 15 00:19:06 2012 (r2893) @@ -20,18 +20,6 @@ \ keyboard input removes mouse cursor and moves mouse to selected square \ keyboard input (arrows) always moves to an occupied square
-\ need: -\ put text into square - -\ have: -\ fill-rectangle ( color x y w h - ) color is 0..255 -\ draw-rectangle ( address x y w h - ) address of 128x128 pixmap -\ read-rectangle ( address x y w h - ) -\ move-mouse-cursor ( x y - ) -\ remove-mouse-cursor ( - ) -\ poll-mouse ( -- x y buttons ) -\ get-event ( #msecs -- false | x y buttons true ) - hex
\ Icon layout parameters @@ -424,15 +412,24 @@ then ( ) ;
-: do-mouse ( - ) +: do-mouse ( -- ) mouse-ih 0= if exit then begin mouse-event? while ( x y buttons ) - remove-mouse-cursor + remove-mouse-cursor ( x y buttons ) -rot update-position ( buttons ) new-sq? draw-mouse-cursor repeat ; +: do-touchscreen ( -- ) + touchscreen-ih 0= if exit then + begin touchscreen-event? while ( x y buttons ) + remove-mouse-cursor ( x y buttons ) + -rot set-xy ( buttons ) + new-sq? + draw-mouse-cursor + repeat +;
headers : centered ( adr y w h -- ) @@ -496,7 +493,7 @@ draw-mouse-cursor
false to done? - begin do-mouse do-key done? until + begin do-touchscreen do-mouse do-key done? until false to done?
remove-mouse-cursor @@ -566,6 +563,7 @@ \ Install menu-or-quit in the "user-interface" defer word later, \ when a root menu is defined. headers + \ LICENSE_BEGIN \ Copyright (c) 2006 FirmWorks \
Modified: ofw/gui/mouse.fth ============================================================================== --- ofw/gui/mouse.fth Tue Mar 13 23:02:15 2012 (r2892) +++ ofw/gui/mouse.fth Thu Mar 15 00:19:06 2012 (r2893) @@ -3,6 +3,8 @@
headerless
+0 value mouse-ih + false value mouse-absolute? \ True if coordinates are absolute
\ Current mouse cursor position @@ -155,8 +157,9 @@
: clamp ( n min max - m ) rot min max ;
+: set-xy ( x y -- ) to ypos to xpos ; : update-position ( x y -- ) - mouse-absolute? if to ypos to xpos exit then + mouse-absolute? if set-xy exit then 2dup or 0= if 2drop exit then \ Avoid flicker if there is no movement
\ Minimize the time the cursor is down by doing computation in advance @@ -164,24 +167,9 @@ \ this optimization is probable unnoticeable, but it doesn't cost much. negate ypos + 0 max-y cursor-h - clamp ( x y' ) swap xpos + 0 max-x cursor-w - clamp ( y' x') - to xpos to ypos + swap set-xy ;
-: get-key-code ( -- c | c 9b ) - key case - \ Distinguish between a bare ESC and an ESC-[ sequence - esc of - d# 10 ms key? if - key [char] [ = if key csi else esc then - else - esc - then - endof - - csi of key csi endof - dup - endcase -; headers
0 value close-mouse? @@ -215,6 +203,32 @@ " stream-poll?" mouse-ih $call-method ;
+0 value touchscreen-ih + +0 value close-touchscreen? + +: ?close-touchscreen ( -- ) + close-touchscreen? if + touchscreen-ih close-dev + 0 to touchscreen-ih + hardware-cursor? if + false to hardware-cursor? + " cursor-off" $call-screen + then + then +; +: ?open-touchscreen ( -- ) + touchscreen-ih 0= dup to close-touchscreen? if + " touchscreen" open-dev is touchscreen-ih + touchscreen-ih 0= if + " /touchscreen" open-dev to touchscreen-ih + then + then +; +: touchscreen-event? ( -- false | x y buttons true ) + " stream-poll?" touchscreen-ih $call-method +; + \ LICENSE_BEGIN \ Copyright (c) 2006 FirmWorks \
Modified: ofw/gui/textfld.fth ============================================================================== --- ofw/gui/textfld.fth Tue Mar 13 23:02:15 2012 (r2892) +++ ofw/gui/textfld.fth Thu Mar 15 00:19:06 2012 (r2893) @@ -115,7 +115,7 @@ (key remove-mouse-cursor exit then mouse-ih if - begin 10 get-event while + begin mouse-event? while remove-mouse-cursor -rot update-position draw-mouse-cursor