diff --git a/assets/haskelloid.png b/assets/haskelloid.png index f633deb..a4b7813 100644 Binary files a/assets/haskelloid.png and b/assets/haskelloid.png differ diff --git a/src/InGame.hs b/src/InGame.hs index 1815bd9..1eefe50 100644 --- a/src/InGame.hs +++ b/src/InGame.hs @@ -5,30 +5,40 @@ import Affection as A import qualified SDL import qualified Data.Set as S -import Data.Maybe (isNothing) +import Data.Maybe (isNothing, catMaybes) import Control.Monad (when, unless) import Control.Monad.IO.Class (liftIO) +import System.Random (randomRIO) + import Linear import NanoVG hiding (V2(..)) +import Foreign.C.Types (CFloat(..)) + import Types import Commons dVel :: Float dVel = 100 +pewVel :: Float +pewVel = 200 + +pewTTL :: Double +pewTTL = 10 + dRot :: Float dRot = 150 -loadGame :: Affection UserData () -> Affection UserData () -loadGame stateChange = do +loadGame :: Affection UserData () -> Affection UserData () -> Affection UserData () +loadGame stateChange clean = do liftIO $ logIO A.Debug "loading game" ud <- getAffection nhs <- newHaskelloids - kid <- partSubscribe (subKeyboard $ subsystems ud) (handleGameKeys stateChange) + kid <- partSubscribe (subKeyboard $ subsystems ud) (handleGameKeys stateChange clean) putAffection ud { stateUUIDs = UUIDClean [] [kid] , haskelloids = nhs @@ -42,18 +52,17 @@ loadGame stateChange = do , wonlost = Nothing } -handleGameKeys :: Affection UserData () -> KeyboardMessage -> Affection UserData () -handleGameKeys stateChange kbdev = when (msgKbdKeyMotion kbdev == SDL.Pressed) $ +handleGameKeys :: Affection UserData () -> Affection UserData () -> KeyboardMessage -> Affection UserData () +handleGameKeys stateChange clean kbdev = when (msgKbdKeyMotion kbdev == SDL.Pressed) $ case SDL.keysymKeycode (msgKbdKeysym kbdev) of SDL.KeycodeSpace -> unless (msgKbdKeyRepeat kbdev) $ do - liftIO $ logIO A.Debug "TODO: PEW!" + liftIO $ logIO A.Debug "PEW!" + shoot SDL.KeycodeR -> unless (msgKbdKeyRepeat kbdev) $ do ud <- getAffection - liftIO $ logIO A.Debug "Reloading" - putAffection ud - { stateUUIDs = UUIDClean [] [] - } - loadGame stateChange + unless (isNothing $ wonlost ud) $ do + liftIO $ logIO A.Debug "Reloading" + clean SDL.KeycodeEscape -> do liftIO $ logIO A.Debug "Leave to Menu" stateChange @@ -63,6 +72,17 @@ handleGameKeys stateChange kbdev = when (msgKbdKeyMotion kbdev == SDL.Pressed) $ SDL.KeycodeD -> rotateShip (-dRot) _ -> return () +shoot :: Affection UserData () +shoot = do + ud <- getAffection + let Ship{..} = ship ud + npew = Pew ppos pVel pewTTL + ppos = sPos + ((V2 0 25) `rotVec` sRot) + pVel = sVel + ((V2 0 pewVel) `rotVec` sRot) + putAffection ud + { shots = npew : shots ud + } + accelShip :: Float -> Affection UserData () accelShip vel = do ud <- getAffection @@ -96,10 +116,13 @@ updateGame :: Double -> Affection UserData () updateGame sec = do ud <- getAffection let nhs = map (updateHaskelloid sec) (haskelloids ud) + npews = filter (\p -> pTTL p > 0) $ map (updatePew sec) (shots ud) putAffection ud { haskelloids = nhs + , shots = npews , ship = updateShip sec (ship ud) } + checkShotDown ud2 <- getAffection when ( ( any (checkCollision (ship ud2)) (haskelloids ud2) @@ -111,6 +134,51 @@ updateGame sec = do { wonlost = Just Lost } ) + when (isNothing (wonlost ud2) && null (haskelloids ud2)) + (putAffection ud2 + { wonlost = Just Won + } + ) + +checkShotDown :: Affection UserData () +checkShotDown = + do + ud <- getAffection + let shoots = shots ud + hasks = haskelloids ud + pairs = catMaybes $ concatMap (crossOut hasks) shoots + deadHasks = map fst pairs + nhask = foldl (\acc a -> filter (\x -> a /= x) acc) hasks deadHasks + npews = foldl (\acc a -> filter (\x -> a /= x) acc) shoots (map snd pairs) + children <- liftIO $ concat <$> mapM (\Haskelloid{..} -> do + n1velx <- randomRIO (-10, 10) + n1vely <- randomRIO (-10, 10) + n1rot <- randomRIO (-180, 180) + n1pitch <- randomRIO (-pi, pi) + n2velx <- randomRIO (-10, 10) + n2vely <- randomRIO (-10, 10) + n2rot <- randomRIO (-180, 180) + n2pitch <- randomRIO (-pi, pi) + let ndiv = hDiv + 1 + if ndiv > 5 + then return [] + else return $ + [ Haskelloid hPos (V2 n1velx n1vely) n1rot n1pitch ndiv hImg + , Haskelloid hPos (V2 n2velx n2vely) n2rot n2pitch ndiv hImg + ] + ) deadHasks + putAffection ud + { shots = npews + , haskelloids = nhask ++ children + } + where + crossOut :: [Haskelloid] -> Pew -> [Maybe (Haskelloid, Pew)] + crossOut hs p = + foldl (\acc h -> + if distance (pPos p) (hPos h) < (50 / fromIntegral (hDiv h)) + then Just (h, p) : acc + else Nothing : acc + ) [] hs checkCollision :: Ship -> Haskelloid -> Bool checkCollision s h = @@ -129,10 +197,19 @@ updateShip ddt s@Ship{..} = s where dt = realToFrac ddt +updatePew :: Double -> Pew -> Pew +updatePew ddt p@Pew{..} = p + { pPos = wrapAround (pPos + fmap (dt *) pVel) 0 + , pTTL = pTTL - ddt + } + where + dt = realToFrac ddt + drawGame :: Affection UserData () drawGame = do ud <- getAffection mapM_ drawHaskelloid (haskelloids ud) + mapM_ drawPew (shots ud) case wonlost ud of Just Lost -> liftIO $ do let ctx = nano ud @@ -154,9 +231,9 @@ drawGame = do 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) + fillColor ctx (rgba 128 255 0 255) fontSize ctx 40 - textBox ctx 0 350 800 "Press [Esc] to exit" + textBox ctx 0 350 800 "Press [Esc] to exit\nPress [R] to try again" restore ctx Nothing -> drawShip (ship ud) @@ -166,3 +243,15 @@ drawShip Ship{..} = do liftIO $ drawImage ctx (sImg) (sPos - fmap (/2) dim) dim sRot 255 where dim = V2 40 40 + +drawPew :: Pew -> Affection UserData () +drawPew Pew{..} = do + ctx <- nano <$> getAffection + liftIO $ do + let (V2 x y) = fmap CFloat pPos + save ctx + beginPath ctx + fillColor ctx (rgba 255 128 0 255) + circle ctx x y 2 + fill ctx + restore ctx diff --git a/src/Main.hs b/src/Main.hs index 41560e6..41171b4 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -31,7 +31,7 @@ main = do , windowConfig = SDL.defaultWindow { SDL.windowOpenGL = Just SDL.defaultOpenGL { SDL.glProfile = SDL.Core SDL.Normal 3 2 - -- , SDL.glColorPrecision = V4 0 8 8 8 + , SDL.glColorPrecision = V4 8 8 8 1 } } , initScreenMode = SDL.Windowed @@ -61,6 +61,7 @@ pre = do SDL.KeycodeF -> do dt <- getDelta liftIO $ logIO A.Debug $ "FPS: " ++ show (1/dt) + SDL.KeycodeO -> toggleScreen _ -> return () return () diff --git a/src/StateMachine.hs b/src/StateMachine.hs index 3e784e7..946da7b 100644 --- a/src/StateMachine.hs +++ b/src/StateMachine.hs @@ -11,7 +11,7 @@ import Menu instance StateMachine State UserData where smLoad Menu = loadMenu (smClean Menu >> smLoad InGame) - smLoad InGame = loadGame (smClean InGame >> smLoad Menu) + smLoad InGame = loadGame (smClean InGame >> smLoad Menu) (smClean InGame >> smLoad InGame) smUpdate Menu = updateMenu diff --git a/src/Types.hs b/src/Types.hs index 4f424bf..4ec6ede 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -37,7 +37,7 @@ data Pew = Pew { pPos :: V2 Float , pVel :: V2 Float , pTTL :: Double - } + } deriving (Eq) data Haskelloid = Haskelloid { hPos :: V2 Float