[openfirmware] [commit] r2893 - cpu/arm/olpc cpu/x86/pc/olpc/via ofw/gui
repository service
svn at openfirmware.info
Thu Mar 15 00:19:06 CET 2012
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
More information about the openfirmware
mailing list