111 lines
3.1 KiB
Factor
111 lines
3.1 KiB
Factor
! Copyright (C) 2010 Slava Pestov.
|
|
USING: accessors euler.b-rep euler.operators
|
|
game.models.half-edge gml.macros gml.printer gml.runtime
|
|
gml.types io io.styles kernel namespaces ;
|
|
FROM: alien.c-types => >c-bool c-bool> ;
|
|
IN: gml.b-rep
|
|
|
|
LOG-GML: makeVEFS ( p1 p2 -- edge ) make-vefs ;
|
|
|
|
LOG-GML: makeEV ( e0 e1 p -- edge ) make-ev ;
|
|
|
|
LOG-GML: makeEVone ( e0 p -- edge ) dupd make-ev ;
|
|
|
|
LOG-GML: makeEF ( e1 e2 -- edge ) make-ef ;
|
|
|
|
LOG-GML: makeEkillR ( edge-ring edge-face -- edge ) make-e-kill-r ;
|
|
|
|
LOG-GML: makeFkillRH ( edge-ring -- ) make-f-kill-rh ;
|
|
|
|
LOG-GML: killVEFS ( edge -- ) kill-vefs ;
|
|
|
|
LOG-GML: killEV ( edge -- ) kill-ev ;
|
|
|
|
LOG-GML: killEF ( edge -- ) kill-ef ;
|
|
|
|
LOG-GML: killEmakeR ( edge -- edge-ring ) kill-e-make-r ;
|
|
|
|
LOG-GML: killFmakeRH ( face-edge base-face-edge -- ) kill-f-make-rh ;
|
|
|
|
GML: moveV ( edge point -- ) move-v ;
|
|
|
|
GML: moveE ( edge offset -- ) move-e ;
|
|
|
|
GML: moveF ( edge offset -- ) move-f ;
|
|
|
|
GML: vertexCW ( e0 -- e1 ) vertex-cw ;
|
|
|
|
GML: vertexCCW ( e0 -- e1 ) vertex-ccw ;
|
|
|
|
GML: faceCW ( e0 -- e1 ) face-cw ;
|
|
|
|
GML: faceCCW ( e0 -- e1 ) face-ccw ;
|
|
|
|
GML: baseface ( e0 -- e1 ) base-face>> ;
|
|
|
|
GML: nextring ( e0 -- e1 ) dup next-ring>> [ ] [ base-face>> ] ?if ;
|
|
|
|
GML: facenormal ( e0 -- n ) face-normal ;
|
|
GML: faceplanedist ( e0 -- d ) face-plane-dist ;
|
|
GML: faceplane ( e0 -- n d ) face-plane ;
|
|
|
|
GML: facemidpoint ( e0 -- v ) face-midpoint ;
|
|
|
|
GML: facedegree ( e0 -- n ) face-sides ;
|
|
|
|
GML: edgemate ( e0 -- e1 ) opposite-edge>> ;
|
|
GML: edgeflip ( e0 -- e1 ) opposite-edge>> ;
|
|
|
|
GML: edgedirection ( e0 -- v ) edge-direction ;
|
|
|
|
GML: vertexpos ( e0 -- p ) vertex-pos ;
|
|
|
|
GML: valence ( e0 -- n ) vertex-valence ;
|
|
|
|
GML: sameEdge ( e0 e1 -- ? ) same-edge? >true ;
|
|
|
|
GML: sameFace ( e0 e1 -- ? ) same-face? >true ;
|
|
|
|
GML: sameVertex ( e0 e1 -- ? ) incident? >true ;
|
|
|
|
GML: isBaseface ( e -- ? ) face>> base-face? ;
|
|
|
|
GML: sharpE ( e sharp -- ) c-bool> sharp-e ;
|
|
|
|
GML: sharpF ( e sharp -- ) c-bool> sharp-f ;
|
|
|
|
GML: sharpV ( e sharp -- ) c-bool> sharp-v ;
|
|
|
|
GML: issharp ( e -- sharp ) sharpness>> >c-bool ;
|
|
|
|
GML: isValidEdge ( e -- ? ) b-rep get is-valid-edge? ;
|
|
|
|
GML: materialF ( e material -- ) material-f ;
|
|
|
|
GML: setcurrentmaterial ( material -- ) drop ;
|
|
GML: getcurrentmaterial ( -- material ) "none" >gml-name ;
|
|
GML: pushcurrentmaterial ( material -- ) drop ;
|
|
GML: popcurrentmaterial ( -- material ) "none" >gml-name ;
|
|
GML: getmaterialnames ( -- [material] ) { } ;
|
|
GML: setfacematerial ( e material -- ) material-f ;
|
|
GML: getfacematerial ( e -- material ) drop "none" >gml-name ;
|
|
|
|
GML: setsharpness ( sharp -- ) c-bool> set-sharpness ;
|
|
GML: getsharpness ( -- sharp ) get-sharpness >c-bool ;
|
|
GML: pushsharpness ( sharp -- ) c-bool> push-sharpness ;
|
|
GML: popsharpness ( -- sharp ) pop-sharpness >c-bool ;
|
|
|
|
GML: connectedvertices ( e0 e1 -- connected )
|
|
! Stupid variable-arity word!
|
|
connecting-edge [ [ over push-operand ] when* ] [ >c-bool ] bi ;
|
|
|
|
M: b-edge write-gml
|
|
dup vertex>> position>> vertex-style [
|
|
"«Edge " write
|
|
[ vertex>> position>> write-gml "-" write ] [
|
|
opposite-edge>> vertex>> position>>
|
|
dup vertex-style [ write-gml ] with-style
|
|
] bi
|
|
"»" write
|
|
] with-style ;
|