unmaintained/4DNav/4DNav.factor

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