From: Jeff Bigot <jeff.bigot@wanadoo.fr>
Date: Fri, 30 Jan 2009 16:38:21 +0000 (+0100)
Subject: Merge branch 'master' of git://factorcode.org/git/factor
X-Git-Tag: 0.94~2198^2~22^2~2
X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=commitdiff_plain;h=f46f92aa9d27aeb94ca2560ba15474d417b8231e

Merge branch 'master' of git://factorcode.org/git/factor
---

f46f92aa9d27aeb94ca2560ba15474d417b8231e
diff --cc unmaintained/4DNav/4DNav-docs.factor
index 0000000000,d4bf1db87d..95f231ecb9
mode 000000,100755..100755
--- a/unmaintained/4DNav/4DNav-docs.factor
+++ b/unmaintained/4DNav/4DNav-docs.factor
@@@ -1,0 -1,400 +1,201 @@@
+ ! Copyright (C) 2008 Jean-François Bigot.
+ ! See http://factorcode.org/license.txt for BSD license.
+ USING: help.markup help.syntax kernel quotations strings ;
+ IN: 4DNav
+ 
 -HELP: (mvt-4D)
 -{ $values
 -     { "quot" quotation }
 -}
 -{ $description "" } ;
 -
 -HELP: 4D-Rxw
 -{ $values
 -     { "angle" null }
 -     { "Rz" null }
 -}
 -{ $description "" } ;
 -
 -HELP: 4D-Rxy
 -{ $values
 -     { "angle" null }
 -     { "Rx" null }
 -}
 -{ $description "" } ;
 -
 -HELP: 4D-Rxz
 -{ $values
 -     { "angle" null }
 -     { "Ry" null }
 -}
 -{ $description "" } ;
 -
 -HELP: 4D-Ryw
 -{ $values
 -     { "angle" null }
 -     { "Ry" null }
 -}
 -{ $description "" } ;
 -
 -HELP: 4D-Ryz
 -{ $values
 -     { "angle" null }
 -     { "Rx" null }
 -}
 -{ $description "" } ;
 -
 -HELP: 4D-Rzw
 -{ $values
 -     { "angle" null }
 -     { "Rz" null }
 -}
 -{ $description "" } ;
 -
 -HELP: 4DNav
 -{ $description "" } ;
 -
 -HELP: >observer3d
 -{ $values
 -     { "value" null }
 -}
 -{ $description "" } ;
 -
 -HELP: >present-space
 -{ $values
 -     { "value" null }
 -}
 -{ $description "" } ;
 -
 -
 -HELP: >view1
 -{ $values
 -     { "value" null }
 -}
 -{ $description "" } ;
 -
 -HELP: >view2
 -{ $values
 -     { "value" null }
 -}
 -{ $description "" } ;
 -
 -HELP: >view3
 -{ $values
 -     { "value" null }
 -}
 -{ $description "" } ;
 -
 -HELP: >view4
 -{ $values
 -     { "value" null }
 -}
 -{ $description "" } ;
 -
 -HELP: add-keyboard-delegate
 -{ $values
 -     { "obj" object }
 -     { "obj" object }
 -}
 -{ $description "" } ;
 -
 -HELP: button*
 -{ $values
 -     { "string" string } { "quot" quotation }
 -     { "button" null }
 -}
 -{ $description "" } ;
 -
 -HELP: camera-action
 -{ $values
 -     { "quot" quotation }
 -     { "quot" quotation }
 -}
 -{ $description "" } ;
 -
 -HELP: camera-button
 -{ $values
 -     { "string" string } { "quot" quotation }
 -     { "button" null }
 -}
 -{ $description "" } ;
 -
 -HELP: controller-window*
 -{ $values
 -     { "gadget" "a gadget" } 
 -}
 -{ $description "" } ;
 -
 -
 -HELP: init-models
 -{ $description "" } ;
 -
 -HELP: init-variables
 -{ $description "" } ;
+ 
+ HELP: menu-3D
+ { $values
 -     { "gadget" null }
++     { "gadget" "gadget" }
+ }
+ { $description "The menu dedicated to 3D movements of the camera" } ;
+ 
+ HELP: menu-4D
+ { $values
+     
 -     { "gadget" null }
++     { "gadget" "gadget" }
+ }
+ { $description "The menu dedicated to 4D movements of space" } ;
+ 
+ HELP: menu-bar
+ { $values
+     
 -     { "gadget" null }
++     { "gadget" "gadget" }
+ }
+ { $description "return gadget containing menu buttons" } ;
+ 
+ HELP: model-projection
+ { $values
 -     { "x" null }
 -     { "space" null }
++     { "x" "interger" }
++     { "space" "space" }
+ }
+ { $description "Project space following coordinate x" } ;
+ 
+ HELP: mvt-3D-1
+ { $values
+     
 -     { "quot" quotation }
++     { "quot" "quotation" }
+ }
+ { $description "return a quotation to orientate space to see it from first point of view" } ;
+ 
+ HELP: mvt-3D-2
+ { $values
+     
 -     { "quot" quotation }
++     { "quot" "quotation" }
+ }
+ { $description "return a quotation to orientate space to see it from second point of view" } ;
+ 
+ HELP: mvt-3D-3
+ { $values
+     
 -     { "quot" quotation }
++     { "quot" "quotation" }
+ }
+ { $description "return a quotation to orientate space to see it from third point of view" } ;
+ 
+ HELP: mvt-3D-4
+ { $values
+     
 -     { "quot" quotation }
++     { "quot" "quotation" }
+ }
+ { $description "return a quotation to orientate space to see it from first point of view" } ;
+ 
 -HELP: observer3d
 -{ $description "" } ;
 -
 -HELP: observer3d>
 -{ $values
 -    
 -     { "value" null }
 -}
 -{ $description "" } ;
 -
 -HELP: present-space
 -{ $description "" } ;
 -
 -HELP: present-space>
 -{ $values
 -    
 -     { "value" null }
 -}
 -{ $description "" } ;
 -
+ HELP: load-model-file
+ { $description "load space from file" } ;
+ 
+ HELP: rotation-4D
+ { $values
+      { "m" "a rotation matrix" }
+ }
+ { $description "Apply a 4D rotation matrix" } ;
+ 
+ HELP: translation-4D
+ { $values
 -     { "v" null }
 -}
 -{ $description "" } ;
 -
 -HELP: update-model-projections
 -{ $description "" } ;
 -
 -HELP: update-observer-projections
 -{ $description "" } ;
 -
 -HELP: view1
 -{ $description "" } ;
 -
 -HELP: view1>
 -{ $values
 -    
 -     { "value" null }
 -}
 -{ $description "" } ;
 -
 -HELP: view2
 -{ $description "" } ;
 -
 -HELP: view2>
 -{ $values
 -    
 -     { "value" null }
 -}
 -{ $description "" } ;
 -
 -HELP: view3
 -{ $description "" } ;
 -
 -HELP: view3>
 -{ $values
 -    
 -     { "value" null }
 -}
 -{ $description "" } ;
 -
 -HELP: view4
 -{ $description "" } ;
 -
 -HELP: view4>
 -{ $values
 -    
 -     { "value" null }
++     { "v" "vector" }
+ }
 -{ $description "" } ;
++{ $description "Apply a 4D translation" } ;
+ 
 -HELP: viewer-windows*
 -{ $description "" } ;
+ 
 -HELP: win3D
 -{ $values
 -     { "text" null } { "gadget" null }
 -}
 -{ $description "" } ;
++ARTICLE: "implementation details" "How 4DNav is done"
++"4DNav is build using :"
+ 
 -HELP: windows
 -{ $description "" } ;
++{ $subsection "4DNav.camera" }
++{ $subsection "adsoda-main-page" }
++;
+ 
+ ARTICLE: "Space file" "Create a new space file"
 -"\nTo build a new space, create an XML file using " { $vocab-link "adsoda" } " model description. \nAn example is:"
++"To build a new space, create an XML file using " { $vocab-link "adsoda" } " model description. A solid is not caracterized by its corners but is defined as the intersection of hyperplanes."
++
++$nl
++"An example is:"
+ $nl
+ 
+ "\n<model>"
+ "\n<space>"
+ "\n <dimension>4</dimension>"
+ "\n <solid>"
+ "\n     <name>4cube1</name>"
+ "\n     <dimension>4</dimension>"
+ "\n     <face>1,0,0,0,100</face>"
+ "\n     <face>-1,0,0,0,-150</face>"
+ "\n     <face>0,1,0,0,100</face>"
+ "\n     <face>0,-1,0,0,-150</face>"
+ "\n     <face>0,0,1,0,100</face>"
+ "\n     <face>0,0,-1,0,-150</face>"
+ "\n     <face>0,0,0,1,100</face>"
+ "\n     <face>0,0,0,-1,-150</face>"
+ "\n     <color>1,0,0</color>"
+ "\n </solid>"
+ "\n <solid>"
+ "\n     <name>4triancube</name>"
+ "\n     <dimension>4</dimension>"
+ "\n     <face>1,0,0,0,160</face>"
+ "\n     <face>-0.4999999999999998,-0.8660254037844387,0,0,-130</face>"
+ "\n     <face>-0.5000000000000004,0.8660254037844384,0,0,-130</face>"
+ "\n     <face>0,0,1,0,140</face>"
+ "\n     <face>0,0,-1,0,-180</face>"
+ "\n     <face>0,0,0,1,110</face>"
+ "\n     <face>0,0,0,-1,-180</face>"
+ "\n     <color>0,1,0</color>"
+ "\n </solid>"
+ "\n <solid>"
+ "\n     <name>triangone</name>"
+ "\n     <dimension>4</dimension>"
+ "\n     <face>1,0,0,0,60</face>"
+ "\n     <face>0.5,0.8660254037844386,0,0,60</face>"
+ "\n     <face>-0.5,0.8660254037844387,0,0,-20</face>"
+ "\n     <face>-1.0,0,0,0,-100</face>"
+ "\n     <face>-0.5,-0.8660254037844384,0,0,-100</face>"
+ "\n     <face>0.5,-0.8660254037844387,0,0,-20</face>"
+ "\n     <face>0,0,1,0,120</face>"
+ "\n     <face>0,0,-0.4999999999999998,-0.8660254037844387,-120</face>"
+ "\n     <face>0,0,-0.5000000000000004,0.8660254037844384,-120</face>"
+ "\n     <color>0,1,1</color>"
+ "\n </solid>"
+ "\n <light>"
+ "\n     <direction>1,1,1,1</direction>"
+ "\n     <color>0.2,0.2,0.6</color>"
+ "\n </light>"
+ "\n <color>0.8,0.9,0.9</color>"
+ "\n</space>"
+ "\n</model>"
+ 
+ 
+ ;
 -
+ ARTICLE: "TODO" "Todo"
+ { $list 
 -    "A file chooser"
+     "A vocab to initialize parameters"
+     "an editor mode" 
+         { $list "add a face to a solid"
+                 "add a solid to the space"
+                 "move a face"
+                 "move a solid"
+                 "select a solid in a list"
+                 "select a face"
+                 "display selected face"
+                 "edit a solid color"
+                 "add a light"
+                 "edit a light color"
+                 "move a light"
+                 }
+     "add a tool wich give an hyperplane normal vector with enought points. Will use adsoda.intersect-hyperplanes with { { 0 } { 0 } { 1 } } "
+     "decorrelate 3D camera and activate them with select buttons"
+ 
 -
 -
+ } ;
+ 
+ 
 -ARTICLE: "4DNav" "4DNav"
++ARTICLE: "4DNav" "The 4DNav app"
+ { $vocab-link "4DNav" }
+ $nl
+ { $heading "4D Navigator" }
+ "4DNav is a simple tool to visualize 4 dimensionnal objects."
+ "\n"
+ "It uses " { $vocab-link "adsoda" } " library to display a 4D space and navigate thru it."
 -
++$nl
+ "It will display:"
+ { $list
+     { "a menu window" }
+     {  "4 visualization windows" }
+ }
 -"Each window represents the projection of the 4D space on a particular 3D space."
 -$nl
 -
 -{ $heading "Initialization" }
 -"put the space file " { $strong "space-exemple.xml" } "  in temp directory"
 -" and then type:" { $code "\"4DNav\" run" } 
 -{ $heading "Navigation" }
 -"4D submenu move the space in translations and rotation."
 -"\n3D submenu move the camera in 3D space. Cameras in every 3D spaces are manipulated as a single one"
 -$nl
 -
++"Each visualization window represents the projection of the 4D space on a particular 3D space."
+ 
++{ $heading "Start" }
++"type:" { $code "\"4DNav\" run" } 
+ 
++{ $heading "Navigation" }
++"Menu window is divided in 4 areas"
++{ $list
++    { "a space-file chooser to select the file to display" }
++    { "a parametrization area to select the projection mode" }
++    { "4D submenu to translate and rotate the 4D space" }
++    { "3D submenu to move the camera in 3D space. Cameras in every 3D spaces are manipulated as a single one" }
++    }
+ 
+ { $heading "Links" }
+ { $subsection "Space file" }
+ 
+ { $subsection "TODO" }
 -
