new Typeclasses for Collision and drawing

This commit is contained in:
nek0 2018-07-03 02:20:17 +02:00
parent a1abb9f379
commit 9d5b3d62a0
10 changed files with 139 additions and 90 deletions

View file

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

View file

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

View file

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

View file

@ -91,7 +91,7 @@ placeNPCs imgmat tilemat rp gr count =
then do then do
r <- randomRIO (1, M.nrows imgmat) r <- randomRIO (1, M.nrows imgmat)
c <- randomRIO (1, M.ncols 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 tilemat M.! (r, c) == Hall
then doPlace (nr + 1) ((V2 (fromIntegral r) (fromIntegral c)) : acc) then doPlace (nr + 1) ((V2 (fromIntegral r) (fromIntegral c)) : acc)
else do else do

View file

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

79
src/Types/Collidible.hs Normal file
View file

@ -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 _ = []

38
src/Types/Drawable.hs Normal file
View file

@ -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

View file

@ -39,61 +39,3 @@ isWall ImgMiscTable3 = False
isWall ImgMiscTable4 = False isWall ImgMiscTable4 = False
isWall ImgMiscTableCorner = False isWall ImgMiscTableCorner = False
isWall _ = True 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 _ = []

View file

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

View file

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