From 9d5b3d62a02d9e129734cdcb7482f5218dfe8138 Mon Sep 17 00:00:00 2001 From: nek0 Date: Tue, 3 Jul 2018 02:20:17 +0200 Subject: [PATCH] new Typeclasses for Collision and drawing --- src/Main.hs | 2 +- src/MainGame/MindMap.hs | 2 +- src/MainGame/WorldMap.hs | 32 +++++----------- src/NPC.hs | 2 +- src/Types.hs | 2 + src/Types/Collidible.hs | 79 ++++++++++++++++++++++++++++++++++++++++ src/Types/Drawable.hs | 38 +++++++++++++++++++ src/Types/ImgId.hs | 58 ----------------------------- src/Util.hs | 12 +++--- tracer-game.cabal | 2 + 10 files changed, 139 insertions(+), 90 deletions(-) create mode 100644 src/Types/Collidible.hs create mode 100644 src/Types/Drawable.hs diff --git a/src/Main.hs b/src/Main.hs index 298c629..32657a1 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -16,7 +16,7 @@ import Data.Maybe (fromJust) -- internal imports -import Types +import Types hiding (draw) import StateMachine () import Init diff --git a/src/MainGame/MindMap.hs b/src/MainGame/MindMap.hs index e47c84e..5aee8f3 100644 --- a/src/MainGame/MindMap.hs +++ b/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))) diff --git a/src/MainGame/WorldMap.hs b/src/MainGame/WorldMap.hs index 97663d3..5f5d6cd 100644 --- a/src/MainGame/WorldMap.hs +++ b/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))) diff --git a/src/NPC.hs b/src/NPC.hs index 5ce3a53..9166f33 100644 --- a/src/NPC.hs +++ b/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 diff --git a/src/Types.hs b/src/Types.hs index d1b3feb..ae40eab 100644 --- a/src/Types.hs +++ b/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 diff --git a/src/Types/Collidible.hs b/src/Types/Collidible.hs new file mode 100644 index 0000000..2552a5e --- /dev/null +++ b/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 _ = [] diff --git a/src/Types/Drawable.hs b/src/Types/Drawable.hs new file mode 100644 index 0000000..d93f89d --- /dev/null +++ b/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 diff --git a/src/Types/ImgId.hs b/src/Types/ImgId.hs index 9c3dbaa..0c877c3 100644 --- a/src/Types/ImgId.hs +++ b/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 _ = [] diff --git a/src/Util.hs b/src/Util.hs index 0730b75..317c0f7 100644 --- a/src/Util.hs +++ b/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 diff --git a/tracer-game.cabal b/tracer-game.cabal index 2f9400c..86361b2 100644 --- a/tracer-game.cabal +++ b/tracer-game.cabal @@ -28,6 +28,8 @@ executable tracer-game , Types.StateData , Types.Animation , Types.MindMap + , Types.Drawable + , Types.Collidible , StateMachine , Floorplan , Interior