++{ $subsection "implementation details" }
+ 
+ ;
+ 
+ ABOUT: "4DNav"
diff --cc unmaintained/4DNav/4DNav.factor
index 0000000000,3a0543df1a..91c1c94b35
mode 000000,100755..100755
--- a/unmaintained/4DNav/4DNav.factor
+++ b/unmaintained/4DNav/4DNav.factor
@@@ -1,0 -1,524 +1,556 @@@
+ ! Copyright (C) 2008 Jeff Bigot
+ ! See http://factorcode.org/license.txt for BSD license.
+ USING: kernel 
+ namespaces
+ accessors
+ make
+ math
+ math.functions
+ math.trig
+ math.parser
+ hashtables
+ sequences
+ combinators
+ continuations
+ colors
+ prettyprint
+ vars
+ quotations
+ io
+ io.directories
+ io.pathnames
+ help.markup
+ io.files
+ ui.gadgets.panes
+  ui
+        ui.gadgets
+        ui.traverse
+        ui.gadgets.borders
+        ui.gadgets.handler
+        ui.gadgets.slate
+        ui.gadgets.theme
+        ui.gadgets.frames
+        ui.gadgets.tracks
+        ui.gadgets.labels
+        ui.gadgets.labelled       
+        ui.gadgets.lists
+        ui.gadgets.buttons
+        ui.gadgets.packs
+        ui.gadgets.grids
+        ui.gestures
+        ui.tools.workspace
+        ui.gadgets.scrollers
+ splitting
+ vectors
+ math.vectors
+ rewrite-closures
+ self
+ values
+ 4DNav.turtle
+ 4DNav.window3D
+ 4DNav.deep
+ 4DNav.space-file-decoder
+ models
+ fry
+ adsoda
+ adsoda.tools
+ ;
+ 
+ IN: 4DNav
+ VALUE: selected-file
+ VALUE: translation-step
+ VALUE: rotation-step
+ 
+ 3 to: translation-step 
+ 5 to: rotation-step
+ 
+ VAR: selected-file-model
+ VAR: observer3d 
+ VAR: view1 
+ VAR: view2
+ VAR: view3
+ VAR: view4
+ VAR: present-space
+ 
+ ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ 
+ ! replacement of namespaces.lib
+     
+ : make* ( seq -- seq ) [ dup quotation? [ call ] [ ] if ] map ;
+ 
+ ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ ! waiting for deep-cleave-quots
+ 
+ : 4D-Rxy ( angle -- Rx ) deg>rad
+ [ 1.0 , 0.0 , 0.0       , 0.0 ,
+   0.0 , 1.0 , 0.0       , 0.0 ,
+   0.0 , 0.0 , dup cos  , dup sin neg  ,
+   0.0 , 0.0 , dup sin  , dup cos  ,  ] 4 make-matrix nip ;
+ 
+ : 4D-Rxz ( angle -- Ry ) deg>rad
+ [ 1.0 , 0.0       , 0.0 , 0.0 ,
+   0.0 , dup cos  , 0.0 , dup sin neg  ,
+   0.0 , 0.0       , 1.0 , 0.0 ,
+   0.0 , dup sin  , 0.0 , dup cos  ,  ] 4 make-matrix nip ;
+ 
+ : 4D-Rxw ( angle -- Rz ) deg>rad
+ [ 1.0 , 0.0       , 0.0           , 0.0 ,
+   0.0 , dup cos  , dup sin neg  , 0.0 ,
+   0.0 , dup sin  , dup cos     , 0.0 ,
+   0.0 , 0.0       , 0.0           , 1.0 , ] 4 make-matrix nip ;
+ 
+ : 4D-Ryz ( angle -- Rx ) deg>rad
+ [ dup cos  , 0.0 , 0.0 , dup sin neg  ,
+   0.0       , 1.0 , 0.0 , 0.0 ,
+   0.0       , 0.0 , 1.0 , 0.0 ,
+   dup sin  , 0.0 , 0.0 , dup cos  ,   ] 4 make-matrix nip ;
+ 
+ : 4D-Ryw ( angle -- Ry ) deg>rad
+ [ dup cos  , 0.0 , dup sin neg  , 0.0 ,
+   0.0       , 1.0 , 0.0           , 0.0 ,
+   dup sin  , 0.0 , dup cos     , 0.0 ,
 -  0.0       , 0.0 , 0.0           , 1.0 ,  ] 4 make-matrix nip ;
++  0.0       , 0.0 , 0.0        , 1.0 ,  ] 4 make-matrix nip ;
+ 
+ : 4D-Rzw ( angle -- Rz ) deg>rad
+ [ dup cos  , dup sin neg  , 0.0 , 0.0 ,
+   dup sin  , dup cos     , 0.0 , 0.0 ,
+   0.0       , 0.0           , 1.0 , 0.0 ,
 -  0.0       , 0.0           , 0.0 , 1.0 ,  ] 4 make-matrix nip ;
++  0.0       , 0.0          , 0.0 , 1.0 ,  ] 4 make-matrix nip ;
+ 
 -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
++! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ ! UI
 -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
++! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ 
 -: button* ( string quot -- button ) closed-quot <repeat-button>  ;
++: button* ( string quot -- button ) 
++    closed-quot <repeat-button>  ;
+ 
 -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
++! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ ! 
 -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
++! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ 
+ : model-projection-chooser ( -- gadget )
+    observer3d> projection-mode>>
 -   { { 1 "perspective" } { 0 "orthogonal" }  } <toggle-buttons> ;
++   { { 1 "perspective" } { 0 "orthogonal" } } 
++   <toggle-buttons> ;
+ 
+ : collision-detection-chooser ( -- gadget )
+    observer3d> collision-mode>>
 -   { { t "on" } { f "off" }  } <toggle-buttons>
 -;
++   { { t "on" } { f "off" }  } <toggle-buttons> ;
+ 
 -: model-projection ( x -- space ) present-space>  swap space-project ;
++: model-projection ( x -- space ) 
++    present-space>  swap space-project ;
+ 
+ : update-observer-projections (  -- )
+     view1> relayout-1 
+     view2> relayout-1 
+     view3> relayout-1 
+     view4> relayout-1 ;
+ 
+ : update-model-projections (  -- )
+     0 model-projection <model> view1> (>>model)
+     1 model-projection <model> view2> (>>model)
+     2 model-projection <model> view3> (>>model)
+     3 model-projection <model> view4> (>>model) ;
+ 
+ : camera-action ( quot -- quot ) 
 -    [ drop [ ] observer3d>  with-self update-observer-projections ] 
++    [ drop [ ] observer3d>  
++    with-self update-observer-projections ] 
+     make* closed-quot ;
+ 
 -: win3D ( text gadget -- ) "navigateur 4D : " rot append open-window ;
++: win3D ( text gadget -- ) 
++    "navigateur 4D : " rot append open-window ;
+ 
 -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
++! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ ! 4D object manipulation
 -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
++! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ 
+ : (mvt-4D) ( quot -- )   
+     present-space>  
+         swap call space-ensure-solids 
+     >present-space 
+     update-model-projections 
+     update-observer-projections ;
+ 
+ : rotation-4D ( m -- ) 
 -    '[ _ [ [ middle-of-space dup vneg ] keep swap space-translate ] dip
++    '[ _ [ [ middle-of-space dup vneg ] keep 
++        swap space-translate ] dip
+          space-transform 
+          swap space-translate
+     ] (mvt-4D) ;
+ 
+ : translation-4D ( v -- ) '[ _ space-translate ] (mvt-4D) ;
+ 
 -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
++! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ ! menu
 -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
++! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ 
+ : menu-rotations-4D ( -- gadget )
+     <frame>
+          <pile> 1 >>fill
 -          "XY +" [ drop rotation-step 4D-Rxy rotation-4D ] button* add-gadget
 -          "XY -" [ drop rotation-step neg 4D-Rxy rotation-4D ] button* add-gadget 
++          "XY +" [ drop rotation-step 4D-Rxy rotation-4D ] 
++                button* add-gadget
++          "XY -" [ drop rotation-step neg 4D-Rxy rotation-4D ] 
++                button* add-gadget 
+        @top-left grid-add    
+         <pile> 1 >>fill
 -          "XZ +" [ drop rotation-step 4D-Rxz rotation-4D ] button* add-gadget
 -          "XZ -" [ drop rotation-step neg 4D-Rxz rotation-4D ] button* add-gadget 
++          "XZ +" [ drop rotation-step 4D-Rxz rotation-4D ] 
++                button* add-gadget
++          "XZ -" [ drop rotation-step neg 4D-Rxz rotation-4D ] 
++                button* add-gadget 
+        @top grid-add    
+         <pile> 1 >>fill
 -          "YZ +" [ drop rotation-step 4D-Ryz rotation-4D ] button* add-gadget
 -          "YZ -" [ drop rotation-step neg 4D-Ryz rotation-4D ] button* add-gadget 
++          "YZ +" [ drop rotation-step 4D-Ryz rotation-4D ] 
++                button* add-gadget
++          "YZ -" [ drop rotation-step neg 4D-Ryz rotation-4D ] 
++                button* add-gadget 
+         @center grid-add
+          <pile> 1 >>fill
 -          "XW +" [ drop rotation-step 4D-Rxw rotation-4D ] button* add-gadget
 -          "XW -" [ drop rotation-step neg 4D-Rxw rotation-4D ] button* add-gadget 
++          "XW +" [ drop rotation-step 4D-Rxw rotation-4D ] 
++                button* add-gadget
++          "XW -" [ drop rotation-step neg 4D-Rxw rotation-4D ] 
++                button* add-gadget 
+         @top-right grid-add   
+          <pile> 1 >>fill
 -          "YW +" [ drop rotation-step 4D-Ryw rotation-4D ] button* add-gadget
 -          "YW -" [ drop rotation-step neg 4D-Ryw rotation-4D ] button* add-gadget 
++          "YW +" [ drop rotation-step 4D-Ryw rotation-4D ] 
++                button* add-gadget
++          "YW -" [ drop rotation-step neg 4D-Ryw rotation-4D ] 
++                button* add-gadget 
+        @right grid-add    
+          <pile> 1 >>fill
 -          "ZW +" [ drop rotation-step 4D-Rzw rotation-4D ] button* add-gadget
 -          "ZW -" [ drop rotation-step neg 4D-Rzw rotation-4D ] button* add-gadget 
++          "ZW +" [ drop rotation-step 4D-Rzw rotation-4D ] 
++                button* add-gadget
++          "ZW -" [ drop rotation-step neg 4D-Rzw rotation-4D ] 
++                button* add-gadget 
+        @bottom-right grid-add    
+ ;
+ 
+ : menu-translations-4D ( -- gadget )
+     <frame> 
+         <pile> 1 >>fill
+             <shelf> 1 >>fill  
 -                "X+" [ drop {  1 0 0 0 } translation-step v*n translation-4D ] 
++                "X+" [ drop {  1 0 0 0 } translation-step v*n 
++                    translation-4D ] 
+                     button* add-gadget
 -                "X-" [ drop { -1 0 0 0 } translation-step v*n translation-4D ] 
++                "X-" [ drop { -1 0 0 0 } translation-step v*n 
++                    translation-4D ] 
+                     button* add-gadget 
+             add-gadget
+             "YZW" <label> add-gadget
+          @bottom-right grid-add
+          <pile> 1 >>fill
+             "XZW" <label> add-gadget
+             <shelf> 1 >>fill
 -                "Y+" [ drop  { 0  1 0 0 } translation-step v*n translation-4D ] 
++                "Y+" [ drop  { 0  1 0 0 } translation-step v*n 
++                    translation-4D ] 
+                     button* add-gadget
 -                "Y-" [ drop  { 0 -1 0 0 } translation-step v*n translation-4D ] 
++                "Y-" [ drop  { 0 -1 0 0 } translation-step v*n 
++                    translation-4D ] 
+                     button* add-gadget 
+                 add-gadget
+          @top-right grid-add
+          <pile> 1 >>fill
+             "XYW" <label> add-gadget
+             <shelf> 1 >>fill
 -                "Z+" [ drop { 0 0  1 0 } translation-step v*n translation-4D ] 
++                "Z+" [ drop { 0 0  1 0 } translation-step v*n 
++                    translation-4D ] 
+                     button* add-gadget
 -                "Z-" [ drop { 0 0 -1 0 } translation-step v*n translation-4D ] 
++                "Z-" [ drop { 0 0 -1 0 } translation-step v*n 
++                    translation-4D ] 
+                     button* add-gadget 
+                 add-gadget                 
+         @top-left grid-add     
+         <pile> 1 >>fill
+             <shelf> 1 >>fill
 -                "W+" [ drop { 0 0 0 1  } translation-step v*n translation-4D ] 
++                "W+" [ drop { 0 0 0 1  } translation-step v*n 
++                    translation-4D ] 
+                     button* add-gadget
 -                "W-" [ drop { 0 0 0 -1 } translation-step v*n translation-4D ] 
++                "W-" [ drop { 0 0 0 -1 } translation-step v*n 
++                    translation-4D ] 
+                     button* add-gadget 
+                 add-gadget
+             "XYZ" <label> add-gadget
+         @bottom-left grid-add 
+         "X" <label> @center grid-add
+ ;
+ 
+ : menu-4D ( -- gadget )  
+     <shelf> 
+         "rotations" <label>     add-gadget
+         menu-rotations-4D       add-gadget
+         "translations" <label>  add-gadget
+         menu-translations-4D    add-gadget
+         0.5 >>align
+         { 0 10 } >>gap
+ ;
+ 
+ 
+ ! ------------------------------------------------------
+ 
+ : redraw-model ( space -- )
+     >present-space 
+     update-model-projections 
+     update-observer-projections ;
+ 
+ : load-model-file ( -- )
 -  selected-file dup selected-file-model> set-model read-model-file 
++  selected-file dup selected-file-model> set-model 
++  read-model-file 
+   redraw-model ;
+ 
+ : mvt-3D-X ( turn pitch -- quot )
+     '[ turtle-pos> norm neg reset-turtle 
+         _ turn-left 
+         _ pitch-up 
+         step-turtle ] ;
+ 
+ : mvt-3D-1 ( -- quot )      90  0 mvt-3D-X ; inline
+ : mvt-3D-2 ( -- quot )      0  90 mvt-3D-X ; inline
+ : mvt-3D-3 ( -- quot )      0   0 mvt-3D-X ; inline
+ : mvt-3D-4 ( -- quot )      45 45 mvt-3D-X ; inline
+ 
+ : camera-button ( string quot -- button ) 
+     [ <label>  ] dip camera-action <repeat-button> ;
+ 
+ ! ----------------------------------------------------------
+ ! file chooser
+ ! ----------------------------------------------------------
+ : <run-file-button> ( file-name -- button )
+   dup '[ drop  _  \ selected-file set-value load-model-file 
+    ] 
+  closed-quot  <roll-button> { 0 0 } >>align ;
+ 
+ : <list-runner> ( -- gadget )
+     "resource:extra/4DNav" 
+   <pile> 1 >>fill 
+     over dup directory-files  
+     [ ".xml" tail? ] filter 
+     [ append-path ] with map
+     [ <run-file-button> add-gadget ] each
+     swap <labelled-gadget> ;
+ 
+ ! -----------------------------------------------------
+ 
+ : menu-rotations-3D ( -- gadget )
+     <frame>
 -        "Turn\n left"  [ rotation-step  turn-left  ] camera-button      
 -            @left grid-add     
 -        "Turn\n right" [ rotation-step turn-right ] camera-button      
 -            @right grid-add     
 -        "Pitch down"   [ rotation-step  pitch-down ] camera-button      
 -            @bottom grid-add     
 -        "Pitch up"     [ rotation-step  pitch-up   ] camera-button      
 -            @top grid-add     
++        "Turn\n left"  [ rotation-step  turn-left  ] 
++            camera-button   @left grid-add     
++        "Turn\n right" [ rotation-step turn-right ] 
++            camera-button   @right grid-add     
++        "Pitch down"   [ rotation-step  pitch-down ] 
++            camera-button   @bottom grid-add     
++        "Pitch up"     [ rotation-step  pitch-up   ] 
++            camera-button   @top grid-add     
+         <shelf>  1 >>fill
 -            "Roll left\n (ctl)"  [ rotation-step  roll-left  ] camera-button
 -                add-gadget  
 -            "Roll right\n(ctl)"  [ rotation-step  roll-right ] camera-button 
 -                add-gadget  
++            "Roll left\n (ctl)"  [ rotation-step  roll-left  ] 
++                camera-button   add-gadget  
++            "Roll right\n(ctl)"  [ rotation-step  roll-right ] 
++                camera-button   add-gadget  
+         @center grid-add 
+ ;
+ 
+ : menu-translations-3D ( -- gadget )
+     <frame>
 -        "left\n(alt)"          [ translation-step  strafe-left  ] camera-button
 -            @left grid-add  
 -        "right\n(alt)"         [ translation-step  strafe-right ] camera-button
 -            @right grid-add     
 -        "Strafe up \n (alt)"   [ translation-step strafe-up    ] camera-button
 -            @top grid-add
 -        "Strafe down \n (alt)" [ translation-step strafe-down  ] camera-button
 -            @bottom grid-add    
