module Main (main) where

import Asteroids.Geometry

import Graphics.HGL.Run (runGraphics)
import Graphics.HGL.Window (Event(..), RedrawMode(..), Window(), closeWindow, getWindowTick, maybeGetWindowEvent, openWindowEx, setGraphic)
import Graphics.HGL.Units (Point())
import Graphics.HGL.Utils (Color(..), drawInWindow, overGraphics, withColor)
import Graphics.HGL.Draw.Monad (Graphic())
import Graphics.HGL.Draw.Text (text)
import Graphics.HGL.Key (isControlLKey, isDownKey, isLeftKey, isRightKey, isUpKey)

-- to make ghc happy -- delete for hugs
fromInt :: Num a=> Int-> a
fromInt n = fromInteger (toInteger n)

data State = State { ship  :: Ship, bullets :: [Bullet], asteroids :: [Asteroid], game :: Game }

data Ship =
   Ship { pos    :: Point,
          shp    :: Shape,
          vel    :: Point,
          ornt   :: Double,
          thrust :: Double,
          hAcc   :: Double,
          bbox   :: BBox}
         deriving (Eq)

data Bullet =
   Bullet { posB :: Point,
            shpB :: Shape,
            velB :: Point,
            time :: Int,
            bboxb :: BBox}
           deriving (Eq)

data Asteroid =
  Asteroid { posA :: Point,
             shpA :: Shape,
             velA :: Point,
             size :: Int,
             bboxa :: BBox}
            deriving (Eq)

data Game = Over | Continue
  deriving (Eq)

type BBox = (Point, Point)

spaceShip :: Figure
spaceShip = Polygon [(10, 4), (-10, 10), (-15, 0), (-10, -10), (10, -4), (0, -4) , (0, 4), (10, 4)]

spaceShipBox :: BBox
spaceShipBox = ((-15, -15), (15, 15))

asteroid :: [Point]
asteroid = [(8, 0), (2, 6), (-6, 4), (-6, -4), (2, -6), (8, 0)]

asteroidBox :: BBox
asteroidBox = ((-8, -8), (8, 8))

asteroidS :: Figure
asteroidS = Polygon asteroid

asteroidM :: Figure
asteroidM = Polygon (map (\(x, y) -> (2*x, 2*y)) asteroid)

asteroidL :: Figure
asteroidL = Polygon (map (\(x, y) -> (4*x, 4*y)) asteroid)

asteroidList :: [Figure]
asteroidList = asteroidS:asteroidM:asteroidL:[]

bulletBox :: BBox
bulletBox = ((-2, -2), (2, 2))

bullet :: Figure
bullet = Polygon [(2, 0), (-1, -1), (-1, 1), (2, 0)]

winSize :: (Int, Int)
winSize = (1000, 800)

aDelta :: Double
aDelta = 1

vMax :: Double
vMax = 20

hDelta :: Double
hDelta = 0.3

maxBTime :: Int
maxBTime = 48

maxAsteroids :: Int
maxAsteroids = 6

minAstDir :: Double
minAstDir = (- pi)

maxAstDir :: Double
maxAstDir = pi

-- asteroidNumber :: IO Int
-- asteroidNumber = randomRIO (1, maxAsteroids)
asteroidNumber :: Int
asteroidNumber = maxAsteroids

-- asteroidDirection :: IO Double
-- asteroidDirection = randomRIO (minAstDir, maxAstDir)
asteroidDirection :: Double
asteroidDirection = 1.0

boxAsteroid :: Point -> Int -> BBox
boxAsteroid p s = translate (resize asteroidBox sze) p
  where sze = s + 1

translate :: BBox -> Point -> BBox
translate (a, b) c = (addWinMod a c, addWinMod b c)

resize :: BBox -> Int -> BBox
resize ((xa, ya), (xb, yb)) s = ((s * xa, s * ya), (s * xb, s * yb))

