adding player sprite and handling

This commit is contained in:
nek0 2018-05-21 00:40:40 +02:00
parent e8847f2aa0
commit b72f2f744b
6 changed files with 125 additions and 36 deletions

View file

@ -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;
};

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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)

View file

@ -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