* tests/011/mandel.expected: New file.

* tests/011/mandel.txr: New file.

3 files changed, 129 insertions, 0 deletions

diff --git a/ChangeLog b/ChangeLog
index a5be43ec..84df303a 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,11 @@
 2014-02-28  Kaz Kylheku  <kaz@kylheku.com>
 
+	* tests/011/mandel.expected: New file.
+
+	* tests/011/mandel.txr: New file.
+
+2014-02-28  Kaz Kylheku  <kaz@kylheku.com>
+
 	Turn *gensym-counter* into proper special variable.
 
 	* eval.c (eval_init): Save *gensym-counter* symbol in gensym_counter_s
diff --git a/tests/011/mandel.expected b/tests/011/mandel.expected
new file mode 100644
index 00000000..62a0c244
--- /dev/null
+++ b/tests/011/mandel.expected
@@ -0,0 +1,60 @@
+                                                                                
+                                                                                
+                                                                                
+                                                                                
+                                                                                
+                                                                                
+                                                                                
+                                                                                
+                                                                                
+                                                                                
+                                                                                
+                                                                                
+                                               *                                
+                                              ***                               
+                                              ***                               
+                                              ***                               
+                                              ***                               
+                                          ********* *                           
+                                       *************** **                       
+                                       ******************                       
+                                      *****************                         
+                                     *******************                        
+                                     ********************                       
+                                    **********************                      
+                                   **********************                       
+                           ******   **********************                      
+                          ******** ***********************                      
+                          ******** **********************                       
+                         ********************************                       
+                       *********************************                        
+                       *********************************                        
+                         ********************************                       
+                          ******** **********************                       
+                          ******** ***********************                      
+                           ******   **********************                      
+                                   **********************                       
+                                    **********************                      
+                                     ********************                       
+                                     *******************                        
+                                      *****************                         
+                                       ******************                       
+                                       *************** **                       
+                                          ********* *                           
+                                              ***                               
+                                              ***                               
+                                              ***                               
+                                              ***                               
+                                               *                                
+                                                                                
+                                                                                
+                                                                                
+                                                                                
+                                                                                
+                                                                                
+                                                                                
+                                                                                
+                                                                                
+                                                                                
+                                                                                
+                                                                                
diff --git a/tests/011/mandel.txr b/tests/011/mandel.txr
new file mode 100644
index 00000000..84200ffa
--- /dev/null
+++ b/tests/011/mandel.txr
@@ -0,0 +1,63 @@
+@(do 
+    (defvar x-centre -0.5)
+    (defvar y-centre 0.0)
+    (defvar width 4.0)
+    (defvar i-max 80)
+    (defvar j-max 60)
+    (defvar n 100)
+    (defvar r-max 2.0)
+    (defvar file "mandelbrot.pgm")
+    (defvar colour-max 255)
+    (defvar pixel-size (/ width i-max))
+    (defvar x-offset (- x-centre (* 0.5 pixel-size (+ i-max 1))))
+    (defvar y-offset (+ y-centre (* 0.5 pixel-size (+ j-max 1))))
+ 
+    ;; complex number library
+    (defmacro cplx (x y) '(cons ,x ,y))
+    (defmacro re (c) '(car ,c))
+    (defmacro im (c) '(cdr ,c))
+
+    (defsymacro c0 (macro-time (cplx 0 0)))
+
+    (macro-time 
+      (defun with-cplx-expand (specs body)
+        (tree-case specs
+           (((re im expr) . rest) 
+            '(tree-bind (,re . ,im) ,expr ,(with-cplx-expand rest body)))
+           (() (tree-case body
+                 ((a b . rest) '(progn ,a ,b ,*rest))
+                 ((a) a)
+                 (x (error "with-cplx: invalid body ~s" body))))
+           (x (error "with-cplx: bad args ~s" x)))))
+
+    (defmacro with-cplx (specs . body)
+      (with-cplx-expand specs body))
+
+    (defun c+ (x y)
+      (with-cplx ((a b x) (c d y))
+        (cplx (+ a c) (+ b d))))
+
+    (defun c* (x y)
+      (with-cplx ((a b x) (c d y))
+        (cplx (- (* a c) (* b d)) (+ (* b c) (* a d)))))
+
+    (defun modulus (z)
+      (with-cplx ((a b z))
+        (sqrt (+ (* a a) (* b b)))))
+
+    ;; Mandelbrot routines
+    (defun inside-p (z0 : (z c0) (n n))
+      (and (< (modulus z) r-max)
+           (or (zerop n)
+               (inside-p z0 (c+ (c* z z) z0) (- n 1)))))
+
+    (defun pixel (i j)
+      (inside-p
+        (cplx (+ x-offset (* pixel-size i))
+              (- y-offset (* pixel-size j)))))
+
+    ;; Mandelbrot loop and output
+    (each ((j (range 1 j-max)))
+      (each ((i (range 1 i-max)))
+        (put-char (if (pixel i j) #\* #\space)))
+      (put-char #\newline)))