adding player sprite and handling
This commit is contained in:
nek0
parent
e8847f2aa0
commit
b72f2f744b
6 changed files with 125 additions and 36 deletions
|
|
@ -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;
|
||||
};
|
||||
|
|
|
|||
37
src/Init.hs
37
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
|
||||
|
|
|
|||
29
src/NPC.hs
29
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
|
||||
|
|
|
|||
54
src/Test.hs
54
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)
|
||||
|
|
@ -73,6 +74,7 @@ loadMap = do
|
|||
{ pos = Just (V2 (nr + 0.5) (nc + 0.5))
|
||||
, vel = Just (V2 0 0)
|
||||
, 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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in a new issue