diff --git a/assets/misc/copier.kra b/assets/misc/copier.kra new file mode 100644 index 0000000..d2e0b2f Binary files /dev/null and b/assets/misc/copier.kra differ diff --git a/assets/misc/copier.png b/assets/misc/copier.png new file mode 100644 index 0000000..b15ae27 Binary files /dev/null and b/assets/misc/copier.png differ diff --git a/src/Load.hs b/src/Load.hs index 90cd7d7..d5d3089 100644 --- a/src/Load.hs +++ b/src/Load.hs @@ -227,7 +227,7 @@ loadFork ws win glc nvg future progress = do ))) copierCopy <- loadAnimationSprites "assets/misc/copier.png" nvg $ [ ( AnimId "copier" "copy" N - , AnimationConfig (64, 0) (64, 74) (64, 0) 4 0.5 APOnce + , AnimationConfig (64, 0) (64, 74) (64, 0) 4 1 APLoop ) ] modifyMVar_ progress (return . (\(p, _) -> diff --git a/src/MainGame/WorldMap.hs b/src/MainGame/WorldMap.hs index 7c77d4b..47af5b6 100644 --- a/src/MainGame/WorldMap.hs +++ b/src/MainGame/WorldMap.hs @@ -37,6 +37,7 @@ import Types import Floorplan import MindMap import NPC +import Object loadMap :: Affection UserData () loadMap = do @@ -44,12 +45,13 @@ loadMap = do let (Subsystems _ m k) = subsystems ud uu1 <- partSubscribe m movePlayer uu2 <- partSubscribe k changeMaps + uu3 <- partSubscribe m playerInteract future <- liftIO newEmptyMVar progress <- liftIO $ newMVar (0, "Ohai!") _ <- liftIO $ forkIO $ loadMapFork ud future progress putAffection ud { stateData = None - , uuid = [uu1, uu2] + , uuid = [uu1, uu2, uu3] , stateMVar = future , stateProgress = progress } @@ -133,8 +135,9 @@ loadMapFork ud future progress = do void $ createEntity $ newEntity { pos = Just $ reachCoord - V2 1 0 , obstacle = Just $ Boundaries (10/36, 8/36) (28/36, 30/36) - , anim = Just $ AnimState (AnimId "copier" "closed" N) 0 0 - , objAccess = Just $ V2 1 0 + , anim = Just $ AnimState (AnimId "copier" "open" N) 0 0 + , objAccess = Just $ (V2 1 0, NW) + , objType = Just ObjCopier } ) (A.log A.Debug ("number of copiers: " ++ show (length copiers)) copiers) void $ liftIO $ swapMVar progress (18 / loadSteps, "Registering NPCs into WorldState") @@ -204,6 +207,48 @@ movePlayer (MsgMouseButton _ _ SDL.Released _ SDL.ButtonLeft _ _) = do } movePlayer _ = return () +playerInteract :: MouseMessage -> Affection UserData () +playerInteract (MsgMouseButton _ _ SDL.Pressed _ SDL.ButtonRight _ m) = do + ud <- getAffection + (nws, relEnts) <- liftIO $ yieldSystemT (worldState ud) $ do + emap allEnts $ do + with player + with rot + rot' <- query rot + (V2 rx ry) <- liftIO $ relativizeMouseCoords m + let dr = (ry / sin (atan 0.5) / 2) + rx + dc = rx - (ry / sin (atan 0.5) / 2) + ndir = direction (V2 dr dc) + return $ unchanged + { rot = Set $ fromMaybe rot' ndir + } + [(ppos, pdir)] <- efor allEnts $ do + with player + with pos + with rot + pos' <- query pos + rot' <- query rot + return (pos', rot') + mrelEnts <- efor allEnts $ do + with pos + with objAccess + (rel, dir) <- query objAccess + pos' <- query pos + otype <- query objType + ent <- queryEnt + if (fmap floor ppos == fmap floor pos' || + fmap floor ppos == fmap floor pos' + rel) && + pdir == dir + then return $ Just (otype, ent) + else return Nothing + return (catMaybes mrelEnts) + liftIO $ A.logIO A.Debug ("relEnts: " ++ show relEnts) + putAffection ud + { worldState = nws + } + mapM_ (uncurry objectAction) relEnts +playerInteract _ = return () + drawMap :: Affection UserData () drawMap = do ud <- getAffection @@ -337,9 +382,9 @@ drawTile ud ctx posanims pr pc row col img = tileWidth = 64 :: Double tileHeight = 32 :: Double sorted = sortOn (\(V2 sr sc, _, mbnds) -> case mbnds of - Just (Boundaries (minr, minc) (maxr, maxc)) -> maxr * 10 + (1 - minc) - _ -> (sr - (fromIntegral ((floor sr) :: Int))) * 10 + - (1 - (sc - (fromIntegral ((floor sc) :: Int)))) + Just (Boundaries (minr, minc) (maxr, maxc)) -> maxr + (1 - maxc) * 10 + _ -> (sr - (fromIntegral ((floor sr) :: Int))) + + (1 - (sc - (fromIntegral ((floor sc) :: Int)))) * 10 ) posanims -- sorted = posanims minrs = Prelude.map (fst . matmin) mb @@ -380,7 +425,6 @@ updateMap dt = do (nws, _) <- liftIO $ yieldSystemT (worldState ud) $ do emap allEnts $ do with anim - with pos stat <- query anim let an = assetAnimations ud Map.! asId stat ntime = asElapsedTime stat + dt diff --git a/src/Object.hs b/src/Object.hs new file mode 100644 index 0000000..c044d9b --- /dev/null +++ b/src/Object.hs @@ -0,0 +1,26 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +module Object where + +import Affection + +import Data.Ecstasy + +import Types + +instance ObjectAction UserData ObjType where + objectAction ObjCopier ent = do + ud <- getAffection + (nws, _) <- liftIO $ yieldSystemT (worldState ud) $ do + emap (anEnt ent) $ do + with anim + liftIO $ logIO Debug "copying!" + let nstat = AnimState + (AnimId "copier" "copy" N) + 0 + 0 + return unchanged + { anim = Set nstat + } + putAffection ud + { worldState = nws + } diff --git a/src/Types.hs b/src/Types.hs index ae40eab..b884547 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -14,3 +14,4 @@ import Types.Animation as T import Types.MindMap as T import Types.Drawable as T import Types.Collidible as T +import Types.ObjType as T diff --git a/src/Types/ObjType.hs b/src/Types/ObjType.hs new file mode 100644 index 0000000..294aa21 --- /dev/null +++ b/src/Types/ObjType.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +module Types.ObjType where + +import Affection + +import Data.Ecstasy (Ent) + +data ObjType + = ObjCopier + deriving (Show, Eq, Ord, Enum) + +class ObjectAction us t where + objectAction :: t -> Ent -> Affection us () diff --git a/src/Types/UserData.hs b/src/Types/UserData.hs index db5c664..608d54c 100644 --- a/src/Types/UserData.hs +++ b/src/Types/UserData.hs @@ -23,6 +23,7 @@ import Types.ImgId import Types.FontId import Types.Direction import Types.Animation +import Types.ObjType data UserData = UserData { state :: State @@ -60,7 +61,8 @@ data Entity f = Entity , player :: Component f 'Unique () , npcMoveState :: Component f 'Field NPCMoveState , anim :: Component f 'Field AnimState - , objAccess :: Component f 'Field (V2 Int) + , objAccess :: Component f 'Field ((V2 Int), Direction) + , objType :: Component f 'Field ObjType } deriving (Generic) diff --git a/src/Util.hs b/src/Util.hs index c455d27..2c5d093 100644 --- a/src/Util.hs +++ b/src/Util.hs @@ -174,12 +174,19 @@ naviGraph imgmat animBounds (V2 r c) = list2 = foldl (\acc (rr, cc) -> - if null (maybe [] collisionObstacle - (fromMaybe Nothing $ M.safeGet (r + rr) (c + cc) imgmat)) + if null + ((maybe [] collisionObstacle + (fromMaybe Nothing $ M.safeGet (r + rr) (c + cc) imgmat)) ++ + (map snd $ filter + (\(V2 br bc, _) -> floor br == r + rr && floor bc == c + cc) + animBounds)) && all null (map - (\(oor, ooc) -> maybe [] collisionObstacle - (fromMaybe Nothing $ M.safeGet (r + oor) (c + ooc) imgmat)) + (\(oor, ooc) -> (maybe [] collisionObstacle + (fromMaybe Nothing $ M.safeGet (r + oor) (c + ooc) imgmat)) ++ + (map snd $ filter + (\(V2 br bc, _) -> floor br == r + oor && floor bc == c + ooc) + animBounds)) [(0, cc), (rr, 0)]) then V2 (r + rr) (c + cc): acc else acc