yotta-zoomer.lisp

   1
   2 (in-package :yotta-zoomer)
   3
   4 (declaim (optimize (speed 0) (safety 3) (debug 3) (compilation-speed 0)))
   5
   6 (defmacro with-gensyms ((&rest names) &body body)
   7   `(let ,(loop for n in names collect `(,n (gensym)))
   8      ,@body))
   9
  10 (defmacro once-only ((&rest names) &body body)
  11   (let ((gensyms (loop for n in names collect (gensym))))
  12     `(let (,@(loop for g in gensyms collect `(,g (gensym))))
  13        `(let (,,@(loop for g in gensyms for n in names collect ``(,,g ,,n)))
  14           ,(let (,@(loop for n in names for g in gensyms collect `(,n ,g)))
  15              ,@body)))))
  16
  17 (defmacro with-opengl (&body forms)
  18   (with-gensyms (error-sym)
  19     `(progn ,@forms
  20             (let ((,error-sym  (gl:get-error)))
  21               (unless ,error-sym
  22                 (error "OpenGL Error ~A~%"
  23                        (case ,error-sym
  24                          (gl:+INVALID-ENUM+ "Invalid Enum")
  25                          (gl:+INVALID-VALUE+ "Invalid value")
  26                          (gl:+INVALID-OPERATION+ "Invalid Operation")
  27                          (gl:+OUT-OF-MEMORY+ "Out of memory")
  28                          (gl:+STACK-OVERFLOW+ "Stack overflow")
  29                          (gl:+STACK-UNDERFLOW+ "Stack underflow"))))))))
  30
  31 (defconstant +squared-limit+ 4.0)
  32 (defparameter *max-iterations* 16)
  33
  34 (defclass rgba-image  ()
  35   ((name :accessor name-of)
  36    (width :accessor width-of :initform 0)
  37    (height :accessor height-of :initform 0)
  38    (format :reader format-of :initform gl:+rgba+)
  39    (bpp :reader bpp-of :initform 4)
  40    (data :accessor data-of)
  41    (size :accessor size-of))
  42   (:documentation "Data  for an opengl RGBA texture"))
  43
  44 (defmethod make-image ((self rgba-image) &key width height)
  45   "Create a sized rgba texture"
  46   (setf (width-of self) width)
  47   (setf (height-of self) height)
  48   (setf (slot-value self 'name) (cffi:foreign-alloc :uint32))
  49   (with-opengl
  50     (gl:gen-textures 1 (name-of self))
  51     (gl:bind-texture gl:+texture-2d+ (cffi::mem-ref (name-of self) :uint32))
  52     (gl:tex-parameter-i gl:+texture-2d+ gl:+texture-wrap-s+ gl:+repeat+)
  53     (gl:tex-parameter-i gl:+texture-2d+ gl:+texture-wrap-t+ gl:+repeat+)
  54     (gl:tex-parameter-i gl:+texture-2d+ gl:+texture-mag-filter+ gl:+linear+)
  55     (gl:tex-parameter-i gl:+texture-2d+ gl:+texture-min-filter+ gl:+linear+)
  56     (gl:pixel-store-i gl:+unpack-alignment+ 1)
  57     (gl:tex-env-f gl:+texture-env+ gl:+texture-env-mode+ gl:+decal+))
  58   (setf (slot-value self 'data)
  59         (cffi:foreign-alloc :uint32
  60                             :count (* (width-of self) (height-of self))
  61                             :initial-element 0)))
  62
  63 (defmethod update-image ((self rgba-image))
  64   "Upload an RGBA texture"
  65   (with-opengl
  66     (gl:bind-texture gl:+texture-2d+ (cffi::mem-ref (name-of self) :uint32))
  67     (gl:tex-image-2d gl:+texture-2d+ 0 gl:+rgba+
  68                      (width-of self) (height-of self)
  69                      0 gl:+rgba+ gl:+unsigned-byte+ (data-of self))))
  70
  71
  72 (defgeneric render (self &key target))
  73
  74 (defmethod render ((self rgba-image) &key target)
  75   "Render an RGBA texture"
  76   (declare (ignore target))
  77   (with-opengl
  78     (gl:bind-texture gl:+texture-2d+ (cffi::mem-ref (name-of self) :uint32))
  79     (gl:tex-env-f gl:+texture-env+ gl:+texture-env-mode+ gl:+decal+)
  80     (gl:with-begin gl:+quads+
  81       (gl:tex-coord-2i 0 0)
  82       (gl:vertex-2f -0.5 -0.5) ;; top lhs
  83       (gl:tex-coord-2i 1 0)
  84       (gl:vertex-2f  0.5 -0.5) ;; top rhs
  85       (gl:tex-coord-2i 1 1)
  86       (gl:vertex-2f  0.5  0.5) ;; bot rhs
  87       (gl:tex-coord-2i 0 1)
  88       (gl:vertex-2f -0.5  0.5)))) ;; bot lhs
  89
  90 (defmethod destroy-image ((self rgba-image))
  91   "Release the memory used by an RGBA texture"
  92   (setf (width-of self) 0)
  93   (setf (height-of self) 0)
  94   (with-opengl
  95     (gl:delete-textures 1 (name-of self))
  96     (cffi:foreign-free (name-of self))
  97     (cffi:foreign-free (data-of self))))
  98
  99
 100
 101 (defmethod image-size ((image rgba-image))
 102   "Overall RGBA texture size in bytes"
 103   (* (width-of image) (height-of image)))
 104
 105 (defmethod pixel ((image rgba-image) i)
 106   "Access a pixel in an RGBA texture"
 107   (cffi:mem-aref (data-of image) :uint32 i))
 108
 109 (defmethod (setf pixel) (pixel (image rgba-image) i)
 110   "Set a pixel in an RGBA texture"
 111   (setf (cffi:mem-aref (data-of image) :uint32 i) pixel))
 112
 113 (defmethod indexxy ((image rgba-image) index)
 114   "Map an i index to an x,y index of a RGBA texure"
 115   (values (mod index (width-of image))
 116           (rem index (width-of image))))
 117
 118 (defmethod xyindex ((image rgba-image) x y)
 119   "Map an x,y index to an i index of a RGBA texure"
 120   (+ x (* (width-of image) y)))
 121
 122 (defun map-color-to-pixel (r g b)
 123   "Convert rgb values to a pixel uint32"
 124   (declare ((unsigned-byte 8) r g b))
 125   (logior
 126    (ash r 24)
 127    (ash g 16)
 128    (ash b 8)
 129    #X0))
 130
 131
 132 ;; FIRST THINGS FIRST -- make a slow zoom into 0,0 work
 133 ;; make a colormap work
 134 ;; then take samples :-)
 135
 136 (declaim (ftype
 137           (function (fixnum fixnum)
 138                     (simple-array (unsigned-byte 8) *)) make-iteration-map))
 139
 140 (defclass iteration-map  ()
 141   ((width :reader width-of :initarg :width)
 142    (height :reader height-of :initarg :height)
 143    (map :reader map-of))
 144   (:documentation "A map of the results of iterating a function over a fixed range of values"))
 145
 146 (defmethod initialize-instance :after ((self iteration-map) &rest args)
 147   (declare (ignore args))
 148   (setf (slot-value self 'map) (make-array (* (width-of self) (height-of self)) :element-type '(unsigned-byte 8))))
 149
 150 (defmethod result ((image iteration-map) i)
 151   (aref (map-of image)  i))
 152
 153 (defmethod (setf result) (value (image iteration-map) i)
 154   (setf (aref (map-of image) i) value))
 155
 156 (defmethod indexxy ((image iteration-map) index)
 157   (values (mod index (width-of image))
 158           (rem index (width-of image))))
 159
 160 (defmethod xyindex ((image iteration-map) x y)
 161   (+ x (* (width-of image) y)))
 162
 163
 164 (defun make-iteration-mapper (iteration-map
 165                               iterated-function
 166                               escape-function)
 167   "Create an function to creat an iteration map of function on the given surface,
 168 in a region interpoalated between two region extents,"
 169   #'(lambda (region-fn alpha max-evaluations)
 170       (declare (type single-float alpha) (type fixnum max-evaluations))
 171       (labels
 172           ((evaluate-point (c)
 173              "Evaluate the iteration function for a given point"
 174              (declare (type (complex single-float) c))
 175              (let ((z #C(0.0 0.0)))
 176                (loop for eval-count of-type fixnum from 0 below max-evaluations
 177                   until (funcall escape-function z)
 178                   do  (setf z (funcall iterated-function z c))
 179                   finally (return eval-count)))))
 180         ;; work out the region we sample
 181         (multiple-value-bind
 182               (top-left bottom-right)
 183             (funcall region-fn alpha)
 184           (let*
 185               ((difference (- bottom-right top-left))
 186                (real-step (complex (/ (realpart difference)
 187                                       (width-of iteration-map))
 188                                    (- (imagpart difference))))
 189                (imag-step (complex 0.0
 190                                    (/ (imagpart difference)
 191                                       (height-of iteration-map))))
 192                (c top-left))
 193             ;; iterate over the region
 194             (dotimes (x (width-of iteration-map))
 195               (dotimes (y (height-of iteration-map))
 196                 (setf (result iteration-map (xyindex iteration-map x y)) (evaluate-point c))
 197                 (incf c imag-step))
 198               (incf c real-step))))
 199         (values))))
 200
 201 ;; to do -- zoom in on a defined region via lerping to a target
 202 ;; to do -- construct iteration map line by line
 203
 204
 205 (defun make-limit-interpolator (&key start-top-left start-bottom-right
 206                                 fin-top-left fin-bottom-right)
 207   "Construct a function to lerp between two sets of limits"
 208   (format t "Creating interpolator for ~A ~A ~A ~A~%"
 209           start-top-left start-bottom-right fin-top-left fin-bottom-right)
 210   #'(lambda (alpha)
 211       (declare (type single-float alpha))
 212       (values
 213        ;; max
 214        (+ start-top-left
 215           (* (- fin-top-left start-top-left) alpha))
 216        ;; to do -- min
 217        (+ start-bottom-right
 218           (* (- fin-bottom-right start-bottom-right) alpha)))))
 219
 220 (defun print-iteration-map (iteration-map width height)
 221   (dotimes (y width)
 222     (dotimes (x height)
 223       (if (>= (result iteration-map (xyindex iteration-map x y)) *max-iterations*)
 224           (format t "~C" #\*)
 225         (format t "~C" #\Space)))
 226     (format t "~%")))
 227
 228 ;;; TO DO -- update this and test sampling
 229 ;; ;; quicky test
 230 ;; (defun iteration-mapper-test (i-m width height max-iter)
 231 ;;   (let*
 232 ;;       ((interpolator (make-limit-interpolator
 233 ;;                       :start-top-left #C(-2.0 -2.0)
 234 ;;                       :start-bottom-right  #C(2.0 2.0)
 235 ;;                       :fin-top-left #C(-1.0 -1.0)
 236 ;;                       :fin-bottom-right #C(1.0 1.0)))
 237 ;;        (i-mapper (make-iteration-mapper i-m #'mandelbrot width height max-iter
 238 ;;                                         interpolator)))
 239
 240 ;;     (funcall  i-mapper 0.0)
 241 ;;     (print-iteration-map i-m 64 64 max-iter)
 242 ;;     (funcall i-mapper 1.0)
 243 ;;     (print-iteration-map i-m 64 64 max-iter)))
 244
 245 ;; color maps
 246
 247 (defun get-red (color-list)
 248   (cadr (assoc :red color-list)))
 249
 250 (defun get-green (color-list)
 251   (cadr (assoc :green color-list)))
 252
 253 (defun get-blue (color-list)
 254   (cadr (assoc :blue color-list)))
 255
 256 (defun get-point (color-list)
 257   (cadr (assoc :point color-list)))
 258
 259 (defun calc-normal-alpha (start end alpha)
 260   (* (- alpha start) (/ 1.0 (- end start))))
 261
 262 (defun lerp (v0 v1 alpha)
 263   (round  (+ v0
 264              (* (- v1 v0) alpha))))
 265
 266 (defun add-point-to-color-list (color-list point &key red green blue)
 267   (list
 268    `((:red . ,red)
 269      (:green . ,green)
 270      (:blue . ,blue)
 271      (:point . ,point))
 272    color-list))
 273
 274 (defun add-points-to-color-list (color-list points)
 275   (append
 276    (loop
 277     for point in points
 278     collect
 279     (destructuring-bind
 280         (p &key red green blue)
 281         point
 282       `((:red ,red)
 283         (:green ,green)
 284         (:blue ,blue)
 285         (:point ,p))))
 286    color-list))
 287
 288
 289 (defun sort-color-list (color-list)
 290   (sort color-list
 291         #'(lambda (x y)
 292             (< (cadr (assoc :point x))
 293                (cadr (assoc :point y))))))
 294
 295 (defun make-color-list-interpolator (color-list)
 296   (let
 297       ((sorted-color-list (sort-color-list color-list)))
 298     (lambda (alpha)
 299       (destructuring-bind
 300           (start end)
 301           (loop
 302            for next-color in sorted-color-list
 303            and color = nil then next-color
 304            when (<= alpha (cadr (assoc :point next-color)))
 305            return
 306            (list color next-color))
 307         (let
 308             ((normal-alpha
 309               (calc-normal-alpha
 310                (get-point start)
 311                (get-point end)
 312                alpha)))
 313           (values
 314            (lerp (get-red start) (get-red end) normal-alpha)
 315            (lerp (get-green start) (get-green end) normal-alpha)
 316            (lerp (get-blue start) (get-blue end) normal-alpha)))))))
 317
 318
 319
 320 (defun render-fractal-map  (iteration-map image color-interpolator)
 321   (let
 322       ((width (width-of image))
 323        (height (height-of image))
 324        (iter-limit (coerce *max-iterations* 'single-float)))
 325     (loop for x from 0 below width do
 326          (loop for y from 0 below height do
 327               (multiple-value-bind
 328                     (red green blue)
 329                   (funcall color-interpolator
 330                            (/ (result iteration-map (xyindex iteration-map x y)) iter-limit))
 331                 (setf (pixel image (xyindex image x y))
 332                       (map-color-to-pixel
 333                        red green blue))))))
 334   (update-image image)
 335   (render image))
 336
 337 ;; to do -- check real == x & imag == y
 338 (defun calc-iteration-map-limits (width height
 339                                   sample-x sample-y
 340                                   sample-width sample-height
 341                                   top-left bottom-right)
 342   "Given an iteration map with the given width and height, and a sample
 343 at the given position and size, work out the real and imaginary
 344 dimensions of the sample and return a suitable interpolation fn"
 345   (let*
 346       ((real-width
 347         (realpart (- bottom-right top-left)))
 348        (imag-width
 349         (imagpart (- bottom-right top-left)))
 350        (real-scale (/ real-width width))
 351        (imag-scale (/ imag-width height)))
 352
 353     (make-limit-interpolator
 354      :start-top-left top-left
 355      :start-bottom-right bottom-right
 356      :fin-top-left
 357      (complex (* sample-x real-scale)
 358               (* sample-y imag-scale))
 359      :fin-bottom-right
 360      (complex
 361       (+
 362        (* sample-x real-scale)
 363        (* sample-width real-scale))
 364       (+
 365        (* sample-y imag-scale)
 366        (* sample-height imag-scale))))))
 367
 368 (defclass sample (iteration-map)
 369   ((x :accessor x-of :initarg :sample-x)
 370    (y :accessor y-of :initarg :sample-y)
 371    (colour-count :accessor colours-in :initform 0)))
 372
 373 ;; to do -- wouldn't it be better to pass in a function to this
 374 ;; to operate on the sample and return a result, rather than
 375 ;; building a huje list of samples?
 376 (defun take-map-sample (iteration-map x y
 377                                       sample-width sample-height)
 378   "Return an sampled area in the iteration map"
 379   (let
 380       ((sample (make-instance 'sample
 381                               :sample-x x
 382                               :sample-y y
 383                               :width sample-width
 384                               :height sample-height)))
 385     (dotimes (dx sample-width)
 386       (dotimes (dy sample-height)
 387         (setf (pixel sample (xyindex sample  dx dy))
 388               (pixel iteration-map (xyindex iteration-map  (+ x dx) (+ y dy))))))
 389     sample))
 390
 391
 392 (defun sample-map (iteration-map width height sample-width sample-height sample-count)
 393   "Return a list of random samples of areas of a given size in the
 394 iteration map"
 395   (iterate
 396    (for sample-index from 0 below sample-count)
 397    (for sample-x =  (random (- width sample-width)))
 398    (for sample-y = (random (- height sample-height)))
 399    (collect
 400     (take-map-sample iteration-map
 401                      sample-x sample-y sample-width sample-height))))
 402
 403 (defun sample-frequency (sample)
 404   "Return the number of distinct colours in the sample"
 405   (dotimes (color-index 255)
 406     (when (find color-index (map-of sample))
 407       (incf (colours-in sample)))))
 408
 409
 410 (defun mandelbrot (z c)
 411   "Evaluate an iteration of the mandelbrot set function."
 412   (declare ((complex single-float) z c))
 413   (the (complex single-float)
 414     (+ (expt z 2) c)))
 415
 416
 417 (defun norm-squared-escape (z)
 418   "Return the squared normal of the complex number"
 419   (declare ((complex single-float) z))
 420   (let ((real-part (realpart z))
 421         (imag-part (imagpart z)))
 422     (declare (single-float real-part imag-part))
 423     (>= (the single-float
 424           (+ (expt real-part 2)
 425              (expt imag-part 2)))
 426         +squared-limit+)))
 427
 428 (defvar *esc-pressed* nil)
 429
 430 (cffi:defcallback key-callback :void ((key :int) (action :int))
 431                   (when (eql action glfw:+press+)
 432                     (cond
 433                      ((eql key glfw:+key-esc+)  (setf *esc-pressed* t)
 434                       ))))
 435
 436 (cffi:defcallback window-size-callback :void ((width :int) (height :int))
 437                   (gl:viewport 0 0 width height))
 438
 439
 440
 441
 442
 443 ;;  (sdl::update-surface :surface video-surface)
 444 ;;  (sdl::update-display video-surface)
 445 ;;              (when (= sample-index samples-between-extents)
 446 ;;                (let*
 447 ;;                    ((sample-width (round (/ width 128)))
 448 ;;                     (sample-height (round (/ height 128)))
 449 ;;                     (sample-area (* sample-width sample-height)))
 450 ;;                  (format t "Resampling using 42 samples of ~D x ~D pixels~%" sample-width sample-height)
 451 ;;                ;; time to resample
 452 ;;                  (let*
 453 ;;                      ((samples
 454 ;;                        (sort
 455 ;;                         (sample-map iteration-map width height
 456 ;;                                    sample-width sample-height
 457 ;;                                    42)
 458 ;;                         #'(lambda (sample0 sample1)
 459 ;;                             (> (sample-frequency sample1)
 460 ;;                                (sample-frequency sample0)))))
 461 ;;                       (selected-sample
 462 ;;                        (car samples)))
 463 ;;                    (format t "Picking sample with frequency ~D~%"
 464 ;;                            (sample-frequency (car samples)))
 465 ;;                       (let*
 466 ;;                           ((sample-x (cadr (assoc :sample-x selected-sample)))
 467 ;;                            (sample-y (cadr (assoc :sample-y selected-sample))))
 468 ;;                         (multiple-value-bind
 469 ;;                               (start-top-left start-bottom-right)
 470 ;;                             (funcall interpolator-fn 1.0)
 471 ;;                           (setf interpolator-fn
 472 ;;                                 (calc-iteration-map-limits
 473 ;;                                  width height
 474 ;;                                  sample-x sample-y
 475 ;;                                  sample-width sample-height
 476 ;;                                  start-top-left start-bottom-right))
 477 ;;                           (setf sample-index 0)))))))
 478
 479
 480 (defparameter *texture-names* nil)
 481
 482 (defun init-gl ()
 483   ;;  Disable stuff that's likely to slow down glRenderPixels.
 484   ;;  (Omit as much of this as possible, when you know in advance
 485   ;;   that the OpenGL state will already be set correctly.)
 486   (gl:enable gl:+texture-2d+)
 487   (gl:matrix-mode gl:+projection+)
 488   (gl:load-identity)
 489   (gl:matrix-mode gl:+modelview+)
 490   (gl:load-identity))
 491
 492
 493 (defun end-gl ()
 494   ())
 495
 496 (defparameter *frame-count* 0)
 497 (defparameter *height* 480)
 498 (defparameter *width* 640)
 499 (defparameter *max-iterations* 16)
 500
 501
 502 (defparameter *max-frames* 128)
 503
 504 (defun pixel-toast ()
 505   (glfw:with-init-window
 506       ("Mandelbrot" *width* *height*)
 507     (glfw::enable glfw:+key-repeat+)
 508     (glfw:set-window-size-callback (cffi:callback window-size-callback))
 509     (init-gl)
 510     (glfw:set-key-callback (cffi:callback key-callback))
 511     (glfw:swap-interval 1)
 512     (let*
 513         ((frame 0)
 514          (image (make-instance 'rgba-image))
 515          (iteration-map (make-instance 'iteration-map :width *width* :height *height*))
 516          (color-list
 517           (add-points-to-color-list
 518            nil
 519            '((0.0 :red 255 :green 255 :blue 255)
 520              (0.1 :red 64 :green 0 :blue 64)
 521              (0.5 :red 0 :green 64 :blue 64)
 522              (1.0 :red 64 :green 63 :blue 0))))
 523          (color-interpolator
 524           (make-color-list-interpolator color-list))
 525          (region-fn
 526           (make-limit-interpolator :start-top-left #C(-2.0 -2.0)
 527                                    :start-bottom-right #C(2.0 2.0)
 528                                    :fin-top-left #C(-1.0 -1.0)
 529                                    :fin-bottom-right #C(1.0 1.0)))
 530          (fractal-mapper (make-iteration-mapper
 531                           iteration-map
 532                           #'mandelbrot
 533                           #'norm-squared-escape)))
 534       (setf cowl:*root-widget* (cowl::make-label "Yotta zoomer" :x 128 :y  128))
 535       (make-image image :width *width* :height *height*)
 536       (iterate
 537         (while (and  (not *esc-pressed*)
 538                      (eql (glfw:get-window-param glfw:+opened+) gl:+true+)
 539                      (< frame *max-frames*)))
 540         (gl:clear gl:+color-buffer-bit+)
 541         (setf (pixel image (xyindex image (random *width*) (random *height*))) (map-color-to-pixel 255 0 0))
 542         (funcall fractal-mapper region-fn (coerce (/ frame *max-frames*) 'single-float) *max-iterations*)
 543         (render-fractal-map iteration-map image color-interpolator)
 544         (update-image image)
 545         (render image)
 546         (incf frame)
 547          (cowl:layout-root)
 548          (cowl:draw-root)
 549         (glfw:swap-buffers)
 550         (cl:sleep 0.1)
 551         (format *debug-io* "Frame ~A ~%" frame))
 552       (destroy-image image)
 553       (end-gl)
 554       (if (eql (glfw:get-window-param glfw:+opened+) gl:+true+)
 555                (glfw:close-window))
 556       (glfw:terminate))))
 557
 558
 559 ;; (defparameter *image* nil)
 560 ;; (glfw:with-init-window ("A Simple Example" 640 480)
 561 ;;   (gl:with-setup-projection
 562 ;;     (glu:perspective 45 4/3 0.1 50)
 563 ;;     (setf *image* (make-instance 'rgba-image))
 564 ;;     (make-image *image* :width 320 :height 200))
 565 ;;   (iterate
 566 ;;     (while (= cl-glfw:+true+ (cl-glfw:get-window-param cl-glfw:+opened+)))
 567 ;;     (gl:clear gl:+color-buffer-bit+)
 568 ;;     (gl:load-identity)
 569 ;;     (gl:translate-f 0 0 -5)
 570 ;;     (gl:rotate-f (* 10 (glfw:get-time)) 1 1 0)
 571 ;;     (gl:rotate-f (* 90 (glfw:get-time)) 0 0 1)
 572 ;;     (render *image*)
 573 ;;     (gl:with-begin gl:+triangles+
 574 ;;       (gl:color-3f 1 0 0) (gl:vertex-3f  1  0 0)
 575 ;;       (gl:color-3f 0 1 0) (gl:vertex-3f -1  1 0)
 576 ;;       (gl:color-3f 0 0 1) (gl:vertex-3f -1 -1 0))
 577 ;;     (cl-glfw:swap-buffers)))
 578
 579 ;; (defun pixel-toast (width height frames-between-samples)
 580 ;;   (glfw:with-open-window
 581 ;;    ("Mandelbrot" width height)
 582 ;;    (glfw::enable glfw:+key-repeat+)
 583 ;;    (glfw:swap-interval 0)
 584 ;;    (glfw:set-window-size-callback (cffi:callback window-size-callback))
 585 ;;    (glfw:set-key-callback (cffi:callback key-callback))
 586 ;;    (init-gl)
 587 ;;    (let*
 588 ;;        ((frame        0)
 589 ;;
 590 ;;         )
 591 ;;
 592
 593
 594 ;; ;; to do -- maybe pass in interpolator to iteration-mapper
 595 ;; ;; to do -- maybe have a n pass iteration map - do the escapes for 1 limit, then 2 limit
 596 ;; (dglDrefun fractal-toast (width height samples-between-extents fn-iterations)
 597 ;;   (let*
 598 ;;       ((sample-index 0)
 599 ;;        (iteration-map (make-iteration-map
 600 ;;                        ;; to do
 601 ;;                        width height))
 602 ;;        (color-list
 603 ;;         (add-points-to-color-list
 604 ;;          nil
 605 ;;          '((0.0 :red 255 :green 255 :blue 255)
 606 ;;            (0.1 :red 64 :green 0 :blue 64)
 607 ;;            (0.5 :red 0 :green 64 :blue 64)
 608 ;;            (1.0 :red 64 :green 63 :blue 0))))
 609 ;;        (color-interpolator
 610 ;;         (make-color-list-interpolator color-list))
 611 ;;        (interpolator-fn
 612 ;;         (make-limit-interpolator :start-top-left #C(-2.0 -2.0)
 613 ;;                                  :start-bottom-right #C(2.0 2.0)
 614 ;;                                  :fin-top-left #C(-1.0 -1.0)
 615 ;;                                  :fin-bottom-right #C(1.0 1.0)))
 616 ;;        (iteration-mapper
 617 ;;         (make-iteration-mapper
 618 ;;          iteration-map
 619 ;;          #'mandelbrot
 620 ;;          #'norm-squared-escape
 621 ;;          width height
 622 ;;          fn-iterations
 623 ;;          interpolator-fn)))
 624 ;;     (declare (fixnum width height sample-index))
 625 ;;  (glfw:do-window ("Mandelbrot")
 626 ;;    ((glfw::enable glfw:+key-repeat+)
 627 ;;     (glfw:swap-interval 0)
 628 ;;     (glfw:set-window-size-callback (cffi:callback window-size-callback))
 629 ;;     (glfw:set-key-callback (cffi:callback key-callback))
 630 ;;     (init-gl))
 631 ;;    (render iteration-mapper (/ sample-index samples-between-extents))
 632 ;;    (incf sample-index)
 633 ;;    (glfw::swap-buffers))))
 634
 635
 636
 637
 638
 639