mirror of
https://github.com/reanimate/reanimate.git
synced 2026-09-10 23:52:22 +00:00
4356efbc7e
* Disable windows CI (because of hmatrix) * Implement ear-clip triangulation. * Implement common framework for polygon morphing. * Draft implementations of compatible triangulation and mesh smoothing. * Implement least-work morphing. * Implement as-rigid-as-possible morphing. * Implement SSSP. * Draft article about polygon morphing. Former-commit-id: f6f19f58b9dd58c655bcca0ed2d65f72726f0a06
72 lines
2.1 KiB
Haskell
72 lines
2.1 KiB
Haskell
{-# LANGUAGE FlexibleInstances #-}
|
|
{-# LANGUAGE TypeSynonymInstances #-}
|
|
{-# OPTIONS_GHC -w #-}
|
|
{-# LANGUAGE TemplateHaskell #-}
|
|
module Properties where
|
|
|
|
import qualified Data.Vector as V
|
|
import Linear.V2
|
|
import Linear.Vector
|
|
import Test.QuickCheck
|
|
import Test.Tasty
|
|
import Test.Tasty.QuickCheck
|
|
|
|
import Reanimate.Math.Common
|
|
import Reanimate.Math.Polygon
|
|
import Reanimate.Math.EarClip
|
|
import Reanimate.Math.SSSP
|
|
import Helpers
|
|
|
|
import Debug.Trace
|
|
|
|
prop_pGenerate (PolyParam a) (PolyParam b) (PolyParam c) (PolyParam d) =
|
|
pIsSimple $ pGenerate [a,b,c,d]
|
|
|
|
prop_pIsSimple p = pIsSimple p
|
|
|
|
prop_isBetween a b = percent $ \t ->
|
|
a /= b ==>
|
|
isBetween (lerp t a b) (a,b) &&
|
|
isBetween a (a,b) &&
|
|
isBetween b (a,b)
|
|
|
|
prop_isBetweenAxis a = percent $ \t ->
|
|
let b = a + V2 0 1
|
|
c = a + V2 1 0 in
|
|
isBetween (lerp t a b) (a,b) &&
|
|
isBetween (lerp t a c) (a,c)
|
|
|
|
prop_isNotBetween a b = forAll (choose (1.1,100)) $ \t ->
|
|
a /= 0 && b /= 0 ==>
|
|
not (isBetween (lerp (realToFrac (t::Double)) a b :: V2 Rational) (a,b))
|
|
|
|
prop_winding = forAll (choose (1,100)) $ \n -> pIsSimple (pMkWinding n)
|
|
|
|
prop_ccw p = label (if pIsConvex p then "convex" else "concave") $ pIsCCW p
|
|
prop_rev_ccw p = not $ pIsCCW (mkPolygon $ V.reverse $ polygonPoints p)
|
|
prop_pCycle p = forAll (choose (0,1)) $ \t ->
|
|
pIsSimple (pCycle p t)
|
|
|
|
prop_validEarClip p = isValidTriangulation p (earClip $ pRing p)
|
|
|
|
-- dualToTrangulation . dual = id
|
|
prop_dualInv p =
|
|
let t = polygonTriangulation p in
|
|
dualToTriangulation (pRing p) (dual (polygonOffset p) t) == t
|
|
|
|
prop_ssspEq p =
|
|
pSize p < 20 ==>
|
|
naive (pRing p) == polygonSSSP p V.! 0
|
|
|
|
prop_ssspVisibilityLength (Parameters xs) =
|
|
let p = pGenerate xs in
|
|
pSize (ssspVisibility p) <= pSize p
|
|
|
|
prop_dualCycle p = forAll (choose (0,pSize p-1)) $ \n ->
|
|
let p1 = pSetOffset p n
|
|
p2 = pCopy p1
|
|
in and [ pParent p1 0 i == pParent p2 0 i | i <- [0.. pSize p-1] ]
|
|
|
|
return []
|
|
all_props :: TestTree
|
|
all_props = testProperties "properties" $allProperties
|