new Typeclasses for Collision and drawing

src/Main.hs

@@ -16,7 +16,7 @@ import Data.Maybe (fromJust)
 
 -- internal imports
 
-import Types
+import Types hiding (draw)
 import StateMachine ()
 import Init
 

src/MainGame/MindMap.hs

@@ -147,7 +147,7 @@ updateMind dt = do
            (
              concatMap
              (\(dr, dc) ->
-               let bs = fromMaybe [] (imgObstacle <$> M.safeGet
+               let bs = maybe [] collisionObstacle (fromMaybe Nothing $ M.safeGet
                      (fromIntegral $ floor pr + dr)
                      (fromIntegral $ floor pc + dc)
                      (mmImgMat (stateData ud)))

src/MainGame/WorldMap.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE TypeFamilies #-}
 module MainGame.WorldMap where
 
 import Affection as A
@@ -280,7 +282,8 @@ drawTile ud ctx posanims pr pc row col img =
         let (bef, beh) = L.partition delimiter sorted
         save ctx
         mapM_ drawAnim beh
-        when (isJust img) drawImage
+        maybe (return ()) (draw ud x (y - 42) 64 74 fact)
+          ((assetImages ud Map.!) <$> img)
         mapM_ drawAnim bef
         restore ctx
   where
@@ -319,28 +322,11 @@ drawTile ud ctx posanims pr pc row col img =
          isWall (fromJust img)
       then min 1 dist
       else 1
-    mb = imgObstacle img
+    mb = maybe [] collisionObstacle 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
+      let ax = realToFrac $ 640 + ((nc - pc) + (nr - pr)) * 32 - 32
+          ay = realToFrac $ 360 + ((nr - pr) - (nc - pc)) * 16 - 58
+      draw ud ax ay 64 74 1 as
 
 updateMap :: Double -> Affection UserData ()
 updateMap dt = do
@@ -525,7 +511,7 @@ updateMap dt = do
               (
                 concatMap
                 (\(dr, dc) ->
-                  let bs = fromMaybe [] (imgObstacle <$> M.safeGet
+                  let bs = maybe [] collisionObstacle (fromMaybe Nothing $ M.safeGet
                         (fromIntegral $ floor pr + dr)
                         (fromIntegral $ floor pc + dc)
                         (imgMat (stateData ud)))

src/NPC.hs

@@ -91,7 +91,7 @@ placeNPCs imgmat tilemat rp gr count =
       then do
         r <- randomRIO (1, M.nrows imgmat)
         c <- randomRIO (1, M.ncols imgmat)
-        if null (imgObstacle $ imgmat M.! (r, c)) &&
+        if null (maybe [] collisionObstacle $ imgmat M.! (r, c)) &&
           tilemat M.! (r, c) == Hall
         then doPlace (nr + 1) ((V2 (fromIntegral r) (fromIntegral c)) : acc)
         else do

src/Types.hs

@@ -12,3 +12,5 @@ import Types.Direction as T
 import Types.StateData as T
 import Types.Animation as T
 import Types.MindMap as T
+import Types.Drawable as T
+import Types.Collidible as T

src/Types/Collidible.hs

@@ -0,0 +1,79 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
+module Types.Collidible where
+
+import Affection as A
+
+-- internal imports
+
+import Types.Map (Boundaries(..))
+import Types.ImgId (ImgId(..))
+import Types.Animation (AnimState(..))
+
+class Collidible c where
+  collisionObstacle :: c -> [(Boundaries Double)]
+
+instance Collidible AnimState where
+
+instance Collidible ImgId where
+  collisionObstacle ImgMiscBox1 =
+    [ Boundaries (0.2, 0.34) (0.8, 1)
+    ]
+  collisionObstacle ImgWallAsc =
+    [ Boundaries (0.34, 0) (0.66, 1)
+    ]
+  collisionObstacle ImgWallDesc =
+    [ Boundaries (0, 0.34) (1, 0.66)
+    ]
+  collisionObstacle ImgWallCornerN =
+    [ Boundaries (0, 0.34) (0.66, 0.66)
+    , Boundaries (0.34, 0.34) (0.66, 1)
+    ]
+  collisionObstacle ImgWallCornerE =
+    [ Boundaries (0.34, 0.34) (1, 0.66)
+    , Boundaries (0.34, 0.34) (0.66, 1)
+    ]
+  collisionObstacle ImgWallCornerS =
+    [ Boundaries (0.34, 0.34) (1, 0.66)
+    , Boundaries (0.34, 0) (0.66, 0.66)
+    ]
+  collisionObstacle ImgWallCornerW =
+    [ Boundaries (0, 0.34) (0.66, 0.66)
+    , Boundaries (0.34, 0) (0.66, 0.66)
+    ]
+  collisionObstacle ImgWallTNE =
+    [ Boundaries (0, 0.34) (1, 0.66)
+    , Boundaries (0.34, 0.34) (0.66, 1)
+    ]
+  collisionObstacle ImgWallTSW =
+    [ Boundaries (0, 0.34) (1, 0.66)
+    , Boundaries (0.34, 0) (0.66, 0.66)
+    ]
+  collisionObstacle ImgWallTSE =
+    [ Boundaries (0.34, 0) (0.66, 1)
+    , Boundaries (0.34, 0.34) (1, 0.66)
+    ]
+  collisionObstacle ImgWallTNW =
+    [ Boundaries (0.34, 0) (0.66, 1)
+    , Boundaries (0, 0.34) (0.66, 0.66)
+    ]
+  collisionObstacle ImgWallCross =
+    [ Boundaries (0.34, 0) (0.66, 1)
+    , Boundaries (0, 0.34) (1, 0.66)
+    ]
+  collisionObstacle ImgMiscTable1 =
+    [ Boundaries (0, 0.34) (1, 1)
+    ]
+  collisionObstacle ImgMiscTable2 =
+    [ Boundaries (0, 0) (0.63, 1)
+    ]
+  collisionObstacle ImgMiscTable3 =
+    [ Boundaries (0, 0) (1, 0.63)
+    ]
+  collisionObstacle ImgMiscTable4 =
+    [ Boundaries (0.34, 0) (1, 1)
+    ]
+  collisionObstacle ImgMiscTableCorner =
+    [ Boundaries (0, 0) (0.63, 1)
+    , Boundaries (0, 0.34) (1, 1)
+    ]
+  collisionObstacle _ = []

src/Types/Drawable.hs

@@ -0,0 +1,38 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+module Types.Drawable where
+
+import Affection as A
+
+import qualified Data.Map.Strict as Map
+
+import NanoVG
+
+import Foreign.C.Types (CFloat(..))
+
+-- internal imports
+
+import Types.Animation
+import Types.UserData
+
+class NanoDrawable us a where
+  draw :: us -> CFloat -> CFloat -> CFloat -> CFloat -> CFloat -> a -> IO ()
+
+instance NanoDrawable UserData Image where
+  draw us x y w h alpha img = do
+    let ctx = nano us
+    save ctx
+    beginPath ctx
+    paint <- imagePattern ctx x y w h 0 img alpha
+    rect ctx x y w h
+    fillPaint ctx paint
+    closePath ctx
+    fill ctx
+    restore ctx
+
+instance NanoDrawable UserData AnimState where
+  draw us x y w h alpha as = do
+    let anims = assetAnimations us
+        a = anims Map.! asId as
+        img = (animSprites a !! asCurrentFrame as) :: Image
+    draw us x y w h alpha img

src/Types/ImgId.hs

@@ -39,61 +39,3 @@ isWall ImgMiscTable3 = False
 isWall ImgMiscTable4 = False
 isWall ImgMiscTableCorner = False
 isWall _ = True
-
-imgObstacle :: Maybe ImgId -> [(Boundaries Double)]
-imgObstacle (Just ImgMiscBox1) = [Boundaries (0.2, 0.34) (0.8, 1)]
-imgObstacle (Just ImgWallAsc) = [Boundaries (0.34, 0) (0.66, 1)]
-imgObstacle (Just ImgWallDesc) = [Boundaries (0, 0.34) (1, 0.66)]
-imgObstacle (Just ImgWallCornerN) =
-  [ Boundaries (0, 0.34) (0.66, 0.66)
-  , Boundaries (0.34, 0.34) (0.66, 1)
-  ]
-imgObstacle (Just ImgWallCornerE) =
-  [ Boundaries (0.34, 0.34) (1, 0.66)
-  , Boundaries (0.34, 0.34) (0.66, 1)
-  ]
-imgObstacle (Just ImgWallCornerS) =
-  [ Boundaries (0.34, 0.34) (1, 0.66)
-  , Boundaries (0.34, 0) (0.66, 0.66)
-  ]
-imgObstacle (Just ImgWallCornerW) =
-  [ Boundaries (0, 0.34) (0.66, 0.66)
-  , Boundaries (0.34, 0) (0.66, 0.66)
-  ]
-imgObstacle (Just ImgWallTNE) =
-  [ Boundaries (0, 0.34) (1, 0.66)
-  , Boundaries (0.34, 0.34) (0.66, 1)
-  ]
-imgObstacle (Just ImgWallTSW) =
-  [ Boundaries (0, 0.34) (1, 0.66)
-  , Boundaries (0.34, 0) (0.66, 0.66)
-  ]
-imgObstacle (Just ImgWallTSE) =
-  [ Boundaries (0.34, 0) (0.66, 1)
-  , Boundaries (0.34, 0.34) (1, 0.66)
-  ]
-imgObstacle (Just ImgWallTNW) =
-  [ Boundaries (0.34, 0) (0.66, 1)
-  , Boundaries (0, 0.34) (0.66, 0.66)
-  ]
-imgObstacle (Just ImgWallCross) =
-  [ Boundaries (0.34, 0) (0.66, 1)
-  , Boundaries (0, 0.34) (1, 0.66)
-  ]
-imgObstacle (Just ImgMiscTable1) =
-  [ Boundaries (0, 0.34) (1, 1)
-  ]
-imgObstacle (Just ImgMiscTable2) =
-  [ Boundaries (0, 0) (0.63, 1)
-  ]
-imgObstacle (Just ImgMiscTable3) =
-  [ Boundaries (0, 0) (1, 0.63)
-  ]
-imgObstacle (Just ImgMiscTable4) =
-  [ Boundaries (0.34, 0) (1, 1)
-  ]
-imgObstacle (Just ImgMiscTableCorner) =
-  [ Boundaries (0, 0) (0.63, 1)
-  , Boundaries (0, 0.34) (1, 1)
-  ]
-imgObstacle _ = []

src/Util.hs

@@ -149,8 +149,8 @@ naviGraph imgmat (V2 r c) =
         foldl
           (\acc (or, oc) ->
             if null
-              (fromMaybe [] $
-              imgObstacle <$> M.safeGet (r + or) (c + oc) imgmat)
+              (maybe [] collisionObstacle
+                (fromMaybe Nothing $ M.safeGet (r + or) (c + oc) imgmat))
             then V2 (r + or) (c + oc): acc
             else acc
             )
@@ -159,12 +159,12 @@ naviGraph imgmat (V2 r c) =
       list2 =
         foldl
           (\acc (or, oc) ->
-            if null (fromMaybe [] $
-              imgObstacle <$> M.safeGet (r + or) (c + oc) imgmat)
+            if null (maybe [] collisionObstacle
+              (fromMaybe Nothing $ M.safeGet (r + or) (c + oc) imgmat))
               && all null
               (map
-              (\(oor, ooc) -> fromMaybe [] $
-                imgObstacle <$> M.safeGet (r + oor) (c + ooc) imgmat)
+              (\(oor, ooc) -> maybe [] collisionObstacle
+                (fromMaybe Nothing $ M.safeGet (r + oor) (c + ooc) imgmat))
               [(0, oc), (or, 0)])
             then V2 (r + or) (c + oc): acc
             else acc

tracer-game.cabal

@@ -28,6 +28,8 @@ executable tracer-game
                      , Types.StateData
                      , Types.Animation
                      , Types.MindMap
+                     , Types.Drawable
+                     , Types.Collidible
                      , StateMachine
                      , Floorplan
                      , Interior