From 42ef9fec076ad60c7a03fec32ffbfbc5244730e6 Mon Sep 17 00:00:00 2001 From: Ashley Smith Date: Sat, 31 Mar 2018 17:00:00 +0100 Subject: [PATCH] [Broken] Working on Entities --- src/Entity.hs | 35 ++++++----------------------- src/GameState.hs | 11 ++++++++++ src/Guy.hs | 57 ++++++++++++++++++++++++++++++++++++++++++++++++ src/Main.hs | 53 +++++++++++++++++++------------------------- 4 files changed, 98 insertions(+), 58 deletions(-) create mode 100644 src/Guy.hs diff --git a/src/Entity.hs b/src/Entity.hs index 61e34a3..f0b636e 100644 --- a/src/Entity.hs +++ b/src/Entity.hs @@ -2,11 +2,9 @@ {-# LANGUAGE PatternSynonyms #-} module Entity ( Entity(Entity) - , position - , velocity - , tag - , animation - , frame + , eID + , update + , render ) where import Control.Monad @@ -15,29 +13,10 @@ import SDL.Vect import SDL (($=)) import qualified SDL import qualified SDL.Image -import Data.List (foldl') -import SDL.Raw.Timer as SDL hiding (delay) -import Text.Pretty.Simple --- The fundamental structures of all our objects in the game data Entity = Entity - { position :: Point V2 CDouble - , velocity :: V2 CDouble - , tag :: String - , animation :: String - , frame :: Int - } deriving (Show, Eq) - - --- Our initial guy starts out with him roughly in the middle -initialGuy :: (CDouble, CDouble) -> Entity -initialGuy pos = - Entity - { position = P $ V2 (fst pos) (snd pos) - , velocity = V2 0 0 - , tag = "male" - , animation = "idle" - , frame = 0 - } - + { eID :: Int + , update :: CDouble -> Entity + , render :: IO () + } diff --git a/src/GameState.hs b/src/GameState.hs index 05beacd..e1eb9cc 100644 --- a/src/GameState.hs +++ b/src/GameState.hs @@ -5,6 +5,8 @@ module GameState , initialState , entities , options + , updateGameState + , renderGameState , initialOptions , screenRes , frameLimit @@ -58,3 +60,12 @@ processEvent :: SDL.EventPayload -> Maybe (SDL.Keycode, Bool) processEvent (SDL.KeyboardEvent (SDL.KeyboardEventData _ SDL.Pressed False (SDL.Keysym _ code _))) = Just (code, True) processEvent (SDL.KeyboardEvent (SDL.KeyboardEventData _ SDL.Released _ (SDL.Keysym _ code _))) = Just (code, False) processEvent _ = Nothing + +-- Updates the game state's entities +updateGameState :: GameState -> CDouble -> GameState +updateGameState state delta = state { entities = map (\(Entity _ up _) -> up delta) (entities state)} + +-- Renders the game state's entities +renderGameState :: GameState -> IO [()] +renderGameState state = sequence $ map (\(Entity _ _ rend) -> rend) $ entities state +-- SDL.copy renderer player (getCurrentFrame newAnimState) $ Just $ SDL.Rectangle (truncate <$> position (entities newState)) (V2 100 100) diff --git a/src/Guy.hs b/src/Guy.hs new file mode 100644 index 0000000..5301733 --- /dev/null +++ b/src/Guy.hs @@ -0,0 +1,57 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} +module Guy + ( Guy(Guy) + , position + , velocity + , tag + , animation + , guy + , updateGuy + ) where + +import Control.Monad +import Foreign.C.Types +import SDL.Vect +import qualified SDL + +import Entity +import SDLAnimations + + -- The fundamental structures of all our objects in the game +data Guy = + Guy + { position :: V2 CDouble + , velocity :: V2 CDouble + , tag :: String + , animation :: AnimationState + } deriving (Show) + +guy :: Guy -> Int -> Entity +guy g i = + Entity + { eID = i + , update = flip guy i . updateGuy g + , render = print (i) + } + +updateGuy :: Guy -> CDouble -> Guy +updateGuy guy dt = + guy + { position = + let (V2 newPosX newPosY) = position guy + velocity guy * V2 dt dt + in V2 newPosX newPosY + , animation = updateAnimationState dt 0.1 (animation guy) + } + +-- -- Our initial guy starts out with him roughly in the middle +-- initialGuy :: (CDouble, CDouble) -> Entity +-- initialGuy pos = +-- Entity +-- { position = P $ V2 (fst pos) (snd pos) +-- , velocity = V2 0 0 +-- , tag = "male" +-- , animation = "idle" +-- , frame = 0 +-- } + diff --git a/src/Main.hs b/src/Main.hs index 640dc3f..35b27c6 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -16,6 +16,8 @@ import GameState import SDLAnimations import InputModule +import Guy + import Paths_FirstGameHS(getDataFileName) jumpVelocity :: V2 CDouble @@ -27,14 +29,6 @@ walkingSpeed = V2 300 0 gravity :: V2 CDouble gravity = V2 0 300 -updateWorld :: CDouble -> GameState -> GameState -updateWorld delta state@(State (Options res _ _) (Guy (P pos) vel tag anim frame)) = - let (V2 newPosX newPosY) = pos + (gravity + vel) * V2 delta delta - fixedX = max 0 $ min newPosX (fromIntegral (fst res) - 50) - fixedY = max 0 $ min (fromIntegral (snd res) - 100) newPosY - in state {entities = Guy (P $ V2 fixedX fixedY) vel tag anim frame } - - -- Takes file and creates a texture out of it getTextureFromImg :: SDL.Renderer -> FilePath -> IO SDL.Texture getTextureFromImg renderer img = do @@ -50,21 +44,23 @@ main = do SDL.initialize [SDL.InitVideo] -- Set up the first state - let jump state@(State _ oldGuy@(Guy _ curVel _ _ _)) = state { entities = oldGuy { velocity = curVel * V2 1 0 + jumpVelocity }} - fall state@(State _ oldGuy@(Guy _ curVel _ _ _)) = state { entities = oldGuy { velocity = curVel - jumpVelocity }} - right state@(State _ oldGuy@(Guy _ curVel _ _ _)) = state { entities = oldGuy { velocity = walkingSpeed + curVel }} - left state@(State _ oldGuy@(Guy _ curVel _ _ _)) = state { entities = oldGuy { velocity = curVel - walkingSpeed }} - - initOptions = initialOptions { keybindings = - addBatchBindings - [ ((SDL.KeycodeUp, True), Just jump) - , ((SDL.KeycodeUp, False), Just fall) - , ((SDL.KeycodeRight, True), Just right) - , ((SDL.KeycodeRight, False), Just left) - , ((SDL.KeycodeLeft, True), Just left) - , ((SDL.KeycodeLeft, False), Just right) - ] blankKeyBindings } - state = initialState { options = initOptions } +-- let jump p@(Guy _ curVel _ _) = p { velocity = curVel * V2 1 0 + jumpVelocity } +-- fall p@(Guy _ curVel _ _) = p { velocity = curVel - jumpVelocity } +-- right p@(Guy _ curVel _ _) = p { velocity = walkingSpeed + curVel } +-- left p@(Guy _ curVel _ _) = p { velocity = curVel - walkingSpeed } +-- +-- initOptions = initialOptions { keybindings = +-- addBatchBindings +-- [ ((SDL.KeycodeUp, True), Just (\s@(GameState _ es) -> s {entities = jump (head es) : tail es})) +-- , ((SDL.KeycodeUp, False), Just fall) +-- , ((SDL.KeycodeRight, True), Just right) +-- , ((SDL.KeycodeRight, False), Just left) +-- , ((SDL.KeycodeLeft, True), Just left) +-- , ((SDL.KeycodeLeft, False), Just right) +-- ] blankKeyBindings } +-- state = initialState { options = initOptions } + + let state = initialState -- Create a window with the correct screensize and make it appear window <- SDL.createWindow "FirstGameHS" @@ -89,11 +85,10 @@ main = do animsList <- loadAnimations "Assets/rogue.json" let animationSet = getAnimationSet "rogue" "male" =<< animsList animation = getAnimation "walk" =<< animationSet - frame = fmap (getFrame 0) animation initAnimationState = AnimationState animationSet animation [] "idle" 0 0 - let loop lastTicks state animState = do + let loop lastTicks state = do ticks <- SDL.getTicks events <- SDL.pollEvents @@ -104,22 +99,20 @@ main = do -- Update functions let worldAfterInput = foldl' processInput state payloads - newState = updateWorld delta worldAfterInput - newAnimState = updateAnimationState delta 0.1 animState + newState = updateGameState worldAfterInput delta -- Render functions (Background and player) SDL.copy renderer texture Nothing Nothing - SDL.copy renderer player (getCurrentFrame newAnimState) $ Just $ SDL.Rectangle (truncate <$> position (entities newState)) (V2 100 100) -- Delay time until next frame to save processing power let frameDelay = 1000 / fromIntegral (frameLimit (options newState)) when (delta < frameDelay) $ SDL.delay (truncate $ frameDelay - delta) SDL.present renderer - unless quit $ loop ticks newState newAnimState + unless quit $ loop ticks newState ticks <- SDL.getTicks - loop ticks state initAnimationState + loop ticks state SDL.destroyWindow window SDL.quit