diff --git a/src/Init.hs b/src/Init.hs index 7c2d49a..29b4dbe 100644 --- a/src/Init.hs +++ b/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) diff --git a/src/NPC.hs b/src/NPC.hs index 8cc3efe..ea353bb 100644 --- a/src/NPC.hs +++ b/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) diff --git a/src/Test.hs b/src/Test.hs index 1932f70..ed7eef8 100644 --- a/src/Test.hs +++ b/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 diff --git a/src/Types/UserData.hs b/src/Types/UserData.hs index c92210e..79297eb 100644 --- a/src/Types/UserData.hs +++ b/src/Types/UserData.hs @@ -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 }