{-# LANGUAGE RecordWildCards, CPP #-}

module Test where

import Affection

import qualified SDL
import qualified GEGL as G
import Abuse

import qualified Data.Map.Strict as M
import Data.List as L
import Data.Maybe

import Control.Monad (unless, when, foldM)
import Control.Monad.State (get, put)

import Types
import Types.StateData
import Commons

playerVelocity :: Double
playerVelocity = 50

moveKeys :: [SDL.Keycode]
moveKeys =
  [ SDL.KeycodeW
  , SDL.KeycodeA
  , SDL.KeycodeS
  , SDL.KeycodeD
  ]

specialKeys :: [SDL.Keycode]
specialKeys =
  [ SDL.KeycodeO
  , SDL.KeycodeEscape
#ifdef DEBUG
  , SDL.KeycodeT
  , SDL.KeycodeF
  , SDL.KeycodeP
#endif
  ]

testLoad :: Affection StateData ()
testLoad = do
  sd@StateData{..} <- getAffection
  playerNode <- liftIO $ G.gegl_node_new_child (nodeMap M.! NodeRoot) $
    G.Operation "gegl:png-load" $ props $
      prop "path" ("assets/pituicat.png" :: String)
  playerScale <- liftIO $ G.gegl_node_new_child (nodeMap M.! NodeRoot) $
    G.Operation "gegl:scale-size-keepaspect" $ props $ do
      prop "x" (64 :: Double)
      prop "y" (64 :: Double)
      prop "origin-x" (32 :: Double)
      prop "origin-y" (32 :: Double)
  playerReflect <- liftIO $ G.gegl_node_new_child (nodeMap M.! NodeRoot) $
    G.Operation "gegl:reflect" $ props $ do
      prop "x" (0 :: Double)
      prop "y" (0 :: Double)
      prop "origin-x" (32 :: Double)
      prop "origin-y" (32 :: Double)
      prop "sampler" (fromEnum G.GeglSamplerCubic)
  playerRot <- liftIO $ G.gegl_node_new_child (nodeMap M.! NodeRoot) $
    G.Operation "gegl:rotate-on-center" $ props $ do
      prop "sampler" (fromEnum G.GeglSamplerCubic)
      prop "degrees" (0 :: Double)
  playerTrans <- liftIO $ G.gegl_node_new_child (nodeMap M.! NodeRoot) $
    G.Operation "gegl:translate" $ props $ do
      prop "x" (30 :: Double)
      prop "y" (0 :: Double)
  playerOver <- liftIO $ G.gegl_node_new_child (nodeMap M.! NodeRoot) $
    G.Operation "gegl:over" []
  liftIO $ G.gegl_node_link_many
    [playerNode, playerRot, playerScale, playerReflect, playerTrans]
  _ <- liftIO $ G.gegl_node_connect_to playerTrans "output" playerOver "aux"
  let boxdim = do
        topleft
        prop "width" (64 :: Double)
        prop "height" (64 :: Double)
      topleft = do
        prop "x" (0 :: Double)
        prop "y" (0 :: Double)
      rotprops = do
        prop "origin-x" (32 :: Double)
        prop "origin-y" (32 :: Double)
        prop "sampler" (fromEnum G.GeglSamplerCubic)
        prop "degrees" (0 :: Double)
  -- box1Node <- liftIO $ G.gegl_node_new_child (nodeMap M.! NodeRoot) $
  --   G.Operation "gegl:rectangle" $ props $ do
  --     boxdim
  --     prop "color" $ G.RGB 1 1 1
  box1Node <- liftIO $ G.gegl_node_new_child (nodeMap M.! NodeRoot) $
    G.Operation "gegl:png-load" $ props $
      prop "path" ("assets/box1.png" :: String)
  box1Scale <- liftIO $ G.gegl_node_new_child (nodeMap M.! NodeRoot) $
    G.Operation "gegl:scale-size-keepaspect" $ props $ do
      prop "x" (64 :: Double)
      prop "y" (64 :: Double)
      -- prop "origin-x" (32 :: Double)
      -- prop "origin-y" (32 :: Double)
  box1Rot <- liftIO $ G.gegl_node_new_child (nodeMap M.! NodeRoot) $
    G.Operation "gegl:rotate" $ props $ do
        prop "sampler" (fromEnum G.GeglSamplerCubic)
        prop "degrees" (0 :: Double)
        prop "origin-x" (0 :: Double)
        prop "origin-y" (0 :: Double)
  box1Trans <- liftIO $ G.gegl_node_new_child (nodeMap M.! NodeRoot) $
    G.Operation "gegl:translate" $ props $ do
      prop "x" (400 :: Double)
      prop "y" (100 :: Double)
  box1Over <- liftIO $ G.gegl_node_new_child (nodeMap M.! NodeRoot) $
    G.Operation "gegl:over" []
  _ <- liftIO $ G.gegl_node_connect_to box1Trans "output" box1Over "aux"
  liftIO $ G.gegl_node_link_many [box1Node, box1Scale, box1Rot, box1Trans]
  box2Node <- liftIO $ G.gegl_node_new_child (nodeMap M.! NodeRoot) $
    G.Operation "gegl:rectangle" $ props $ do
      boxdim
      prop "color" $ G.RGB 1 0 0
  box2Rot <- liftIO $ G.gegl_node_new_child (nodeMap M.! NodeRoot) $
    G.Operation "gegl:rotate" $ props $ rotprops
  box2Trans <- liftIO $ G.gegl_node_new_child (nodeMap M.! NodeRoot) $
    G.Operation "gegl:translate" $ props $ do
      prop "x" (600 :: Double)
      prop "y" (0 :: Double)
  box2Over <- liftIO $ G.gegl_node_new_child (nodeMap M.! NodeRoot) $
    G.Operation "gegl:over" []
  _ <- liftIO $ G.gegl_node_connect_to box2Trans "output" box2Over "aux"
  liftIO $ G.gegl_node_link_many [box2Node, box2Rot, box2Trans]
  fixture <- liftIO $ G.gegl_node_new_child (nodeMap M.! NodeRoot) $
    G.Operation "gegl:rectangle" $ props $ do
      topleft
      prop "width" (800 :: Double)
      prop "height" (20 :: Double)
      prop "color" $ G.RGB 0 1 0
  fixtTrans <- liftIO $ G.gegl_node_new_child (nodeMap M.! NodeRoot) $
    G.Operation "gegl:translate" $ props $ do
      prop "x" (0 :: Double)
      prop "y" (500 :: Double)
  fixtOver <- liftIO $ G.gegl_node_new_child (nodeMap M.! NodeRoot) $
    G.Operation "gegl:over" []
  _ <- liftIO $ G.gegl_node_connect_to fixtTrans "output" fixtOver "aux"
  liftIO $ G.gegl_node_link_many [fixture, fixtTrans]
  let sidebars = do
        topleft
        prop "width" (20 :: Double)
        prop "height" (600 :: Double)
  fixture2 <- liftIO $ G.gegl_node_new_child (nodeMap M.! NodeRoot) $
    G.Operation "gegl:rectangle" $ props $ do
      sidebars
      prop "color" $ G.RGB 0 1 0
  fixt2Trans <- liftIO $ G.gegl_node_new_child (nodeMap M.! NodeRoot) $
    G.Operation "gegl:translate" $ props $ do
      prop "x" (780 :: Double)
      prop "y" (0 :: Double)
  fixt2Over <- liftIO $ G.gegl_node_new_child (nodeMap M.! NodeRoot) $
    G.Operation "gegl:over" []
  _ <- liftIO $ G.gegl_node_connect_to fixt2Trans "output" fixt2Over "aux"
  liftIO $ G.gegl_node_link_many [fixture2, fixt2Trans]
  fixture3 <- liftIO $ G.gegl_node_new_child (nodeMap M.! NodeRoot) $
    G.Operation "gegl:rectangle" $ props $ do
      sidebars
      prop "color" $ G.RGB 0 1 0
  fixt3Trans <- liftIO $ G.gegl_node_new_child (nodeMap M.! NodeRoot) $
    G.Operation "gegl:translate" $ props $ do
      prop "x" (0 :: Double)
      prop "y" (0 :: Double)
  fixt3Over <- liftIO $ G.gegl_node_new_child (nodeMap M.! NodeRoot) $
    G.Operation "gegl:over" []
  _ <- liftIO $ G.gegl_node_connect_to fixt3Trans "output" fixt3Over "aux"
  liftIO $ G.gegl_node_link_many [fixture3, fixt3Trans]
  bg <- liftIO $ G.gegl_node_new_child (nodeMap M.! NodeRoot) $
    G.Operation "gegl:rectangle" $ props $ do
      prop "x" (0 :: Double)
      prop "y" (0 :: Double)
      prop "width" (800 :: Double)
      prop "height" (600 :: Double)
      prop "color" $ G.RGB 0.1 0.1 0.1
  bgOver <- liftIO $ G.gegl_node_new_child (nodeMap M.! NodeRoot) $
    G.Operation "gegl:over" []
  _ <- liftIO $ G.gegl_node_connect_to bg "output" bgOver "aux"
  let playerActor = Actor
        [ ActorProperty "image"
            (G.PropertyString "assets/pituicat.png")
            (Just (NodePlayer, "path"))
        , ActorProperty "x" (G.PropertyDouble 200) (Just (NodePlayerTrans, "x"))
        , ActorProperty "y" (G.PropertyDouble 400) (Just (NodePlayerTrans, "y"))
        , ActorProperty "reflectionx" (G.PropertyDouble 0) (Just (NodePlayerReflect, "x"))
        , ActorProperty "reflectiony" (G.PropertyDouble 0) (Just (NodePlayerReflect, "y"))
        , ActorProperty "rotation"    (G.PropertyDouble 0)
          (Just (NodePlayerRot, "degrees"))
        ]
        (M.fromList
          [ (NodePlayer, playerNode)
          , (NodePlayerOver, playerOver)
          , (NodePlayerTrans, playerTrans)
          , (NodePlayerScale, playerScale)
          , (NodePlayerReflect, playerReflect)
          , (NodePlayerRot, playerRot)
          ])
        playerOver
      idle = SpriteAnimation
        { sanimCurrentFrame  = 1
        , sanimSprites       = ["assets/pituicat.png"]
        , sanimFrameDuration = 0
        , sanimLoop          = True
        , sanimLastChange    = 0
        , sanimPropName      = "image"
        }
      slither = SpriteAnimation
        { sanimCurrentFrame  = 1
        , sanimSprites       =
            [ "assets/pituicat_slither_1.png"
            , "assets/pituicat_slither_2.png"
            ]
        , sanimFrameDuration = 0.25
        , sanimLoop          = True
        , sanimLastChange    = 0
        , sanimPropName      = "image"
        }
      box1Actor = Actor
        [ ActorProperty "x" (G.PropertyDouble 400) (Just (NodeBoxTrans, "x"))
        , ActorProperty "y" (G.PropertyDouble 100) (Just (NodeBoxTrans, "y"))
        , ActorProperty "rot" (G.PropertyDouble 0) (Just (NodeBoxRot, "degrees"))
        , ActorProperty "cx" (G.PropertyDouble 0) (Just (NodeBoxRot, "origin-x"))
        , ActorProperty "cy" (G.PropertyDouble 0) (Just (NodeBoxRot, "origin-y"))
        ]
        (M.fromList
          [ (NodeBox, box1Node)
          , (NodeBoxOver, box1Over)
          , (NodeBoxTrans, box1Trans)
          , (NodeBoxRot, box1Rot)
          ])
        box1Over
      box2Actor = Actor
        [ ActorProperty "x" (G.PropertyDouble 600) (Just (NodeBoxTrans, "x"))
        , ActorProperty "y" (G.PropertyDouble 100) (Just (NodeBoxTrans, "y"))
        , ActorProperty "rot" (G.PropertyDouble 0) (Just (NodeBoxRot, "degrees"))
        ]
        (M.fromList
          [ (NodeBox, box2Node)
          , (NodeBoxOver, box2Over)
          , (NodeBoxTrans, box2Trans)
          , (NodeBoxRot, box2Rot)
          ])
        box2Over
  liftIO $ G.gegl_node_link_many
    [bgOver
    , box1Over
    , box2Over
    , playerOver
    , fixtOver
    , fixt2Over
    , fixt3Over
    , nodeMap M.! NodeCrop
    ]
  putAffection sd
   { actorMap = M.fromList
        [ (ActorPlayer, playerActor)
        , (ActorBox1, box1Actor)
        , (ActorBox2, box2Actor)
        ]
    , animations = M.fromList
        [ (AnimSlither, slither)
        , (AnimIdle   , idle)
        ]
    , state = Test
    , pBodies = M.fromList
        [ (ActorPlayer,
          PhysicsBody
            { pbInvMass = 0.7
            , pbPos     = Vector 30 0
            , pbVel     = Vector 0 0
            , pbAcc     = Vector 0 0
            , pbRot     = 0
            , pbPitch   = 0
            , pbCenter  = Vector 32 32
            , pbImps    = []
            , pbColl    = CollisionCircle (Vector 32 32) 32
            , pbRest    = 0.5
            , pbFrictStat = 0
            , pbFrictDyn  = 0
            , pbKind    = CollisionBody Nothing
            })
        , (ActorBox1,
          PhysicsBody
            { pbInvMass = 0.5
            , pbPos     = Vector 400 100
            , pbVel     = Vector 0 0
            , pbAcc     = Vector 0 0
            , pbCenter  = Vector 0 0
            , pbRot     = 0
            , pbPitch   = 0
            , pbImps    = []
            , pbColl    = CollisionCircle (Vector 32 32) 32
            -- , pbColl    = CollisionBox (Vector 0 0) (Vector 64 64)
            , pbRest    = 0.5
            , pbFrictStat = 0.5
            , pbFrictDyn  = 0.4
            , pbKind    = CollisionActor []
            })
        , (ActorBox2,
          PhysicsBody
            { pbInvMass = 0.5
            , pbPos     = Vector 600 0
            , pbVel     = Vector 0 (-100)
            , pbAcc     = Vector 0 0
            , pbCenter  = Vector 32 32
            , pbRot     = 0
            , pbPitch   = 0
            , pbImps    = []
            , pbColl    = CollisionCircle (Vector 32 32) 32
            -- , pbColl    = CollisionBox (Vector 0 0) (Vector 64 64)
            , pbRest    = 0.5
            , pbFrictStat = 0.5
            , pbFrictDyn  = 0.4
            , pbKind    = CollisionActor []
            })
        , (ActorFixture,
          PhysicsBody
            { pbInvMass = 0
            , pbPos     = Vector 0 500
            , pbVel     = Vector 0 0
            , pbAcc     = Vector 0 0
            , pbCenter  = Vector 400 10
            , pbRot     = 0
            , pbPitch   = 0
            , pbImps    = []
            , pbColl    =
                CollisionUnion (map (\x -> CollisionCircle (Vector (x*20) 10) 10) [0..40])
            , pbRest    = 0.5
            , pbFrictStat = 0.5
            , pbFrictDyn  = 0.4
            , pbKind    = CollisionFixture
            })
        , (ActorFixture2,
          PhysicsBody
            { pbInvMass = 0
            , pbPos     = Vector 780 0
            , pbVel     = Vector 0 0
            , pbAcc     = Vector 0 0
            , pbCenter  = Vector 10 300
            , pbRot     = 0
            , pbPitch   = 0
            , pbImps    = []
            , pbColl    =
                CollisionUnion (map (\y -> CollisionCircle (Vector 10 (y*20)) 10) [0..30])
            , pbRest    = 0.5
            , pbFrictStat = 0.5
            , pbFrictDyn  = 0.4
            , pbKind    = CollisionFixture
            })
        , (ActorFixture3,
          PhysicsBody
            { pbInvMass = 0
            , pbPos     = Vector 0 0
            , pbVel     = Vector 0 0
            , pbAcc     = Vector 0 0
            , pbCenter  = Vector 10 300
            , pbRot     = 0
            , pbPitch   = 0
            , pbImps    = []
            , pbColl    =
                CollisionUnion (map (\y -> CollisionCircle (Vector 10 (y*20)) 10) [0..30])
            , pbRest    = 0.5
            , pbFrictStat = 0.5
            , pbFrictDyn  = 0.4
            , pbKind    = CollisionFixture
            })
        ]
    }

testUpdate :: Double -> Affection StateData ()
testUpdate dt = do
  sd <- getAffection
  mapM_ (`handleKeys` dt) (keysDown sd)
  sd2 <- getAffection
  if any (`elem` moveKeys) (keysDown sd2)
    then do
      (nanim, nact) <- runAnimation
        (actorMap sd2 M.! ActorPlayer)
        (animations sd2 M.! AnimSlither)
      putAffection sd2
        { animations = M.insert AnimSlither nanim (animations sd2)
        , updateActors = nact : updateActors sd2
        , actorMap = M.insert ActorPlayer nact (actorMap sd2)
        }
    else do
      (nanim, nact) <- runAnimation
        (actorMap sd2 M.! ActorPlayer)
        (animations sd2 M.! AnimIdle)
      putAffection sd2
        { animations = M.insert AnimIdle nanim (animations sd2)
        , updateActors = nact : updateActors sd2
        , actorMap = M.insert ActorPlayer nact (actorMap sd2)
        }
  -- debug "ran animatons"
  sdp <- getAffection
  now <- getElapsedTime
  let npb = updatePhysicsBodies (pBodies sdp) dt now
  -- debug $ show $ npb M.! ActorPlayer
  -- debug "physics bodies updated"
  let nmap = M.adjust (
        updateProperties $ props $ do
          prop "x" $ xComp (pbPos (pBodies sdp M.! ActorPlayer))
          prop "y" $ yComp (pbPos (pBodies sdp M.! ActorPlayer))
        ) ActorPlayer (actorMap sdp)
      nmap2 = M.adjust (
        updateProperties $ props $ do
          prop "x" $ xComp (pbPos (pBodies sdp M.! ActorBox1))
          prop "y" $ yComp (pbPos (pBodies sdp M.! ActorBox1))
          prop "rot" $ pbRot (pBodies sdp M.! ActorBox1)
          prop "cx" $ xComp (pbCenter (pBodies sdp M.! ActorBox1))
          prop "cy" $ yComp (pbCenter (pBodies sdp M.! ActorBox1))
        ) ActorBox1 nmap
      nmap3 = M.adjust (
        updateProperties $ props $ do
          prop "x" $ xComp (pbPos (pBodies sdp M.! ActorBox2))
          prop "y" $ yComp (pbPos (pBodies sdp M.! ActorBox2))
          prop "rot" $ pbRot (pBodies sdp M.! ActorBox2)
        ) ActorBox2 nmap
  putAffection sdp
    { actorMap = nmap2
    , updateActors = (nmap3 M.! ActorBox1) : (nmap3 M.! ActorBox2) : (nmap3 M.! ActorPlayer) : updateActors sdp
    , pBodies = npb
    }

testDraw :: Affection StateData ()
testDraw = do
  playerOrientation
  sd@StateData{..} <- getAffection
  mapM_ applyProperties $ reverse updateActors
  sd2 <- getAffection
  putAffection sd2
    { updateActors = []
    }

testHandle :: SDL.EventPayload -> Affection StateData ()
testHandle (SDL.WindowClosedEvent _) = do
  debug "ciao"
  quit

testHandle (SDL.KeyboardEvent dat) = unless (SDL.keyboardEventRepeat dat) $ do
  sd <- getAffection
  let key = SDL.keysymKeycode (SDL.keyboardEventKeysym dat)
  if key `notElem` specialKeys
  then
    if SDL.keyboardEventKeyMotion dat == SDL.Pressed
    then
      putAffection sd
        { keysDown =
            key : keysDown sd
        }
    else
      putAffection sd
        { keysDown =
            delete
            key
            (keysDown sd)
        }
  else
    if SDL.keyboardEventKeyMotion dat == SDL.Pressed
    then handleSpecial key
    else return ()

testHandle _ =
  return ()

handleKeys :: SDL.Keycode -> Double -> Affection StateData ()
handleKeys code dt
  | code == SDL.KeycodeA || code == SDL.KeycodeD = do
      sd <- getAffection
      now <- getElapsedTime
      -- debug "got globals"
      let npb =
            M.adjust (\body ->
              let vect = case code of
                    SDL.KeycodeA -> Vector (-10 * playerVelocity) 0
                    SDL.KeycodeD -> Vector (10 * playerVelocity) 0
                  imp = Impulse now 0.1 vect
              in
                if imp `notElem` pbImps body
                then
                  body
                    { pbImps = imp : pbImps body
                    }
                else
                  body
            ) ActorPlayer (pBodies sd)
          (G.PropertyDouble xscale) =
            fromJust $ getProperty "reflectionx" $ actorMap sd M.! ActorPlayer
          nmap = M.adjust (
            updateProperties $ props $
              prop "reflectiony" $
                case code of
                  SDL.KeycodeD -> 0 :: Double
                  SDL.KeycodeA -> 1 :: Double
                  _            -> error "This is impossible!"
            ) ActorPlayer (actorMap sd)
      putAffection sd
        { actorMap = nmap
        , updateActors = (nmap M.! ActorPlayer) : updateActors sd
        , pBodies = npb
        }
  | code == SDL.KeycodeW = do
      sd <- getAffection
      now <- getElapsedTime
      let npb =
            M.adjust (\body ->
              let vect = Vector 0 (-50 * 100)
                  imp = Impulse now 0 vect
              in
                if imp `notElem` pbImps body
                  && pbKind body /= CollisionBody Nothing
                then
                  body
                    { pbImps = imp : pbImps body
                    }
                else
                  body
            ) ActorPlayer (pBodies sd)
      putAffection sd
        { pBodies = npb
        }
  | otherwise = return ()

handleSpecial code
#ifdef DEBUG
  | code == SDL.KeycodeP = do
      ad <- get
      put ad
        { pausedTime = not $ pausedTime ad
        }
  | code == SDL.KeycodeT = do
      sd <- getAffection
      debug $ show $ pBodies sd M.! ActorPlayer
  | code == SDL.KeycodeF = do
      dt <- deltaTime <$> get
      debug (show (1 / dt) ++ " FPS")
#endif
  | code == SDL.KeycodeO =
      toggleScreen
  | code == SDL.KeycodeEscape = do
      debug "seeya!"
      quit
  | otherwise = return ()

playerOrientation :: Affection StateData ()
playerOrientation = do
  sd <- getAffection
  let (G.PropertyDouble yscale) =
        fromJust $ getProperty "reflectiony" $ actorMap sd M.! ActorPlayer
      nmap = M.adjust (
        updateProperties $ props $
          case pbKind (pBodies sd M.! ActorPlayer) of
            CollisionBody (Just b)
              | yComp (pbPos $ pBodies sd M.! b) >
                yComp (pbPos $ pBodies sd M.! ActorPlayer) ->
                  prop "rotation" (0 :: Double)
              | xComp (pbPos (pBodies sd M.! b) `vmin`
                pbPos (pBodies sd M.! ActorPlayer)) < 0    -> do
                  prop "reflectiony" (1 :: Double)
                  prop "rotation" (90 :: Double)
              | xComp (pbPos (pBodies sd M.! b) `vmin`
                pbPos (pBodies sd M.! ActorPlayer)) > 0    -> do
                  prop "reflectiony" (0 :: Double)
                  prop "rotation" (90 :: Double)
            CollisionBody Nothing  ->
              prop "rotation" (0 :: Double)
            _                      ->
              -- error "wrong CollisionKind for ActorPlayer"
              return ()
        ) ActorPlayer (actorMap sd)
  putAffection sd
    { actorMap = nmap
    , updateActors = (nmap M.! ActorPlayer) : updateActors sd
    }
