;;; 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)))