]> gitweb.factorcode.org Git - factor.git/blobdiff - extra/euler/modeling/modeling.factor
core, basis, extra: Remove DOS line endings from files.
[factor.git] / extra / euler / modeling / modeling.factor
index 7b4dfa21e07a07ea1168c1b5fdd6b926f4ba1e1f..21c69742831351ca3f3b2ed6c02a9392d9dfd127 100644 (file)
@@ -1,78 +1,78 @@
-! Copyright (C) 2010 Slava Pestov.\r
-USING: accessors combinators fry kernel locals math.vectors\r
-namespaces sets sequences game.models.half-edge euler.b-rep\r
-euler.operators math ;\r
-IN: euler.modeling\r
-\r
-: (polygon>double-face) ( polygon -- edge )\r
-    [ first2 make-vefs ] keep\r
-    [ drop opposite-edge>> ] [ 2 tail-slice [ make-ev-one ] each ] 2bi\r
-    make-ef face-ccw ;\r
-\r
-SYMBOLS: smooth-smooth\r
-sharp-smooth\r
-smooth-sharp\r
-sharp-sharp\r
-smooth-like-vertex\r
-sharp-like-vertex\r
-smooth-continue\r
-sharp-continue ;\r
-\r
-: polygon>double-face ( polygon mode -- edge )\r
-    ! This only handles the simple case with no repeating vertices\r
-    drop\r
-    dup all-unique? [ "polygon>double-face doesn't support repeating vertices yet" throw ] unless\r
-    (polygon>double-face) ;\r
-\r
-:: extrude-simple ( edge dist sharp? -- edge )\r
-    edge face-normal dist v*n :> vec\r
-    edge vertex-pos vec v+ :> pos\r
-    edge pos make-ev-one :> e0!\r
-    e0 opposite-edge>> :> e-end\r
-    edge face-ccw :> edge!\r
-\r
-    [ edge e-end eq? not ] [\r
-        edge vertex-pos vec v+ :> pos\r
-        edge pos make-ev-one :> e1\r
-        e0 e1 make-ef drop\r
-        e1 e0!\r
-        edge face-ccw edge!\r
-    ] do while\r
-    \r
-    e-end face-ccw :> e-end\r
-    e0 e-end make-ef drop\r
-\r
-    e-end ;\r
-\r
-: check-bridge-rings ( e1 e2 -- )\r
-    {\r
-        [ [ face>> assert-no-rings ] bi@ ]\r
-        [ [ face>> assert-base-face ] bi@ ]\r
-        [ assert-different-faces ]\r
-        [ [ face-sides ] bi@ assert= ]\r
-    } 2cleave ;\r
-\r
-:: bridge-rings-simple ( e1 e2 sharp? -- edge )\r
-    e1 e2 check-bridge-rings\r
-    e1 e2 kill-f-make-rh\r
-    e1 e2 make-e-kill-r face-cw :> ea!\r
-    e2 face-ccw :> eb!\r
-    [ ea e1 eq? not ] [\r
-        ea eb make-ef opposite-edge>> face-cw ea!\r
-        eb face-ccw eb!\r
-    ] while\r
-    eb ;\r
-\r
-:: project-pt-line ( p p0 p1 -- q )\r
-    p1 p0 v- :> vt\r
-    p p0 v- vt v* sum\r
-    vt norm-sq /\r
-    vt n*v p0 v+ ; inline\r
-\r
-:: project-pt-plane ( line-p0 line-vt plane-n plane-d -- q )\r
-    plane-d neg plane-n line-p0 v. -\r
-    line-vt plane-n v. /\r
-    line-vt n*v line-p0 v+ ; inline\r
-\r
-: project-poly-plane ( poly vdir plane-n plane-d -- qoly )\r
-    '[ _ _ _ project-pt-plane ] map ; inline\r
+! Copyright (C) 2010 Slava Pestov.
+USING: accessors combinators fry kernel locals math.vectors
+namespaces sets sequences game.models.half-edge euler.b-rep
+euler.operators math ;
+IN: euler.modeling
+
+: (polygon>double-face) ( polygon -- edge )
+    [ first2 make-vefs ] keep
+    [ drop opposite-edge>> ] [ 2 tail-slice [ make-ev-one ] each ] 2bi
+    make-ef face-ccw ;
+
+SYMBOLS: smooth-smooth
+sharp-smooth
+smooth-sharp
+sharp-sharp
+smooth-like-vertex
+sharp-like-vertex
+smooth-continue
+sharp-continue ;
+
+: polygon>double-face ( polygon mode -- edge )
+    ! This only handles the simple case with no repeating vertices
+    drop
+    dup all-unique? [ "polygon>double-face doesn't support repeating vertices yet" throw ] unless
+    (polygon>double-face) ;
+
+:: extrude-simple ( edge dist sharp? -- edge )
+    edge face-normal dist v*n :> vec
+    edge vertex-pos vec v+ :> pos
+    edge pos make-ev-one :> e0!
+    e0 opposite-edge>> :> e-end
+    edge face-ccw :> edge!
+
+    [ edge e-end eq? not ] [
+        edge vertex-pos vec v+ :> pos
+        edge pos make-ev-one :> e1
+        e0 e1 make-ef drop
+        e1 e0!
+        edge face-ccw edge!
+    ] do while
+
+    e-end face-ccw :> e-end
+    e0 e-end make-ef drop
+
+    e-end ;
+
+: check-bridge-rings ( e1 e2 -- )
+    {
+        [ [ face>> assert-no-rings ] bi@ ]
+        [ [ face>> assert-base-face ] bi@ ]
+        [ assert-different-faces ]
+        [ [ face-sides ] bi@ assert= ]
+    } 2cleave ;
+
+:: bridge-rings-simple ( e1 e2 sharp? -- edge )
+    e1 e2 check-bridge-rings
+    e1 e2 kill-f-make-rh
+    e1 e2 make-e-kill-r face-cw :> ea!
+    e2 face-ccw :> eb!
+    [ ea e1 eq? not ] [
+        ea eb make-ef opposite-edge>> face-cw ea!
+        eb face-ccw eb!
+    ] while
+    eb ;
+
+:: project-pt-line ( p p0 p1 -- q )
+    p1 p0 v- :> vt
+    p p0 v- vt v* sum
+    vt norm-sq /
+    vt n*v p0 v+ ; inline
+
+:: project-pt-plane ( line-p0 line-vt plane-n plane-d -- q )
+    plane-d neg plane-n line-p0 v. -
+    line-vt plane-n v. /
+    line-vt n*v line-p0 v+ ; inline
+
+: project-poly-plane ( poly vdir plane-n plane-d -- qoly )
+    '[ _ _ _ project-pt-plane ] map ; inline