drawing animation properly
This commit is contained in:
nek0
parent
81abbaf91e
commit
e83482e8ea
4 changed files with 351 additions and 177 deletions
68
src/Init.hs
68
src/Init.hs
|
|
@ -12,7 +12,7 @@ import qualified Graphics.Rendering.OpenGL as GL
|
|||
import NanoVG hiding (V2(..), V3(..))
|
||||
import NanoVG.Internal.Image (ImageFlags(..))
|
||||
|
||||
import Linear
|
||||
import Linear hiding (E(..))
|
||||
|
||||
import Codec.Picture as CP
|
||||
import Codec.Picture.Extra
|
||||
|
|
@ -77,23 +77,64 @@ 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 .. ImgIntrN] ++ [ImgIntrNE])
|
||||
-- playerImgs <- loadPlayerSprite "assets/intruder.png" 64 74 nvg
|
||||
-- (zipWith (\a b -> (a, [b])) [0..] $ [ImgIntrE .. ImgIntrN] ++ [ImgIntrNE])
|
||||
let imgs = zipWith (\a b -> (a, fromJust b)) [ImgWallAsc ..] mimgs
|
||||
directions = [E .. N] ++ [NE]
|
||||
animIds = map (AnimId 0 "standing") directions
|
||||
animConfigs = map
|
||||
(\i -> AnimationConfig (0, i * 74) (64, 74) 1 0 APLoop)
|
||||
[0 .. length animIds]
|
||||
animations <- loadAnimationSprites "assets/intruder.png" nvg
|
||||
(zip animIds animConfigs)
|
||||
return UserData
|
||||
{ state = Menu
|
||||
, subsystems = subs
|
||||
, assetImages = M.fromList
|
||||
(imgs ++ playerImgs)
|
||||
, assetFonts = M.fromList
|
||||
{ state = Menu
|
||||
, subsystems = subs
|
||||
, assetImages = M.fromList imgs
|
||||
, assetAnimations = M.fromList animations
|
||||
, assetFonts = M.fromList
|
||||
[ (FontBedstead, "bedstead")
|
||||
]
|
||||
, nano = nvg
|
||||
, uuid = []
|
||||
, worldState = ws
|
||||
, stateData = None
|
||||
, nano = nvg
|
||||
, uuid = []
|
||||
, worldState = ws
|
||||
, stateData = None
|
||||
}
|
||||
|
||||
loadAnimationSprites
|
||||
:: FilePath -- Path to Sprite map
|
||||
-> Context -- NanoVG context
|
||||
-> [(AnimId, AnimationConfig)]
|
||||
-> IO [(AnimId, Animation)]
|
||||
loadAnimationSprites fp nvg idconfs = do
|
||||
eimg <- readImage fp
|
||||
case eimg of
|
||||
Left err -> do
|
||||
logIO Error err
|
||||
exitFailure
|
||||
Right dimg -> do
|
||||
let img = convertRGBA8 dimg
|
||||
mapM
|
||||
(\(id, (AnimationConfig (xoffs, yoffs) (w, h) count dur pb)) -> do
|
||||
let crs = map
|
||||
(\i -> crop (xoffs + (i * w)) yoffs w h img)
|
||||
[0 .. (count - 1)]
|
||||
mresimgs <- mapM
|
||||
(\cr ->
|
||||
createImageMem nvg (ImagePremultiplied) (toStrict $ encodePng cr))
|
||||
crs
|
||||
imgs <- if any isNothing mresimgs
|
||||
then do
|
||||
logIO Error ("failed to load: " ++ fp ++ " " ++ show id)
|
||||
exitFailure
|
||||
else
|
||||
return $ catMaybes mresimgs
|
||||
return $
|
||||
( id
|
||||
, Animation dur imgs pb
|
||||
)
|
||||
) idconfs
|
||||
|
||||
loadPlayerSprite
|
||||
:: FilePath -- Path to spritemap
|
||||
-> Int -- width of single sprite
|
||||
|
|
@ -112,7 +153,8 @@ loadPlayerSprite fp w h nvg rids = do
|
|||
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)
|
||||
mresimg <-
|
||||
createImageMem nvg (ImagePremultiplied) (toStrict $ encodePng cr)
|
||||
case mresimg of
|
||||
Nothing -> do
|
||||
logIO Error ("Failed to load: " ++ fp ++ " " ++ show id)
|
||||
|
|
|
|||
98
src/NPC.hs
98
src/NPC.hs
|
|
@ -26,55 +26,55 @@ import Types.Interior
|
|||
import Types.Map
|
||||
import Types.ReachPoint
|
||||
|
||||
drawNPCs
|
||||
:: Map ImgId Image
|
||||
-> Context
|
||||
-> UserData
|
||||
-> [(V2 Double, Direction)]
|
||||
-> Double
|
||||
-> Double
|
||||
-> Int
|
||||
-> Int
|
||||
-> Maybe ImgId
|
||||
-> IO ()
|
||||
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) &&
|
||||
(realToFrac x < 1280 && realToFrac (y - (74 - realToFrac tileHeight)) < 720)) &&
|
||||
((all (\m -> prow > (fromIntegral (floor prow :: Int)) + m) minrs &&
|
||||
all (\m -> pcol < (fromIntegral (floor pcol :: Int)) + m) mincs) ||
|
||||
(all (\m -> prow > (fromIntegral (floor prow :: Int)) + m) minrs &&
|
||||
all (\m -> pcol < (fromIntegral (floor pcol :: Int)) + m) maxcs)) &&
|
||||
(floor nr == row && floor nc == col)
|
||||
)
|
||||
npcposrots
|
||||
mapM_
|
||||
(\((V2 nr nc, dir)) -> do
|
||||
let x = realToFrac $ 640 + ((nc - pcol) + (nr - prow)) * 32
|
||||
y = realToFrac $ 360 + ((nr - prow) - (nc - pcol)) * 16
|
||||
beginPath ctx
|
||||
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
|
||||
)
|
||||
fnpcposrots
|
||||
where
|
||||
tileWidth = 64 :: Double
|
||||
tileHeight = 32 :: Double
|
||||
mb = imgObstacle img
|
||||
minrs = Prelude.map (fst . matmin) mb
|
||||
maxrs = Prelude.map (fst . matmax) mb
|
||||
mincs = Prelude.map (snd . matmin) mb
|
||||
maxcs = Prelude.map (snd . matmax) mb
|
||||
-- drawNPCs
|
||||
-- :: Map ImgId Image
|
||||
-- -> Context
|
||||
-- -> UserData
|
||||
-- -> [(V2 Double, Direction)]
|
||||
-- -> Double
|
||||
-- -> Double
|
||||
-- -> Int
|
||||
-- -> Int
|
||||
-- -> Maybe ImgId
|
||||
-- -> IO ()
|
||||
-- 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) &&
|
||||
-- (realToFrac x < 1280 && realToFrac (y - (74 - realToFrac tileHeight)) < 720)) &&
|
||||
-- ((all (\m -> prow > (fromIntegral (floor prow :: Int)) + m) minrs &&
|
||||
-- all (\m -> pcol < (fromIntegral (floor pcol :: Int)) + m) mincs) ||
|
||||
-- (all (\m -> prow > (fromIntegral (floor prow :: Int)) + m) minrs &&
|
||||
-- all (\m -> pcol < (fromIntegral (floor pcol :: Int)) + m) maxcs)) &&
|
||||
-- (floor nr == row && floor nc == col)
|
||||
-- )
|
||||
-- npcposrots
|
||||
-- mapM_
|
||||
-- (\((V2 nr nc, dir)) -> do
|
||||
-- let x = realToFrac $ 640 + ((nc - pcol) + (nr - prow)) * 32
|
||||
-- y = realToFrac $ 360 + ((nr - prow) - (nc - pcol)) * 16
|
||||
-- beginPath ctx
|
||||
-- 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
|
||||
-- )
|
||||
-- fnpcposrots
|
||||
-- where
|
||||
-- tileWidth = 64 :: Double
|
||||
-- tileHeight = 32 :: Double
|
||||
-- mb = imgObstacle img
|
||||
-- minrs = Prelude.map (fst . matmin) mb
|
||||
-- maxrs = Prelude.map (fst . matmax) mb
|
||||
-- mincs = Prelude.map (snd . matmin) mb
|
||||
-- maxcs = Prelude.map (snd . matmax) mb
|
||||
|
||||
placeNPCs
|
||||
:: M.Matrix (Maybe ImgId)
|
||||
|
|
|
|||
315
src/Test.hs
315
src/Test.hs
|
|
@ -18,6 +18,7 @@ import qualified Data.Text as T
|
|||
import Data.Matrix as M
|
||||
import Data.Ecstasy as E
|
||||
import Data.Maybe
|
||||
import Data.List (sortOn)
|
||||
|
||||
import System.Random (randomRIO)
|
||||
|
||||
|
|
@ -39,8 +40,8 @@ loadMap :: Affection UserData ()
|
|||
loadMap = do
|
||||
ud <- getAffection
|
||||
let fc = FloorConfig
|
||||
(20, 20)
|
||||
[(5,5), (35, 35)]
|
||||
(10, 10)
|
||||
[]
|
||||
(50, 50)
|
||||
(Subsystems _ m) = subsystems ud
|
||||
(mat, gr) <- liftIO $ buildHallFloorIO fc
|
||||
|
|
@ -56,20 +57,19 @@ loadMap = do
|
|||
(inter, rps) <- liftIO $ placeInteriorIO mat imgmat exits gr
|
||||
liftIO $ logIO A.Debug ("number of reachpoints: " ++ show (length rps))
|
||||
let nnex = Prelude.filter (\p -> pointType p /= RoomExit) rps
|
||||
playerAnim = Animations
|
||||
{ animStand = Map.fromList
|
||||
(zip [NE .. N] [ImgIntrNE .. ImgIntrN])
|
||||
}
|
||||
-- playerAnim = Animations
|
||||
-- { animStand = Map.fromList
|
||||
-- (zip [NE .. N] [ImgIntrNE .. ImgIntrN])
|
||||
-- }
|
||||
npcposs <- placeNPCs inter mat rps gr 50 -- (length nnex)
|
||||
liftIO $ A.logIO A.Debug $ "number of placed NPCs: " ++ show (length npcposs)
|
||||
(nws, _) <- liftIO $ yieldSystemT (worldState ud) $ do
|
||||
createEntity $ newEntity
|
||||
{ pos = Just (V2 20.5 20.5)
|
||||
{ pos = Just (V2 10.5 10.5)
|
||||
, vel = Just (V2 0 0)
|
||||
, player = Just ()
|
||||
, rot = Just SE
|
||||
, anim = Just playerAnim
|
||||
, animCurrFrame = Just (0, 0)
|
||||
, anim = Just $ AnimState (AnimId 0 "standing" SE) 0 0
|
||||
}
|
||||
void $ mapM_ (\npcpos@(V2 nr nc) -> do
|
||||
-- ttl <- liftIO $ randomRIO (5, 30)
|
||||
|
|
@ -82,8 +82,7 @@ loadMap = do
|
|||
, velFact = Just fact
|
||||
, rot = Just SE
|
||||
, npcState = Just (NPCStanding 0 future)
|
||||
, anim = Just playerAnim
|
||||
, animCurrFrame = Just (0, 0)
|
||||
, anim = Just $ AnimState (AnimId 0 "standing" SE) 0 0
|
||||
}
|
||||
) npcposs
|
||||
uu <- partSubscribe m movePlayer
|
||||
|
|
@ -138,7 +137,7 @@ drawMap :: Affection UserData ()
|
|||
drawMap = do
|
||||
ud <- getAffection
|
||||
dt <- getDelta
|
||||
(_, (playerPos, playerRot, npcposrots)) <- liftIO $ yieldSystemT (worldState ud) $ do
|
||||
(_, (playerPos, playerRot, posanims)) <- liftIO $ yieldSystemT (worldState ud) $ do
|
||||
(pc, dir) <- fmap head $ efor allEnts $ do
|
||||
with player
|
||||
with pos
|
||||
|
|
@ -146,14 +145,19 @@ drawMap = do
|
|||
pos' <- query pos
|
||||
rot' <- query rot
|
||||
pure (pos', rot')
|
||||
-- (_, npcposs) <- yieldSystemT (worldState ud) $ do
|
||||
npcsrots <- efor allEnts $ do
|
||||
with npcState
|
||||
-- npcsrots <- efor allEnts $ do
|
||||
-- with npcState
|
||||
-- with pos
|
||||
-- pos' <- query pos
|
||||
-- rot' <- query rot
|
||||
-- pure (pos', rot')
|
||||
posanims <- efor allEnts $ do
|
||||
with anim
|
||||
with pos
|
||||
state <- query anim
|
||||
pos' <- query pos
|
||||
rot' <- query rot
|
||||
pure (pos', rot')
|
||||
return (pc, dir, npcsrots)
|
||||
return (pos', state)
|
||||
return (pc, dir, posanims)
|
||||
let V2 pr pc = playerPos
|
||||
mat = imgMat (stateData ud)
|
||||
ctx = nano ud
|
||||
|
|
@ -180,8 +184,9 @@ drawMap = do
|
|||
fill ctx
|
||||
mapM_ (\(i, ls) -> mapM_
|
||||
(\(j, t) -> do
|
||||
drawTile (assetImages ud) ctx pr pc i j t (dirToImgId playerRot)
|
||||
drawNPCs (assetImages ud) ctx ud npcposrots pr pc i j t
|
||||
drawTile ud ctx posanims pr pc i j t
|
||||
-- drawNPCs (assetImages ud) ctx ud npcposrots pr pc i j t
|
||||
-- drawAnims ctx (assetAnimations ud) (worldState ud) posanims pr pc i j t
|
||||
)
|
||||
(reverse $ zip [1..] ls))
|
||||
(zip [1..] (toLists mat))
|
||||
|
|
@ -192,6 +197,149 @@ drawMap = do
|
|||
fillColor ctx (rgb 255 128 0)
|
||||
textBox ctx 0 0 200 ("FPS: " `T.append` (T.pack $ Prelude.take 5 $ show (1/dt)))
|
||||
|
||||
drawTile
|
||||
:: UserData
|
||||
-> Context
|
||||
-> [(V2 Double, AnimState)]
|
||||
-> Double
|
||||
-> Double
|
||||
-> Int
|
||||
-> Int
|
||||
-> Maybe ImgId
|
||||
-> IO ()
|
||||
drawTile ud ctx posanims pr pc row col img =
|
||||
when ((realToFrac x > -tileWidth && realToFrac y > -tileHeight) &&
|
||||
(realToFrac x < 1280 && realToFrac (y - (74 - realToFrac tileHeight)) < 720)) $
|
||||
do
|
||||
let lt = Prelude.filter (\(V2 nr nc, _) ->
|
||||
(any (\m -> nr < (fromIntegral (floor nr :: Int)) + m) maxrs &&
|
||||
any (\m -> nc > (fromIntegral (floor nc :: Int)) + m) maxcs)
|
||||
-- (all (\m -> nr < (fromIntegral (floor nr :: Int)) + m) minrs &&
|
||||
-- all (\m -> nc > (fromIntegral (floor nc :: Int)) + m) mincs) ||
|
||||
-- (all (\m -> nr < (fromIntegral (floor nr :: Int)) + m) maxrs &&
|
||||
-- all (\m -> nc > (fromIntegral (floor nc :: Int)) + m) maxcs)
|
||||
) sorted
|
||||
ge = Prelude.filter (\(V2 nr nc, _) -> not
|
||||
(any (\m -> nr < (fromIntegral (floor nr :: Int)) + m) maxrs &&
|
||||
any (\m -> nc > (fromIntegral (floor nc :: Int)) + m) maxcs)
|
||||
-- (all (\m -> nr < (fromIntegral (floor nr :: Int)) + m) minrs &&
|
||||
-- all (\m -> nc > (fromIntegral (floor nc :: Int)) + m) mincs) ||
|
||||
-- (all (\m -> nr < (fromIntegral (floor nr :: Int)) + m) maxrs &&
|
||||
-- all (\m -> nc > (fromIntegral (floor nc :: Int)) + m) maxcs)
|
||||
) sorted
|
||||
save ctx
|
||||
mapM_ drawAnim lt
|
||||
when (isJust img) drawImage
|
||||
mapM_ drawAnim ge
|
||||
-- mapM (\posanim@(V2 nr nc, as) -> do
|
||||
-- if (isNothing img)
|
||||
-- then drawAnim posanim
|
||||
-- else do
|
||||
-- if (Prelude.null mb)
|
||||
-- then do
|
||||
-- drawImage
|
||||
-- drawAnim posanim
|
||||
-- else do
|
||||
-- if (all (\m -> nr > (fromIntegral (floor nr :: Int)) + m) minrs &&
|
||||
-- all (\m -> nc < (fromIntegral (floor nc :: Int)) + m) mincs) ||
|
||||
-- (all (\m -> nr > (fromIntegral (floor nr :: Int)) + m) minrs &&
|
||||
-- all (\m -> nc < (fromIntegral (floor nc :: Int)) + m) maxcs)
|
||||
-- then do
|
||||
-- drawImage
|
||||
-- drawAnim posanim
|
||||
-- else do
|
||||
-- drawAnim posanim
|
||||
-- drawImage
|
||||
-- ) sorted
|
||||
restore ctx
|
||||
where
|
||||
ai = assetImages ud
|
||||
anims = assetAnimations ud
|
||||
tileWidth = 64 :: Double
|
||||
tileHeight = 32 :: Double
|
||||
filtered = Prelude.filter
|
||||
(\((V2 ar ac), _) -> floor ar == row && floor ac == col) posanims
|
||||
sorted = sortOn (\(V2 sr sc, _) -> sc + sr * maxCol) filtered
|
||||
maxCol = maximum (Prelude.map (\(V2 _ mc, _) -> mc) filtered)
|
||||
minrs = Prelude.map (fst . matmin) mb
|
||||
maxrs = Prelude.map (fst . matmax) mb
|
||||
mincs = Prelude.map (snd . matmin) mb
|
||||
maxcs = Prelude.map (snd . matmax) mb
|
||||
x = realToFrac $ 640 + ((fromIntegral col - pc) +
|
||||
(fromIntegral row - pr)) * (tileWidth / 2) :: CFloat
|
||||
y = realToFrac $ 360 - (tileHeight / 2) + ((fromIntegral row - pr) -
|
||||
(fromIntegral col - pc)) * (tileHeight / 2) :: CFloat
|
||||
dist = distance (V2 (fromIntegral row) (fromIntegral col))
|
||||
(V2 (realToFrac pr - 1) (realToFrac pc)) / 4
|
||||
fact =
|
||||
if (pr <= fromIntegral row + minimum maxrs &&
|
||||
pc >= fromIntegral col + maximum mincs) &&
|
||||
isWall (fromJust img)
|
||||
then min 1 dist
|
||||
else 1
|
||||
mb = imgObstacle img
|
||||
drawAnim (V2 nr nc, as) = do
|
||||
let ax = realToFrac $ 640 + ((nc - pc) + (nr - pr)) * 32
|
||||
ay = realToFrac $ 360 + ((nr - pr) - (nc - pc)) * 16
|
||||
a = anims Map.! asId as
|
||||
beginPath ctx
|
||||
paint <- imagePattern ctx (ax - 32) (ay - 58) 64 74 0
|
||||
(animSprites a !! asCurrentFrame as) 1
|
||||
rect ctx (ax - 32) (ay - 58) 64 74
|
||||
fillPaint ctx paint
|
||||
fill ctx
|
||||
drawImage = do
|
||||
beginPath ctx
|
||||
paint <- imagePattern
|
||||
ctx x (y - (74 - realToFrac tileHeight))
|
||||
(realToFrac tileWidth) 74
|
||||
0
|
||||
(ai Map.! fromJust img)
|
||||
fact
|
||||
rect ctx x (y - (74 - realToFrac tileHeight)) (realToFrac tileWidth) 74
|
||||
fillPaint ctx paint
|
||||
fill ctx
|
||||
-- drawPlayer = do
|
||||
-- when (floor pr == row && floor pc == col) $ do
|
||||
-- beginPath ctx
|
||||
-- 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
|
||||
|
||||
drawAnims
|
||||
:: Context
|
||||
-> Map AnimId Animation
|
||||
-> SystemState Entity IO
|
||||
-> [(V2 Double, AnimState)]
|
||||
-> Double
|
||||
-> Double
|
||||
-> Int
|
||||
-> Int
|
||||
-> Maybe ImgId
|
||||
-> IO ()
|
||||
drawAnims ctx anims ws posanims pr pc r c tile =
|
||||
mapM_ (\(V2 nr nc, as) -> do
|
||||
let x = realToFrac $ 640 + ((nc - pc) + (nr - pr)) * 32
|
||||
y = realToFrac $ 360 + ((nr - pr) - (nc - pc)) * 16
|
||||
anim = anims Map.! asId as
|
||||
beginPath ctx
|
||||
paint <- imagePattern ctx (x - 32) (y - 58) 64 74 0
|
||||
(animSprites anim !! asCurrentFrame as) 1
|
||||
rect ctx (x - 32) (y - 58) 64 74
|
||||
fillPaint ctx paint
|
||||
fill ctx
|
||||
) filtered
|
||||
where
|
||||
filtered = Prelude.filter
|
||||
(\((V2 ar ac), _) -> floor ar == r && floor ac == c) posanims
|
||||
sorted = sortOn (\(V2 sr sc, _) -> sc + sr * maxCol) filtered
|
||||
maxCol = maximum (Prelude.map (\(V2 _ mc, _) -> mc) filtered)
|
||||
|
||||
updateMap :: Double -> Affection UserData ()
|
||||
updateMap dt = do
|
||||
let direction :: V2 Double -> Direction -> Direction
|
||||
|
|
@ -214,21 +362,63 @@ updateMap dt = do
|
|||
else rot'
|
||||
ud <- getAffection
|
||||
(nws, _) <- liftIO $ yieldSystemT (worldState ud) $ do
|
||||
emap allEnts $ do
|
||||
with anim
|
||||
state <- query anim
|
||||
let anim = assetAnimations ud Map.! asId state
|
||||
ntime = asElapsedTime state + dt
|
||||
nstate = if ntime > (fromIntegral $ asCurrentFrame state) *
|
||||
(animDuration anim / (fromIntegral $ length $ animSprites anim))
|
||||
then
|
||||
let nframe = asCurrentFrame state + 1
|
||||
in case animPlay anim of
|
||||
APLoop ->
|
||||
let (nnframe, nntime) =
|
||||
if nframe >= (length $ animSprites anim)
|
||||
then (0, 0)
|
||||
else (nframe, ntime)
|
||||
in state
|
||||
{ asCurrentFrame = nnframe
|
||||
, asElapsedTime = nntime
|
||||
}
|
||||
APOnce ->
|
||||
let nnframe = if nframe >= (length $ animSprites anim)
|
||||
then nframe - 1
|
||||
else nframe
|
||||
in state
|
||||
{ asCurrentFrame = nnframe
|
||||
, asElapsedTime = ntime
|
||||
}
|
||||
else
|
||||
state
|
||||
{ asElapsedTime = ntime
|
||||
}
|
||||
return $ unchanged
|
||||
{ anim = Set nstate
|
||||
}
|
||||
emap allEnts $ do
|
||||
without player
|
||||
with vel
|
||||
with velFact
|
||||
with pos
|
||||
with rot
|
||||
with anim
|
||||
pos'@(V2 pr pc) <- query pos
|
||||
vel' <- query vel
|
||||
rot' <- query rot
|
||||
fact' <- query velFact
|
||||
state <- query anim
|
||||
let npos@(V2 nr nc) = pos' + fmap (* (dt * fact')) vel'
|
||||
dpos = npos - pos'
|
||||
aId = asId state
|
||||
ent = unchanged
|
||||
{ pos = Set $ npos
|
||||
, rot = Set $ direction vel' rot'
|
||||
, anim = Set state
|
||||
{ asId = aId
|
||||
{ aiDirection = direction vel' rot'
|
||||
}
|
||||
}
|
||||
}
|
||||
return ent
|
||||
emap allEnts $ do
|
||||
|
|
@ -236,11 +426,14 @@ updateMap dt = do
|
|||
with vel
|
||||
with pos
|
||||
with rot
|
||||
with anim
|
||||
pos'@(V2 pr pc) <- query pos
|
||||
vel'@(V2 vr vc) <- query vel
|
||||
rot' <- query rot
|
||||
state <- query anim
|
||||
let npos@(V2 nr nc) = pos' + fmap (* dt) vel'
|
||||
dpos@(V2 dpr dpc) = npos - pos'
|
||||
aId = asId state
|
||||
len = sqrt (dpos `dot` dpos)
|
||||
lll = (,)
|
||||
<$> (
|
||||
|
|
@ -286,6 +479,11 @@ updateMap dt = do
|
|||
(A.log A.Verbose (show lll ++ " " ++ show len) lll)
|
||||
)
|
||||
, rot = Set (direction vel' rot')
|
||||
, anim = Set state
|
||||
{ asId = aId
|
||||
{ aiDirection = direction vel' rot'
|
||||
}
|
||||
}
|
||||
}
|
||||
return ent
|
||||
updateNPCs
|
||||
|
|
@ -299,83 +497,6 @@ updateMap dt = do
|
|||
{ worldState = nws
|
||||
}
|
||||
|
||||
drawTile
|
||||
:: Map ImgId Image
|
||||
-> Context
|
||||
-> Double
|
||||
-> Double
|
||||
-> Int
|
||||
-> Int
|
||||
-> Maybe ImgId
|
||||
-> ImgId
|
||||
-> IO ()
|
||||
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
|
||||
save ctx
|
||||
if (isNothing img)
|
||||
then drawPlayer
|
||||
else do
|
||||
if (Prelude.null mb)
|
||||
then do
|
||||
drawImage
|
||||
drawPlayer
|
||||
else do
|
||||
if (all (\m -> pr > (fromIntegral (floor pr :: Int)) + m) minrs &&
|
||||
all (\m -> pc < (fromIntegral (floor pc :: Int)) + m) mincs) ||
|
||||
(all (\m -> pr > (fromIntegral (floor pr :: Int)) + m) minrs &&
|
||||
all (\m -> pc < (fromIntegral (floor pc :: Int)) + m) maxcs)
|
||||
then do
|
||||
drawImage
|
||||
drawPlayer
|
||||
else do
|
||||
drawPlayer
|
||||
drawImage
|
||||
restore ctx
|
||||
where
|
||||
tileWidth = 64 :: Double
|
||||
tileHeight = 32 :: Double
|
||||
minrs = Prelude.map (fst . matmin) mb
|
||||
maxrs = Prelude.map (fst . matmax) mb
|
||||
mincs = Prelude.map (snd . matmin) mb
|
||||
maxcs = Prelude.map (snd . matmax) mb
|
||||
x = realToFrac $ 640 + ((fromIntegral col - pc) +
|
||||
(fromIntegral row - pr)) * (tileWidth / 2) :: CFloat
|
||||
y = realToFrac $ 360 - (tileHeight / 2) + ((fromIntegral row - pr) -
|
||||
(fromIntegral col - pc)) * (tileHeight / 2) :: CFloat
|
||||
dist = distance (V2 (fromIntegral row) (fromIntegral col))
|
||||
(V2 (realToFrac pr - 1) (realToFrac pc)) / 4
|
||||
fact =
|
||||
if (pr <= fromIntegral row + minimum maxrs &&
|
||||
pc >= fromIntegral col + maximum mincs) &&
|
||||
isWall (fromJust img)
|
||||
then min 1 dist
|
||||
else 1
|
||||
mb = imgObstacle img
|
||||
drawImage = do
|
||||
beginPath ctx
|
||||
paint <- imagePattern
|
||||
ctx x (y - (74 - realToFrac tileHeight))
|
||||
(realToFrac tileWidth) 74
|
||||
0
|
||||
(ai Map.! fromJust img)
|
||||
fact
|
||||
rect ctx x (y - (74 - realToFrac tileHeight)) (realToFrac tileWidth) 74
|
||||
fillPaint ctx paint
|
||||
fill ctx
|
||||
drawPlayer = do
|
||||
when (floor pr == row && floor pc == col) $ do
|
||||
beginPath ctx
|
||||
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
|
||||
:: V2 Double
|
||||
-> V2 Double
|
||||
|
|
|
|||
|
|
@ -63,14 +63,14 @@ data ImgId
|
|||
| ImgMiscTable3
|
||||
| ImgMiscTable4
|
||||
| ImgMiscTableCorner
|
||||
| ImgIntrNE
|
||||
| ImgIntrE
|
||||
| ImgIntrSE
|
||||
| ImgIntrS
|
||||
| ImgIntrSW
|
||||
| ImgIntrW
|
||||
| ImgIntrNW
|
||||
| ImgIntrN
|
||||
-- | ImgIntrNE
|
||||
-- | ImgIntrE
|
||||
-- | ImgIntrSE
|
||||
-- | ImgIntrS
|
||||
-- | ImgIntrSW
|
||||
-- | ImgIntrW
|
||||
-- | ImgIntrNW
|
||||
-- | ImgIntrN
|
||||
deriving (Show, Eq, Ord, Enum)
|
||||
|
||||
isWall :: ImgId -> Bool
|
||||
|
|
@ -155,15 +155,15 @@ data Direction
|
|||
| 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
|
||||
-- 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)
|
||||
|
|
@ -248,14 +248,17 @@ generalUnSubscribe t uu =
|
|||
|
||||
data AnimId = AnimId
|
||||
{ aiVariation :: Int
|
||||
, aiName :: String -- CHANGE ME !!!
|
||||
, aiDirection :: Direction
|
||||
}
|
||||
deriving (Show, Eq, Ord)
|
||||
|
||||
data AnimState = AnimState
|
||||
{ asId :: AnimId
|
||||
, asCurrentFrame :: Int
|
||||
, asElapsedTime :: Double
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
data AnimPlayback
|
||||
= APLoop
|
||||
|
|
@ -264,5 +267,13 @@ data AnimPlayback
|
|||
data Animation = Animation
|
||||
{ animDuration :: Double
|
||||
, animSprites :: [Image]
|
||||
, animPLay :: AnimPlayback
|
||||
, animPlay :: AnimPlayback
|
||||
}
|
||||
|
||||
data AnimationConfig = AnimationConfig
|
||||
{ animConfOffset :: (Int, Int)
|
||||
, animConfSize :: (Int, Int)
|
||||
, animConfCount :: Int
|
||||
, animConfDuration :: Double
|
||||
, animConfPlay :: AnimPlayback
|
||||
}
|
||||
|
|
|
|||
Loading…
Reference in a new issue