diff --git a/scheme/examples/hello.scm b/scheme/examples/hello.scm index cbe4557..686b4d7 100755 --- a/scheme/examples/hello.scm +++ b/scheme/examples/hello.scm @@ -4,55 +4,63 @@ ,batch on -,open xlib +,open xlib rendezvous-channels threads (define (hello text) (let* ((dpy (open-display)) - (cm (copy-colormap-and-free (display-default-colormap dpy))) + (screen (display:default-screen dpy)) + (cm (screen:default-colormap screen)) + ;;(cm (copy-colormap-and-free dpy (screen:default-colormap screen))) ;; many ways to get color in your progs. - (black (black-pixel dpy)) - (white (white-pixel dpy)) - (blue (alloc-color! cm (make-color 0 0 1))) - (green (alloc-named-color cm "#00FF00")) - (red (alloc-named-color cm 'red)) + (black (screen:black-pixel screen)) + (white (screen:white-pixel screen)) + (blue (alloc-color dpy cm 0 0 1)) + (green-color (alloc-named-color dpy cm "#00FF00")) + (green (if green-color (color:pixel green-color) white)) - (win (create-window - (display-default-root-window dpy) - 100 200 300 200 10 - 'copy-from-parent 'copy-from-parent 'copy-from-parent - (make-set-window-attribute-alist - (event-mask (event-mask exposure button-press)) - (background-pixel white) - (colormap cm)))) - (gc (create-gcontext - win - (make-gc-value-alist (background white) - (foreground black)))) - (font (open-font dpy "*-new century schoolbook-bold-r*24*")) - (font2 (open-font dpy "*times*18*"))) - (set-wm-name! win '("scx Hello World Program")) - (map-window win) + (win (create-simple-window dpy + (default-root-window dpy) + 100 200 400 200 1 + black white)) + (gc (create-gc dpy win + (make-gc-value-alist (background white) + (foreground black)))) + (font (load-font dpy "*-new century schoolbook-bold-r*24*")) + (font2 (load-font dpy "*times*18*"))) - (let event-loop () - (display-flush-output dpy) - (let ((e (wait-event dpy))) - (if - (cond - ((expose-event? e) - (set-gcontext-font! gc font) - (set-gcontext-foreground! gc black) - (draw-poly-text win gc 10 25 text '1-byte) - (set-gcontext-foreground! gc blue) - (draw-poly-text win gc 20 50 (list font text) '1-byte) - (set-gcontext-foreground! gc red) - (set-gcontext-font! gc font2) - (draw-image-text win gc 30 75 text '1-byte) - #t) - (else #f)) - (event-loop) - #f))) - (close-display dpy))) + (set-window-colormap! dpy win cm) + (set-wm-name! dpy win (string-list->property '("scx Hello World Program"))) + + (spawn (lambda () + (let loop ((se (most-recent-sync-x-event))) + (display "event: ") (display (sync-x-event-event se)) + (display "\n") + (loop (next-sync-x-event se (lambda (e) #t)))))) + ;;(synchronize dpy #f) + + (init-sync-x-events dpy) + (let ((handler + (lambda (channel) + (map-window dpy win) + (let loop () + (if + (let ((e (receive channel))) + (cond + ((expose-event? e) + (set-gc-font! dpy gc font) + (set-gc-foreground! dpy gc black) + (draw-image-string dpy win gc 10 65 text) + + (set-gc-foreground! dpy gc green) + (draw-text dpy win gc 20 40 + (make-text-items text (change-font font2) + (with-delta 20 text)))) + (else #f))) + (loop)))))) + (call-with-event-channel dpy win (event-mask exposure button-press) + handler) + (close-display dpy)))) (hello "Hello World!")