[Shootout-list] Mandelbrot Set for CMUCL and SBCL

Yannick Gingras ygingras@ygingras.net
Fri, 25 Mar 2005 08:20:25 -0500


--nextPart6440201.ZEvIm2nFEP
Content-Type: text/plain;
  charset="iso-8859-1"
Content-Transfer-Encoding: quoted-printable
Content-Disposition: inline


Hi, here his my humble submission:


;;; The Great Computer Language Shootout
;;;   http://shootout.alioth.debian.org/

;;;   contributed by Yannick Gingras <ygingras@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)))
 =20
(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)))


=2D-=20
Yannick Gingras         Math Student, UQAM
Join FSF as an Associate Member at:
  http://member.fsf.org/join?referrer=3D2327


--nextPart6440201.ZEvIm2nFEP
Content-Type: application/pgp-signature

-----BEGIN PGP SIGNATURE-----
Version: GnuPG v1.2.5 (GNU/Linux)

iD8DBQBCRBAdX5grbfhLwA4RAiBAAJ9QzcDX1llnHh3oeDC/D/doUZIKrgCfeaFL
IIs8hfu3cpIQAPp9Eg9gRuc=
=eSEd
-----END PGP SIGNATURE-----

--nextPart6440201.ZEvIm2nFEP--