1 files changed, 210 insertions, 0 deletions
diff --git a/Examples/guile/matrix/matrix.scm b/Examples/guile/matrix/matrix.scm
new file mode 100644
index 0000000..18e5284
--- /dev/null
+++ b/Examples/guile/matrix/matrix.scm
@@ -0,0 +1,210 @@
+#!./matrix \
+-e do-test -s
+!#
+;;; Authors: David Beazley <beazley@cs.uchicago.edu>, 1999
+;;;          Martin Froehlich <MartinFroehlich@ACM.org>, 2000
+;;;
+;;; PURPOSE OF THIS FILE: This file is an example for how to use the guile
+;;;   scripting options with a little more than trivial script. Example
+;;;   derived from David Beazley's matrix evaluation example.  David
+;;;   Beazley's annotation: >>Guile script for testing out matrix
+;;;   operations. Disclaimer : I'm not a very good scheme
+;;;   programmer<<. Martin Froehlich's annotation: >>I'm not a very good
+;;;   scheme programmer, too<<.
+;;;
+;;; Explanation: The three lines at the beginning of this script are
+;;; telling the kernel to load the enhanced guile interpreter named
+;;; "matrix"; to execute the function "do-test" (-e option) after loading
+;;; this script (-s option). There are a lot more options wich allow for
+;;; even finer tuning. SEE ALSO: Section "Guile Scripts" in the "Guile
+;;; reference manual -- Part I: Preliminaries".
+;;;
+;;;
+;;; This program is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+;;; Create a zero matrix
+
+(define (zero M)
+  (define (zero-loop M i j)
+    (if (< i 4)
+	(if (< j 4) (begin
+		      (set-m M i j 0.0)
+		      (zero-loop M i (+ j 1)))
+	    (zero-loop M (+ i 1) 0))))
+  (zero-loop M 0 0))
+
+;;; Create an identity matrix
+
+(define (identity M)
+  (define (iloop M i)
+    (if (< i 4) (begin
+		  (set-m M i i 1.0)
+		  (iloop M (+ i 1)))))
+  (zero M)
+  (iloop M 0))
+
+;;; Rotate around x axis
+
+(define (rotx M r)
+  (define temp (new-matrix))
+  (define rd (/ (* r 3.14159) 180.0))
+  (zero temp)
+  (set-m temp 0 0 1.0)
+  (set-m temp 1 1 (cos rd))
+  (set-m temp 1 2 (- 0 (sin rd)))
+  (set-m temp 2 1 (sin rd))
+  (set-m temp 2 2 (cos rd))
+  (set-m temp 3 3 1.0)
+  (mat-mult M temp M)
+  (destroy-matrix temp))
+
+;;; Rotate around y axis
+
+(define (roty M r)
+  (define temp (new-matrix))
+  (define rd (/ (* r 3.14159) 180.0))
+  (zero temp)
+  (set-m temp 1 1 1.0)
+  (set-m temp 0 0 (cos rd))
+  (set-m temp 0 2 (sin rd))
+  (set-m temp 2 0 (- 0 (sin rd)))
+  (set-m temp 2 2 (cos rd))
+  (set-m temp 3 3 1.0)
+  (mat-mult M temp M)
+  (destroy-matrix temp))
+
+;;; Rotate around z axis
+
+(define (rotz M r)
+  (define temp (new-matrix))
+  (define rd (/ (* r 3.14159) 180.0))
+  (zero temp)
+  (set-m temp 0 0 (cos rd))
+  (set-m temp 0 1 (- 0 (sin rd)))
+  (set-m temp 1 0 (sin rd))
+  (set-m temp 1 1 (cos rd))
+  (set-m temp 2 2 1.0)
+  (set-m temp 3 3 1.0)
+  (mat-mult M temp M)
+  (destroy-matrix temp))
+
+;;; Scale a matrix
+
+(define (scale M s)
+  (define temp (new-matrix))
+  (define (sloop m i s)
+    (if (< i 4) (begin
+		  (set-m m i i s)
+		  (sloop m (+ i 1) s))))
+  (zero temp)
+  (sloop temp 0 s)
+  (mat-mult M temp M)
+  (destroy-matrix temp))
+
+;;; Make a matrix with random elements
+
+(define (randmat M)
+  (define (rand-loop M i j)
+    (if (< i 4)
+	(if (< j 4)
+            (begin
+              (set-m M i j (drand48))
+              (rand-loop M i (+ j 1)))
+	    (rand-loop M (+ i 1) 0))))
+  (rand-loop M 0 0))
+
+;;; stray definitions collected here
+
+(define (rot-test M v t i)
+  (if (< i 360) (begin
+		  (rotx M 1)
+		  (rotz M -0.5)
+		  (transform M v t)
+		  (rot-test M v t (+ i 1)))))
+
+(define (create-matrix)		; Create some matrices
+  (let loop ((i 0) (result '()))
+    (if (< i 200)
+	(loop (+ i 1) (cons (new-matrix) result))
+	result)))
+
+(define (add-mat M ML)
+  (define (add-two m1 m2 i j)
+    (if (< i 4)
+	(if (< j 4)
+            (begin
+              (set-m m1 i j (+ (get-m m1 i j) (get-m m2 i j)))
+              (add-two m1 m2 i (+ j 1)))
+	    (add-two m1 m2 (+ i 1) 0))))
+  (if (null? ML) () (begin
+		      (add-two M (car ML) 0 0)
+		      (add-mat M (cdr ML)))))
+
+(define (cleanup ML)
+  (if (null? ML) () (begin
+		      (destroy-matrix (car ML))
+		      (cleanup (cdr ML)))))
+
+(define (make-random ML)		; Put random values in them
+  (if (null? ML) () (begin
+		      (randmat (car ML))
+		      (make-random (cdr ML)))))
+
+(define (mul-mat m ML)
+  (if (null? ML) () (begin
+		      (mat-mult m (car ML) m)
+		      (mul-mat m (cdr ML)))))
+
+;;; Now we'll hammer on things a little bit just to make
+;;; sure everything works.
+(define M1 (new-matrix))		; a matrix
+(define v (createv 1 2 3 4))		; a vector
+(define t (createv 0 0 0 0))		; the zero-vector
+(define M-list (create-matrix))		; get list of marices
+(define M (new-matrix))			; yet another matrix
+
+(display "variables defined\n")
+(define (do-test x)
+  (display "Testing matrix program...\n")
+
+  (identity M1)
+  (print-matrix M1)
+  (display "Rotate-x 45 degrees\n")
+  (rotx M1 45)
+  (print-matrix M1)
+  (display "Rotate y 30 degrees\n")
+  (roty M1 30)
+  (print-matrix M1)
+  (display "Rotate z 15 degrees\n")
+  (rotz M1 15)
+  (print-matrix M1)
+  (display "Scale 0.5\n")
+  (scale M1 0.5)
+  (print-matrix M1)
+
+  ;; Rotating ...
+  (display "Rotating...\n")
+  (rot-test M1 v t 0)
+  (printv t)
+
+  (make-random M-list)
+
+  (zero M1)
+
+  (display "Adding them together (in Guile)\n")
+
+  (add-mat M1 M-list)
+  (print-matrix M1)
+
+  (display "Doing 200 multiplications (mostly in C)\n")
+  (randmat M)
+
+  (mul-mat M M-list)
+
+  (display "Cleaning up\n")
+
+  (cleanup M-list))
+
+;;; matrix.scm ends here