there's something out there...

This commit is contained in:
nek0 2017-12-21 00:56:16 +01:00
parent c25c34c24b
commit a12707d740
6 changed files with 133 additions and 40 deletions

View file

@ -4,41 +4,31 @@ module InGame where
import Affection as A import Affection as A
import qualified SDL import qualified SDL
import qualified Data.Map as M import qualified Data.Set as S
import Data.Maybe (catMaybes, isJust, fromJust, isNothing) import Data.Maybe (isNothing)
import Control.Monad (when, unless) import Control.Monad (when, unless)
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
import System.Random (randomRIO)
import Linear import Linear
import NanoVG hiding (V2(..))
import Types import Types
import Commons import Commons
import Menu
dVel :: Float
dVel = 100
dRot :: Float
dRot = 150
loadGame :: Affection UserData () -> Affection UserData () loadGame :: Affection UserData () -> Affection UserData ()
loadGame stateChange = do loadGame stateChange = do
liftIO $ logIO A.Debug "loading game" liftIO $ logIO A.Debug "loading game"
ud <- getAffection ud <- getAffection
nhs <- newHaskelloids nhs <- newHaskelloids
kid <- partSubscribe (subKeyboard $ subsystems ud) kid <- partSubscribe (subKeyboard $ subsystems ud) (handleGameKeys stateChange)
(\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 putAffection ud
{ stateUUIDs = UUIDClean [] [kid] { stateUUIDs = UUIDClean [] [kid]
, haskelloids = nhs , haskelloids = nhs
@ -47,9 +37,60 @@ loadGame stateChange = do
, sVel = V2 0 0 , sVel = V2 0 0
, sRot = 0 , sRot = 0
} }
, shots = []
, state = InGame , state = InGame
, wonlost = Nothing
} }
handleGameKeys :: Affection UserData () -> KeyboardMessage -> Affection UserData ()
handleGameKeys stateChange kbdev = when (msgKbdKeyMotion kbdev == SDL.Pressed) $
case SDL.keysymKeycode (msgKbdKeysym kbdev) of
SDL.KeycodeSpace -> unless (msgKbdKeyRepeat kbdev) $ do
liftIO $ logIO A.Debug "TODO: PEW!"
SDL.KeycodeR -> unless (msgKbdKeyRepeat kbdev) $ do
ud <- getAffection
liftIO $ logIO A.Debug "Reloading"
putAffection ud
{ stateUUIDs = UUIDClean [] []
}
loadGame stateChange
SDL.KeycodeEscape -> do
liftIO $ logIO A.Debug "Leave to Menu"
stateChange
SDL.KeycodeW -> accelShip dVel
SDL.KeycodeS -> accelShip (-dVel)
SDL.KeycodeA -> rotateShip dRot
SDL.KeycodeD -> rotateShip (-dRot)
_ -> return ()
accelShip :: Float -> Affection UserData ()
accelShip vel = do
ud <- getAffection
dt <- getDelta
let s = ship ud
nVel = sVel s + fmap (realToFrac dt *) ((V2 0 vel) `rotVec` sRot s)
putAffection ud
{ ship = s
{ sVel = nVel
}
}
rotateShip :: Float -> Affection UserData ()
rotateShip deg = do
ud <- getAffection
dt <- getDelta
putAffection ud
{ ship = (ship ud)
{ sRot = (sRot $ ship ud) - deg * realToFrac dt
}
}
rotVec :: (Num a, Floating a) => V2 a -> a -> V2 a
rotVec (V2 x y) deg = V2 nx ny
where
nx = x * (cos $ dtor deg) + y * (sin $ dtor deg)
ny = x * (sin $ dtor deg) - y * (cos $ dtor deg)
dtor = (pi / 180 *)
updateGame :: Double -> Affection UserData () updateGame :: Double -> Affection UserData ()
updateGame sec = do updateGame sec = do
@ -59,6 +100,27 @@ updateGame sec = do
{ haskelloids = nhs { haskelloids = nhs
, ship = updateShip sec (ship ud) , ship = updateShip sec (ship ud)
} }
ud2 <- getAffection
when
( ( any (checkCollision (ship ud2)) (haskelloids ud2)
|| any (checkFriendlyFire (ship ud2)) (shots ud2)
)
&& isNothing (wonlost ud2)
)
(putAffection ud2
{ wonlost = Just Lost
}
)
checkCollision :: Ship -> Haskelloid -> Bool
checkCollision s h =
distance (sPos s) (hPos h) < minDist
where
minDist = 20 + (50 / fromIntegral (hDiv h))
checkFriendlyFire :: Ship -> Pew -> Bool
checkFriendlyFire s p =
distance (sPos s) (pPos p) < 20
updateShip :: Double -> Ship -> Ship updateShip :: Double -> Ship -> Ship
updateShip ddt s@Ship{..} = s updateShip ddt s@Ship{..} = s
@ -71,7 +133,32 @@ drawGame :: Affection UserData ()
drawGame = do drawGame = do
ud <- getAffection ud <- getAffection
mapM_ drawHaskelloid (haskelloids ud) mapM_ drawHaskelloid (haskelloids ud)
drawShip (ship ud) case wonlost ud of
Just Lost -> liftIO $ do
let ctx = nano ud
save ctx
fontSize ctx 120
fontFace ctx "modulo"
textAlign ctx (S.fromList [AlignCenter,AlignTop])
fillColor ctx (rgba 255 255 255 255)
textBox ctx 0 200 800 "YOU LOST!"
fillColor ctx (rgba 255 128 0 255)
fontSize ctx 40
textBox ctx 0 350 800 "Press [Esc] to exit\nPress [R] to try again"
restore ctx
Just Won -> liftIO $ do
let ctx = nano ud
save ctx
fontSize ctx 120
fontFace ctx "modulo"
textAlign ctx (S.fromList [AlignCenter,AlignTop])
fillColor ctx (rgba 255 255 255 255)
textBox ctx 0 200 800 "YOU WON!"
fillColor ctx (rgba 255 128 0 255)
fontSize ctx 40
textBox ctx 0 350 800 "Press [Esc] to exit"
restore ctx
Nothing -> drawShip (ship ud)
drawShip :: Ship -> Affection UserData () drawShip :: Ship -> Affection UserData ()
drawShip Ship{..} = do drawShip Ship{..} = do

