diff --git a/src/Animation.hs b/src/Animation.hs new file mode 100644 index 0000000..ce153dd --- /dev/null +++ b/src/Animation.hs @@ -0,0 +1,7 @@ +module Animation where + +import Types.Animation + +animFloats :: AnimId -> Bool +animFloats (AnimId "computer" _ _) = True +animFloats _ = False diff --git a/src/Load.hs b/src/Load.hs index d5d3089..75079ea 100644 --- a/src/Load.hs +++ b/src/Load.hs @@ -59,7 +59,7 @@ loadFork -> MVar (Float, T.Text) -> IO () loadFork ws win glc nvg future progress = do - let stateSteps = 24 + let stateSteps = 25 increment = 1 / stateSteps SDL.glMakeCurrent win glc modifyMVar_ progress (return . (\(p, _) -> @@ -225,11 +225,20 @@ loadFork ws win glc nvg future progress = do ( p + increment , "Loading Animation \"copier: copy\"" ))) - copierCopy <- loadAnimationSprites "assets/misc/copier.png" nvg $ + copierCopy <- loadAnimationSprites "assets/misc/copier.png" nvg [ ( AnimId "copier" "copy" N , AnimationConfig (64, 0) (64, 74) (64, 0) 4 1 APLoop ) ] + modifyMVar_ progress (return . (\(p, _) -> + ( p + increment + , "Loading Animation \"computer: off\"" + ))) + computerOff <- loadAnimationSprites "assets/misc/tableCornerComputer.png" nvg + [ ( AnimId "computer" "off" N + , AnimationConfig (0, 0) (64, 74) (64, 0) 2 2 APLoop + ) + ] modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Handing over" @@ -245,7 +254,8 @@ loadFork ws win glc nvg future progress = do jdoemStanding ++ jdoemWalking ++ copierStand ++ - copierCopy + copierCopy ++ + computerOff ) } ) diff --git a/src/MainGame/WorldMap.hs b/src/MainGame/WorldMap.hs index 0905560..0711289 100644 --- a/src/MainGame/WorldMap.hs +++ b/src/MainGame/WorldMap.hs @@ -38,6 +38,7 @@ import Floorplan import MindMap import NPC import Object +import Animation loadMap :: Affection UserData () loadMap = do @@ -140,6 +141,19 @@ loadMapFork ud future progress = do , objType = Just ObjCopier } ) (A.log A.Debug ("number of copiers: " ++ show (length copiers)) copiers) + let computers = Prelude.filter (\a -> pointType a == Computer) rps + mapM_ (\(ReachPoint _ icoord dir) -> do + let reachCoord = fmap ((+ 0.5) . fromIntegral) icoord + void $ createEntity $ newEntity + { pos = Just $ reachCoord - case dir of + N -> V2 1 (-1) + _ -> error "not yet defined" + -- , obstacle = Just $ Boundaries (10/36, 8/36) (28/36, 30/36) + , anim = Just $ AnimState (AnimId "computer" "off" N) 0 0 + , objAccess = Just $ (V2 1 (-1), dir) + , objType = Just ObjComputer + } + ) (A.log A.Debug ("number of computers: " ++ show (length computers)) computers) void $ liftIO $ swapMVar progress (18 / loadSteps, "Registering NPCs into WorldState") posbounds <- efor allEnts $ do with pos @@ -356,12 +370,13 @@ drawTile ud ctx posanims pr pc row col img = ) mapM_ drawAnim bef restore ctx - -- when (floor pr == row && floor pc == col) $ do - -- A.logIO A.Debug ("sorted: " ++ show sorted) - -- A.logIO A.Debug ("beh: " ++ show beh) - -- A.logIO A.Debug ("bef: " ++ show bef) + when (floor pr == row && floor pc == col) $ do + A.logIO A.Debug ("sorted: " ++ show sorted) + A.logIO A.Debug ("beh: " ++ show beh) + A.logIO A.Debug ("bef: " ++ show bef) where - delimiter (V2 nr nc, _, mbnds) = + delimiter (V2 nr nc, as, mbnds) = + animFloats (asId as) || all delimit mb where delimit b diff --git a/src/Types/Interior.hs b/src/Types/Interior.hs index 7668973..724503b 100644 --- a/src/Types/Interior.hs +++ b/src/Types/Interior.hs @@ -95,12 +95,12 @@ clusterPoints ClusterTable3 = clusterPoints ClusterTable4 = [ ReachPoint Table (V2 1 1) SE] clusterPoints ClusterCornerTable = - [ ReachPoint Table (V2 2 1) N + [ ReachPoint Computer (V2 2 1) N ] clusterPoints ClusterTableGroup = - [ ReachPoint Table (V2 2 2) N - , ReachPoint Table (V2 2 5) N - , ReachPoint Table (V2 5 5) N + [ ReachPoint Computer (V2 2 2) N + , ReachPoint Computer (V2 2 5) N + , ReachPoint Computer (V2 5 5) N ] clusterPoints ClusterCopier = [ ReachPoint Copier (V2 2 1) NW diff --git a/src/Types/ObjType.hs b/src/Types/ObjType.hs index 294aa21..c66658e 100644 --- a/src/Types/ObjType.hs +++ b/src/Types/ObjType.hs @@ -7,7 +7,10 @@ import Data.Ecstasy (Ent) data ObjType = ObjCopier + | ObjComputer deriving (Show, Eq, Ord, Enum) class ObjectAction us t where objectAction :: t -> Ent -> Affection us () + + ubjectUpdate :: t -> Ent -> Affection us () diff --git a/src/Types/ReachPoint.hs b/src/Types/ReachPoint.hs index 790c05b..4db7799 100644 --- a/src/Types/ReachPoint.hs +++ b/src/Types/ReachPoint.hs @@ -14,4 +14,5 @@ data PointType = RoomExit | Table | Copier + | Computer deriving (Eq, Show) diff --git a/tracer-game.cabal b/tracer-game.cabal index b9c7258..e443712 100644 --- a/tracer-game.cabal +++ b/tracer-game.cabal @@ -31,6 +31,7 @@ executable tracer-game , Types.Drawable , Types.Collidible , Types.ObjType + , Animation , StateMachine , Floorplan , Interior