never executed always true always false

    1 module Reanimate.Morph.Linear
    2   ( linear, rawLinear
    3   , linearCorrespondence
    4   , closestLinearCorrespondence
    5   , closestLinearCorrespondenceA
    6   , linearTrajectory
    7   ) where
    8 
    9 import           Data.Hashable
   10 import qualified Data.Vector            as V
   11 import           Linear.Vector
   12 import           Reanimate.ColorComponents
   13 import           Reanimate.Math.Common
   14 import           Reanimate.Math.Polygon
   15 import           Reanimate.Morph.Cache
   16 import           Reanimate.Morph.Common
   17 
   18 linear :: Morph
   19 linear = rawLinear
   20   { morphPointCorrespondence  =
   21       cachePointCorrespondence (hash ("closest"::String))
   22         closestLinearCorrespondence }
   23 
   24 rawLinear :: Morph
   25 rawLinear = Morph
   26   { morphTolerance            = 0.001
   27   , morphColorComponents      = labComponents
   28   , morphPointCorrespondence  = linearCorrespondence
   29   , morphTrajectory           = linearTrajectory
   30   , morphObjectCorrespondence = splitObjectCorrespondence }
   31 
   32 linearCorrespondence :: PointCorrespondence
   33 linearCorrespondence = normalizePolygons
   34 
   35 closestLinearCorrespondence :: PointCorrespondence
   36 closestLinearCorrespondence = closestLinearCorrespondenceA
   37 
   38 closestLinearCorrespondenceA :: (Real a, Fractional a) => APolygon a -> APolygon a -> (APolygon a, APolygon a)
   39 closestLinearCorrespondenceA src' dst' =
   40     (src, worker dst (score dst) options)
   41   where
   42     (src, dst) = normalizePolygons src' dst'
   43     worker bestP _bestPScore [] = bestP
   44     worker bestP bestPScore (x:xs) =
   45       let newScore = score x in
   46       if newScore < bestPScore
   47         then worker x newScore xs
   48         else worker bestP bestPScore xs
   49     options = pCycles dst
   50     score p = sum
   51       [ -- approxDist (pAccess src n) (pAccess p n)
   52         distSquared (pAccess src n) (pAccess p n)
   53       | n <- [0 .. pSize src-1] ]
   54 
   55 linearTrajectory :: Trajectory
   56 linearTrajectory (src,dst)
   57   | pSize src == pSize dst = \t -> mkPolygon $
   58     V.zipWith (lerp $ realToFrac t) (polygonPoints dst) (polygonPoints src)
   59   | otherwise = error $ "Invalid lengths: " ++ show (pSize src, pSize dst)