From 46fc6f37f81218948d10a452344cf87a759f7b87 Mon Sep 17 00:00:00 2001
From: erana <jceuppen@vub.ac.be>
Date: Tue, 17 Jan 2012 14:11:08 +0900
Subject: [PATCH] widget X async loop

---
 scsh/scgame/scgamewidgets.scm | 81 ++++++++++++-----------------------
 1 file changed, 27 insertions(+), 54 deletions(-)

diff --git a/scsh/scgame/scgamewidgets.scm b/scsh/scgame/scgamewidgets.scm
index 0cdd6d9..f6a7de4 100644
--- a/scsh/scgame/scgamewidgets.scm
+++ b/scsh/scgame/scgamewidgets.scm
@@ -150,68 +150,18 @@
         (set! height (cadr wh))
         ))
 
-    (define (press-button dpy win gc)
-      (init-sync-x-events dpy)
-      (map-window dpy win)
-      (call-with-event-channel
-       dpy win (event-mask button-press)
-       (lambda (channel)
-         (let loop ()
-           (if
-            (let ((e (receive channel)))
-              (cond
-               ((button-press-event? e)
-                (clear-window dpy win)
-                (draw-pressed-image dpy win gc)
-                )
-               ((button-release-event? e)
-                (clear-window dpy win)
-                (draw-image dpy win gc)
-                )
-               (else #f)))
-            (loop))))))
-
-    (define (release-button dpy win gc)
-      (press-button dpy win gc))
-
     (define (draw-pressed-image dpy win gc)
       (init-sync-x-events dpy)
       (map-window dpy win)
-      (call-with-event-channel
-       dpy win (event-mask exposure map)
-       (lambda (channel)
-         (let loop ()
-           (if
-            (let ((e (receive channel)))
-              (cond
-               ((or (expose-event? e)(map-event? e))
-                (clear-window dpy win)
-                (draw-points dpy win gc (* width height) 0 0
-                             (/ width 2) (/ height 2))
-                )
-
-               (else #f)))
-            (loop))))))
+      (draw-points dpy win gc (* width height) 0 0
+                   (/ width 2) (/ height 2)))
 
     ;; NOTE : you can remap a button (image) to a new window win if you like
     (define (draw-image dpy win gc)
       (init-sync-x-events dpy)
       (map-window dpy win)
-      (call-with-event-channel
-       dpy win (event-mask exposure map)
-       (lambda (channel)
-         (let loop ()
-           (if
-            (let ((e (receive channel)))
-              (cond
-               ((or (expose-event? e)(map-event? e))
-                (clear-window dpy win)
-                (draw-points dpy win gc (* width height) 0 0
-                             (/ width 2) (/ height 2))
-                )
-
-               (else #f)))
-            (loop))))))
+      (draw-points dpy win gc (* width height) 0 0
+                   (/ width 2) (/ height 2)))
 
     (define (draw-points dpy win gc count x y)
       (if (zero? (modulo count 100))
@@ -241,6 +191,29 @@
       (release-button dpy win gc)
       (set! pressed #f))
 
+    (init-sync-x-events dpy)
+    (map-window dpy win)
+    (call-with-event-channel
+     dpy win (event-mask button-press)
+     (lambda (channel)
+       (fork-and-forget
+        ;; FIXME calibrate at 10 times or using nanosleep
+        (let loop ()
+          (if
+           (let ((e (receive channel)))
+             (cond
+              ((button-press-event? e)
+               (press!)
+               (draw-pressed-image dpy win gc)
+               )
+              ((button-release-event? e)
+               (release!)
+               (draw-image dpy win gc)
+               )
+              (else #f)))
+           (loop))))))
+
+
     (lambda (msg)
       (cond ((eq? 'set-image) set-image)
             ((eq? 'set-pressed-image) set-pressed-image)