++        "left\n(alt)"        [ translation-step  strafe-left  ]
++            camera-button @left grid-add  
++        "right\n(alt)"       [ translation-step  strafe-right ]
++            camera-button @right grid-add     
++        "Strafe up \n (alt)" [ translation-step strafe-up    ] 
++            camera-button @top grid-add
++        "Strafe down\n (alt)" [ translation-step strafe-down  ]
++            camera-button @bottom grid-add    
+         <pile>  1 >>fill
 -            "Forward (ctl)"  [  translation-step step-turtle ] camera-button
 -                add-gadget
 -            "Backward (ctl)" [ translation-step neg step-turtle ] camera-button
 -                add-gadget
++            "Forward (ctl)"  [  translation-step step-turtle ] 
++                camera-button add-gadget
++            "Backward (ctl)" 
++                [ translation-step neg step-turtle ] 
++                camera-button   add-gadget
+         @center grid-add
+ ;
+ 
+ : menu-quick-views ( -- gadget )
+     <shelf>
+         "View 1 (1)" mvt-3D-1 camera-button   add-gadget
+         "View 2 (2)" mvt-3D-2 camera-button   add-gadget
+         "View 3 (3)" mvt-3D-3 camera-button   add-gadget 
+         "View 4 (4)" mvt-3D-4 camera-button   add-gadget 
+ ;
+ 
+ : menu-3D ( -- gadget ) 
+     <pile>
+         <shelf>   
+             menu-rotations-3D    add-gadget
+             menu-translations-3D add-gadget
+             0.5 >>align
+             { 0 10 } >>gap
+         add-gadget
+         menu-quick-views add-gadget ; 
+ 
+ : add-keyboard-delegate ( obj -- obj )
+  <handler>
+ {
+         { T{ key-down f f "LEFT" }  
+             [ [ rotation-step turn-left ] camera-action ] }
+         { T{ key-down f f "RIGHT" } 
+             [ [ rotation-step turn-right ] camera-action ] }
+         { T{ key-down f f "UP" }    
+             [ [ rotation-step pitch-down ] camera-action ] }
+         { T{ key-down f f "DOWN" }  
+             [ [ rotation-step pitch-up ] camera-action ] }
+ 
+         { T{ key-down f { C+ } "UP" } 
 -            [ [ translation-step step-turtle ] camera-action ] }
++           [ [ translation-step step-turtle ] camera-action ] }
+         { T{ key-down f { C+ } "DOWN" } 
 -            [ [ translation-step neg step-turtle ] camera-action ] }
++            [ [ translation-step neg step-turtle ] 
++                    camera-action ] }
+         { T{ key-down f { C+ } "LEFT" } 
+             [ [ rotation-step roll-left ] camera-action ] }
+         { T{ key-down f { C+ } "RIGHT" } 
+             [ [ rotation-step roll-right ] camera-action ] }
+ 
+         { T{ key-down f { A+ } "LEFT" }  
 -            [ [ translation-step strafe-left ] camera-action ] }
++           [ [ translation-step strafe-left ] camera-action ] }
+         { T{ key-down f { A+ } "RIGHT" } 
 -            [ [ translation-step strafe-right ] camera-action ] }
++          [ [ translation-step strafe-right ] camera-action ] }
+         { T{ key-down f { A+ } "UP" }    
+             [ [ translation-step strafe-up ] camera-action ] }
+         { T{ key-down f { A+ } "DOWN" }  
 -            [ [ translation-step strafe-down ] camera-action ] }
++           [ [ translation-step strafe-down ] camera-action ] }
+ 
+ 
+         { T{ key-down f f "1" } [ mvt-3D-1 camera-action ] }
+         { T{ key-down f f "2" } [ mvt-3D-2 camera-action ] }
+         { T{ key-down f f "3" } [ mvt-3D-3  camera-action ] }
+         { T{ key-down f f "4" } [ mvt-3D-4  camera-action ] }
+ 
+     } [ make* ] map >hashtable >>table
+     ;    
+ 
+ ! --------------------------------------------
+ ! print elements 
+ ! --------------------------------------------
+ ! print-content
+ 
+ GENERIC: adsoda-display-model ( x -- ) 
+ 
+ M: light adsoda-display-model 
+ "\n light : " .
+      { 
+         [ direction>> "direction : " pprint . ] 
+         [ color>> "color : " pprint . ]
+     }   cleave
+     ;
+ 
+ M: face adsoda-display-model 
+      {
+         [ halfspace>> "halfspace : " pprint . ] 
+         [ touching-corners>> "touching corners : " pprint . ]
+     }   cleave
+     ;
+ M: solid adsoda-display-model 
+      {
+         [ name>> "solid called : " pprint . ] 
+         [ color>> "color : " pprint . ]
+         [ dimension>> "dimension : " pprint . ]
 -        [ faces>> "composed of faces : " pprint [ adsoda-display-model ] each ]
++        [ faces>> "composed of faces : " pprint 
++            [ adsoda-display-model ] each ]
+     }   cleave
+     ;
+ M: space adsoda-display-model 
+      {
+         [ dimension>> "dimension : " pprint . ] 
+         [ ambient-color>> "ambient-color : " pprint . ]
 -        [ solids>> "composed of solids : " pprint [ adsoda-display-model ] each ]
 -        [ lights>> "composed of lights : " pprint [ adsoda-display-model ] each ] 
++        [ solids>> "composed of solids : " pprint 
++            [ adsoda-display-model ] each ]
++        [ lights>> "composed of lights : " pprint 
++            [ adsoda-display-model ] each ] 
+     }   cleave
+     ;
+ 
+ ! ----------------------------------------------
+ : menu-bar ( -- gadget )
+        <shelf>
 -             "reinit" [ drop load-model-file ] button* add-gadget
 -             selected-file-model> <label-control> add-gadget
++          "reinit" [ drop load-model-file ] button* add-gadget
++          selected-file-model> <label-control> add-gadget
+     ;
+ 
+ 
+ : controller-window* ( -- gadget )
+     { 0 1 } <track>
+         menu-bar f track-add
+         <list-runner>  
+             <limited-scroller>  
+             { 200 400 } >>max-dim
+         f track-add
+         <shelf>
+             "Projection mode : " <label> add-gadget
+             model-projection-chooser add-gadget
+         f track-add
+         <shelf>
 -            "Collision detection (slow and buggy ) : " <label> add-gadget
++            "Collision detection (slow and buggy ) : " 
++                <label> add-gadget
+             collision-detection-chooser add-gadget
+         f track-add
+         <pile>
+             0.5 >>align    
+             menu-4D add-gadget 
+             light-purple solid-interior
+             "4D movements" <labelled-gadget>
+         f track-add
+         <pile>
+             0.5 >>align
+             { 2 2 } >>gap
+             menu-3D add-gadget
+             light-purple solid-interior 
+             "Camera 3D" <labelled-gadget>
+         f track-add      
+         gray solid-interior
+  ;
+  
+ : viewer-windows* ( --  )
+     "YZW" view1> win3D 
+     "XZW" view2> win3D 
+     "XYW" view3> win3D 
+     "XYZ" view4> win3D   
+ ;
+ 
+ : navigator-window* ( -- )
+     controller-window*
+     viewer-windows*   
+     add-keyboard-delegate
+     "navigateur 4D" open-window
+ ;
+ 
+ : windows ( -- ) [ [ navigator-window* ] with-scope ] with-ui ;
+ 
+ 
+ ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ 
+ : init-variables ( -- )
+     "choose a file" <model> >selected-file-model  
+     <observer> >observer3d
+     [ observer3d> >self
+       reset-turtle 
+       45 turn-left 
+       45 pitch-up 
+       -300 step-turtle 
+     ] with-scope
+     
+ ;
+ 
+ 
+ : init-models ( -- )
+     0 model-projection observer3d> <window3D> >view1
+     1 model-projection observer3d> <window3D> >view2
+     2 model-projection observer3d> <window3D> >view3
+     3 model-projection observer3d> <window3D> >view4
+ ;
+ 
+ : 4DNav ( -- ) 
+     init-variables
+     selected-file read-model-file >present-space
+     init-models
+     windows
+ ;
+ 
+ MAIN: 4DNav
+ 
+ 
diff --cc unmaintained/4DNav/camera/camera-docs.factor
index 0000000000,422148aebe..4898c4e580
mode 000000,100755..100755
--- a/unmaintained/4DNav/camera/camera-docs.factor
+++ b/unmaintained/4DNav/camera/camera-docs.factor
@@@ -1,0 -1,88 +1,88 @@@
+ ! Copyright (C) 2008 Jean-François Bigot.
+ ! See http://factorcode.org/license.txt for BSD license.
+ USING: help.markup help.syntax kernel ;
+ IN: 4DNav.camera
+ 
+ HELP: camera-eye
+ { $values
+     
 -     { "point" null }
++     { "point" "position" }
+ }
+ { $description "return the position of the camera" } ;
+ 
+ HELP: camera-focus
+ { $values
+     
 -     { "point" null }
++     { "point" "position" }
+ }
+ { $description "return the point the camera looks at" } ;
+ 
+ HELP: camera-up
+ { $values
+     
 -     { "dirvec" null }
++     { "dirvec" "upside direction" }
+ }
+ { $description "In order to precise the roling position of camera give an upward vector" } ;
+ 
+ HELP: do-look-at
+ { $values
 -     { "camera" null }
++     { "camera" "direction" }
+ }
+ { $description "Word to use in replacement of gl-look-at when using a camera" } ;
+ 
 -ARTICLE: "4DNav.camera" "4DNav.camera"
++ARTICLE: "4DNav.camera" "Camera"
+ { $vocab-link "4DNav.camera" }
+ "\n"
+ "A camera is defined by:"
+ { $list
+ { "a position (" { $link camera-eye } ")" }
+ { "a focus direction (" { $link camera-focus } ")\n" }
+ { "an attitude information (" { $link camera-up } ")\n" }
+ }
+ "\nUse " { $link do-look-at } " in opengl statement in placement of gl-look-at"
+ "\n\n"
+ "A camera is a " { $vocab-link "4DNav.turtle" } " object. Its a special vocab to handle mouvements of a 3D object:"
+ { $list
+ { "To define a camera"
+ {
+     $unchecked-example
+     
+ "VAR: my-camera"
+ ": init-my-camera ( -- )"
+ "    <turtle> >my-camera"
+ "    [ my-camera> >self"
+ "      reset-turtle "
+ "    ] with-scope ;"
+ } }
+ { "To move it"
+ {
+     $unchecked-example
+ 
+ "    [ my-camera> >self"
+ "      45 pitch-up "
+ "      5 step-turtle" 
+ "    ] with-scope "
+ } }
+ { "or"
+ {
+     $unchecked-example
+ 
+ "    [ my-camera> >self"
+ "      5 strafe-left"
+ "    ] with-scope "
+ }
+ }
+ {
+ "to use it in an opengl statement"
+ {
+     $unchecked-example
+   "my-camera> do-look-at"
+ 
+ }
+ }
+ }
+ 
+ 
+ ;
+ 
+ ABOUT: "4DNav.camera"
diff --cc unmaintained/4DNav/camera/camera.factor
index 0000000000,93e8271f1b..1e492fe8d9
mode 000000,100755..100755
--- a/unmaintained/4DNav/camera/camera.factor
+++ b/unmaintained/4DNav/camera/camera.factor
@@@ -1,0 -1,15 +1,19 @@@
 -USING: kernel namespaces math.vectors opengl 4DNav.turtle self ;
++USING: kernel namespaces math.vectors opengl 4DNav.turtle 
++self ;
+ 
+ IN: 4DNav.camera
+ 
 -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
++! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ 
+ : camera-eye ( -- point ) turtle-pos> ;
+ 
 -: camera-focus ( -- point ) [ 1 step-turtle turtle-pos> ] save-self ;
++: camera-focus ( -- point ) 
++    [ 1 step-turtle turtle-pos> ] save-self ;
+ 
+ : camera-up ( -- dirvec )
 -[ 90 pitch-up turtle-pos> 1 step-turtle turtle-pos> swap v- ] save-self ;
++[ 90 pitch-up turtle-pos> 1 step-turtle turtle-pos> swap v- ] 
++    save-self ;
+ 
+ : do-look-at ( camera -- )
 -[ >self camera-eye camera-focus camera-up gl-look-at ] with-scope ;
++[ >self camera-eye camera-focus camera-up gl-look-at ] 
++    with-scope ;
diff --cc unmaintained/4DNav/deep/deep-docs.factor
index 0000000000,0332f77e66..78439c6c0f
mode 000000,100755..100755
--- a/unmaintained/4DNav/deep/deep-docs.factor
+++ b/unmaintained/4DNav/deep/deep-docs.factor
@@@ -1,0 -1,31 +1,31 @@@
+ ! Copyright (C) 2008 Jean-François Bigot.
+ ! See http://factorcode.org/license.txt for BSD license.
+ USING: help.markup help.syntax kernel quotations sequences ;
+ IN: 4DNav.deep
+ 
+ ! HELP: deep-cleave-quots
+ ! { $values
+ !     { "seq" sequence }
+ !     { "quot" quotation }
+ ! }
+ ! { $description "A word to build a soquence from a sequence of quotation" }
+ ! 
+ ! { $examples
+ ! "It is useful to build matrix"
+ ! { $example "USING: math math.trig ; "
+ !     " 30 deg>rad "
+ !    "  {  { [ cos ] [ sin neg ]   0 } "
+ !    "     { [ sin ] [ cos ]       0 } "
+ !    "     {   0       0           1 } "
+ !    "  } deep-cleave-quots " 
+ !     " "
+ ! 
+ ! 
+ ! } }
+ ! ;
+ 
 -ARTICLE: "4DNav.deep" "4DNav.deep"
++ARTICLE: "4DNav.deep" "Deep"
+ { $vocab-link "4DNav.deep" }
+ ;
+ 
+ ABOUT: "4DNav.deep"
diff --cc unmaintained/4DNav/deep/deep.factor
index 0000000000,65e15180bc..b18000a84c
mode 000000,100755..100755
--- a/unmaintained/4DNav/deep/deep.factor
+++ b/unmaintained/4DNav/deep/deep.factor
@@@ -1,0 -1,11 +1,13 @@@
 -USING: macros quotations math math.functions math.trig sequences.deep kernel make fry combinators grouping ;
++USING: macros quotations math math.functions math.trig 
++sequences.deep kernel make fry combinators grouping ;
+ IN: 4DNav.deep
+ 
+ ! USING: bake ;
+ ! MACRO: deep-cleave-quots ( seq -- quot )
+ !    [ [ quotation? ] deep-filter ]
+ !    [ [ dup quotation? [ drop , ] when ] deep-map ]
+ !    bi '[ _ cleave _ bake ] ;
+ 
 -: make-matrix ( quot width -- matrix ) [ { } make ] dip group ; inline
