;;; -*-Scheme-*-


(load 'xlib)

(define-macro (make-window . events)

  (define (get-event-mask events)
     (cond ((equal? events '())
             '())
           ((equal? 'expose (car(car events)))
             (cons 'exposure (get-event-mask (cdr events))))
           (else
             (cons (car(car events)) (get-event-mask (cdr events))))
     )
  )

  (define (make-event-functions events)
     (cond ((equal? events '())
             '())
           (else
             (cons                   
                  (list (car(car events))
                       `(lambda () ,@(cdr(car events))))
                  (make-event-functions (cdr events))))))

  (define (make-handle-events-args events)
     (cond ((equal? events '())
             '())
           (else
             (cons
                  (list (car(car events))
                       `(lambda args ,(list(car(car events))) #f))
                  (make-handle-events-args (cdr events))))))
                  
 `(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 ',(get-event-mask events)))
      (g-con   (create-gcontext 'window window
                                'background white
                                'foreground black))
      ,@(make-event-functions events)
    )
                           
    (map-window window)
    (handle-events display #t #f ,@(make-handle-events-args events))
    (close-display display)
  )
)

      
