; try to call with (mandel 1 3 2 3 2 3 3 4 1 1 4 4 1 3 3 1 3 3 3 1 4 4 4 1 3 4 4 4 3 3 3 4 3 4 2 3 4 4 1 1 2 4 3) (defconstant *charset* (make-array '(94 12) :initial-contents '(( " " " ** " " **** " " **** " " **** " " ** " " ** " " " " ** " " ** " " " " " ) ( " " " ** ** " " ** ** " " ** ** " " * * " " " " " " " " " " " " " " " ) ( " " " ** ** " " ** ** " "******* " " ** ** " " ** ** " " ** ** " "******* " " ** ** " " ** ** " " " " " ) ( " ** " " ** " " ***** " "** " "** " " **** " " ** " " ** " "***** " " ** " " ** " " " ) ( " " " " " " "** * " "** ** " " ** " " ** " " ** " "** ** " "* ** " " " " " ) ( " " " *** " "** ** " "** ** " " *** " "***** * " "** **** " "** ** " "** *** " " *** ** " " " " " ) ( " " " ** " " ** " " ** " " ** " " " " " " " " " " " " " " " ) ( " " " ** " " ** " " ** " " ** " " ** " " ** " " ** " " ** " " ** " " " " " ) ( " " " ** " " ** " " ** " " ** " " ** " " ** " " ** " " ** " " ** " " " " " ) ( " " " " " " " ** ** " " **** " "********" " **** " " ** ** " " " " " " " " " ) ( " " " " " " " ** " " ** " " ****** " " ** " " ** " " " " " " " " " ) ( " " " " " " " " " " " " " " " " " *** " " *** " " ** " " " ) ( " " " " " " " " " " "******* " " " " " " " " " " " " " ) ( " " " " " " " " " " " " " " " " " *** " " *** " " " " " ) ( " " " " " * " " ** " " ** " " ** " " ** " " ** " "** " "* " " " " " ) ( " " " ***** " "** ** " "** *** " "** **** " "** * ** " "**** ** " "*** ** " "** ** " " ***** " " " " " ) ( " " " * " " ** " "**** " " ** " " ** " " ** " " ** " " ** " "****** " " " " " ) ( " " " **** " "** ** " "** ** " " ** " " ** " " ** " " ** " "** ** " "****** " " " " " ) ( " " " **** " "** ** " " ** " " ** " " *** " " ** " " ** " "** ** " " **** " " " " " ) ( " " " ** " " *** " " **** " " ** ** " "** ** " "******* " " ** " " ** " " **** " " " " " ) ( " " "****** " "** " "** " "** " "***** " " ** " " ** " "** ** " " **** " " " " " ) ( " " " *** " " ** " "** " "** " "***** " "** ** " "** ** " "** ** " " **** " " " " " ) ( " " "******* " "** ** " "** ** " " ** " " ** " " ** " " ** " " ** " " ** " " " " " ) ( " " " **** " "** ** " "** ** " "** ** " " **** " "** ** " "** ** " "** ** " " **** " " " " " ) ( " " " **** " "** ** " "** ** " "** ** " " ***** " " ** " " ** " " ** " " *** " " " " " ) ( " " " " " " " *** " " *** " " " " " " *** " " *** " " " " " " " ) ( " " " " " " " *** " " *** " " " " " " *** " " *** " " ** " " ** " " " ) ( " " " ** " " ** " " ** " " ** " "** " " ** " " ** " " ** " " ** " " " " " ) ( " " " " " " " " " ****** " " " " ****** " " " " " " " " " " " ) ( " " " ** " " ** " " ** " " ** " " ** " " ** " " ** " " ** " " ** " " " " " ) ( " " " **** " "** ** " " ** " " ** " " ** " " ** " " " " ** " " ** " " " " " ) ( " " " ***** " "** ** " "** ** " "** **** " "** **** " "** **** " "** " "** " " ***** " " " " " ) ( " " " ** " " **** " "** ** " "** ** " "** ** " "****** " "** ** " "** ** " "** ** " " " " " ) ( " " "****** " " ** ** " " ** ** " " ** ** " " ***** " " ** ** " " ** ** " " ** ** " "****** " " " " " ) ( " " " **** " " ** ** " "** ** " "** " "** " "** " "** ** " " ** ** " " **** " " " " " ) ( " " "***** " " ** ** " " ** ** " " ** ** " " ** ** " " ** ** " " ** ** " " ** ** " "***** " " " " " ) ( " " "******* " " ** * " " ** " " ** * " " ***** " " ** * " " ** " " ** * " "******* " " " " " ) ( " " "******* " " ** ** " " ** * " " ** * " " ***** " " ** * " " ** " " ** " "**** " " " " " ) ( " " " **** " " ** ** " "** ** " "** " "** " "** *** " "** ** " " ** ** " " ***** " " " " " ) ( " " "** ** " "** ** " "** ** " "** ** " "****** " "** ** " "** ** " "** ** " "** ** " " " " " ) ( " " " **** " " ** " " ** " " ** " " ** " " ** " " ** " " ** " " **** " " " " " ) ( " " " **** " " ** " " ** " " ** " " ** " "** ** " "** ** " "** ** " " **** " " " " " ) ( " " "*** ** " " ** ** " " ** ** " " ** ** " " **** " " ** ** " " ** ** " " ** ** " "*** ** " " " " " ) ( " " "**** " " ** " " ** " " ** " " ** " " ** * " " ** ** " " ** ** " "******* " " " " " ) ( " " "** ** " "*** *** " "******* " "******* " "** * ** " "** ** " "** ** " "** ** " "** ** " " " " " ) ( " " "** ** " "** ** " "*** ** " "**** ** " "******* " "** **** " "** *** " "** ** " "** ** " " " " " ) ( " " " *** " " ** ** " "** ** " "** ** " "** ** " "** ** " "** ** " " ** ** " " *** " " " " " ) ( " " "****** " " ** ** " " ** ** " " ** ** " " ***** " " ** " " ** " " ** " "**** " " " " " ) ( " " " *** " " ** ** " "** ** " "** ** " "** ** " "** *** " "** **** " " ***** " " ** " " **** " " " ) ( " " "****** " " ** ** " " ** ** " " ** ** " " ***** " " ** ** " " ** ** " " ** ** " "*** ** " " " " " ) ( " " " **** " "** ** " "** ** " "** " " *** " " ** " "** ** " "** ** " " **** " " " " " ) ( " " "****** " "* ** * " " ** " " ** " " ** " " ** " " ** " " ** " " **** " " " " " ) ( " " "** ** " "** ** " "** ** " "** ** " "** ** " "** ** " "** ** " "** ** " " **** " " " " " ) ( " " "** ** " "** ** " "** ** " "** ** " "** ** " "** ** " "** ** " " **** " " ** " " " " " ) ( " " "** ** " "** ** " "** ** " "** ** " "** * ** " "** * ** " " ** ** " " ** ** " " ** ** " " " " " ) ( " " "** ** " "** ** " "** ** " " **** " " ** " " **** " "** ** " "** ** " "** ** " " " " " ) ( " " "** ** " "** ** " "** ** " "** ** " " **** " " ** " " ** " " ** " " **** " " " " " ) ( " " "******* " "** *** " "* ** " " ** " " ** " " ** " " ** * " "** ** " "******* " " " " " ) ( " " " **** " " ** " " ** " " ** " " ** " " ** " " ** " " ** " " **** " " " " " ) ( " " " " "* " "** " " ** " " ** " " ** " " ** " " ** " " * " " " " " ) ( " " " **** " " ** " " ** " " ** " " ** " " ** " " ** " " ** " " **** " " " " " ) ( " * " " *** " " ** ** " "** ** " " " " " " " " " " " " " " " " " ) ( " " " " " " " " " " " " " " " " " " " " "********" " " ) ( " ** " " ** " " ** " " " " " " " " " " " " " " " " " " " ) ( " " " " " " " " " **** " " ** " " ***** " "** ** " "** ** " " *** ** " " " " " ) ( " " "*** " " ** " " ** " " ***** " " ** ** " " ** ** " " ** ** " " ** ** " "** *** " " " " " ) ( " " " " " " " " " **** " "** ** " "** " "** " "** ** " " **** " " " " " ) ( " " " *** " " ** " " ** " " ***** " "** ** " "** ** " "** ** " "** ** " " *** ** " " " " " ) ( " " " " " " " " " **** " "** ** " "****** " "** " "** ** " " **** " " " " " ) ( " " " *** " " ** ** " " ** " " ** " "***** " " ** " " ** " " ** " "**** " " " " " ) ( " " " " " " " " " *** ** " "** ** " "** ** " "** ** " " ***** " " ** " "** ** " " **** " ) ( " " "*** " " ** " " ** " " ** ** " " *** ** " " ** ** " " ** ** " " ** ** " "*** ** " " " " " ) ( " " " ** " " ** " " " " **** " " ** " " ** " " ** " " ** " " ****** " " " " " ) ( " " " ** " " ** " " " " **** " " ** " " ** " " ** " " ** " "** ** " "** ** " " **** " ) ( " " "*** " " ** " " ** " " ** ** " " ** ** " " **** " " ** ** " " ** ** " "*** ** " " " " " ) ( " " " **** " " ** " " ** " " ** " " ** " " ** " " ** " " ** " " ****** " " " " " ) ( " " " " " " " " "****** " "** * ** " "** * ** " "** * ** " "** * ** " "** ** " " " " " ) ( " " " " " " " " "***** " "** ** " "** ** " "** ** " "** ** " "** ** " " " " " ) ( " " " " " " " " " **** " "** ** " "** ** " "** ** " "** ** " " **** " " " " " ) ( " " " " " " " " "** *** " " ** ** " " ** ** " " ** ** " " ** ** " " ***** " " ** " "**** " ) ( " " " " " " " " " *** ** " "** ** " "** ** " "** ** " "** ** " " ***** " " ** " " **** " ) ( " " " " " " " " "*** ** " " ** *** " " *** ** " " ** " " ** " "**** " " " " " ) ( " " " " " " " " " **** " "** ** " " ** " " ** " "** ** " " **** " " " " " ) ( " " " " " * " " ** " "****** " " ** " " ** " " ** " " ** ** " " *** " " " " " ) ( " " " " " " " " "** ** " "** ** " "** ** " "** ** " "** ** " " *** ** " " " " " ) ( " " " " " " " " "** ** " "** ** " "** ** " "** ** " " **** " " ** " " " " " ) ( " " " " " " " " "** ** " "** ** " "** * ** " "** * ** " " ** ** " " ** ** " " " " " ) ( " " " " " " " " "** ** " " ** ** " " *** " " *** " " ** ** " "** ** " " " " " ) ( " " " " " " " " " ** ** " " ** ** " " ** ** " " ** ** " " **** " " ** " " ** " "**** " ) ( " " " " " " " " "****** " "* ** " " ** " " ** " "** * " "****** " " " " " ) ( " " " *** " " ** " " ** " " ** " "** " " ** " " ** " " ** " " *** " " " " " ) ( " " " ** " " ** " " ** " " ** " " " " ** " " ** " " ** " " ** " " " " " ) ( " " "*** " " ** " " ** " " ** " " ** " " ** " " ** " " ** " "*** " " " " " ) ( " " " *** **" "** ** * " "** *** " " " " " " " " " " " " " " " " " )))) (defun mandel (&rest quadrants) (let ((x0 -2d0) (y0 -2d0) (x1 2d0) (y1 2d0) (i 0) (steps 8)) (dolist (q quadrants) (let ((x0-old x0) (y0-old y0) (x1-old x1) (y1-old y1)) (multiple-value-setq (x0 y0 x1 y1) (select-quadrant q x0 y0 x1 y1)) (loop for j from 0 to (1- steps) do (format t "calculating image ~S of ~S~%" (1+ i) (* steps (length quadrants))) (draw-quadrant i (+ (* (/ (- x0 x0-old) steps) j) x0-old) (+ (* (/ (- y0 y0-old) steps) j) y0-old) (+ (* (/ (- x1 x1-old) steps) j) x1-old) (+ (* (/ (- y1 y1-old) steps) j) y1-old)) (incf i)))))) (defun select-quadrant (q x0 y0 x1 y1) (let ((midx (/ (+ x1 x0) 2d0)) (midy (/ (+ y1 y0) 2d0))) (case q (1 (values midx midy x1 y1)) (2 (values x0 midy midx y1)) (3 (values x0 y0 midx midy)) (4 (values midx y0 x1 midy)) (t (values x0 y0 x1 y1))))) (defun draw-quadrant (i x0 y0 x1 y1) (let ((steps 30) (ti (make-instance 'terminal-image))) (char-out ti #\2) (loop for x from 0 to steps do (char-out ti #\-)) (char-out ti #\1) (newline ti) (loop for y from 0 to steps do (char-out ti #\|) (loop for x from 0 to steps do (let* ((c 126) (z (complex (+ (* (/ (- x1 x0) steps) x) x0) (+ (* (/ (- y1 y0) steps) y) y0))) (a z)) (loop while (and (< (abs (setq z (+ (* z z) a))) 2) (> (decf c) 32))) (char-out ti (code-char c)) )) (char-out ti #\|) (newline ti)) (char-out ti #\3) (loop for x from 0 to steps do (char-out ti #\-)) (char-out ti #\4) (newline ti) (write-tga ti (format nil "/tmp/t~S.tga" i)))) (defclass terminal-image () ((cols :initarg cols :initform 33) (rows :initarg rows :initform 33) (cursor-x :initform 0) (cursor-y :initform 0) width height image)) (defmethod char-out ((ti terminal-image) c) (let ((index (- (char-code c) 33)) (x0 (* 8 (slot-value ti 'cursor-x))) (y0 (* 12 (slot-value ti 'cursor-y)))) (if (and (<= 0 index) (< index 94)) (loop for y from 0 to 11 do (let ((char-line (aref *charset* index y))) (loop for x from 0 to 7 do (if (not (eq #\Space (elt char-line x))) (setf (aref (slot-value ti 'image) (+ y y0) (+ x x0)) 1))))))) (incf (slot-value ti 'cursor-x))) (defmethod newline ((ti terminal-image)) (setf (slot-value ti 'cursor-x) 0) (incf (slot-value ti 'cursor-y))) (defmethod initialize-instance :after ((ti terminal-image) &key) (let ((width (* (slot-value ti 'cols) 8)) (height (* (slot-value ti 'rows) 12))) (setf (slot-value ti 'width) width) (setf (slot-value ti 'height) height) (setf (slot-value ti 'image) (make-array (list height width) :element-type '(unsigned-byte 1) :initial-element 0)))) (defmethod write-tga ((ti terminal-image) filename) (let ((width (slot-value ti 'width)) (height (slot-value ti 'height))) (with-open-file (tga filename :direction :output :if-exists :supersede :element-type 'unsigned-byte) (dolist (byte (list 0 0 2 0 0 0 0 0 0 0 0 0 (mod width 256) (floor width 256) (mod height 256) (floor height 256) 24 0)) (write-byte byte tga)) (loop for y from (1- height) downto 0 do (loop for x from 0 to (1- width) do (let ((color (if (= (aref (slot-value ti 'image) y x) 1) 255 0))) (write-byte color tga) (write-byte color tga) (write-byte color tga))))))) (defun charset () (with-open-file (chars "/tmp/chars.tga" :element-type 'unsigned-byte) (loop for c from 0 to 93 do (princ "(") (princ #\Newline) (loop for y from 11 downto 0 do (file-position chars (+ 18 (* y 752) (* c 8))) (princ "\"") (loop for x from 0 to 7 do (if (= 255 (read-byte chars)) (princ "*") (princ " "))) (princ "\" ") (princ #\Newline)) (princ ")") (princ #\Newline))))