module Snake where

import Util
import TypesConstants
import Graphics.Gloss.Interface.Pure.Game
    ( color,
      pictures,
      rectangleSolid,
      rectangleWire,
      scale,
      text,
      translate,
      play,
      polygon,
      Display(InWindow),
      Key(Char, SpecialKey),
      SpecialKey(KeyRight, KeyUp, KeyDown, KeyLeft, KeySpace),
      Event(EventKey, EventResize),
      KeyState(Up, Down),
      Picture )
import Graphics.Gloss.Data.Color as C
    ( black, dark, green, red, white, violet)
import Data.List
import System.Random ( mkStdGen, randomIO, Random(randomR))

initBoard :: Int -> Bool -> Board
initBoard s auto = Board {
res = (512, 512),
size = (32, 32), --scaled down by factor 16
snake = if auto then [(-10,4)] else [(-7,5),(-6,5),(-5,5),(-4,5)],
food = (0,1),
dir = L,
gameOver = False,
r = gen2,
currentFood = "$",
tumFoods = zip foods foodPosis,
started = False,
automatic = auto}
    where firstGen = mkStdGen s
          (foods, gen) = getNRandomElements firstGen allOps 11
          (foodPosisTemp, gen2) = getNRandomElements firstGen foodPositionsTUM2 10
          foodPosis = filter (`elem` foodPosisTemp) foodPositionsTUM2 ++ [(-7.0, 4.0)] --i know this is ugly, but this is a relly easy way to ensure the random elements keep the order from the original list

displayMode :: Bool-> Display
displayMode False = InWindow "python" (512,512) (0,0)
displayMode True = InWindow "python" (1024, 1024) (0,0)

--updates the Board according to the given event
eventHandler :: Event -> Board -> Board
eventHandler e@(EventKey (Char c) Up _ _) b = b
eventHandler e@(EventKey (Char c) Down _ _) b = keyHandler' c b
eventHandler e@(EventKey (SpecialKey k) Up _ _) b = b
eventHandler e@(EventKey (SpecialKey k) Down _ _) b = keyHandler k b
eventHandler (EventResize resize) b = b{res=resize, size=newSize}
    where newSize = mapTuple (ceiling . (/ 16.0) . fromIntegral) resize --needed because `div` rounds towards negInf, but i want to divison rounded towards posInf
eventHandler _ b = b

keyHandler :: SpecialKey -> Board -> Board
keyHandler KeySpace b = b{started=True}
keyHandler KeyUp b 
    | d == U || d == D = b
    | otherwise = b{dir=U}
    where d = dir b
keyHandler KeyDown b 
    | d == U || d == D = b
    | otherwise = b{dir=D}
    where d = dir b
keyHandler KeyLeft b
    | d == L || d == R = b
    | otherwise = b{dir=L}
    where d = dir b
keyHandler KeyRight b
    | d == L || d == R = b
    | otherwise = b{dir=R}
    where d = dir b
keyHandler _ b = b

keyHandler' :: Char -> Board -> Board
keyHandler' 'w' b = keyHandler KeyUp b
keyHandler' 's' b = keyHandler KeyDown b
keyHandler' 'a' b = keyHandler KeyLeft b
keyHandler' 'd' b = keyHandler KeyRight b
keyHandler' _ b = b

stepHandler :: Float -> Board -> Board
stepHandler _ b
    | not $ started b = b
    | gO = b{gameOver=True} 
    | foodEaten = b{snake=newSnake, food=foodPos, r=gen, currentFood = foodOp}
    | otherwise = b{snake=newSnake}
    where d = dir b
          snk = snake b
          (x, y) = head snk
          newSnakeHead 
            | d == U = (x, y+1)
            | d == D = (x, y-1)
            | d == L = (x-1, y)
            | otherwise = (x+1, y)
          foodEaten = food b == newSnakeHead
          newSnake = if foodEaten then newSnakeHead : snk else newSnakeHead : init snk
          (foodPos, foodOp, gen) = newFood b newSnake
          gO = checkGO newSnake b

stepHandlerAutomatic :: Float -> Board -> Board
stepHandlerAutomatic _ b
    | not $ started b = b
    | gO = b{gameOver=True} 
    | otherwise = b{snake=newSnake, dir = newDir, tumFoods = newFoods}
    where snk = snake b
          d = dir b
          (x, y) = head snk
          newSnakeHead 
            | d == U = (x, y+1)
            | d == D = (x, y-1)
            | d == L = (x-1, y)
            | otherwise = (x+1, y)
          newDir 
            | newSnakeHead `elem` rightTurnSpots = turn d 
            | newSnakeHead `elem` leftTurnSpots = turnLeft d 
            | otherwise = d
          newSnake = newSnakeHead : snk
          fds = tumFoods  b
          newFoods 
            | null fds = fds
            | otherwise = if snd (head fds) `elem` newSnake then tail fds else fds
          gO = checkGO newSnake b

{- MCCOMMENT 
    I know this stretches the task of creating something "visually appealing" by a lot,
    but it turned out my art skills are even worse than I orignally thought so I can't really offer more than this little "python" game.
    To make up for it (or at least try to do so) I created an automatic mode where you don't play the game yourself, but instead the python slithers around on it's own,
    creating a picture of the most beatiful thing I could think of.
    [oh and of course everything you see is created in haskell (using the gloss library) without the use of any external images etc]

    - Game description -
    The slow, loop-loving python slithers through the peaceful Haskell land all day, when suddenly, out of the bushes a small little $ appears.
    The imperative python instantly shivers with fear of all the functional power and elegance radiating from the innocent little Dollar sign, 
    so it tries to do the only thing it knows to protect itself: Try to eat the danger.
    But what it does not know is that Haskell has an seemingly endless supply of weird looking yet elegant operators just waiting to appear out of nowhere to confuse slow, imperative Programmers.

    Try to find your way around Haskell land, eating as much functional operators as you can.
    Try not to move too fast as our python is a little slow and may not react appropriately to very fast direction changes.

    - Art description -
    This Art piece shows the playful beauty of Haskell, while highlighting the importance of functional programming and it's origin at the same time.
    The first aspect is indicated by the fact that the piece lends it look from the famous game 'snake', which has been recreated by the artist using pure Haskell functions, whereas
    the latter is done by illustrating how the foundations of the most excellent organisation - the TUM itself - are built upon the power of 
    functional thinking and abstract logic like lambda calculus. 

    - Wettbewerb info - 
    [additional packages: the gloss package (I really hope the cabal stuff works),
     run: "stack run game",
     how to play: type to stdin whether you want to play yourself (see output on stdout), press space to start game,
     controls: arrow Keys | WASD,
     wettbwerb submission: video in .\art or https://mega.nz/file/1e5mFKiR#JAjCPRf1tvLKG0AGUsb1ksoNMFc72NQ7bojk56MRnm0 ,
     infos: everything visual is created using the gloss package (background is a combination of multiple polygons), 
            the foods are generated randomly (in the game and in automatic mode)
    ]

-}
main :: IO ()
main = do 
    putStrLn "Type a 'y' if you want to play yourself (and anything else to show automated game)"
    autoQuestion <- getChar
    randomSeed <- randomIO
    let auto = autoQuestion /= 'y'
    let world = initBoard randomSeed auto
    let handler = if auto then stepHandlerAutomatic else stepHandler
    let stepSpeed = if auto then 10 else 5
    let mode = displayMode auto

    play
        mode
        C.black
        stepSpeed
        world
        drawBoard
        eventHandler
        handler