scsh-conservatory
/
sunterlib
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

widget X async loop

This commit is contained in:
erana 2012-01-17 14:11:08 +09:00
parent 2cf13f7324
commit 46fc6f37f8
1 changed files with 27 additions and 54 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

77
scsh/scgame/scgamewidgets.scm
View File

@ -150,68 +150,18 @@
(set! height (cadr wh)) (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) (define (draw-pressed-image dpy win gc)
(init-sync-x-events dpy) (init-sync-x-events dpy)
(map-window dpy win) (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 (draw-points dpy win gc (* width height) 0 0
(/ width 2) (/ height 2)) (/ width 2) (/ height 2)))
)
(else #f)))
(loop))))))
;; NOTE : you can remap a button (image) to a new window win if you like ;; NOTE : you can remap a button (image) to a new window win if you like
(define (draw-image dpy win gc) (define (draw-image dpy win gc)
(init-sync-x-events dpy) (init-sync-x-events dpy)
(map-window dpy win) (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 (draw-points dpy win gc (* width height) 0 0
(/ width 2) (/ height 2)) (/ width 2) (/ height 2)))
)
(else #f)))
(loop))))))
(define (draw-points dpy win gc count x y) (define (draw-points dpy win gc count x y)
(if (zero? (modulo count 100)) (if (zero? (modulo count 100))
@ -241,6 +191,29 @@
(release-button dpy win gc) (release-button dpy win gc)
(set! pressed #f)) (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) (lambda (msg)
(cond ((eq? 'set-image) set-image) (cond ((eq? 'set-image) set-image)
((eq? 'set-pressed-image) set-pressed-image) ((eq? 'set-pressed-image) set-pressed-image)