++: make-matrix ( quot width -- matrix ) 
++    [ { } make ] dip group ; inline
+ 
diff --cc unmaintained/4DNav/file-chooser/file-chooser.factor
index 0000000000,2056b728d7..d7c869ce2f
mode 000000,100755..100755
--- a/unmaintained/4DNav/file-chooser/file-chooser.factor
+++ b/unmaintained/4DNav/file-chooser/file-chooser.factor
@@@ -1,0 -1,144 +1,157 @@@
+ ! Copyright (C) 2008 Jeff Bigot
+ ! See http://factorcode.org/license.txt for BSD license.
+ USING:
+ kernel
+ io.files
+ io.backend
+ io.directories
+ io.files.info
+ io.pathnames
+ sequences
+ models
+ strings
+ ui
+ ui.operations
+ ui.commands
+ ui.gestures
+ ui.gadgets
+ ui.gadgets.buttons
+ ui.gadgets.lists
+ ui.gadgets.labels
+ ui.gadgets.tracks
+ ui.gadgets.packs
+ ui.gadgets.panes
+ ui.gadgets.scrollers
+ prettyprint
+ combinators
+ rewrite-closures
+ accessors
+ values
+ tools.walker
+ fry
+ ;
+ IN: 4DNav.file-chooser
+ 
+ TUPLE: file-chooser < track 
+     path
+     extension 
+     selected-file
+     presenter
+     hook  
+     list
+     ;
+ 
+ : find-file-list ( gadget -- list )
+     [ file-chooser? ] find-parent list>> ;
+ 
+ file-chooser H{
 -    { T{ key-down f f "UP" } [ find-file-list select-previous ] }
 -    { T{ key-down f f "DOWN" } [ find-file-list select-next ] }
 -    { T{ key-down f f "PAGE_UP" } [ find-file-list list-page-up ] }
 -    { T{ key-down f f "PAGE_DOWN" } [ find-file-list list-page-down ] }
 -    { T{ key-down f f "RET" } [ find-file-list invoke-value-action ] }
 -    { T{ button-down } request-focus }
 -    { T{ button-down f 1 } [ find-file-list invoke-value-action ]  }
++    { T{ key-down f f "UP" } 
++        [ find-file-list select-previous ] }
++    { T{ key-down f f "DOWN" } 
++        [ find-file-list select-next ] }
++    { T{ key-down f f "PAGE_UP" } 
++        [ find-file-list list-page-up ] }
++    { T{ key-down f f "PAGE_DOWN" } 
++        [ find-file-list list-page-down ] }
++    { T{ key-down f f "RET" } 
++        [ find-file-list invoke-value-action ] }
++    { T{ button-down } 
++        request-focus }
++    { T{ button-down f 1 } 
++        [ find-file-list invoke-value-action ]  }
+ } set-gestures
+ 
+ : list-of-files ( file-chooser -- seq )
+      [ path>> value>> directory-entries ] [ extension>> ] bi
 -     '[ [ name>> _ [ tail? ] with contains? ] [ directory? ] bi or ]  filter
++     '[ [ name>> _ [ tail? ] with any? ] 
++     [ directory? ] bi or ]  filter
+ ;
+ 
+ : update-filelist-model ( file-chooser -- file-chooser )
+     [ list-of-files ] [ model>> ] bi set-model ;
+ 
+ : init-filelist-model ( file-chooser -- file-chooser )
+     dup list-of-files <model> >>model ; 
+ 
+ : (fc-go) ( file-chooser quot -- )
+     [ [ file-chooser? ] find-parent dup path>> ] dip
+     call
+     normalize-path swap set-model
+     update-filelist-model
+     drop ;
+ 
+ : fc-go-parent ( file-chooser -- )
+     [ dup value>> parent-directory ] (fc-go) ;
+ 
+ : fc-go-home ( file-chooser -- )
+     [ home ] (fc-go) ;
+ 
+ : fc-change-directory ( file-chooser file -- file-chooser )
+     dupd [ path>> value>> normalize-path ] [ name>> ] bi* 
+     append-path over path>> set-model    
+     update-filelist-model
+ ;
+ 
+ : fc-load-file ( file-chooser file -- )
+   dupd [ selected-file>> ] [ name>> ] bi* swap set-model 
+   [ path>> value>> ] 
+   [ selected-file>> value>> append ] 
+   [ hook>> ] tri
+   call
+ ; inline
+ 
+ ! : fc-ok-action ( file-chooser -- quot )
+ !  dup selected-file>> value>>  "" =
+ !    [ drop [ drop ] ] [    
+ !            [ path>> value>> ] 
+ !            [ selected-file>> value>> append ] 
+ !            [ hook>> prefix ] tri
+ !        [ drop ] prepend
+ !    ]  if ; 
+ 
+ : line-selected-action ( file-chooser -- )
+      dup list>> list-value
+      dup directory? 
+      [ fc-change-directory ] [ fc-load-file ] if ;
+ 
+ : present-dir-element ( element -- string )
+     [ name>> ] [ directory? ] bi   [ "-> " prepend ] when ;
+ 
+ : <file-list> ( file-chooser -- list )
+   dup [ nip line-selected-action ] curry 
+   [ present-dir-element ] rot model>> <list> ;
+ 
+ : <file-chooser> ( hook path extension -- gadget )
+     { 0 1 } file-chooser new-track
+     swap >>extension
+     swap <model> >>path
+     "" <model> >>selected-file
+     swap >>hook
+     init-filelist-model
+     dup <file-list> >>list
+     "choose a file in directory " <label> f track-add
+     dup path>> <label-control> f track-add
 -    dup extension>> ", " join "limited to : " prepend <label> f track-add
++    dup extension>> ", " join "limited to : " prepend 
++        <label> f track-add
+     <shelf> 
+         "selected file : " <label> add-gadget
+         over selected-file>> <label-control> add-gadget
+     f track-add
+     <shelf> 
 -        over [  swap fc-go-parent ] curry  "go up" swap <bevel-button> add-gadget
 -        over [  swap fc-go-home ] curry  "go home" swap <bevel-button> add-gadget
 -    !    over [ swap fc-ok-action ] curry "OK" swap <bevel-button> add-gadget
++        over [  swap fc-go-parent ] curry  "go up" 
++            swap <bevel-button> add-gadget
++        over [  swap fc-go-home ] curry  "go home" 
++            swap <bevel-button> add-gadget
++    !    over [ swap fc-ok-action ] curry "OK" 
++    !    swap <bevel-button> add-gadget
+     !    [ drop ]  "Cancel" swap <bevel-button> add-gadget
+     f track-add
+     dup list>> <scroller> 1 track-add
+ ;
+ 
+ M: file-chooser pref-dim* drop { 400 200 } ;
+ 
+ : file-chooser-window ( -- )
 -[ . ] home { "xml" "txt" }   <file-chooser> "Choose a file" open-window ;
++    [ . ] home { "xml" "txt" }   <file-chooser> 
++    "Choose a file" open-window ;
+ 
diff --cc unmaintained/4DNav/space-file-decoder/space-file-decoder-docs.factor
index 0000000000,ce66375759..0a7816636f
mode 000000,100755..100755
--- a/unmaintained/4DNav/space-file-decoder/space-file-decoder-docs.factor
+++ b/unmaintained/4DNav/space-file-decoder/space-file-decoder-docs.factor
@@@ -1,0 -1,31 +1,20 @@@
+ ! Copyright (C) 2008 Jean-François Bigot.
+ ! See http://factorcode.org/license.txt for BSD license.
+ USING: help.markup help.syntax kernel ;
+ IN: 4DNav.space-file-decoder
+ 
 -HELP: adsoda-read-model
 -{ $values
 -     { "tag" null }
 -}
 -{ $description "" } ;
+ 
 -HELP: decode-number-array
 -{ $values
 -     { "x" null }
 -     { "y" null }
 -}
 -{ $description "" } ;
+ 
+ HELP: read-model-file
+ { $values
+     
+      { "path" "path to the file to read" }
 -     { "x" null }
++     { "x" "value" }
+ }
 -{ $description "" } ;
++{ $description "Read a file containing the xml description of the model" } ;
+ 
 -ARTICLE: "4DNav.space-file-decoder" "4DNav.space-file-decoder"
++ARTICLE: "4DNav.space-file-decoder" "Space XMLfile decoder"
+ { $vocab-link "4DNav.space-file-decoder" }
+ ;
+ 
+ ABOUT: "4DNav.space-file-decoder"
diff --cc unmaintained/4DNav/space-file-decoder/space-file-decoder.factor
index 0000000000,8ef5c9e906..872ddbcee3
mode 000000,100755..100755
--- a/unmaintained/4DNav/space-file-decoder/space-file-decoder.factor
+++ b/unmaintained/4DNav/space-file-decoder/space-file-decoder.factor
@@@ -1,0 -1,55 +1,66 @@@
+ ! Copyright (C) 2008 Jeff Bigot
+ ! See http://factorcode.org/license.txt for BSD license.
 -USING: adsoda xml xml.utilities xml.dispatch accessors combinators
 -sequences math.parser kernel splitting values continuations ;
++USING: adsoda xml xml.utilities xml.dispatch accessors 
++combinators sequences math.parser kernel splitting values 
++continuations ;
+ IN: 4DNav.space-file-decoder
+ 
 -: decode-number-array ( x -- y )  "," split [ string>number ] map ;
++: decode-number-array ( x -- y )  
++    "," split [ string>number ] map ;
+ 
+ PROCESS: adsoda-read-model ( tag -- )
+ 
 -TAG: dimension adsoda-read-model children>> first string>number ;
 -TAG: direction adsoda-read-model children>> first decode-number-array ;
 -TAG: color     adsoda-read-model children>> first decode-number-array ;
 -TAG: name      adsoda-read-model children>> first ;
 -TAG: face      adsoda-read-model children>> first decode-number-array ;
++TAG: dimension adsoda-read-model 
++    children>> first string>number ;
++TAG: direction adsoda-read-model 
++    children>> first decode-number-array ;
++TAG: color     adsoda-read-model 
++    children>> first decode-number-array ;
++TAG: name      adsoda-read-model 
++    children>> first ;
++TAG: face      adsoda-read-model 
++    children>> first decode-number-array ;
+ 
+ TAG: solid adsoda-read-model 
+     <solid> swap  
+     { 
 -        [ "dimension" tag-named adsoda-read-model >>dimension ] 
++        [ "dimension" tag-named adsoda-read-model >>dimension ]
+         [ "name"      tag-named adsoda-read-model >>name ] 
+         [ "color"     tag-named adsoda-read-model >>color ] 
 -        [ "face"      tags-named [ adsoda-read-model cut-solid ] each ] 
++        [ "face"      
++            tags-named [ adsoda-read-model cut-solid ] each ] 
+     } cleave
+     ensure-adjacencies
+ ;
+ 
+ TAG: light adsoda-read-model 
+    <light> swap  
+     { 
 -        [ "direction" tag-named adsoda-read-model >>direction ] 
++        [ "direction" tag-named adsoda-read-model >>direction ]
+         [ "color"     tag-named adsoda-read-model >>color ] 
+     } cleave
+ ;
+ 
+ TAG: space adsoda-read-model 
+     <space> swap  
+     { 
 -        [ "dimension" tag-named adsoda-read-model >>dimension ] 
++        [ "dimension" tag-named adsoda-read-model >>dimension ]
+         [ "name"      tag-named adsoda-read-model >>name ] 
 -        [ "color"     tag-named adsoda-read-model >>ambient-color ] 
 -        [ "solid"     tags-named [ adsoda-read-model suffix-solids ] each ] 
 -        [ "light"     tags-named [ adsoda-read-model suffix-lights ] each ]         
++        [ "color"     tag-named 
++            adsoda-read-model >>ambient-color ] 
++        [ "solid"     tags-named 
++            [ adsoda-read-model suffix-solids ] each ] 
++        [ "light"     tags-named 
++            [ adsoda-read-model suffix-lights ] each ]
+     } cleave
+ ;
+ 
+ : read-model-file ( path -- x )
+   dup
+   [
+     [ file>xml "space" tags-named first adsoda-read-model ] 
+     [ drop <space> ] recover 
+   ] [  drop <space> ] if 
+ 
+ ;
+ 
diff --cc unmaintained/4DNav/turtle/turtle-docs.factor
index 0000000000,e6f57972b9..b94ed99673
mode 000000,100755..100755
--- a/unmaintained/4DNav/turtle/turtle-docs.factor
+++ b/unmaintained/4DNav/turtle/turtle-docs.factor
@@@ -1,0 -1,229 +1,11 @@@
+ ! Copyright (C) 2008 Jean-François Bigot.
+ ! See http://factorcode.org/license.txt for BSD license.
+ USING: arrays help.markup help.syntax kernel sequences ;
+ IN: 4DNav.turtle
+ 
 -HELP: <turtle>
 -{ $values
 -    
 -     { "turtle" null }
 -}
 -{ $description "" } ;
+ 
 -HELP: >turtle-ori
 -{ $values
 -     { "val" null }
 -}
 -{ $description "" } ;
 -
 -HELP: >turtle-pos
 -{ $values
 -     { "val" null }
 -}
 -{ $description "" } ;
 -
 -HELP: Rx
 -{ $values
 -     { "angle" null }
 -     { "Rz" null }
 -}
 -{ $description "" } ;
 -
 -HELP: Ry
 -{ $values
 -     { "angle" null }
 -     { "Ry" null }
 -}
 -{ $description "" } ;
 -
 -HELP: Rz
 -{ $values
 -     { "angle" null }
 -     { "Rx" null }
 -}
 -{ $description "" } ;
 -
 -HELP: V
 -{ $values
 -    
 -     { "V" null }
 -}
 -{ $description "" } ;
 -
 -HELP: X
 -{ $values
 -    
 -     { "3array" null }
 -}
 -{ $description "" } ;
 -
 -HELP: Y
 -{ $values
 -    
 -     { "3array" null }
 -}
 -{ $description "" } ;
 -
 -HELP: Z
 -{ $values
 -    
 -     { "3array" null }
 -}
 -{ $description "" } ;
 -
 -HELP: apply-rotation
 -{ $values
 -     { "rotation" null }
 -}
 -{ $description "" } ;
 -
 -HELP: distance
 -{ $values
 -     { "turtle" null } { "turtle" null }
 -     { "n" null }
 -}
 -{ $description "" } ;
 -
 -HELP: move-by
 -{ $values
 -     { "point" null }
 -}
 -{ $description "" } ;
 -
 -HELP: pitch-down
 -{ $values
 -     { "angle" null }
 -}
 -{ $description "" } ;
 -
 -HELP: pitch-up
 -{ $values
 -     { "angle" null }
 -}
 -{ $description "" } ;
 -
 -HELP: reset-turtle
 -{ $description "" } ;
 -
 -HELP: roll-left
 -{ $values
 -     { "angle" null }
 -}
 -{ $description "" } ;
 -
 -HELP: roll-right
 -{ $values
 -     { "angle" null }
 -}
 -{ $description "" } ;
 -
 -HELP: roll-until-horizontal
 -{ $description "" } ;
 -
 -HELP: rotate-x
 -{ $values
 -     { "angle" null }
 -}
 -{ $description "" } ;
 -
 -HELP: rotate-y
 -{ $values
 -     { "angle" null }
 -}
 -{ $description "" } ;
 -
 -HELP: rotate-z
 -{ $values
 -     { "angle" null }
 -}
 -{ $description "" } ;
 -
 -HELP: set-X
 -{ $values
 -     { "seq" sequence }
 -}
 -{ $description "" } ;
 -
 -HELP: set-Y
 -{ $values
 -     { "seq" sequence }
 -}
 -{ $description "" } ;
 -
 -HELP: set-Z
 -{ $values
 -     { "seq" sequence }
 -}
 -{ $description "" } ;
 -
 -HELP: step-turtle
 -{ $values
 -     { "length" null }
 -}
 -{ $description "" } ;
 -
 -HELP: step-vector
 -{ $values
 -     { "length" null }
 -     { "array" array }
 -}
 -{ $description "" } ;
 -
 -HELP: strafe-down
 -{ $values
 -     { "length" null }
 -}
 -{ $description "" } ;
 -
 -HELP: strafe-left
 -{ $values
 -     { "length" null }
 -}
 -{ $description "" } ;
 -
 -HELP: strafe-right
 -{ $values
 -     { "length" null }
 -}
 -{ $description "" } ;
 -
 -HELP: strafe-up
 -{ $values
 -     { "length" null }
 -}
 -{ $description "" } ;
 -
 -HELP: turn-left
 -{ $values
 -     { "angle" null }
 -}
 -{ $description "" } ;
 -
 -HELP: turn-right
 -{ $values
 -     { "angle" null }
 -}
 -{ $description "" } ;
 -
 -HELP: turtle
 -{ $description "" } ;
 -
 -HELP: turtle-ori>
 -{ $values
 -    
 -     { "val" null }
 -}
 -{ $description "" } ;
 -
 -HELP: turtle-pos>
 -{ $values
 -    
 -     { "val" null }
 -}
 -{ $description "" } ;
 -
 -ARTICLE: "4DNav.turtle" "4DNav.turtle"
