drawing animation properly

This commit is contained in:
nek0 2018-05-30 16:20:58 +02:00
parent 81abbaf91e
commit e83482e8ea
4 changed files with 351 additions and 177 deletions

View file

@ -12,7 +12,7 @@ import qualified Graphics.Rendering.OpenGL as GL
import NanoVG hiding (V2(..), V3(..)) import NanoVG hiding (V2(..), V3(..))
import NanoVG.Internal.Image (ImageFlags(..)) import NanoVG.Internal.Image (ImageFlags(..))
import Linear import Linear hiding (E(..))
import Codec.Picture as CP import Codec.Picture as CP
import Codec.Picture.Extra import Codec.Picture.Extra
@ -77,23 +77,64 @@ load = do
when (any isNothing mimgs) $ do when (any isNothing mimgs) $ do
logIO Error "Failed to load image assets" logIO Error "Failed to load image assets"
exitFailure exitFailure
playerImgs <- loadPlayerSprite "assets/intruder.png" 64 74 nvg -- playerImgs <- loadPlayerSprite "assets/intruder.png" 64 74 nvg
(zipWith (\a b -> (a, [b])) [0..] $ [ImgIntrE .. ImgIntrN] ++ [ImgIntrNE]) -- (zipWith (\a b -> (a, [b])) [0..] $ [ImgIntrE .. ImgIntrN] ++ [ImgIntrNE])
let imgs = zipWith (\a b -> (a, fromJust b)) [ImgWallAsc ..] mimgs 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 return UserData
{ state = Menu { state = Menu
, subsystems = subs , subsystems = subs
, assetImages = M.fromList , assetImages = M.fromList imgs
(imgs ++ playerImgs) , assetAnimations = M.fromList animations
, assetFonts = M.fromList , assetFonts = M.fromList
[ (FontBedstead, "bedstead") [ (FontBedstead, "bedstead")
] ]
, nano = nvg , nano = nvg
, uuid = [] , uuid = []
, worldState = ws , worldState = ws
, stateData = None , 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 loadPlayerSprite
:: FilePath -- Path to spritemap :: FilePath -- Path to spritemap
-> Int -- width of single sprite -> Int -- width of single sprite
@ -112,7 +153,8 @@ loadPlayerSprite fp w h nvg rids = do
ret <- mapM (\(row, ids) -> do ret <- mapM (\(row, ids) -> do
mapM (\(num, id) -> do mapM (\(num, id) -> do
let cr = crop (num * w) (row * h) w h img 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 case mresimg of
Nothing -> do Nothing -> do
logIO Error ("Failed to load: " ++ fp ++ " " ++ show id) logIO Error ("Failed to load: " ++ fp ++ " " ++ show id)

View file

@ -26,55 +26,55 @@ import Types.Interior
import Types.Map import Types.Map
import Types.ReachPoint import Types.ReachPoint
drawNPCs -- drawNPCs
:: Map ImgId Image -- :: Map ImgId Image
-> Context -- -> Context
-> UserData -- -> UserData
-> [(V2 Double, Direction)] -- -> [(V2 Double, Direction)]
-> Double -- -> Double
-> Double -- -> Double
-> Int -- -> Int
-> Int -- -> Int
-> Maybe ImgId -- -> Maybe ImgId
-> IO () -- -> IO ()
drawNPCs ai ctx ud npcposrots prow pcol row col img = do -- drawNPCs ai ctx ud npcposrots prow pcol row col img = do
let fnpcposrots = filter -- let fnpcposrots = filter
(\((V2 nr nc, dir)) -> -- (\((V2 nr nc, dir)) ->
let x = realToFrac $ 640 + ((nc - pcol) + (nr - prow)) * 32 -- let x = realToFrac $ 640 + ((nc - pcol) + (nr - prow)) * 32
y = realToFrac $ 360 + ((nr - prow) - (nc - pcol)) * 16 -- y = realToFrac $ 360 + ((nr - prow) - (nc - pcol)) * 16
in ((realToFrac x > -tileWidth && realToFrac y > -tileHeight) && -- in ((realToFrac x > -tileWidth && realToFrac y > -tileHeight) &&
(realToFrac x < 1280 && realToFrac (y - (74 - realToFrac tileHeight)) < 720)) && -- (realToFrac x < 1280 && realToFrac (y - (74 - realToFrac tileHeight)) < 720)) &&
((all (\m -> prow > (fromIntegral (floor prow :: Int)) + m) minrs && -- ((all (\m -> prow > (fromIntegral (floor prow :: Int)) + m) minrs &&
all (\m -> pcol < (fromIntegral (floor pcol :: Int)) + m) mincs) || -- all (\m -> pcol < (fromIntegral (floor pcol :: Int)) + m) mincs) ||
(all (\m -> prow > (fromIntegral (floor prow :: Int)) + m) minrs && -- (all (\m -> prow > (fromIntegral (floor prow :: Int)) + m) minrs &&
all (\m -> pcol < (fromIntegral (floor pcol :: Int)) + m) maxcs)) && -- all (\m -> pcol < (fromIntegral (floor pcol :: Int)) + m) maxcs)) &&
(floor nr == row && floor nc == col) -- (floor nr == row && floor nc == col)
) -- )
npcposrots -- npcposrots
mapM_ -- mapM_
(\((V2 nr nc, dir)) -> do -- (\((V2 nr nc, dir)) -> do
let x = realToFrac $ 640 + ((nc - pcol) + (nr - prow)) * 32 -- let x = realToFrac $ 640 + ((nc - pcol) + (nr - prow)) * 32
y = realToFrac $ 360 + ((nr - prow) - (nc - pcol)) * 16 -- y = realToFrac $ 360 + ((nr - prow) - (nc - pcol)) * 16
beginPath ctx -- beginPath ctx
paint <- imagePattern ctx (x - 32) (y - 58) 64 74 0 -- paint <- imagePattern ctx (x - 32) (y - 58) 64 74 0
(ai Map.! (dirToImgId dir)) 1 -- (ai Map.! (dirToImgId dir)) 1
rect ctx (x - realToFrac (tileWidth / 2)) (y - 58) -- rect ctx (x - realToFrac (tileWidth / 2)) (y - 58)
(realToFrac tileWidth) 74 -- (realToFrac tileWidth) 74
fillPaint ctx paint -- fillPaint ctx paint
-- circle ctx x y 5 -- -- circle ctx x y 5
-- closePath ctx -- -- closePath ctx
-- fillColor ctx (rgba 255 0 0 255) -- -- fillColor ctx (rgba 255 0 0 255)
fill ctx -- fill ctx
) -- )
fnpcposrots -- fnpcposrots
where -- where
tileWidth = 64 :: Double -- tileWidth = 64 :: Double
tileHeight = 32 :: Double -- tileHeight = 32 :: Double
mb = imgObstacle img -- mb = imgObstacle img
minrs = Prelude.map (fst . matmin) mb -- minrs = Prelude.map (fst . matmin) mb
maxrs = Prelude.map (fst . matmax) mb -- maxrs = Prelude.map (fst . matmax) mb
mincs = Prelude.map (snd . matmin) mb -- mincs = Prelude.map (snd . matmin) mb
maxcs = Prelude.map (snd . matmax) mb -- maxcs = Prelude.map (snd . matmax) mb
placeNPCs placeNPCs
:: M.Matrix (Maybe ImgId) :: M.Matrix (Maybe ImgId)

View file

@ -18,6 +18,7 @@ import qualified Data.Text as T
import Data.Matrix as M import Data.Matrix as M
import Data.Ecstasy as E import Data.Ecstasy as E
import Data.Maybe import Data.Maybe
import Data.List (sortOn)
import System.Random (randomRIO) import System.Random (randomRIO)
@ -39,8 +40,8 @@ loadMap :: Affection UserData ()
loadMap = do loadMap = do
ud <- getAffection ud <- getAffection
let fc = FloorConfig let fc = FloorConfig
(20, 20) (10, 10)
[(5,5), (35, 35)] []
(50, 50) (50, 50)
(Subsystems _ m) = subsystems ud (Subsystems _ m) = subsystems ud
(mat, gr) <- liftIO $ buildHallFloorIO fc (mat, gr) <- liftIO $ buildHallFloorIO fc
@ -56,20 +57,19 @@ loadMap = do
(inter, rps) <- liftIO $ placeInteriorIO mat imgmat exits gr (inter, rps) <- liftIO $ placeInteriorIO mat imgmat exits gr
liftIO $ logIO A.Debug ("number of reachpoints: " ++ show (length rps)) liftIO $ logIO A.Debug ("number of reachpoints: " ++ show (length rps))
let nnex = Prelude.filter (\p -> pointType p /= RoomExit) rps let nnex = Prelude.filter (\p -> pointType p /= RoomExit) rps
playerAnim = Animations -- playerAnim = Animations
{ animStand = Map.fromList -- { animStand = Map.fromList
(zip [NE .. N] [ImgIntrNE .. ImgIntrN]) -- (zip [NE .. N] [ImgIntrNE .. ImgIntrN])
} -- }
npcposs <- placeNPCs inter mat rps gr 50 -- (length nnex) npcposs <- placeNPCs inter mat rps gr 50 -- (length nnex)
liftIO $ A.logIO A.Debug $ "number of placed NPCs: " ++ show (length npcposs) liftIO $ A.logIO A.Debug $ "number of placed NPCs: " ++ show (length npcposs)
(nws, _) <- liftIO $ yieldSystemT (worldState ud) $ do (nws, _) <- liftIO $ yieldSystemT (worldState ud) $ do
createEntity $ newEntity createEntity $ newEntity
{ pos = Just (V2 20.5 20.5) { pos = Just (V2 10.5 10.5)
, vel = Just (V2 0 0) , vel = Just (V2 0 0)
, player = Just () , player = Just ()
, rot = Just SE , rot = Just SE
, anim = Just playerAnim , anim = Just $ AnimState (AnimId 0 "standing" SE) 0 0
, animCurrFrame = Just (0, 0)
} }
void $ mapM_ (\npcpos@(V2 nr nc) -> do void $ mapM_ (\npcpos@(V2 nr nc) -> do
-- ttl <- liftIO $ randomRIO (5, 30) -- ttl <- liftIO $ randomRIO (5, 30)
@ -82,8 +82,7 @@ loadMap = do
, velFact = Just fact , velFact = Just fact
, rot = Just SE , rot = Just SE
, npcState = Just (NPCStanding 0 future) , npcState = Just (NPCStanding 0 future)
, anim = Just playerAnim , anim = Just $ AnimState (AnimId 0 "standing" SE) 0 0
, animCurrFrame = Just (0, 0)
} }
) npcposs ) npcposs
uu <- partSubscribe m movePlayer uu <- partSubscribe m movePlayer
@ -138,7 +137,7 @@ drawMap :: Affection UserData ()
drawMap = do drawMap = do
ud <- getAffection ud <- getAffection
dt <- getDelta 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 (pc, dir) <- fmap head $ efor allEnts $ do
with player with player
with pos with pos
@ -146,14 +145,19 @@ drawMap = do
pos' <- query pos pos' <- query pos
rot' <- query rot rot' <- query rot
pure (pos', rot') pure (pos', rot')
-- (_, npcposs) <- yieldSystemT (worldState ud) $ do -- npcsrots <- efor allEnts $ do
npcsrots <- efor allEnts $ do -- with npcState
with npcState -- with pos
-- pos' <- query pos
-- rot' <- query rot
-- pure (pos', rot')
posanims <- efor allEnts $ do
with anim
with pos with pos
state <- query anim
pos' <- query pos pos' <- query pos
rot' <- query rot return (pos', state)
pure (pos', rot') return (pc, dir, posanims)
return (pc, dir, npcsrots)
let V2 pr pc = playerPos let V2 pr pc = playerPos
mat = imgMat (stateData ud) mat = imgMat (stateData ud)
ctx = nano ud ctx = nano ud
@ -180,8 +184,9 @@ drawMap = do
fill ctx fill ctx
mapM_ (\(i, ls) -> mapM_ mapM_ (\(i, ls) -> mapM_
(\(j, t) -> do (\(j, t) -> do
drawTile (assetImages ud) ctx pr pc i j t (dirToImgId playerRot) drawTile ud ctx posanims pr pc i j t
drawNPCs (assetImages ud) ctx ud npcposrots 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)) (reverse $ zip [1..] ls))
(zip [1..] (toLists mat)) (zip [1..] (toLists mat))
@ -192,6 +197,149 @@ drawMap = do
fillColor ctx (rgb 255 128 0) fillColor ctx (rgb 255 128 0)
textBox ctx 0 0 200 ("FPS: " `T.append` (T.pack $ Prelude.take 5 $ show (1/dt))) 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 :: Double -> Affection UserData ()
updateMap dt = do updateMap dt = do
let direction :: V2 Double -> Direction -> Direction let direction :: V2 Double -> Direction -> Direction
@ -214,21 +362,63 @@ updateMap dt = do
else rot' else rot'
ud <- getAffection ud <- getAffection
(nws, _) <- liftIO $ yieldSystemT (worldState ud) $ do (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 emap allEnts $ do
without player without player
with vel with vel
with velFact with velFact
with pos with pos
with rot with rot
with anim
pos'@(V2 pr pc) <- query pos pos'@(V2 pr pc) <- query pos
vel' <- query vel vel' <- query vel
rot' <- query rot rot' <- query rot
fact' <- query velFact fact' <- query velFact
state <- query anim
let npos@(V2 nr nc) = pos' + fmap (* (dt * fact')) vel' let npos@(V2 nr nc) = pos' + fmap (* (dt * fact')) vel'
dpos = npos - pos' dpos = npos - pos'
aId = asId state
ent = unchanged ent = unchanged
{ pos = Set $ npos { pos = Set $ npos
, rot = Set $ direction vel' rot' , rot = Set $ direction vel' rot'
, anim = Set state
{ asId = aId
{ aiDirection = direction vel' rot'
}
}
} }
return ent return ent
emap allEnts $ do emap allEnts $ do
@ -236,11 +426,14 @@ updateMap dt = do
with vel with vel
with pos with pos
with rot with rot
with anim
pos'@(V2 pr pc) <- query pos pos'@(V2 pr pc) <- query pos
vel'@(V2 vr vc) <- query vel vel'@(V2 vr vc) <- query vel
rot' <- query rot rot' <- query rot
state <- query anim
let npos@(V2 nr nc) = pos' + fmap (* dt) vel' let npos@(V2 nr nc) = pos' + fmap (* dt) vel'
dpos@(V2 dpr dpc) = npos - pos' dpos@(V2 dpr dpc) = npos - pos'
aId = asId state
len = sqrt (dpos `dot` dpos) len = sqrt (dpos `dot` dpos)
lll = (,) lll = (,)
<$> ( <$> (
@ -286,6 +479,11 @@ updateMap dt = do
(A.log A.Verbose (show lll ++ " " ++ show len) lll) (A.log A.Verbose (show lll ++ " " ++ show len) lll)
) )
, rot = Set (direction vel' rot') , rot = Set (direction vel' rot')
, anim = Set state
{ asId = aId
{ aiDirection = direction vel' rot'
}
}
} }
return ent return ent
updateNPCs updateNPCs
@ -299,83 +497,6 @@ updateMap dt = do
{ worldState = nws { 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 checkBoundsCollision
:: V2 Double :: V2 Double
-> V2 Double -> V2 Double

View file

@ -63,14 +63,14 @@ data ImgId
| ImgMiscTable3 | ImgMiscTable3
| ImgMiscTable4 | ImgMiscTable4
| ImgMiscTableCorner | ImgMiscTableCorner
| ImgIntrNE -- | ImgIntrNE
| ImgIntrE -- | ImgIntrE
| ImgIntrSE -- | ImgIntrSE
| ImgIntrS -- | ImgIntrS
| ImgIntrSW -- | ImgIntrSW
| ImgIntrW -- | ImgIntrW
| ImgIntrNW -- | ImgIntrNW
| ImgIntrN -- | ImgIntrN
deriving (Show, Eq, Ord, Enum) deriving (Show, Eq, Ord, Enum)
isWall :: ImgId -> Bool isWall :: ImgId -> Bool
@ -155,15 +155,15 @@ data Direction
| N | N
deriving (Show, Eq, Ord, Enum) deriving (Show, Eq, Ord, Enum)
dirToImgId :: Direction -> ImgId -- dirToImgId :: Direction -> ImgId
dirToImgId E = ImgIntrE -- dirToImgId E = ImgIntrE
dirToImgId SE = ImgIntrSE -- dirToImgId SE = ImgIntrSE
dirToImgId S = ImgIntrS -- dirToImgId S = ImgIntrS
dirToImgId SW = ImgIntrSW -- dirToImgId SW = ImgIntrSW
dirToImgId W = ImgIntrW -- dirToImgId W = ImgIntrW
dirToImgId NW = ImgIntrNW -- dirToImgId NW = ImgIntrNW
dirToImgId N = ImgIntrN -- dirToImgId N = ImgIntrN
dirToImgId NE = ImgIntrNE -- dirToImgId NE = ImgIntrNE
data Entity f = Entity data Entity f = Entity
{ pos :: Component f 'Field (V2 Double) { pos :: Component f 'Field (V2 Double)
@ -248,14 +248,17 @@ generalUnSubscribe t uu =
data AnimId = AnimId data AnimId = AnimId
{ aiVariation :: Int { aiVariation :: Int
, aiName :: String -- CHANGE ME !!!
, aiDirection :: Direction , aiDirection :: Direction
} }
deriving (Show, Eq, Ord)
data AnimState = AnimState data AnimState = AnimState
{ asId :: AnimId { asId :: AnimId
, asCurrentFrame :: Int , asCurrentFrame :: Int
, asElapsedTime :: Double , asElapsedTime :: Double
} }
deriving (Show)
data AnimPlayback data AnimPlayback
= APLoop = APLoop
@ -264,5 +267,13 @@ data AnimPlayback
data Animation = Animation data Animation = Animation
{ animDuration :: Double { animDuration :: Double
, animSprites :: [Image] , animSprites :: [Image]
, animPLay :: AnimPlayback , animPlay :: AnimPlayback
}
data AnimationConfig = AnimationConfig
{ animConfOffset :: (Int, Int)
, animConfSize :: (Int, Int)
, animConfCount :: Int
, animConfDuration :: Double
, animConfPlay :: AnimPlayback
} }