[Shootout-list] Mandelbrot Set for CMUCL and SBCL
Yannick Gingras
ygingras at ygingras.net
Sun Apr 23 22:54:52 UTC 2006
Hi, here his my humble submission:
;;; The Great Computer Language Shootout
;;; http://shootout.alioth.debian.org/
;;; contributed by Yannick Gingras <ygingras at ygingras.net>
;;; for a colorful web zoomer for the Mandelbrot Set by the same
;;; author see http://fract.ygingras.net/
(declaim (optimize speed (debug 0) (safety 0)))
(defun render (size &optional (stream *standard-output*))
(declare (type fixnum size)
(type stream stream))
(let* ((inc (/ 2.0 size))
(code 0)
(mask 128))
(declare (type (unsigned-byte 8) code)
(type (unsigned-byte 8) mask))
(format stream "P4~%~d ~d~%" size size)
(dotimes (y size)
(declare (type fixnum y))
(let ((base-imag (+ (* inc y) -1.0)))
(declare (type single-float base-imag))
(dotimes (x size)
(declare (type fixnum x))
(let* ((z #c(0.0 0.0))
(c (complex (+ (* inc x) -1.5) base-imag))
(imag 0.0)
(real 0.0))
(declare (type (complex single-float) z)
(type (complex single-float) c))
(when (not (dotimes (n 50)
(when (< 4.0 (+ (* imag imag) (* real real)))
(return t))
(setf z (+ (* z z) c))
(setf imag (imagpart z))
(setf real (realpart z))))
(setf code (logior mask code)))
(setf mask (ash mask -1))
(when (zerop mask)
(setf mask 128)
(write-char (code-char code) stream)
(setf code 0))))))))
(defun main ()
(let* ((args #+sbcl sb-ext:*posix-argv*
#+cmu extensions:*command-line-strings*
#+gcl si::*command-args*)
(n (parse-integer (car (last args)))))
(render n)))
--
Yannick Gingras Math Student, UQAM
Join FSF as an Associate Member at:
http://member.fsf.org/join?referrer=2327
-------------- next part --------------
A non-text attachment was scrubbed...
Name: not available
Type: application/pgp-signature
Size: 189 bytes
Desc: not available
Url : http://lists.alioth.debian.org/pipermail/shootout-list/attachments/20060423/25073739/attachment.pgp
More information about the Shootout-list
mailing list