| blob | 3a0543df1a9985f78576c00b010c31f79eecd410 |
1 ! Copyright (C) 2008 Jeff Bigot\r
2 ! See http://factorcode.org/license.txt for BSD license.\r
3 USING: kernel \r
4 namespaces\r
5 accessors\r
6 make\r
7 math\r
8 math.functions\r
9 math.trig\r
10 math.parser\r
11 hashtables\r
12 sequences\r
13 combinators\r
14 continuations\r
15 colors\r
16 prettyprint\r
17 vars\r
18 quotations\r
19 io\r
20 io.directories\r
21 io.pathnames\r
22 help.markup\r
23 io.files\r
24 ui.gadgets.panes\r
25 ui\r
26 ui.gadgets\r
27 ui.traverse\r
28 ui.gadgets.borders\r
29 ui.gadgets.handler\r
30 ui.gadgets.slate\r
31 ui.gadgets.theme\r
32 ui.gadgets.frames\r
33 ui.gadgets.tracks\r
34 ui.gadgets.labels\r
35 ui.gadgets.labelled \r
36 ui.gadgets.lists\r
37 ui.gadgets.buttons\r
38 ui.gadgets.packs\r
39 ui.gadgets.grids\r
40 ui.gestures\r
41 ui.tools.workspace\r
42 ui.gadgets.scrollers\r
43 splitting\r
44 vectors\r
45 math.vectors\r
46 rewrite-closures\r
47 self\r
48 values\r
49 4DNav.turtle\r
50 4DNav.window3D\r
51 4DNav.deep\r
52 4DNav.space-file-decoder\r
53 models\r
54 fry\r
55 adsoda\r
56 adsoda.tools\r
57 ;\r
58 \r
59 IN: 4DNav\r
60 VALUE: selected-file\r
61 VALUE: translation-step\r
62 VALUE: rotation-step\r
63 \r
64 3 to: translation-step \r
65 5 to: rotation-step\r
66 \r
67 VAR: selected-file-model\r
68 VAR: observer3d \r
69 VAR: view1 \r
70 VAR: view2\r
71 VAR: view3\r
72 VAR: view4\r
73 VAR: present-space\r
74 \r
75 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\r
76 \r
77 ! replacement of namespaces.lib\r
78 \r
79 : make* ( seq -- seq ) [ dup quotation? [ call ] [ ] if ] map ;\r
80 \r
81 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\r
82 ! waiting for deep-cleave-quots\r
83 \r
84 : 4D-Rxy ( angle -- Rx ) deg>rad\r
85 [ 1.0 , 0.0 , 0.0 , 0.0 ,\r
86 0.0 , 1.0 , 0.0 , 0.0 ,\r
87 0.0 , 0.0 , dup cos , dup sin neg ,\r
88 0.0 , 0.0 , dup sin , dup cos , ] 4 make-matrix nip ;\r
89 \r
90 : 4D-Rxz ( angle -- Ry ) deg>rad\r
91 [ 1.0 , 0.0 , 0.0 , 0.0 ,\r
92 0.0 , dup cos , 0.0 , dup sin neg ,\r
93 0.0 , 0.0 , 1.0 , 0.0 ,\r
94 0.0 , dup sin , 0.0 , dup cos , ] 4 make-matrix nip ;\r
95 \r
96 : 4D-Rxw ( angle -- Rz ) deg>rad\r
97 [ 1.0 , 0.0 , 0.0 , 0.0 ,\r
98 0.0 , dup cos , dup sin neg , 0.0 ,\r
99 0.0 , dup sin , dup cos , 0.0 ,\r
100 0.0 , 0.0 , 0.0 , 1.0 , ] 4 make-matrix nip ;\r
101 \r
102 : 4D-Ryz ( angle -- Rx ) deg>rad\r
103 [ dup cos , 0.0 , 0.0 , dup sin neg ,\r
104 0.0 , 1.0 , 0.0 , 0.0 ,\r
105 0.0 , 0.0 , 1.0 , 0.0 ,\r
106 dup sin , 0.0 , 0.0 , dup cos , ] 4 make-matrix nip ;\r
107 \r
108 : 4D-Ryw ( angle -- Ry ) deg>rad\r
109 [ dup cos , 0.0 , dup sin neg , 0.0 ,\r
110 0.0 , 1.0 , 0.0 , 0.0 ,\r
111 dup sin , 0.0 , dup cos , 0.0 ,\r
112 0.0 , 0.0 , 0.0 , 1.0 , ] 4 make-matrix nip ;\r
113 \r
114 : 4D-Rzw ( angle -- Rz ) deg>rad\r
115 [ dup cos , dup sin neg , 0.0 , 0.0 ,\r
116 dup sin , dup cos , 0.0 , 0.0 ,\r
117 0.0 , 0.0 , 1.0 , 0.0 ,\r
118 0.0 , 0.0 , 0.0 , 1.0 , ] 4 make-matrix nip ;\r
119 \r
120 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\r
121 ! UI\r
122 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\r
123 \r
124 : button* ( string quot -- button ) closed-quot <repeat-button> ;\r
125 \r
126 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\r
127 ! \r
128 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\r
129 \r
130 : model-projection-chooser ( -- gadget )\r
131 observer3d> projection-mode>>\r
132 { { 1 "perspective" } { 0 "orthogonal" } } <toggle-buttons> ;\r
133 \r
134 : collision-detection-chooser ( -- gadget )\r
135 observer3d> collision-mode>>\r
136 { { t "on" } { f "off" } } <toggle-buttons>\r
137 ;\r
138 \r
139 : model-projection ( x -- space ) present-space> swap space-project ;\r
140 \r
141 : update-observer-projections ( -- )\r
142 view1> relayout-1 \r
143 view2> relayout-1 \r
144 view3> relayout-1 \r
145 view4> relayout-1 ;\r
146 \r
147 : update-model-projections ( -- )\r
148 0 model-projection <model> view1> (>>model)\r
149 1 model-projection <model> view2> (>>model)\r
150 2 model-projection <model> view3> (>>model)\r
151 3 model-projection <model> view4> (>>model) ;\r
152 \r
153 : camera-action ( quot -- quot ) \r
154 [ drop [ ] observer3d> with-self update-observer-projections ] \r
155 make* closed-quot ;\r
156 \r
157 : win3D ( text gadget -- ) "navigateur 4D : " rot append open-window ;\r
158 \r
159 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\r
160 ! 4D object manipulation\r
161 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\r
162 \r
163 : (mvt-4D) ( quot -- ) \r
164 present-space> \r
165 swap call space-ensure-solids \r
166 >present-space \r
167 update-model-projections \r
168 update-observer-projections ;\r
169 \r
170 : rotation-4D ( m -- ) \r
171 '[ _ [ [ middle-of-space dup vneg ] keep swap space-translate ] dip\r
172 space-transform \r
173 swap space-translate\r
174 ] (mvt-4D) ;\r
175 \r
176 : translation-4D ( v -- ) '[ _ space-translate ] (mvt-4D) ;\r
177 \r
178 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\r
179 ! menu\r
180 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\r
181 \r
182 : menu-rotations-4D ( -- gadget )\r
183 <frame>\r
184 <pile> 1 >>fill\r
185 "XY +" [ drop rotation-step 4D-Rxy rotation-4D ] button* add-gadget\r
186 "XY -" [ drop rotation-step neg 4D-Rxy rotation-4D ] button* add-gadget \r
187 @top-left grid-add \r
188 <pile> 1 >>fill\r
189 "XZ +" [ drop rotation-step 4D-Rxz rotation-4D ] button* add-gadget\r
190 "XZ -" [ drop rotation-step neg 4D-Rxz rotation-4D ] button* add-gadget \r
191 @top grid-add \r
192 <pile> 1 >>fill\r
193 "YZ +" [ drop rotation-step 4D-Ryz rotation-4D ] button* add-gadget\r
194 "YZ -" [ drop rotation-step neg 4D-Ryz rotation-4D ] button* add-gadget \r
195 @center grid-add\r
196 <pile> 1 >>fill\r
197 "XW +" [ drop rotation-step 4D-Rxw rotation-4D ] button* add-gadget\r
198 "XW -" [ drop rotation-step neg 4D-Rxw rotation-4D ] button* add-gadget \r
199 @top-right grid-add \r
200 <pile> 1 >>fill\r
201 "YW +" [ drop rotation-step 4D-Ryw rotation-4D ] button* add-gadget\r
202 "YW -" [ drop rotation-step neg 4D-Ryw rotation-4D ] button* add-gadget \r
203 @right grid-add \r
204 <pile> 1 >>fill\r
205 "ZW +" [ drop rotation-step 4D-Rzw rotation-4D ] button* add-gadget\r
206 "ZW -" [ drop rotation-step neg 4D-Rzw rotation-4D ] button* add-gadget \r
207 @bottom-right grid-add \r
208 ;\r
209 \r
210 : menu-translations-4D ( -- gadget )\r
211 <frame> \r
212 <pile> 1 >>fill\r
213 <shelf> 1 >>fill \r
214 "X+" [ drop { 1 0 0 0 } translation-step v*n translation-4D ] \r
215 button* add-gadget\r
216 "X-" [ drop { -1 0 0 0 } translation-step v*n translation-4D ] \r
217 button* add-gadget \r
218 add-gadget\r
219 "YZW" <label> add-gadget\r
220 @bottom-right grid-add\r
221 <pile> 1 >>fill\r
222 "XZW" <label> add-gadget\r
223 <shelf> 1 >>fill\r
224 "Y+" [ drop { 0 1 0 0 } translation-step v*n translation-4D ] \r
225 button* add-gadget\r
226 "Y-" [ drop { 0 -1 0 0 } translation-step v*n translation-4D ] \r
227 button* add-gadget \r
228 add-gadget\r
229 @top-right grid-add\r
230 <pile> 1 >>fill\r
231 "XYW" <label> add-gadget\r
232 <shelf> 1 >>fill\r
233 "Z+" [ drop { 0 0 1 0 } translation-step v*n translation-4D ] \r
234 button* add-gadget\r
235 "Z-" [ drop { 0 0 -1 0 } translation-step v*n translation-4D ] \r
236 button* add-gadget \r
237 add-gadget \r
238 @top-left grid-add \r
239 <pile> 1 >>fill\r
240 <shelf> 1 >>fill\r
241 "W+" [ drop { 0 0 0 1 } translation-step v*n translation-4D ] \r
242 button* add-gadget\r
243 "W-" [ drop { 0 0 0 -1 } translation-step v*n translation-4D ] \r
244 button* add-gadget \r
245 add-gadget\r
246 "XYZ" <label> add-gadget\r
247 @bottom-left grid-add \r
248 "X" <label> @center grid-add\r
249 ;\r
250 \r
251 : menu-4D ( -- gadget ) \r
252 <shelf> \r
253 "rotations" <label> add-gadget\r
254 menu-rotations-4D add-gadget\r
255 "translations" <label> add-gadget\r
256 menu-translations-4D add-gadget\r
257 0.5 >>align\r
258 { 0 10 } >>gap\r
259 ;\r
260 \r
261 \r
262 ! ------------------------------------------------------\r
263 \r
264 : redraw-model ( space -- )\r
265 >present-space \r
266 update-model-projections \r
267 update-observer-projections ;\r
268 \r
269 : load-model-file ( -- )\r
270 selected-file dup selected-file-model> set-model read-model-file \r
271 redraw-model ;\r
272 \r
273 : mvt-3D-X ( turn pitch -- quot )\r
274 '[ turtle-pos> norm neg reset-turtle \r
275 _ turn-left \r
276 _ pitch-up \r
277 step-turtle ] ;\r
278 \r
279 : mvt-3D-1 ( -- quot ) 90 0 mvt-3D-X ; inline\r
280 : mvt-3D-2 ( -- quot ) 0 90 mvt-3D-X ; inline\r
281 : mvt-3D-3 ( -- quot ) 0 0 mvt-3D-X ; inline\r
282 : mvt-3D-4 ( -- quot ) 45 45 mvt-3D-X ; inline\r
283 \r
284 : camera-button ( string quot -- button ) \r
285 [ <label> ] dip camera-action <repeat-button> ;\r
286 \r
287 ! ----------------------------------------------------------\r
288 ! file chooser\r
289 ! ----------------------------------------------------------\r
290 : <run-file-button> ( file-name -- button )\r
291 dup '[ drop _ \ selected-file set-value load-model-file \r
292 ] \r
293 closed-quot <roll-button> { 0 0 } >>align ;\r
294 \r
295 : <list-runner> ( -- gadget )\r
296 "resource:extra/4DNav" \r
297 <pile> 1 >>fill \r
298 over dup directory-files \r
299 [ ".xml" tail? ] filter \r
300 [ append-path ] with map\r
301 [ <run-file-button> add-gadget ] each\r
302 swap <labelled-gadget> ;\r
303 \r
304 ! -----------------------------------------------------\r
305 \r
306 : menu-rotations-3D ( -- gadget )\r
307 <frame>\r
308 "Turn\n left" [ rotation-step turn-left ] camera-button \r
309 @left grid-add \r
310 "Turn\n right" [ rotation-step turn-right ] camera-button \r
311 @right grid-add \r
312 "Pitch down" [ rotation-step pitch-down ] camera-button \r
313 @bottom grid-add \r
314 "Pitch up" [ rotation-step pitch-up ] camera-button \r
315 @top grid-add \r
316 <shelf> 1 >>fill\r
317 "Roll left\n (ctl)" [ rotation-step roll-left ] camera-button\r
318 add-gadget \r
319 "Roll right\n(ctl)" [ rotation-step roll-right ] camera-button \r
320 add-gadget \r
321 @center grid-add \r
322 ;\r
323 \r
324 : menu-translations-3D ( -- gadget )\r
325 <frame>\r
326 "left\n(alt)" [ translation-step strafe-left ] camera-button\r
327 @left grid-add \r
328 "right\n(alt)" [ translation-step strafe-right ] camera-button\r
329 @right grid-add \r
330 "Strafe up \n (alt)" [ translation-step strafe-up ] camera-button\r
331 @top grid-add\r
332 "Strafe down \n (alt)" [ translation-step strafe-down ] camera-button\r
333 @bottom grid-add \r
334 <pile> 1 >>fill\r
335 "Forward (ctl)" [ translation-step step-turtle ] camera-button\r
336 add-gadget\r
337 "Backward (ctl)" [ translation-step neg step-turtle ] camera-button\r
338 add-gadget\r
339 @center grid-add\r
340 ;\r
341 \r
342 : menu-quick-views ( -- gadget )\r
343 <shelf>\r
344 "View 1 (1)" mvt-3D-1 camera-button add-gadget\r
345 "View 2 (2)" mvt-3D-2 camera-button add-gadget\r
346 "View 3 (3)" mvt-3D-3 camera-button add-gadget \r
347 "View 4 (4)" mvt-3D-4 camera-button add-gadget \r
348 ;\r
349 \r
350 : menu-3D ( -- gadget ) \r
351 <pile>\r
352 <shelf> \r
353 menu-rotations-3D add-gadget\r
354 menu-translations-3D add-gadget\r
355 0.5 >>align\r
356 { 0 10 } >>gap\r
357 add-gadget\r
358 menu-quick-views add-gadget ; \r
359 \r
360 : add-keyboard-delegate ( obj -- obj )\r
361 <handler>\r
362 {\r
363 { T{ key-down f f "LEFT" } \r
364 [ [ rotation-step turn-left ] camera-action ] }\r
365 { T{ key-down f f "RIGHT" } \r
366 [ [ rotation-step turn-right ] camera-action ] }\r
367 { T{ key-down f f "UP" } \r
368 [ [ rotation-step pitch-down ] camera-action ] }\r
369 { T{ key-down f f "DOWN" } \r
370 [ [ rotation-step pitch-up ] camera-action ] }\r
371 \r
372 { T{ key-down f { C+ } "UP" } \r
373 [ [ translation-step step-turtle ] camera-action ] }\r
374 { T{ key-down f { C+ } "DOWN" } \r
375 [ [ translation-step neg step-turtle ] camera-action ] }\r
376 { T{ key-down f { C+ } "LEFT" } \r
377 [ [ rotation-step roll-left ] camera-action ] }\r
378 { T{ key-down f { C+ } "RIGHT" } \r
379 [ [ rotation-step roll-right ] camera-action ] }\r
380 \r
381 { T{ key-down f { A+ } "LEFT" } \r
382 [ [ translation-step strafe-left ] camera-action ] }\r
383 { T{ key-down f { A+ } "RIGHT" } \r
384 [ [ translation-step strafe-right ] camera-action ] }\r
385 { T{ key-down f { A+ } "UP" } \r
386 [ [ translation-step strafe-up ] camera-action ] }\r
387 { T{ key-down f { A+ } "DOWN" } \r
388 [ [ translation-step strafe-down ] camera-action ] }\r
389 \r
390 \r
391 { T{ key-down f f "1" } [ mvt-3D-1 camera-action ] }\r
392 { T{ key-down f f "2" } [ mvt-3D-2 camera-action ] }\r
393 { T{ key-down f f "3" } [ mvt-3D-3 camera-action ] }\r
394 { T{ key-down f f "4" } [ mvt-3D-4 camera-action ] }\r
395 \r
396 } [ make* ] map >hashtable >>table\r
397 ; \r
398 \r
399 ! --------------------------------------------\r
400 ! print elements \r
401 ! --------------------------------------------\r
402 ! print-content\r
403 \r
404 GENERIC: adsoda-display-model ( x -- ) \r
405 \r
406 M: light adsoda-display-model \r
407 "\n light : " .\r
408 { \r
409 [ direction>> "direction : " pprint . ] \r
410 [ color>> "color : " pprint . ]\r
411 } cleave\r
412 ;\r
413 \r
414 M: face adsoda-display-model \r
415 {\r
416 [ halfspace>> "halfspace : " pprint . ] \r
417 [ touching-corners>> "touching corners : " pprint . ]\r
418 } cleave\r
419 ;\r
420 M: solid adsoda-display-model \r
421 {\r
422 [ name>> "solid called : " pprint . ] \r
423 [ color>> "color : " pprint . ]\r
424 [ dimension>> "dimension : " pprint . ]\r
425 [ faces>> "composed of faces : " pprint [ adsoda-display-model ] each ]\r
426 } cleave\r
427 ;\r
428 M: space adsoda-display-model \r
429 {\r
430 [ dimension>> "dimension : " pprint . ] \r
431 [ ambient-color>> "ambient-color : " pprint . ]\r
432 [ solids>> "composed of solids : " pprint [ adsoda-display-model ] each ]\r
433 [ lights>> "composed of lights : " pprint [ adsoda-display-model ] each ] \r
434 } cleave\r
435 ;\r
436 \r
437 ! ----------------------------------------------\r
438 : menu-bar ( -- gadget )\r
439 <shelf>\r
440 "reinit" [ drop load-model-file ] button* add-gadget\r
441 selected-file-model> <label-control> add-gadget\r
442 ;\r
443 \r
444 \r
445 : controller-window* ( -- gadget )\r
446 { 0 1 } <track>\r
447 menu-bar f track-add\r
448 <list-runner> \r
449 <limited-scroller> \r
450 { 200 400 } >>max-dim\r
451 f track-add\r
452 <shelf>\r
453 "Projection mode : " <label> add-gadget\r
454 model-projection-chooser add-gadget\r
455 f track-add\r
456 <shelf>\r
457 "Collision detection (slow and buggy ) : " <label> add-gadget\r
458 collision-detection-chooser add-gadget\r
459 f track-add\r
460 <pile>\r
461 0.5 >>align \r
462 menu-4D add-gadget \r
463 light-purple solid-interior\r
464 "4D movements" <labelled-gadget>\r
465 f track-add\r
466 <pile>\r
467 0.5 >>align\r
468 { 2 2 } >>gap\r
469 menu-3D add-gadget\r
470 light-purple solid-interior \r
471 "Camera 3D" <labelled-gadget>\r
472 f track-add \r
473 gray solid-interior\r
474 ;\r
475 \r
476 : viewer-windows* ( -- )\r
477 "YZW" view1> win3D \r
478 "XZW" view2> win3D \r
479 "XYW" view3> win3D \r
480 "XYZ" view4> win3D \r
481 ;\r
482 \r
483 : navigator-window* ( -- )\r
484 controller-window*\r
485 viewer-windows* \r
486 add-keyboard-delegate\r
487 "navigateur 4D" open-window\r
488 ;\r
489 \r
490 : windows ( -- ) [ [ navigator-window* ] with-scope ] with-ui ;\r
491 \r
492 \r
493 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\r
494 \r
495 : init-variables ( -- )\r
496 "choose a file" <model> >selected-file-model \r
497 <observer> >observer3d\r
498 [ observer3d> >self\r
499 reset-turtle \r
500 45 turn-left \r
501 45 pitch-up \r
502 -300 step-turtle \r
503 ] with-scope\r
504 \r
505 ;\r
506 \r
507 \r
508 : init-models ( -- )\r
509 0 model-projection observer3d> <window3D> >view1\r
510 1 model-projection observer3d> <window3D> >view2\r
511 2 model-projection observer3d> <window3D> >view3\r
512 3 model-projection observer3d> <window3D> >view4\r
513 ;\r
514 \r
515 : 4DNav ( -- ) \r
516 init-variables\r
517 selected-file read-model-file >present-space\r
518 init-models\r
519 windows\r
520 ;\r
521 \r
522 MAIN: 4DNav\r
523 \r
524 \r