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

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