drawing animation properly

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
+  -- 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
+      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
+    { 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")
       ]
-    , 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
   :: 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)

src/NPC.hs

@@ -26,55 +26,55 @@ import Types.Interior
 import Types.Map
 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
   :: M.Matrix (Maybe ImgId)

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)
+        (10, 10)
-        [(5,5), (35, 35)]
+        []
         (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
+      -- 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)
   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
+      , anim          = Just $ AnimState (AnimId 0 "standing" SE) 0 0
-      , animCurrFrame = Just (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
+        , anim          = Just $ AnimState (AnimId 0 "standing" SE) 0 0
-        , animCurrFrame = Just (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
-    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
+      state <- query anim
       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
       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)
+        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))
       (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

src/Types/UserData.hs

@@ -63,14 +63,14 @@ data ImgId
   | ImgMiscTable3
   | ImgMiscTable4
   | ImgMiscTableCorner
-  | ImgIntrNE
+  -- | ImgIntrNE
-  | ImgIntrE
+  -- | ImgIntrE
-  | ImgIntrSE
+  -- | ImgIntrSE
-  | ImgIntrS
+  -- | ImgIntrS
-  | ImgIntrSW
+  -- | ImgIntrSW
-  | ImgIntrW
+  -- | ImgIntrW
-  | ImgIntrNW
+  -- | ImgIntrNW
-  | ImgIntrN
+  -- | 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 :: 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
   { 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
   }