place and show door

src/Animation.hs

@@ -3,5 +3,5 @@ module Animation where
 import Types.Animation
 
 animFloats :: AnimId -> Bool
-animFloats (AnimId "computer" _ _) = True
+animFloats (AnimId AnimComputer _ _) = True
 animFloats _ = False

src/Load.hs

@@ -63,7 +63,7 @@ loadFork
   -> MVar (Float, T.Text)
   -> IO ()
 loadFork ws win glc nvg future progress = do
-  let stateSteps = 55
+  let stateSteps = 57
       increment = 1 / stateSteps
   SDL.glMakeCurrent win glc
   modifyMVar_ progress (return . (\(p, _) ->
@@ -311,36 +311,36 @@ loadFork ws win glc nvg future progress = do
       walkIds var = map (AnimId var "walking") directions
       standConfigs = map
         (\i -> AnimationConfig (0, i * 74) (64, 74) (64, 0) 1 0 APLoop)
-        [0 .. length (standIds "intruder") - 1]
+        [0 .. length (standIds AnimIntruder) - 1]
       walkConfigs = map
         (\i -> AnimationConfig (64, i * 74) (64, 74) (64, 0) 6 1.5 APLoop)
-        [0 .. length (walkIds "intruder") - 1]
+        [0 .. length (walkIds AnimIntruder) - 1]
   playerStanding <- loadAnimationSprites "assets/intruder.png" nvg
-    (zip (standIds "intruder") standConfigs)
+    (zip (standIds AnimIntruder) standConfigs)
   modifyMVar_ progress (return . (\(p, _) ->
     ( p + increment
     , "Loading Animation \"intruder: walking\""
     )))
   playerWalking <- loadAnimationSprites "assets/intruder.png" nvg
-    (zip (walkIds "intruder") walkConfigs)
+    (zip (walkIds AnimIntruder) walkConfigs)
   modifyMVar_ progress (return . (\(p, _) ->
     ( p + increment
     , "Loading Animation \"jdoem: standing\""
     )))
   jdoemStanding <- loadAnimationSprites "assets/jdoem.png" nvg
-    (zip (standIds "jdoem") standConfigs)
+    (zip (standIds AnimJDoeM) standConfigs)
   modifyMVar_ progress (return . (\(p, _) ->
     ( p + increment
     , "Loading Animation \"jdoem: walking\""
     )))
   jdoemWalking <- loadAnimationSprites "assets/jdoem.png" nvg
-    (zip (walkIds "jdoem") walkConfigs)
+    (zip (walkIds AnimJDoeM) walkConfigs)
   modifyMVar_ progress (return . (\(p, _) ->
     ( p + increment
     , "Loading Animation \"copier: stand\""
     )))
   copierStand <- loadAnimationSprites "assets/misc/copier.png" nvg $ zip
-    (map (\name -> AnimId "copier" name N) ["closed", "open"])
+    (map (\name -> AnimId AnimCopier name N) ["closed", "open"])
     (map
       (\i -> AnimationConfig (0, i * 74) (64, 74) (0, 0) 1 0 APLoop)
       [0, 1]
@@ -350,7 +350,7 @@ loadFork ws win glc nvg future progress = do
     , "Loading Animation \"copier: copy\""
     )))
   copierCopy <- loadAnimationSprites "assets/misc/copier.png" nvg
-    [ ( AnimId "copier" "copy" N
+    [ ( AnimId AnimCopier "copy" N
       , AnimationConfig (64, 0) (64, 74) (64, 0) 4 1 APLoop
       )
     ]
@@ -359,7 +359,7 @@ loadFork ws win glc nvg future progress = do
     , "Loading Animation \"cornerComputer: off\""
     )))
   cornerComputerOff <- loadAnimationSprites "assets/misc/tableCornerComputer.png" nvg
