From 72010947aaf92ff5a9dc13fd0c5410eabb3107b5 Mon Sep 17 00:00:00 2001
From: eknauel <eknauel>
Date: Thu, 23 Oct 2003 17:29:09 +0000
Subject: [PATCH] + added Xft example program

---
 scheme/examples/hello-xft.scm | 68 +++++++++++++++++++++++++++++++++++
 1 file changed, 68 insertions(+)
 create mode 100755 scheme/examples/hello-xft.scm

diff --git a/scheme/examples/hello-xft.scm b/scheme/examples/hello-xft.scm
new file mode 100755
index 0000000..83d5f14
--- /dev/null
+++ b/scheme/examples/hello-xft.scm
@@ -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