module Main where

import qualified GraphicsUtils as G
import GraphicsUtils hiding (Point, Angle)
import Geometry

-- import Debug.Trace
-- import IOExts(trace)

import Random(Random,randomRIO)  

data Car = Car { a   :: !Double
               , brake :: !Bool
               , phi :: !Angle   
               , w   :: !Angle
               , pos :: !Point
               , v   :: !Double
               } deriving (Show, Eq)

data State = State { car   :: !Car 
                   }

setCar :: (Car-> Car)-> State-> State
setCar f s = s {car= f (car s)}

initialState :: IO State
initialState = return (State {car= initialCar})

initialCar :: Car
initialCar = Car {a= 0, phi= 0, brake= False, w= 0, pos= (0, 0), v= 0}

atCar :: Car-> Figure-> Figure
atCar c = translate (pos c). rotate (w c)

carFigure :: Car-> Figure
carFigure c = atCar c $  
  poly $ map (add (-0.9, 0))
       [(-0.6, 0.4), (2.4, 0.4), (2.6, 0.2),
        (2.6, -0.2), (2.4,-0.4), (-0.6, -0.4)]


wheelsFig :: Car-> [Figure]
wheelsFig c = map (atCar c. translate (-0.9, 0)) $ 
  zipWith translate
    [(0, 0.6), (1.8, 0.6), (1.8, -0.6), (0, -0.6)]
    [r, rotate (phi c) r, rotate (phi c) r, r] where r =rect 1 0.4

wheelBase :: Dimension
wheelBase =  1.8

-- Acceleration
accMax :: Double 
accMax = 10  -- m/s^2

-- Brake acceleration
brakeAcc :: Double
brakeAcc = 50  -- m/s^2

-- Max. steering angle (60°)
phiMax :: Double
phiMax = pi/3

-- Max. velocity, 250 km/h
vMax :: Double
vMax = 250 * 10/36

-- One tick, 30 ms
deltaT :: Double
deltaT = 30/1000

-- Graphics parameters

-- size of the window
winX, winY :: Int
(winX, winY) = (1000, 800)

-- scale: how many pixels to one meter?
drawScale   :: Double  
drawScale   = 20

-- maximum X and Y value which still fit on the screen
maxX, maxY :: Double
maxX = fromInt (winX `div` 2) / drawScale -- 50, here
maxY = fromInt (winY `div` 2) / drawScale

moveCar :: Car-> Car
moveCar (Car {a= a, brake= brake, phi= phi, 
              w= w, pos= pos, v= v})
  | phi == 0  =
    let pos' = winMod (add pos (cart (Polar {angle= w, 
                                     dist= v* deltaT})))
    in  Car {a= a, brake= brake, phi= 0, w= w,
             pos= pos', v= v'}

  | otherwise = 
    let r    = wheelBase /tan phi -- Lenkradius
        wa   = w+ phi+ pi/2  -- Lenkwinkel
        m    = add (cart (Polar{angle= wa, dist= r})) pos    
                                        -- Lenkmittelpunkt
        zeta = v*deltaT / r -- Drehwinkel um m
        pos' = winMod (rotAround m zeta pos) -- neue Pos'n
        w'   = w+ zeta -- neue Orientierung
    in  Car {a= a, brake= brake, phi= phi, 
             w= w', pos= pos', v= v'}

    where v'= if brake then 
                 if v> 0 then max 0 (v- brakeAcc*deltaT)
                         else 0
              else if abs v <= vMax then v+ a*deltaT 
                                    else v           

-- refit point into window size
winMod :: Point-> Point
winMod (px, py) = (px `rMod` maxX, py `rMod` maxY) where
  rMod x m | abs x <= m = x
           | abs x >  m = if x > 0 then x- 2*m else 2*m -x
           
-- draw a figure with window size and scale as above
drawFig :: Figure-> Graphic
drawFig  = draw (winX `div` 2, winY `div` 2) drawScale

-- draw the state: first the car, then the speed
drawState :: State-> Graphic
drawState s = overGraphics $
  drawCar ++ 
  [text (10, winY-15) ("Speed: "++ show (3.6*v(car s)) ++ "km/h")] where
    drawCar = [withColor Red (drawFig (carFigure (car s)))] ++
              map (withRGB (RGB 50 50 50). drawFig) (wheelsFig (car s))

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

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

nextState :: [Event]-> State-> IO State
nextState evs s = return
  (setCar moveCar (foldl (flip procEv) s evs))

procEv :: Event-> State-> State
procEv (Key {keysym= k, isDown=down}) 
     | k `isKey` ' ' && down     = setBrake True
     | k `isKey` ' ' && not down = setBrake False
     | isUpKey k && down        = setAcc accMax
     | isUpKey k && not down    = setAcc 0
     | isDownKey k && down      = setAcc (- accMax)
     | isDownKey k && not down  = setAcc 0
procEv (Button{isLeft= True, isDown= True})  = setBrake True
procEv (Button{isLeft= True, isDown= False}) = setBrake False
procEv (MouseMove {pt= (x, y)}) = setAng (mouseToAngle x)
procEv _ = id

isKey :: Key-> Char-> Bool 
isKey k c = isCharKey k && keyToChar k == c

mouseToAngle :: Int-> Double
mouseToAngle x = 
  let x2= fromInt (winX `div` 2)
  in  asin ((fromInt x - x2) / x2)* phiMax / pi

setAng :: Double->State-> State
setAng a = setCar (\c-> c{phi= a})

setAcc :: Double-> State-> State
setAcc a = setCar (\c-> c{a= a})

setBrake :: Bool-> State-> State
setBrake b = setCar (\c-> c{brake= b})

main :: IO ()
main = runGraphics $
  do w<- openWindowEx "Haskell Racer!" Nothing 
           (winX, winY) DoubleBuffered (Just 30)
     i<- initialState
     loop w i
     closeWindow w