content: module Game.GameMain
      (gameMain) where
  
  import Data.List
  import Data.Maybe
  import Control.Monad.State
  import Data.IORef
  import qualified Graphics.UI.GLUT as Glut
  import World.World
  import Rain.Rain as Rain
  import Nxt.Types
  import Input.InputState as InputState
  import Panels.MainPanel
  -- import qualified Panels.MainPanel as MainPanel
  import Panels.ItemPanel
  import Settings.WorldSettings as WorldSettings
  import Settings.DisplaySettings as DisplaySettings
  import Settings.CatSettings as CatSettings
  import Data.Time.Clock
  import Cat.Cat
  import Items.Items
  import Items.ItemEffects
  import Level.Level
  import Level.FireHydrant
  import Level.EndMarker
  import Game.GameState
  import Nxt.Graphics
  
  -- gameMain
  gameMain :: IORef WorldState -> (IORef WorldState -> IO ()) -> IO ()
  gameMain worldStateRef mainCallback = do
      startTime <- getCurrentTime
  
      worldState <- readIORef worldStateRef
  
      let mainpanel = mainPanel worldState
  
      let lvl = curLevel worldState
          lvlData = levelData lvl
  
      -- get updated input
      let keysRef' = keysStateRef worldState
          mousePosRef' = mousePosRef worldState
      mousePos' <- readIORef (mousePosRef worldState)
      keys' <- readIORef (keysStateRef worldState)
      Glut.Size winW winH <- Glut.get Glut.windowSize
      let (mousex, mousey) = translateMousePos mousePos' winW winH
  
      -- update camera pos
      let (cameraX, cameraY) = cameraPos $ mainPanel worldState
          cameraX' 
            | leftKeyDown keys' && cameraX < 0.0 =
              cameraX + WorldSettings.cameraSpeed
            | rightKeyDown keys' &&
               cameraX >
                 (-(fromIntegral $ levelWidth lvl :: Double)) +
                   fromGLdouble screenResWidth
                    = cameraX - WorldSettings.cameraSpeed
            | otherwise = cameraX
          cameraY' 
             | upKeyDown keys' && cameraY > 0.0 =
               cameraY - WorldSettings.cameraSpeed
             | downKeyDown keys' &&
                 cameraY <
                   (fromIntegral $ levelHeight lvl :: Double) -
                     fromGLdouble screenResHeight
               = cameraY + WorldSettings.cameraSpeed
             | otherwise = cameraY
      -- update rain
      rain' <- updateRain worldState
  
      -- update go/stop state
      let goStopState' = if catItemName c == "Hurt" && (catItemDuration c == Just 1)
                            then GoState
                            else goStopState $ goStopButton $ itemPanel worldState
                         where c = cat mainpanel
  
      -- update go/stop button
      let goStopBtn = updateGoStopButton (goStopButton $ itemPanel worldState)
          goStopBtn' = if pointInRect (mousex, mousey) (goStopButtonRect goStopBtn) && lMouseDown keys'
                          then toggleGoStopButton goStopBtn
                          else goStopBtn {goStopState = goStopState'}
  
      let (cat', itemL) = updateCatAndItems goStopState' mainpanel keys' (cameraX', cameraY') (mousex, mousey) lvlData
          catUsedItems = itemList mainpanel \\ itemL
  
      -- update items
      (item', (itemList', corkList', tarpList'), placedItem, placingItem', erasedItems) <- updateItemList goStopState' worldState keys' (mousex, mousey) (cameraX', cameraY') itemL
  
      -- update item constraints
      let itemButList = itemButtonList $ itemPanel worldState
          itemButList' = execState (do
                                       -- placed an item in world
                                       iBL1 <- get
                                       put (if placedItem
                                               then map (\itemBut -> if itemName (itemButItem itemBut) == itemName item'
                                                                        then itemBut {itemButCount = itemButCount itemBut - 1}
                                                                        else itemBut) iBL1
                                               else iBL1)
  
                                       -- erased an item from world
                                       iBL2 <- get
                                       put (if not (null erasedItems)
                                               then foldr (\ersItemName -> map (\itemBut -> if itemName (itemButItem itemBut) == ersItemName
                                                                                                      then itemBut {itemButCount = itemButCount itemBut + 1}
                                                                                                      else itemBut))
                                                          iBL2 erasedItems
                                                else iBL2)
  
                                       -- cat used an item in world
                                       iBL3 <- get
                                       put (if not (null catUsedItems)
                                               then foldr (\usedItem -> map (\itemBut -> if itemName (itemButItem itemBut) == itemName usedItem
                                                                                                   then itemBut {itemButCount = itemButCount itemBut + 1}
                                                                                                   else itemBut))
                                                          iBL3 catUsedItems
                                               else iBL3)
  
                                       return ())
                                   itemButList
  
      -- update fire hydrants
      let _ = if catItemName cat' == "Wrench"
                 then foldr (\fh fhList -> if rectIntersect (catHitbox cat') (fireHydrantRect fh)
                                              then case fireHydrantDir fh of
                                                        DirLeft   -> if fst (catPos cat') > (rectX (fireHydrantRect fh) + rectWidth (fireHydrantRect fh))
                                                                        then (fh {fireHydrantDisabled = True}):fhList
                                                                        else fh:fhList
                                                        DirRight  -> if fst (catPos cat') < rectX (fireHydrantRect fh)
                                                                        then (fh {fireHydrantDisabled = True}):fhList
                                                                        else fh:fhList
                                              else fh:fhList)
                            [] (fireHydrants $ mainPanel worldState)
                 else fireHydrants $ mainPanel worldState
      let fireHydrants' = updateFireHydrants goStopState' cat' worldState
  
      -- update game state (menu, post victory)
      let gameState' 
            | escKeyDown keys' = MainMenuState
            | catItemName cat' == "Win" && (catItemDuration cat' == Just 1) =
              PostVictoryState
            | otherwise = GameRunningState
  
      -- update panels
      let mainPanel' = mainpanel {cameraPos = (cameraX', cameraY'), raindrops = rain', cat = cat', curItem = item',
                                  itemList = itemList', corkList = corkList', tarpList = tarpList',
                                  fireHydrants = fireHydrants', placingItem = placingItem'}
          itemPanel' = (itemPanel worldState) {itemButtonList = itemButList', goStopButton = goStopBtn'}
      messagePanel' <- updateMessagePanel worldState
  
      -- update world
      -- let lvl = curLevel worldState
      writeIORef worldStateRef (worldState {gameState = gameState', keysStateRef = keysRef', mousePosRef = mousePosRef', mainPanel = mainPanel', itemPanel = itemPanel', messagePanel = messagePanel'})
  
      Glut.postRedisplay Nothing
      endTime <- getCurrentTime
  
      let timeDiff = truncate (1000 * diffUTCTime endTime startTime)
          timeSleep = if timeDiff < refreshMS then refreshMS - timeDiff else 0
      --print timeDiff
  
      Glut.addTimerCallback timeSleep (mainCallback worldStateRef)
  
  -- updateFireHydrants
  updateFireHydrants :: GoStopState -> Cat -> WorldState -> [FireHydrant]
  updateFireHydrants GoState _ worldState =
      let enabledFHs = map (\fh -> fh {fireHydrantDisabled = False}) (fireHydrants $ mainPanel worldState)
          in map updateFireHydrant enabledFHs
  updateFireHydrants StopState theCat worldState =
      let fireHydrantsL = if catItemName theCat == "Wrench"
                             then foldr (\fh fhList -> if rectIntersect (catHitbox theCat) (fireHydrantRect fh)
                                                          then case fireHydrantDir fh of
                                                                    DirLeft   -> if fst (catPos theCat) > (rectX (fireHydrantRect fh) + rectWidth (fireHydrantRect fh))
                                                                                    then (fh {fireHydrantDisabled = True}):fhList
                                                                                    else fh:fhList
                                                                    DirRight  -> if fst (catPos theCat) < rectX (fireHydrantRect fh)
                                                                                    then (fh {fireHydrantDisabled = True}):fhList
                                                                                    else fh:fhList
                                                          else fh:fhList)
                                        [] (fireHydrants $ mainPanel worldState)
                             else fireHydrants $ mainPanel worldState
          in map updateFireHydrant fireHydrantsL
  
  -- updateItemList
  updateItemList :: GoStopState -> WorldState -> KeysState -> Vector2d -> Vector2d -> [Item] -> IO (Item, ([Item], [Item], [Item]), Bool, Maybe Item, [String])
  -- updateItemList (StopState)
  updateItemList StopState worldState _ _ _ itemL = do
      let mainpanel = mainPanel worldState
  
      posItem <- updateItem worldState
      -- Note: need to force evaluation of posItem to prevent lazy evaluation of it (causes memory leak!)
      let forceItemEval = posItem `seq` True
  
      return $ if forceItemEval
                  then (posItem, (itemL, corkList mainpanel, tarpList mainpanel), False, Nothing, [])
                  else (posItem, (itemL, corkList mainpanel, tarpList mainpanel), False, Nothing, [])
  -- updateItemList (GoState)
  updateItemList GoState worldState keys (mousex, mousey) (camerax, cameray) itemL = do
      let mainpanel = mainPanel worldState
      let itemButList = itemButtonList $ itemPanel worldState
  
      posItem <- updateItem worldState
      let tempItem = if lMouseDown keys then posItem else curItem mainpanel
      let item' = tempItem `seq` curItem mainpanel `seq` (if isNothing (placingItem mainpanel)
                     then tempItem
                    else curItem mainpanel)
                  {itemPos = (mousex - camerax - (fromIntegral $ textureWidth $ itemTexture tempItem :: Double) / 2.0,
                                              mousey - cameray - (fromIntegral $ textureHeight $ itemTexture tempItem :: Double) / 2.0)}
      let curItemIntersects = foldr ((||) . itemIntersects (curItem mainpanel))
                                  False itemL
                              ||
                                 foldr ((||) . itemIntersects (curItem mainpanel))
                                  False (corkList mainpanel)
                              ||
                                 foldr ((||) . itemIntersects (curItem mainpanel))
                                  False (tarpList mainpanel)
  
      -- remove any items if eraser was clicked on them
      let ((itemListE, corkListE, tarpListE)) = if rMouseDown keys
                                                   then (filter (not . itemIntersects (curItem mainpanel)) itemL,
                                                         filter (not . itemIntersects (curItem mainpanel)) (corkList mainpanel),
                                                         filter (not . itemIntersects (curItem mainpanel)) (tarpList mainpanel))
                                                   else (itemL, corkList mainpanel, tarpList mainpanel)
          erasedItems = (itemL \\ itemListE) ++ (corkList mainpanel \\ corkListE) ++ (tarpList mainpanel \\ tarpListE)
          erasedItemNames = map itemName erasedItems
  
      -- Note: need to force evaluation of item' to prevent lazy evaluation of it (causes memory leak!)
      let forceItemEval = item' `seq` True
  
      -- Make sure we have at least 1 item of this to use
      let itemCountValid = itemName item' /= "Eraser" &&
                              foldr (\itemBut countValid -> if itemName (itemButItem itemBut) == itemName item'
                                                                    then itemButCount itemBut > 0
                                                                    else countValid) True itemButList
  
      let placeItem = forceItemEval && lMousePrevDown keys && not (lMouseDown keys) && not curItemIntersects && mousex < maxWorldX && itemName item' /= "Eraser" && itemCountValid && isJust (placingItem mainpanel)
      let placingItem' 
            | placeItem || not (lMouseDown keys) = Nothing
            | lMouseDown keys && itemName item' /= "Eraser" && itemCountValid =
              if isJust (placingItem mainpanel) then placingItem mainpanel else
                Just item'
            | otherwise = Nothing
  
      -- placing new item in world
      let (itemList', corkList', tarpList') = if placeItem
                                                 then case itemName item' of
                                                           "Cork"    -> (itemListE, item':corkListE, tarpListE)
                                                           "Tarp"    -> (itemListE, corkListE, item':tarpListE)
                                                           "Eraser"  -> (itemListE, corkListE, tarpListE)
                                                           _         -> (item':itemListE, corkListE, tarpListE)
                                                 else (itemListE, corkListE, tarpListE)
  
      return (item', (itemList', corkList', tarpList'), placeItem, placingItem', erasedItemNames)
  
  -- updateCatAndItems
  updateCatAndItems :: GoStopState -> MainPanel -> KeysState -> (Double, Double) -> (Double, Double) -> LevelData -> (Cat, [Item])
  updateCatAndItems GoState mainpanel _ _ _ lvlData =
      let c = cat mainpanel
          -- catTex = catTexture c
          idleTex = head $ idleTextures $ catAnimations c
          walkTex = walkTextures $ catAnimations c
          catTex' = idleTex : walkTex
          in (c {catPos = (rectX $ levelCat lvlData, rectY $ levelCat lvlData),
                 catTexture = catTex', catDirection = DirRight,
                 catVelocity = (catWalkVelX, 0.0), catItemName = "NoItem",
                 catItemDuration = Nothing},
              itemList mainpanel)
  updateCatAndItems StopState mainpanel keys (cameraX, cameraY) (mousex, mousey) _ =
      let
          (catVelX, catVelY) = catVelocity $ cat mainpanel
          (catX, catY) = catPos $ cat mainpanel
          catdirection = catDirection $ cat mainpanel
          catrect = catHitbox $ cat mainpanel
          catpoly = catPoly $ cat mainpanel
          catitemname = catItemName $ cat mainpanel
  
          -- update cat and world surface collisions
          catTouchedRects = foldr (\rect touchedRects -> if rectIntersect rect catrect
                                                            then rect:touchedRects else touchedRects)
                                  [] (rectSurfaces mainpanel ++ corkRects)
                            where corkRects = map itemRect (corkList mainpanel)
          catTouchingPoly = foldr (\poly -> (polyIntersect poly catpoly ||))
                                  False (polySurfaces mainpanel)
          catTouchingSurface = not $ null catTouchedRects || catTouchingPoly
  
          -- update cat and puddle collisions
          catTouchingPuddle = foldr (\puddle -> (rectIntersect puddle catrect ||))
                                    False (puddles mainpanel)
  
          catBouncePogostick = catTouchingSurface && catitemname == "Pogostick"
          catFallUmbrella = not catTouchingSurface && catVelY < 0.0 &&
                            catitemname `elem` ["Umbrella", "FallUmbrella"]
          catUpsUmbrella = catitemname == "UpsUmbrellaActive" || (catTouchingPuddle && catitemname == "UpsUmbrella" && catVelY < 0.0)
  
          -- update cat pos, direction
          (catPos', catdirection') = foldr (\rect (pos, dir) -> catRectResponse pos (catVelX, catVelY) dir catrect rect)
                                           ((catX, catY), catdirection) catTouchedRects
  
          -- horizontal ground velocity
          dirNeg = case catdirection' of
                       DirLeft    -> -1
                       DirRight   -> 1
          groundVelX = case catitemname of
                           "SpeedBoots"   -> catSpeedVelX * dirNeg
                           "Skateboard"   -> catSkateVelX * dirNeg
                           "Hurt"         -> 0.0
                           "Win"         -> 0.0
                           _              -> catWalkVelX * dirNeg
  
          -- update cat velocity
          catVel' = execState (do
  
                                  -- gravity
                                  (velXg, velYg) <- get
                                  put (if catitemname `notElem` ["UpsUmbrellaActive", "Hurt", "Win"]
                                          then (velXg, velYg + gravity)
                                          else (velXg, velYg))
  
                                  -- touching rect surface
                                  (velXr, velYr) <- get
                                  put (if not $ null catTouchedRects
                                          then (groundVelX, 0.0)
                                          else (velXr, velYr))
  
                                  -- touching poly surface
                                  (velXp, velYp) <- get
                                  put (if catTouchingPoly
                                          then (groundVelX, 2.0)
                                          else (velXp, velYp))
  
                                  -- pogostick bounce
                                  (velXpb, velYpb) <- get
                                  put (if catBouncePogostick
                                          then (velXpb, -catVelY)
                                          else (velXpb, velYpb))
  
                                  return ())
                              (catVelocity $ cat mainpanel)
  
          -- see if cat got wet
          catTouchedPuddle = foldr (\puddle touchedPuddle -> if rectIntersect puddle catrect
                                                                then Just puddle
                                                                else touchedPuddle)
                                   Nothing (puddles mainpanel)
  
          catTouchingRain = foldr (\rain -> (rectIntersect (rainRect rain) catrect ||))
                                  False (raindrops mainpanel)
          catTouchedFireHydrant = foldr (\fh touchedFH -> if rectIntersect (fireHydrantRect fh) catrect
                                                             then Just fh
                                                             else touchedFH)
                                  Nothing (fireHydrants mainpanel)
  
          catWetFromRain = catTouchingRain &&
                              case catitemname of
                                        "Shield"          -> False
                                        "Poncho"          -> False
                                        "Umbrella"        -> False
                                        "FallUmbrella"    -> False
                                        _                 -> True
  
          catWetFromPuddle = isJust catTouchedPuddle &&
                                  case catitemname of
                                          "Shield"            -> False
                                          "UpsUmbrella"       -> False
                                          "UpsUmbrellaActive" -> False
                                          "RainBoots"         -> rectY catrect + rectHeight catrect < rectY (fromJust catTouchedPuddle) + rectHeight (fromJust catTouchedPuddle)
                                          "Skateboard"        -> rectY catrect + rectHeight catrect < rectY (fromJust catTouchedPuddle) + rectHeight (fromJust catTouchedPuddle)
                                          _                   -> True
  
          catWetFromFireHydrant = isJust catTouchedFireHydrant &&
                                      let fh = fromJust catTouchedFireHydrant
                                              in (not (fireHydrantDisabled fh || catitemname == "Shield") &&
                                                    (case fireHydrantDir fh of
                                                              DirLeft   -> if catitemname == "Poncho"
                                                                              then case catdirection of
                                                                                       DirLeft   -> False
                                                                                       _         -> rectX catrect + rectWidth catrect < rectX (fireHydrantRect fh) + rectWidth (fireHydrantRect fh) / 2.0
                                                                              else rectX catrect + rectWidth catrect < rectX (fireHydrantRect fh) + rectWidth (fireHydrantRect fh) / 2.0
                                                              DirRight  -> if catitemname == "Poncho"
                                                                              then case catdirection of
                                                                                        DirRight  -> False
                                                                                        _         -> rectX catrect + rectWidth catrect < rectX (fireHydrantRect fh) + rectWidth (fireHydrantRect fh)
                                                                              else rectX catrect + rectWidth catrect > rectX (fireHydrantRect fh) + 100))
  
          catIsWet = catWetFromPuddle || catWetFromRain || catWetFromFireHydrant
  
          -- reached end marker?
          catWin = rectIntersect catrect (endMarkerRect $ endMarker mainpanel)
  
          -- update cat item effects
          preEffect = execState (do
                                    e1 <- get
                                    put (if catBouncePogostick
                                            then pogostickEffect2
                                            else e1)
  
                                    e2 <- get
                                    put (if catFallUmbrella
                                            then fallUmbrellaEffect
                                            else e2)
  
                                    e3 <- get
                                    put (if catUpsUmbrella
                                            then upsUmbrellaEffect2
                                            else e3)
  
                                    e4 <- get
                                    put (if catIsWet
                                           then hurtEffect
                                           else e4)
  
                                    e5 <- get
                                    put (if catWin
                                            then winEffect
                                            else e5)
  
                                    return ()) noEffect
  
          (effect, itemL) = foldr (\item (prevEff, prevList) -> if rectIntersect (itemRect item) catrect && (itemName item `notElem` ["Cork", "Tarp"])
                                                                   then (itemEffect item, prevList)
                                                                   else (prevEff, item:prevList))
                                  (preEffect, []) (itemList mainpanel)
  
          -- update cat
          cat' = execState (do
                                -- apply position change
                                c1 <- get
                                put (updateCatPos c1 catPos')
  
                                -- apply velocity change
                                c2 <- get
                                put (updateCatVel c2 catVel')
  
                                -- apply direction change
                                c3 <- get
                                put (c3 {catDirection = catdirection'})
  
                                -- apply item effect
                                c4 <- get
                                put (effect c4)
  
                                -- update animation
                                c5 <- get
                                put (updateCatAnim c5)
  
                                -- revert back to walking from spring boots
                                c6 <- get
                                put (if (catItemName c6 == "SpringBoots") && catTouchingSurface && catVelY < 0
                                        then walkEffect c6
                                        else c6)
  
                                -- revert back to walking from pogostick bounce
                                c7 <- get
                                put (if (catItemName c7 == "Pogostick") && abs catVelY <= 1.0
                                        then walkEffect c7
                                        else c7)
  
                                -- revert back to walking from falling umbrella
                                c8 <- get
                                put (if (catItemName c8 == "FallUmbrella") && catTouchingSurface
                                        then walkEffect c8
                                        else c8)
  
                                -- revert back to walking from upsidedown umbrella
                                c9 <- get
                                put (if (catItemName c9 == "UpsUmbrellaActive") && not catTouchingPuddle
                                        then walkEffect c9
                                        else c9)
  
                                -- update item duration
                                c10 <- get
                                put (updateCatItemDuration c10)
  
                                -- teleport cat to mouse pos (DEBUG)
                                c11 <- get
                                put (if spaceKeyDown keys
                                        then updateCatPos c11 (mousex - cameraX, mousey - cameraY)
                                        else c11)
  
                                return ())
                           (cat mainpanel)
  
          in (cat', itemL)
  
  -- catRectResponse
  catRectResponse :: Vector2d -> Vector2d -> Direction -> Nxt.Types.Rect -> Nxt.Types.Rect -> (Vector2d, Direction)
  catRectResponse (catX, catY) (catVelX, catVelY) catDir (Rect catRX catRY catRW catRH) (Rect rectx recty rectwidth rectheight) =
      let displaceY = (recty + rectheight) - catY
          displaceDownY = (recty + rectheight) - (catRY + catRH)
          displaceX
            | catVelX < 0.0 = (rectx + rectwidth) - catRX
            | catVelX > 0.0 = rectx - (catRX + catRW)
            | otherwise = 0.0
          oppDir = case catDir of
                      DirLeft  -> DirRight
                      DirRight -> DirLeft
  
          in execState (do
                           -- vertical displacement
                           ((x1, y1), d1) <- get
                           put (if catVelY > 0.0
                                   then ((x1, y1 - displaceDownY), d1)
                                   else if abs displaceY < abs displaceX
                                           then ((x1, y1 + displaceY), d1)
                                           else ((x1, y1), d1))
  
                           -- horizontal displacement
                           ((x2, y2), d2) <- get
                           put (if (catRY + catRH < recty + rectheight && catRY >= recty) || (catRY < recty && catVelY <= 0.0)
                                   then ((x2 + displaceX, y2), oppDir)
                                   else ((x2, y2), d2))
  
                           return ()) ((catX, catY), catDir)
  
  