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