module Main where

import Control.Monad (forM_, when)
import Data.Bits
import Flirt as DD
import Graphics.UI.SDL as SDL
import Graphics.UI.SDL.Utilities as SDLU
import System.IO
import System.Environment
import System.Exit
import System.Posix (usleep)
import System.Time

width :: Int
width = 800

height :: Int
height = 600

-- Get current time in microseconds since EPOCH.
getMicroTime :: IO Integer
getMicroTime = do
  (TOD secs picosecs) <- getClockTime
  return $ secs * 1000000 + round ((fromInteger picosecs :: Double) / 1000000)

runSDL :: Surface -> Player -> Image -> IO ()
runSDL screen player image = do
  ret <- lockSurface screen
  when (not ret) (error "Couldn't lock the display surface")
  pixels <- surfaceGetPixels screen
  imageSetBuffer image pixels
  playerReadMovie player
  unlockSurface screen
  updateRect screen (SDL.Rect 0 0 width height)

  frameRate  <- playerGetFrameRate player
  lastUpdate <- getMicroTime
  playerStep player
  updateLoop (1000000.0 / frameRate) lastUpdate
 where
  updateLoop usecPerFrame lastUpd = do
    ret <- lockSurface screen
    when (not ret) (error "Couldn't lock the display surface")

    pixels <- surfaceGetPixels screen
    imageSetBuffer image pixels
    playerStep player
    whileTrue (playerExecuteFrameActions player StepFrame)
    rects <- playerUpdateDisplay player
    unlockSurface screen
    forM_ rects $ \(DD.Rect l r t b) -> do
      updateRect screen (SDL.Rect (l `shiftR` 10) (t `shiftR` 10) 
                         ((r - l) `shiftR` 10) ((b - t) `shiftR` 10))
    event <- pollEvent
    case event of
      MouseMotion   x y _ _ -> playerDoMouseMove player x y >> return ()
      MouseButtonDown x y _ -> playerDoMouseDown player x y
      MouseButtonUp   x y _ -> playerDoMouseUp player x y

      KeyUp   Keysym { symKey = k } -> playerDoKeyUp player (keyToIntegral k)
      KeyDown Keysym { symKey = k } -> do
        when (k == SDLK_ESCAPE) (exitWith ExitSuccess)
        playerDoKeyDown player (keyToIntegral k)

      Quit -> exitWith ExitSuccess
      _ -> return ()
    now <- getMicroTime
    let microDelay = lastUpd + round usecPerFrame - now
    if microDelay <= 0
      then updateLoop usecPerFrame now
      else do
        usleep (fromInteger microDelay)
        updateLoop usecPerFrame (now + microDelay)

  keyToIntegral = fromIntegral . SDLU.fromEnum
  whileTrue m = m >>= \x -> if x then whileTrue m else return x
  forever m   = m >> forever m

main :: IO ()
main = do
  args <- getArgs
  when (null args) $ do
    prog <- getProgName
    hPutStrLn stderr ("usage: " ++ prog ++ " <file>")
    exitFailure

  ok <- DD.init
  when (not ok) (error "dd_init() failed")

  image  <- DD.newImage width height
  player <- newPlayerFile (head args) image
  SDL.init [InitVideo, InitNoParachute]
  screen <- setVideoMode width height 32 [HWSurface]
  setActionTraceFunction player putStrLn -- DEBUG
  runSDL screen player image
  SDL.quit