source: project/gl-display-glx/gl-display-events-util.scm @ 3309

;;; gl-display-events-util.scm
;;
;; 07.01.2007 - 20.01.2007
;;  
;; Provide events related utility functions.
;; Need gl-display.
;; 

(require-for-syntax 'srfi-13)
(require-extension srfi-18)

;

; wait-event is like a blocking receive-event,
; i.e. it does not return before it receive
; an event.
(define (wait-event window)
  (let ((e (gl-display:receive-event window)))
    (if (eqv? (car e) 'NO-EVENT)
      (begin (thread-sleep! 0.01)
             (wait-event window))
      e)))

(define (write-event e)
  (case (car e)
    ((KEY-PRESSED)     (print "key pressed " (gl-display:event-key e)))
    ((KEY-RELEASED)    (print "key released " (gl-display:event-key e)))
    ((BUTTON-PRESSED)  (print "button pressed"))
    ((BUTTON-RELEASED) (print "button released"))
    ((MOUSE-MOVED)     (print "mouse moved"))
    ;((NO-EVENT)        (print "no event"))
    ;(else             (print "unused event"))
    )
    (flush-output))

(define (quit-on-escape e)
  (let ((type (car e)))
;   (write-event e)
    (if (and (eqv? type 'KEY-PRESSED) (eqv? (caddr e) 'ESCAPE-KEY))
      (exit))))

; filter-events pumps continuously for events.
; each event is handled with the function act given in argument.
(define (filter-events window act)
  (define (poll) (act (gl-display:receive-event window))
                 (thread-sleep! 0.01)
                 (poll))
  (poll))

; TODO
; filter-events-until pumps continuously for events
; until the predicate returns #t.
; each event is handled with the function act given in argument
; before being passed to the predicate.

; process-events pumps for events until there's
; no more event.
; each event is handled with the function act given in argument.
(define (process-events window act)
  (define (process)
    (let ((e (gl-display:receive-event window)))
      (when (not (eqv? 'NO-EVENT (car e)))
        (act e)
        (process))))
  (process))



(define (key-pressed? event)
  (eqv? 'KEY-PRESSED (gl-display:event-type event)))
(define (key-released? event)
  (eqv? 'KEY-RELEASED (gl-display:event-type event)))
(define (button-pressed? event)
  (eqv? 'BUTTON-PRESSED (gl-display:event-type event)))
(define (button-released? event)
  (eqv? 'BUTTON-RELEASED (gl-display:event-type event)))
(define (mouse-moved? event)
  (eqv? 'MOUSE-MOVED (gl-display:event-type event)))


(define (escape-key-released? event)
  (and (key-released? event)
       (eqv? #\esc (gl-display:event-key event))))

(define (up-key-released? event)
  (and (key-released? event)
       (eqv? 'UP-KEY (gl-display:event-key event))))
(define (up-key-pressed? event)
  (and (key-pressed? event)
       (eqv? 'UP-KEY (gl-display:event-key event))))
(define (down-key-released? event)
  (and (key-released? event)
       (eqv? 'DOWN-KEY (gl-display:event-key event))))
(define (down-key-pressed? event)
  (and (key-pressed? event)
       (eqv? 'DOWN-KEY (gl-display:event-key event))))
(define (left-key-released? event)
  (and (key-released? event)
       (eqv? 'LEFT-KEY (gl-display:event-key event))))
(define (left-key-pressed? event)
  (and (key-pressed? event)
       (eqv? 'LEFT-KEY (gl-display:event-key event))))
(define (right-key-released? event)
  (and (key-released? event)
       (eqv? 'RIGHT-KEY (gl-display:event-key event))))
(define (right-key-pressed? event)
  (and (key-pressed? event)
       (eqv? 'RIGHT-KEY (gl-display:event-key event))))

(define (space-key-released? event)
  (and (key-released? event)
       (eqv? #\space (gl-display:event-key event))))
(define (space-key-pressed? event)
  (and (key-pressed? event)
       (eqv? #\space (gl-display:event-key event))))

(define (lmb-released? event)
  (and (button-released? event)
       (eqv? 'LMB (gl-display:event-key event))))
(define (lmb-pressed? event)
  (and (button-pressed? event)
       (eqv? 'LMB (gl-display:event-key event))))