haskelloids/src/InGame.hs

82 lines
1.9 KiB
Haskell
Raw Normal View History

2017-12-20 01:00:28 +00:00
{-# LANGUAGE RecordWildCards #-}
2016-12-31 16:01:24 +00:00
module InGame where
2017-12-20 01:00:28 +00:00
import Affection as A
2016-12-31 16:01:24 +00:00
import qualified SDL
import qualified Data.Map as M
2017-12-16 10:55:30 +00:00
import Data.Maybe (catMaybes, isJust, fromJust, isNothing)
2016-12-31 16:01:24 +00:00
2017-12-20 01:00:28 +00:00
import Control.Monad (when)
import Control.Monad.IO.Class (liftIO)
2017-01-03 16:34:37 +00:00
import System.Random (randomRIO)
2016-12-31 16:01:24 +00:00
2017-12-20 01:00:28 +00:00
import Linear
2016-12-31 16:01:24 +00:00
import Types
import Commons
2017-02-26 01:14:49 +00:00
import Menu
2016-12-31 16:01:24 +00:00
2017-12-20 01:00:28 +00:00
loadGame :: Affection UserData () -> Affection UserData ()
loadGame stateChange = do
liftIO $ logIO A.Debug "loading game"
2017-01-03 16:34:37 +00:00
ud <- getAffection
2017-12-20 01:00:28 +00:00
nhs <- newHaskelloids
kid <- partSubscribe (subKeyboard $ subsystems ud)
(\kbdev -> when (msgKbdKeyMotion kbdev == SDL.Pressed) $
case SDL.keysymKeycode (msgKbdKeysym kbdev) of
SDL.KeycodeSpace -> do
liftIO $ logIO Debug "TODO: PEW!"
SDL.KeycodeR -> do
liftIO $ logIO Debug "Reloading"
putAffection ud
{ stateUUIDs = UUIDClean [] []
}
loadGame stateChange
SDL.KeycodeEscape -> do
liftIO $ logIO Debug "Leave to Menu"
stateChange
_ -> return ()
)
2017-01-03 16:34:37 +00:00
putAffection ud
2017-12-20 01:00:28 +00:00
{ stateUUIDs = UUIDClean [] [kid]
, haskelloids = nhs
, ship = (ship ud)
{ sPos = V2 400 300
, sVel = V2 0 0
2017-01-03 16:34:37 +00:00
, sRot = 0
}
, state = InGame
}
updateGame :: Double -> Affection UserData ()
updateGame sec = do
ud <- getAffection
2017-12-20 01:00:28 +00:00
let nhs = map (updateHaskelloid sec) (haskelloids ud)
putAffection ud
2017-01-03 16:34:37 +00:00
{ haskelloids = nhs
2017-12-20 01:00:28 +00:00
, ship = updateShip sec (ship ud)
2017-01-03 16:34:37 +00:00
}
2017-12-20 01:00:28 +00:00
updateShip :: Double -> Ship -> Ship
updateShip ddt s@Ship{..} = s
{ sPos = wrapAround (sPos + fmap (dt *) sVel) 40
}
where
dt = realToFrac ddt
2017-01-12 17:48:23 +00:00
drawGame :: Affection UserData ()
drawGame = do
ud <- getAffection
2017-12-20 01:00:28 +00:00
mapM_ drawHaskelloid (haskelloids ud)
drawShip (ship ud)
2016-12-31 16:01:24 +00:00
2017-12-20 01:00:28 +00:00
drawShip :: Ship -> Affection UserData ()
drawShip Ship{..} = do
ctx <- nano <$> getAffection
liftIO $ drawImage ctx (sImg) (sPos - fmap (/2) dim) dim sRot 255
where
dim = V2 40 40