extra/game/models/half-edge/half-edge.factor

   1 ! (c)2010 Joe Groff bsd license
   2 USING: accessors arrays fry kernel locals math sequences ;
   3 IN: game.models.half-edge
   4
   5 TUPLE: edge < identity-tuple face vertex opposite-edge next-edge ;
   6
   7 : edge-vertices ( edge -- start end )
   8     [ vertex>> ] [ opposite-edge>> vertex>> ] bi ;
   9
  10 ! building blocks for edge loop iteration
  11
  12 : (collect) ( in quot iterator -- out )
  13     [ collector ] dip dip >array ; inline
  14
  15 : (reduce) ( in initial quot iterator -- accum )
  16     [ swap ] 2dip call ; inline
  17
  18 : (count) ( in iterator -- count )
  19     [ 0 [ drop 1 + ] ] dip (reduce) ; inline
  20
  21 : edge-loop ( ..a edge quot: ( ..a edge -- ..b ) next-edge-quot: ( ..b edge -- ..a edge' ) -- ..a )
  22     pick '[ _ _ bi dup _ eq? not ] loop drop ; inline
  23
  24 ! iterate over related edges
  25
  26 : each-vertex-edge ( ... edge quot: ( ... edge -- ... ) -- ... )
  27     [ opposite-edge>> next-edge>> ] edge-loop ; inline
  28
  29 : each-face-edge ( ... edge quot: ( ... edge -- ... ) -- ... )
  30     [ next-edge>> ] edge-loop ; inline
  31
  32 !
  33
  34 : vertex-edges ( edge -- edges )
  35     [ ] [ each-vertex-edge ] (collect) ;
  36
  37 : vertex-neighbors ( edge -- edges )
  38     [ opposite-edge>> vertex>> ] [ each-vertex-edge ] (collect) ;
  39
  40 : vertex-diagonals ( edge -- edges )
  41     [ next-edge>> opposite-edge>> vertex>> ] [ each-vertex-edge ] (collect) ;
  42
  43 : vertex-valence ( edge -- count )
  44     [ each-vertex-edge ] (count) ;
  45
  46 : face-edges ( edge -- edges )
  47     [ ] [ each-face-edge ] (collect) ;
  48
  49 : face-neighbors ( edge -- edges )
  50     [ opposite-edge>> face>> ] [ each-face-edge ] (collect) ;
  51
  52 : face-sides ( edge -- count )
  53     [ each-face-edge ] (count) ;
  54