[ dup cos , 0.0 , dup sin neg , 0.0 ,\r
0.0 , 1.0 , 0.0 , 0.0 ,\r
dup sin , 0.0 , dup cos , 0.0 ,\r
- 0.0 , 0.0 , 0.0 , 1.0 , ] 4 make-matrix nip ;\r
+ 0.0 , 0.0 , 0.0 , 1.0 , ] 4 make-matrix nip ;\r
\r
: 4D-Rzw ( angle -- Rz ) deg>rad\r
[ dup cos , dup sin neg , 0.0 , 0.0 ,\r
dup sin , dup cos , 0.0 , 0.0 ,\r
0.0 , 0.0 , 1.0 , 0.0 ,\r
- 0.0 , 0.0 , 0.0 , 1.0 , ] 4 make-matrix nip ;\r
+ 0.0 , 0.0 , 0.0 , 1.0 , ] 4 make-matrix nip ;\r
\r
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\r
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\r
! UI\r
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\r
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\r
\r
-: button* ( string quot -- button ) closed-quot <repeat-button> ;\r
+: button* ( string quot -- button ) \r
+ closed-quot <repeat-button> ;\r
\r
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\r
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\r
! \r
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\r
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\r
\r
: model-projection-chooser ( -- gadget )\r
observer3d> projection-mode>>\r
- { { 1 "perspective" } { 0 "orthogonal" } } <toggle-buttons> ;\r
+ { { 1 "perspective" } { 0 "orthogonal" } } \r
+ <toggle-buttons> ;\r
\r
: collision-detection-chooser ( -- gadget )\r
observer3d> collision-mode>>\r
- { { t "on" } { f "off" } } <toggle-buttons>\r
-;\r
+ { { t "on" } { f "off" } } <toggle-buttons> ;\r
\r
-: model-projection ( x -- space ) present-space> swap space-project ;\r
+: model-projection ( x -- space ) \r
+ present-space> swap space-project ;\r
\r
: update-observer-projections ( -- )\r
view1> relayout-1 \r
3 model-projection <model> view4> (>>model) ;\r
\r
: camera-action ( quot -- quot ) \r
- [ drop [ ] observer3d> with-self update-observer-projections ] \r
+ [ drop [ ] observer3d> \r
+ with-self update-observer-projections ] \r
make* closed-quot ;\r
\r
-: win3D ( text gadget -- ) "navigateur 4D : " rot append open-window ;\r
+: win3D ( text gadget -- ) \r
+ "navigateur 4D : " rot append open-window ;\r
\r
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\r
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\r
! 4D object manipulation\r
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\r
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\r
\r
: (mvt-4D) ( quot -- ) \r
present-space> \r
update-observer-projections ;\r
\r
: rotation-4D ( m -- ) \r
- '[ _ [ [ middle-of-space dup vneg ] keep swap space-translate ] dip\r
+ '[ _ [ [ middle-of-space dup vneg ] keep \r
+ swap space-translate ] dip\r
space-transform \r
swap space-translate\r
] (mvt-4D) ;\r
\r
: translation-4D ( v -- ) '[ _ space-translate ] (mvt-4D) ;\r
\r
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\r
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\r
! menu\r
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\r
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\r
\r
: menu-rotations-4D ( -- gadget )\r
<frame>\r
<pile> 1 >>fill\r
- "XY +" [ drop rotation-step 4D-Rxy rotation-4D ] button* add-gadget\r
- "XY -" [ drop rotation-step neg 4D-Rxy rotation-4D ] button* add-gadget \r
+ "XY +" [ drop rotation-step 4D-Rxy rotation-4D ] \r
+ button* add-gadget\r
+ "XY -" [ drop rotation-step neg 4D-Rxy rotation-4D ] \r
+ button* add-gadget \r
@top-left grid-add \r
<pile> 1 >>fill\r
- "XZ +" [ drop rotation-step 4D-Rxz rotation-4D ] button* add-gadget\r
- "XZ -" [ drop rotation-step neg 4D-Rxz rotation-4D ] button* add-gadget \r
+ "XZ +" [ drop rotation-step 4D-Rxz rotation-4D ] \r
+ button* add-gadget\r
+ "XZ -" [ drop rotation-step neg 4D-Rxz rotation-4D ] \r
+ button* add-gadget \r
@top grid-add \r
<pile> 1 >>fill\r
- "YZ +" [ drop rotation-step 4D-Ryz rotation-4D ] button* add-gadget\r
- "YZ -" [ drop rotation-step neg 4D-Ryz rotation-4D ] button* add-gadget \r
+ "YZ +" [ drop rotation-step 4D-Ryz rotation-4D ] \r
+ button* add-gadget\r
+ "YZ -" [ drop rotation-step neg 4D-Ryz rotation-4D ] \r
+ button* add-gadget \r
@center grid-add\r
<pile> 1 >>fill\r
- "XW +" [ drop rotation-step 4D-Rxw rotation-4D ] button* add-gadget\r
- "XW -" [ drop rotation-step neg 4D-Rxw rotation-4D ] button* add-gadget \r
+ "XW +" [ drop rotation-step 4D-Rxw rotation-4D ] \r
+ button* add-gadget\r
+ "XW -" [ drop rotation-step neg 4D-Rxw rotation-4D ] \r
+ button* add-gadget \r
@top-right grid-add \r
<pile> 1 >>fill\r
- "YW +" [ drop rotation-step 4D-Ryw rotation-4D ] button* add-gadget\r
- "YW -" [ drop rotation-step neg 4D-Ryw rotation-4D ] button* add-gadget \r
+ "YW +" [ drop rotation-step 4D-Ryw rotation-4D ] \r
+ button* add-gadget\r
+ "YW -" [ drop rotation-step neg 4D-Ryw rotation-4D ] \r
+ button* add-gadget \r
@right grid-add \r
<pile> 1 >>fill\r
- "ZW +" [ drop rotation-step 4D-Rzw rotation-4D ] button* add-gadget\r
- "ZW -" [ drop rotation-step neg 4D-Rzw rotation-4D ] button* add-gadget \r
+ "ZW +" [ drop rotation-step 4D-Rzw rotation-4D ] \r
+ button* add-gadget\r
+ "ZW -" [ drop rotation-step neg 4D-Rzw rotation-4D ] \r
+ button* add-gadget \r
@bottom-right grid-add \r
;\r
\r
<frame> \r
<pile> 1 >>fill\r
<shelf> 1 >>fill \r
- "X+" [ drop { 1 0 0 0 } translation-step v*n translation-4D ] \r
+ "X+" [ drop { 1 0 0 0 } translation-step v*n \r
+ translation-4D ] \r
button* add-gadget\r
- "X-" [ drop { -1 0 0 0 } translation-step v*n translation-4D ] \r
+ "X-" [ drop { -1 0 0 0 } translation-step v*n \r
+ translation-4D ] \r
button* add-gadget \r
add-gadget\r
"YZW" <label> add-gadget\r
<pile> 1 >>fill\r
"XZW" <label> add-gadget\r
<shelf> 1 >>fill\r
- "Y+" [ drop { 0 1 0 0 } translation-step v*n translation-4D ] \r
+ "Y+" [ drop { 0 1 0 0 } translation-step v*n \r
+ translation-4D ] \r
button* add-gadget\r
- "Y-" [ drop { 0 -1 0 0 } translation-step v*n translation-4D ] \r
+ "Y-" [ drop { 0 -1 0 0 } translation-step v*n \r
+ translation-4D ] \r
button* add-gadget \r
add-gadget\r
@top-right grid-add\r
<pile> 1 >>fill\r
"XYW" <label> add-gadget\r
<shelf> 1 >>fill\r
- "Z+" [ drop { 0 0 1 0 } translation-step v*n translation-4D ] \r
+ "Z+" [ drop { 0 0 1 0 } translation-step v*n \r
+ translation-4D ] \r
button* add-gadget\r
- "Z-" [ drop { 0 0 -1 0 } translation-step v*n translation-4D ] \r
+ "Z-" [ drop { 0 0 -1 0 } translation-step v*n \r
+ translation-4D ] \r
button* add-gadget \r
add-gadget \r
@top-left grid-add \r
<pile> 1 >>fill\r
<shelf> 1 >>fill\r
- "W+" [ drop { 0 0 0 1 } translation-step v*n translation-4D ] \r
+ "W+" [ drop { 0 0 0 1 } translation-step v*n \r
+ translation-4D ] \r
button* add-gadget\r
- "W-" [ drop { 0 0 0 -1 } translation-step v*n translation-4D ] \r
+ "W-" [ drop { 0 0 0 -1 } translation-step v*n \r
+ translation-4D ] \r
button* add-gadget \r
add-gadget\r
"XYZ" <label> add-gadget\r
update-observer-projections ;\r
\r
: load-model-file ( -- )\r
- selected-file dup selected-file-model> set-model read-model-file \r
+ selected-file dup selected-file-model> set-model \r
+ read-model-file \r
redraw-model ;\r
\r
: mvt-3D-X ( turn pitch -- quot )\r
\r
: menu-rotations-3D ( -- gadget )\r
<frame>\r
- "Turn\n left" [ rotation-step turn-left ] camera-button \r
- @left grid-add \r
- "Turn\n right" [ rotation-step turn-right ] camera-button \r
- @right grid-add \r
- "Pitch down" [ rotation-step pitch-down ] camera-button \r
- @bottom grid-add \r
- "Pitch up" [ rotation-step pitch-up ] camera-button \r
- @top grid-add \r
+ "Turn\n left" [ rotation-step turn-left ] \r
+ camera-button @left grid-add \r
+ "Turn\n right" [ rotation-step turn-right ] \r
+ camera-button @right grid-add \r
+ "Pitch down" [ rotation-step pitch-down ] \r
+ camera-button @bottom grid-add \r
+ "Pitch up" [ rotation-step pitch-up ] \r
+ camera-button @top grid-add \r
<shelf> 1 >>fill\r
- "Roll left\n (ctl)" [ rotation-step roll-left ] camera-button\r
- add-gadget \r
- "Roll right\n(ctl)" [ rotation-step roll-right ] camera-button \r
- add-gadget \r
+ "Roll left\n (ctl)" [ rotation-step roll-left ] \r
+ camera-button add-gadget \r
+ "Roll right\n(ctl)" [ rotation-step roll-right ] \r
+ camera-button add-gadget \r
@center grid-add \r
;\r
\r
: menu-translations-3D ( -- gadget )\r
<frame>\r
- "left\n(alt)" [ translation-step strafe-left ] camera-button\r
- @left grid-add \r
- "right\n(alt)" [ translation-step strafe-right ] camera-button\r
- @right grid-add \r
- "Strafe up \n (alt)" [ translation-step strafe-up ] camera-button\r
- @top grid-add\r
- "Strafe down \n (alt)" [ translation-step strafe-down ] camera-button\r
- @bottom grid-add \r
+ "left\n(alt)" [ translation-step strafe-left ]\r
+ camera-button @left grid-add \r
+ "right\n(alt)" [ translation-step strafe-right ]\r
+ camera-button @right grid-add \r
+ "Strafe up \n (alt)" [ translation-step strafe-up ] \r
+ camera-button @top grid-add\r
+ "Strafe down\n (alt)" [ translation-step strafe-down ]\r
+ camera-button @bottom grid-add \r
<pile> 1 >>fill\r
- "Forward (ctl)" [ translation-step step-turtle ] camera-button\r
- add-gadget\r
- "Backward (ctl)" [ translation-step neg step-turtle ] camera-button\r
- add-gadget\r
+ "Forward (ctl)" [ translation-step step-turtle ] \r
+ camera-button add-gadget\r
+ "Backward (ctl)" \r
+ [ translation-step neg step-turtle ] \r
+ camera-button add-gadget\r
@center grid-add\r
;\r
\r
[ [ rotation-step pitch-up ] camera-action ] }\r
\r
{ T{ key-down f { C+ } "UP" } \r
- [ [ translation-step step-turtle ] camera-action ] }\r
+ [ [ translation-step step-turtle ] camera-action ] }\r
{ T{ key-down f { C+ } "DOWN" } \r
- [ [ translation-step neg step-turtle ] camera-action ] }\r
+ [ [ translation-step neg step-turtle ] \r
+ camera-action ] }\r
{ T{ key-down f { C+ } "LEFT" } \r
[ [ rotation-step roll-left ] camera-action ] }\r
{ T{ key-down f { C+ } "RIGHT" } \r
[ [ rotation-step roll-right ] camera-action ] }\r
\r
{ T{ key-down f { A+ } "LEFT" } \r
- [ [ translation-step strafe-left ] camera-action ] }\r
+ [ [ translation-step strafe-left ] camera-action ] }\r
{ T{ key-down f { A+ } "RIGHT" } \r
- [ [ translation-step strafe-right ] camera-action ] }\r
+ [ [ translation-step strafe-right ] camera-action ] }\r
{ T{ key-down f { A+ } "UP" } \r
[ [ translation-step strafe-up ] camera-action ] }\r
{ T{ key-down f { A+ } "DOWN" } \r
- [ [ translation-step strafe-down ] camera-action ] }\r
+ [ [ translation-step strafe-down ] camera-action ] }\r
\r
\r
{ T{ key-down f f "1" } [ mvt-3D-1 camera-action ] }\r
[ name>> "solid called : " pprint . ] \r
[ color>> "color : " pprint . ]\r
[ dimension>> "dimension : " pprint . ]\r
- [ faces>> "composed of faces : " pprint [ adsoda-display-model ] each ]\r
+ [ faces>> "composed of faces : " pprint \r
+ [ adsoda-display-model ] each ]\r
} cleave\r
;\r
M: space adsoda-display-model \r
{\r
[ dimension>> "dimension : " pprint . ] \r
[ ambient-color>> "ambient-color : " pprint . ]\r
- [ solids>> "composed of solids : " pprint [ adsoda-display-model ] each ]\r
- [ lights>> "composed of lights : " pprint [ adsoda-display-model ] each ] \r
+ [ solids>> "composed of solids : " pprint \r
+ [ adsoda-display-model ] each ]\r
+ [ lights>> "composed of lights : " pprint \r
+ [ adsoda-display-model ] each ] \r
} cleave\r
;\r
\r
! ----------------------------------------------\r
: menu-bar ( -- gadget )\r
<shelf>\r
- "reinit" [ drop load-model-file ] button* add-gadget\r
- selected-file-model> <label-control> add-gadget\r
+ "reinit" [ drop load-model-file ] button* add-gadget\r
+ selected-file-model> <label-control> add-gadget\r
;\r
\r
\r
model-projection-chooser add-gadget\r
f track-add\r
<shelf>\r
- "Collision detection (slow and buggy ) : " <label> add-gadget\r
+ "Collision detection (slow and buggy ) : " \r
+ <label> add-gadget\r
collision-detection-chooser add-gadget\r
f track-add\r
<pile>\r
projects / factor.git / blobdiff