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