doc correction
Jeff Bigot
parent
dbddd6ad0d
commit
4a31f6f0e6
|
|
@ -3,210 +3,62 @@
|
||||||
USING: help.markup help.syntax kernel quotations strings ;
|
USING: help.markup help.syntax kernel quotations strings ;
|
||||||
IN: 4DNav
|
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
|
HELP: menu-3D
|
||||||
{ $values
|
{ $values
|
||||||
{ "gadget" null }
|
{ "gadget" "gadget" }
|
||||||
}
|
}
|
||||||
{ $description "The menu dedicated to 3D movements of the camera" } ;
|
{ $description "The menu dedicated to 3D movements of the camera" } ;
|
||||||
|
|
||||||
HELP: menu-4D
|
HELP: menu-4D
|
||||||
{ $values
|
{ $values
|
||||||
|
|
||||||
{ "gadget" null }
|
{ "gadget" "gadget" }
|
||||||
}
|
}
|
||||||
{ $description "The menu dedicated to 4D movements of space" } ;
|
{ $description "The menu dedicated to 4D movements of space" } ;
|
||||||
|
|
||||||
HELP: menu-bar
|
HELP: menu-bar
|
||||||
{ $values
|
{ $values
|
||||||
|
|
||||||
{ "gadget" null }
|
{ "gadget" "gadget" }
|
||||||
}
|
}
|
||||||
{ $description "return gadget containing menu buttons" } ;
|
{ $description "return gadget containing menu buttons" } ;
|
||||||
|
|
||||||
HELP: model-projection
|
HELP: model-projection
|
||||||
{ $values
|
{ $values
|
||||||
{ "x" null }
|
{ "x" "interger" }
|
||||||
{ "space" null }
|
{ "space" "space" }
|
||||||
}
|
}
|
||||||
{ $description "Project space following coordinate x" } ;
|
{ $description "Project space following coordinate x" } ;
|
||||||
|
|
||||||
HELP: mvt-3D-1
|
HELP: mvt-3D-1
|
||||||
{ $values
|
{ $values
|
||||||
|
|
||||||
{ "quot" quotation }
|
{ "quot" "quotation" }
|
||||||
}
|
}
|
||||||
{ $description "return a quotation to orientate space to see it from first point of view" } ;
|
{ $description "return a quotation to orientate space to see it from first point of view" } ;
|
||||||
|
|
||||||
HELP: mvt-3D-2
|
HELP: mvt-3D-2
|
||||||
{ $values
|
{ $values
|
||||||
|
|
||||||
{ "quot" quotation }
|
{ "quot" "quotation" }
|
||||||
}
|
}
|
||||||
{ $description "return a quotation to orientate space to see it from second point of view" } ;
|
{ $description "return a quotation to orientate space to see it from second point of view" } ;
|
||||||
|
|
||||||
HELP: mvt-3D-3
|
HELP: mvt-3D-3
|
||||||
{ $values
|
{ $values
|
||||||
|
|
||||||
{ "quot" quotation }
|
{ "quot" "quotation" }
|
||||||
}
|
}
|
||||||
{ $description "return a quotation to orientate space to see it from third point of view" } ;
|
{ $description "return a quotation to orientate space to see it from third point of view" } ;
|
||||||
|
|
||||||
HELP: mvt-3D-4
|
HELP: mvt-3D-4
|
||||||
{ $values
|
{ $values
|
||||||
|
|
||||||
{ "quot" quotation }
|
{ "quot" "quotation" }
|
||||||
}
|
}
|
||||||
{ $description "return a quotation to orientate space to see it from first point of view" } ;
|
{ $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
|
HELP: load-model-file
|
||||||
{ $description "load space from file" } ;
|
{ $description "load space from file" } ;
|
||||||
|
|
||||||
|
|
@ -218,70 +70,23 @@ HELP: rotation-4D
|
||||||
|
|
||||||
HELP: translation-4D
|
HELP: translation-4D
|
||||||
{ $values
|
{ $values
|
||||||
{ "v" null }
|
{ "v" "vector" }
|
||||||
}
|
}
|
||||||
{ $description "" } ;
|
{ $description "Apply a 4D translation" } ;
|
||||||
|
|
||||||
HELP: update-model-projections
|
|
||||||
{ $description "" } ;
|
|
||||||
|
|
||||||
HELP: update-observer-projections
|
ARTICLE: "implementation details" "How 4DNav is done"
|
||||||
{ $description "" } ;
|
"4DNav is build using :"
|
||||||
|
|
||||||
HELP: view1
|
{ $subsection "4DNav.camera" }
|
||||||
{ $description "" } ;
|
{ $subsection "adsoda-main-page" }
|
||||||
|
;
|
||||||
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 }
|
|
||||||
}
|
|
||||||
{ $description "" } ;
|
|
||||||
|
|
||||||
HELP: viewer-windows*
|
|
||||||
{ $description "" } ;
|
|
||||||
|
|
||||||
HELP: win3D
|
|
||||||
{ $values
|
|
||||||
{ "text" null } { "gadget" null }
|
|
||||||
}
|
|
||||||
{ $description "" } ;
|
|
||||||
|
|
||||||
HELP: windows
|
|
||||||
{ $description "" } ;
|
|
||||||
|
|
||||||
ARTICLE: "Space file" "Create a new space file"
|
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
|
$nl
|
||||||
|
|
||||||
"\n<model>"
|
"\n<model>"
|
||||||
|
|
@ -336,10 +141,8 @@ $nl
|
||||||
|
|
||||||
|
|
||||||
;
|
;
|
||||||
|
|
||||||
ARTICLE: "TODO" "Todo"
|
ARTICLE: "TODO" "Todo"
|
||||||
{ $list
|
{ $list
|
||||||
"A file chooser"
|
|
||||||
"A vocab to initialize parameters"
|
"A vocab to initialize parameters"
|
||||||
"an editor mode"
|
"an editor mode"
|
||||||
{ $list "add a face to a solid"
|
{ $list "add a face to a solid"
|
||||||
|
|
@ -357,43 +160,41 @@ ARTICLE: "TODO" "Todo"
|
||||||
"add a tool wich give an hyperplane normal vector with enought points. Will use adsoda.intersect-hyperplanes with { { 0 } { 0 } { 1 } } "
|
"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"
|
"decorrelate 3D camera and activate them with select buttons"
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
} ;
|
} ;
|
||||||
|
|
||||||
|
|
||||||
ARTICLE: "4DNav" "4DNav"
|
ARTICLE: "4DNav" "The 4DNav app"
|
||||||
{ $vocab-link "4DNav" }
|
{ $vocab-link "4DNav" }
|
||||||
$nl
|
$nl
|
||||||
{ $heading "4D Navigator" }
|
{ $heading "4D Navigator" }
|
||||||
"4DNav is a simple tool to visualize 4 dimensionnal objects."
|
"4DNav is a simple tool to visualize 4 dimensionnal objects."
|
||||||
"\n"
|
"\n"
|
||||||
"It uses " { $vocab-link "adsoda" } " library to display a 4D space and navigate thru it."
|
"It uses " { $vocab-link "adsoda" } " library to display a 4D space and navigate thru it."
|
||||||
|
$nl
|
||||||
"It will display:"
|
"It will display:"
|
||||||
{ $list
|
{ $list
|
||||||
{ "a menu window" }
|
{ "a menu window" }
|
||||||
{ "4 visualization windows" }
|
{ "4 visualization windows" }
|
||||||
}
|
}
|
||||||
"Each window represents the projection of the 4D space on a particular 3D space."
|
"Each visualization window represents the projection of the 4D space on a particular 3D space."
|
||||||
$nl
|
|
||||||
|
{ $heading "Start" }
|
||||||
|
"type:" { $code "\"4DNav\" run" }
|
||||||
|
|
||||||
{ $heading "Initialization" }
|
|
||||||
"put the space file " { $strong "space-exemple.xml" } " in temp directory"
|
|
||||||
" and then type:" { $code "\"4DNav\" run" }
|
|
||||||
{ $heading "Navigation" }
|
{ $heading "Navigation" }
|
||||||
"4D submenu move the space in translations and rotation."
|
"Menu window is divided in 4 areas"
|
||||||
"\n3D submenu move the camera in 3D space. Cameras in every 3D spaces are manipulated as a single one"
|
{ $list
|
||||||
$nl
|
{ "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" }
|
{ $heading "Links" }
|
||||||
{ $subsection "Space file" }
|
{ $subsection "Space file" }
|
||||||
|
|
||||||
{ $subsection "TODO" }
|
{ $subsection "TODO" }
|
||||||
|
{ $subsection "implementation details" }
|
||||||
|
|
||||||
;
|
;
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -109,34 +109,36 @@ VAR: present-space
|
||||||
[ dup cos , 0.0 , dup sin neg , 0.0 ,
|
[ dup cos , 0.0 , dup sin neg , 0.0 ,
|
||||||
0.0 , 1.0 , 0.0 , 0.0 ,
|
0.0 , 1.0 , 0.0 , 0.0 ,
|
||||||
dup sin , 0.0 , dup cos , 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
|
: 4D-Rzw ( angle -- Rz ) deg>rad
|
||||||
[ dup cos , dup sin neg , 0.0 , 0.0 ,
|
[ dup cos , dup sin neg , 0.0 , 0.0 ,
|
||||||
dup sin , dup cos , 0.0 , 0.0 ,
|
dup sin , dup cos , 0.0 , 0.0 ,
|
||||||
0.0 , 0.0 , 1.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
|
! UI
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
: button* ( string quot -- button ) closed-quot <repeat-button> ;
|
: button* ( string quot -- button )
|
||||||
|
closed-quot <repeat-button> ;
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
!
|
!
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
: model-projection-chooser ( -- gadget )
|
: model-projection-chooser ( -- gadget )
|
||||||
observer3d> projection-mode>>
|
observer3d> projection-mode>>
|
||||||
{ { 1 "perspective" } { 0 "orthogonal" } } <toggle-buttons> ;
|
{ { 1 "perspective" } { 0 "orthogonal" } }
|
||||||
|
<toggle-buttons> ;
|
||||||
|
|
||||||
: collision-detection-chooser ( -- gadget )
|
: collision-detection-chooser ( -- gadget )
|
||||||
observer3d> collision-mode>>
|
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 ( -- )
|
: update-observer-projections ( -- )
|
||||||
view1> relayout-1
|
view1> relayout-1
|
||||||
|
|
@ -151,14 +153,16 @@ VAR: present-space
|
||||||
3 model-projection <model> view4> (>>model) ;
|
3 model-projection <model> view4> (>>model) ;
|
||||||
|
|
||||||
: camera-action ( quot -- quot )
|
: camera-action ( quot -- quot )
|
||||||
[ drop [ ] observer3d> with-self update-observer-projections ]
|
[ drop [ ] observer3d>
|
||||||
|
with-self update-observer-projections ]
|
||||||
make* closed-quot ;
|
make* closed-quot ;
|
||||||
|
|
||||||
: win3D ( text gadget -- ) "navigateur 4D : " rot append open-window ;
|
: win3D ( text gadget -- )
|
||||||
|
"navigateur 4D : " rot append open-window ;
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
! 4D object manipulation
|
! 4D object manipulation
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
: (mvt-4D) ( quot -- )
|
: (mvt-4D) ( quot -- )
|
||||||
present-space>
|
present-space>
|
||||||
|
|
@ -168,42 +172,55 @@ VAR: present-space
|
||||||
update-observer-projections ;
|
update-observer-projections ;
|
||||||
|
|
||||||
: rotation-4D ( m -- )
|
: 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
|
space-transform
|
||||||
swap space-translate
|
swap space-translate
|
||||||
] (mvt-4D) ;
|
] (mvt-4D) ;
|
||||||
|
|
||||||
: translation-4D ( v -- ) '[ _ space-translate ] (mvt-4D) ;
|
: translation-4D ( v -- ) '[ _ space-translate ] (mvt-4D) ;
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
! menu
|
! menu
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
: menu-rotations-4D ( -- gadget )
|
: menu-rotations-4D ( -- gadget )
|
||||||
<frame>
|
<frame>
|
||||||
<pile> 1 >>fill
|
<pile> 1 >>fill
|
||||||
"XY +" [ drop rotation-step 4D-Rxy rotation-4D ] button* add-gadget
|
"XY +" [ drop rotation-step 4D-Rxy rotation-4D ]
|
||||||
"XY -" [ drop rotation-step neg 4D-Rxy rotation-4D ] button* add-gadget
|
button* add-gadget
|
||||||
|
"XY -" [ drop rotation-step neg 4D-Rxy rotation-4D ]
|
||||||
|
button* add-gadget
|
||||||
@top-left grid-add
|
@top-left grid-add
|
||||||
<pile> 1 >>fill
|
<pile> 1 >>fill
|
||||||
"XZ +" [ drop rotation-step 4D-Rxz rotation-4D ] button* add-gadget
|
"XZ +" [ drop rotation-step 4D-Rxz rotation-4D ]
|
||||||
"XZ -" [ drop rotation-step neg 4D-Rxz rotation-4D ] button* add-gadget
|
button* add-gadget
|
||||||
|
"XZ -" [ drop rotation-step neg 4D-Rxz rotation-4D ]
|
||||||
|
button* add-gadget
|
||||||
@top grid-add
|
@top grid-add
|
||||||
<pile> 1 >>fill
|
<pile> 1 >>fill
|
||||||
"YZ +" [ drop rotation-step 4D-Ryz rotation-4D ] button* add-gadget
|
"YZ +" [ drop rotation-step 4D-Ryz rotation-4D ]
|
||||||
"YZ -" [ drop rotation-step neg 4D-Ryz rotation-4D ] button* add-gadget
|
button* add-gadget
|
||||||
|
"YZ -" [ drop rotation-step neg 4D-Ryz rotation-4D ]
|
||||||
|
button* add-gadget
|
||||||
@center grid-add
|
@center grid-add
|
||||||
<pile> 1 >>fill
|
<pile> 1 >>fill
|
||||||
"XW +" [ drop rotation-step 4D-Rxw rotation-4D ] button* add-gadget
|
"XW +" [ drop rotation-step 4D-Rxw rotation-4D ]
|
||||||
"XW -" [ drop rotation-step neg 4D-Rxw rotation-4D ] button* add-gadget
|
button* add-gadget
|
||||||
|
"XW -" [ drop rotation-step neg 4D-Rxw rotation-4D ]
|
||||||
|
button* add-gadget
|
||||||
@top-right grid-add
|
@top-right grid-add
|
||||||
<pile> 1 >>fill
|
<pile> 1 >>fill
|
||||||
"YW +" [ drop rotation-step 4D-Ryw rotation-4D ] button* add-gadget
|
"YW +" [ drop rotation-step 4D-Ryw rotation-4D ]
|
||||||
"YW -" [ drop rotation-step neg 4D-Ryw rotation-4D ] button* add-gadget
|
button* add-gadget
|
||||||
|
"YW -" [ drop rotation-step neg 4D-Ryw rotation-4D ]
|
||||||
|
button* add-gadget
|
||||||
@right grid-add
|
@right grid-add
|
||||||
<pile> 1 >>fill
|
<pile> 1 >>fill
|
||||||
"ZW +" [ drop rotation-step 4D-Rzw rotation-4D ] button* add-gadget
|
"ZW +" [ drop rotation-step 4D-Rzw rotation-4D ]
|
||||||
"ZW -" [ drop rotation-step neg 4D-Rzw rotation-4D ] button* add-gadget
|
button* add-gadget
|
||||||
|
"ZW -" [ drop rotation-step neg 4D-Rzw rotation-4D ]
|
||||||
|
button* add-gadget
|
||||||
@bottom-right grid-add
|
@bottom-right grid-add
|
||||||
;
|
;
|
||||||
|
|
||||||
|
|
@ -211,9 +228,11 @@ VAR: present-space
|
||||||
<frame>
|
<frame>
|
||||||
<pile> 1 >>fill
|
<pile> 1 >>fill
|
||||||
<shelf> 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
|
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
|
button* add-gadget
|
||||||
add-gadget
|
add-gadget
|
||||||
"YZW" <label> add-gadget
|
"YZW" <label> add-gadget
|
||||||
|
|
@ -221,26 +240,32 @@ VAR: present-space
|
||||||
<pile> 1 >>fill
|
<pile> 1 >>fill
|
||||||
"XZW" <label> add-gadget
|
"XZW" <label> add-gadget
|
||||||
<shelf> 1 >>fill
|
<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
|
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
|
button* add-gadget
|
||||||
add-gadget
|
add-gadget
|
||||||
@top-right grid-add
|
@top-right grid-add
|
||||||
<pile> 1 >>fill
|
<pile> 1 >>fill
|
||||||
"XYW" <label> add-gadget
|
"XYW" <label> add-gadget
|
||||||
<shelf> 1 >>fill
|
<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
|
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
|
button* add-gadget
|
||||||
add-gadget
|
add-gadget
|
||||||
@top-left grid-add
|
@top-left grid-add
|
||||||
<pile> 1 >>fill
|
<pile> 1 >>fill
|
||||||
<shelf> 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
|
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
|
button* add-gadget
|
||||||
add-gadget
|
add-gadget
|
||||||
"XYZ" <label> add-gadget
|
"XYZ" <label> add-gadget
|
||||||
|
|
@ -267,7 +292,8 @@ VAR: present-space
|
||||||
update-observer-projections ;
|
update-observer-projections ;
|
||||||
|
|
||||||
: load-model-file ( -- )
|
: 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 ;
|
redraw-model ;
|
||||||
|
|
||||||
: mvt-3D-X ( turn pitch -- quot )
|
: mvt-3D-X ( turn pitch -- quot )
|
||||||
|
|
@ -305,37 +331,38 @@ VAR: present-space
|
||||||
|
|
||||||
: menu-rotations-3D ( -- gadget )
|
: menu-rotations-3D ( -- gadget )
|
||||||
<frame>
|
<frame>
|
||||||
"Turn\n left" [ rotation-step turn-left ] camera-button
|
"Turn\n left" [ rotation-step turn-left ]
|
||||||
@left grid-add
|
camera-button @left grid-add
|
||||||
"Turn\n right" [ rotation-step turn-right ] camera-button
|
"Turn\n right" [ rotation-step turn-right ]
|
||||||
@right grid-add
|
camera-button @right grid-add
|
||||||
"Pitch down" [ rotation-step pitch-down ] camera-button
|
"Pitch down" [ rotation-step pitch-down ]
|
||||||
@bottom grid-add
|
camera-button @bottom grid-add
|
||||||
"Pitch up" [ rotation-step pitch-up ] camera-button
|
"Pitch up" [ rotation-step pitch-up ]
|
||||||
@top grid-add
|
camera-button @top grid-add
|
||||||
<shelf> 1 >>fill
|
<shelf> 1 >>fill
|
||||||
"Roll left\n (ctl)" [ rotation-step roll-left ] camera-button
|
"Roll left\n (ctl)" [ rotation-step roll-left ]
|
||||||
add-gadget
|
camera-button add-gadget
|
||||||
"Roll right\n(ctl)" [ rotation-step roll-right ] camera-button
|
"Roll right\n(ctl)" [ rotation-step roll-right ]
|
||||||
add-gadget
|
camera-button add-gadget
|
||||||
@center grid-add
|
@center grid-add
|
||||||
;
|
;
|
||||||
|
|
||||||
: menu-translations-3D ( -- gadget )
|
: menu-translations-3D ( -- gadget )
|
||||||
<frame>
|
<frame>
|
||||||
"left\n(alt)" [ translation-step strafe-left ] camera-button
|
"left\n(alt)" [ translation-step strafe-left ]
|
||||||
@left grid-add
|
camera-button @left grid-add
|
||||||
"right\n(alt)" [ translation-step strafe-right ] camera-button
|
"right\n(alt)" [ translation-step strafe-right ]
|
||||||
@right grid-add
|
camera-button @right grid-add
|
||||||
"Strafe up \n (alt)" [ translation-step strafe-up ] camera-button
|
"Strafe up \n (alt)" [ translation-step strafe-up ]
|
||||||
@top grid-add
|
camera-button @top grid-add
|
||||||
"Strafe down \n (alt)" [ translation-step strafe-down ] camera-button
|
"Strafe down\n (alt)" [ translation-step strafe-down ]
|
||||||
@bottom grid-add
|
camera-button @bottom grid-add
|
||||||
<pile> 1 >>fill
|
<pile> 1 >>fill
|
||||||
"Forward (ctl)" [ translation-step step-turtle ] camera-button
|
"Forward (ctl)" [ translation-step step-turtle ]
|
||||||
add-gadget
|
camera-button add-gadget
|
||||||
"Backward (ctl)" [ translation-step neg step-turtle ] camera-button
|
"Backward (ctl)"
|
||||||
add-gadget
|
[ translation-step neg step-turtle ]
|
||||||
|
camera-button add-gadget
|
||||||
@center grid-add
|
@center grid-add
|
||||||
;
|
;
|
||||||
|
|
||||||
|
|
@ -370,22 +397,23 @@ VAR: present-space
|
||||||
[ [ rotation-step pitch-up ] camera-action ] }
|
[ [ rotation-step pitch-up ] camera-action ] }
|
||||||
|
|
||||||
{ T{ key-down f { C+ } "UP" }
|
{ T{ key-down f { C+ } "UP" }
|
||||||
[ [ translation-step step-turtle ] camera-action ] }
|
[ [ translation-step step-turtle ] camera-action ] }
|
||||||
{ T{ key-down f { C+ } "DOWN" }
|
{ 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" }
|
{ T{ key-down f { C+ } "LEFT" }
|
||||||
[ [ rotation-step roll-left ] camera-action ] }
|
[ [ rotation-step roll-left ] camera-action ] }
|
||||||
{ T{ key-down f { C+ } "RIGHT" }
|
{ T{ key-down f { C+ } "RIGHT" }
|
||||||
[ [ rotation-step roll-right ] camera-action ] }
|
[ [ rotation-step roll-right ] camera-action ] }
|
||||||
|
|
||||||
{ T{ key-down f { A+ } "LEFT" }
|
{ T{ key-down f { A+ } "LEFT" }
|
||||||
[ [ translation-step strafe-left ] camera-action ] }
|
[ [ translation-step strafe-left ] camera-action ] }
|
||||||
{ T{ key-down f { A+ } "RIGHT" }
|
{ T{ key-down f { A+ } "RIGHT" }
|
||||||
[ [ translation-step strafe-right ] camera-action ] }
|
[ [ translation-step strafe-right ] camera-action ] }
|
||||||
{ T{ key-down f { A+ } "UP" }
|
{ T{ key-down f { A+ } "UP" }
|
||||||
[ [ translation-step strafe-up ] camera-action ] }
|
[ [ translation-step strafe-up ] camera-action ] }
|
||||||
{ T{ key-down f { A+ } "DOWN" }
|
{ 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 "1" } [ mvt-3D-1 camera-action ] }
|
||||||
|
|
@ -422,23 +450,26 @@ M: solid adsoda-display-model
|
||||||
[ name>> "solid called : " pprint . ]
|
[ name>> "solid called : " pprint . ]
|
||||||
[ color>> "color : " pprint . ]
|
[ color>> "color : " pprint . ]
|
||||||
[ dimension>> "dimension : " pprint . ]
|
[ dimension>> "dimension : " pprint . ]
|
||||||
[ faces>> "composed of faces : " pprint [ adsoda-display-model ] each ]
|
[ faces>> "composed of faces : " pprint
|
||||||
|
[ adsoda-display-model ] each ]
|
||||||
} cleave
|
} cleave
|
||||||
;
|
;
|
||||||
M: space adsoda-display-model
|
M: space adsoda-display-model
|
||||||
{
|
{
|
||||||
[ dimension>> "dimension : " pprint . ]
|
[ dimension>> "dimension : " pprint . ]
|
||||||
[ ambient-color>> "ambient-color : " pprint . ]
|
[ ambient-color>> "ambient-color : " pprint . ]
|
||||||
[ solids>> "composed of solids : " pprint [ adsoda-display-model ] each ]
|
[ solids>> "composed of solids : " pprint
|
||||||
[ lights>> "composed of lights : " pprint [ adsoda-display-model ] each ]
|
[ adsoda-display-model ] each ]
|
||||||
|
[ lights>> "composed of lights : " pprint
|
||||||
|
[ adsoda-display-model ] each ]
|
||||||
} cleave
|
} cleave
|
||||||
;
|
;
|
||||||
|
|
||||||
! ----------------------------------------------
|
! ----------------------------------------------
|
||||||
: menu-bar ( -- gadget )
|
: menu-bar ( -- gadget )
|
||||||
<shelf>
|
<shelf>
|
||||||
"reinit" [ drop load-model-file ] button* add-gadget
|
"reinit" [ drop load-model-file ] button* add-gadget
|
||||||
selected-file-model> <label-control> add-gadget
|
selected-file-model> <label-control> add-gadget
|
||||||
;
|
;
|
||||||
|
|
||||||
|
|
||||||
|
|
@ -454,7 +485,8 @@ M: space adsoda-display-model
|
||||||
model-projection-chooser add-gadget
|
model-projection-chooser add-gadget
|
||||||
f track-add
|
f track-add
|
||||||
<shelf>
|
<shelf>
|
||||||
"Collision detection (slow and buggy ) : " <label> add-gadget
|
"Collision detection (slow and buggy ) : "
|
||||||
|
<label> add-gadget
|
||||||
collision-detection-chooser add-gadget
|
collision-detection-chooser add-gadget
|
||||||
f track-add
|
f track-add
|
||||||
<pile>
|
<pile>
|
||||||
|
|
|
||||||
|
|
@ -6,31 +6,31 @@ IN: 4DNav.camera
|
||||||
HELP: camera-eye
|
HELP: camera-eye
|
||||||
{ $values
|
{ $values
|
||||||
|
|
||||||
{ "point" null }
|
{ "point" "position" }
|
||||||
}
|
}
|
||||||
{ $description "return the position of the camera" } ;
|
{ $description "return the position of the camera" } ;
|
||||||
|
|
||||||
HELP: camera-focus
|
HELP: camera-focus
|
||||||
{ $values
|
{ $values
|
||||||
|
|
||||||
{ "point" null }
|
{ "point" "position" }
|
||||||
}
|
}
|
||||||
{ $description "return the point the camera looks at" } ;
|
{ $description "return the point the camera looks at" } ;
|
||||||
|
|
||||||
HELP: camera-up
|
HELP: camera-up
|
||||||
{ $values
|
{ $values
|
||||||
|
|
||||||
{ "dirvec" null }
|
{ "dirvec" "upside direction" }
|
||||||
}
|
}
|
||||||
{ $description "In order to precise the roling position of camera give an upward vector" } ;
|
{ $description "In order to precise the roling position of camera give an upward vector" } ;
|
||||||
|
|
||||||
HELP: do-look-at
|
HELP: do-look-at
|
||||||
{ $values
|
{ $values
|
||||||
{ "camera" null }
|
{ "camera" "direction" }
|
||||||
}
|
}
|
||||||
{ $description "Word to use in replacement of gl-look-at when using a camera" } ;
|
{ $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" }
|
{ $vocab-link "4DNav.camera" }
|
||||||
"\n"
|
"\n"
|
||||||
"A camera is defined by:"
|
"A camera is defined by:"
|
||||||
|
|
|
||||||
|
|
@ -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
|
IN: 4DNav.camera
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
: camera-eye ( -- point ) turtle-pos> ;
|
: 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 )
|
: 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 -- )
|
: 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 ;
|
||||||
|
|
|
||||||
|
|
@ -24,7 +24,7 @@ IN: 4DNav.deep
|
||||||
! } }
|
! } }
|
||||||
! ;
|
! ;
|
||||||
|
|
||||||
ARTICLE: "4DNav.deep" "4DNav.deep"
|
ARTICLE: "4DNav.deep" "Deep"
|
||||||
{ $vocab-link "4DNav.deep" }
|
{ $vocab-link "4DNav.deep" }
|
||||||
;
|
;
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -1,4 +1,5 @@
|
||||||
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
|
IN: 4DNav.deep
|
||||||
|
|
||||||
! USING: bake ;
|
! USING: bake ;
|
||||||
|
|
@ -7,5 +8,6 @@ IN: 4DNav.deep
|
||||||
! [ [ dup quotation? [ drop , ] when ] deep-map ]
|
! [ [ dup quotation? [ drop , ] when ] deep-map ]
|
||||||
! bi '[ _ cleave _ bake ] ;
|
! bi '[ _ cleave _ bake ] ;
|
||||||
|
|
||||||
: make-matrix ( quot width -- matrix ) [ { } make ] dip group ; inline
|
: make-matrix ( quot width -- matrix )
|
||||||
|
[ { } make ] dip group ; inline
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -45,18 +45,26 @@ TUPLE: file-chooser < track
|
||||||
[ file-chooser? ] find-parent list>> ;
|
[ file-chooser? ] find-parent list>> ;
|
||||||
|
|
||||||
file-chooser H{
|
file-chooser H{
|
||||||
{ T{ key-down f f "UP" } [ find-file-list select-previous ] }
|
{ T{ key-down f f "UP" }
|
||||||
{ T{ key-down f f "DOWN" } [ find-file-list select-next ] }
|
[ find-file-list select-previous ] }
|
||||||
{ T{ key-down f f "PAGE_UP" } [ find-file-list list-page-up ] }
|
{ T{ key-down f f "DOWN" }
|
||||||
{ T{ key-down f f "PAGE_DOWN" } [ find-file-list list-page-down ] }
|
[ find-file-list select-next ] }
|
||||||
{ T{ key-down f f "RET" } [ find-file-list invoke-value-action ] }
|
{ T{ key-down f f "PAGE_UP" }
|
||||||
{ T{ button-down } request-focus }
|
[ find-file-list list-page-up ] }
|
||||||
{ T{ button-down f 1 } [ find-file-list invoke-value-action ] }
|
{ 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
|
} set-gestures
|
||||||
|
|
||||||
: list-of-files ( file-chooser -- seq )
|
: list-of-files ( file-chooser -- seq )
|
||||||
[ path>> value>> directory-entries ] [ extension>> ] bi
|
[ 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 )
|
: update-filelist-model ( file-chooser -- file-chooser )
|
||||||
|
|
@ -123,15 +131,19 @@ file-chooser H{
|
||||||
dup <file-list> >>list
|
dup <file-list> >>list
|
||||||
"choose a file in directory " <label> f track-add
|
"choose a file in directory " <label> f track-add
|
||||||
dup path>> <label-control> 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>
|
<shelf>
|
||||||
"selected file : " <label> add-gadget
|
"selected file : " <label> add-gadget
|
||||||
over selected-file>> <label-control> add-gadget
|
over selected-file>> <label-control> add-gadget
|
||||||
f track-add
|
f track-add
|
||||||
<shelf>
|
<shelf>
|
||||||
over [ swap fc-go-parent ] curry "go up" swap <bevel-button> add-gadget
|
over [ swap fc-go-parent ] curry "go up"
|
||||||
over [ swap fc-go-home ] curry "go home" swap <bevel-button> add-gadget
|
swap <bevel-button> add-gadget
|
||||||
! over [ swap fc-ok-action ] curry "OK" 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
|
! [ drop ] "Cancel" swap <bevel-button> add-gadget
|
||||||
f track-add
|
f track-add
|
||||||
dup list>> <scroller> 1 track-add
|
dup list>> <scroller> 1 track-add
|
||||||
|
|
@ -140,5 +152,6 @@ file-chooser H{
|
||||||
M: file-chooser pref-dim* drop { 400 200 } ;
|
M: file-chooser pref-dim* drop { 400 200 } ;
|
||||||
|
|
||||||
: file-chooser-window ( -- )
|
: file-chooser-window ( -- )
|
||||||
[ . ] home { "xml" "txt" } <file-chooser> "Choose a file" open-window ;
|
[ . ] home { "xml" "txt" } <file-chooser>
|
||||||
|
"Choose a file" open-window ;
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -3,28 +3,17 @@
|
||||||
USING: help.markup help.syntax kernel ;
|
USING: help.markup help.syntax kernel ;
|
||||||
IN: 4DNav.space-file-decoder
|
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
|
HELP: read-model-file
|
||||||
{ $values
|
{ $values
|
||||||
|
|
||||||
{ "path" "path to the file to read" }
|
{ "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" }
|
{ $vocab-link "4DNav.space-file-decoder" }
|
||||||
;
|
;
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -1,26 +1,34 @@
|
||||||
! Copyright (C) 2008 Jeff Bigot
|
! Copyright (C) 2008 Jeff Bigot
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: adsoda xml xml.utilities xml.dispatch accessors combinators
|
USING: adsoda xml xml.utilities xml.dispatch accessors
|
||||||
sequences math.parser kernel splitting values continuations ;
|
combinators sequences math.parser kernel splitting values
|
||||||
|
continuations ;
|
||||||
IN: 4DNav.space-file-decoder
|
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 -- )
|
PROCESS: adsoda-read-model ( tag -- )
|
||||||
|
|
||||||
TAG: dimension adsoda-read-model children>> first string>number ;
|
TAG: dimension adsoda-read-model
|
||||||
TAG: direction adsoda-read-model children>> first decode-number-array ;
|
children>> first string>number ;
|
||||||
TAG: color adsoda-read-model children>> first decode-number-array ;
|
TAG: direction adsoda-read-model
|
||||||
TAG: name adsoda-read-model children>> first ;
|
children>> first decode-number-array ;
|
||||||
TAG: face 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
|
TAG: solid adsoda-read-model
|
||||||
<solid> swap
|
<solid> swap
|
||||||
{
|
{
|
||||||
[ "dimension" tag-named adsoda-read-model >>dimension ]
|
[ "dimension" tag-named adsoda-read-model >>dimension ]
|
||||||
[ "name" tag-named adsoda-read-model >>name ]
|
[ "name" tag-named adsoda-read-model >>name ]
|
||||||
[ "color" tag-named adsoda-read-model >>color ]
|
[ "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
|
} cleave
|
||||||
ensure-adjacencies
|
ensure-adjacencies
|
||||||
;
|
;
|
||||||
|
|
@ -28,7 +36,7 @@ TAG: solid adsoda-read-model
|
||||||
TAG: light adsoda-read-model
|
TAG: light adsoda-read-model
|
||||||
<light> swap
|
<light> swap
|
||||||
{
|
{
|
||||||
[ "direction" tag-named adsoda-read-model >>direction ]
|
[ "direction" tag-named adsoda-read-model >>direction ]
|
||||||
[ "color" tag-named adsoda-read-model >>color ]
|
[ "color" tag-named adsoda-read-model >>color ]
|
||||||
} cleave
|
} cleave
|
||||||
;
|
;
|
||||||
|
|
@ -36,11 +44,14 @@ TAG: light adsoda-read-model
|
||||||
TAG: space adsoda-read-model
|
TAG: space adsoda-read-model
|
||||||
<space> swap
|
<space> swap
|
||||||
{
|
{
|
||||||
[ "dimension" tag-named adsoda-read-model >>dimension ]
|
[ "dimension" tag-named adsoda-read-model >>dimension ]
|
||||||
[ "name" tag-named adsoda-read-model >>name ]
|
[ "name" tag-named adsoda-read-model >>name ]
|
||||||
[ "color" tag-named adsoda-read-model >>ambient-color ]
|
[ "color" tag-named
|
||||||
[ "solid" tags-named [ adsoda-read-model suffix-solids ] each ]
|
adsoda-read-model >>ambient-color ]
|
||||||
[ "light" tags-named [ adsoda-read-model suffix-lights ] each ]
|
[ "solid" tags-named
|
||||||
|
[ adsoda-read-model suffix-solids ] each ]
|
||||||
|
[ "light" tags-named
|
||||||
|
[ adsoda-read-model suffix-lights ] each ]
|
||||||
} cleave
|
} cleave
|
||||||
;
|
;
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -3,226 +3,8 @@
|
||||||
USING: arrays help.markup help.syntax kernel sequences ;
|
USING: arrays help.markup help.syntax kernel sequences ;
|
||||||
IN: 4DNav.turtle
|
IN: 4DNav.turtle
|
||||||
|
|
||||||
HELP: <turtle>
|
|
||||||
{ $values
|
|
||||||
|
|
||||||
{ "turtle" null }
|
|
||||||
}
|
|
||||||
{ $description "" } ;
|
|
||||||
|
|
||||||
HELP: >turtle-ori
|
ARTICLE: "4DNav.turtle" "Turtle"
|
||||||
{ $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"
|
|
||||||
{ $vocab-link "4DNav.turtle" }
|
{ $vocab-link "4DNav.turtle" }
|
||||||
;
|
;
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -6,7 +6,7 @@ splitting grouping self math.trig
|
||||||
sequences accessors 4DNav.deep models ;
|
sequences accessors 4DNav.deep models ;
|
||||||
IN: 4DNav.turtle
|
IN: 4DNav.turtle
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
TUPLE: turtle pos ori ;
|
TUPLE: turtle pos ori ;
|
||||||
|
|
||||||
|
|
@ -32,7 +32,7 @@ TUPLE: observer < turtle projection-mode collision-mode ;
|
||||||
: turtle-ori> ( -- val ) self> ori>> ;
|
: turtle-ori> ( -- val ) self> ori>> ;
|
||||||
: >turtle-ori ( val -- ) self> (>>ori) ;
|
: >turtle-ori ( val -- ) self> (>>ori) ;
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
! These rotation matrices are from
|
! These rotation matrices are from
|
||||||
! `Computer Graphics: Principles and Practice'
|
! `Computer Graphics: Principles and Practice'
|
||||||
|
|
@ -74,15 +74,15 @@ TUPLE: observer < turtle projection-mode collision-mode ;
|
||||||
0 , dup sin , dup cos , ] 3 make-matrix nip ;
|
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-x ( angle -- ) Rx apply-rotation ;
|
||||||
: rotate-y ( angle -- ) Ry apply-rotation ;
|
: rotate-y ( angle -- ) Ry apply-rotation ;
|
||||||
: rotate-z ( angle -- ) Rz apply-rotation ;
|
: rotate-z ( angle -- ) Rz apply-rotation ;
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
: pitch-up ( angle -- ) neg rotate-x ;
|
: pitch-up ( angle -- ) neg rotate-x ;
|
||||||
: pitch-down ( angle -- ) rotate-x ;
|
: pitch-down ( angle -- ) rotate-x ;
|
||||||
|
|
@ -93,9 +93,9 @@ TUPLE: observer < turtle projection-mode collision-mode ;
|
||||||
: roll-left ( angle -- ) neg rotate-z ;
|
: roll-left ( angle -- ) neg rotate-z ;
|
||||||
: roll-right ( angle -- ) rotate-z ;
|
: roll-right ( angle -- ) rotate-z ;
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
! roll-until-horizontal
|
! roll-until-horizontal
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
: V ( -- V ) { 0 1 0 } ;
|
: V ( -- V ) { 0 1 0 } ;
|
||||||
|
|
||||||
|
|
@ -111,25 +111,27 @@ TUPLE: observer < turtle projection-mode collision-mode ;
|
||||||
V Z cross normalize set-X
|
V Z cross normalize set-X
|
||||||
Z X cross normalize set-Y ;
|
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 ;
|
: move-by ( point -- ) turtle-pos> v+ >turtle-pos ;
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
: reset-turtle ( -- )
|
: reset-turtle ( -- )
|
||||||
{ 0 0 0 } clone >turtle-pos 3 identity-matrix >turtle-ori ;
|
{ 0 0 0 } clone >turtle-pos 3 identity-matrix >turtle-ori ;
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
: step-vector ( length -- array ) { 0 0 1 } n*v ;
|
: step-vector ( length -- array ) { 0 0 1 } n*v ;
|
||||||
|
|
||||||
: step-turtle ( length -- )
|
: 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 -- )
|
: strafe-up ( length -- )
|
||||||
90 pitch-up
|
90 pitch-up
|
||||||
|
|
|
||||||
|
|
@ -3,17 +3,9 @@
|
||||||
USING: help.markup help.syntax kernel ;
|
USING: help.markup help.syntax kernel ;
|
||||||
IN: 4DNav.window3D
|
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" }
|
{ $vocab-link "4DNav.window3D" }
|
||||||
;
|
;
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -21,9 +21,9 @@ prettyprint
|
||||||
|
|
||||||
IN: 4DNav.window3D
|
IN: 4DNav.window3D
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
! drawing functions
|
! drawing functions
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
TUPLE: window3D < gadget observer ;
|
TUPLE: window3D < gadget observer ;
|
||||||
|
|
||||||
|
|
@ -63,7 +63,8 @@ M: window3D draw-gadget* ( gadget -- )
|
||||||
GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA glBlendFunc
|
GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA glBlendFunc
|
||||||
GL_LINE_SMOOTH_HINT GL_NICEST glHint
|
GL_LINE_SMOOTH_HINT GL_NICEST glHint
|
||||||
1.25 glLineWidth
|
1.25 glLineWidth
|
||||||
GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT bitor glClear
|
GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT bitor
|
||||||
|
glClear
|
||||||
glLoadIdentity
|
glLoadIdentity
|
||||||
GL_LIGHTING glEnable
|
GL_LIGHTING glEnable
|
||||||
GL_LIGHT0 glEnable
|
GL_LIGHT0 glEnable
|
||||||
|
|
|
||||||
|
|
@ -9,7 +9,7 @@ IN: adsoda
|
||||||
! --------------------------------------------------------------
|
! --------------------------------------------------------------
|
||||||
! faces
|
! faces
|
||||||
! --------------------------------------------------------------
|
! --------------------------------------------------------------
|
||||||
ARTICLE: "face-page" "face in ADSODA"
|
ARTICLE: "face-page" "Face in ADSODA"
|
||||||
"explanation of faces"
|
"explanation of faces"
|
||||||
$nl
|
$nl
|
||||||
"link to functions"
|
"link to functions"
|
||||||
|
|
@ -65,7 +65,7 @@ HELP: face-transform
|
||||||
! --------------------------------
|
! --------------------------------
|
||||||
! solid
|
! solid
|
||||||
! --------------------------------------------------------------
|
! --------------------------------------------------------------
|
||||||
ARTICLE: "solid-page" "solid in ADSODA"
|
ARTICLE: "solid-page" "Solid in ADSODA"
|
||||||
"explanation of solids"
|
"explanation of solids"
|
||||||
$nl
|
$nl
|
||||||
"link to functions"
|
"link to functions"
|
||||||
|
|
@ -133,13 +133,13 @@ $nl
|
||||||
|
|
||||||
HELP: subtract
|
HELP: subtract
|
||||||
{ $values { "solid1" "initial shape" } { "solid2" "shape to remove" } { "solids" "resulting shape" } }
|
{ $values { "solid1" "initial shape" } { "solid2" "shape to remove" } { "solids" "resulting shape" } }
|
||||||
{ $description " " } ;
|
{ $description "Substract solid2 from solid1" } ;
|
||||||
|
|
||||||
|
|
||||||
! --------------------------------------------------------------
|
! --------------------------------------------------------------
|
||||||
! space
|
! space
|
||||||
! --------------------------------------------------------------
|
! --------------------------------------------------------------
|
||||||
ARTICLE: "space-page" "space in ADSODA"
|
ARTICLE: "space-page" "Space in ADSODA"
|
||||||
"A space is a collection of solids and lights."
|
"A space is a collection of solids and lights."
|
||||||
$nl
|
$nl
|
||||||
"link to functions"
|
"link to functions"
|
||||||
|
|
@ -211,7 +211,7 @@ HELP: space-project
|
||||||
! --------------------------------------------------------------
|
! --------------------------------------------------------------
|
||||||
! 3D rendering
|
! 3D rendering
|
||||||
! --------------------------------------------------------------
|
! --------------------------------------------------------------
|
||||||
ARTICLE: "3D-rendering-page" "3D rendering in ADSODA"
|
ARTICLE: "3D-rendering-page" "The 3D rendering in ADSODA"
|
||||||
"explanation of 3D rendering"
|
"explanation of 3D rendering"
|
||||||
$nl
|
$nl
|
||||||
"link to functions"
|
"link to functions"
|
||||||
|
|
@ -223,21 +223,21 @@ $nl
|
||||||
|
|
||||||
HELP: face->GL
|
HELP: face->GL
|
||||||
{ $values { "face" "a face" } { "color" "3 3 values array" } }
|
{ $values { "face" "a face" } { "color" "3 3 values array" } }
|
||||||
{ $description "" } ;
|
{ $description "display a face" } ;
|
||||||
|
|
||||||
HELP: solid->GL
|
HELP: solid->GL
|
||||||
{ $values { "solid" "a solid" } }
|
{ $values { "solid" "a solid" } }
|
||||||
{ $description "" } ;
|
{ $description "display a solid" } ;
|
||||||
|
|
||||||
HELP: space->GL
|
HELP: space->GL
|
||||||
{ $values { "space" "a space" } }
|
{ $values { "space" "a space" } }
|
||||||
{ $description "" } ;
|
{ $description "display a space" } ;
|
||||||
|
|
||||||
! --------------------------------------------------------------
|
! --------------------------------------------------------------
|
||||||
! light
|
! light
|
||||||
! --------------------------------------------------------------
|
! --------------------------------------------------------------
|
||||||
|
|
||||||
ARTICLE: "light-page" "light in ADSODA"
|
ARTICLE: "light-page" "Light in ADSODA"
|
||||||
"explanation of light"
|
"explanation of light"
|
||||||
$nl
|
$nl
|
||||||
"link to functions"
|
"link to functions"
|
||||||
|
|
@ -274,7 +274,6 @@ ARTICLE: { "adsoda" "light" } "ADSODA : lights"
|
||||||
|
|
||||||
|
|
||||||
ARTICLE: { "adsoda" "halfspace" } "ADSODA : halfspace"
|
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"
|
" defined by the concatenation of the normal vector and a constant"
|
||||||
;
|
;
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -41,7 +41,7 @@ DEFER: combinations
|
||||||
VAR: pv
|
VAR: pv
|
||||||
|
|
||||||
|
|
||||||
! ---------------------------------------------------------------------
|
! -------------------------------------------------------------
|
||||||
! global values
|
! global values
|
||||||
VALUE: remove-hidden-solids?
|
VALUE: remove-hidden-solids?
|
||||||
VALUE: VERY-SMALL-NUM
|
VALUE: VERY-SMALL-NUM
|
||||||
|
|
@ -52,25 +52,26 @@ t to: remove-hidden-solids?
|
||||||
0.0000001 to: VERY-SMALL-NUM
|
0.0000001 to: VERY-SMALL-NUM
|
||||||
0.0000001 to: ZERO-VALUE
|
0.0000001 to: ZERO-VALUE
|
||||||
4 to: MAX-FACE-PER-CORNER
|
4 to: MAX-FACE-PER-CORNER
|
||||||
! ---------------------------------------------------------------------
|
! -------------------------------------------------------------
|
||||||
! sequence complement
|
! sequence complement
|
||||||
|
|
||||||
: with-pv ( i quot -- ) [ swap >pv call ] with-scope ; inline
|
: with-pv ( i quot -- ) [ swap >pv call ] with-scope ; inline
|
||||||
|
|
||||||
: dimension ( array -- x ) length 1- ; inline
|
: dimension ( array -- x ) length 1- ; inline
|
||||||
: last ( seq -- x ) [ dimension ] [ nth ] bi ; inline
|
: last ( seq -- x ) [ dimension ] [ nth ] bi ; inline
|
||||||
: change-last ( seq quot -- ) [ [ dimension ] keep ] dip change-nth ;
|
: change-last ( seq quot -- )
|
||||||
|
[ [ dimension ] keep ] dip change-nth ;
|
||||||
|
|
||||||
! --------------------------------------------------------------
|
! -------------------------------------------------------------
|
||||||
! light
|
! light
|
||||||
! --------------------------------------------------------------
|
! -------------------------------------------------------------
|
||||||
|
|
||||||
TUPLE: light name { direction array } color ;
|
TUPLE: light name { direction array } color ;
|
||||||
: <light> ( -- tuple ) light new ;
|
: <light> ( -- tuple ) light new ;
|
||||||
|
|
||||||
! -----------------------------------------------------------------------
|
! -------------------------------------------------------------
|
||||||
! halfspace manipulation
|
! halfspace manipulation
|
||||||
! -----------------------------------------------------------------------
|
! -------------------------------------------------------------
|
||||||
|
|
||||||
: constant+ ( v x -- w ) '[ [ _ + ] change-last ] keep ;
|
: constant+ ( v x -- w ) '[ [ _ + ] change-last ] keep ;
|
||||||
: translate ( u v -- w ) dupd v* sum constant+ ;
|
: translate ( u v -- w ) dupd v* sum constant+ ;
|
||||||
|
|
@ -78,7 +79,8 @@ TUPLE: light name { direction array } color ;
|
||||||
: transform ( u matrix -- w )
|
: transform ( u matrix -- w )
|
||||||
[ swap m.v ] 2keep ! compute new normal vector
|
[ 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
|
! be sure it's not null vector
|
||||||
last ! get constant
|
last ! get constant
|
||||||
swap /f neg swap ! intercept value
|
swap /f neg swap ! intercept value
|
||||||
|
|
@ -97,8 +99,10 @@ TUPLE: light name { direction array } color ;
|
||||||
position-point VERY-SMALL-NUM > ;
|
position-point VERY-SMALL-NUM > ;
|
||||||
: point-inside-or-on-halfspace? ( halfspace v -- ? )
|
: point-inside-or-on-halfspace? ( halfspace v -- ? )
|
||||||
position-point VERY-SMALL-NUM neg > ;
|
position-point VERY-SMALL-NUM neg > ;
|
||||||
: project-vector ( seq -- seq ) pv> [ head ] [ 1+ tail ] 2bi append ;
|
: project-vector ( seq -- seq )
|
||||||
: get-intersection ( matrice -- seq ) [ 1 tail* ] map flip first ;
|
pv> [ head ] [ 1+ tail ] 2bi append ;
|
||||||
|
: get-intersection ( matrice -- seq )
|
||||||
|
[ 1 tail* ] map flip first ;
|
||||||
|
|
||||||
: islenght=? ( seq n -- seq n ? ) 2dup [ length ] [ = ] bi* ;
|
: islenght=? ( seq n -- seq n ? ) 2dup [ length ] [ = ] bi* ;
|
||||||
|
|
||||||
|
|
@ -117,29 +121,33 @@ TUPLE: light name { direction array } color ;
|
||||||
[ solution dup ] [ first dimension ] bi
|
[ solution dup ] [ first dimension ] bi
|
||||||
valid-solution? [ get-intersection ] [ drop f ] if ;
|
valid-solution? [ get-intersection ] [ drop f ] if ;
|
||||||
|
|
||||||
! --------------------------------------------------------------
|
! -------------------------------------------------------------
|
||||||
! faces
|
! faces
|
||||||
! --------------------------------------------------------------
|
! -------------------------------------------------------------
|
||||||
|
|
||||||
TUPLE: face { halfspace array } touching-corners adjacent-faces ;
|
TUPLE: face { halfspace array }
|
||||||
|
touching-corners adjacent-faces ;
|
||||||
: <face> ( v -- tuple ) face new swap >>halfspace ;
|
: <face> ( v -- tuple ) face new swap >>halfspace ;
|
||||||
: flip-face ( face -- face ) [ vneg ] change-halfspace ;
|
: flip-face ( face -- face ) [ vneg ] change-halfspace ;
|
||||||
: erase-face-touching-corners ( face -- face ) f >>touching-corners ;
|
: erase-face-touching-corners ( face -- face )
|
||||||
: erase-face-adjacent-faces ( face -- face ) f >>adjacent-faces ;
|
f >>touching-corners ;
|
||||||
|
: erase-face-adjacent-faces ( face -- face )
|
||||||
|
f >>adjacent-faces ;
|
||||||
: faces-intersection ( faces -- v )
|
: faces-intersection ( faces -- v )
|
||||||
[ halfspace>> ] map intersect-hyperplanes ;
|
[ halfspace>> ] map intersect-hyperplanes ;
|
||||||
: face-translate ( face v -- face )
|
: face-translate ( face v -- face )
|
||||||
[ translate ] curry change-halfspace ; inline
|
[ translate ] curry change-halfspace ; inline
|
||||||
: face-transform ( face m -- face )
|
: face-transform ( face m -- face )
|
||||||
[ transform ] curry change-halfspace ; inline
|
[ 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 <= ;
|
: backface? ( face -- face ? ) dup face-orientation 0 <= ;
|
||||||
: pv-factor ( face -- f face )
|
: pv-factor ( face -- f face )
|
||||||
halfspace>> [ pv> swap nth [ * ] curry ] keep ; inline
|
halfspace>> [ pv> swap nth [ * ] curry ] keep ; inline
|
||||||
: suffix-touching-corner ( face corner -- face )
|
: suffix-touching-corner ( face corner -- face )
|
||||||
[ suffix ] curry change-touching-corners ; inline
|
[ suffix ] curry change-touching-corners ; inline
|
||||||
: real-face? ( face -- ? )
|
: real-face? ( face -- ? )
|
||||||
[ touching-corners>> length ] [ halfspace>> dimension ] bi >= ;
|
[ touching-corners>> length ]
|
||||||
|
[ halfspace>> dimension ] bi >= ;
|
||||||
|
|
||||||
: (add-to-adjacent-faces) ( face face -- face )
|
: (add-to-adjacent-faces) ( face face -- face )
|
||||||
over adjacent-faces>> 2dup member?
|
over adjacent-faces>> 2dup member?
|
||||||
|
|
@ -203,7 +211,8 @@ TUPLE: face { halfspace array } touching-corners adjacent-faces ;
|
||||||
[ ] (intersection-into-face) ;
|
[ ] (intersection-into-face) ;
|
||||||
|
|
||||||
: intersections-into-faces ( face -- faces )
|
: intersections-into-faces ( face -- faces )
|
||||||
clone dup adjacent-faces>> [ intersection-into-face ] with map
|
clone dup
|
||||||
|
adjacent-faces>> [ intersection-into-face ] with map
|
||||||
[ ] filter ;
|
[ ] filter ;
|
||||||
|
|
||||||
: (face-silhouette) ( face -- faces )
|
: (face-silhouette) ( face -- faces )
|
||||||
|
|
@ -219,30 +228,32 @@ TUPLE: face { halfspace array } touching-corners adjacent-faces ;
|
||||||
|
|
||||||
! --------------------------------
|
! --------------------------------
|
||||||
! solid
|
! 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 ;
|
: <solid> ( -- tuple ) solid new ;
|
||||||
|
|
||||||
: suffix-silhouettes ( solid silhouette -- solid )
|
: suffix-silhouettes ( solid silhouette -- solid )
|
||||||
[ suffix ] curry change-silhouettes ;
|
[ suffix ] curry change-silhouettes ;
|
||||||
|
|
||||||
: suffix-face ( solid face -- solid ) [ suffix ] curry change-faces ;
|
: suffix-face ( solid face -- solid )
|
||||||
|
[ suffix ] curry change-faces ;
|
||||||
: suffix-corner ( solid corner -- solid ) [ suffix ] curry change-corners ;
|
: suffix-corner ( solid corner -- solid )
|
||||||
|
[ suffix ] curry change-corners ;
|
||||||
: erase-solid-corners ( solid -- solid ) f >>corners ;
|
: erase-solid-corners ( solid -- solid ) f >>corners ;
|
||||||
|
|
||||||
: erase-silhouettes ( solid -- solid ) dup dimension>> f <array> >>silhouettes ;
|
: erase-silhouettes ( solid -- solid )
|
||||||
|
dup dimension>> f <array> >>silhouettes ;
|
||||||
: filter-real-faces ( solid -- solid ) [ [ real-face? ] filter ] change-faces ;
|
: filter-real-faces ( solid -- solid )
|
||||||
|
[ [ real-face? ] filter ] change-faces ;
|
||||||
: initiate-solid-from-face ( face -- solid )
|
: initiate-solid-from-face ( face -- solid )
|
||||||
face-project-dim <solid> swap >>dimension ;
|
face-project-dim <solid> swap >>dimension ;
|
||||||
|
|
||||||
: erase-old-adjacencies ( solid -- solid )
|
: erase-old-adjacencies ( solid -- solid )
|
||||||
erase-solid-corners
|
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 ;
|
change-faces ;
|
||||||
|
|
||||||
: point-inside-or-on-face? ( face v -- ? )
|
: point-inside-or-on-face? ( face v -- ? )
|
||||||
|
|
@ -252,13 +263,15 @@ TUPLE: solid dimension silhouettes faces corners adjacencies-valid color name ;
|
||||||
[ halfspace>> ] dip point-inside-halfspace? ;
|
[ halfspace>> ] dip point-inside-halfspace? ;
|
||||||
|
|
||||||
: point-inside-solid? ( solid point -- ? )
|
: 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 -- ? )
|
: 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 )
|
: 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 )
|
: add-face ( solid face -- solid )
|
||||||
suffix-face unvalid-adjacencies ;
|
suffix-face unvalid-adjacencies ;
|
||||||
|
|
@ -338,8 +351,10 @@ TUPLE: solid dimension silhouettes faces corners adjacencies-valid color name ;
|
||||||
ensure-silhouettes
|
ensure-silhouettes
|
||||||
;
|
;
|
||||||
|
|
||||||
: (non-empty-solid?) ( solid -- ? ) [ dimension>> ] [ corners>> length ] bi < ;
|
: (non-empty-solid?) ( solid -- ? )
|
||||||
: non-empty-solid? ( solid -- ? ) ensure-adjacencies (non-empty-solid?) ;
|
[ dimension>> ] [ corners>> length ] bi < ;
|
||||||
|
: non-empty-solid? ( solid -- ? )
|
||||||
|
ensure-adjacencies (non-empty-solid?) ;
|
||||||
|
|
||||||
: compare-corners-roughly ( corner corner -- ? )
|
: compare-corners-roughly ( corner corner -- ? )
|
||||||
2drop t ;
|
2drop t ;
|
||||||
|
|
@ -367,8 +382,10 @@ TUPLE: solid dimension silhouettes faces corners adjacencies-valid color name ;
|
||||||
[ dup faces>> ] dip call drop
|
[ dup faces>> ] dip call drop
|
||||||
unvalid-adjacencies ; inline
|
unvalid-adjacencies ; inline
|
||||||
|
|
||||||
: solid-translate ( solid v -- solid ) [ face-translate ] (solid-move) ;
|
: solid-translate ( solid v -- solid )
|
||||||
: solid-transform ( solid m -- solid ) [ face-transform ] (solid-move) ;
|
[ face-translate ] (solid-move) ;
|
||||||
|
: solid-transform ( solid m -- solid )
|
||||||
|
[ face-transform ] (solid-move) ;
|
||||||
|
|
||||||
: find-corner-in-silhouette ( s1 s2 -- elt bool )
|
: find-corner-in-silhouette ( s1 s2 -- elt bool )
|
||||||
pv> swap silhouettes>> nth
|
pv> swap silhouettes>> nth
|
||||||
|
|
@ -402,13 +419,15 @@ TUPLE: solid dimension silhouettes faces corners adjacencies-valid color name ;
|
||||||
[ ensure-adjacencies ] map
|
[ ensure-adjacencies ] map
|
||||||
; inline
|
; inline
|
||||||
|
|
||||||
! --------------------------------------------------------------
|
! -------------------------------------------------------------
|
||||||
! space
|
! space
|
||||||
! --------------------------------------------------------------
|
! -------------------------------------------------------------
|
||||||
TUPLE: space name dimension solids ambient-color lights ;
|
TUPLE: space name dimension solids ambient-color lights ;
|
||||||
: <space> ( -- space ) space new ;
|
: <space> ( -- space ) space new ;
|
||||||
: suffix-solids ( space solid -- space ) [ suffix ] curry change-solids ; inline
|
: suffix-solids ( space solid -- space )
|
||||||
: suffix-lights ( space light -- space ) [ suffix ] curry change-lights ; inline
|
[ suffix ] curry change-solids ; inline
|
||||||
|
: suffix-lights ( space light -- space )
|
||||||
|
[ suffix ] curry change-lights ; inline
|
||||||
: clear-space-solids ( space -- space ) f >>solids ;
|
: clear-space-solids ( space -- space ) f >>solids ;
|
||||||
|
|
||||||
: space-ensure-solids ( space -- space )
|
: space-ensure-solids ( space -- space )
|
||||||
|
|
@ -417,19 +436,24 @@ TUPLE: space name dimension solids ambient-color lights ;
|
||||||
[ [ non-empty-solid? ] filter ] change-solids ;
|
[ [ non-empty-solid? ] filter ] change-solids ;
|
||||||
|
|
||||||
: projected-space ( space solids -- space )
|
: 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 ;
|
: get-silhouette ( solid -- silhouette )
|
||||||
: solid= ( solid solid -- ? ) [ corners>> ] bi@ = ;
|
silhouettes>> pv> swap nth ;
|
||||||
|
: solid= ( solid solid -- ? ) [ corners>> ] bi@ = ;
|
||||||
|
|
||||||
: space-apply ( space m quot -- space )
|
: space-apply ( space m quot -- space )
|
||||||
curry [ map ] curry [ dup solids>> ] dip
|
curry [ map ] curry [ dup solids>> ] dip
|
||||||
[ call ] [ drop ] recover drop ;
|
[ call ] [ drop ] recover drop ;
|
||||||
: space-transform ( space m -- space ) [ solid-transform ] space-apply ;
|
: space-transform ( space m -- space )
|
||||||
: space-translate ( space v -- space ) [ solid-translate ] space-apply ;
|
[ solid-transform ] space-apply ;
|
||||||
|
: space-translate ( space v -- space )
|
||||||
|
[ solid-translate ] space-apply ;
|
||||||
|
|
||||||
: describe-space ( space -- )
|
: describe-space ( space -- )
|
||||||
solids>> [ [ corners>> [ pprint ] each ] [ name>> . ] bi ] each ;
|
solids>>
|
||||||
|
[ [ corners>> [ pprint ] each ] [ name>> . ] bi ] each ;
|
||||||
|
|
||||||
: clip-solid ( solid solid -- solids )
|
: clip-solid ( solid solid -- solids )
|
||||||
[ ]
|
[ ]
|
||||||
|
|
@ -451,7 +475,8 @@ TUPLE: space name dimension solids ambient-color lights ;
|
||||||
; inline
|
; inline
|
||||||
|
|
||||||
: remove-hidden-solids ( space -- space )
|
: 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
|
! a solid can be divided in more than on solid
|
||||||
[
|
[
|
||||||
[ [ 1array ] map ]
|
[ [ 1array ] map ]
|
||||||
|
|
@ -489,9 +514,9 @@ TUPLE: space name dimension solids ambient-color lights ;
|
||||||
[ [ ] [ v+ ] map-reduce ] [ length ] bi v/n
|
[ [ ] [ v+ ] map-reduce ] [ length ] bi v/n
|
||||||
;
|
;
|
||||||
|
|
||||||
! --------------------------------------------------------------
|
! -------------------------------------------------------------
|
||||||
! 3D rendering
|
! 3D rendering
|
||||||
! --------------------------------------------------------------
|
! -------------------------------------------------------------
|
||||||
|
|
||||||
: face-reference ( face -- halfspace point vect )
|
: face-reference ( face -- halfspace point vect )
|
||||||
[ halfspace>> ]
|
[ halfspace>> ]
|
||||||
|
|
@ -523,8 +548,10 @@ TUPLE: space name dimension solids ambient-color lights ;
|
||||||
|
|
||||||
: face->GL ( face color -- )
|
: face->GL ( face color -- )
|
||||||
[ ordered-face-points ] dip
|
[ ordered-face-points ] dip
|
||||||
[ first3 1.0 glColor4d GL_POLYGON [ [ point->GL ] each ] do-state ] curry
|
[ first3 1.0 glColor4d GL_POLYGON
|
||||||
[ 0 0 0 1 glColor4d GL_LINE_LOOP [ [ point->GL ] each ] do-state ]
|
[ [ point->GL ] each ] do-state ] curry
|
||||||
|
[ 0 0 0 1 glColor4d GL_LINE_LOOP
|
||||||
|
[ [ point->GL ] each ] do-state ]
|
||||||
bi
|
bi
|
||||||
; inline
|
; inline
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -5,7 +5,7 @@ IN: adsoda.combinators
|
||||||
|
|
||||||
HELP: among
|
HELP: among
|
||||||
{ $values
|
{ $values
|
||||||
{ "array" array } { "n" null }
|
{ "array" array } { "n" "number of value to select" }
|
||||||
{ "array" array }
|
{ "array" array }
|
||||||
}
|
}
|
||||||
{ $description "returns an array containings every possibilities of n choices among a given sequence" } ;
|
{ $description "returns an array containings every possibilities of n choices among a given sequence" } ;
|
||||||
|
|
@ -32,7 +32,7 @@ HELP: do-cycle
|
||||||
{ $description "Copy the first element at the end of the sequence in order to close the cycle." } ;
|
{ $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" }
|
{ $vocab-link "adsoda.combinators" }
|
||||||
;
|
;
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -4,7 +4,7 @@ USING: kernel arrays sequences fry math combinators ;
|
||||||
|
|
||||||
IN: adsoda.combinators
|
IN: adsoda.combinators
|
||||||
|
|
||||||
! : (combinations) ( seq -- seq ) [ 1 tail ] dip combinations ;
|
! : (combinations) ( seq -- seq ) [ 1 tail ] dip combinations ;
|
||||||
|
|
||||||
! : prefix-each [ prefix ] curry map ; inline
|
! : prefix-each [ prefix ] curry map ; inline
|
||||||
|
|
||||||
|
|
@ -34,7 +34,8 @@ IN: adsoda.combinators
|
||||||
} cond
|
} 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 ;
|
: do-cycle ( array -- array ) dup first suffix ;
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -9,7 +9,7 @@ HELP: 3cube
|
||||||
{ "solid" "solid" }
|
{ "solid" "solid" }
|
||||||
}
|
}
|
||||||
{ $description "array : xmin xmax ymin ymax zmin zmax"
|
{ $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
|
HELP: 4cube
|
||||||
|
|
@ -18,24 +18,10 @@ HELP: 4cube
|
||||||
{ "solid" "solid" }
|
{ "solid" "solid" }
|
||||||
}
|
}
|
||||||
{ $description "array : xmin xmax ymin ymax zmin zmax wmin wmax"
|
{ $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
|
HELP: equation-system-for-normal
|
||||||
{ $values
|
{ $values
|
||||||
{ "points" "a list of n points" }
|
{ "points" "a list of n points" }
|
||||||
|
|
@ -51,8 +37,8 @@ HELP: normal-vector
|
||||||
{ "v" "a vector" }
|
{ "v" "a vector" }
|
||||||
}
|
}
|
||||||
{ $description "From a list of points, returns the vector normal to the plan defined by the points"
|
{ $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"
|
"With 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" }
|
"returns { f } if a normal vector can not be found" }
|
||||||
;
|
;
|
||||||
|
|
||||||
HELP: points-to-hyperplane
|
HELP: points-to-hyperplane
|
||||||
|
|
@ -61,14 +47,14 @@ HELP: points-to-hyperplane
|
||||||
{ "hyperplane" "an hyperplane equation" }
|
{ "hyperplane" "an hyperplane equation" }
|
||||||
}
|
}
|
||||||
{ $description "From a list of points, returns the equation of the hyperplan"
|
{ $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" }
|
{ $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"
|
ABOUT: "adsoda.tools"
|
||||||
|
|
|
||||||
|
|
@ -79,7 +79,8 @@ IN: adsoda.tools
|
||||||
translate ;
|
translate ;
|
||||||
|
|
||||||
: refs-to-points ( points faces -- faces )
|
: 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{ { 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 } } }
|
! V{ { { 1.1 1.3 } { 0.1 0.2 } } { { 0.1 0.2 } { 1.1 1.3 } } }
|
||||||
|
|
@ -102,13 +103,15 @@ refs-to-points
|
||||||
;
|
;
|
||||||
: 2-faces-to-prism ( seq seq -- seq )
|
: 2-faces-to-prism ( seq seq -- seq )
|
||||||
2dup
|
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
|
||||||
swap prefix
|
swap prefix
|
||||||
;
|
;
|
||||||
|
|
||||||
: Xpoints-to-prisme ( seq height -- cube )
|
: 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
|
! and of based on the three points
|
||||||
! a face is a group of 3 or mode points.
|
! a face is a group of 3 or mode points.
|
||||||
[ dup dup 3points-to-normal ] dip
|
[ dup dup 3points-to-normal ] dip
|
||||||
|
|
@ -121,7 +124,8 @@ refs-to-points
|
||||||
|
|
||||||
|
|
||||||
: Xpoints-to-plane4D ( seq x y -- 4Dplane )
|
: 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)
|
! from x to y (height = y-x)
|
||||||
! and of based on the X points
|
! and of based on the X points
|
||||||
! a face is a group of 3 or mode points.
|
! a face is a group of 3 or mode points.
|
||||||
|
|
@ -130,7 +134,8 @@ refs-to-points
|
||||||
;
|
;
|
||||||
|
|
||||||
: 3pointsfaces-to-3Dsolidfaces ( seq -- seq )
|
: 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
|
||||||
|
|
||||||
;
|
;
|
||||||
|
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue