-! Copyright (C) 2008 Jeff Bigot\r
-! See http://factorcode.org/license.txt for BSD license.\r
-USING: \r
-kernel\r
-sequences\r
-math\r
-accessors\r
-adsoda\r
-math.vectors \r
-math.matrices\r
-bunny.model\r
-io.encodings.ascii\r
-io.files\r
-sequences.deep\r
-combinators\r
-adsoda.combinators\r
-fry\r
-io.files.temp\r
-grouping\r
-;\r
-\r
-IN: adsoda.tools\r
-\r
-\r
-\r
-\r
-\r
-! ---------------------------------\r
-: coord-min ( x array -- array ) swap suffix ;\r
-: coord-max ( x array -- array ) swap neg suffix ;\r
-\r
-: 4cube ( array name -- solid )\r
-! array : xmin xmax ymin ymax zmin zmax wmin wmax\r
- <solid> \r
- 4 >>dimension\r
- swap >>name\r
- swap\r
- { \r
- [ { 1 0 0 0 } coord-min ] [ { -1 0 0 0 } coord-max ] \r
- [ { 0 1 0 0 } coord-min ] [ { 0 -1 0 0 } coord-max ]\r
- [ { 0 0 1 0 } coord-min ] [ { 0 0 -1 0 } coord-max ] \r
- [ { 0 0 0 1 } coord-min ] [ { 0 0 0 -1 } coord-max ]\r
- }\r
- [ curry call ] 2map \r
- [ cut-solid ] each \r
- ensure-adjacencies\r
- \r
-; inline\r
-\r
-: 3cube ( array name -- solid )\r
-! array : xmin xmax ymin ymax zmin zmax wmin wmax\r
- <solid> \r
- 3 >>dimension\r
- swap >>name\r
- swap\r
- { \r
- [ { 1 0 0 } coord-min ] [ { -1 0 0 } coord-max ] \r
- [ { 0 1 0 } coord-min ] [ { 0 -1 0 } coord-max ]\r
- [ { 0 0 1 } coord-min ] [ { 0 0 -1 } coord-max ] \r
- }\r
- [ curry call ] 2map \r
- [ cut-solid ] each \r
- ensure-adjacencies\r
- \r
-; inline\r
-\r
-\r
-: equation-system-for-normal ( points -- matrix )\r
- unclip [ v- 0 suffix ] curry map\r
- dup first [ drop 1 ] map suffix\r
-;\r
-\r
-: normal-vector ( points -- v ) \r
- equation-system-for-normal\r
- intersect-hyperplanes ;\r
-\r
-: points-to-hyperplane ( points -- hyperplane )\r
- [ normal-vector 0 suffix ] [ first ] bi\r
- translate ;\r
-\r
-: refs-to-points ( points faces -- faces )\r
- [ swap [ nth 10 v*n { 100 100 100 } v+ ] curry map ] \r
- with map\r
-;\r
-! V{ { 0.1 0.2 } { 1.1 1.3 } } V{ { 1 0 } { 0 1 } }\r
-! V{ { { 1.1 1.3 } { 0.1 0.2 } } { { 0.1 0.2 } { 1.1 1.3 } } }\r
-\r
-: ply-model-path ( -- path )\r
-\r
-! "bun_zipper.ply" \r
-"screw2.ply"\r
-temp-file \r
-;\r
-\r
-: read-bunny-model ( -- v )\r
-ply-model-path ascii [ parse-model ] with-file-reader\r
-\r
-refs-to-points\r
-;\r
-\r
-: 3points-to-normal ( seq -- v )\r
- unclip [ v- ] curry map first2 cross normalize\r
-;\r
-: 2-faces-to-prism ( seq seq -- seq )\r
- 2dup\r
- [ do-cycle 2 clump ] bi@ concat-nth \r
- ! 3 faces rectangulaires\r
- swap prefix\r
- swap prefix\r
-; \r
-\r
-: Xpoints-to-prisme ( seq height -- cube )\r
- ! from 3 points gives a list of faces representing \r
- ! a cube of height "height"\r
- ! and of based on the three points\r
- ! a face is a group of 3 or mode points. \r
- [ dup dup 3points-to-normal ] dip \r
- v*n [ v+ ] curry map ! 2 eme face triangulaire \r
- 2-faces-to-prism \r
-\r
-! [ dup number? [ 1 + ] when ] deep-map\r
-! dup keep \r
-;\r
-\r
-\r
-: Xpoints-to-plane4D ( seq x y -- 4Dplane )\r
- ! from 3 points gives a list of faces representing \r
- ! a cube in 4th dim\r
- ! from x to y (height = y-x)\r
- ! and of based on the X points\r
- ! a face is a group of 3 or mode points. \r
- '[ [ [ _ suffix ] map ] [ [ _ suffix ] map ] bi ] call\r
- 2-faces-to-prism\r
-;\r
-\r
-: 3pointsfaces-to-3Dsolidfaces ( seq -- seq )\r
- [ 1 Xpoints-to-prisme [ 100 \r
- 110 Xpoints-to-plane4D ] map concat ] map \r
-\r
-;\r
-\r
-: test-figure ( -- solid )\r
- <solid> \r
- 2 >>dimension\r
- { 1 -1 -5 } cut-solid \r
- { -1 -1 -21 } cut-solid \r
- { -1 0 -12 } cut-solid \r
- { 1 2 16 } cut-solid\r
-;\r
-\r
+! Copyright (C) 2008 Jeff Bigot
+! See http://factorcode.org/license.txt for BSD license.
+USING:
+kernel
+sequences
+math
+accessors
+adsoda
+math.vectors
+math.matrices
+bunny.model
+io.encodings.ascii
+io.files
+sequences.deep
+combinators
+adsoda.combinators
+fry
+io.files.temp
+grouping
+;
+
+IN: adsoda.tools
+
+
+
+
+
+! ---------------------------------
+: coord-min ( x array -- array ) swap suffix ;
+: coord-max ( x array -- array ) swap neg suffix ;
+
+: 4cube ( array name -- solid )
+! array : xmin xmax ymin ymax zmin zmax wmin wmax
+ <solid>
+ 4 >>dimension
+ swap >>name
+ swap
+ {
+ [ { 1 0 0 0 } coord-min ] [ { -1 0 0 0 } coord-max ]
+ [ { 0 1 0 0 } coord-min ] [ { 0 -1 0 0 } coord-max ]
+ [ { 0 0 1 0 } coord-min ] [ { 0 0 -1 0 } coord-max ]
+ [ { 0 0 0 1 } coord-min ] [ { 0 0 0 -1 } coord-max ]
+ }
+ [ curry call ] 2map
+ [ cut-solid ] each
+ ensure-adjacencies
+
+; inline
+
+: 3cube ( array name -- solid )
+! array : xmin xmax ymin ymax zmin zmax wmin wmax
+ <solid>
+ 3 >>dimension
+ swap >>name
+ swap
+ {
+ [ { 1 0 0 } coord-min ] [ { -1 0 0 } coord-max ]
+ [ { 0 1 0 } coord-min ] [ { 0 -1 0 } coord-max ]
+ [ { 0 0 1 } coord-min ] [ { 0 0 -1 } coord-max ]
+ }
+ [ curry call ] 2map
+ [ cut-solid ] each
+ ensure-adjacencies
+
+; inline
+
+
+: equation-system-for-normal ( points -- matrix )
+ unclip [ v- 0 suffix ] curry map
+ dup first [ drop 1 ] map suffix
+;
+
+: normal-vector ( points -- v )
+ equation-system-for-normal
+ intersect-hyperplanes ;
+
+: points-to-hyperplane ( points -- hyperplane )
+ [ normal-vector 0 suffix ] [ first ] bi
+ translate ;
+
+: refs-to-points ( points faces -- faces )
+ [ swap [ nth 10 v*n { 100 100 100 } v+ ] curry map ]
+ with map
+;
+! V{ { 0.1 0.2 } { 1.1 1.3 } } V{ { 1 0 } { 0 1 } }
+! V{ { { 1.1 1.3 } { 0.1 0.2 } } { { 0.1 0.2 } { 1.1 1.3 } } }
+
+: ply-model-path ( -- path )
+
+! "bun_zipper.ply"
+"screw2.ply"
+temp-file
+;
+
+: read-bunny-model ( -- v )
+ply-model-path ascii [ parse-model ] with-file-reader
+
+refs-to-points
+;
+
+: 3points-to-normal ( seq -- v )
+ unclip [ v- ] curry map first2 cross normalize
+;
+: 2-faces-to-prism ( seq seq -- seq )
+ 2dup
+ [ do-cycle 2 clump ] bi@ concat-nth
+ ! 3 faces rectangulaires
+ swap prefix
+ swap prefix
+;
+
+: Xpoints-to-prisme ( seq height -- cube )
+ ! from 3 points gives a list of faces representing
+ ! a cube of height "height"
+ ! and of based on the three points
+ ! a face is a group of 3 or mode points.
+ [ dup dup 3points-to-normal ] dip
+ v*n [ v+ ] curry map ! 2 eme face triangulaire
+ 2-faces-to-prism
+
+! [ dup number? [ 1 + ] when ] deep-map
+! dup keep
+;
+
+
+: Xpoints-to-plane4D ( seq x y -- 4Dplane )
+ ! from 3 points gives a list of faces representing
+ ! a cube in 4th dim
+ ! from x to y (height = y-x)
+ ! and of based on the X points
+ ! a face is a group of 3 or mode points.
+ '[ [ [ _ suffix ] map ] [ [ _ suffix ] map ] bi ] call
+ 2-faces-to-prism
+;
+
+: 3pointsfaces-to-3Dsolidfaces ( seq -- seq )
+ [ 1 Xpoints-to-prisme [ 100
+ 110 Xpoints-to-plane4D ] map concat ] map
+
+;
+
+: test-figure ( -- solid )
+ <solid>
+ 2 >>dimension
+ { 1 -1 -5 } cut-solid
+ { -1 -1 -21 } cut-solid
+ { -1 0 -12 } cut-solid
+ { 1 2 16 } cut-solid
+;
+
projects / factor.git / blobdiff