initialState :: State
initialState =
  State {ship= setShp $
     Ship{pos= shipPos, vel= (0, 0), ornt= pi/2,
          thrust= 0, hAcc= 0, bbox = translate spaceShipBox shipPos},
          bullets = [], asteroids =
          Asteroid{posA = ast1, velA = (1, 1),
          bboxa = boxAsteroid ast1 2,
          shpA = shape (Translate ast1 asteroidL), size = 2}:
          Asteroid{posA = ast2, velA = (1, -1),
          bboxa = boxAsteroid ast2 2,
          shpA = shape (Translate ast2 asteroidL), size = 2}:
          Asteroid{posA = ast3, velA = (-1, 1),
          bboxa = boxAsteroid ast3 2,
          shpA = shape (Translate ast3 asteroidL), size = 2}:
          Asteroid{posA = ast4, velA = (-1, -1),
          bboxa = boxAsteroid ast4 2,
          shpA = shape (Translate ast4 asteroidL), size = 2}:[],
          game = Continue}
            where
              minXP = 100
              minYP = 100
              maxXP = fst winSize - 100
              maxYP = snd winSize - 100
              ast1 = (minXP, minYP)
              ast2 = (minXP, maxYP)
              ast3 = (maxXP, minYP)
              ast4 = (maxXP, maxYP)
              shipPos = (fst winSize `div` 2, snd winSize `div` 2)

moveShip :: Ship-> Ship
moveShip(Ship {pos= pos0, vel= vel0, hAcc= hAcc, thrust= t, ornt= o}) =
  setShp $
    Ship{pos= addWinMod pos0 vel1,
         vel= if l> vMax then smult (vMax/l) vel1 else vel1,
         thrust= t, ornt= o+ hAcc, hAcc= hAcc} where
           vel1= add (polar t o) vel0
           l   = len vel1

setShp :: Ship-> Ship
setShp s = s{shp= shape (Translate (pos s)
                     (Rotate (ornt s) spaceShip)),
                     bbox = translate spaceShipBox (pos s)}

moveAsteroids :: [Asteroid] -> [Asteroid]
moveAsteroids [] = []
moveAsteroids (Asteroid{posA = pa, velA = va, size = s}:as) =
  Asteroid{posA = position, shpA = shape (Translate position (asteroidList !! s)),
  velA = va, size = s, bboxa = boxAsteroid position s}:(moveAsteroids as)
    where position = addWinMod pa va

moveBullets :: [Bullet] -> [Bullet]
moveBullets [] = []
moveBullets (Bullet{posB = pb, velB = vb, time = tb}:bs)
  | tb >= maxBTime = moveBullets bs
  | otherwise = Bullet{posB = position, shpB = shape (Translate position bullet),
      velB = vb, time = tb + 1, bboxb = translate bulletBox position}:(moveBullets bs)
        where position = addWinMod pb vb

addWinMod :: (Int,Int) -> (Int,Int) -> (Int,Int)
addWinMod (a, b) (c, d)=
  ((a+ c) `mod` (fst winSize),
   (b+ d) `mod` (snd winSize))

drawState :: State-> Graphic
drawState s = overGraphics
                ( drawShip (ship s):
                 (map drawBullet (bullets s))++
                 (map drawAsteroid (asteroids s)) )

drawShip :: Ship-> Graphic
drawShip s =
   withColor (if thrust s> 0 then Blue else if thrust s< 0 then Yellow else Green)
             (drawShape (shp s))

drawAsteroid :: Asteroid -> Graphic
drawAsteroid a = withColor White (drawShape (shpA a))

drawBullet :: Bullet -> Graphic
drawBullet b = withColor Red (drawShape (shpB b))

lostState :: State -> State
lostState st = st{game = Over} -- nicht komplett

wonState :: State -> State
wonState st = st{game = Over} -- auch nicht komplett

bounding :: BBox -> BBox -> Bool
bounding ((xa, ya), (xb, yb)) ((xc, yc), (xd, yd))
  | yd < ya || yc > yb || xd < xa || xc > xb = False
  | otherwise = True