View file

@ -68,6 +68,7 @@ load = do
, sImg = fromJust mshipImage , sImg = fromJust mshipImage
} }
, haskelloids = [] , haskelloids = []
, shots = []
, wonlost = Nothing , wonlost = Nothing
, state = Menu , state = Menu
, fade = FadeIn 1 , fade = FadeIn 1

View file

@ -12,6 +12,7 @@ import Linear as L
import NanoVG hiding (V2(..), V4(..)) import NanoVG hiding (V2(..), V4(..))
import Control.Monad (when)
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
-- internal imports -- internal imports
@ -29,8 +30,8 @@ main = do
, windowTitle = "Haskelloids" , windowTitle = "Haskelloids"
, windowConfig = SDL.defaultWindow , windowConfig = SDL.defaultWindow
{ SDL.windowOpenGL = Just SDL.defaultOpenGL { SDL.windowOpenGL = Just SDL.defaultOpenGL
{ SDL.glProfile = SDL.Core SDL.Normal 3 0 { SDL.glProfile = SDL.Core SDL.Normal 3 2
, SDL.glColorPrecision = V4 0 8 8 8 -- , SDL.glColorPrecision = V4 0 8 8 8
} }
} }
, initScreenMode = SDL.Windowed , initScreenMode = SDL.Windowed
@ -54,6 +55,13 @@ pre = do
dw = floor $ (fromIntegral w - fromIntegral nw) / 2 dw = floor $ (fromIntegral w - fromIntegral nw) / 2
GL.viewport $= (GL.Position dw 0, GL.Size nw h) GL.viewport $= (GL.Position dw 0, GL.Size nw h)
_ -> return () _ -> return ()
_ <- partSubscribe (subKeyboard subs) $ \kbdev ->
when (msgKbdKeyMotion kbdev == SDL.Pressed) $
case SDL.keysymKeycode (msgKbdKeysym kbdev) of
SDL.KeycodeF -> do
dt <- getDelta
liftIO $ logIO A.Debug $ "FPS: " ++ show (1/dt)
_ -> return ()
return () return ()
update :: Double -> Affection UserData () update :: Double -> Affection UserData ()
@ -70,9 +78,9 @@ handle e = do
draw :: Affection UserData () draw :: Affection UserData ()
draw = do draw = do
ud <- getAffection ud <- getAffection
window <- drawWindow <$> get -- window <- drawWindow <$> get
pf <- liftIO $ SDL.getWindowPixelFormat window -- pf <- liftIO $ SDL.getWindowPixelFormat window
liftIO $ logIO A.Debug $ "Window pixel format: " ++ show pf -- liftIO $ logIO A.Debug $ "Window pixel format: " ++ show pf
liftIO $ beginFrame (nano ud) 800 600 (800/600) liftIO $ beginFrame (nano ud) 800 600 1
smDraw (state ud) smDraw (state ud)
liftIO $ endFrame (nano ud) liftIO $ endFrame (nano ud)

