cl-glutによるマンデルブロ集合の描画

mandelbrot.lisp

(ql:quickload "cl-glut")

(defparameter *width* 500)
(defparameter *height* 500)
(defparameter *magnification* 100.0)

(defun get-latice-points (width height reduction)
  (apply #'append (loop for x from (* -1 (/ width 2)) below (1+ (/ width 2))
                        collect (loop for y from (* -1 (/ height 2)) below (1+ (/ height 2))
                                 collect (complex (/ x reduction) (/ y reduction))))))

(defun calc-mandelbrot (c)
  (labels ((f (z c n)
    (cond ((= n 27) `(,c -1))
          ((< 2 (abs z)) `(,c ,n))
          (t (f (+ c (expt z 2)) c (1+ n))))))
    (f 0 c 0)))

(defun get-mandelbrot ()
  (mapcar #'calc-mandelbrot (get-latice-points  *width* *height* *magnification*)))

(defun set-mandelbrot-vertexes (latice-points)
  (mapcar #'(lambda (x)
	      (let ((latice-point (car x))
	       	    (n (cadr x)))
		(cond ((= n -1) (%gl:color-3f 0 0 0))
		      (t (%gl:color-3f (* n 0.2) 0 0)))
		(gl:vertex (* *magnification* (realpart latice-point)) (* *magnification* (imagpart latice-point)) 0)))
	  latice-points))

(defclass my-window (glut:window)
  ()
  (:default-initargs :title "mandelbrot" :width *width* :height *height*
		     :mode '(:single :rgb :depth)))

(defmethod glut:display-window :before ((w my-window))
  (gl:clear-color 1 1 1 0)
  (gl:matrix-mode :projection)
  (gl:load-identity)
  (gl:ortho 0 *width* *height* 0 -1 1))

(defmethod glut:display ((window my-window))
  (gl:clear :color-buffer-bit)
  (%gl:color-3f 0 0 0)
  (gl:push-matrix)
  (gl:translate (/ *width* 2) (/ *height* 2) 0)
  (gl:begin :points)
  (set-mandelbrot-vertexes *mandelbrot*)
  (gl:end)
  (gl:pop-matrix)
  (gl:flush))

(defparameter *mandelbrot* (get-mandelbrot))
(defun draw-mandelbrot ()
  (glut:display-window (make-instance 'my-window)))