checkIntersections :: State -> State
checkIntersections st@State{ship = s, asteroids = a, bullets = b}
  | a == [] = wonState st
  | or [intersect (shp s) x | Asteroid{shpA = x, bboxa = xa} <- a, bounding xa (bbox s)] = lostState st
  | otherwise = st{asteroids = (interSecAst intersecting) ++ [x | x <- a, not (elem x intersecting)],
    bullets = [bul | bul@Bullet{shpB = x} <- b,
    not (or [intersect x y | Asteroid{shpA = y} <- intersecting])]}
      where intersecting = [x | x@Asteroid{shpA = xa, bboxa = ya} <- a,
                            or [intersect xa xb| Bullet{shpB = xb, bboxb = yb} <- b,
                            bounding ya yb]]

interSecAst :: [Asteroid] -> [Asteroid]
interSecAst [] = []
interSecAst (a:as)
  | s == 0 = interSecAst as
  | otherwise = [Asteroid{posA = p, size = (s - 1),
    shpA = shape (Translate p (asteroidList !! (s - 1))),
    velA = rot (asteroidDirection + (pi - (fromInt (mod n (maxAsteroids + 1))))) (3 - s, 3 - s),
    bboxa = translate (resize asteroidBox (s + 1)) p} | n <- [1..asteroidNumber]] ++
    interSecAst as
      where
      s = (size a)
      p = (posA a)

loop :: Window-> State-> IO ()
loop w s =
  do setGraphic w (drawState s)
     getWindowTick w
     evs<- getEvs
     t <- nextState evs s
     loop w t
      where

--        gameOver :: State -> IO ()
--        gameOver s
--          | (game s) == Over =
--             do drawInWindow w (text (fst winSize `div` 2,  snd winSize `div` 2) "You lost!!!!")
--          | [(0::Int)| x <- (asteroids s)] == [] =
--             do drawInWindow w (text (fst winSize `div` 2, snd winSize `div` 2) "You won!")
--          | otherwise = loop w s

       nextState :: [Event]-> State-> IO State
       nextState evs t =
         do return $ checkIntersections s1{ship= moveShip (ship s1),
                      asteroids = moveAsteroids (asteroids s1),
                      bullets = moveBullets (bullets s1)}
           where
            s1= foldl (flip procEv) t evs

       getEvs :: IO [Event]
       getEvs = do x<- maybeGetWindowEvent w
                   case x of
                       Nothing -> return []
                       Just e  -> do rest <- getEvs
                                     return (e : rest)

       procEv :: Event-> State-> State
       procEv (Key {keysym= k, isDown=down})
        | isLeftKey k && down      = sethAcc hDelta
        | isLeftKey k && not down  = sethAcc 0
        | isRightKey k && down     = sethAcc (- hDelta)
        | isRightKey k && not down = sethAcc 0
        | isUpKey k && down        = setThrust aDelta
        | isUpKey k && not down    = setThrust 0
        | isDownKey k && down      = setThrust (- aDelta)
        | isDownKey k && not down  = setThrust 0
        | isControlLKey k && down  = shoot
       procEv _ = id

       sethAcc :: Double->State-> State
       sethAcc a t = s{ship= (ship t){hAcc= a}}

       setThrust :: Double-> State-> State
       setThrust a t = s{ship= (ship t){thrust= a}}

       shoot :: State -> State
       shoot t@State{ship = Ship{pos = pos0, ornt = r}, bullets = b} =
         t{bullets= b ++ [Bullet{time = 0, velB = speed,
          posB = pos0, shpB = shape (Translate (addWinMod pos0 speed) bullet),
          bboxb = translate bulletBox pos0}]}
            where speed = (rot r (round (1.5 * vMax), 0))

main :: IO ()
main = runGraphics $
  do w<- openWindowEx "Starshiptroopers II: Bugwars (ft. Spaceman Spiff)"
                      Nothing winSize DoubleBuffered
                      (Just 30)
     loop w initialState
     closeWindow w