home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / elk-2_0.lha / elk-2.0 / examples / xlib / lines < prev    next >
Encoding:
Text File  |  1991-08-05  |  1.1 KB  |  44 lines
  1. ;;; -*-Scheme-*-
  2.  
  3. (require 'xlib)
  4.  
  5. (define (lines)
  6.   (let*
  7.     ((dpy (open-display))
  8.      (black (black-pixel dpy)) (white (white-pixel dpy))
  9.      (win (create-window 'parent (display-root-window dpy)
  10.                'width 400 'height 400
  11.                'background-pixel white
  12.                'event-mask '(exposure button-press
  13.                           enter-window leave-window)))
  14.      (gc (create-gcontext 'window win 'background white
  15.             'foreground black))
  16.      (draw
  17.       (lambda (inc)
  18.     (clear-window win)
  19.     (with win
  20.        (let ((width (window-width win))
  21.          (height (window-height win)))
  22.          (do ((x 0 (+ x inc))) ((> x width))
  23.            (draw-line win gc x 0 (- width x) height))
  24.          (do ((y height (- y inc))) ((< y 0))
  25.            (draw-line win gc 0 y width (- height y))))))))
  26.  
  27.     (map-window win)
  28.     (unwind-protect
  29.      (handle-events dpy #t #f
  30.        (button-press
  31.     (lambda args #t))
  32.        (expose
  33.     (lambda args
  34.       (draw 2)
  35.       #f))
  36.        ((enter-notify leave-notify)
  37.     (lambda (e . args)
  38.       (set-window-border-pixel! win
  39.                     (if (eq? e 'enter-notify) white black))
  40.       #f)))
  41.      (close-display dpy))))
  42.  
  43. (lines)
  44.