Fri Apr  3 00:16:06 CEST 2009  Tobias Rautenkranz <tobias@rautenkranz.ch>
  * initial import
--- old-kde.examples/src/mandelbrot/render.lisp	1970-01-01 01:00:00.000000000 +0100
+++ new-kde.examples/src/mandelbrot/render.lisp	2014-10-30 08:42:02.000000000 +0100
@@ -0,0 +1,114 @@
+;;; Copyright (C) 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>
+;;; Copyright (C) 2009 Nokia Corporation and/or its subsidiary(-ies).
+;;;
+;;; This library is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public
+;;; License as published by the Free Software Foundation; either
+;;; version 2.1 of the License, or (at your option) any later version.
+;;; 
+;;; This library is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; Lesser General Public License for more details.
+;;; 
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this library; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
+;;; 
+
+(in-package :kde.examples)
+
+(declaim (optimize (debug 3)))
+
+(defun make-image (width height)
+  (make-instance 'qt:image :args (list width height
+                                       qt:image.+format-rgb32+)))
+
+(declaim (inline z_0))
+(defun z_0 ()
+  #C(0d0 0d0))
+
+(declaim (inline z_n+1))
+(defun z_n+1 (z_n c)
+  (+ (expt z_n 2) c))
+
+(declaim (inline make-complex))
+(defun make-complex (realpart imagpart)
+  (+ (float realpart 0d0) (* imagpart #C(0d0 1d0))))
+  
+
+(defun diverge-p (c iterations)
+  (declare (type (complex double-float) c)
+           (type fixnum iterations)
+           (optimize (speed 3) (debug 3) (safety 3)))
+  (let ((z (z_0)))
+    (declare (type (complex double-float) z))
+    (dotimes (n iterations nil)
+      (setf z (z_n+1 z c))
+      (when (> (+ (expt (realpart z) 2) (expt (imagpart z) 2)) 4)
+        (return n)))))
+
+
+(declaim (inline div-to-color))
+(defun div-to-color (n iterations)
+  (declare (type fixnum n iterations))
+  (let ((grey (- #xFF (min #xFF n))))
+    (+ #xFF000000
+       (* #x010000 grey)
+       (* #x000100 grey)
+       (* #x000001 grey))))
+
+(defclass render-control ()
+  ((done-signal :initform (qt:make-signal (find-class 'qt:image)
+                                          (find-class 'double-float))
+                :reader done-signal
+                :documentation "Signals that an image is ready.")
+   (mutex :initform (sb-thread:make-mutex)
+          :accessor mutex)
+   (stop-p :initform nil)))
+
+(defun stop-p (render-control)
+  (sb-thread:with-mutex ((mutex render-control))
+    (slot-value render-control 'stop-p)))
+
+(defmacro if-stop-p (render-control then else)
+  `(sb-thread:with-mutex ((mutex ,render-control))
+     (if (slot-value ,render-control 'stop-p)
+         ,then
+         ,else)))
+
+(defun (setf stop-p) (new-value control)
+  (sb-thread:with-mutex ((mutex control))
+    (setf (slot-value control 'stop-p)
+          new-value)))
+  
+;;;a : x width
+;;;b : y height
+(defun render (center scale width height control)
+  (declare (fixnum width height)
+           (type (complex double-float) center)
+           (double-float scale)
+           (optimize (speed 3)))
+  (let ((image (make-image width height))
+        (top-left (- (/ (complex width height) 2))))
+    (dotimes (pass 1)
+      (let ((iterations 200))      ;(+ (expt 2 (+ (* 2 pass) 6)) 32)))
+        (dotimes (y height)
+          (when (stop-p control)
+            (return))
+          (let ((scanline (cxx:scan-line image y)))
+            (dotimes (x width)
+              (let ((diverge (diverge-p (+ (* scale (+ top-left (make-complex x y))) center) iterations)))
+                (if diverge
+                    (setf (cffi:mem-ref scanline :unsigned-int)
+                          (div-to-color diverge iterations))
+                    (setf (cffi:mem-ref scanline :unsigned-int)
+                          #.(qt:q-rgb 0 0 0))))
+              (cffi:incf-pointer scanline
+                                 (cffi:foreign-type-size :unsigned-int))))))
+      (if-stop-p control
+                 (return)
+                 (funcall (done-signal control) image scale)))))
+
+(defun make-render-function (center scale width height done-signal)
+  #'(lambda () (render center scale width height done-signal)))