Changeset 2893


Ignore:
Timestamp:
Mar 15, 2012, 12:19:06 AM (3 years ago)
Author:
wmb
Message:

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.

Files:
1 added
9 edited

Legend:

Unmodified
Added
Removed
  • cpu/arm/olpc/build-fw.fth

    r2882 r2893  
    753753\+ olpc-cl3 fload ${BP}/cpu/arm/olpc/exc7200-touchscreen.fth    \ Touchscreen driver and diagnostic
    754754\+ olpc-cl3 fload ${BP}/dev/softkeyboard.fth                    \ On-screen keyboard
    755 \+ olpc-cl3 devalias mouse /touchscreen
    756755\+ olpc-cl2 fload ${BP}/cpu/arm/olpc/rm3150-touchscreen.fth    \ Touchscreen driver and diagnostic
    757756fload ${BP}/cpu/arm/olpc/roller.fth     \ Accelerometer test
  • cpu/arm/olpc/exc7200-touchscreen.fth

    r2789 r2893  
    440 0  " 4,8"  " /twsi" begin-package
    55my-space encode-int  my-address encode-int encode+  " reg" property
    6 " touchscreen" name
    76
    8 0 value screen-w
    9 0 value screen-h
    10 0 instance value invert-x?
    11 0 instance value invert-y?
     7\ XXX these are really platform-related, not touchscreen-related
     8: targets?  ( -- flag )  true  ;  \ Used to be "final-test?"
     9: .tsmsg  ( -- )  0 d# 27 at-xy  ." Touchscreen test.  Hit both targets to exit" cr  ;
    1210
    13 : dimensions  ( -- w h )  screen-w  screen-h  ;
     11fload ${BP}/cpu/arm/olpc/touchscreen-common.fth
    1412
    15 : #contacts  ( -- n )  2  ;
     13h# 7fff to touchscreen-max-x
     14h# 7fff to touchscreen-max-y
    1615
    17 h# 7fff constant touchscreen-max-x
    18 h# 7fff constant touchscreen-max-y
    19 
    20 : invert-x  ( x -- x' )  touchscreen-max-x swap -  ;
    21 : invert-y  ( y -- y' )  touchscreen-max-y swap -  ;
    22 
    23 : scale-x  ( x -- x' )
    24    invert-x?  if  invert-x  then
    25    screen-w touchscreen-max-x */
    26 ;
    27 : scale-y  ( y -- y' )
    28    invert-y?  if  invert-y  then
    29    screen-h touchscreen-max-y */
    30 ;
     162 to #contacts
    3117
    3218\ Try to receive a mouse report packet.  If one arrives within
     
    4430   then                                    ( flags  r: z y x )
    4531
    46    r>  scale-x                             ( flags  x'  r: z y )
    47    r>  scale-y                             ( flags  x y'  r: z )
     32   r> r> scale-xy                          ( flags  x' y'  r: z )
    4833
    4934   r> 3 roll                               ( x y z flags )
     
    5237   true                                    ( x y z down? contact# true )
    5338;
    54 true value absolute?
    5539: stream-poll?  ( -- false | x y buttons true )
    5640   pad?  if               ( x y z down? contact# )
     
    6549;
    6650
    67 h# f800 constant red
    68 h# 07e0 constant green
    69 h# 001f constant blue
    70 h# ffe0 constant yellow
    71 h# f81f constant magenta
    72 h# 07ff constant cyan
    73 h# ffff constant white
    74 h# 0000 constant black
    75 
    76 variable pixcolor
    77 
    78 h# 4 value y-offset
    79 \ 0 value /line
    80 \ 2 value /pixel
    81 
    82 
    83 variable ptr
    84 
    85 \ The following code receives and decodes touchpad packets
    86 
    87 : show-packets  ( adr len -- )
    88    push-hex
    89    bounds  ?do
    90       i 6  bounds  ?do  i c@  3 u.r  loop  cr
    91    6 +loop
    92    pop-base
    93 ;
    94 : last-10  ( -- )
    95    ptr @  load-base -  d# 60  >  if
    96       ptr @  d# 60 -  d# 60
    97    else
    98       load-base  ptr @  over -
    99    then
    100    show-packets
    101 ;
    102 
    10351\ Display raw data from the device, stopping when a key is typed.
    10452: show-pad  ( -- )
     
    10856;
    10957
    110 : button  ( color x -- )
    111    screen-h d# 50 -  d# 200  d# 30  fill-rectangle-noff
    112 ;
    113 d# 300 d# 300 2constant target-wh
    114 : left-target   ( -- x y w h )  0 0  target-wh  ;
    115 : right-target  ( -- x y w h )  screen-w screen-h  target-wh  xy-  target-wh  ;
    116 false value left-hit?
    117 false value right-hit?
    118 : inside?  ( mouse-x,y  x y w h -- flag )
    119    >r >r         ( mouse-x mouse-y  x y  r: h w )
    120    xy-           ( dx dy )
    121    swap r> u<    ( dy x-inside? )
    122    swap r> u<    ( x-inside? y-inside? )
    123    and           ( flag )
    124 ;
    125 
    126 : draw-left-target  ( -- )  green  left-target   fill-rectangle-noff  ;
    127 : draw-right-target ( -- )  red    right-target  fill-rectangle-noff  ;
    128 
    129 : ?hit-target  ( -- )
    130    pixcolor @  cyan =   if  \ touch1              ( x y )
    131       2dup  left-target  inside?  if              ( x y )
    132          yellow left-target  fill-rectangle-noff  ( x y )
    133          true to left-hit?                        ( x y )
    134          exit
    135       then                                        ( x y )
    136    then                                           ( x y )
    137    pixcolor @ yellow =  if  \ touch2              ( x y )
    138       2dup  right-target  inside?  if             ( x y )
    139          yellow right-target  fill-rectangle-noff ( x y )
    140          true to right-hit?                       ( x y )
    141          exit
    142       then                                        ( x y )
    143    then                                           ( x y )
    144 ;
    145 
    146 : targets?  ( -- flag )  true  ;  \ Used to be "final-test?"
    147 
    148 : track-init  ( -- )
    149 \   screen-ih package( bytes/line )package  to /line
    150    load-base ptr !
    151 ;
    152 
    153 : dot  ( x y -- )
    154    swap screen-w 3 - min  swap y-offset + screen-h 3 - min  ( x' y' )
    155    pixcolor @  -rot   3 3                   ( color x y w h )
    156    fill-rectangle-noff                      ( )
    157 ;
    158 
    159 : background  ( -- )
    160    black  0 0  screen-w screen-h  fill-rectangle-noff
    161    targets?  if
    162       false to left-hit?
    163       false to right-hit?
    164       draw-left-target
    165       draw-right-target
    166    else
    167       0 d# 27 at-xy  ." Touchscreen test.  Hit both targets to exit" cr
    168    then
    169 ;
    170 
    171 : setcolor  ( contact# -- )
    172    case
    173       0  of  cyan    endof
    174       1  of  yellow  endof
    175       2  of  magenta endof
    176       3  of  blue    endof
    177       ( default )  white swap
    178    endcase
    179 
    180    pixcolor !         
    181 ;
    182 0 value pressure
    183 
    184 : *3/5  ( n -- n' )  3 5 */  ;
    185 : dimmer  ( color -- color' )
    186    565>rgb rot *3/5 rot *3/5 rot *3/5 rgb>565
    187 ;
    188 
    18958: track  ( x y z down? contact# -- )
    19059   setcolor                       ( x y z down? )
    191    0=  if
    192       pixcolor @  dup dimmer  " replace-color" $call-screen
    193       3drop exit
     60   0=  if                         ( x y z )
     61      3drop  undot  exit          ( -- )
    19462   then                           ( x y z )
    19563   to pressure                    ( x y )
     
    20270
    20371   dot
    204 ;
    205 
    206 : handle-key  ( -- exit? )
    207    key upc  case
    208       [char] P  of
    209          cursor-on
    210          cr last-10
    211          key drop
    212          background
    213          false
    214       endof
    215 
    216       ( key )  true swap
    217    endcase
    218 ;
    219 
    220 false value selftest-failed?  \ Success/failure flag for final test mode
    221 : exit-test?  ( -- flag )
    222    targets?  if                       ( )
    223       \ If the targets have been hit, we exit with successa
    224       left-hit? right-hit? and  if    ( )
    225          false to selftest-failed?    ( )
    226          true                         ( flag )
    227          exit
    228       then                            ( )
    229 
    230       \ Otherwise we give the tester a chance to bail out by typing a key,
    231       \ thus indicating failure
    232       key?  0=  if  false exit  then  ( )
    233       key drop                        ( )
    234       true to selftest-failed?        ( )
    235       true                            ( flag )
    236       exit
    237    then                               ( )
    238 
    239    \ If not final test mode, we only exit via a key - no targets
    240    key?  if  handle-key  else  false  then  ( exit ? )
    24172;
    24273: touchscreen-present?  ( -- flag )
     
    25485   \ Read once to prime the interrupt
    25586   d# 10 " get" $call-parent  4drop 4drop 2drop
    256    " dimensions" $call-screen  to screen-h  to screen-w
    25787
    258    \ The "TI" tag controls the inverson of X and Y axes.
    259    \ If the tag is missing, axes are not inverted.  If present
    260    \ and the value contains either of the letters x or y, the
    261    \ corresponding axis is inverted.  This is primarily for
    262    \ development, using prototype touchscreens.
    263    " TI" find-tag  if     ( adr len )
    264       begin  dup  while   ( adr len )
    265          over c@  upc  [char] x =  if  true to invert-x?  then
    266          over c@  upc  [char] y =  if  true to invert-y?  then
    267          1 /string        ( adr' len' )
    268       repeat              ( adr len )
    269       2drop               ( )
    270    then                   ( )
     88   set-geometry
    27189
    27290   flush
     
    292110   then
    293111
    294    cursor-off  track-init
     112   cursor-off
    295113
    296114   \ Consume already-queued keys to prevent premature exit
     
    313131   targets?  if  selftest-failed?  else  false  then
    314132;
    315 
    316133
    317134end-package
  • cpu/arm/olpc/rm3150-touchscreen.fth

    r2775 r2893  
    440 0  " 4,60"  " /twsi" begin-package
    55my-space encode-int  my-address encode-int encode+  " reg" property
    6 " touchscreen" name
    76
    8 0 value screen-w
    9 0 value screen-h
     7\ XXX these are really platform-related, not touchscreen-related
     8: targets?  ( -- flag )  final-test?  ;
     9: .tsmsg  ( -- )  0 d# 27 at-xy  ." Touchscreen test.  Type a key to exit" cr  ;
     10
     11fload ${BP}/cpu/arm/olpc/touchscreen-common.fth
     12
     13d# 896 to touchscreen-max-x
     14d# 672 to touchscreen-max-y
     15
     16d# 10 to #contacts
    1017
    1118: ts-b!  ( b reg# -- )  " smbus-b!" $call-parent  ;
    1219: ts-b@  ( reg# -- b )  " smbus-b@" $call-parent  ;
    13 
    14 d# 896 constant touchscreen-max-x
    15 d# 672 constant touchscreen-max-y
    1620
    1721: 4b>xy  ( x.hi x.lo  y.hi y.lo -- x y )  swap bwjoin >r  swap bwjoin r>  ;
     
    3640      0 1 ts-b!                    ( okay? )  \ Set to polled mode
    3741   then                            ( okay? )
    38    " dimensions" $call-screen  to screen-h  to screen-w
     42   set-geometry
    3943;
    4044
    41 : dimensions  ( -- w h )  screen-w  screen-h  ;
     45: touched?  ( -- flag )  d# 99 gpio-pin@ 0=  ;
     46: #touches  ( -- n )  h# 10 ts-b@   h# 7f and  ;
    4247
    43 : #contacts  ( -- n )  d# 10  ;
    44 
    45 : pad-events  ( -- n*[ x.hi x.lo y.hi y.lo z ]  #contacts )
    46    d# 99 gpio-pin@  if  false exit  then
    47    h# 10 ts-b@   h# 7f and  >r                        ( r: #contacts )
    48    r@  if                                             ( r: #contacts )
    49       h# 11 1  r@ 5 *  " smbus-out-in" $call-parent   ( n*[ x.hi x.lo y.hi y.lo z ]  r: #contacts )
    50    then                                               ( n*[ x.hi x.lo y.hi y.lo z ]  r: #contacts )
    51    r>                                                 ( n*[ x.hi x.lo y.hi y.lo z ]  #contacts )
     48: pad-events  ( -- n*[ x.hi x.lo y.hi y.lo z ]  #touches )
     49   touched? 0=  if  false exit  then
     50   #touches >r  r@  if                                ( r: #touches )
     51      h# 11 1  r@ 5 *  " smbus-out-in" $call-parent   ( n*[ x.hi x.lo y.hi y.lo z ]  r: #touches )
     52   then                                               ( n*[ x.hi x.lo y.hi y.lo z ]  r: #touches )
     53   r>                                                 ( n*[ x.hi x.lo y.hi y.lo z ]  #touches )
    5254;
    53 
    54 h# f800 constant red
    55 h# 07e0 constant green
    56 h# 001f constant blue
    57 h# ffe0 constant yellow
    58 h# f81f constant magenta
    59 h# 07ff constant cyan
    60 h# ffff constant white
    61 h# 0000 constant black
    62 
    63 variable pixcolor
    64 
    65 h# 4 value y-offset
    66 0 value /line
    67 2 value /pixel
    68 
    69 
    70 variable ptr
    71 
    72 \ The following code receives and decodes touchpad packets
    73 
    74 : show-packets  ( adr len -- )
    75    push-hex
    76    bounds  ?do
    77       i 6  bounds  ?do  i c@  3 u.r  loop  cr
    78    6 +loop
    79    pop-base
    80 ;
    81 : last-10  ( -- )
    82    ptr @  load-base -  d# 60  >  if
    83       ptr @  d# 60 -  d# 60
    84    else
    85       load-base  ptr @  over -
    86    then
    87    show-packets
    88 ;
    89 
    90 : scale-xy  ( x y -- x' y' )
    91    swap screen-w touchscreen-max-x */
    92    swap screen-h touchscreen-max-y */
    93 ;
    94 
    95 0 [if]
    96 \ Try to receive a mouse report packet.  If one arrives within
    97 \ 20 milliseconds, return true and the decoded information.
    98 \ Otherwise return false.
    99 : pad?  ( -- false | x y z down? contact# true )
    100    get-touch?   if            ( x dy buttons )
    101       2>r >r scale-xy r> 2r>  ( x' y' z down? contact# )
    102       true
    103    else
    104       false
    105    then
    106 ;
    107 
    108 : flush  ( -- )  begin  d# 10 ms  pad?  while  2drop 3drop  repeat  ;
    109 
    110 \ Display raw data from the device, stopping when a key is typed.
    111 : show-pad  ( -- )
    112    begin
    113       pad?  if  . . . . . cr  then
    114    key? until
    115 ;
    116 [then]
    11755
    11856: close  ( -- )
     
    12159;
    12260
    123 : button  ( color x -- )
    124    screen-h d# 50 -  d# 200  d# 30  fill-rectangle-noff
    125 ;
    126 d# 300 d# 300 2constant target-wh
    127 : left-target   ( -- x y w h )  0 0  target-wh  ;
    128 : right-target  ( -- x y w h )  screen-w screen-h  target-wh  xy-  target-wh  ;
    129 false value left-hit?
    130 false value right-hit?
    131 : inside?  ( mouse-x,y  x y w h -- flag )
    132    >r >r         ( mouse-x mouse-y  x y  r: h w )
    133    xy-           ( dx dy )
    134    swap r> u<    ( dy x-inside? )
    135    swap r> u<    ( x-inside? y-inside? )
    136    and           ( flag )
    137 ;
    138 
    139 : draw-left-target  ( -- )  green  left-target   fill-rectangle-noff  ;
    140 : draw-right-target ( -- )  red    right-target  fill-rectangle-noff  ;
    141 
    142 : ?hit-target  ( -- )
    143    pixcolor @  cyan =   if  \ touch1              ( x y )
    144       2dup  left-target  inside?  if              ( x y )
    145          yellow left-target  fill-rectangle-noff  ( x y )
    146          true to left-hit?                        ( x y )
    147          exit
    148       then                                        ( x y )
    149    then                                           ( x y )
    150    pixcolor @ yellow =  if  \ touch2              ( x y )
    151       2dup  right-target  inside?  if             ( x y )
    152          yellow right-target  fill-rectangle-noff ( x y )
    153          true to right-hit?                       ( x y )
    154          exit
    155       then                                        ( x y )
    156    then                                           ( x y )
    157 ;
    158 
    159 : track-init  ( -- )
    160    screen-ih package( bytes/line )package  to /line
    161    load-base ptr !
    162 ;
    163 
    164 : dot  ( x y -- )
    165    swap screen-w 3 - min  swap y-offset + screen-h 3 - min  ( x' y' )
    166    pixcolor @  -rot   3 3                   ( color x y w h )
    167    fill-rectangle-noff                      ( )
    168 ;
    169 
    170 : background  ( -- )
    171    black  0 0  screen-w screen-h  fill-rectangle-noff
    172    final-test?  if
    173       false to left-hit?
    174       false to right-hit?
    175       draw-left-target
    176       draw-right-target
    177    else
    178       0 d# 27 at-xy  ." Touchscreen test.  Type a key to exit" cr
    179    then
    180 ;
    181 
    182 : *3/5  ( n -- n' )  3 5 */  ;
    183 : dimmer  ( color -- color' )
    184    565>rgb rot *3/5 rot *3/5 rot *3/5 rgb>565
    185 ;
    186 
    187 : setcolor  ( contact# -- )
    188    case
    189       0  of  cyan    endof
    190       1  of  yellow  endof
    191       2  of  magenta endof
    192       3  of  blue    endof
    193       4  of  red     endof
    194       5  of  green   endof
    195       6  of  cyan    dimmer  endof
    196       7  of  yellow  dimmer  endof
    197       8  of  magenta dimmer  endof
    198       9  of  blue    dimmer  endof
    199   d# 10  of  red     dimmer  endof
    200   d# 11  of  green   dimmer  endof
    201       ( default )  white swap
    202    endcase
    203 
    204    pixcolor !         
    205 ;
    206 0 value pressure
    207 
    208 : track-n  ( .. xhi xlo yhi ylo z  #contacts -- )
    209    ?dup 0=  if  exit  then     ( .. xhi xlo yhi ylo z  #contacts -- )
     61: track-n  ( .. xhi xlo yhi ylo z  #touches -- )
     62   ?dup 0=  if  exit  then     ( .. xhi xlo yhi ylo z  #touches -- )
    21063   1-  0  swap  do             ( .. xhi xlo yhi ylo z )
    21164      i setcolor               ( .. xhi xlo yhi ylo z )
     
    21366      4b>xy  scale-xy          ( .. x y )
    21467
    215       final-test?  if          ( .. x y )
    216          ?hit-target           ( .. x y )
    217       then                     ( .. x y )
     68      targets?  if  ?hit-target   then     ( .. x y )
     69
    21870      dot
    21971   -1 +loop
    22072;
    22173
    222 : handle-key  ( -- exit? )
    223    key upc  case
    224       [char] P  of
    225          cursor-on
    226          cr last-10
    227          key drop
    228          background
    229          false
    230       endof
    231 
    232       ( key )  true swap
    233    endcase
     740 0 2value last-xy
     75false value last-down?
     76: no-touch  ( -- false | x y buttons true )
     77   last-down?  if
     78      \ Return up event for last "mouse" position
     79      false to last-down?
     80      last-xy 0 true
     81   else
     82      false
     83   then
    23484;
    235 
    236 false value selftest-failed?  \ Success/failure flag for final test mode
    237 : exit-test?  ( -- flag )
    238    final-test?  if                    ( )
    239       \ If the targets have been hit, we exit with successa
    240       left-hit? right-hit? and  if    ( )
    241          false to selftest-failed?    ( )
    242          true                         ( flag )
    243          exit
    244       then                            ( )
    245 
    246       \ Otherwise we give the tester a chance to bail out by typing a key,
    247       \ thus indicating failure
    248       key?  0=  if  false exit  then  ( )
    249       key drop                        ( )
    250       true to selftest-failed?        ( )
    251       true                            ( flag )
    252       exit
    253    then                               ( )
    254 
    255    \ If not final test mode, we only exit via a key - no targets
    256    key?  if  handle-key  else  false  then  ( exit ? )
     85: touch  ( -- false | x y buttons true )
     86   #touches  0=  if  false exit  then
     87   h# 11 1 4  " smbus-out-in" $call-parent   ( x.hi x.lo y.hi y.lo )
     88   4b>xy  scale-xy     ( x y )
     89   2dup to last-xy     ( x y )
     90   true to last-down?  ( x y )
     91   1 true              ( x y buttons true )
    25792;
    258 
     93: stream-poll?  ( -- false | x y buttons true )
     94   touched?  if  touch  else  no-touch  then
     95;
    25996: discard-n  ( .. #events -- )   5 *  0  ?do  drop  loop  ;
    26097
     
    273110   then
    274111
    275    cursor-off  track-init
     112   cursor-off
    276113
    277114   \ Consume already-queued keys to prevent premature exit
  • cpu/x86/pc/olpc/via/mfgtest.fth

    r2890 r2893  
    156156
    157157: init-menu  ( -- )
    158    ?open-screen  ?open-mouse
     158   ?open-screen  ?open-mouse  ?open-touchscreen
    159159   #mfgrows to rows
    160160   #mfgcols to cols
  • ofw/gui/dialog.fth

    r2331 r2893  
    201201   ['] selected?  find-node  nip       ( node )
    202202   " next-enum" run-method             ( )
     203;
     204: get-key-code  ( -- c | c 9b )
     205   key  case
     206      \ Distinguish between a bare ESC and an ESC-[ sequence
     207      esc of
     208         d# 10 ms  key?  if
     209            key  [char] [ =  if  key csi  else  esc  then
     210         else
     211            esc
     212         then
     213      endof
     214
     215      csi of  key csi  endof
     216      dup
     217   endcase
    203218;
    204219: controls-key  ( list -- done? )
  • ofw/gui/graphics.fth

    r2755 r2893  
    2323
    2424\needs screen-ih 0 value screen-ih
    25 0 value mouse-ih
    2625
    2726: $call-screen  ( ??? adr len -- ??? )  screen-ih $call-method  ;
     
    5958;
    6059
    61 : get-event  ( #msecs -- false | x y buttons true )
    62    " get-event" mouse-ih $call-method
    63 ;
    64 
    6560: screen-color!  ( r g b color# -- )  " color!" $call-screen  ;
    6661: screen-color@  ( color# -- r g b )  " color@" $call-screen  ;
  • ofw/gui/iconmenu.fth

    r2876 r2893  
    2020\ keyboard input removes mouse cursor and moves mouse to selected square
    2121\ keyboard input (arrows) always moves to an occupied square
    22 
    23 \ need:
    24 \ put text into square
    25 
    26 \ have:
    27 \ fill-rectangle ( color x y w h - )    color is 0..255
    28 \ draw-rectangle ( address x y w h - )  address of 128x128 pixmap
    29 \ read-rectangle ( address x y w h - )
    30 \ move-mouse-cursor ( x y - )
    31 \ remove-mouse-cursor ( - )
    32 \ poll-mouse  ( -- x y buttons )
    33 \ get-event  ( #msecs -- false | x y buttons true )
    3422
    3523hex
     
    425413;
    426414
    427 : do-mouse  ( - )
     415: do-mouse  ( -- )
    428416   mouse-ih 0=  if  exit  then
    429417   begin  mouse-event?  while         ( x y buttons )
    430       remove-mouse-cursor
     418      remove-mouse-cursor             ( x y buttons )
    431419      -rot  update-position           ( buttons )
     420      new-sq?
     421      draw-mouse-cursor
     422   repeat
     423;
     424: do-touchscreen  ( -- )
     425   touchscreen-ih 0=  if  exit  then
     426   begin  touchscreen-event?  while   ( x y buttons )
     427      remove-mouse-cursor             ( x y buttons )
     428      -rot  set-xy                    ( buttons )
    432429      new-sq?
    433430      draw-mouse-cursor
     
    497494 
    498495   false to done?
    499    begin   do-mouse  do-key   done? until
     496   begin   do-touchscreen  do-mouse  do-key   done? until
    500497   false to done?
    501498 
     
    567564\ when a root menu is defined.
    568565headers
     566
    569567\ LICENSE_BEGIN
    570568\ Copyright (c) 2006 FirmWorks
  • ofw/gui/mouse.fth

    r2754 r2893  
    33
    44headerless
     5
     60 value mouse-ih
    57
    68false value mouse-absolute?  \ True if coordinates are absolute
     
    156158: clamp  ( n min max - m )  rot min max  ;
    157159
     160: set-xy  ( x y -- )  to ypos  to xpos  ;
    158161: update-position  ( x y -- )
    159    mouse-absolute?  if  to ypos  to xpos  exit  then
     162   mouse-absolute?  if  set-xy  exit  then
    160163   2dup or 0=  if  2drop exit  then  \ Avoid flicker if there is no movement
    161164
     
    165168   negate  ypos +  0  max-y cursor-h -  clamp      ( x y' )
    166169   swap    xpos +  0  max-x cursor-w -  clamp      ( y' x')
    167    to xpos  to ypos
    168 ;
    169 
    170 : get-key-code  ( -- c | c 9b )
    171    key  case
    172       \ Distinguish between a bare ESC and an ESC-[ sequence
    173       esc of
    174          d# 10 ms  key?  if
    175             key  [char] [ =  if  key csi  else  esc  then
    176          else
    177             esc
    178          then
    179       endof
    180 
    181       csi of  key csi  endof
    182       dup
    183    endcase
    184 ;
     170   swap set-xy
     171;
     172
    185173headers
    186174
     
    214202: mouse-event?  ( -- false | x y buttons true )
    215203   " stream-poll?" mouse-ih $call-method
     204;
     205
     2060 value touchscreen-ih
     207
     2080 value close-touchscreen?
     209
     210: ?close-touchscreen  ( -- )
     211   close-touchscreen?  if
     212      touchscreen-ih close-dev
     213      0 to touchscreen-ih
     214      hardware-cursor?  if
     215         false to hardware-cursor?
     216         " cursor-off" $call-screen
     217      then
     218   then
     219;
     220: ?open-touchscreen  ( -- )
     221   touchscreen-ih  0=  dup to close-touchscreen?  if
     222      " touchscreen" open-dev is touchscreen-ih
     223      touchscreen-ih  0=  if
     224         " /touchscreen" open-dev to touchscreen-ih
     225      then
     226   then
     227;
     228: touchscreen-event?  ( -- false | x y buttons true )
     229   " stream-poll?" touchscreen-ih $call-method
    216230;
    217231
  • ofw/gui/textfld.fth

    r1 r2893  
    116116      then
    117117      mouse-ih  if
    118          begin  10 get-event  while
     118         begin  mouse-event?  while
    119119            remove-mouse-cursor
    120120            -rot update-position
Note: See TracChangeset for help on using the changeset viewer.