repos
/
kde.examples
/ annotate_shade
summary
|
shortlog
|
log
|
tree
|
commit
|
commitdiff
|
headdiff
|
annotate
|
headblob
|
headfilediff
|
filehistory
normal
|
plain
|
shade
|
zebra
License
Annotate for file src/mandelbrot/render.lisp
2009-04-02 tobias
1
;;; Copyright (C) 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>
22:16:06 '
2
;;; Copyright (C) 2009 Nokia Corporation and/or its subsidiary(-ies).
'
3
;;;
2009-04-14 tobias
4
;;; This program is free software: you can redistribute it and/or modify
14:32:06 '
5
;;; it under the terms of the GNU General Public License as published by
'
6
;;; the Free Software Foundation, either version 3 of the License, or
'
7
;;; (at your option) any later version.
'
8
;;;
'
9
;;; This program is distributed in the hope that it will be useful,
2009-04-02 tobias
10
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
2009-04-14 tobias
11
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14:32:06 '
12
;;; GNU General Public License for more details.
'
13
;;;
'
14
;;; You should have received a copy of the GNU General Public License
'
15
;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
2009-04-02 tobias
16
2010-04-03 tobias
17
(in-package :kde.examples)
2009-04-02 tobias
18
22:16:06 '
19
(defun make-image (width height)
'
20
(make-instance 'qt:image :args (list width height
'
21
qt:image.+format-rgb32+)))
'
22
'
23
(declaim (inline z_0))
'
24
(defun z_0 ()
'
25
#C(0d0 0d0))
'
26
'
27
(declaim (inline z_n+1))
'
28
(defun z_n+1 (z_n c)
'
29
(+ (expt z_n 2) c))
'
30
'
31
(declaim (inline make-complex))
'
32
(defun make-complex (realpart imagpart)
'
33
(+ (float realpart 0d0) (* imagpart #C(0d0 1d0))))
'
34
'
35
'
36
(defun diverge-p (c iterations)
'
37
(declare (type (complex double-float) c)
'
38
(type fixnum iterations)
'
39
(optimize (speed 3) (debug 3) (safety 3)))
'
40
(let ((z (z_0)))
'
41
(declare (type (complex double-float) z))
'
42
(dotimes (n iterations nil)
'
43
(setf z (z_n+1 z c))
'
44
(when (> (+ (expt (realpart z) 2) (expt (imagpart z) 2)) 4)
'
45
(return n)))))
'
46
'
47
'
48
(declaim (inline div-to-color))
'
49
(defun div-to-color (n iterations)
'
50
(declare (type fixnum n iterations))
'
51
(let ((grey (- #xFF (min #xFF n))))
'
52
(+ #xFF000000
'
53
(* #x010000 grey)
'
54
(* #x000100 grey)
'
55
(* #x000001 grey))))
'
56
'
57
(defclass render-control ()
'
58
((done-signal :initform (qt:make-signal (find-class 'qt:image)
'
59
(find-class 'double-float))
'
60
:reader done-signal
'
61
:documentation "Signals that an image is ready.")
'
62
(mutex :initform (sb-thread:make-mutex)
'
63
:accessor mutex)
'
64
(stop-p :initform nil)))
'
65
'
66
(defun stop-p (render-control)
'
67
(sb-thread:with-mutex ((mutex render-control))
'
68
(slot-value render-control 'stop-p)))
'
69
'
70
(defmacro if-stop-p (render-control then else)
'
71
`(sb-thread:with-mutex ((mutex ,render-control))
'
72
(if (slot-value ,render-control 'stop-p)
'
73
,then
'
74
,else)))
'
75
'
76
(defun (setf stop-p) (new-value control)
'
77
(sb-thread:with-mutex ((mutex control))
'
78
(setf (slot-value control 'stop-p)
'
79
new-value)))
'
80
'
81
;;;a : x width
'
82
;;;b : y height
'
83
(defun render (center scale width height control)
'
84
(declare (fixnum width height)
'
85
(type (complex double-float) center)
'
86
(double-float scale)
'
87
(optimize (speed 3)))
'
88
(let ((image (make-image width height))
'
89
(top-left (- (/ (complex width height) 2))))
'
90
(dotimes (pass 1)
'
91
(let ((iterations 200)) ;(+ (expt 2 (+ (* 2 pass) 6)) 32)))
'
92
(dotimes (y height)
'
93
(when (stop-p control)
'
94
(return))
'
95
(let ((scanline (cxx:scan-line image y)))
'
96
(dotimes (x width)
'
97
(let ((diverge (diverge-p (+ (* scale (+ top-left (make-complex x y))) center) iterations)))
'
98
(if diverge
'
99
(setf (cffi:mem-ref scanline :unsigned-int)
'
100
(div-to-color diverge iterations))
'
101
(setf (cffi:mem-ref scanline :unsigned-int)
'
102
#.(qt:q-rgb 0 0 0))))
'
103
(cffi:incf-pointer scanline
'
104
(cffi:foreign-type-size :unsigned-int))))))
'
105
(if-stop-p control
'
106
(return)
'
107
(funcall (done-signal control) image scale)))))
'
108
'
109
(defun make-render-function (center scale width height done-signal)
'
110
#'(lambda () (render center scale width height done-signal)))