widget-tree sync eventloop - 2
This commit is contained in:
parent
85fb2c868b
commit
1e372d54ee
|
@ -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))))))))
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue