content: #!/usr/bin/env stack
  -- stack runghc --package reanimate
  {-# LANGUAGE OverloadedStrings #-}
  module Main where
  
  import           Codec.Picture.Types
  import           Control.Lens                  ()
  import           Control.Monad
  import           Data.Function
  import           Data.List
  import           Data.List.NonEmpty            (NonEmpty)
  import qualified Data.List.NonEmpty            as NE
  import           Data.Maybe
  import           Data.Ratio
  import qualified Data.Text                     as T
  import           Data.Tuple
  import qualified Data.Vector                   as V
  import           Debug.Trace
  import           Linear.Matrix                 hiding (trace)
  import           Linear.Metric
  import           Linear.V2
  import           Linear.V3
  import           Linear.Vector
  import           Numeric.LinearAlgebra         hiding (polar, scale, (<>))
  import qualified Numeric.LinearAlgebra         as Matrix
  import           Numeric.LinearAlgebra.HMatrix hiding (polar, scale, (<>))
  import           Reanimate
  import           Reanimate.Animation
  import           Reanimate.Math.Balloon
  import           Reanimate.Math.Common
  import           Reanimate.Math.Triangulate
  import           Reanimate.Math.Polygon
  import           Reanimate.Math.EarClip
  import           Reanimate.Math.SSSP
  import           Reanimate.Math.Render
  import           Reanimate.Math.Visibility
  import           Reanimate.Math.Compatible
  import           Reanimate.Morph.Common
  import           Reanimate.Morph.Linear
  import           Reanimate.Morph.LeastDifference
  import           Reanimate.PolyShape           (svgToPolygons)
  import           Reanimate.Debug
  import qualified Reanimate.Math.Compatible as Compat
  
  extraPoints = 0
  
  -- p1 = pScale 2 $ pAtCenter $ pAddPoints extraPoints (pSetOffset shape13 0)
  -- p1 = pSetOffset (addPoints 2 shape13) 0
  -- p2 = pScale 0.5 $ centerPolygon shape20
  -- p1 = centerPolygon shape2
  -- p2 = pScale 2 $ pAtCenter $ pAddPoints extraPoints (pSetOffset shape14 0 )
  
  -- p1 = pAddPoints extraPoints (pAtCenter $ unsafeSVGToPolygon 0.1 $ scale 6 $ latex "S")
  -- p2 = pAddPoints extraPoints (pAtCenter $ unsafeSVGToPolygon 0.1 $ scale 6 $ latex "C")
  p1 = pAddPoints extraPoints (pAtCenter $ unsafeSVGToPolygon 0.1 $ scale 6 $ latex "X")
  p2 = pAddPoints extraPoints (pAtCenter $ unsafeSVGToPolygon 0.1 $ scale 6 $ latex "I")
  
  p1_ = castPolygon p1
  p2_ = castPolygon p2
  polys = triangulate_ p1_ p2_
  p1_circ = circumference (map fst polys') p1_
  p2_circ = circumference (map snd polys') p2_
  
  polys' = alignPolygons polys p1_ p2_
  polys'' = compatTriagPairs polys'
  
  -- (p1_circ, p2_circ) = closestLinearCorrespondence p1_circ' p2_circ'
  
  -- (p1s, p2s) = unzip $ triangulate p1 p2
  
  main :: IO ()
  -- main = reanimate $ playTraces $ seq (last $ triangulate [] p1 p2) ()
  main = reanimate $ scene $ do
    bg <- newSpriteSVG $ mkBackground "black"
    spriteZ bg (-1)
  
    -- let leastDiffTrig = triangulate p1 p2
    let lst = polys'
    -- let lst = take 10 $ uncurry Compat.compatiblyTriangulateP (polys'!!3) -- polys''
    -- let lst = polys''
    forM_ (zip [0..] lst {-([polys''!!2]++p_snd)-}) $ \(n,(l, r)) -> do
      let c = promotePixel $ turbo (n/fromIntegral (length lst-1))
      newSpriteSVG_ $ 
        translate (-2) 0 $ withFillColorPixel c $ mkGroup
        [ polygonShape (castPolygon l)
        -- , polygonNumDots (castPolygon l)
        ]
      newSpriteSVG_ $ 
        translate 2 0 $ withFillColorPixel c $ mkGroup
        [ polygonShape (castPolygon r)
        -- , polygonNumDots (castPolygon r)
        ]
      nums <- newSpriteSVG $ mkGroup
        [ translate (-2) 0 $ polygonNumDots (castPolygon l)
        , translate 2 0 $ polygonNumDots (castPolygon r)
        ]
      wait (1/60)
      destroySprite nums
    
    -- fork $ play $ staticFrame (1/60) $ mkGroup
    --   [ translate 2 0 $ mkGroup
    --     [ withFillColor "grey" $ polygonShape p2_circ
    --     , polygonNumDots p2_circ
    --     ]
    --   , translate 6 0 $ mkGroup
    --     [ withFillColor "grey" $ polygonShape p2
    --     , polygonNumDots p2
    --     ]
    --   ]
    -- play $ staticFrame (1/60) $ mkGroup
    --   [ translate (-2) 0 $ mkGroup
    --     [ withFillColor "grey" $ polygonShape p1_circ
    --     , polygonNumDots p1_circ
    --     ]
    --   , translate (-6) 0 $ mkGroup
    --     [ withFillColor "grey" $ polygonShape p1
    --     , polygonNumDots p1
    --     ]
    --   ]
  
  
  showP p = mkGroup
    [ withFillColor "grey" $ polygonShape p
    , polygonNumDots p ]
  