topkata-0.2.4: Main.hs

module Main (main) where

import qualified Graphics.UI.GLFW as GLFW
import qualified Topkata.CommandLineArgs as Args
import Graphics.Rendering.OpenGL ( ($=) )
import Data.IORef
import Control.Monad (unless)
import System.IO.Unsafe (unsafePerformIO)
import qualified Graphics.Rendering.OpenGL as GL
import Topkata.Render (render, mkRenderInfo, renderInit)
import Topkata.State 
import Topkata.Topka.Topka (animateTop)
import Topkata.Actions
import qualified Topkata.Keyboard as Keyboard
import Control.Concurrent(threadDelay)
import Graphics.Rendering.OpenGL as OpenGL

--windowMode True = GLFW.Window
--windowMode False = GLFW.FullScreen


simpleErrorCallback e s =
        putStrLn $ unwords [show e, show s]

initialize actionSlot windowOption = do
  GLFW.setErrorCallback $ Just simpleErrorCallback
  r <-  GLFW.init
  
  --check $ GLFW.openWindow (GL.Size 800 600) [] (windowMode windowOption)
  Just win <- GLFW.createWindow 800 600 "Topkata" Nothing Nothing
  GLFW.makeContextCurrent $ Just win
  --GLFW.setWindowTitle win "Topkata"
  GL.lighting $= GL.Enabled
  version <- OpenGL.get (OpenGL.majorMinor OpenGL.glVersion)
  putStrLn $ "version: " ++ show version
  renderInit
  version <- OpenGL.get (OpenGL.majorMinor OpenGL.glVersion)
  putStrLn $ "version: " ++ show version
  GLFW.setKeyCallback win  (Just $ Keyboard.callback actionSlot)
  GLFW.swapInterval 1
  return win

quitRef = unsafePerformIO $ newIORef False
{-# NOINLINE quitRef #-}


keyCallback (GLFW.Key'Escape) GLFW.KeyState'Pressed = writeIORef quitRef True
keyCallback _ _ = return ()


mainLoop win renderInfo actionSlot state = do
  render renderInfo state
  GLFW.swapBuffers win
  threadDelay 10
  GLFW.pollEvents
  r <- performRecordedActions actionSlot $ stTopka state
  case r of
    Left () -> return ()
    Right ts ->
        let state' = state { stTopka = ts } in
          mainLoop win renderInfo actionSlot $ animate state'

animate state = 
   state { stTopka = animateTop 10 (stTopka state) (stLaby state) }

main = do
  args <- Args.args
  state <- newState
  actionSlot <- newSlot
  win <- initialize actionSlot $ Args.windowOption args
  renderInfo <- mkRenderInfo state
  mainLoop win renderInfo actionSlot state
  GLFW.terminate