++ARTICLE: "4DNav.turtle" "Turtle"
+ { $vocab-link "4DNav.turtle" }
+ ;
+ 
+ ABOUT: "4DNav.turtle"
diff --cc unmaintained/4DNav/turtle/turtle.factor
index 0000000000,72a2e58e9b..62c25c4344
mode 000000,100755..100755
--- a/unmaintained/4DNav/turtle/turtle.factor
+++ b/unmaintained/4DNav/turtle/turtle.factor
@@@ -1,0 -1,152 +1,154 @@@
+ USING: kernel math arrays math.vectors math.matrices
+ namespaces make
+ math.constants math.functions
+ math.vectors
+ splitting grouping self math.trig
+   sequences accessors 4DNav.deep models ;
+ IN: 4DNav.turtle
+ 
 -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
++! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ 
+ TUPLE: turtle pos ori ;
+ 
+ : <turtle> ( -- turtle )
+     turtle new
+     { 0 0 0 } clone >>pos
+     3 identity-matrix >>ori
+ ;
+ 
+ 
+ TUPLE: observer < turtle projection-mode collision-mode ;
+ 
+ : <observer> ( -- object ) 
+      observer new
+     0 <model> >>projection-mode 
+     f <model> >>collision-mode
+     ;
+ 
+ 
+ : turtle-pos> ( -- val ) self> pos>> ;
+ : >turtle-pos ( val -- ) self> (>>pos) ;
+ 
+ : turtle-ori> ( -- val ) self> ori>> ;
+ : >turtle-ori ( val -- ) self> (>>ori) ;
+ 
 -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
++! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ 
+ ! These rotation matrices are from
+ ! `Computer Graphics: Principles and Practice'
+ 
+ 
+ ! waiting for deep-cleave-quots  
+ 
+ ! : Rz ( angle -- Rx ) deg>rad
+ !    {   { [ cos ] [ sin neg ]   0 }
+ !        { [ sin ] [ cos ]      0  }
+ !        {   0       0           1 } 
+ !    } deep-cleave-quots  ;
+ 
+ ! : Ry ( angle -- Ry ) deg>rad
+ !    {   { [ cos ]      0 [ sin ] }
+ !        {   0          1 0       }
+ !        { [  sin neg ] 0 [ cos ] }
+ !    } deep-cleave-quots  ;
+   
+ ! : Rx ( angle -- Rz ) deg>rad
+ !   {   { 1     0        0        }
+ !        { 0   [ cos ] [ sin neg ] }
+ !        { 0   [ sin ] [ cos ]     }
+ !    } deep-cleave-quots ;
+ 
+ : Rz ( angle -- Rx ) deg>rad
+ [ dup cos ,     dup sin neg ,   0 ,
+   dup sin ,     dup cos ,       0 ,
+   0 ,           0 ,             1 , ] 3 make-matrix nip ;
+ 
+ : Ry ( angle -- Ry ) deg>rad
+ [ dup cos ,     0 ,             dup sin ,
+   0 ,           1 ,             0 ,
+   dup sin neg , 0 ,             dup cos , ] 3 make-matrix nip ;
+ 
+ : Rx ( angle -- Rz ) deg>rad
+ [ 1 ,           0 ,             0 ,
+   0 ,           dup cos ,       dup sin neg ,
+   0 ,           dup sin ,       dup cos , ] 3 make-matrix nip ;
+ 
+ 
 -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 -
 -: apply-rotation ( rotation -- ) turtle-ori> swap m. >turtle-ori ;
++! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ 
++: apply-rotation ( rotation -- ) 
++    turtle-ori> swap m. >turtle-ori ;
+ : rotate-x ( angle -- ) Rx apply-rotation ;
+ : rotate-y ( angle -- ) Ry apply-rotation ;
+ : rotate-z ( angle -- ) Rz apply-rotation ;
+ 
 -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
++! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ 
+ : pitch-up   ( angle -- ) neg rotate-x ;
+ : pitch-down ( angle -- )     rotate-x ;
+ 
+ : turn-left ( angle -- )      rotate-y ;
+ : turn-right ( angle -- ) neg rotate-y ;
+ 
+ : roll-left  ( angle -- ) neg rotate-z ;
+ : roll-right ( angle -- )     rotate-z ;
+ 
 -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
++! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ ! roll-until-horizontal
 -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
++! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ 
+ : V ( -- V ) { 0 1 0 } ;
+ 
+ : X ( -- 3array ) turtle-ori> [ first  ] map ;
+ : Y ( -- 3array ) turtle-ori> [ second ] map ;
+ : Z ( -- 3array ) turtle-ori> [ third  ] map ;
+ 
+ : set-X ( seq -- ) turtle-ori> [ set-first ] 2each ;
+ : set-Y ( seq -- ) turtle-ori> [ set-second ] 2each ;
+ : set-Z ( seq -- ) turtle-ori> [ set-third ] 2each ;
+ 
+ : roll-until-horizontal ( -- )
+     V Z cross normalize set-X
+     Z X cross normalize set-Y ;
+ 
 -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
++! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ 
 -: distance ( turtle turtle -- n ) pos>> swap pos>> v- [ sq ] map sum sqrt ;
++: distance ( turtle turtle -- n ) 
++    pos>> swap pos>> v- [ sq ] map sum sqrt ;
+ 
+ : move-by ( point -- ) turtle-pos> v+ >turtle-pos ;
+ 
 -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
++! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ 
+ : reset-turtle ( -- ) 
+     { 0 0 0 } clone >turtle-pos 3 identity-matrix >turtle-ori ;
+ 
 -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
++! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ 
+ : step-vector ( length -- array ) { 0 0 1 } n*v ;
+ 
+ : step-turtle ( length -- ) 
 -    step-vector turtle-ori> swap m.v turtle-pos> v+ >turtle-pos ;
++    step-vector turtle-ori> swap m.v 
++    turtle-pos> v+ >turtle-pos ;
+ 
 -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
++! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ 
+ : strafe-up ( length -- )
+     90 pitch-up
+     step-turtle
+     90 pitch-down ;
+ 
+ : strafe-down ( length -- )
+     90 pitch-down
+     step-turtle
+     90 pitch-up ;
+ 
+ : strafe-left ( length -- )
+     90 turn-left
+     step-turtle
+     90 turn-right ;
+ 
+ : strafe-right ( length -- )
+     90 turn-right
+     step-turtle
+     90 turn-left ;
diff --cc unmaintained/4DNav/window3D/window3D-docs.factor
index 0000000000,d57df6a8d8..a534d2e9ec
mode 000000,100755..100755
--- a/unmaintained/4DNav/window3D/window3D-docs.factor
+++ b/unmaintained/4DNav/window3D/window3D-docs.factor
@@@ -1,0 -1,20 +1,12 @@@
+ ! Copyright (C) 2008 Jean-François Bigot.
+ ! See http://factorcode.org/license.txt for BSD license.
+ USING: help.markup help.syntax kernel ;
+ IN: 4DNav.window3D
+ 
 -HELP: <window3D>
 -{ $values
 -     { "model" null } { "observer" null }
 -     { "gadget" null }
 -}
 -{ $description "" } ;
+ 
 -HELP: window3D
 -{ $description "" } ;
+ 
 -ARTICLE: "4DNav.window3D" "4DNav.window3D"
++ARTICLE: "4DNav.window3D" "Window3D"
+ { $vocab-link "4DNav.window3D" }
+ ;
+ 
+ ABOUT: "4DNav.window3D"
diff --cc unmaintained/4DNav/window3D/window3D.factor
index 0000000000,6db5d7c2f5..a5ca5f2a9a
mode 000000,100755..100755
--- a/unmaintained/4DNav/window3D/window3D.factor
+++ b/unmaintained/4DNav/window3D/window3D.factor
@@@ -1,0 -1,82 +1,83 @@@
+ ! Copyright (C) 2008 Jeff Bigot
+ ! See http://factorcode.org/license.txt for BSD license.
+ USING: kernel 
+ ui.gadgets
+ ui.render
+ opengl
+ opengl.gl
+ opengl.glu
+ 4DNav.camera
+ 4DNav.turtle
+ math
+ values
+ alien.c-types
+ accessors
+ namespaces
+ adsoda 
+ models
+ accessors
+ prettyprint
+ ;
+ 
+ IN: 4DNav.window3D
+ 
 -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
++! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ ! drawing functions 
 -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
++! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ 
+ TUPLE: window3D  < gadget observer ; 
+ 
+ : <window3D>  ( model observer -- gadget )
+     window3D  new-gadget 
+     swap 2dup 
+     projection-mode>> add-connection
+     2dup 
+     collision-mode>> add-connection
+     >>observer 
+     swap <model> >>model 
+     t >>root?
+ ;
+ 
+ M: window3D pref-dim* ( gadget -- dim )  drop { 300 300 } ;
+ 
+ M: window3D draw-gadget* ( gadget -- )
+ 
+     GL_PROJECTION glMatrixMode
+         glLoadIdentity
+         0.6 0.6 0.6 .9 glClearColor
+         dup observer>> projection-mode>> value>> 1 =    
+         [ 60.0 1.0 0.1 3000.0 gluPerspective ]
+         [ -400.0 400.0 -400.0 400.0 0.0 4000.0 glOrtho ] if
+         dup observer>> collision-mode>> value>> 
+         \ remove-hidden-solids?   
+         set-value
+         dup  observer>> do-look-at
+         GL_MODELVIEW glMatrixMode
+             glLoadIdentity  
+             0.9 0.9 0.9 1.0 glClearColor
+             1.0 glClearDepth
+             GL_LINE_SMOOTH glEnable
+             GL_BLEND glEnable
+             GL_DEPTH_TEST glEnable       
+             GL_LEQUAL glDepthFunc
+             GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA glBlendFunc
+             GL_LINE_SMOOTH_HINT GL_NICEST glHint
+             1.25 glLineWidth
 -            GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT bitor glClear
++            GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT bitor 
++                glClear
+             glLoadIdentity
+             GL_LIGHTING glEnable
+             GL_LIGHT0 glEnable
+             GL_COLOR_MATERIAL glEnable
+             GL_FRONT GL_AMBIENT_AND_DIFFUSE glColorMaterial
+             ! *************************
+             
+             model>> value>> 
+             [ space->GL ] when*
+ 
+             ! *************************
+ ;
+ 
+ M: window3D graft* drop ;
+ 
+ M: window3D model-changed nip relayout ; 
diff --cc unmaintained/adsoda/adsoda-docs.factor
index 0000000000,d90beb7c7b..9ab874d370
mode 000000,100755..100755
--- a/unmaintained/adsoda/adsoda-docs.factor
+++ b/unmaintained/adsoda/adsoda-docs.factor
@@@ -1,0 -1,300 +1,299 @@@
+ ! Copyright (C) 2008 Jeff Bigot
+ ! See http://factorcode.org/license.txt for BSD license.
+ USING: help.markup help.syntax ;
+ 
+ IN: adsoda
+ 
+ 
+ 
+ ! --------------------------------------------------------------
+ ! faces
+ ! --------------------------------------------------------------
 -ARTICLE: "face-page" "face in ADSODA"
++ARTICLE: "face-page" "Face in ADSODA"
+ "explanation of faces"
+ $nl
+ "link to functions"
+ "what is an halfspace"
+ "halfspace touching-corners adjacent-faces"
+ "touching-corners list of pointers to the corners which touch this face\n"
+ 
+ "adjacent-faces list of pointers to the faces which touch this face\n"
+ { $subsection face }
+ { $subsection <face> }
+ "test relative position"
+ { $subsection point-inside-or-on-face? } 
+ { $subsection point-inside-face? }
+ "handling face"
+ { $subsection flip-face }
+ { $subsection face-translate  }
+ { $subsection  face-transform }
+ 
+ ;
+ 
+ HELP: face
+ { $class-description "a face is defined by"
+ { $list "halfspace equation" }
+ { $list "list of touching corners" }
+ { $list "list of adjacent faces" }
+ $nl
+ "Touching corners and adjacent faces are defined by algorithm thanks to other faces of the solid"
+ }
+ 
+ 
+ ;
+ HELP: <face> 
+ { $values { "v" "an halfspace equation" } { "tuple" "a face" }  }   ;
+ HELP: flip-face 
+ { $values { "face" "a face" } { "face" "flipped face" } }
+ { $description "change the orientation of a face" }
+ ;
+ 
+ HELP: face-translate 
+ { $values { "face" "a face" } { "v" "a vector" } }
+ { $description 
+ "translate a face following a vector"
+ $nl
+ "a translation of an halfspace doesn't change the normal vector. this word just compute the new constant term" }
+ 
+  
+  ;
+ HELP: face-transform 
+ { $values { "face" "a face" } { "m" "a transformation matrix" } }
+ { $description  "compute the transformation of a face using a transformation matrix" }
+  
+  ;
+ ! --------------------------------
+ ! solid
+ ! --------------------------------------------------------------
 -ARTICLE: "solid-page" "solid in ADSODA"
++ARTICLE: "solid-page" "Solid in ADSODA"
+ "explanation of solids"
+ $nl
+ "link to functions"
+ { $subsection solid }
+ { $subsection <solid> }
+ "test relative position"
+ { $subsection point-inside-solid? }
+ { $subsection point-inside-or-on-solid? }
+ "playing with faces and solids"
+ { $subsection add-face }
+ { $subsection cut-solid }
+ { $subsection slice-solid }
+ "solid handling"
+ { $subsection solid-project }
+ { $subsection solid-translate }
+ { $subsection solid-transform }
+ { $subsection subtract }
+ 
+ { $subsection get-silhouette  }
+ 
+ { $subsection  solid= }
+ 
+ 
+ ;
+ 
+ HELP: solid 
+ { $class-description "dimension" $nl "silhouettes" $nl "faces" $nl "corners" $nl "adjacencies-valid" $nl "color" $nl "name" 
+ }
+ ;
+ 
+ HELP: add-face 
+ { $values { "solid" "a solid" } { "face" "a face" } }
+ { $description "reshape a solid with a face. The face truncate the solid." } ;
+ 
+ HELP: cut-solid
+ { $values { "solid" "a solid" } { "halfspace" "an halfspace" } }
+ { $description "like add-face but just with halfspace equation" } ;
+ 
+ HELP: slice-solid
+ { $values { "solid" "a solid" } { "face" "a face" } { "solid1" "the outer part of the former solid" } { "solid2" "the inner part of the former solid" } }
+ { $description "cut a solid into two parts. The face acts like a knife"
+ }  ;
+ 
+ 
+ HELP: solid-project
+ { $values { "lights" "lights" } { "ambient" "ambient" } { "solid" "solid" } { "solids" "projection of solid" } }
+ { $description "Project the solid using pv vector" 
+ $nl
+ "TODO: explain how to use lights"
+ } ;
+ 
+ HELP: solid-translate 
+ { $values { "solid" "a solid" } { "v" "translating vector" } }
+ { $description "Translate a solid using a vector" 
+ $nl
+ "v and solid must have the same dimension "
+ } ;
+ 
+ HELP: solid-transform 
+ { $values { "solid" "a solid" } { "m" "transformation matrix" } }
+ { $description "Transform a solid using a matrix"
+ $nl
+ "v and solid must have the same dimension "
+ } ;
+ 
+ HELP: subtract 
+ { $values { "solid1" "initial shape" } { "solid2" "shape to remove" } { "solids" "resulting shape" } }
 -{ $description  " " } ;
++{ $description  "Substract solid2 from solid1" } ;
+ 
+ 
+ ! --------------------------------------------------------------
+ ! space 
+ ! --------------------------------------------------------------
 -ARTICLE: "space-page" "space in ADSODA"
++ARTICLE: "space-page" "Space in ADSODA"
+ "A space is a collection of solids and lights."
+ $nl
+ "link to functions"
+ $nl
+ "Defining words"
+ { $subsection space }
+ { $subsection <space> } 
+ { $subsection suffix-solids  }
+ { $subsection suffix-lights }
+ { $subsection clear-space-solids  }
+ { $subsection describe-space }
+ 
+ 
+ "Handling space"
+ { $subsection space-ensure-solids }
+ { $subsection eliminate-empty-solids  }
+ { $subsection space-transform }
+ { $subsection space-translate }
+ { $subsection remove-hidden-solids }
+ { $subsection space-project }
+ 
+ 
+ ;
+ 
+ HELP: space 
+ { $class-description 
+ "dimension" $nl " solids" $nl " ambient-color" $nl "lights" 
+ }
+ ;
+ 
+ HELP: suffix-solids 
+ "( space solid -- space )"
+ { $values { "space" "a space" } { "solid" "a solid to add" } }
+ { $description "Add solid to space definition" } ;
+ 
+ HELP: suffix-lights 
+ "( space light -- space ) "
+ { $values { "space" "a space" } { "light" "a light to add" } }
+ { $description "Add a light to space definition" } ;
+ 
+ HELP: clear-space-solids 
+ "( space -- space )"   
+ { $values { "space" "a space" } }
+ { $description "remove all solids in space" } ;
+ 
+ HELP: space-ensure-solids 
+ { $values { "space" "a space" } }
+ { $description "rebuild corners of all solids in space" } ;
+ 
+ 
+ 
+ HELP: space-transform 
+ " ( space m -- space )" 
+ { $values { "space" "a space" } { "m" "a matrix" } }
+ { $description "Transform a space using a matrix" } ;
+ 
+ HELP: space-translate 
+ { $values { "space" "a space" } { "v" "a vector" } }
+ { $description "Translate a space following a vector" } ;
+ 
+ HELP: describe-space " ( space -- )"
+ { $values { "space" "a space" } }
+ { $description "return a description of space" } ;
+ 
+ HELP: space-project 
+ { $values { "space" "a space" } { "i" "an integer" } }
+ { $description "Project a space along ith coordinate" } ;
+ 
+ ! --------------------------------------------------------------
+ ! 3D rendering
+ ! --------------------------------------------------------------
 -ARTICLE: "3D-rendering-page" "3D rendering in ADSODA"
++ARTICLE: "3D-rendering-page" "The 3D rendering in ADSODA"
+ "explanation of 3D rendering"
+ $nl
+ "link to functions"
+ { $subsection face->GL }
+ { $subsection solid->GL }
+ { $subsection space->GL }
+ 
+ ;
+ 
+ HELP: face->GL 
+ { $values { "face" "a face" } { "color" "3 3 values array" } }
 -{ $description "" } ;
++{ $description "display a face" } ;
+ 
+ HELP: solid->GL 
+ { $values { "solid" "a solid" } }
 -{ $description "" } ;
++{ $description "display a solid" } ;
+ 
+ HELP: space->GL 
+ { $values { "space" "a space" } }
 -{ $description "" } ;
++{ $description "display a space" } ;
+ 
+ ! --------------------------------------------------------------
+ ! light
+ ! --------------------------------------------------------------
+ 
 -ARTICLE: "light-page" "light in ADSODA"
++ARTICLE: "light-page" "Light in ADSODA"
+ "explanation of light"
+ $nl
+ "link to functions"
+ ;
+ 
+ ARTICLE: { "adsoda" "light" } "ADSODA : lights"
+ "! HELP: light position color" 
+ "! <light> ( -- tuple ) light new ;"
+ 
+ "! light est un vecteur avec 3 variables pour les couleurs\n"
+ 
+ " void Light::Apply(Vector& normal, double &cRed, double &cGreen, double &cBlue)\n"
+ " { \n"
+ "   // Dot the light direction with the normalized normal of Face."
+ "   register double intensity = -(normal * (*this));"
+ 
+ "   // Face is a backface, from light's perspective"
+ "   if (intensity < 0)"
+ "     return;"
+ "   "
+ "   // Add the intensity componentwise"
+ "   cRed += red * intensity;"
+ "   cGreen += green * intensity;"
+ "   cBlue += blue * intensity;"
+ 
+ "   // Clip to unit range"
+ "  if (cRed > 1.0) cRed = 1.0;"
+ "   if (cGreen > 1.0) cGreen = 1.0;"
+ "   if (cBlue > 1.0) cBlue = 1.0;"
+ 
+ 
+ ;
+ 
+ 
+ 
+ ARTICLE: { "adsoda" "halfspace" } "ADSODA : halfspace"
 -"! demi espace défini par un vecteur normal et une constante"
+ " defined by the concatenation of the normal vector and a constant"  
+  ;
+ 
+ 
+ 
+ ARTICLE:  "adsoda-main-page"  "ADSODA : Arbitrary-Dimensional Solid Object Display Algorithm"
+ "multidimensional handler :" 
+ $nl
+ "design a solid using face delimitations. Only works on convex shapes"
+ $nl
+ { $emphasis "written in C++ by Greg Ferrar" }
+ $nl
+ "full explanation on adsoda page at " { $url "http://www.flowerfire.com/ADSODA/" }
+ $nl
+ "Useful words are describe on the following pages: "
+ { $subsection "face-page" }
+ { $subsection "solid-page" }
+ { $subsection "space-page" }
+ { $subsection "light-page" }
+ { $subsection "3D-rendering-page" }
+  ;
+ 
+ ABOUT: "adsoda-main-page"
diff --cc unmaintained/adsoda/adsoda.factor
index 0000000000,e586087e48..01e437bc7d
mode 000000,100755..100755
--- a/unmaintained/adsoda/adsoda.factor
+++ b/unmaintained/adsoda/adsoda.factor
@@@ -1,0 -1,543 +1,570 @@@
+ ! Copyright (C) 2008 Jeff Bigot
+ ! See http://factorcode.org/license.txt for BSD license.
+ USING: accessors
+ arrays 
+ assocs
+ combinators
+ kernel 
+ fry
+ math 
+ math.constants
+ math.functions
+ math.libm
+ math.order
+ math.vectors 
+ math.matrices 
+ math.parser
+ namespaces
+ prettyprint
+ sequences
+ sequences.deep
+ sets
+ slots
+ sorting
+ tools.time
+ vars
+ continuations
+ words
+ opengl
+ opengl.gl
+ colors
+ adsoda.solution2
+ adsoda.combinators
+ opengl.demo-support
+ values
+ tools.walker
+ ;
+ 
+ IN: adsoda
+ 
+ DEFER: combinations
+ VAR: pv
+ 
+ 
 -! ---------------------------------------------------------------------
++! -------------------------------------------------------------
+ ! global values
+ VALUE: remove-hidden-solids?
+ VALUE: VERY-SMALL-NUM
+ VALUE: ZERO-VALUE
+ VALUE: MAX-FACE-PER-CORNER
+ 
+ t to: remove-hidden-solids?
+ 0.0000001 to: VERY-SMALL-NUM
+ 0.0000001 to: ZERO-VALUE
+ 4 to: MAX-FACE-PER-CORNER
 -! ---------------------------------------------------------------------
++! -------------------------------------------------------------
+ ! sequence complement
+ 
+ : with-pv ( i quot -- ) [ swap >pv call ] with-scope  ; inline
+ 
+ : dimension ( array -- x )      length 1- ; inline 
 -: last ( seq -- x )             [ dimension ] [ nth ] bi ; inline
 -: change-last ( seq quot --  )  [ [ dimension ] keep ] dip change-nth  ; 
++: last ( seq -- x )           [ dimension ] [ nth ] bi ; inline
++: change-last ( seq quot -- ) 
++    [ [ dimension ] keep ] dip change-nth  ; 
+ 
 -! --------------------------------------------------------------
++! -------------------------------------------------------------
+ ! light
 -! --------------------------------------------------------------
++! -------------------------------------------------------------
+ 
+ TUPLE: light name { direction array } color ;
+ : <light> ( -- tuple ) light new ;
+ 
 -! -----------------------------------------------------------------------
++! -------------------------------------------------------------
+ ! halfspace manipulation
 -! -----------------------------------------------------------------------
++! -------------------------------------------------------------
+ 
+ : constant+ ( v x -- w )  '[ [ _ + ] change-last ] keep ;
+ : translate ( u v -- w )   dupd     v* sum     constant+ ; 
+ 
+ : transform ( u matrix -- w )
+     [ swap m.v ] 2keep ! compute new normal vector    
+     [
 -        [ [ abs ZERO-VALUE > ] find ] keep ! find a point on the frontier
++        [ [ abs ZERO-VALUE > ] find ] keep 
++        ! find a point on the frontier
+         ! be sure it's not null vector
+         last ! get constant
+         swap /f neg swap ! intercept value
+     ] dip  
+     flip 
+     nth
+     [ * ] with map ! apply intercep value
+     over v*
+     sum  neg
+     suffix ! add value as constant at the end of equation
+ ;
+ 
+ : position-point ( halfspace v -- x ) 
+     -1 suffix v* sum  ; inline
+ : point-inside-halfspace? ( halfspace v -- ? )       
+     position-point VERY-SMALL-NUM  > ; 
+ : point-inside-or-on-halfspace? ( halfspace v -- ? ) 
+     position-point VERY-SMALL-NUM neg > ;
 -: project-vector (  seq -- seq )     pv> [ head ] [ 1+  tail ] 2bi append ; 
 -: get-intersection ( matrice -- seq )     [ 1 tail* ] map     flip first ;
++: project-vector (  seq -- seq )     
++    pv> [ head ] [ 1+  tail ] 2bi append ; 
++: get-intersection ( matrice -- seq )     
++    [ 1 tail* ] map     flip first ;
+ 
+ : islenght=? ( seq n -- seq n ? ) 2dup [ length ] [ = ] bi*  ;
+ 
+ : compare-nleft-to-identity-matrix ( seq n -- ? ) 
+     [ [ head ] curry map ] keep  identity-matrix m- 
+     flatten
+     [ abs ZERO-VALUE < ] all?
+ ;
+ 
+ : valid-solution? ( matrice n -- ? )
+     islenght=?
+     [ compare-nleft-to-identity-matrix ]  
+     [ 2drop f ] if ; inline
+ 
+ : intersect-hyperplanes ( matrice -- seq )
+     [ solution dup ] [ first dimension ] bi
+     valid-solution?     [ get-intersection ] [ drop f ] if ;
+ 
 -! --------------------------------------------------------------
++! -------------------------------------------------------------
+ ! faces
 -! --------------------------------------------------------------
++! -------------------------------------------------------------
+ 
 -TUPLE: face { halfspace array } touching-corners adjacent-faces ;
++TUPLE: face { halfspace array } 
++    touching-corners adjacent-faces ;
+ : <face> ( v -- tuple )       face new swap >>halfspace ;
+ : flip-face ( face -- face ) [ vneg ] change-halfspace ;
 -: erase-face-touching-corners ( face -- face ) f >>touching-corners ;
 -: erase-face-adjacent-faces ( face -- face )   f >>adjacent-faces ;
++: erase-face-touching-corners ( face -- face ) 
++    f >>touching-corners ;
++: erase-face-adjacent-faces ( face -- face )   
++    f >>adjacent-faces ;
+ : faces-intersection ( faces -- v )  
+     [ halfspace>> ] map intersect-hyperplanes ;
+ : face-translate ( face v -- face ) 
+     [ translate ] curry change-halfspace ; inline
+ : face-transform ( face m -- face )
+     [ transform ] curry change-halfspace ; inline
 -: face-orientation ( face -- x )  pv> swap halfspace>> nth sgn ;
++: face-orientation ( face -- x ) pv> swap halfspace>> nth sgn ;
+ : backface? ( face -- face ? )      dup face-orientation 0 <= ;
+ : pv-factor ( face -- f face )     
+     halfspace>> [ pv> swap nth [ * ] curry ] keep ; inline
+ : suffix-touching-corner ( face corner -- face ) 
+     [ suffix ] curry   change-touching-corners ; inline
+ : real-face? ( face -- ? )
 -    [ touching-corners>> length ] [ halfspace>> dimension ] bi >= ;
++    [ touching-corners>> length ] 
++    [ halfspace>> dimension ] bi >= ;
+ 
+ : (add-to-adjacent-faces) ( face face -- face )
+     over adjacent-faces>> 2dup member?
+     [ 2drop ] [ swap suffix >>adjacent-faces ] if ;
+ 
+ : add-to-adjacent-faces ( face face -- face )
+     2dup =   [ drop ] [ (add-to-adjacent-faces) ] if ;
+ 
+ : update-adjacent-faces ( faces corner -- )
+    '[ [ _ suffix-touching-corner drop ] each ] keep 
+     2 among [ 
+         [ first ] keep second  
+         [ add-to-adjacent-faces drop ] 2keep 
+         swap add-to-adjacent-faces drop  
+     ] each ; inline
+ 
+ : face-project-dim ( face -- x )  halfspace>> length 2 -  ;
+ 
+ : apply-light ( color light normal -- u )
+     over direction>>  v. 
+     neg dup 0 > 
+     [ 
+         [ color>> swap ] dip 
+         [ * ] curry map v+ 
+         [ 1 min ] map 
+     ] 
+     [ 2drop ] 
+     if
+ ;
+ 
+ : enlight-projection ( array face -- color )
+     ! array = lights + ambient color
+     [ [ third ] [ second ] [ first ] tri ]
+     [ halfspace>> project-vector normalize ] bi*
+     [ apply-light ] curry each
+     v*
+ ;
+ 
+ : (intersection-into-face) ( face-init face-adja quot -- face )
+     [
+     [  [ pv-factor ] bi@ 
+         roll 
+         [ map ] 2bi@
+         v-
+     ] 2keep
+     [ touching-corners>> ] bi@
+     [ swap  [ = ] curry find  nip f = ] curry find nip
+     ] dip  over
+      [
+         call
+         dupd
+         point-inside-halfspace? [ vneg ] unless 
+         <face> 
+      ] [ 3drop f ] if 
+     ; inline
+ 
+ : intersection-into-face ( face-init face-adja -- face )
+     [ [ project-vector ] bi@ ]     (intersection-into-face) ;
+ 
+ : intersection-into-silhouette-face ( face-init face-adja -- face )
+     [ ] (intersection-into-face) ;
+ 
+ : intersections-into-faces ( face -- faces )
 -    clone dup  adjacent-faces>> [ intersection-into-face ] with map 
++    clone dup  
++    adjacent-faces>> [ intersection-into-face ] with map 
+     [ ] filter ;
+ 
+ : (face-silhouette) ( face -- faces )
+     clone dup adjacent-faces>>
+     [   backface?
+         [ intersection-into-silhouette-face ] [ 2drop f ]  if  
+     ] with map 
+     [ ] filter
+ ; inline
+ 
+ : face-silhouette ( face -- faces )     
+     backface? [ drop f ] [ (face-silhouette) ] if ;
+ 
+ ! --------------------------------
+ ! solid
 -! --------------------------------------------------------------
 -TUPLE: solid dimension silhouettes faces corners adjacencies-valid color name ;
++! -------------------------------------------------------------
++TUPLE: solid dimension silhouettes 
++    faces corners adjacencies-valid color name ;
+ 
+ : <solid> ( -- tuple ) solid new ;
+ 
+ : suffix-silhouettes ( solid silhouette -- solid )  
+     [ suffix ] curry change-silhouettes ;
+ 
 -: suffix-face ( solid face -- solid )     [ suffix ] curry change-faces ;
 -
 -: suffix-corner ( solid corner -- solid ) [ suffix ] curry change-corners ; 
 -
++: suffix-face ( solid face -- solid )     
++    [ suffix ] curry change-faces ;
++: suffix-corner ( solid corner -- solid ) 
++    [ suffix ] curry change-corners ; 
+ : erase-solid-corners ( solid -- solid )  f >>corners ;
+ 
 -: erase-silhouettes ( solid -- solid ) dup dimension>> f <array> >>silhouettes ;
 -
 -: filter-real-faces ( solid -- solid ) [ [ real-face? ] filter ] change-faces ;
 -
++: erase-silhouettes ( solid -- solid ) 
++    dup dimension>> f <array> >>silhouettes ;
++: filter-real-faces ( solid -- solid ) 
++    [ [ real-face? ] filter ] change-faces ;
+ : initiate-solid-from-face ( face -- solid ) 
+     face-project-dim  <solid> swap >>dimension ;
+ 
+ : erase-old-adjacencies ( solid -- solid )
+     erase-solid-corners
 -    [ dup [ erase-face-touching-corners erase-face-adjacent-faces drop ] each ]
++    [ dup [ erase-face-touching-corners 
++        erase-face-adjacent-faces drop ] each ]
+     change-faces ;
+ 
+ : point-inside-or-on-face? ( face v -- ? ) 
+     [ halfspace>> ] dip point-inside-or-on-halfspace?  ;
+ 
+ : point-inside-face? ( face v -- ? ) 
+     [ halfspace>> ] dip  point-inside-halfspace? ;
+ 
+ : point-inside-solid? ( solid point -- ? )
 -    [ faces>> ] dip [ point-inside-face? ] curry  all?   ; inline
++    [ faces>> ] dip [ point-inside-face? ] curry all? ; inline
+ 
+ : point-inside-or-on-solid? ( solid point -- ? )
 -    [ faces>> ] dip [ point-inside-or-on-face? ] curry  all?   ; inline
++    [ faces>> ] dip 
++    [ point-inside-or-on-face? ] curry  all?   ; inline
+ 
+ : unvalid-adjacencies ( solid -- solid )  
 -    erase-old-adjacencies f >>adjacencies-valid erase-silhouettes ;
++    erase-old-adjacencies f >>adjacencies-valid 
++    erase-silhouettes ;
+ 
+ : add-face ( solid face -- solid ) 
+     suffix-face unvalid-adjacencies ; 
+ 
+ : cut-solid ( solid halfspace -- solid )    <face> add-face ; 
+ 
+ : slice-solid ( solid face  -- solid1 solid2 )
+     [ [ clone ] bi@ flip-face add-face 
+     [ "/outer/" append ] change-name  ] 2keep
+     add-face [ "/inner/" append ] change-name ;
+ 
+ ! -------------
+ 
+ 
+ : add-silhouette ( solid  -- solid )
+    dup 
+    ! find-adjacencies 
+    faces>> { } 
+    [ face-silhouette append ] reduce
+    [ ] filter 
+    <solid> 
+         swap >>faces
+         over dimension>> >>dimension 
+         over name>> " silhouette " append 
+                  pv> number>string append 
+         >>name
+      !   ensure-adjacencies
+    suffix-silhouettes ; inline
+ 
+ : find-silhouettes ( solid -- solid )
+     { } >>silhouettes 
+     dup dimension>> [ [ add-silhouette ] with-pv ] each ;
+ 
+ : ensure-silhouettes ( solid  -- solid )
+     dup  silhouettes>>  [ f = ] all?
+     [ find-silhouettes  ]  when ; 
+ 
+ ! ------------
+ 
+ : corner-added? ( solid corner -- ? ) 
+     ! add corner to solid if it is inside solid
+     [ ] 
+     [ point-inside-or-on-solid? ] 
+     [ swap corners>> member? not ] 
+     2tri and
+     [ suffix-corner drop t ] [ 2drop f ] if ;
+ 
+ : process-corner ( solid faces corner -- )
+     swapd 
+     [ corner-added? ] keep swap ! test if corner is inside solid
+     [ update-adjacent-faces ] 
+     [ 2drop ]
+     if ;
+ 
+ : compute-intersection ( solid faces -- )
+     dup faces-intersection
+     dup f = [ 3drop ] [ process-corner ]  if ;
+ 
+ : test-faces-combinaisons ( solid n -- )
+     [ dup faces>> ] dip among   
+     [ compute-intersection ] with each ;
+ 
+ : compute-adjacencies ( solid -- solid )
+     dup dimension>> [ >= ] curry 
+     [ keep swap ] curry MAX-FACE-PER-CORNER swap
+     [ [ test-faces-combinaisons ] 2keep 1- ] [ ] while drop ;
+ 
+ : find-adjacencies ( solid -- solid ) 
+     erase-old-adjacencies   
+     compute-adjacencies
+     filter-real-faces 
+     t >>adjacencies-valid ;
+ 
+ : ensure-adjacencies ( solid -- solid ) 
+     dup adjacencies-valid>> 
+     [ find-adjacencies ] unless 
+     ensure-silhouettes
+     ;
+ 
 -: (non-empty-solid?) ( solid -- ? ) [ dimension>> ] [ corners>> length ] bi < ;
 -: non-empty-solid? ( solid -- ? )   ensure-adjacencies (non-empty-solid?) ;
++: (non-empty-solid?) ( solid -- ? ) 
++    [ dimension>> ] [ corners>> length ] bi < ;
++: non-empty-solid? ( solid -- ? )   
++    ensure-adjacencies (non-empty-solid?) ;
+ 
+ : compare-corners-roughly ( corner corner -- ? )
+     2drop t ;
+ ! : remove-inner-faces ( -- ) ;
+ : face-project ( array face -- seq )
+     backface? 
+   [ 2drop f ]
+     [   [ enlight-projection ] 
+         [ initiate-solid-from-face ]
+         [ intersections-into-faces ]  tri
+         >>faces
+         swap >>color        
+     ]    if ;
+ 
+ : solid-project ( lights ambient solid -- solids )
+   ensure-adjacencies
+     [ color>> ] [ faces>> ] bi [ 3array  ] dip
+     [ face-project ] with map 
+     [ ] filter 
+     [ ensure-adjacencies ] map
+ ;
+ 
+ : (solid-move) ( solid v move -- solid ) 
+    curry [ map ] curry 
+    [ dup faces>> ] dip call drop  
+    unvalid-adjacencies ; inline
+ 
 -: solid-translate ( solid v -- solid ) [ face-translate ] (solid-move) ; 
 -: solid-transform ( solid m -- solid ) [ face-transform ] (solid-move) ; 
++: solid-translate ( solid v -- solid ) 
++    [ face-translate ] (solid-move) ; 
++: solid-transform ( solid m -- solid ) 
++    [ face-transform ] (solid-move) ; 
+ 
+ : find-corner-in-silhouette ( s1 s2 -- elt bool )
+     pv> swap silhouettes>> nth     
+     swap corners>>
+     [ point-inside-solid? ] with find swap ;
+ 
+ : valid-face-for-order ( solid point -- face )
+     [ point-inside-face? not ] 
+     [ drop face-orientation  0 = not ] 2bi and ;
+ 
+ : check-orientation ( s1 s2 pt -- int )
+     [ nip faces>> ] dip
+     [ valid-face-for-order ] curry find swap
+     [ face-orientation ] [ drop f ] if ;
+ 
+ : (order-solid) ( s1 s2 -- int )
+     2dup find-corner-in-silhouette
+     [ check-orientation ] [ 3drop f ] if ;
+ 
+ : order-solid ( solid solid  -- i ) 
+     2dup (order-solid)
+     [ 2nip ]
+     [   swap (order-solid)
+         [ neg ] [ f ] if*
+     ] if* ;
+ 
+ : subtract ( solid1 solid2 -- solids )
+     faces>> swap clone ensure-adjacencies ensure-silhouettes  
+     [ swap slice-solid drop ]  curry map
+     [ non-empty-solid? ] filter
+     [ ensure-adjacencies ] map
+ ; inline
+ 
 -! --------------------------------------------------------------
++! -------------------------------------------------------------
+ ! space 
 -! --------------------------------------------------------------
++! -------------------------------------------------------------
+ TUPLE: space name dimension solids ambient-color lights ;
+ : <space> ( -- space )      space new ;
 -: suffix-solids ( space solid -- space ) [ suffix ] curry change-solids ; inline
 -: suffix-lights ( space light -- space ) [ suffix ] curry change-lights ; inline
++: suffix-solids ( space solid -- space ) 
++    [ suffix ] curry change-solids ; inline
++: suffix-lights ( space light -- space ) 
++    [ suffix ] curry change-lights ; inline
+ : clear-space-solids ( space -- space )     f >>solids ;
+ 
+ : space-ensure-solids ( space -- space ) 
+     [ [ ensure-adjacencies ] map ] change-solids ;
+ : eliminate-empty-solids ( space -- space ) 
+     [ [ non-empty-solid? ] filter ] change-solids ;
+ 
+ : projected-space ( space solids -- space ) 
 -   swap dimension>> 1-  <space>    swap >>dimension    swap  >>solids ;
++   swap dimension>> 1-  <space>    
++   swap >>dimension    swap  >>solids ;
+ 
 -: get-silhouette ( solid -- silhouette )    silhouettes>> pv> swap nth ;
 -: solid= ( solid solid -- ? )               [ corners>> ]  bi@ = ;
++: get-silhouette ( solid -- silhouette )    
++    silhouettes>> pv> swap nth ;
++: solid= ( solid solid -- ? )            [ corners>> ]  bi@ = ;
+ 
+ : space-apply ( space m quot -- space ) 
+         curry [ map ] curry [ dup solids>> ] dip
+         [ call ] [ drop ] recover drop ;
 -: space-transform ( space m -- space ) [ solid-transform ] space-apply ;
 -: space-translate ( space v -- space ) [ solid-translate ] space-apply ; 
++: space-transform ( space m -- space ) 
++    [ solid-transform ] space-apply ;
++: space-translate ( space v -- space ) 
++    [ solid-translate ] space-apply ; 
+ 
+ : describe-space ( space -- ) 
 -    solids>>  [  [ corners>>  [ pprint ] each ] [ name>> . ] bi ] each ;
++    solids>>  
++    [  [ corners>>  [ pprint ] each ] [ name>> . ] bi ] each ;
+ 
+ : clip-solid ( solid solid -- solids )
+     [ ]
+     [ solid= not ]
+     [ order-solid -1 = ] 2tri 
+     and
+     [ get-silhouette subtract ] 
+     [  drop 1array ] 
+     if 
+     
+     ;
+ 
+ : (solids-silhouette-subtract) ( solids solid -- solids ) 
+      [  clip-solid append ] curry { } -rot each ; inline
+ 
+ : solids-silhouette-subtract ( solids i solid -- solids )
+ ! solids is an array of 1 solid arrays
+       [ (solids-silhouette-subtract) ] curry map-but 
+ ; inline 
+ 
+ : remove-hidden-solids ( space -- space ) 
 -! We must include each solid in a sequence because during substration 
++! We must include each solid in a sequence because 
++! during substration 
+ ! a solid can be divided in more than on solid
+     [ 
+         [ [ 1array ] map ] 
+         [ length ] 
+         [ ] 
+         tri     
+         [ solids-silhouette-subtract ] 2each
+         { } [ append ] reduce 
+     ] change-solids
+     eliminate-empty-solids ! TODO include into change-solids
+ ;
+ 
+ : space-project ( space i -- space )
+   [
+   [ clone  
+     remove-hidden-solids? [ remove-hidden-solids ] when
+     dup 
+         [ solids>> ] 
+         [ lights>> ] 
+         [ ambient-color>> ]  tri 
+         [ rot solid-project ] 2curry 
+         map 
+         [ append ] { } -rot each 
+         ! TODO project lights
+         projected-space 
+       ! remove-inner-faces 
+       ! 
+       eliminate-empty-solids
+     ] with-pv 
+     ] [ 3drop <space> ] recover
+     ; inline
+ 
+ : middle-of-space ( space -- point )
+     solids>> [ corners>> ] map concat
+     [ [ ] [ v+ ] map-reduce ] [ length ] bi v/n
+ ;
+ 
 -! --------------------------------------------------------------
++! -------------------------------------------------------------
+ ! 3D rendering
 -! --------------------------------------------------------------
++! -------------------------------------------------------------
+ 
+ : face-reference ( face -- halfspace point vect )
+        [ halfspace>> ] 
+        [ touching-corners>> first ] 
+        [ touching-corners>> second ] tri 
+        over v-
+ ;
+ 
+ : theta ( v halfspace point vect -- v x )
+    [ [ over ] dip v- ] dip    
+    [ cross dup norm >float ]
+    [ v. >float ]  
+    2bi 
+    fatan2
+    -rot v. 
+    0 < [ neg ] when
+ ;
+ 
+ : ordered-face-points ( face -- corners )  
+     [ touching-corners>> 1 head ] 
+     [ touching-corners>> 1 tail ] 
+     [ face-reference [ theta ] 3curry ]         tri
+     { } map>assoc    sort-values keys 
+     append
+     ; inline
+ 
+ : point->GL  ( point -- )   gl-vertex ;
+ : points->GL ( array -- )   do-cycle [ point->GL ] each ;
+ 
+ : face->GL ( face color -- )
+    [ ordered-face-points ] dip
 -   [ first3 1.0 glColor4d GL_POLYGON [ [ point->GL  ] each ] do-state ] curry
 -   [  0 0 0 1 glColor4d GL_LINE_LOOP [ [ point->GL  ] each ] do-state ]
++   [ first3 1.0 glColor4d GL_POLYGON 
++        [ [ point->GL  ] each ] do-state ] curry
++   [  0 0 0 1 glColor4d GL_LINE_LOOP 
++        [ [ point->GL  ] each ] do-state ]
+    bi
+    ; inline
+ 
+ : solid->GL ( solid -- )    
+     [ faces>> ]    
+     [ color>> ] bi
+     [ face->GL ] curry each ; inline
+ 
+ : space->GL ( space -- )
+     solids>>
+     [ solid->GL ] each ;
+ 
+ 
+ 
+ 
+ 
diff --cc unmaintained/adsoda/combinators/combinators-docs.factor
index 0000000000,e6bb52ac24..0121dce32b
mode 000000,100755..100755
--- a/unmaintained/adsoda/combinators/combinators-docs.factor
+++ b/unmaintained/adsoda/combinators/combinators-docs.factor
@@@ -1,0 -1,39 +1,39 @@@
+ ! Copyright (C) 2008 Your name.
+ ! See http://factorcode.org/license.txt for BSD license.
+ USING: arrays help.markup help.syntax kernel sequences ;
+ IN: adsoda.combinators
+ 
+ HELP: among
+ { $values
 -     { "array" array } { "n" null }
++     { "array" array } { "n" "number of value to select" }
+      { "array" array }
+ }
+ { $description "returns an array containings every possibilities of n choices among a given sequence" } ;
+ 
+ HELP: columnize
+ { $values
+      { "array" array }
+      { "array" array }
+ }
+ { $description "flip a sequence into a sequence of 1 element sequences" } ;
+ 
+ HELP: concat-nth
+ { $values
+      { "seq1" sequence } { "seq2" sequence }
+      { "seq" sequence }
+ }
+ { $description "merges 2 sequences of sequences appending corresponding elements" } ;
+ 
+ HELP: do-cycle
+ { $values
+      { "array" array }
+      { "array" array }
+ }
+ { $description "Copy the first element at the end of the sequence in order to close the cycle." } ;
+ 
+ 
 -ARTICLE: "adsoda.combinators" "adsoda.combinators"
++ARTICLE: "adsoda.combinators" "Combinators"
+ { $vocab-link "adsoda.combinators" }
+ ;
+ 
+ ABOUT: "adsoda.combinators"
diff --cc unmaintained/adsoda/combinators/combinators.factor
index 0000000000,5838c30698..4e4bbff72d
mode 000000,100755..100755
--- a/unmaintained/adsoda/combinators/combinators.factor
+++ b/unmaintained/adsoda/combinators/combinators.factor
@@@ -1,0 -1,44 +1,45 @@@
+ ! Copyright (C) 2008 Jeff Bigot
+ ! See http://factorcode.org/license.txt for BSD license.
+ USING: kernel arrays sequences fry math combinators ;
+ 
+ IN: adsoda.combinators
+ 
 -! : (combinations) ( seq -- seq ) [ 1 tail ] dip combinations ; 
++! : (combinations) ( seq -- seq ) [ 1 tail ] dip combinations ;
+ 
+ ! : prefix-each [ prefix ] curry map ; inline
+ 
+ ! : combinations ( seq n -- seqs )
+ !    {
+ !        { [ dup 0 = ] [ 2drop { { } } ] }
+ !        { [ over empty? ] [ 2drop { } ] }
+ !        { [ t ] [ 
+ !            [ [ 1- (combinations) ] [ drop first ] 2bi prefix-each ]
+ !            [ (combinations) ] 2bi append
+ !        ] }
+ !    } cond ;
+ 
+ : columnize ( array -- array ) [ 1array ] map ; inline
+ 
+ : among ( array n -- array )
+     2dup swap length 
+     {
+         { [ over 1 = ] [ 3drop columnize ] }
+         { [ over 0 = ] [ 2drop 2drop { } ] }
+         { [ 2dup < ] [ 2drop [ 1 cut ] dip  
+                          [ 1- among [ append ] with map  ] 
+                          [ among append ] 2bi
+                        ] }
+         { [ 2dup = ] [ 3drop 1array ] }
+         { [ 2dup > ] [ 2drop 2drop {  } ] } 
+     } cond
+ ;
+ 
 -: concat-nth ( seq1 seq2 -- seq )  [ nth append ] curry map-index ;
++: concat-nth ( seq1 seq2 -- seq )  
++    [ nth append ] curry map-index ;
+ 
+ : do-cycle   ( array -- array )   dup first suffix ;
+ 
+ : map-but ( seq i quot -- seq )
+     ! quot : ( seq x -- seq )
+     '[ _ = [ @ ] unless ] map-index ; inline
+ 
diff --cc unmaintained/adsoda/tools/tools-docs.factor
index 0000000000,6fb617a0c4..1d952e329b
mode 000000,100755..100755
--- a/unmaintained/adsoda/tools/tools-docs.factor
+++ b/unmaintained/adsoda/tools/tools-docs.factor
@@@ -1,0 -1,76 +1,62 @@@
+ ! Copyright (C) 2008 Jeff Bigot.
+ ! See http://factorcode.org/license.txt for BSD license.
+ USING: arrays help.markup help.syntax kernel sequences ;
+ IN: adsoda.tools
+ 
+ HELP: 3cube
+ { $values 
+     { "array" "array" } { "name" "name" } 
+     { "solid" "solid" } 
+ }
+ { $description "array : xmin xmax ymin ymax zmin zmax" 
 -"\n returns a 3D solid with given limits"
++"returns a 3D solid with given limits"
+ } ;
+ 
+ HELP: 4cube
+ { $values 
+     { "array" "array" } { "name" "name" } 
+     { "solid" "solid" } 
+ }
+ { $description "array : xmin xmax ymin ymax zmin zmax wmin wmax"  
 -"\n returns a 4D solid with given limits"
++"returns a 4D solid with given limits"
+ } ;
+ 
+ 
 -HELP: coord-max
 -{ $values
 -     { "x" null } { "array" array }
 -     { "array" array }
 -}
 -{ $description "" } ;
 -
 -HELP: coord-min
 -{ $values
 -     { "x" null } { "array" array }
 -     { "array" array }
 -}
 -{ $description "" } ;
 -
+ HELP: equation-system-for-normal
+ { $values
+      { "points" "a list of n points" }
+      { "matrix" "matrix" }
+ }
+ { $description "From a list of points, return the matrix" 
+ "to solve in order to find the vector normal to the plan defined by the points" } 
+ ;
+ 
+ HELP: normal-vector
+ { $values
+      { "points" "a list of n points" }
+      { "v" "a vector" }
+ }
+ { $description "From a list of points, returns the vector normal to the plan defined by the points" 
 -"\nWith n points, creates n-1 vectors and then find a vector orthogonal to every others"
 -"\n returns { f } if a normal vector can not be found" } 
++"With n points, creates n-1 vectors and then find a vector orthogonal to every others"
++"returns { f } if a normal vector can not be found" } 
+ ;
+ 
+ HELP: points-to-hyperplane
+ { $values
+      { "points" "a list of n points" }
+      { "hyperplane" "an hyperplane equation" }
+ }
+ { $description "From a list of points, returns the equation of the hyperplan"
 -"\n Finds a normal vector and then translate it so that it includes one of the points"
++"Finds a normal vector and then translate it so that it includes one of the points"
+ 
+ } 
+ ;
+ 
 -ARTICLE: "adsoda.tools" "adsoda.tools"
++ARTICLE: "adsoda.tools" "Tools"
+ { $vocab-link "adsoda.tools" }
 -"\nTools to help in building an " { $vocab-link "adsoda" } "-space"
++"Tools to help in building an " { $vocab-link "adsoda" } "-space"
+ ;
+ 
+ ABOUT: "adsoda.tools"
+ 
+ 
diff --cc unmaintained/adsoda/tools/tools.factor
index 0000000000,efa3a55013..6c4f4c3029
mode 000000,100755..100755
--- a/unmaintained/adsoda/tools/tools.factor
+++ b/unmaintained/adsoda/tools/tools.factor
@@@ -1,0 -1,145 +1,150 @@@
+ ! Copyright (C) 2008 Jeff Bigot
+ ! See http://factorcode.org/license.txt for BSD license.
+ USING: 
+ kernel
+ sequences
+ math
+ accessors
+ adsoda
+ math.vectors 
+ math.matrices
+ bunny.model
+ io.encodings.ascii
+ io.files
+ sequences.deep
+ combinators
+ adsoda.combinators
+ fry
+ io.files.temp
+ grouping
+ ;
+ 
+ IN: adsoda.tools
+ 
+ 
+ 
+ 
+ 
+ ! ---------------------------------
+ : coord-min ( x array -- array )  swap suffix  ;
+ : coord-max ( x array -- array )  swap neg suffix ;
+ 
+ : 4cube ( array name -- solid )
+ ! array : xmin xmax ymin ymax zmin zmax wmin wmax
+     <solid> 
+     4 >>dimension
+     swap >>name
+     swap
+     { 
+        [ { 1 0 0 0 } coord-min ] [ { -1 0 0 0 } coord-max ] 
+        [ { 0 1 0 0 } coord-min ] [ { 0 -1 0 0 } coord-max ]
+        [ { 0 0 1 0 } coord-min ] [ { 0 0 -1 0 } coord-max ] 
+        [ { 0 0 0 1 } coord-min ] [ { 0 0 0 -1 } coord-max ]
+     }
+     [ curry call ] 2map 
+     [ cut-solid ] each 
+     ensure-adjacencies
+     
+ ; inline
+ 
+ : 3cube ( array name -- solid )
+ ! array : xmin xmax ymin ymax zmin zmax wmin wmax
+     <solid> 
+     3 >>dimension
+     swap >>name
+     swap
+     { 
+        [ { 1 0 0 } coord-min ] [ { -1 0 0 } coord-max ] 
+        [ { 0 1 0 } coord-min ] [ { 0 -1 0 } coord-max ]
+        [ { 0 0 1 } coord-min ] [ { 0 0 -1 } coord-max ] 
+     }
+     [ curry call ] 2map 
+     [ cut-solid ] each 
+     ensure-adjacencies
+     
+ ; inline
+ 
+ 
+ : equation-system-for-normal ( points -- matrix )
+     unclip [ v- 0 suffix ] curry map
+     dup first [ drop 1 ] map     suffix
+ ;
+ 
+ : normal-vector ( points -- v ) 
+     equation-system-for-normal
+     intersect-hyperplanes ;
+ 
+ : points-to-hyperplane ( points -- hyperplane )
+     [ normal-vector 0 suffix ] [ first ] bi
+     translate ;
+ 
+ : refs-to-points ( points faces -- faces )
 -   [ swap [ nth 10 v*n { 100 100 100 } v+ ] curry map    ] with map
++   [ swap [ nth 10 v*n { 100 100 100 } v+ ] curry map ] 
++   with map
+ ;
+ ! V{ { 0.1 0.2 } { 1.1 1.3 } } V{ { 1 0 } { 0 1 } }
+ ! V{ { { 1.1 1.3 } { 0.1 0.2 } } { { 0.1 0.2 } { 1.1 1.3 } } }
+ 
+ : ply-model-path ( -- path )
+ 
+ ! "bun_zipper.ply" 
+ "screw2.ply"
+ temp-file 
+ ;
+ 
+ : read-bunny-model ( -- v )
+ ply-model-path ascii [  parse-model ] with-file-reader
+ 
+ refs-to-points
+ ;
+ 
+ : 3points-to-normal ( seq -- v )
+     unclip [ v- ] curry map first2 cross normalize
+ ;
+ : 2-faces-to-prism ( seq seq -- seq )
+   2dup
 -    [ do-cycle 2 clump ] bi@ concat-nth  !  3 faces rectangulaires
++    [ do-cycle 2 clump ] bi@ concat-nth  
++    !  3 faces rectangulaires
+     swap prefix
+     swap prefix
+ ;    
+ 
+ : Xpoints-to-prisme ( seq height -- cube )
 -    ! from 3 points gives a list of faces representing a cube of height "height"
++    ! from 3 points gives a list of faces representing 
++    ! a cube of height "height"
+     ! and of based on the three points
+     ! a face is a group of 3 or mode points.   
+     [ dup dup  3points-to-normal ] dip 
+     v*n [ v+ ] curry map ! 2 eme face triangulaire 
+     2-faces-to-prism  
+ 
+ ! [ dup number? [ 1 + ] when ] deep-map
+ ! dup keep 
+ ;
+ 
+ 
+ : Xpoints-to-plane4D ( seq x y -- 4Dplane )
 -    ! from 3 points gives a list of faces representing a cube in 4th dim
++    ! from 3 points gives a list of faces representing 
++    ! a cube in 4th dim
+     ! from x to y (height = y-x)
+     ! and of based on the X points
+     ! a face is a group of 3 or mode points.   
+     '[ [ [ _ suffix ] map ] [ [ _ suffix ] map ] bi ] call
+     2-faces-to-prism
+ ;
+ 
+ : 3pointsfaces-to-3Dsolidfaces ( seq -- seq )
 -    [ 1 Xpoints-to-prisme [ 100 110 Xpoints-to-plane4D ] map concat ] map 
++    [ 1 Xpoints-to-prisme [ 100 
++        110 Xpoints-to-plane4D ] map concat ] map 
+ 
+ ;
+ 
+ : test-figure ( -- solid )
+     <solid> 
+     2 >>dimension
+     { 1 -1 -5 } cut-solid 
+     { -1 -1 -21 } cut-solid 
+     { -1 0 -12 } cut-solid 
+     { 1 2 16 } cut-solid
+ ;
+