Common Lisp (6) - praktický príklad

Vykreslenie Mandelbrotovej množiny.

(asdf:defsystem #:mandelbrot
  :depends-on (#:sdl)
  :components ((:file "mandelbrot")))

A začiatok zdrojového súboru mandelbrot.lisp (znovu exportujeme funkciu start):

(defpackage #:mandelbrot
  (:use #:cl #:sdl)
  (:export #:start))
 
(in-package #:mandelbrot)

Teraz môžeme začať písať kód. Základný výpočet Mandelbrotovej množiny je celkom jednoduchý, dokonca aj na Wikipedii tvorí malú časť celého článku. Prepíšeme si nasledujúci pseudokód do Lispu:

For each pixel on the screen do:
{
  x = x0 = x co-ordinate of pixel
  y = y0 = y co-ordinate of pixel

  iteration = 0
  max_iteration = 1000
 
  while ( x*x + y*y <= (2*2)  AND  iteration < max_iteration ) 
  {

    xtemp = x*x - y*y + x0
    y = 2*x*y + y0

    x = xtemp

    iteration = iteration + 1
  }
 
  if ( iteration == max_iteration ) 
  then 
    colour = black
  else 
    colour = iteration

  plot(x0,y0,colour)
}

Tento výpočet môžeme realizovať s jednoduchým použitím makra do (pre jednoduchšie konštrukcie existujú zjednodušené verzie dolist a dotimes):

(do ((var1 init-form [step-form])
     ...)
    (end-form
     [result-form])
    body*)

Prvý je zoznam premenných, ktorým sa priradia počiatočné hodnoty a po každej iterácii je možné im priradiť novú hodnotu. Ďalší je zoznam, ktorý obsahuje test na ukončenie (ukončí sa ak je výsledok pravdivý) a voliteľnú návratovú hodnotu. Ďalej nasledujú výrazy, ktoré sa majú vykonávať pri každej iterácii. Toto makro nám poskytuje také možnosti, že telo ani nevyužijeme:

(defun mandelbrot (x0 y0)
  (do ((iteration 0 (1+ iteration))
       (x 0 (+ x0 (- (* x x) (* y y))))
       (y 0 (+ y0 (* 2 x y) )))
      ((or (> (+ (* x x) (* y y)) 4)
           (>= iteration *iterations*))
       (if (= iteration *iterations*) nil iteration))))

V každej iterácii inkrementujeme premennú iteration a premenným x a y priradíme hodnotu podľa výpočtu. Výpočet a priradenie nových hodnôt môžeme spraviť narozdiel od pseudokódu v jednom kroku, pretože hodnoty sú najskôr vypočítané a potom priradené (paralelne), variant do* priradzuje postupne (sekvenčne). Takéto postupné priradenie spôsobuje zaujímavú deformáciu. Náš test na ukončenie je negovaný oproti pôvodnému, pretože sa používa v opačnom význame. Po splnení podmienky vrátime počet iterácii, resp. nil ak by sme ešte pokračovali (je to prvok množiny).

Teraz už len nejak tento výpočet zužitkovať. Globálne funkcie ovplyvňujúce zobrazenie a inicializácia SDL:

;; súbor pre screenshot
(defvar *file* "mandelbrot.bmp")
 
;; inicializácia SDL
(defvar *width* 640)
(defvar *height* 480)
(defvar *bpp* 24)
(defvar *flags* (logior sdl:+resizable+
                        sdl:+swsurface+))
 
;; obdĺžnik v komplexnej rovine, ktorý vykreslujeme
(defvar *rect* nil)
;; počet iterácií pre pixel
(defvar *iterations* 256)
;; priblíženie
(defvar *zoom* 1.0)
 
(defun init-sdl ()
  (sdl:init (logior sdl:+init-video+))
  (let ((surface (sdl:set-video-mode *width* *height* *bpp* *flags*)))
    (when (sgum:null-pointer-p surface)
      (error "Unable to set video mode"))
    (sdl:wm-set-caption "CL-SDL Mandelbrot set" nil)
    surface))

S našimi znalosťami nie je problém rozlúštiť ani nasledujúcu dlhú a nudnú funkciu (číselné kódy označujú šípky, ďalšie použité klávesy sú R na prekreslenie, W/E pre zoom, S pre uloženie a Q pre ukončenie).

(defun run-sdl-event-loop (surface pixel-fn)
  (sdl:event-loop
   (:key-down (scan-code key mod unicode)
              (cond ((= key (char-code #\q))
                     (return))
                    ((= key (char-code #\w))
                     (incf *zoom* 0.45))
                    ((= key (char-code #\e))
                     (decf *zoom* 0.45))
                    ((= key 273)
                     (incf (second *rect*) 0.1)
                     (incf (fourth *rect*) 0.1))
                    ((= key 274)
                     (decf (second *rect*) 0.1)
                     (decf (fourth *rect*) 0.1))
                    ((= key 275)
                     (incf (first *rect*) 0.1)
                     (incf (third *rect*) 0.1))
                    ((= key 276)
                     (decf (first *rect*) 0.1)
                     (decf (third *rect*) 0.1))
                    ((= key (char-code #\s))
                     (sdl:save-bmp surface *file*))
                    ((= key (char-code #\r))
                     (plot surface *rect* pixel-fn)))
              (format t "zoom: ~f~%rect: ~{~f ~}~%" *zoom* *rect*))
   (:key-up (scan-code key mod unicode)
            (cond ((= key (char-code #\q))
                   (return))))
   (:quit ()
          (return))
   (:resize (width height)
            (setf *width* width
                  *height* height
                  surface (sdl:set-video-mode *width* *height* *bpp* *flags*)))
   (:idle ()
          (sleep 0.05))))

Taktiež funkcia pre štart nášho programu:

(defun start (&key (rect nil rect-p) (transform-name :greyscale))
  (if rect-p
      (setf *rect* rect)
      (setf *rect* (list -2.2 1.2 0.8 -1.2)))
  (unwind-protect
       (progn
         (let ((surface (init-sdl)))
           (run-sdl-event-loop surface (make-pixel-fn transform-name))))
    (sdl:quit)))

Transformačná funkcia v našom programe spôsobí sfarbenie podľa návratovej hodnoty (nil alebo počet iterácií). Tu je funkcia, ktorá nám vráti kresliacu funkciu:

(defun make-pixel-fn (name)
  (cond
    ((equal name :pure)
     #'(lambda (surface x y colour)
         (if (null colour)
             (cl-sdl:draw-pixel surface x y 0 0 0
              :check-lock-p nil :update-p nil :clipping-p nil)
             (cl-sdl:draw-pixel surface x y 255 255 255
              :check-lock-p nil :update-p nil :clipping-p nil))))
    ((equal name :colours)
     (let ((palette '((  0  0  0) (  0  0 170) (  0 170  0) (  0 170 170) 
                      (170  0  0) (170  0 170) (170  85  0) (170 170 170) 
                      ( 85 85 85) ( 85 85 255) ( 85 255 85) ( 85 255 255) 
                      (255 85 85) (255 85 255) (255 255 85) (255 255 255))))
       #'(lambda (surface x y colour)
           (let ((c (nth (mod (or colour 0) 16) palette)))
             (cl-sdl:draw-pixel surface x y (first c) (second c) (third c)
              :check-lock-p nil :update-p nil :clipping-p nil)))))
    ((equal name :redscale)
     #'(lambda (surface x y colour)
         (if (null colour)
             (cl-sdl:draw-pixel surface x y 0 0 0
              :check-lock-p nil :update-p nil :clipping-p nil)
             (let ((c (ash colour 16)))
               (cl-sdl:draw-pixel surface x y 
                                  (mod (* 8 (ldb (byte 8 16) c)) 256)
                                  (mod (* 8 (ldb (byte 8 8) c)) 256)
                                  (mod (* 8 (ldb (byte 8 0) c)) 256)
                                  :check-lock-p nil
                                  :update-p nil
                                  :clipping-p nil)))))
    ((equal name :greyscale)
     #'(lambda (surface x y colour)
         (if (null colour)
             (cl-sdl:draw-pixel surface x y 0 0 0
              :check-lock-p nil :update-p nil :clipping-p nil)
             (let ((c (mod (ash colour 3) 256)))
               (cl-sdl:draw-pixel surface x y c c c
                :check-lock-p nil :update-p nil :clipping-p nil)))))))

Teraz nám už chýba len funkcia, ktorá pre všetky pixely spraví výpočet a vykreslí bod (táto funkcia prepočítava polohu bodu pixelu na polohu v obdĺžniku, ktorý naozaj vykreslujeme). Zase je to jednoduchá funkcia, kde aplikujeme základné poznatky. with-possible-lock-and-update používame na uzamknutie, pretože budeme zakreslovať pixely, na konci sa celá obrazovka prekreslí.

(defun plot (surface rect pixel-fn)
  (let ((x0 (first rect))
        (y0 (second rect))
        (x1 (third rect))
        (y1 (fourth rect)))
    (with-possible-lock-and-update (surface t t 0 0 *width* *height*)
      (let ((x-step (float (/ (/ (abs (- x0 x1)) *width*) *zoom*)))
            (y-step (float (/ (/ (abs (- y0 y1)) *height*) *zoom*))))
        (loop :for y :from 0 :below *height* :do
           (loop :for x :from 0 :below *width* :do
              (funcall pixel-fn surface x y (mandelbrot
                                             (float (+ x0 (* x-step x)))
                                             (float (- y0 (* y-step y)))))))))))

Makro with-possible-lock-and-update je požičané z knižnice cl-sdl a preto ho tu ani nebudem uvádzať.

A to je všetko (kompletný zdrojový kód). Pre záujemcov dávam k dispozícii optimalizovaný zdrojový kód (natívne kresliace funkcie knižnice a deklarácie typov premenných), na testovacom počítači bolo zobrazenie 640×480 vykreslené viac než 15x rýchlejšie. Nabudúce si trochu priblížime makrá.