View file

@ -80,7 +80,7 @@ drawMenu = do
textAlign ctx (S.fromList [AlignCenter,AlignTop]) textAlign ctx (S.fromList [AlignCenter,AlignTop])
fillColor ctx (rgba 255 255 255 255) fillColor ctx (rgba 255 255 255 255)
textBox ctx 0 200 800 "HASKELLOIDS" textBox ctx 0 200 800 "HASKELLOIDS"
fillColor ctx (rgba 255 128 0 (alpha $ fade ud)) fillColor ctx (rgba 0 128 255 (alpha $ fade ud))
fontSize ctx 40 fontSize ctx 40
textBox ctx 0 350 800 "Press [Space] to Play\nPress [Esc] to exit" textBox ctx 0 350 800 "Press [Space] to Play\nPress [Esc] to exit"
restore ctx restore ctx

View file

@ -3,17 +3,8 @@
module StateMachine where module StateMachine where
import Affection import Affection
import qualified SDL
import qualified Data.Map as M
import Data.Maybe (catMaybes)
import Control.Monad (foldM, when)
import System.Random (randomRIO)
import Types import Types
import Commons
import InGame import InGame
import Menu import Menu

View file

@ -13,7 +13,7 @@ import Control.Monad.IO.Class (liftIO)
data UserData = UserData data UserData = UserData
{ ship :: Ship { ship :: Ship
, haskelloids :: [Haskelloid] , haskelloids :: [Haskelloid]
-- , shots :: ParticleSystem , shots :: [Pew]
-- , debris :: ParticleSystem -- , debris :: ParticleSystem
, wonlost :: Maybe WonLost , wonlost :: Maybe WonLost
, pixelSize :: Int , pixelSize :: Int
@ -33,6 +33,12 @@ data Ship = Ship
, sImg :: Image , sImg :: Image
} }
data Pew = Pew
{ pPos :: V2 Float
, pVel :: V2 Float
, pTTL :: Double
}
data Haskelloid = Haskelloid data Haskelloid = Haskelloid
{ hPos :: V2 Float { hPos :: V2 Float
, hVel :: V2 Float , hVel :: V2 Float
@ -44,7 +50,7 @@ data Haskelloid = Haskelloid
data State data State
= Menu = Menu
| HighScore -- | HighScore
| InGame | InGame
data MenuFade data MenuFade