r993 - dev

Author: wmb
Date: 2008-11-04 01:57:29 +0100 (Tue, 04 Nov 2008)
New Revision: 993

Modified:
   dev/ps2mouse.fth
Log:
Added "stream-poll?" and "adaptive-poll?" mouse methods so that
client programs can track the mouse efficiently.

Modified: dev/ps2mouse.fth
===================================================================
--- dev/ps2mouse.fth	2008-11-03 17:32:11 UTC (rev 992)
+++ dev/ps2mouse.fth	2008-11-04 00:57:29 UTC (rev 993)
@@ -66,7 +66,7 @@
 : mouse2:1       h# e7 cmd  ;
 : stream-on      h# f4 cmd  ;
 : stream-off     h# f5 cmd  ;
-: stream-mode    h# ea cmd  ;
+: stream-mode    h# ea cmd  stream-on  ;

\ The Apex concentrator refuses to send motion and button events
 \ unless stream data is enabled!
@@ -104,7 +104,7 @@
 ;
 [then]

-\ Translate RML to RML
+\ Translate MRL to RML
 create buttons  0 c,  1 c,  4 c,  5 c,  2 c,  3 c,  6 c,  7 c,

\ create Mitsumi	\ Comment out this line if you don't support Mitsumi mouse
@@ -128,7 +128,123 @@
 : clear-queue  ( -- )  begin  get-data?  while  drop  repeat  ;
 : no-event  ( -- 0 0 0 )  clear-queue  0 0 0  ;

+0 instance value mouse-byte#
+instance variable mouse-bytes
+0 instance value mouse-timestamp
+2 instance value poll-delay
+
+: save-byte  ( byte -- )
+   mouse-bytes @  8 lshift or  mouse-bytes !  ( )
+   mouse-byte# 1+ to mouse-byte#              ( )
+   get-msecs to mouse-timestamp
+   2 to poll-delay
+;
+: out-of-packet  ( -- )
+   0 to mouse-byte#
+   0 to mouse-timestamp
+;
+
+: stream-event  ( byte -- false | x y buttons true )
+   mouse-byte#  case                          ( byte )
+      0  of
+         \ Discard if framing error
+         dup 8 and  if  save-byte  else  drop  then  ( )
+         false exit
+      endof
+
+      1  of  save-byte  false exit  then
+   endcase                                    ( byte3 )
+
+   \ Fall through if already have 2 mouse bytes (this is the third)
+   out-of-packet
+
+   mouse-bytes @ wbsplit  ( byte3-ylow byte2-xlow byte1-stat )
+
+   dup 7 and buttons + c@ >r              ( ylow xlow stat )
+   swap   over h# 10 ?negative  -rot      ( x ylow stat )
+   h# 20 ?negative r>                     ( x y buttons )
+
+   true exit
+;
+
+\ Time-based resynchronization.  If we are in the middle of a packet,
+\ but we poll and see no bytes and the interval since the last byte
+\ was longer than the possible time between bytes within a packet,
+\ we discard the queued-up bytes.
+: ?reframe  ( -- )
+   mouse-byte#  if
+      \ We don't trust time intervals <= ms/tick because the timestamp
+      \ could have happened just before a tick and the next sample
+      \ right after a tick, so the actual elapsed time could be almost
+      \ zero, but the reported time difference would be ms/tick .
+      get-msecs mouse-timestamp - ms/tick - 0 max  d# 5  >  if
+         out-of-packet
+       then
+   then
+;
 headers
+
+: stream-poll?  ( -- false | x y buttons true )
+   begin  get-data?  while     ( byte )
+      \ If we have a packet, retry soon because there is likely to be another
+      \ right on its heels.  The packet generation rate is 100/sec, but some
+      \ could be queued up, so we don't wait a full 10 ms
+      stream-event  ?dup  if  exit  then
+   repeat                      ( )
+
+   ?reframe
+   false
+;
+
+\ delay-ms is a suggested delay until the next poll.  It tells you when
+\ a call to stream-poll? is likely to have something worthwhile to do.
+\ In the middle of an incoming mouse packet, delay-ms will be a couple of
+\ milliseconds, a bit longer than the interval between successive PS/2 bytes.
+\ Just after receiving a packet, it will be a bit more than 10 mS, since
+\ another packet is likely to follow (the standard mouse packet rate is
+\ 100 packets/second).  When idle, the delay is 56 milliseconds, just
+\ longer than a worst-case PC tick interval, but short enough that a
+\ human won't notice a delay.
+\ This strikes a good balance between responsive, accurate mouse tracking
+\ and minimal polling overhead.
+
+: adaptive-poll?  ( -- false delay-ms | x y buttons true delay-ms )
+   begin  get-data?  while     ( byte )
+      \ If we have a packet, retry soon because there is likely to be another
+      \ right on its heels.  The packet generation rate is 100/sec, but some
+      \ could be queued up, so we don't wait a full 10 ms
+      stream-event  ?dup  if  poll-delay  exit  then
+   repeat                      ( )
+
+   ?reframe
+   false  poll-delay                 ( false delay-ms )
+
+   dup 2 = if  9  else  d# 32  then  to poll-delay  ( false delay-ms )
+;
+0 [if]
+: adaptive-track  ( -- )
+   stream-mode
+   begin
+      adaptive-poll?  >r  if   ( x y stat r: next-poll )
+         (cr . 4 .r 4 .r     ( r: next-poll )
+      then                   ( r: next-poll )
+      r> ms                  ( )
+   key? until                ( )
+   stream-off
+;
+: stream-track  ( -- )
+   stream-mode
+   begin
+      stream-poll?  if       ( x y stat )
+         (cr . 4 .r 4 .r     ( )
+      then                   ( )
+      5 ms                   ( )
+   key? until                ( )
+   stream-off
+;
+
+[then]
+
 : poll  ( -- x y buttons )
    clear-queue