scx/scheme/examples/hello.scm

62 lines
1.5 KiB
Scheme
Raw Normal View History

2001-12-04 05:24:59 -05:00
#!/bin/sh
2001-12-04 06:16:05 -05:00
../../scx <<EOF
2001-12-04 05:24:59 -05:00
,batch on
,open xlib
(define (hello text)
(let* ((dpy (open-display))
(cm (copy-colormap-and-free (display-default-colormap dpy)))
;; 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))
(win (create-window
(display-default-root-window dpy)
100 200 300 200 10
'copy-from-parent 'copy-from-parent 'copy-from-parent
2002-02-08 12:10:45 -05:00
(make-set-window-attribute-alist
(event-mask (event-mask exposure button-press))
(background-pixel white)
(colormap cm))))
(gc (create-gcontext
win
2002-02-08 12:10:45 -05:00
(make-gc-value-alist (background white)
(foreground black))))
2001-12-04 05:24:59 -05:00
(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)
(let event-loop ()
(display-flush-output dpy)
(let ((e (wait-event dpy)))
(if
2002-02-08 12:10:45 -05:00
(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))
2001-12-04 05:24:59 -05:00
(event-loop)
#f)))
(close-display dpy)))
(hello "Hello World!")
,exit
2001-12-04 06:16:05 -05:00
EOF