;;; -*-Scheme-*-

;;;       name: MAKE-WINDOW
;;; arguaments: clauses of the form (event action, action...)
;;;             where event is a X-event eg. expose, button-press
;;;             and action is executable scheme
;;;   comments: 
;;;   requires: xlib

(define-macro (make-window . clauses)

  (define (make-event-mask clauses)
     (map (lambda (clause) (car (cdr (assoc (car clause)
                                            '((else         else)
                                              (expose       exposure)
                                              (button-press button-press)
                                              (enter-notify enter-window)
                                              (leave-notify leave-window))))))
          clauses))
                 
  (define (make-event-functions clauses)
     (map (lambda (clause) (list (car clause)
                                `(lambda () ,@(cdr clause))))
          clauses))

  (define (make-handle-events-args clauses)
     (map (lambda (clause) (list (car clause)
                                `(lambda args ,(list(car clause)) #f)))
          clauses))
                  
 `(let*
    ( (display (open-display))
      (black   (black-pixel display))
      (white   (white-pixel display))
      (window  (create-window 'parent (display-root-window display)
                              'width 400 'height 400
                              'background-pixel white
                              'event-mask ',(make-event-mask clauses)))
      (g-con   (create-gcontext 'window window
                                'background white
                                'foreground black))
      ,@(make-event-functions clauses)
    )
                           
    (map-window window)
    (handle-events display #t #f ,@(make-handle-events-args clauses))
    (close-display display)
  )
)

      
