extra/euler/operators/operators-tests.factor

   1 USING: accessors euler.operators euler.modeling euler.b-rep
   2 kernel tools.test game.models.half-edge combinators namespaces
   3 fry sequences make ;
   4 FROM: euler.b-rep => has-rings? ;
   5 IN: euler.operators.tests
   6
   7 { t } [ [ ] make-b-rep b-rep? ] unit-test
   8
   9 { } [
  10     [
  11         { 1 0 0 }
  12         { 0 1 0 }
  13         make-vefs
  14         {
  15             [ face-ccw vertex-pos { 1 0 0 } assert= ]
  16             [ vertex-pos { 0 1 0 } assert= ]
  17             [ vertex-valence 1 assert= ]
  18             [ face-ccw vertex-valence 1 assert= ]
  19             [ dup face-ccw assert-same-face ]
  20         } cleave
  21     ] make-b-rep check-b-rep
  22 ] unit-test
  23
  24 { } [
  25     [
  26         { 1 0 0 }
  27         { 0 1 0 }
  28         make-vefs
  29         kill-vefs
  30     ] make-b-rep assert-empty-b-rep
  31 ] unit-test
  32
  33 [
  34     [
  35         { 1 0 0 }
  36         { 0 1 0 }
  37         make-vefs
  38         dup face-ccw
  39         { 0 0 1 } make-ev
  40     ] make-b-rep
  41 ] [ edges-not-incident? ] must-fail-with
  42
  43 { } [
  44     [
  45         0
  46         1
  47         make-vefs
  48         dup 2 make-ev
  49         [ vertex-pos 2 assert= ]
  50         [ opposite-edge>> vertex-pos 1 assert= ]
  51         bi
  52     ] make-b-rep check-b-rep
  53 ] unit-test
  54
  55 { } [
  56     [
  57         { 1 0 0 }
  58         { 0 1 0 }
  59         make-vefs
  60         dup dup { 0 0 1 } make-ev kill-ev
  61         kill-vefs
  62     ] make-b-rep assert-empty-b-rep
  63 ] unit-test
  64
  65 { } [
  66     [
  67         { 1 2 3 } smooth-smooth polygon>double-face
  68         dup face-cw opposite-edge>>
  69         2dup [ "a" set ] [ "b" set ] bi*
  70         4 make-ev {
  71             [ face-sides 4 assert= ]
  72             [ vertex-pos 4 assert= ]
  73             [ opposite-edge>> face-sides 4 assert= ]
  74             [ face-ccw "b" get assert= ]
  75             [ face-cw "a" get opposite-edge>> assert= ]
  76         } cleave
  77     ] make-b-rep check-b-rep
  78 ] unit-test
  79
  80 { } [
  81     [
  82         { 1 2 3 4 } smooth-smooth polygon>double-face
  83         [ face-ccw opposite-edge>> ]
  84         [ face-ccw face-ccw ]
  85         [ dup face-ccw face-ccw make-ef drop ] tri
  86         5 make-ev {
  87             [ vertex-pos 5 assert= ]
  88             [ face-sides 4 assert= ]
  89         } cleave
  90     ] make-b-rep check-b-rep
  91 ] unit-test
  92
  93 { } [
  94     [
  95         { 1 0 0 }
  96         { 0 1 0 }
  97         make-vefs
  98         [
  99             dup dup make-ef
 100             [ face>> ] bi@ eq? f assert=
 101         ]
 102         [ vertex-valence 3 assert= ]
 103         bi
 104     ] make-b-rep check-b-rep
 105 ] unit-test
 106
 107 [
 108     [
 109         { 1 0 0 }
 110         { 0 1 0 }
 111         make-vefs
 112         dup dup make-ef make-ef
 113     ] make-b-rep
 114 ] [ edges-in-different-faces? ] must-fail-with
 115
 116 { } [
 117     [
 118         { 1 0 0 }
 119         { 0 1 0 }
 120         make-vefs
 121         dup opposite-edge>>
 122         [ [ "a" set ] [ "b" set ] bi* ]
 123         [
 124             make-ef
 125             {
 126                 [ vertex-valence 2 assert= ]
 127                 [ opposite-edge>> vertex-valence 2 assert= ]
 128                 [ next-edge>> "a" get assert= ]
 129                 [ opposite-edge>> next-edge>> "b" get assert= ]
 130                 [ dup opposite-edge>> [ face>> ] bi@ eq? f assert= ]
 131             } cleave
 132         ] 2bi
 133     ] make-b-rep check-b-rep
 134 ] unit-test
 135
 136 { } [
 137     [
 138         { 1 2 3 4 } smooth-smooth polygon>double-face
 139         { 5 6 7 8 } smooth-smooth polygon>double-face
 140         { 9 10 11 12 } smooth-smooth polygon>double-face
 141         {
 142             [ [ drop ] dip kill-f-make-rh ]
 143             [ [ drop ] 2dip kill-f-make-rh ]
 144             [ [ drop ] dip [ face>> ] bi@ [ base-face>> ] dip assert= ]
 145             [ [ drop ] 2dip [ face>> ] bi@ [ base-face>> ] dip assert= ]
 146             [ 2nip face>> has-rings? t assert= ]
 147             [ drop drop make-f-kill-rh ]
 148             [ drop nip make-f-kill-rh ]
 149             [ drop drop face>> dup base-face>> assert= ]
 150             [ drop nip face>> dup base-face>> assert= ]
 151             [ 2nip face>> has-rings? f assert= ]
 152         } 3cleave
 153     ] make-b-rep check-b-rep
 154 ] unit-test
 155
 156 {
 157     { 0 1 0 }
 158     { 1 0 0 }
 159     { 1 2 1 }
 160     { 2 1 1 }
 161 } [
 162     [
 163         { 1 0 0 }
 164         { 0 1 0 }
 165         make-vefs
 166         dup opposite-edge>>
 167         {
 168             [ [ vertex-pos ] bi@ ]
 169             [ drop { 1 1 1 } move-e ]
 170             [ [ vertex-pos ] bi@ ]
 171         } 2cleave
 172     ] make-b-rep check-b-rep
 173 ] unit-test
 174
 175 {
 176     {
 177         { 2 1 1 }
 178         { 1 2 1 }
 179         { 1 1 2 }
 180     }
 181 } [
 182     [
 183         { { 1 0 0 } { 0 1 0 } { 0 0 1 } } smooth-smooth polygon>double-face
 184         [ { 1 1 1 } move-f ]
 185         [ [ [ vertex-pos , ] each-face-edge ] { } make ]
 186         bi
 187     ] make-b-rep check-b-rep
 188 ] unit-test
 189
 190 ! Make sure we update the face's edge when killing an edge
 191 { } [
 192     [
 193         { 1 2 3 4 } smooth-smooth polygon>double-face
 194         kill-ev
 195     ] make-b-rep check-b-rep
 196 ] unit-test
 197
 198 { } [
 199     [
 200         { 1 2 3 4 } smooth-smooth polygon>double-face
 201         face-ccw kill-ev
 202     ] make-b-rep check-b-rep
 203 ] unit-test
 204
 205 { } [
 206     [
 207         { 1 2 3 4 } smooth-smooth polygon>double-face
 208         face-ccw face-ccw kill-ev
 209     ] make-b-rep check-b-rep
 210 ] unit-test
 211
 212 { } [
 213     [
 214         { 1 2 3 4 } smooth-smooth polygon>double-face
 215         face-ccw face-ccw face-ccw kill-ev
 216     ] make-b-rep check-b-rep
 217 ] unit-test