diff options
Diffstat (limited to 'tests/011')
| -rw-r--r-- | tests/011/mandel.expected | 60 | ||||
| -rw-r--r-- | tests/011/mandel.txr | 63 |
2 files changed, 123 insertions, 0 deletions
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))) |