module Main where

import Graphics.HGL
import Random(Random,randomRIO)
import Geometry

type State = Ship

data Ship = 
   Ship { pos    :: Point
        , vel    :: Point
        , ornt   :: Double
        , thrust :: Double
        , hAcc   :: Double } 

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

aDelta :: Double
aDelta = 1    

vMax :: Double
vMax = 20    

hDelta :: Double
hDelta = 0.3    

spaceShip :: [Point]
spaceShip = [(15, 0), (-15, 10), 
             (-10, 0), (-15, -10), (15, 0)]

initialState :: State
initialState = 
  Ship{ pos= (40, 40)
      , vel= (0, 0), ornt= -pi/2
      , thrust= 0, hAcc= 0}

moveShip :: Ship-> Ship
moveShip(Ship {pos= pos0, vel= vel0, 
               hAcc= hAcc, thrust= t, ornt= o}) = 
  Ship{ pos= addWinMod pos0 vel0
      , 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

-- Vektoraddition modulo Fenstergröße:
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 = drawShip s

drawShip :: Ship-> Graphic
drawShip s =
   withColor (if thrust s> 0 then Red else Blue) $
     polygon (map (add (pos s). rot (ornt s)) spaceShip) 

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

nextState :: [Event]-> State-> State
nextState evs s =
  moveShip (foldl (flip procEv) s evs)

getEvents :: Window-> IO [Event]
getEvents w =
  do x<- maybeGetWindowEvent w 
     case x of Nothing -> return []
               Just e  -> do rest <- getEvents w
                             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
procEv _ = id
sethAcc :: Double->State-> State
sethAcc a s = s{hAcc= a}
setThrust :: Double-> State-> State
setThrust a s = s{thrust= a}

main :: IO ()
main = runGraphics $
  do w<- openWindowEx "Space --- The Final Frontier" 
                      Nothing winSize DoubleBuffered
                      (Just 30)
     loop w initialState
     closeWindow w