repos
/
qt.examples
/ annotate_shade
summary
|
shortlog
|
log
|
tree
|
commit
|
commitdiff
|
headdiff
|
annotate
|
headblob
|
headfilediff
|
filehistory
normal
|
plain
|
shade
|
zebra
modular smoke & cleanup.
Annotate for file src/origami/origami.lisp
2010-01-10 tobias
1
;;; OpenGL Pleated Hyperbolic Paraboloid
2009-07-06 tobias
2
;;;
21:50:38 '
3
;;; Construction using the method in:
2010-01-10 tobias
4
;;;
2009-07-06 tobias
5
;;; (Non)existence of Pleated Folds: How Paper Folds Between Creases
21:50:38 '
6
;;;
2010-01-10 tobias
7
;;; Erik D. Demaine, Martin L. Demaine, Vi Hart, Gregory N. Price,
08:54:26 '
8
;;; Tomohiro Tachi
'
9
;;;
'
10
;;; http://arxiv.org/abs/0906.4747
'
11
;;;
'
12
;;; Section 6: Existence of Triangulated Hyperbolic Paraboloid
2009-07-06 tobias
13
21:50:38 '
14
(in-package :qt.examples)
'
15
'
16
(defun triangulid-length (n diagonal-part-length)
'
17
"Length of the extra fold from ring N to the next."
'
18
(sqrt (+ (expt (* n diagonal-part-length) 2)
'
19
(expt (* (1+ n) diagonal-part-length) 2))))
'
20
'
21
(defun length-in-diagonal-plane (distance-to-plane length)
'
22
"Length in the r z plane."
'
23
(sqrt (- (expt length 2)
'
24
(expt distance-to-plane 2))))
'
25
'
26
(defun next-vertex (z-x r-x z-y diagonal-part-length
'
27
length-in-diagonal-plane n)
'
28
(multiple-value-bind (r-1 z-1)
'
29
(v1 z-x z-y
'
30
r-x
'
31
diagonal-part-length
'
32
length-in-diagonal-plane)
'
33
(multiple-value-bind (r-2 z-2)
'
34
(v2 z-x z-y
'
35
r-x
'
36
diagonal-part-length
'
37
length-in-diagonal-plane)
'
38
;; alternate valley and mountain fold
'
39
(if (or (and (> z-1 z-2)
'
40
(evenp n))
'
41
(and (< z-1 z-2)
'
42
(oddp n)))
'
43
(values z-1 r-1)
'
44
(values z-2 r-2)))))
'
45
'
46
(defun make-grid-points (fold-angle n)
'
47
"Returns the vertex points for FOLD-ANGLE of the center diagonal
'
48
and N rings."
'
49
;; Cylindrical coodinates (θ = 0 or θ = π/2)
'
50
;; the x and y axes are the diagonals of the square paper.
'
51
;; Due to symetry only one fourth need to be calculated.
'
52
(let (;; θ = 0
'
53
(z-x (make-array n
'
54
:element-type 'double-float
'
55
:initial-element 0d0))
'
56
(r-x (make-array n
'
57
:element-type 'double-float
'
58
:initial-element 0d0))
'
59
;; θ = π/2
'
60
(z-y (make-array n
'
61
:element-type 'double-float
'
62
:initial-element 0d0))
'
63
'
64
(r-y (make-array n
'
65
:element-type 'double-float
'
66
:initial-element 0d0))
'
67
(diagonal-part-length 1d0))
'
68
;; the innermost square
'
69
(setf (aref r-x 0) diagonal-part-length)
'
70
(setf (aref z-y 0)
'
71
(- (* (cos (/ fold-angle 2)) diagonal-part-length))
'
72
(aref r-y 0)
'
73
(* (sin (/ fold-angle 2)) diagonal-part-length))
'
74
'
75
(dotimes (ring (1- n))
'
76
(let ((length-in-diagonal-plane
'
77
(length-in-diagonal-plane (aref r-y ring)
'
78
(triangulid-length
'
79
(1+ ring)
'
80
diagonal-part-length))))
'
81
(multiple-value-bind
'
82
(z1 r1)
'
83
(next-vertex (aref z-x ring) (aref r-x ring)
'
84
(aref z-y ring) diagonal-part-length
'
85
length-in-diagonal-plane ring)
'
86
(setf (aref z-x (1+ ring)) z1)
'
87
(setf (aref r-x (1+ ring)) r1)))
'
88
(let ((length-in-diagonal-plane
'
89
(length-in-diagonal-plane (aref r-x (1+ ring))
'
90
(* (sqrt 2) (+ 2 ring)))))
'
91
(multiple-value-bind
'
92
(z2 r2)
'
93
(next-vertex (aref z-y ring) (aref r-y ring)
'
94
(aref z-x (1+ ring)) diagonal-part-length
'
95
length-in-diagonal-plane ring)
'
96
(setf (aref z-y (1+ ring)) z2)
'
97
(setf (aref r-y (1+ ring)) r2))))
'
98
(values z-x r-x z-y r-y)))
'
99
'
100
(defclass origami-view (qt:glwidget)
'
101
((object :accessor object)
'
102
(animate)
'
103
(rings :initform 4 :accessor rings)
'
104
(rings-changed :reader rings-changed)
'
105
(fold-angle :initform Pi :accessor fold-angle)
'
106
(fold-angle-changed :reader fold-angle-changed))
'
107
(:metaclass cxx:class))
'
108
'
109
(defmethod initialize-instance :after ((view origami-view) &rest initargs)
'
110
(declare (ignore initargs))
'
111
(cxx:set-minimum-size view 200 200)
'
112
(setf (slot-value view 'rings-changed)
'
113
(qt:make-slot #'(lambda (rings)
'
114
(setf (rings view) rings)
'
115
(make-origami view (fold-angle view)
'
116
(rings view)))))
'
117
(setf (slot-value view 'fold-angle-changed)
'
118
(qt:make-slot #'(lambda (fold-angle)
'
119
(setf (fold-angle view)
'
120
(* (/ pi 180) fold-angle))
'
121
(make-origami view (fold-angle view)
'
122
(rings view)))))
'
123
(let ((animate (make-instance 'qt:timer)))
'
124
(setf (cxx:interval animate) (* 1/25 1000)
'
125
(slot-value view 'animate) animate)
'
126
(qt:connect (qt:get-signal animate "timeout()")
'
127
(qt:get-slot view "update()"))))
'
128
'
129
(defun inner-square (z-x r-x z-y r-y)
'
130
"OpenGL vertices for the inner square."
'
131
(gl:with-primitive :triangle-strip
'
132
(gl:normal 0d0 (aref z-y 0) (- (aref r-y 0)))
'
133
(gl:vertex 0d0 (aref r-y 0) (aref z-y 0))
'
134
(gl:vertex (aref r-x 0) 0d0 (aref z-x 0))
'
135
'
136
(gl:vertex (- (aref r-x 0)) 0d0 (aref z-x 0))
'
137
(gl:normal 0d0 (- (aref z-y 0)) (- (aref r-y 0)))
'
138
(gl:vertex 0d0 (- (aref r-y 0)) (aref z-y 0))))
'
139
'
140
(defun triangle-strip (z-x r-x z-y r-y x-direction y-direction)
'
141
"Generates a OpenGL triangle strip for one quarter not
'
142
including the inner square part."
'
143
(declare (type (or (eql 1) (eql -1)) x-direction y-direction))
'
144
(gl:with-primitives :triangle-strip
'
145
(loop for i from 0 below (1- (length z-x))
'
146
do
'
147
(ring-edge-vertices (aref z-x i) (aref r-x i)
'
148
(aref z-y i) (aref r-y i)
'
149
x-direction y-direction)
'
150
(normal (* x-direction (aref r-x i)) 0d0 (aref z-x i)
'
151
0d0 (* y-direction (aref r-y i)) (aref z-y i)
'
152
(* x-direction (aref r-x (1+ i))) 0d0 (aref z-x (1+ i)))
'
153
finally
'
154
(ring-edge-vertices (aref z-x i) (aref r-x i)
'
155
(aref z-y i) (aref r-y i)
'
156
x-direction y-direction))))
'
157
'
158
'
159
(defun ring-edge-vertices (z-x r-x z-y r-y x-direction y-direction)
'
160
"The two vertices of a fourth of a ring."
'
161
(let ((r-x (* x-direction r-x))
'
162
(r-y (* y-direction r-y)))
'
163
(if (= 0 (* x-direction y-direction ))
'
164
(progn
'
165
(gl:vertex 0d0 r-y z-y)
'
166
(gl:vertex r-x 0d0 z-x))
'
167
(progn
'
168
(gl:vertex r-x 0d0 z-x)
'
169
(gl:vertex 0d0 r-y z-y)))))
'
170
'
171
(defun normal (mid-x mid-y mid-z
'
172
x1 y1 z1
'
173
x2 y2 z2)
'
174
"Generates a OpenGL normal normal to three points."
'
175
(let* ((vec1 (vector (- x1 mid-x) (- y1 mid-y) (- z1 mid-z)))
'
176
(vec2 (vector (- x2 mid-x) (- y2 mid-y) (- z2 mid-z)))
'
177
(cross-product (vector (- (* (aref vec1 1) (aref vec2 2))
'
178
(* (aref vec2 1) (aref vec1 2)))
'
179
(- (* (aref vec2 0) (aref vec1 2))
'
180
(* (aref vec1 0) (aref vec2 2)))
'
181
(- (* (aref vec1 0) (aref vec2 1))
'
182
(* (aref vec2 0) (aref vec1 1))))))
'
183
(gl:normal (aref cross-product 0)
'
184
(aref cross-product 1)
'
185
(aref cross-product 2))))
'
186
'
187
(defun make-hyperbolic-parabolid (z-x r-x z-y r-y)
'
188
(gl:material :front-and-back :ambient #(0.6 0.6 0.6 1.0))
'
189
(gl:material :front-and-back :diffuse #(0.4 0.4 0.4 1.0))
'
190
(inner-square z-x r-x z-y r-y)
'
191
(triangle-strip z-x r-x z-y r-y 1 1)
'
192
(triangle-strip z-x r-x z-y r-y -1 1)
'
193
(triangle-strip z-x r-x z-y r-y 1 -1)
'
194
(triangle-strip z-x r-x z-y r-y -1 -1))
'
195
'
196
(defun make-origami (view fold-angle rings)
'
197
(handler-case
'
198
(let ((grid-points
'
199
(multiple-value-list
'
200
(make-grid-points fold-angle rings))))
'
201
'
202
(gl:with-new-list ((object view) :compile)
'
203
(gl:scale (/ 1.0 rings) (/ 1.0 rings) (/ 1.0 rings))
'
204
(apply #'make-hyperbolic-parabolid
'
205
grid-points)))
'
206
((or type-error arithmetic-error) (condition)
'
207
(warn "Can not fold: ~A." condition)
'
208
(sb-debug:backtrace 10)
'
209
(gl:with-new-list ((object view) :compile))))
'
210
(cxx:update view))
'
211
'
212
(defmethod cxx:initialize-gl ((view origami-view))
'
213
(gl:check-error)
'
214
(gl:clear-color 0 0 0 0)
'
215
(gl:shade-model :flat)
'
216
(gl:light :light0 :position '(2 2 1 1))
'
217
(gl:light :light0 :ambient '(1 1 1 1))
'
218
(gl:light :light0 :diffuse '(1 1 1 1))
'
219
(gl:light-model :light-model-two-side 1)
'
220
(gl:enable :light0 :lighting :normalize :depth-test)
'
221
;(gl:enable :line-smooth)
'
222
(setf (object view) (gl:gen-lists 1))
'
223
(gl:check-error)
'
224
(make-origami view 2.5 5)
'
225
(cxx:start (slot-value view 'animate)))
'
226
'
227
(defmethod cxx:paint-gl ((view origami-view))
'
228
(gl:clear :color-buffer :depth-buffer)
'
229
(gl:load-identity)
'
230
(gl:translate 0 0 -2)
'
231
(gl:rotate -60 1 0 0)
'
232
(gl:rotate (mod (* 4 (/ (get-internal-real-time)
'
233
internal-time-units-per-second))
'
234
360)
'
235
0 0 1)
'
236
(gl:call-list (object view))
'
237
(gl:check-error))
'
238
'
239
(defmethod cxx:resize-gl ((view origami-view) width height)
'
240
(gl:viewport 0 0 width height)
'
241
(gl:matrix-mode :projection)
'
242
(gl:load-identity)
'
243
(glu:perspective 50 (/ width height) 0.5 20)
'
244
(gl:matrix-mode :modelview)
'
245
(gl:load-identity)
'
246
(gl:check-error))
'
247
'
248
(defclass origami (qt:widget)
'
249
((view :initform (make-instance 'origami-view)
'
250
:reader view))
'
251
(:metaclass cxx:class))
'
252
'
253
(defmethod initialize-instance :after ((origami origami) &rest initargs)
'
254
(declare (ignore initargs))
'
255
(let ((layout (make-instance 'qt:hbox-layout)))
'
256
(cxx:add-widget layout (view origami))
'
257
(let ((fold-angle (make-instance 'qt:slider))
'
258
(rings (make-instance 'qt:slider)))
'
259
(cxx:add-widget layout fold-angle)
'
260
(cxx:add-widget layout rings)
'
261
(qt:do-delayed-initialize
'
262
(qt:connect (qt:get-signal fold-angle "valueChanged(int)")
'
263
(fold-angle-changed (view origami)))
'
264
(setf (cxx:minimum fold-angle) 0
'
265
(cxx:value fold-angle) 150
'
266
(cxx:maximum fold-angle) 360
'
267
(cxx:tick-position fold-angle) qt:slider.+ticks-left+
'
268
(cxx:tick-interval fold-angle) 90)
'
269
(qt:connect (qt:get-signal rings "valueChanged(int)")
'
270
(rings-changed (view origami)))
'
271
(setf (cxx:minimum rings) 1
'
272
(cxx:value rings) 20
'
273
(cxx:maximum rings) 50
'
274
(cxx:tick-position rings) qt:slider.+ticks-right+
'
275
(cxx:tick-interval rings) 10)))
'
276
(cxx:set-layout origami layout)))
2010-01-10 tobias
277
08:54:26 '
278
(defun origami ()
'
279
"OpenGL Pleated Hyperbolic Paraboloid"
'
280
(qt:with-app ()
'
281
(let ((origami (make-instance 'origami)))
'
282
(cxx:show origami)
'
283
(qt:exec))))