Raincat-1.1.1: src/Menu/Menu.hs
module Menu.Menu
(menuMain,
menuDraw,
howtoMain,
howtoDraw) where
import Graphics.Rendering.OpenGL as GL hiding (get)
import qualified Graphics.UI.GLUT as Glut
import Data.IORef
import Data.Time.Clock
import World.World
import Nxt.Graphics
import Nxt.Types
import Settings.DisplaySettings
import Game.GameState
import Input.InputState
import Control.Monad.State
import Level.Level
import Settings.Path
howtoRect :: Nxt.Types.Rect
backRect :: Nxt.Types.Rect
lvl1Rect :: Nxt.Types.Rect
lvl2Rect :: Nxt.Types.Rect
lvl3Rect :: Nxt.Types.Rect
lvl4Rect :: Nxt.Types.Rect
lvl5Rect :: Nxt.Types.Rect
lvl6Rect :: Nxt.Types.Rect
lvl7Rect :: Nxt.Types.Rect
lvl8Rect :: Nxt.Types.Rect
lvl9Rect :: Nxt.Types.Rect
howtoRect = Nxt.Types.Rect 690.0 470.0 200.0 60.0
backRect = Nxt.Types.Rect 785.0 626.0 200.0 60.0
lvl1Rect = Nxt.Types.Rect 543.0 245.0 90.0 90.0
lvl2Rect = Nxt.Types.Rect 649.0 245.0 90.0 90.0
lvl3Rect = Nxt.Types.Rect 753.0 245.0 90.0 90.0
lvl4Rect = Nxt.Types.Rect 543.0 140.0 90.0 90.0
lvl5Rect = Nxt.Types.Rect 649.0 140.0 90.0 90.0
lvl6Rect = Nxt.Types.Rect 753.0 140.0 90.0 90.0
lvl7Rect = Nxt.Types.Rect 543.0 37.0 90.0 90.0
lvl8Rect = Nxt.Types.Rect 649.0 37.0 90.0 90.0
lvl9Rect = Nxt.Types.Rect 753.0 37.0 90.0 90.0
-- menuMain
menuMain :: IORef WorldState -> (IORef WorldState -> IO ()) -> IO ()
menuMain worldStateRef mainCallback = do
dataPath <- getDataDir
startTime <- getCurrentTime
worldState <- readIORef worldStateRef
keys' <- readIORef (keysStateRef worldState)
Size winW winH <- Glut.get Glut.windowSize
mousePos <- readIORef (mousePosRef worldState)
let (mousex, mousey) = translateMousePos mousePos winW winH
let gameState' = if pointInRect (mousex, mousey) howtoRect && lMouseDown keys'
then HowtoMenuState
else MainMenuState
worldState' <- execStateT (do
-- level 1
w1 <- get
lvl1 <- if pointInRect (mousex, mousey) lvl1Rect && lMouseDown keys'
then liftIO $ loadLevel w1 (dataPath ++ "/data/levels/water1/water1.lvl")
else return w1
lvl1Bg <- if pointInRect (mousex, mousey) lvl1Rect && lMouseDown keys'
then liftIO $ loadLevelBackgrounds (dataPath ++ "/data/levels/water1/water1.lvl") (curLevel lvl1)
else return $ levelBackgrounds $ levelData $ curLevel lvl1
put (lvl1 {curLevel = (curLevel lvl1) {levelData = (levelData (curLevel lvl1)) {levelBackgrounds = lvl1Bg}}})
-- level 2
w2 <- get
lvl2 <- if pointInRect (mousex, mousey) lvl2Rect && lMouseDown keys'
then liftIO $ loadLevel w2 (dataPath ++ "/data/levels/movement1/movement1.lvl")
else return w2
lvl2Bg <- if pointInRect (mousex, mousey) lvl2Rect && lMouseDown keys'
then liftIO $ loadLevelBackgrounds (dataPath ++ "/data/levels/movement1/movement1.lvl") (curLevel lvl2)
else return $ levelBackgrounds $ levelData $ curLevel lvl2
put (lvl2 {curLevel = (curLevel lvl2) {levelData = (levelData (curLevel lvl2)) {levelBackgrounds = lvl2Bg}}})
-- level 3
w3 <- get
lvl3 <- if pointInRect (mousex, mousey) lvl3Rect && lMouseDown keys'
then liftIO $ loadLevel w3 (dataPath ++ "/data/levels/water2/water2.lvl")
else return w3
lvl3Bg <- if pointInRect (mousex, mousey) lvl3Rect && lMouseDown keys'
then liftIO $ loadLevelBackgrounds (dataPath ++ "/data/levels/water2/water2.lvl") (curLevel lvl3)
else return $ levelBackgrounds $ levelData $ curLevel lvl3
put (lvl3 {curLevel = (curLevel lvl3) {levelData = (levelData (curLevel lvl3)) {levelBackgrounds = lvl3Bg}}})
-- level 4
w4 <- get
lvl4 <- if pointInRect (mousex, mousey) lvl4Rect && lMouseDown keys'
then liftIO $ loadLevel w4 (dataPath ++ "/data/levels/movement2/movement2.lvl")
else return w4
lvl4Bg <- if pointInRect (mousex, mousey) lvl4Rect && lMouseDown keys'
then liftIO $ loadLevelBackgrounds (dataPath ++ "/data/levels/movement2/movement2.lvl") (curLevel lvl4)
else return $ levelBackgrounds $ levelData $ curLevel lvl4
put (lvl4 {curLevel = (curLevel lvl4) {levelData = (levelData (curLevel lvl4)) {levelBackgrounds = lvl4Bg}}})
-- level 5
w5 <- get
lvl5 <- if pointInRect (mousex, mousey) lvl5Rect && lMouseDown keys'
then liftIO $ loadLevel w5 (dataPath ++ "/data/levels/pool/pool.lvl")
else return w5
lvl5Bg <- if pointInRect (mousex, mousey) lvl5Rect && lMouseDown keys'
then liftIO $ loadLevelBackgrounds (dataPath ++ "/data/levels/pool/pool.lvl") (curLevel lvl5)
else return $ levelBackgrounds $ levelData $ curLevel lvl5
put (lvl5 {curLevel = (curLevel lvl5) {levelData = (levelData (curLevel lvl5)) {levelBackgrounds = lvl5Bg}}})
-- level 6
w6 <- get
lvl6 <- if pointInRect (mousex, mousey) lvl6Rect && lMouseDown keys'
then liftIO $ loadLevel w6 (dataPath ++ "/data/levels/rift/rift.lvl")
else return w6
lvl6Bg <- if pointInRect (mousex, mousey) lvl6Rect && lMouseDown keys'
then liftIO $ loadLevelBackgrounds (dataPath ++ "/data/levels/rift/rift.lvl") (curLevel lvl6)
else return $ levelBackgrounds $ levelData $ curLevel lvl6
put (lvl6 {curLevel = (curLevel lvl6) {levelData = (levelData (curLevel lvl6)) {levelBackgrounds = lvl6Bg}}})
-- level 7
w7 <- get
lvl7 <- if pointInRect (mousex, mousey) lvl7Rect && lMouseDown keys'
then liftIO $ loadLevel w7 (dataPath ++ "/data/levels/skyline/skyline.lvl")
else return w7
lvl7Bg <- if pointInRect (mousex, mousey) lvl7Rect && lMouseDown keys'
then liftIO $ loadLevelBackgrounds (dataPath ++ "/data/levels/skyline/skyline.lvl") (curLevel lvl7)
else return $ levelBackgrounds $ levelData $ curLevel lvl7
put (lvl7 {curLevel = (curLevel lvl7) {levelData = (levelData (curLevel lvl7)) {levelBackgrounds = lvl7Bg}}})
-- level 8
w8 <- get
lvl8 <- if pointInRect (mousex, mousey) lvl8Rect && lMouseDown keys'
then liftIO $ loadLevel w8 (dataPath ++ "/data/levels/river/river.lvl")
else return w8
lvl8Bg <- if pointInRect (mousex, mousey) lvl8Rect && lMouseDown keys'
then liftIO $ loadLevelBackgrounds (dataPath ++ "/data/levels/river/river.lvl") (curLevel lvl8)
else return $ levelBackgrounds $ levelData $ curLevel lvl8
put (lvl8 {curLevel = (curLevel lvl8) {levelData = (levelData (curLevel lvl8)) {levelBackgrounds = lvl8Bg}}})
-- level 9
w9 <- get
lvl9 <- if pointInRect (mousex, mousey) lvl9Rect && lMouseDown keys'
then liftIO $ loadLevel w9 (dataPath ++ "/data/levels/pinball/pinball.lvl")
else return w9
lvl9Bg <- if pointInRect (mousex, mousey) lvl9Rect && lMouseDown keys'
then liftIO $ loadLevelBackgrounds (dataPath ++ "/data/levels/pinball/pinball.lvl") (curLevel lvl9)
else return $ levelBackgrounds $ levelData $ curLevel lvl9
put (lvl9 {curLevel = (curLevel lvl9) {levelData = (levelData (curLevel lvl9)) {levelBackgrounds = lvl9Bg}}})
return ())
(worldState {gameState = gameState'})
writeIORef worldStateRef worldState'
Glut.postRedisplay Nothing
endTime <- getCurrentTime
let timeDiff = truncate (1000 * diffUTCTime endTime startTime)
timeSleep = if timeDiff < refreshMS then refreshMS - timeDiff else 0
Glut.addTimerCallback timeSleep (mainCallback worldStateRef)
-- menuDraw
menuDraw :: IORef WorldState -> IO ()
menuDraw worldStateRef = do
worldState <- readIORef worldStateRef
Nxt.Graphics.begin
Nxt.Graphics.drawTexture 0.0 0.0 (fst $ menuTextures worldState) (1.0::GLdouble)
{-Nxt.Graphics.drawRect howtoRect (Color4 0.0 1.0 1.0 0.5)
Nxt.Graphics.drawRect lvl1Rect (Color4 0.0 1.0 1.0 0.5)
Nxt.Graphics.drawRect lvl2Rect (Color4 0.0 1.0 1.0 0.5)
Nxt.Graphics.drawRect lvl3Rect (Color4 0.0 1.0 1.0 0.5)
Nxt.Graphics.drawRect lvl4Rect (Color4 0.0 1.0 1.0 0.5)
Nxt.Graphics.drawRect lvl5Rect (Color4 0.0 1.0 1.0 0.5)
Nxt.Graphics.drawRect lvl6Rect (Color4 0.0 1.0 1.0 0.5)
Nxt.Graphics.drawRect lvl7Rect (Color4 0.0 1.0 1.0 0.5)
Nxt.Graphics.drawRect lvl8Rect (Color4 0.0 1.0 1.0 0.5)
Nxt.Graphics.drawRect lvl9Rect (Color4 0.0 1.0 1.0 0.5)-}
-- mouse cursor position
{-mousePos <- readIORef (mousePosRef worldState)
let mousex = mouseX mousePos
let mousey = mouseY mousePos
Nxt.Graphics.drawString 10.0 740.0 ("Mouse Pos: (" ++ (show mousex) ++ ", " ++ (show mousey) ++ ")") (Color4 0.7 0.7 0.7 1.0)-}
Nxt.Graphics.end
-- howtoMain
howtoMain :: IORef WorldState -> (IORef WorldState -> IO ()) -> IO ()
howtoMain worldStateRef mainCallback = do
startTime <- getCurrentTime
worldState <- readIORef worldStateRef
keys' <- readIORef (keysStateRef worldState)
Size winW winH <- Glut.get Glut.windowSize
mousePos <- readIORef (mousePosRef worldState)
let (mousex, mousey) = translateMousePos mousePos winW winH
let gameState' = if pointInRect (mousex, mousey) backRect && lMouseDown keys'
then MainMenuState
else HowtoMenuState
writeIORef worldStateRef (worldState {gameState = gameState'})
Glut.postRedisplay Nothing
endTime <- getCurrentTime
let timeDiff = truncate (1000 * diffUTCTime endTime startTime)
timeSleep = if timeDiff < refreshMS then refreshMS - timeDiff else 0
Glut.addTimerCallback timeSleep (mainCallback worldStateRef)
-- howtoDraw
howtoDraw :: IORef WorldState -> IO ()
howtoDraw worldStateRef = do
worldState <- readIORef worldStateRef
Nxt.Graphics.begin
Nxt.Graphics.drawTexture 0.0 0.0 (snd $ menuTextures worldState) (1.0::GLdouble)
--Nxt.Graphics.drawRect backRect (Color4 0.0 1.0 1.0 0.5)
-- mouse cursor position
{-mousePos <- readIORef (mousePosRef worldState)
let mousex = mouseX mousePos
let mousey = mouseY mousePos
Nxt.Graphics.drawString 10.0 740.0 ("Mouse Pos: (" ++ (show mousex) ++ ", " ++ (show mousey) ++ ")") (Color4 0.7 0.7 0.7 1.0)-}
Nxt.Graphics.end