widget-tree sync eventloop - 2

This commit is contained in:
erana 2012-01-17 15:44:45 +09:00
parent 85fb2c868b
commit 1e372d54ee
1 changed files with 54 additions and 33 deletions

View File

@ -1,4 +1,5 @@
;;; scgamewidgets.scm - a scheme game library (needs scx-0.2 or scheme48-fb) ;;; scgamewidgets.scm - a scheme game library widgets
;; (needs scx-0.2 or scheme48-fb)
;;; ;;;
;;; Copyright (c) 2011-2012 Johan Ceuppens ;;; Copyright (c) 2011-2012 Johan Ceuppens
;;; ;;;
@ -85,6 +86,21 @@
#t)) #t))
#f)) #f))
(define (draw-widget-tree widget-tree)
(define (frec l)
(cond ((null? l) #f)
((list? (car l))
(frec (car l)))
((widget? (car l))
(((car l) 'draw)))
(else (frec (cdr l)))))
(if (widget-node? node)
(for-each frec (force node))
#f))
;; widgets ;; widgets
(define (make-scgame-widget) (define (make-scgame-widget)
@ -210,36 +226,41 @@
;; This is the main loop you call on your window's ;; This is the main loop you call on your window's
;; widget tree (see above) ;; widget tree (see above)
(define (widget-tree-eventloop dpy win widget-tree) (define (widget-tree-eventloop dpy win tree)
(let ((mousex 0) (let ((mousex 0))
(mousey 0)) (let ((mousey 0))
(init-sync-x-events dpy) (let ((widget-tree tree))
(map-window dpy win) (init-sync-x-events dpy)
(call-with-event-channel (map-window dpy win)
dpy win (event-mask button-press) (call-with-event-channel
(lambda (channel) dpy win (event-mask button-press)
;; FIXME calibrate at 10 times or using nanosleep (lambda (channel)
(let loop () ;; FIXME calibrate at 10 times or using nanosleep for your machine
(if (let loop ()
(let ((e (receive channel))) (if
(cond (let ((e (receive channel)))
((motion-event? e) ;; process events
(set! mousex motion-event-x) (cond
(set! mousey motion-event-y)) ((motion-event? e)
((map-event? e) (set! mousex motion-event-x)
(map-window dpy map-event-window)) (set! mousey motion-event-y))
((unmap-event? e) ((map-event? e)
(unmap-window dpy unmap-event-window)) (map-window dpy map-event-window))
((button-event? e) ((unmap-event? e)
(let ((state button-event-state)) (unmap-window dpy unmap-event-window))
(let ((widget (widget-node-collide? widget-tree mousex mouse))) ((button-event? e)
(if state (let ((state button-event-state))
((widget 'press!)) (let ((widget (widget-node-collide? widget-tree mousex mouse)))
((widget 'release!)))))) (if state
((expose-event? e) ((widget 'press!))
(expose-window dpy expose-event-window)) ((widget 'release!))))))
((destroy-widow-event? e) ((expose-event? e)
(expose-window dpy destroy-window-event-window)) (expose-window dpy expose-event-window))
(else #f)))) ((destroy-widow-event? e)
(loop)))))) (expose-window dpy destroy-window-event-window))
(else #f))
;; draw widgets in tree
(draw-widget-tree widget-tree)
))
(loop))))))))