haskelloids/src/InGame.hs
2017-12-20 04:58:24 +01:00

82 lines
2 KiB
Haskell

{-# LANGUAGE RecordWildCards #-}
module InGame where
import Affection as A
import qualified SDL
import qualified Data.Map as M
import Data.Maybe (catMaybes, isJust, fromJust, isNothing)
import Control.Monad (when, unless)
import Control.Monad.IO.Class (liftIO)
import System.Random (randomRIO)
import Linear
import Types
import Commons
import Menu
loadGame :: Affection UserData () -> Affection UserData ()
loadGame stateChange = do
liftIO $ logIO A.Debug "loading game"
ud <- getAffection
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 -> unless (msgKbdKeyRepeat kbdev) $ do
liftIO $ logIO Debug "Reloading"
putAffection ud
{ stateUUIDs = UUIDClean [] []
}
loadGame stateChange
SDL.KeycodeEscape -> do
liftIO $ logIO Debug "Leave to Menu"
stateChange
_ -> return ()
)
putAffection ud
{ stateUUIDs = UUIDClean [] [kid]
, haskelloids = nhs
, ship = (ship ud)
{ sPos = V2 400 300
, sVel = V2 0 0
, sRot = 0
}
, state = InGame
}
updateGame :: Double -> Affection UserData ()
updateGame sec = do
ud <- getAffection
let nhs = map (updateHaskelloid sec) (haskelloids ud)
putAffection ud
{ haskelloids = nhs
, ship = updateShip sec (ship ud)
}
updateShip :: Double -> Ship -> Ship
updateShip ddt s@Ship{..} = s
{ sPos = wrapAround (sPos + fmap (dt *) sVel) 40
}
where
dt = realToFrac ddt
drawGame :: Affection UserData ()
drawGame = do
ud <- getAffection
mapM_ drawHaskelloid (haskelloids ud)
drawShip (ship ud)
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