82 lines
2 KiB
Haskell
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
|