#!/usr/bin/env stack
-- stack runghc --package reanimate
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
module Main (main) where

import           Chiphunk.Low
import           Control.Monad
import           Graphics.SvgTree    (Tree)
import           Linear.V2
import           Reanimate.Chiphunk
import           Reanimate
import           Reanimate.PolyShape
import           System.IO.Unsafe

test :: Animation
test = unsafePerformIO $ do
  bodyStore <- newBodyStore
  let gravity = Vect 0 (-1)

  -- Create an empty space.
  space <- spaceNew
  -- spaceCollisionSlop space $= (screenWidth/2560)
  spaceGravity space $= gravity

  -- Add a static line segment shape for the ground.
  -- We'll make it slightly tilted so the ball will roll off.
  -- We attach it to a static body to tell Chipmunk it shouldn't be movable.
  static <- get $ spaceStaticBody space
  ground <- segmentShapeNew static
    (Vect (-screenWidth/2) (screenHeight/2))
    (Vect (screenWidth/2) (-screenHeight/2)) 0
  shapeFriction ground $= 1
  spaceAddShape space ground

  -- Now let's make a ball that falls onto the line and rolls off.
  -- First we need to make a cpBody to hold the physical properties of the object.
  -- These include the mass, position, velocity, angle, etc. of the object.
  -- Then we attach collision shapes to the Body to give it a size and shape.

  let toVect (V2 x y) = Vect x y

  let svg = center $ scale 2 $ latex "$\\Phi$"
      poly = svgToPolyShapes svg
      vectGroup = plDecompose' 1 poly
            --mkCircle (Num radius)
      -- vects = svgToVects svg
      -- vects' = fst $ convexHull vects 0
      -- svg' =
      --   withFillOpacity 0 $ withStrokeColor "white" $
      --   withStrokeWidth 0.01 $
      --   renderPolyShapes (map plFromPolygon vectGroup)
  --
  -- ballBody <- polyShapesToBody space poly
  -- bodyPosition ballBody $= Vect (-screenWidth/4) (screenHeight/2)
  --
  -- addToBodyStore bodyStore ballBody $
  --   withFillColor "white" $
  --   mkGroup
  --     [ svg' ]

  -- let splitPolys = vectGroup
  forM_ vectGroup $ \polygon -> do
    bd <- polygonsToBody space [map toVect polygon]
    bodyPosition bd $= Vect 0 (screenHeight/3)
    addToBodyStore bodyStore bd $
      renderPolyShape $ plFromPolygon polygon
      -- withFillColor "white" $
      -- mkGroup
      --   [ --withStrokeWidth (Num 0.005) $
      --     -- withStrokeWidth (Num 0.00) $
      --     -- withStrokeColor "white" $
      --     -- withFillOpacity 1 $
      --     renderPolyShape $ plFromPolygon polygon
      --   ]

  ani <- simulate space bodyStore 60 10 10
  spaceFreeRecursive space
  return ani

-- data LineCommand
--   = LineMove RPoint
--   -- | LineDraw RPoint
--   | LineBezier [RPoint]
--   | LineEnd

-- vectsToSVG :: [Vect] -> Tree
-- vectsToSVG (Vect x y:rest) =
--   mkPath $
--     MoveTo OriginAbsolute [V2 x y] :
--     [ LineTo OriginAbsolute [V2 a b] | Vect a b <- rest ] ++
--     [ EndPath ]
--   where
--     mkPath cmds = PathTree $ defaultSvg & pathDefinition .~ cmds

-- polygonsToSVG :: [[Vect]] -> Tree
-- polygonsToSVG = merge . mkGroup . map vectsToSVG
--   where
--     merge svg = PathTree $ defaultSvg & pathDefinition .~ extractPath svg

-- svgToVects :: Tree -> [Vect]
-- svgToVects svg = map worker (lineToPoints 200 cmds)
--   where
--     worker (V2 x y) = Vect x y
--     cmds = toLineCommands $ wibble $ extractPath svg
--     wibble xs = takeWhile (/=EndPath) xs ++ [EndPath]

chunkPolyshapes :: Tree -> Tree
chunkPolyshapes t =
  mkGroup
  [
  -- withFillColor "white" $
  -- withFillOpacity 1 $
  -- withStrokeWidth (Num 0.01) $
  -- withStrokeColor "blue" $
  -- mkGroup $ map renderPolyShape $
  -- map mergePolyShapeHoles $
  -- plGroupShapes $
  -- -- unionPolyShapes $
  -- traceUnion $
  -- svgToPolyShapes t
    withStrokeWidth 0.001 $
    withStrokeColor "red" $
    withFillOpacity 0 $
    mkGroup $ map renderPolyShape $
    svgToPolyShapes t
    -- withStrokeWidth 0.001 $
    -- withStrokeColor "red" $
    -- mkGroup $ map renderPolyShape [pl12,pl13]
  ]

-- plArea :: PolyShape -> Double
-- plArea pl = areaForPoly (map toVect $ plPolygonify polyShapeTolerance pl) 0
--   where
--     toVect (Point x y) = Vect x y

reorient :: Tree -> Tree
reorient = scale 6 . translate 0 (-0.9)

-- traceUnion t =
--   let out = unionPolyShapes t
--   in trace (unlines $
--             ("Trace: " ++ show (sum $ map plArea t)) :
--             ("Check: " ++ show (sum $ map plArea out)) :
--             map show t ++ ["Out:"] ++ map show out) out

-- pl1 = PolyShape {unPolyShape = ClosedPath [(Point 9.076152025049407e-2 0.8793158714390639,JoinLine),(Point 0.48865783997158957 0.5875446050720555,JoinLine),(Point 0.6291445682322502 0.560956966929786,JoinLine),(Point 0.684414274089106 0.6254399758525935,JoinLine),(Point 8.549729225029659e-2 0.9226054512958702,JoinLine)]}
-- pl2 = PolyShape {unPolyShape = ClosedPath [(Point 0.3174796674934045 (-0.17830385091116296),JoinLine),(Point 0.3930521201476444 (-0.22384314349780887),JoinLine),(Point 0.42400439387727545 (-0.17026635397131717),JoinLine),(Point 0.367180526197663 (-0.13743818486413273),JoinLine)]}
-- pl3 = PolyShape {unPolyShape = ClosedPath [(Point 3.818529643334073e-2 4.994390978944008e-2,JoinLine),(Point 3.5509598929490127e-3 3.0061273354143103e-2,JoinLine),(Point 2.6643683455205014e-2 (-1.3314171733262437e-2),JoinLine)]}
-- pl4 = PolyShape {unPolyShape = ClosedPath [(Point 8.041123459068245e-2 (-4.592522065745819e-2),JoinLine),(Point 0.29675416515553454 (-0.17235110729572378),JoinLine),(Point 0.34590008699238584 (-0.13081971694800998),JoinLine),(Point 0.22737727571852562 4.513304505856075e-2,JoinLine),(Point 0.10498823211784264 (-3.373201779345303e-3),JoinLine)]}
-- pl5 = PolyShape {unPolyShape = ClosedPath [(Point 4.1547772506933034e-2 0.10908491253751296,JoinLine),(Point 5.7556283592893165e-2 (-2.2936657573235042e-2),JoinLine),(Point 0.18645395693905423 2.887370173550552e-2,JoinLine),(Point 0.24063435970720265 0.12675372820097613,JoinLine),(Point 0.19807899284556882 0.17285980812856805,JoinLine),(Point 8.45668830191807e-2 0.18680141998908184,JoinLine)]}
-- pl6 = PolyShape {unPolyShape = ClosedPath [(Point (-0.2574090456009813) 0.22352645168090446,JoinLine),(Point (-0.27139525022076605) 0.16073053060077958,JoinLine),(Point (-9.444562231853837e-2) 4.994785063168361e-2,JoinLine),(Point (-4.012849544398306e-2) 6.733655689772311e-2,JoinLine),(Point (-4.6550067413171026e-2) 0.20017002713448606,JoinLine)]}
-- pl7 = PolyShape {unPolyShape = ClosedPath [(Point (-0.3714373753139388) 0.20874389306710772,JoinLine),(Point (-0.29452803703157854) 0.1655072120141602,JoinLine),(Point (-0.2835217605861194) 0.22889335799870397,JoinLine),(Point (-0.34012040364470725) 0.2621083279509192,JoinLine)]}
-- pl8 = PolyShape {unPolyShape = ClosedPath [(Point 0.1712163207191154 0.2149766965620984,JoinLine),(Point 0.19616659305280632 0.1905738263277067,JoinLine),(Point 0.6315796735654418 0.5328570813993471,JoinLine),(Point 0.49895896036053317 0.5862908698518825,JoinLine)]}
-- pl9 = PolyShape {unPolyShape = ClosedPath [(Point 0.10739670009207455 0.19390054402859663,JoinLine),(Point 0.16776933204268935 0.17681618959615353,JoinLine),(Point 0.19166035517967667 0.1970425575035583,JoinLine),(Point 0.16584071117957827 0.2205236594561943,JoinLine)]}
-- pl10 = PolyShape {unPolyShape = ClosedPath [(Point (-0.3669271639958152) 1.1382616686769857,JoinLine),(Point (-0.30169633405804164) 1.1454435521784956,JoinLine),(Point (-0.2858326377769962) 1.2078015601462844,JoinLine),(Point (-0.3736986541543818) 1.199765022618315,JoinLine)]}
-- pl11 = PolyShape {unPolyShape = ClosedPath [(Point (-3.0061173114158422e-2) 1.1779482589541495,JoinLine),(Point 5.4907529076574785e-3 1.2315286122957358,JoinLine),(Point (-3.4177530164954735e-2) 1.2269151735259667,JoinLine)]}
-- pl12 = PolyShape {unPolyShape = ClosedPath
--   [(Point (-0.301730083226429*10) 1.1457103198223786,JoinLine)
--   ,(Point (-0.10299641326632633*10) 1.0714677466302471,JoinLine)
--   ,(Point (-3.162369257155477e-2*10) 1.182092647608354,JoinLine)
--   ,(Point (-3.636877035247056e-2*10) 1.2310026399913667,JoinLine)
--   ,(Point (-0.28589249688644447*10) 1.208074964264014,JoinLine)]}
-- pl13 = PolyShape {unPolyShape = ClosedPath
--   [(Point (-9.39646610882567e-2*10) 0.96018603098516,JoinLine)
--   ,(Point (-6.465077411411442e-2*10) 0.9514465910530718,JoinLine)
--   ,(Point (0.14134955357291654*10) 1.2461928296570437,JoinLine)
--   ,(Point (8.29425965486209e-3*10) 1.2330682613363688,JoinLine)
--   ,(Point (-0.10287959610529117*10) 1.0717052650151784,JoinLine)]}
-- pl14 = PolyShape {unPolyShape = ClosedPath [(Point (-0.6410657779553459) 0.5634659418454123,JoinLine),(Point (-0.641345175626591) 0.555247219163176,JoinLine),(Point (-0.4420444191709594) 0.5513358399243028,JoinLine),(Point (-0.10594072095664082) 0.9023816092645105,JoinLine),(Point (-7.577913627887163e-2) 0.9355404742795719,JoinLine),(Point (-0.10373629906690308) 0.9479533236181756,JoinLine)]}
-- pl15 = PolyShape {unPolyShape = ClosedPath [(Point (-3.523485505752828e-2) 0.1998408875682416,JoinLine),(Point 1.2546982880291841e-2 0.15208851089779252,JoinLine),(Point 0.13018455413761065 0.208301106923033,JoinLine),(Point 8.433578523127425e-2 0.9418697065712005,JoinLine),(Point (-7.884702019521485e-2) 0.932428903501462,JoinLine),(Point (-8.084970167352624e-2) 0.9296667902794287,JoinLine)]}
-- pl16 = PolyShape {unPolyShape = ClosedPath [(Point (-7.878197627394322e-2) 0.9319709148544943,JoinLine),(Point 8.438182768423004e-2 0.941734614325483,JoinLine),(Point 8.518191684165782e-2 0.9853357574063363,JoinLine),(Point 8.15663333974107e-2 0.9853939259545145,JoinLine),(Point (-4.936159754845773e-2) 0.9727171460725276,JoinLine)]}
-- pl17 = PolyShape {unPolyShape = ClosedPath [(Point (-4.99911351869741e-2) 0.9726181699897635,JoinLine),(Point 8.094809532371453e-2 0.9851776987711782,JoinLine),(Point 7.384845354621125e-2 1.0968271981504014,JoinLine),(Point 4.400324523877765e-2 1.1025518925313644,JoinLine)]}
-- pl18 = PolyShape {unPolyShape = ClosedPath [(Point 4.8482888984171635e-2 1.1105768787999895,JoinLine),(Point 7.512899062784217e-2 1.0959654499901599,JoinLine),(Point 0.2822087302816073 1.1420633097553252,JoinLine),(Point 0.27513287205836434 1.2060076125068004,JoinLine),(Point 0.20204313118994668 1.2231219927110881,JoinLine)]}
-- pl19 = PolyShape {unPolyShape = ClosedPath [(Point 0.2748784478150325 1.2078902086770202,JoinLine),(Point 0.2820822061918643 1.1439601884266248,JoinLine),(Point 0.3457225261391361 1.127943000720636,JoinLine),(Point 0.36082444597621127 1.187946730956635,JoinLine)]}
-- pl20 = PolyShape {unPolyShape = ClosedPath [(Point (-0.6864531908080556) 0.5032767356555317,JoinLine),(Point (-9.929294916146593e-2) 0.20829491627795255,JoinLine),(Point (-8.483230342755331e-2) 0.23523598173633797,JoinLine),(Point (-0.49217693932265094) 0.547917843618004,JoinLine)]}
-- pl21 = PolyShape {unPolyShape = ClosedPath [(Point (-9.274301086931341e-2) 0.2153671046631685,JoinLine),(Point (-4.68781647762479e-2) 0.2005165600411279,JoinLine),(Point (-4.790067311086227e-2) 0.23865704773924823,JoinLine),(Point (-7.795810209993242e-2) 0.2330461435659677,JoinLine)]}

-- unionTest = parsed
--   where
--     svg = center $ scale 2 $ latex "I"
--     poly = svgToPolyShapes svg
--     vectGroup = plDecompose' 1 poly
--     rendered = mkGroup $ take 100 $ map (renderPolyShape . plFromPolygon) vectGroup
--     parsed = svgToPolyShapes rendered
--
--     myDecompose tol =
--       concatMap decomposePolygon .
--       map (plPolygonify tol) .
--       map mergePolyShapeHoles .
--       plGroupShapes .
--       unionPolyShapes

main :: IO ()
main = reanimate $ bg `parA` mapA reorient (line `parA` mapA chunkPolyshapes test)
  where
    bg = animate $ const $ mkBackground "black"
    line = animate $ const $ withStrokeColor "white" $
      withStrokeWidth 0.01 $
      mkLine (-screenWidth/2, screenHeight/2)
             (screenWidth/2, -screenHeight/2)