doc correction
Jeff Bigot
parent
dbddd6ad0d
commit
4a31f6f0e6
|
|
@ -3,210 +3,62 @@
|
|||
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" } ;
|
||||
|
||||
|
|
@ -218,70 +70,23 @@ HELP: rotation-4D
|
|||
|
||||
HELP: translation-4D
|
||||
{ $values
|
||||
{ "v" null }
|
||||
{ "v" "vector" }
|
||||
}
|
||||
{ $description "" } ;
|
||||
{ $description "Apply a 4D translation" } ;
|
||||
|
||||
HELP: update-model-projections
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: update-observer-projections
|
||||
{ $description "" } ;
|
||||
ARTICLE: "implementation details" "How 4DNav is done"
|
||||
"4DNav is build using :"
|
||||
|
||||
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 }
|
||||
}
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: viewer-windows*
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: win3D
|
||||
{ $values
|
||||
{ "text" null } { "gadget" null }
|
||||
}
|
||||
{ $description "" } ;
|
||||
|
||||
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>"
|
||||
|
|
@ -336,10 +141,8 @@ $nl
|
|||
|
||||
|
||||
;
|
||||
|
||||
ARTICLE: "TODO" "Todo"
|
||||
{ $list
|
||||
"A file chooser"
|
||||
"A vocab to initialize parameters"
|
||||
"an editor mode"
|
||||
{ $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 } } "
|
||||
"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
|
||||
"Each visualization window represents the projection of the 4D space on a particular 3D space."
|
||||
|
||||
{ $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" }
|
||||
"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
|
||||
|
||||
|
||||
|
||||
"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" }
|
||||
|
||||
;
|
||||
|
||||
|
|
|
|||
|
|
@ -109,34 +109,36 @@ VAR: present-space
|
|||
[ 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
|
||||
|
|
@ -151,14 +153,16 @@ VAR: present-space
|
|||
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>
|
||||
|
|
@ -168,42 +172,55 @@ VAR: present-space
|
|||
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
|
||||
;
|
||||
|
||||
|
|
@ -211,9 +228,11 @@ VAR: present-space
|
|||
<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
|
||||
|
|
@ -221,26 +240,32 @@ VAR: present-space
|
|||
<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
|
||||
|
|
@ -267,7 +292,8 @@ VAR: present-space
|
|||
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 )
|
||||
|
|
@ -305,37 +331,38 @@ VAR: present-space
|
|||
|
||||
: 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
|
||||
;
|
||||
|
||||
|
|
@ -370,22 +397,23 @@ VAR: present-space
|
|||
[ [ 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 ] }
|
||||
|
|
@ -422,23 +450,26 @@ 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
|
||||
;
|
||||
|
||||
|
||||
|
|
@ -454,7 +485,8 @@ M: space adsoda-display-model
|
|||
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>
|
||||
|
|
|
|||
|
|
@ -6,31 +6,31 @@ 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:"
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
|
|
|||
|
|
@ -24,7 +24,7 @@ IN: 4DNav.deep
|
|||
! } }
|
||||
! ;
|
||||
|
||||
ARTICLE: "4DNav.deep" "4DNav.deep"
|
||||
ARTICLE: "4DNav.deep" "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
|
||||
|
||||
! USING: bake ;
|
||||
|
|
@ -7,5 +8,6 @@ IN: 4DNav.deep
|
|||
! [ [ 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
|
||||
|
||||
|
|
|
|||
|
|
@ -45,18 +45,26 @@ TUPLE: file-chooser < track
|
|||
[ 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 )
|
||||
|
|
@ -123,15 +131,19 @@ file-chooser H{
|
|||
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
|
||||
|
|
@ -140,5 +152,6 @@ file-chooser H{
|
|||
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 ;
|
||||
|
||||
|
|
|
|||
|
|
@ -3,28 +3,17 @@
|
|||
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" }
|
||||
;
|
||||
|
||||
|
|
|
|||
|
|
@ -1,26 +1,34 @@
|
|||
! 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
|
||||
;
|
||||
|
|
@ -28,7 +36,7 @@ TAG: solid adsoda-read-model
|
|||
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
|
||||
;
|
||||
|
|
@ -36,11 +44,14 @@ TAG: light adsoda-read-model
|
|||
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
|
||||
;
|
||||
|
||||
|
|
|
|||
|
|
@ -3,226 +3,8 @@
|
|||
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" }
|
||||
;
|
||||
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@ splitting grouping self math.trig
|
|||
sequences accessors 4DNav.deep models ;
|
||||
IN: 4DNav.turtle
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
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) ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
! These rotation matrices are from
|
||||
! `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 ;
|
||||
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: 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 ;
|
||||
|
|
@ -93,9 +93,9 @@ TUPLE: observer < turtle projection-mode collision-mode ;
|
|||
: roll-left ( angle -- ) neg rotate-z ;
|
||||
: roll-right ( angle -- ) rotate-z ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
! roll-until-horizontal
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: V ( -- V ) { 0 1 0 } ;
|
||||
|
||||
|
|
@ -111,25 +111,27 @@ TUPLE: observer < turtle projection-mode collision-mode ;
|
|||
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
|
||||
|
|
|
|||
|
|
@ -3,17 +3,9 @@
|
|||
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" }
|
||||
;
|
||||
|
||||
|
|
|
|||
|
|
@ -21,9 +21,9 @@ prettyprint
|
|||
|
||||
IN: 4DNav.window3D
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
! drawing functions
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
TUPLE: window3D < gadget observer ;
|
||||
|
||||
|
|
@ -63,7 +63,8 @@ M: window3D draw-gadget* ( gadget -- )
|
|||
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
|
||||
|
|
|
|||
|
|
@ -9,7 +9,7 @@ IN: adsoda
|
|||
! --------------------------------------------------------------
|
||||
! faces
|
||||
! --------------------------------------------------------------
|
||||
ARTICLE: "face-page" "face in ADSODA"
|
||||
ARTICLE: "face-page" "Face in ADSODA"
|
||||
"explanation of faces"
|
||||
$nl
|
||||
"link to functions"
|
||||
|
|
@ -65,7 +65,7 @@ HELP: face-transform
|
|||
! --------------------------------
|
||||
! solid
|
||||
! --------------------------------------------------------------
|
||||
ARTICLE: "solid-page" "solid in ADSODA"
|
||||
ARTICLE: "solid-page" "Solid in ADSODA"
|
||||
"explanation of solids"
|
||||
$nl
|
||||
"link to functions"
|
||||
|
|
@ -133,13 +133,13 @@ $nl
|
|||
|
||||
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"
|
||||
|
|
@ -211,7 +211,7 @@ HELP: space-project
|
|||
! --------------------------------------------------------------
|
||||
! 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"
|
||||
|
|
@ -223,21 +223,21 @@ $nl
|
|||
|
||||
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"
|
||||
|
|
@ -274,7 +274,6 @@ ARTICLE: { "adsoda" "light" } "ADSODA : lights"
|
|||
|
||||
|
||||
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"
|
||||
;
|
||||
|
||||
|
|
|
|||
|
|
@ -41,7 +41,7 @@ DEFER: combinations
|
|||
VAR: pv
|
||||
|
||||
|
||||
! ---------------------------------------------------------------------
|
||||
! -------------------------------------------------------------
|
||||
! global values
|
||||
VALUE: remove-hidden-solids?
|
||||
VALUE: VERY-SMALL-NUM
|
||||
|
|
@ -52,25 +52,26 @@ 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+ ;
|
||||
|
|
@ -78,7 +79,8 @@ TUPLE: light name { direction array } color ;
|
|||
: 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
|
||||
|
|
@ -97,8 +99,10 @@ TUPLE: light name { direction array } color ;
|
|||
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* ;
|
||||
|
||||
|
|
@ -117,29 +121,33 @@ TUPLE: light name { direction array } color ;
|
|||
[ 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?
|
||||
|
|
@ -203,7 +211,8 @@ TUPLE: face { halfspace array } touching-corners adjacent-faces ;
|
|||
[ ] (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 )
|
||||
|
|
@ -219,30 +228,32 @@ TUPLE: face { halfspace array } touching-corners adjacent-faces ;
|
|||
|
||||
! --------------------------------
|
||||
! 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 -- ? )
|
||||
|
|
@ -252,13 +263,15 @@ TUPLE: solid dimension silhouettes faces corners adjacencies-valid color name ;
|
|||
[ 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 ;
|
||||
|
|
@ -338,8 +351,10 @@ TUPLE: solid dimension silhouettes faces corners adjacencies-valid color name ;
|
|||
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 ;
|
||||
|
|
@ -367,8 +382,10 @@ TUPLE: solid dimension silhouettes faces corners adjacencies-valid color name ;
|
|||
[ 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
|
||||
|
|
@ -402,13 +419,15 @@ TUPLE: solid dimension silhouettes faces corners adjacencies-valid color name ;
|
|||
[ 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 )
|
||||
|
|
@ -417,19 +436,24 @@ TUPLE: space name dimension solids ambient-color lights ;
|
|||
[ [ 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 )
|
||||
[ ]
|
||||
|
|
@ -451,7 +475,8 @@ TUPLE: space name dimension solids ambient-color lights ;
|
|||
; 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 ]
|
||||
|
|
@ -489,9 +514,9 @@ TUPLE: space name dimension solids ambient-color lights ;
|
|||
[ [ ] [ v+ ] map-reduce ] [ length ] bi v/n
|
||||
;
|
||||
|
||||
! --------------------------------------------------------------
|
||||
! -------------------------------------------------------------
|
||||
! 3D rendering
|
||||
! --------------------------------------------------------------
|
||||
! -------------------------------------------------------------
|
||||
|
||||
: face-reference ( face -- halfspace point vect )
|
||||
[ halfspace>> ]
|
||||
|
|
@ -523,8 +548,10 @@ TUPLE: space name dimension solids ambient-color lights ;
|
|||
|
||||
: 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
|
||||
|
||||
|
|
|
|||
|
|
@ -5,7 +5,7 @@ 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" } ;
|
||||
|
|
@ -32,7 +32,7 @@ HELP: do-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" }
|
||||
;
|
||||
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@ 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
|
||||
|
||||
|
|
@ -34,7 +34,8 @@ IN: adsoda.combinators
|
|||
} 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 ;
|
||||
|
||||
|
|
|
|||
|
|
@ -9,7 +9,7 @@ HELP: 3cube
|
|||
{ "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
|
||||
|
|
@ -18,24 +18,10 @@ HELP: 4cube
|
|||
{ "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" }
|
||||
|
|
@ -51,8 +37,8 @@ HELP: normal-vector
|
|||
{ "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
|
||||
|
|
@ -61,14 +47,14 @@ HELP: points-to-hyperplane
|
|||
{ "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"
|
||||
|
|
|
|||
|
|
@ -79,7 +79,8 @@ IN: adsoda.tools
|
|||
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 } } }
|
||||
|
|
@ -102,13 +103,15 @@ refs-to-points
|
|||
;
|
||||
: 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
|
||||
|
|
@ -121,7 +124,8 @@ refs-to-points
|
|||
|
||||
|
||||
: 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.
|
||||
|
|
@ -130,7 +134,8 @@ refs-to-points
|
|||
;
|
||||
|
||||
: 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