-    [ ( AnimId "computer" "off" N
+    [ ( AnimId AnimComputer "off" N
       , AnimationConfig (0, 0) (64, 74) (64, 0) 2 2 APLoop
       )
     ]
@@ -368,7 +368,7 @@ loadFork ws win glc nvg future progress = do
     , "Loading Animation \"cornerComputer: on\""
     )))
   cornerComputerOn <- loadAnimationSprites "assets/misc/tableCornerComputer.png" nvg
-    [ ( AnimId "computer" "on" N
+    [ ( AnimId AnimComputer "on" N
       , AnimationConfig (128, 0) (64, 74) (0, 0) 1 0 APLoop
       )
     ]
@@ -377,7 +377,7 @@ loadFork ws win glc nvg future progress = do
     , "Loading Animation \"cornerComputer: hack\""
     )))
   cornerComputerHack <- loadAnimationSprites "assets/misc/tableCornerComputer.png" nvg
-    [ ( AnimId "computer" "hack" N
+    [ ( AnimId AnimComputer "hack" N
       , AnimationConfig (0, 74) (64, 74) (64, 0) 4 2 APLoop
       )
     ]
@@ -386,7 +386,7 @@ loadFork ws win glc nvg future progress = do
     , "Loading Animation \"neComputer: off\""
     )))
   neComputerOff <- loadAnimationSprites "assets/misc/tableSWComputer.png" nvg
-    [ ( AnimId "computer" "off" NE
+    [ ( AnimId AnimComputer "off" NE
       , AnimationConfig (0, 0) (64, 74) (64, 0) 2 2 APLoop
       )
     ]
@@ -395,7 +395,7 @@ loadFork ws win glc nvg future progress = do
     , "Loading Animation \"neComputer: on\""
     )))
   neComputerOn <- loadAnimationSprites "assets/misc/tableSWComputer.png" nvg
-    [ ( AnimId "computer" "on" NE
+    [ ( AnimId AnimComputer "on" NE
       , AnimationConfig (128, 0) (64, 74) (0, 0) 1 0 APLoop
       )
     ]
@@ -404,7 +404,7 @@ loadFork ws win glc nvg future progress = do
     , "Loading Animation \"neComputer: hack\""
     )))
   neComputerHack <- loadAnimationSprites "assets/misc/tableSWComputer.png" nvg
-    [ ( AnimId "computer" "hack" NE
+    [ ( AnimId AnimComputer "hack" NE
       , AnimationConfig (0, 74) (64, 74) (64, 0) 4 2 APLoop
       )
     ]
@@ -413,7 +413,7 @@ loadFork ws win glc nvg future progress = do
     , "Loading Animation \"nwComputer: off\""
     )))
   nwComputerOff <- loadAnimationSprites "assets/misc/tableSEComputer.png" nvg
-    [ ( AnimId "computer" "off" NW
+    [ ( AnimId AnimComputer "off" NW
       , AnimationConfig (0, 0) (64, 74) (64, 0) 2 2 APLoop
       )
     ]
@@ -422,7 +422,7 @@ loadFork ws win glc nvg future progress = do
     , "Loading Animation \"nwComputer: on\""
     )))
   nwComputerOn <- loadAnimationSprites "assets/misc/tableSEComputer.png" nvg
-    [ ( AnimId "computer" "on" NW
+    [ ( AnimId AnimComputer "on" NW
       , AnimationConfig (128, 0) (64, 74) (0, 0) 1 0 APLoop
       )
     ]
@@ -431,7 +431,7 @@ loadFork ws win glc nvg future progress = do
     , "Loading Animation \"nwComputer: hack\""
     )))
   nwComputerHack <- loadAnimationSprites "assets/misc/tableSEComputer.png" nvg
-    [ ( AnimId "computer" "hack" NW
+    [ ( AnimId AnimComputer "hack" NW
       , AnimationConfig (0, 74) (64, 74) (64, 0) 4 2 APLoop
       )
     ]
@@ -440,7 +440,7 @@ loadFork ws win glc nvg future progress = do
     , "Loading Animation \"toilet: free\""
     )))
   toiletFree <- loadAnimationSprites "assets/misc/toilet.png" nvg
-    [ ( AnimId "toilet" "free" N
+    [ ( AnimId AnimToilet "free" N
       , AnimationConfig (0, 0) (64, 74) (0, 0) 1 0 APLoop
       )
     ]
@@ -449,10 +449,28 @@ loadFork ws win glc nvg future progress = do
     , "Loading Animation \"toilet: occupied\""
     )))
   toiletOccupied <- loadAnimationSprites "assets/misc/toilet.png" nvg
-    [ ( AnimId "toilet" "occupied" N
+    [ ( AnimId AnimToilet "occupied" N
       , AnimationConfig (64, 0) (64, 74) (0, 0) 1 0 APLoop
       )
     ]
+  modifyMVar_ progress (return . (\(p, _) ->
+    ( p + increment
+    , "Loading Animation \"neDoor0: shut\""
+    )))
+  neDoor0shut <- loadAnimationSprites "assets/doors/door_asc_0.png" nvg
+    [ ( AnimId AnimDoor0 "shut" NE
+      , AnimationConfig (0, 0) (64, 74) (0, 0) 1 0 APLoop
+      )
+    ]
+  modifyMVar_ progress (return . (\(p, _) ->
+    ( p + increment
+    , "Loading Animation \"nwDoor0: shut\""
+    )))
+  nwDoor0shut <- loadAnimationSprites "assets/doors/door_desc_0.png" nvg
+    [ ( AnimId AnimDoor0 "shut" NW
+      , AnimationConfig (0, 0) (64, 74) (0, 0) 1 0 APLoop
+      )
+    ]
   modifyMVar_ progress (return . (\(p, _) ->
     ( p + increment
     , "Handing over"
@@ -479,7 +497,9 @@ loadFork ws win glc nvg future progress = do
           nwComputerOn ++
           nwComputerHack ++
           toiletFree ++
-          toiletOccupied
+          toiletOccupied ++
+          neDoor0shut ++
+          nwDoor0shut
         )
       , loadAssetIcons  = M.fromList icons
       }

src/MainGame/WorldMap.hs

@@ -101,7 +101,7 @@ loadMapFork
   -> MVar (Float, T.Text)
   -> IO ()
 loadMapFork ud ad future progress = do
-  let loadSteps = 22
+  let loadSteps = 23
       increment = 1 / loadSteps
       fc = FloorConfig
         (V2 10 10)
@@ -145,7 +145,7 @@ loadMapFork ud ad 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" "open" N) 0 0
+        , anim      = Just $ AnimState (AnimId AnimCopier "open" N) 0 0
         , objAccess = Just (V2 1 0, NW)
         , objType   = Just ObjCopier
         , objState  = Just "idle"
@@ -155,7 +155,7 @@ loadMapFork ud ad future progress = do
       ( p + increment
       , "Registering computers into WorldState"
       )))
-    let !computers = Prelude.filter (\a -> pointType a == Computer) rps
+    let !computers = Prelude.filter ((Computer ==) . pointType) rps
     mapM_ (\(ReachPoint _ icoord dir _) -> do
       let reachCoord = fmap ((+ 0.5) . fromIntegral) icoord
           access = case dir of
@@ -165,7 +165,7 @@ loadMapFork ud ad future progress = do
             x -> error ("computer placement " ++ show x ++ " not defined")
       void $ createEntity $ newEntity
         { pos       = Just $ reachCoord - fmap fromIntegral access
-        , anim      = Just $ AnimState (AnimId "computer" "off" dir) 0 0
+        , anim      = Just $ AnimState (AnimId AnimComputer "off" dir) 0 0
         , objAccess = Just (access, dir)
         , objType   = Just ObjComputer
         , objState  = Just "off"
@@ -181,7 +181,7 @@ loadMapFork ud ad future progress = do
       void $ createEntity $ newEntity
         { pos       = Just $ reachCoord - V2 0 (-1)
         , obstacle  = Just $ Boundaries (0, 0) (1, 1)
-        , anim      = Just $ AnimState (AnimId "toilet" "free" N) 0 0
+        , anim      = Just $ AnimState (AnimId AnimToilet "free" N) 0 0
         , objAccess = Just (V2 0 (-1), dir)
         , objType   = Just ObjToilet
         }
@@ -217,7 +217,7 @@ loadMapFork ud ad future progress = do
       , mmvel         = Just (V2 0 0)
       , player        = Just ()
       , rot           = Just SE
-      , anim          = Just $ AnimState (AnimId "intruder" "standing" SE) 0 0
+      , anim          = Just $ AnimState (AnimId AnimIntruder "standing" SE) 0 0
       }
     liftIO $ A.logIO A.Debug $ "number of placed NPCs: " ++ show (length computers)
     liftIO $ modifyMVar_ progress (return . (\(p, _) ->
@@ -248,10 +248,54 @@ loadMapFork ud ad future progress = do
         , npcWorkplace   = Just cpr
         , npcActionState = Just ASWork
         , npcStats       = Just stats
-        , npcClearanceLvl = Just (clearance room)
+        , clearanceLvl   = Just (clearance room)
-        , anim            = Just $ AnimState (AnimId "jdoem" "standing" SE) 0 0
+        , anim           = Just $ AnimState (AnimId AnimJDoeM "standing" SE) 0 0
         }
       ) computers
+    liftIO $ modifyMVar_ progress (return . (\(p, _) ->
+      ( p + increment
+      , "Registering doors into WorldState"
+      )))
+    let doors = Prelude.filter ((RoomExit ==) . pointType) rps
+    mapM_ (\door -> do
+      let rooms = Prelude.foldl
+            (\acc coord ->
+              let rs = Prelude.filter ((inBounds coord) . bounds) graph
+              in
+                if not (Prelude.null rs)
+                then (coord, head rs) : acc
+                else acc
+              )
+            []
+            coords
+          [coord] = Prelude.filter
+            (\(V2 r c) -> (Door ==) $ (mat M.! (r, c)))
+            coords
+          graph = Types.connects (head gr) ++ tail gr
+          coords = Prelude.map (pointCoord door +) deltas
+          dcoords = Prelude.map (coord +) deltas
+          deltas =
+            [ V2 0 1
+            , V2 1 0
+            , V2 (-1) 0
+            , V2 0 (-1)
+            ]
+          wall = Prelude.filter
+            (\delta ->
+              let V2 r c = coord + delta
+              in
+                fromMaybe False (isWall <$> imgmat M.! (r, c)))
+            deltas
+          orientation
+            | head wall == V2 0 1 || head wall == V2 0 (-1) = NE
+            | head wall == V2 1 0 || head wall == V2 (-1) 0 = NW
+            | otherwise                                     = error ("strange wall: " ++ show wall)
+      void $ createEntity $ newEntity
+        { pos          = Just (fmap ((+ 0.5) . fromIntegral) coord)
+        , clearanceLvl = Just (maximum $ Prelude.map clearance (Prelude.map snd rooms))
+        , anim         = Just $ AnimState (AnimId AnimDoor0 "shut" orientation) 0 0
+        }
+      ) doors
     liftIO $ modifyMVar_ progress (return . (\(p, _) ->
       ( p + increment
       , "Handing over"

src/NPC.hs

@@ -54,13 +54,13 @@ updateNPCs imgmat ws rrp dt = do
     with npcActionState
     with npcWorkplace
     with npcStats
-    with npcClearanceLvl
+    with clearanceLvl
     with vel
     with rot
     with anim
     pos' <- query pos
     rot' <- query rot
-    lvl  <- query npcClearanceLvl
+    lvl  <- query clearanceLvl
     npcState' <- query npcMoveState
     let rp = filter ((lvl >=) . pointClearance) rrp
     case npcState' of

src/Object.hs

@@ -114,7 +114,7 @@ instance ObjectAction ObjType ObjState where
   objectTransition ObjCopier "idle" playerActivated ent (Just aent) = do
     e <- efor (anEnt ent) $ do
         let nstat = AnimState
-              (AnimId "copier" "copy" N)
+              (AnimId AnimCopier "copy" N)
               0
               0
         return unchanged
@@ -131,7 +131,7 @@ instance ObjectAction ObjType ObjState where
       if ttl < 0
       then do
         let nstat = AnimState
-              (AnimId "copier" "open" N)
+              (AnimId AnimCopier "open" N)
               0
               0
         return unchanged
@@ -152,7 +152,7 @@ instance ObjectAction ObjType ObjState where
       then if not (fromMaybe False solved)
         then do
           let nstat = AnimState
-                (AnimId "computer" "hack" dir)
+                (AnimId AnimComputer "hack" dir)
                 0
                 0
           return unchanged
@@ -163,7 +163,7 @@ instance ObjectAction ObjType ObjState where
             }
         else do
           let nstat = AnimState
-                (AnimId "computer" "on" dir)
+                (AnimId AnimComputer "on" dir)
                 0
                 0
           return unchanged
@@ -174,7 +174,7 @@ instance ObjectAction ObjType ObjState where
               }
       else do
         let nstat = AnimState
-              (AnimId "computer" "on" dir)
+              (AnimId AnimComputer "on" dir)
               0
               0
         return unchanged
@@ -189,7 +189,7 @@ instance ObjectAction ObjType ObjState where
     e <- efor (anEnt ent) $ do
       (_, dir) <- query objAccess
       let nstat = AnimState
-            (AnimId "computer" "off" dir)
+            (AnimId AnimComputer "off" dir)
             0
             0
       return unchanged
@@ -207,7 +207,7 @@ instance ObjectAction ObjType ObjState where
       e <- efor (anEnt ent) $ do
         (_, dir) <- query objAccess
         let nstat = AnimState
-              (AnimId "computer" "off" dir)
+              (AnimId AnimComputer "off" dir)
               0
               0
         ost <- query objStateTime

src/Types/Animation.hs

@@ -5,8 +5,8 @@ import NanoVG (Image)
 import Types.Direction
 
 data AnimId = AnimId
-  { aiVariation :: String
+  { aiVariation :: AnimationName
-  , aiName      :: String -- CHANGE ME !!!
+  , aiName      :: String
   , aiDirection :: Direction
   }
   deriving (Show, Eq, Ord)
@@ -39,3 +39,12 @@ data AnimationConfig = AnimationConfig
   , animConfPlay     :: AnimPlayback
   }
   deriving (Show, Eq)
+
+data AnimationName
+  = AnimIntruder
+  | AnimCopier
+  | AnimComputer
+  | AnimToilet
+  | AnimJDoeM
+  | AnimDoor0
+  deriving (Show, Eq, Ord, Enum)

src/Types/Entity.hs

@@ -26,7 +26,7 @@ data Entity f = Entity
   , npcWorkplace       :: Component f 'Field ReachPoint
   , npcActionState     :: Component f 'Field NPCActionState
   , npcStats           :: Component f 'Field NPCStats
-  , npcClearanceLvl    :: Component f 'Field Word
+  , clearanceLvl       :: Component f 'Field Word
   , anim               :: Component f 'Field AnimState
   , objAccess          :: Component f 'Field ((V2 Int), Direction)
   , objType            :: Component f 'Field ObjType

src/Types/ObjType.hs

@@ -2,7 +2,8 @@
 module Types.ObjType where
 
 data ObjType
-  = ObjCopier
+  = ObjDoor
+  | ObjCopier
   | ObjComputer
   | ObjToilet
   deriving (Show, Eq, Ord, Enum)