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