+ added Xft example program

This commit is contained in:
eknauel 2003-10-23 17:29:09 +00:00
parent 958d3901fc
commit 72010947aa
1 changed files with 68 additions and 0 deletions

68
scheme/examples/hello-xft.scm Executable file
View File

@ -0,0 +1,68 @@
#!/bin/sh
../../scx <<EOF
,batch on
,open xlib xft xrender rendezvous-channels threads
(define (hello text)
(let* ((dpy (open-display))
(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 (screen:black-pixel screen))
(white (screen:white-pixel screen))
(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 (scx-xft-font-open-name dpy screen "Luxi Mono-24"))
(font2 (scx-xft-font-open-name dpy screen "Times-36"))
(visual (screen:default-visual screen))
(xft-draw (scx-xft-draw-create dpy win visual cm))
(xft-black (scx-xft-color-alloc-name dpy visual cm "black"))
(xft-blue (scx-xft-color-alloc-name dpy visual cm "blue")))
(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)
(scx-xft-draw-string-8bit
xft-draw xft-black font 10 65 text)
(scx-xft-draw-string-8bit
xft-draw xft-blue font 10 140 text))
((motion-event? e) #t)
(else #f)))
(loop))))))
(call-with-event-channel dpy win (event-mask exposure button-press
pointer-motion)
handler)
(close-display dpy))))
(hello "Hello World!")
,exit
EOF