From b72f2f744bdb419c09c1c667501e1d411a229ccc Mon Sep 17 00:00:00 2001 From: nek0 Date: Mon, 21 May 2018 00:40:40 +0200 Subject: [PATCH] adding player sprite and handling --- shell.nix | 5 ++-- src/Init.hs | 37 +++++++++++++++++++++++++++- src/NPC.hs | 29 +++++++++++++--------- src/Test.hs | 56 ++++++++++++++++++++++++++++++------------- src/Types/UserData.hs | 31 +++++++++++++++++++----- tracer-game.cabal | 3 +++ 6 files changed, 125 insertions(+), 36 deletions(-) diff --git a/shell.nix b/shell.nix index 4dfee62..7ef3eda 100644 --- a/shell.nix +++ b/shell.nix @@ -79,7 +79,7 @@ let f = { mkDerivation, astar, base, containers, linear , matrix, OpenGL, random, sdl2, stdenv, stm, text, unordered-containers - , vector + , vector, JuicyPixels, JuicyPixels-extra, bytestring }: mkDerivation { pname = "tracer-game"; @@ -90,7 +90,8 @@ let enableExecutableProfiling = true; executableHaskellDepends = [ affectionNeko astar base containers ecstasyNeko linear matrix nanovgNeko - OpenGL random sdl2 stm text unordered-containers vector + OpenGL random sdl2 stm text unordered-containers vector JuicyPixels + JuicyPixels-extra bytestring ]; license = stdenv.lib.licenses.gpl3; }; diff --git a/src/Init.hs b/src/Init.hs index 8536939..f21fda7 100644 --- a/src/Init.hs +++ b/src/Init.hs @@ -10,9 +10,13 @@ import qualified SDL import qualified Graphics.Rendering.OpenGL as GL import NanoVG hiding (V2(..), V3(..)) +import NanoVG.Internal.Image (ImageFlags(..)) import Linear +import Codec.Picture as CP +import Codec.Picture.Extra + import Control.Monad (when) import Control.Monad.IO.Class (liftIO) @@ -22,6 +26,7 @@ import qualified Data.Set as S import qualified Data.Map.Strict as M import Data.Ecstasy import Data.Maybe +import Data.ByteString.Lazy (toStrict) import System.Exit (exitFailure) @@ -72,12 +77,14 @@ load = do when (any isNothing mimgs) $ do logIO Error "Failed to load image assets" exitFailure + playerImgs <- loadPlayerSprite "assets/intruder.png" 64 74 nvg + (zipWith (\a b -> (a, [b])) [0..] [ImgIntrE .. ImgIntrNE]) let imgs = zipWith (\a b -> (a, fromJust b)) [ImgWallAsc ..] mimgs return UserData { state = Menu , subsystems = subs , assetImages = M.fromList - imgs + (imgs ++ playerImgs) , assetFonts = M.fromList [ (FontBedstead, "bedstead") ] @@ -86,3 +93,31 @@ load = do , worldState = ws , stateData = None } + +loadPlayerSprite + :: FilePath -- Path to spritemap + -> Int -- width of single sprite + -> Int -- height of single sprite + -> Context -- Nanovg context + -> [(Int, [ImgId])] -- [(picture row, Image IDs)] + -> IO [(ImgId, NanoVG.Image)] +loadPlayerSprite fp w h nvg rids = do + eimg <- readImage fp + case eimg of + Left err -> do + logIO Error err + exitFailure + Right dimg -> do + let img = convertRGBA8 dimg + ret <- mapM (\(row, ids) -> do + mapM (\(num, id) -> do + let cr = crop (num * w) (row * h) w h img + mresimg <- createImageMem nvg (ImagePremultiplied) (toStrict $ encodePng cr) + case mresimg of + Nothing -> do + logIO Error ("Failed to load: " ++ fp ++ " " ++ show id) + exitFailure + Just resimg -> return (id, resimg) + ) (zip [0..] ids) + ) rids + return $ concat ret diff --git a/src/NPC.hs b/src/NPC.hs index 78341cf..8cc3efe 100644 --- a/src/NPC.hs +++ b/src/NPC.hs @@ -3,6 +3,7 @@ module NPC where import Affection as A import qualified Data.Matrix as M +import Data.Map.Strict as Map hiding (filter, null) import Data.Ecstasy as E import Control.Monad.IO.Class (MonadIO(..)) @@ -26,18 +27,19 @@ import Types.Map import Types.ReachPoint drawNPCs - :: Context + :: Map ImgId Image + -> Context -> UserData - -> [V2 Double] + -> [(V2 Double, Direction)] -> Double -> Double -> Int -> Int -> Maybe ImgId -> IO () -drawNPCs ctx ud npcposs prow pcol row col img = do - let fnpcposs = filter - (\(V2 nr nc) -> +drawNPCs ai ctx ud npcposrots prow pcol row col img = do + let fnpcposrots = filter + (\((V2 nr nc, dir)) -> let x = realToFrac $ 640 + ((nc - pcol) + (nr - prow)) * 32 y = realToFrac $ 360 + ((nr - prow) - (nc - pcol)) * 16 in ((realToFrac x > -tileWidth && realToFrac y > -tileHeight) && @@ -48,18 +50,23 @@ drawNPCs ctx ud npcposs prow pcol row col img = do all (\m -> pcol < (fromIntegral (floor pcol :: Int)) + m) maxcs)) && (floor nr == row && floor nc == col) ) - npcposs + npcposrots mapM_ - (\(V2 nr nc) -> do + (\((V2 nr nc, dir)) -> do let x = realToFrac $ 640 + ((nc - pcol) + (nr - prow)) * 32 y = realToFrac $ 360 + ((nr - prow) - (nc - pcol)) * 16 beginPath ctx - circle ctx x y 5 - closePath ctx - fillColor ctx (rgba 255 0 0 255) + paint <- imagePattern ctx (x - 32) (y - 58) 64 74 0 + (ai Map.! (dirToImgId dir)) 1 + rect ctx (x - realToFrac (tileWidth / 2)) (y - 58) + (realToFrac tileWidth) 74 + fillPaint ctx paint + -- circle ctx x y 5 + -- closePath ctx + -- fillColor ctx (rgba 255 0 0 255) fill ctx ) - fnpcposs + fnpcposrots where tileWidth = 64 :: Double tileHeight = 32 :: Double diff --git a/src/Test.hs b/src/Test.hs index 8b08aaa..994d97a 100644 --- a/src/Test.hs +++ b/src/Test.hs @@ -63,6 +63,7 @@ loadMap = do { pos = Just (V2 20.5 20.5) , vel = Just (V2 0 0) , player = Just () + , rot = Just SE } void $ mapM_ (\npcpos@(V2 nr nc) -> do -- ttl <- liftIO $ randomRIO (5, 30) @@ -72,7 +73,8 @@ loadMap = do createEntity $ newEntity { pos = Just (V2 (nr + 0.5) (nc + 0.5)) , vel = Just (V2 0 0) - , velFact = Just fact + , velFact = Just fact + , rot = Just SE , npcState = Just (NPCStanding 0 future) } ) npcposs @@ -128,20 +130,23 @@ drawMap :: Affection UserData () drawMap = do ud <- getAffection dt <- getDelta - (_, (playerPos, npcposs)) <- liftIO $ yieldSystemT (worldState ud) $ do - pc <- efor allEnts $ do + (_, (playerPos, playerRot, npcposrots)) <- liftIO $ yieldSystemT (worldState ud) $ do + (pc, dir) <- fmap head $ efor allEnts $ do with player with pos + with rot pos' <- query pos - pure pos' + rot' <- query rot + pure (pos', rot') -- (_, npcposs) <- yieldSystemT (worldState ud) $ do - npcs <- efor allEnts $ do + npcsrots <- efor allEnts $ do with npcState with pos pos' <- query pos - pure pos' - return (pc, npcs) - let V2 pr pc = head playerPos + rot' <- query rot + pure (pos', rot') + return (pc, dir, npcsrots) + let V2 pr pc = playerPos mat = imgMat (stateData ud) ctx = nano ud cols = fromIntegral (ncols mat) @@ -167,9 +172,8 @@ drawMap = do fill ctx mapM_ (\(i, ls) -> mapM_ (\(j, t) -> do - drawTile - (assetImages ud) ctx pr pc i j t - drawNPCs ctx ud npcposs pr pc i j t + drawTile (assetImages ud) ctx pr pc i j t (dirToImgId playerRot) + drawNPCs (assetImages ud) ctx ud npcposrots pr pc i j t ) (reverse $ zip [1..] ls)) (zip [1..] (toLists mat)) @@ -182,6 +186,14 @@ drawMap = do updateMap :: Double -> Affection UserData () updateMap dt = do + let direction vel'@(V2 vr _) rot' = if sqrt (vel' `dot` vel') > 0 + then toEnum ( + let xuu = floor + ((((acos ((vel' `dot` V2 0 1) / sqrt (vel' `dot` vel'))) / + pi) + 0.25) * 4 ) + xu = if vr < 0 then 7 - xuu else xuu + in A.log A.Debug ("xu: " ++ show xu) xu) + else rot' ud <- getAffection (nws, _) <- liftIO $ yieldSystemT (worldState ud) $ do emap allEnts $ do @@ -189,21 +201,26 @@ updateMap dt = do with vel with velFact with pos + with rot pos'@(V2 pr pc) <- query pos vel' <- query vel + rot' <- query rot fact' <- query velFact let npos@(V2 nr nc) = pos' + fmap (* (dt * fact')) vel' dpos = npos - pos' ent = unchanged { pos = Set $ npos + , rot = Set $ direction vel' rot' } return ent emap allEnts $ do with player with vel with pos + with rot pos'@(V2 pr pc) <- query pos - vel' <- query vel + vel'@(V2 vr vc) <- query vel + rot' <- query rot let npos@(V2 nr nc) = pos' + fmap (* dt) vel' dpos@(V2 dpr dpc) = npos - pos' len = sqrt (dpos `dot` dpos) @@ -250,6 +267,8 @@ updateMap dt = do ) (A.log A.Verbose (show lll ++ " " ++ show len) lll) ) + , rot = Set (A.log A.Debug ("dir: " ++ show (direction vel' rot')) + (direction vel' rot')) } return ent updateNPCs @@ -271,8 +290,9 @@ drawTile -> Int -> Int -> Maybe ImgId + -> ImgId -> IO () -drawTile ai ctx pr pc row col img = +drawTile ai ctx pr pc row col img playerImg = when ((realToFrac x > -tileWidth && realToFrac y > -tileHeight) && (realToFrac x < 1280 && realToFrac (y - (74 - realToFrac tileHeight)) < 720)) $ do @@ -330,9 +350,13 @@ drawTile ai ctx pr pc row col img = drawPlayer = do when (floor pr == row && floor pc == col) $ do beginPath ctx - circle ctx 640 360 5 - closePath ctx - fillColor ctx (rgba 0 255 255 255) + paint <- imagePattern + ctx 608 302 64 74 0 (ai Map.! playerImg) 1 + rect ctx 608 302 64 74 + fillPaint ctx paint + -- circle ctx 640 360 5 + -- closePath ctx + -- fillColor ctx (rgba 0 255 255 255) fill ctx checkBoundsCollision diff --git a/src/Types/UserData.hs b/src/Types/UserData.hs index 5e1c231..b798436 100644 --- a/src/Types/UserData.hs +++ b/src/Types/UserData.hs @@ -62,6 +62,14 @@ data ImgId | ImgMiscTable3 | ImgMiscTable4 | ImgMiscTableCorner + | ImgIntrE + | ImgIntrSE + | ImgIntrS + | ImgIntrSW + | ImgIntrW + | ImgIntrNW + | ImgIntrN + | ImgIntrNE deriving (Show, Eq, Ord, Enum) isWall :: ImgId -> Bool @@ -136,14 +144,25 @@ data FontId deriving (Show, Eq, Ord, Enum) data Direction - = N - | W - | S + = NE | E - | NW - | SW - | NE | SE + | S + | SW + | W + | NW + | N + deriving (Show, Eq, Ord, Enum) + +dirToImgId :: Direction -> ImgId +dirToImgId E = ImgIntrE +dirToImgId SE = ImgIntrSE +dirToImgId S = ImgIntrS +dirToImgId SW = ImgIntrSW +dirToImgId W = ImgIntrW +dirToImgId NW = ImgIntrNW +dirToImgId N = ImgIntrN +dirToImgId NE = ImgIntrNE data Entity f = Entity { pos :: Component f 'Field (V2 Double) diff --git a/tracer-game.cabal b/tracer-game.cabal index e39c692..4c62c94 100644 --- a/tracer-game.cabal +++ b/tracer-game.cabal @@ -49,6 +49,9 @@ executable tracer-game , vector , astar , unordered-containers + , JuicyPixels + , JuicyPixels-extra + , bytestring hs-source-dirs: src ghc-options: -Wall -threaded default-language: Haskell2010