From 9a316771fc93d135b79b78e71b46ac2bf3455237 Mon Sep 17 00:00:00 2001
From: frese <frese>
Date: Tue, 4 Dec 2001 13:49:07 +0000
Subject: [PATCH] + added more example scripts.

---
 scheme/examples/picture.scm | 54 +++++++++++++++++++++++++++
 scheme/examples/regions.scm | 73 +++++++++++++++++++++++++++++++++++++
 scheme/examples/scxev.scm   | 33 +++++++++++++++++
 3 files changed, 160 insertions(+)
 create mode 100755 scheme/examples/picture.scm
 create mode 100755 scheme/examples/regions.scm
 create mode 100755 scheme/examples/scxev.scm

diff --git a/scheme/examples/picture.scm b/scheme/examples/picture.scm
new file mode 100755
index 0000000..c8886b0
--- /dev/null
+++ b/scheme/examples/picture.scm
@@ -0,0 +1,54 @@
+#!/bin/sh
+
+../../scx <<EOF
+
+,batch on
+,open xlib
+,batch off
+
+(define (picture point-count)
+  (let* ((dpy (open-display))
+	 (width 400)
+	 (height 400)
+	 (black (black-pixel dpy))
+	 (white (white-pixel dpy))
+	 (root (display-root-window dpy))
+	 (win (create-window root width height 
+			     'background-pixel white
+			     'event-mask '(exposure button-press)))
+	 (gc (create-gcontext win
+			      'background white 'foreground black)))
+    (map-window win)
+    (let event-loop ()
+      (let ((e (next-event dpy)))
+	(if
+	 (case (event-type e)
+	   ((expose) (begin
+		       (clear-window win)
+		       (draw-points win gc point-count 0 0 
+				    (/ width 2) (/ height 2))
+		       (draw-poly-text win gc 10 10 "Click a button to exit"
+				       '1-byte)
+		       #f))
+	   (else #t))
+	 #t
+	 (event-loop))))
+    (close-display dpy)))
+
+(define (draw-points win gc count x y hw hh)
+  (if (zero? (modulo count 100))
+      (display-flush-output (window-display win)))
+  (if (not (zero? count))
+      (let ((xf (floor (* (+ 1.2 x) hw ))) ; These lines center the picture
+	    (yf (floor (* (+ 0.5 y) hh ))))
+	(draw-point win gc (cons (inexact->exact xf) (inexact->exact yf)))
+	(draw-points win gc (- count 1)
+		     (- (* y (+ 1 (sin (* 0.7 x)))) (* 1.2 (sqrt (abs x))))
+		     (- 0.21 x)
+		     hw hh))))
+
+(picture 1000)
+
+,exit
+y
+EOF
diff --git a/scheme/examples/regions.scm b/scheme/examples/regions.scm
new file mode 100755
index 0000000..20042c1
--- /dev/null
+++ b/scheme/examples/regions.scm
@@ -0,0 +1,73 @@
+../../scx <<EOF
+
+,batch on
+,open xlib
+,batch off
+
+(define (regions)
+  (let* ((dpy (open-display))
+	(cm (display-default-colormap dpy))
+	(black (black-pixel dpy))
+	(white (white-pixel dpy))
+	(blue (alloc-named-color cm 'blue))
+	(win (create-window (display-root-window dpy) 500 500 
+			    'event-mask '(button-press exposure)
+			    'background-pixel white))
+	(gc (create-gcontext win
+			     'background white
+			     'foreground black))
+	
+	(rectangles '((10 20 60 60) (50 100 30 30)))
+	(colors (list black blue))
+	(regions-alist 
+	 (list (cons (union-rectangle-with-region (car rectangles)
+						  (create-region))
+		     "black rectangle")
+	       (cons (union-rectangle-with-region (cadr rectangles)
+						  (create-region))
+		     "blue rectangle")))
+
+	(handle-event 
+	 (lambda (e)
+	   (let ((args (event-args e))
+		 (type (event-type e)))
+	     (case type
+	       ;; Zeichnen...
+	       ((expose) (begin
+			   (for-each (lambda (rect color)
+				       (set-gcontext-foreground! gc color)
+				       (fill-rectangle win gc rect))
+				     rectangles colors)
+			   #t))
+	       ;; Hit-Tests
+	       ((button-press)
+		(let* ((x (cdr (assq 'x args)))
+		       (y (cdr (assq 'y args)))
+		       (rs (filter (lambda (r-n)
+				     (point-in-region? (car r-n)
+						       x y))
+				   regions-alist)))
+		  (for-each (lambda (region-name)
+			      (display "You clicked: ")
+			      (display (cdr region-name))
+			      (newline))
+			    rs)
+		  ;; break if none was hit.
+		  (not (null? rs))))
+	       )))))
+
+    (map-window win)
+    (let loop ()
+      (display-flush-output dpy)
+      (let ((e (next-event dpy)))
+	(if (handle-event e)
+	    (loop)
+	    (close-display dpy))))))
+
+(regions)
+	
+
+
+,exit
+y
+EOF
diff --git a/scheme/examples/scxev.scm b/scheme/examples/scxev.scm
new file mode 100755
index 0000000..7bf486e
--- /dev/null
+++ b/scheme/examples/scxev.scm
@@ -0,0 +1,33 @@
+#!/bin/sh
+
+../../scx <<EOF
+
+,batch on
+,open xlib
+,batch off
+
+(define (scxev)
+  (let* ((dpy (open-display))
+	 (black (black-pixel dpy))
+	 (white (white-pixel dpy))
+	 (win (create-window (display-default-root-window dpy)
+			     300 200
+			     'event-mask '(all-events)
+			     'background-pixel white))
+	 )
+    (set-wm-name! win '("scx Event Listener"))
+    (map-window win)
+    (let event-loop ()
+      (display-flush-output dpy)
+      (let ((e (wait-event dpy)))
+	(display (event-type e)) (display " Event, Data:\n")
+	(display (event-args e)) (newline) (newline)
+	
+	(event-loop))
+      (close-display dpy))))
+
+(scxev)
+
+,exit
+y
+EOF
\ No newline at end of file