{-# LANGUAGE BangPatterns, PatternGuards #-}
import World
import Trace
import Light
import Object
import Vec3
import System.Environment
import qualified Graphics.Gloss                         as G
import qualified Graphics.Gloss.Interface.Pure.Game     as G
import qualified Graphics.Gloss.Raster.Field            as G

main :: IO ()
main 
 = do   args    <- getArgs
        case args of
         []     -> run 800 600 4 100 4

         [sizeX, sizeY, zoom, fov, bounces]
                -> run (read sizeX) (read sizeY) (read zoom) (read fov) (read bounces)

         _ -> putStr $ unlines
           [ "trace <sizeX::Int> <sizeY::Int> <zoom::Int> (fov::Int) (bounces::Int)"
           , "    sizeX, sizeY - visualisation size        (default 800, 600)"
           , "    zoom         - pixel replication factor  (default 4)"
           , "    fov          - field of view             (default 100)"
           , "    bounces      - ray bounce limit          (default 4)"
           , ""
           , " You'll want to run this with +RTS -N to enable threads" ]
   

-- | World and interface state.
data State
        = State
        { stateTime             :: !Float 
        , stateEyePos           :: !Vec3
        , stateEyeLoc           :: !Vec3

        , stateLeftClick        :: !(Maybe G.Point)

        , stateMoveSpeed        :: !Float
        , stateMovingForward    :: !Bool
        , stateMovingBackward   :: !Bool
        , stateMovingLeft       :: !Bool
        , stateMovingRight      :: !Bool

        , stateObjects          :: ![Object]
        , stateObjectsView      :: ![Object]

        , stateLights           :: ![Light]
        , stateLightsView       :: ![Light] }

        deriving (Eq, Show)


-- | Initial world and interface state.
initState :: State
initState
        = State
        { stateTime             = 0
        , stateEyePos           = Vec3 50    (-100) (-700)
        , stateEyeLoc           = Vec3 (-50) 200   1296

        , stateLeftClick        = Nothing 

        , stateMoveSpeed        = 400
        , stateMovingForward    = False
        , stateMovingBackward   = False
        , stateMovingLeft       = False
        , stateMovingRight      = False

        , stateObjects          = makeObjects 0
        , stateObjectsView      = makeObjects 0

        , stateLights           = makeLights  0
        , stateLightsView       = makeLights  0 }


-- | Run the game.
run :: Int -> Int -> Int -> Int -> Int -> IO ()                     
run sizeX sizeY zoom fov bounces
 = G.playField 
        (G.InWindow "Ray" (sizeX, sizeY) (10, 10))
        (zoom, zoom)
        100
        initState
        (tracePixel sizeX sizeY fov bounces)
        handleEvent
        advanceState
{-# NOINLINE run #-}


-- | Render a single pixel of the image.
tracePixel :: Int -> Int -> Int -> Int -> State -> G.Point -> G.Color
tracePixel !sizeX !sizeY !fov !bounces !state (x, y)
 = let  !sizeX'  = fromIntegral sizeX
        !sizeY'  = fromIntegral sizeY
        !aspect  = sizeX' / sizeY'
        !fov'    = fromIntegral fov
        !fovX    = fov' * aspect
        !fovY    = fov'
       
        !ambient = Vec3 0.3 0.3 0.3
        !eyePos  = stateEyePos state
        !eyeDir  = normaliseV3 ((Vec3 (x * fovX) ((-y) * fovY) 0) - eyePos)

        Vec3 r g b
          = traceRay    (stateObjectsView state) 
                        (stateLightsView  state) ambient
                        eyePos eyeDir
                        bounces

   in   G.rawColor r g b 1.0
{-# INLINE tracePixel #-}


-- | Handle an event from the user interface.
handleEvent :: G.Event -> State -> State
handleEvent event state 
        -- Start translation.
        | G.EventKey (G.MouseButton G.LeftButton) 
                     G.Down _ (x, y) <- event
        = state { stateLeftClick = Just (x, y)}

        -- End transation.
        | G.EventKey (G.MouseButton G.LeftButton) 
                     G.Up _ _ <- event
        = state { stateLeftClick = Nothing }

        -- Moving forward
        | G.EventKey (G.Char 'w') G.Down _ _        <- event
        = state { stateMovingForward  = True }

        | G.EventKey (G.Char 'w') G.Up   _ _        <- event
        = state { stateMovingForward  = False }

        -- Moving backward
        | G.EventKey (G.Char 's') G.Down _ _        <- event
        = state { stateMovingBackward = True }

        | G.EventKey (G.Char 's') G.Up   _ _        <- event
        = state { stateMovingBackward = False }

        -- Moving left
        | G.EventKey (G.Char 'a') G.Down _ _        <- event
        = state { stateMovingLeft = True }

        | G.EventKey (G.Char 'a') G.Up   _ _        <- event
        = state { stateMovingLeft = False }

        -- Moving right
        | G.EventKey (G.Char 'd') G.Down _ _        <- event
        = state { stateMovingRight = True }

        | G.EventKey (G.Char 'd') G.Up   _ _        <- event
        = state { stateMovingRight = False }

        -- Translate the world.
        | G.EventMotion (x, y)  <- event
        , Just (oX, oY)         <- stateLeftClick state
        , Vec3 eyeX eyeY eyeZ   <- stateEyeLoc    state
        = let   eyeX'   = eyeX + (x - oX)
                eyeY'   = eyeY
                eyeZ'   = eyeZ + (y - oY)

          in    setEyeLoc (Vec3 eyeX' eyeY' eyeZ')
                 $ state { stateLeftClick  = Just (x, y) }
        
        | otherwise
        = state
{-# NOINLINE handleEvent #-}


-- | Advance the world forward in time.
advanceState :: Float -> State -> State
advanceState advTime state
 = let  time'   = stateTime state + advTime

        speed   = stateMoveSpeed state
        move    = (if stateMovingForward state 
                        then moveEyeLoc (Vec3 0 0 (-speed * advTime))
                        else id)
                . (if stateMovingBackward state
                        then moveEyeLoc (Vec3 0 0 (speed * advTime))
                        else id)
                . (if stateMovingLeft state
                        then moveEyeLoc (Vec3 (speed * advTime) 0 0)
                        else id)
                . (if stateMovingRight state
                        then moveEyeLoc (Vec3 (-speed * advTime) 0 0)
                        else id)

   in   setTime time' $ move state
{-# NOINLINE advanceState #-}


-- | Set the location of the eye.
setEyeLoc :: Vec3 -> State -> State
setEyeLoc eyeLoc state
 = let  objects = makeObjects (stateTime state)
        lights  = makeLights  (stateTime state)
   in state 
        { stateEyeLoc           = eyeLoc
        , stateObjectsView      = map (translateObject (stateEyeLoc state)) objects
        , stateLightsView       = map (translateLight  (stateEyeLoc state)) lights 
        }
{-# NOINLINE setEyeLoc #-}


moveEyeLoc :: Vec3 -> State -> State
moveEyeLoc v state
 = let  objects = stateObjects state
        lights  = stateLights  state
        eyeLoc  = stateEyeLoc  state + v
   in state
        { stateEyeLoc           = eyeLoc
        , stateObjectsView      = map (translateObject eyeLoc) objects
        , stateLightsView       = map (translateLight  eyeLoc) lights
        }
{-# NOINLINE moveEyeLoc #-}


-- | Set the time of the world.
setTime   :: Float -> State -> State
setTime time state
 = let  objects = makeObjects time
        lights  = makeLights  time
   in state 
        { stateTime             = time
        , stateObjects          = objects
        , stateObjectsView      = map (translateObject (stateEyeLoc state)) objects

        , stateLights           = lights
        , stateLightsView       = map (translateLight  (stateEyeLoc state)) lights 
        }
{-# NOINLINE setTime #-}