I present: copiers

src/Interior.hs

@@ -38,7 +38,7 @@ placeInteriorIO imat imgmat irp graph =
       -> (StdGen, (Matrix (Maybe ImgId), [ReachPoint]))
     traverseGraph acc (GHall sub) =
       foldl traverseGraph acc sub
-    traverseGraph putt@(_, _) (GRoom _ bnds) =
+    traverseGraph putt (GRoom _ bnds) =
       let applicable =
             (L.sortBy (\b a -> size a `compare` size b) (
               L.filter
@@ -90,6 +90,7 @@ placeInteriorIO imat imgmat irp graph =
           reaches = map (+ V2 (pr - 1) (pc - 1))
             (map pointCoord (clusterPoints appl))
           reachdirs = map pointDir (clusterPoints appl)
+          reachtypes = map pointType (clusterPoints appl)
           oldreaches = foldl (\acc p ->
               if pointType p /= RoomExit && inBounds (pointCoord p) bnds
               then pointCoord p : acc
@@ -97,7 +98,8 @@ placeInteriorIO imat imgmat irp graph =
               )
             []
             rp
-          newrp = rp ++ map (uncurry (ReachPoint Table)) (zip reaches reachdirs)
+          newrp = rp ++ map (\(a, b, c) -> ReachPoint a b c)
+            (zip3 reachtypes reaches reachdirs)
       in
         if try > 10 || fromIntegral freeRoom < size appl
         then (g2, (mat, rp))

src/Load.hs

@@ -59,7 +59,7 @@ loadFork
   -> MVar (Float, T.Text)
   -> IO ()
 loadFork ws win glc nvg future progress = do
-  let stateSteps = 22
+  let stateSteps = 24
       increment = 1 / stateSteps
   SDL.glMakeCurrent win glc
   modifyMVar_ progress (return . (\(p, _) ->
@@ -162,36 +162,74 @@ loadFork ws win glc nvg future progress = do
     exitFailure
   -- playerImgs <- loadPlayerSprite "assets/intruder.png" 64 74 nvg
   --   (zipWith (\a b -> (a, [b])) [0..] $ [ImgIntrE .. ImgIntrN] ++ [ImgIntrNE])
-  let imgs = zipWith (\a b -> (a, fromJust b)) [ImgWallAsc ..] mimgs
+  let imgs = zipWith (\a b -> (a, fromJust b))
+        [ ImgWallAsc
+        , ImgWallDesc
+        , ImgWallCornerN
+        , ImgWallCornerE
+        , ImgWallCornerS
+        , ImgWallCornerW
+        , ImgWallTNE
+        , ImgWallTSE
+        , ImgWallTSW
+        , ImgWallTNW
+        , ImgWallCross
+        , ImgMiscBox1
+        , ImgMiscTable1
+        , ImgMiscTable2
+        , ImgMiscTable3
+        , ImgMiscTable4
+        , ImgMiscTableCorner
+        ]
+        mimgs
       directions = [E .. N] ++ [NE]
       standIds var = map (AnimId var "standing") directions
       walkIds var = map (AnimId var "walking") directions
       standConfigs = map
-        (\i -> AnimationConfig (0, i * 74) (64, 74) 1 0 APLoop)
+        (\i -> AnimationConfig (0, i * 74) (64, 74) (64, 0) 1 0 APLoop)
-        [0 .. length (standIds 0) - 1]
+        [0 .. length (standIds "intruder") - 1]
       walkConfigs = map
-        (\i -> AnimationConfig (64, i * 74) (64, 74) 6 1.5 APLoop)
+        (\i -> AnimationConfig (64, i * 74) (64, 74) (64, 0) 6 1.5 APLoop)
-        [0 .. length (walkIds 0) - 1]
+        [0 .. length (walkIds "intruder") - 1]
   playerStanding <- loadAnimationSprites "assets/intruder.png" nvg
-    (zip (standIds 0) standConfigs)
+    (zip (standIds "intruder") standConfigs)
   modifyMVar_ progress (return . (\(p, _) ->
     ( p + increment
     , "Loading Animation \"intruder: walking\""
     )))
   playerWalking <- loadAnimationSprites "assets/intruder.png" nvg
-    (zip (walkIds 0) walkConfigs)
+    (zip (walkIds "intruder") walkConfigs)
   modifyMVar_ progress (return . (\(p, _) ->
     ( p + increment
     , "Loading Animation \"jdoem: standing\""
     )))
   jdoemStanding <- loadAnimationSprites "assets/jdoem.png" nvg
-    (zip (standIds 1) standConfigs)
+    (zip (standIds "jdoem") standConfigs)
   modifyMVar_ progress (return . (\(p, _) ->
     ( p + increment
     , "Loading Animation \"jdoem: walking\""
     )))
   jdoemWalking <- loadAnimationSprites "assets/jdoem.png" nvg
-    (zip (walkIds 1) walkConfigs)
+    (zip (walkIds "jdoem") 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
+      (\i -> AnimationConfig (0, i * 74) (64, 74) (0, 0) 1 0 APLoop)
+      [0, 1]
+    )
+  modifyMVar_ progress (return . (\(p, _) ->
+    ( p + increment
+    , "Loading Animation \"copier: copy\""
+    )))
+  copierCopy <- loadAnimationSprites "assets/misc/copier.png" nvg $
+    [ ( AnimId "copier" "copy" N
+      , AnimationConfig (64, 0) (64, 74) (64, 0) 4 0.5 APOnce
+      )
+    ]
   modifyMVar_ progress (return . (\(p, _) ->
     ( p + increment
     , "Handing over"
@@ -202,7 +240,13 @@ loadFork ws win glc nvg future progress = do
     , LoadData
       { loadAssetImages = M.fromList imgs
       , loadAssetAnims  = M.fromList
-        (playerStanding ++ playerWalking ++ jdoemStanding ++ jdoemWalking)
+        ( playerStanding ++
+          playerWalking ++
+          jdoemStanding ++
+          jdoemWalking ++
+          copierStand ++
+          copierCopy
+        )
       }
     )
 

src/MainGame/MindMap.hs

@@ -159,7 +159,8 @@ drawMind = do
       with mmpos
       stat <- query anim
       pos' <- query mmpos
-      return (pos', stat)
+      mbnds <- queryMaybe obstacle
+      return (pos', stat, mbnds)
     return (pc, posanims)
   let V2 pr pc = playerPos
       mat = mmImgMat (stateData ud)
@@ -186,11 +187,13 @@ drawMind = do
             )
           )
       processList
-        :: [(V2 Double, AnimState)]
+        :: [(V2 Double, AnimState, Maybe (Boundaries Double))]
         -> (Int, Int)
-        -> ([(V2 Double, AnimState)], [(V2 Double, AnimState)])
+        -> ( [(V2 Double, AnimState, Maybe (Boundaries Double))]
+           , [(V2 Double, AnimState, Maybe (Boundaries Double))]
+           )
       processList list (r, c) =
-        let delimiter (V2 nr nc, _) =
+        let delimiter (V2 nr nc, _, _) =
               floor nr == r && floor nc == c
         in  L.partition delimiter list
   liftIO $ do -- draw floor

src/MainGame/WorldMap.hs

@@ -75,7 +75,7 @@ loadMapFork
   -> MVar (Float, T.Text)
   -> IO ()
 loadMapFork ud future progress = do
-  let loadSteps = 18
+  let loadSteps = 19
       fc = FloorConfig
         (10, 10)
         [(5, 5), (5, 45)]
@@ -85,7 +85,7 @@ loadMapFork ud future progress = do
   _ <- liftIO $ swapMVar progress (11 / loadSteps, "Converting to images")
   let imgmat = convertTileToImg mat
       exits = Prelude.foldl
-        (\acc coord@(r, c) -> if imgmat M.! coord == Just ImgEmpty
+        (\acc coord@(r, c) -> if imgmat M.! coord == Just (ImgEmpty [])
           then ReachPoint RoomExit (V2 r c) NE : acc
           else acc
           )
@@ -96,7 +96,7 @@ loadMapFork ud future progress = do
   _ <- liftIO $ swapMVar progress (13 / loadSteps, "Placing NPCs")
   logIO A.Debug ("number of reachpoints: " ++ show (length rps))
   let nnex = Prelude.filter (\p -> pointType p /= RoomExit) rps
-  npcposs <- placeNPCs inter mat rps 100 -- (length nnex)
+  npcposs <- placeNPCs inter mat rps 10 -- (length $ filter (\a -> pointType a == Table) nnex)
   _ <- liftIO $ swapMVar progress (14 / loadSteps, "Preparing MindMap graph")
   A.logIO A.Debug $ "number of placed NPCs: " ++ show (length npcposs)
   !(mmintmat, mmgraph) <- buildFloorMap . springField <$>
@@ -124,9 +124,20 @@ loadMapFork ud future progress = do
       , mmvel         = Just (V2 0 0)
       , player        = Just ()
       , rot           = Just SE
-      , anim          = Just $ AnimState (AnimId 0 "standing" SE) 0 0
+      , anim          = Just $ AnimState (AnimId "intruder" "standing" SE) 0 0
       }
-    void $ liftIO $ swapMVar progress (17 / loadSteps, "Registering NPCs into WorldState")
+    void $ liftIO $ swapMVar progress (17 / loadSteps, "Registering copiers into WorldState")
+    let copiers = Prelude.filter (\a -> pointType a == Copier) rps
+    mapM_ (\(ReachPoint _ icoord _) -> do
+      let reachCoord = fmap ((+ 0.5) . fromIntegral) icoord
+      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
+        }
+      ) (A.log A.Debug ("number of copiers: " ++ show (length copiers)) copiers)
+    void $ liftIO $ swapMVar progress (18 / loadSteps, "Registering NPCs into WorldState")
     mapM_ (\npcpos@(V2 nr nc) -> do
       fact <- liftIO $ randomRIO (0.5, 1.5)
       fut <- liftIO newEmptyMVar
@@ -137,15 +148,15 @@ loadMapFork ud future progress = do
         , velFact       = Just fact
         , rot           = Just SE
         , npcMoveState  = Just (NPCStanding 0 fut)
-        , anim          = Just $ AnimState (AnimId 1 "standing" SE) 0 0
+        , anim          = Just $ AnimState (AnimId "jdoem" "standing" SE) 0 0
         }
       ) npcposs
-    void $ liftIO $ swapMVar progress (18 / loadSteps, "Handing over")
+    void $ liftIO $ swapMVar progress (19 / loadSteps, "Handing over")
   putMVar future (nws, MainData
       { mapMat = mat
       , imgMat = M.fromList (nrows inter) (ncols inter) $
         Prelude.map
-          (\a -> if a == Just ImgEmpty then Nothing else a)
+          (\a -> if a == Just (ImgEmpty []) then Nothing else a)
           (M.toList inter)
       , reachPoints = rps
       , mmImgMat = mmimgmat
@@ -204,7 +215,8 @@ drawMap = do
           with pos
           stat <- query anim
           pos' <- query pos
-          return (pos', stat)
+          mbnds <- queryMaybe obstacle
+          return (pos', stat, mbnds)
         return (pc, posanims)
       let V2 pr pc = playerPos
           mat = imgMat (stateData ud)
@@ -231,11 +243,13 @@ drawMap = do
                 )
               )
           processList
-            :: [(V2 Double, AnimState)]
+            :: [(V2 Double, AnimState, Maybe (Boundaries Double))]
             -> (Int, Int)
-            -> ([(V2 Double, AnimState)], [(V2 Double, AnimState)])
+            -> ( [(V2 Double, AnimState, Maybe (Boundaries Double))]
+               , [(V2 Double, AnimState, Maybe (Boundaries Double))]
+               )
           processList list (r, c) =
-            let delimiter (V2 nr nc, _) =
+            let delimiter (V2 nr nc, _, _) =
                   floor nr == r && floor nc == c
             in  L.partition delimiter list
       liftIO $ do -- draw floor
@@ -266,7 +280,7 @@ drawMap = do
 drawTile
   :: UserData
   -> Context
-  -> [(V2 Double, AnimState)]
+  -> [(V2 Double, AnimState, Maybe (Boundaries Double))]
   -> Double
   -> Double
   -> Int
@@ -282,11 +296,18 @@ drawTile ud ctx posanims pr pc row col img =
         save ctx
         mapM_ drawAnim beh
         maybe (return ()) (draw ud x (y - 42) 64 74 fact)
-          ((assetImages ud Map.!) <$> img)
+          ((assetImages ud Map.!) <$> case img of
+            Just (ImgEmpty _) -> Nothing
+            _ -> 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)
   where
-    delimiter (V2 nr nc, _) =
+    delimiter (V2 nr nc, _, mbnds) =
       all delimit mb
       where
         delimit b
@@ -296,13 +317,22 @@ drawTile ud ctx posanims pr pc row col img =
             nnr > fst (matmax b)
           | otherwise =
             True
-        nnr = nr - fromIntegral ((floor nr) :: Int) :: Double
+        nnr = case mbnds of
-        nnc = nc - fromIntegral ((floor nc) :: Int) :: Double
+          Just (Boundaries (minr, minc) (maxr, maxc)) -> maxr
+          Nothing -> nr - fromIntegral ((floor nr) :: Int) :: Double
+        nnc = case mbnds of
+          Just (Boundaries (minr, minc) (maxr, maxc)) -> minc
+          Nothing -> nc - fromIntegral ((floor nc) :: Int) :: Double
       -- any (\m -> nr < fromIntegral (floor nr :: Int) + m) maxrs &&
       -- any (\m -> nc > fromIntegral (floor nc :: Int) + m) mincs
     tileWidth = 64 :: Double
     tileHeight = 32 :: Double
-    sorted = sortOn (\(V2 sr sc, _) -> sc + sr * fromIntegral col) posanims
+    sorted = sortOn (\(V2 sr sc, _, mbnds) -> case mbnds of
+      Just (Boundaries (minr, minc) (maxr, maxc)) -> minr * 10 + (1 - minc)
+      _ -> (sr - (fromIntegral ((floor sr) :: Int))) * 10 +
+        (1 - (sc - (fromIntegral ((floor sc) :: Int))))
+      ) posanims
+    -- sorted = posanims
     minrs = Prelude.map (fst . matmin) mb
     maxrs = Prelude.map (fst . matmax) mb
     mincs = Prelude.map (snd . matmin) mb
@@ -320,7 +350,7 @@ drawTile ud ctx posanims pr pc row col img =
       then min 1 dist
       else 1
     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 - 32
           ay = realToFrac $ 360 + ((nr - pr) - (nc - pc)) * 16 - 58
       draw ud ax ay 64 74 1 as
@@ -504,6 +534,7 @@ updateMap dt = do
               , rot = Set (fromMaybe rot' $ direction vel')
               , anim = Set nstat
               }
+        -- liftIO $ A.logIO A.Debug ("player position: " ++ show (pos' + colldpos))
         return ent
       updateNPCs
         (imgMat $ stateData ud)

src/Types/Animation.hs

@@ -5,7 +5,7 @@ import NanoVG (Image)
 import Types.Direction
 
 data AnimId = AnimId
-  { aiVariation :: Int
+  { aiVariation :: String
   , aiName      :: String -- CHANGE ME !!!
   , aiDirection :: Direction
   }
@@ -33,6 +33,7 @@ data Animation = Animation
 data AnimationConfig = AnimationConfig
   { animConfOffset   :: (Int, Int)
   , animConfSize     :: (Int, Int)
+  , animConfStep     :: (Int, Int)
   , animConfCount    :: Int
   , animConfDuration :: Double
   , animConfPlay     :: AnimPlayback

src/Types/Collidible.hs

@@ -76,4 +76,5 @@ instance Collidible ImgId where
     [ Boundaries (0, 0) (0.63, 1)
     , Boundaries (0, 0.34) (1, 1)
     ]
+  collisionObstacle (ImgEmpty b) = b
   collisionObstacle _ = []

src/Types/ImgId.hs

@@ -3,7 +3,7 @@ module Types.ImgId where
 import Types.Map
 
 data ImgId
-  = ImgEmpty -- TODO: Find better solution thatn empty image.
+  = ImgEmpty [Boundaries Double] -- TODO: Find better solution than empty image.
   | ImgWallAsc
   | ImgWallDesc
   | ImgWallCornerN
@@ -29,7 +29,7 @@ data ImgId
   -- | ImgIntrW
   -- | ImgIntrNW
   -- | ImgIntrN
-  deriving (Show, Eq, Ord, Enum)
+  deriving (Show, Eq, Ord)
 
 isWall :: ImgId -> Bool
 isWall ImgMiscBox1 = False

src/Types/Interior.hs

@@ -19,6 +19,7 @@ data Cluster
   | ClusterTable4
   | ClusterCornerTable
   | ClusterTableGroup
+  | ClusterCopier
   deriving (Enum, Bounded)
 
 clusterMat :: Cluster -> Matrix (Maybe ImgId)
@@ -30,43 +31,48 @@ clusterMat ClusterBox1 =
     ]
 clusterMat ClusterTable1 =
   M.fromLists
-    [[Just ImgEmpty, Just ImgMiscTable1]]
+    [[Just (ImgEmpty []), Just ImgMiscTable1]]
 clusterMat ClusterTable2 =
   M.fromLists
     [ [Just ImgMiscTable2]
-    , [Just ImgEmpty]
+    , [Just (ImgEmpty [])]
     ]
 clusterMat ClusterTable3 =
   M.fromLists
-    [[Just ImgMiscTable3, Just ImgEmpty]]
+    [[Just ImgMiscTable3, Just (ImgEmpty [])]]
 clusterMat ClusterTable4 =
   M.fromLists
-    [ [Just ImgEmpty]
+    [ [Just (ImgEmpty [])]
     , [Just ImgMiscTable4]
     ]
 clusterMat ClusterCornerTable =
   M.fromLists
     [ [Just ImgMiscTable2, Just ImgMiscTableCorner]
-    , [Just ImgEmpty     , Just ImgMiscTable1]
+    , [Just (ImgEmpty []), Just ImgMiscTable1]
     ]
 clusterMat ClusterTableGroup =
   M.fromLists
-    [ [ Just ImgEmpty, Just ImgMiscTable2, Just ImgMiscTableCorner
+    [ [ Just (ImgEmpty []), Just ImgMiscTable2, Just ImgMiscTableCorner
-      , Just ImgEmpty, Just ImgMiscTable2, Just ImgMiscTableCorner
+      , Just (ImgEmpty []), Just ImgMiscTable2, Just ImgMiscTableCorner
       ]
-    , [ Just ImgEmpty, Just ImgEmpty, Just ImgMiscTable1
+    , [ Just (ImgEmpty []), Just (ImgEmpty []), Just ImgMiscTable1
-      , Just ImgEmpty, Just ImgEmpty, Just ImgMiscTable1 
+      , Just (ImgEmpty []), Just (ImgEmpty []), Just ImgMiscTable1
       ]
-    , [ Just ImgEmpty, Just ImgEmpty, Just ImgEmpty
+    , [ Just (ImgEmpty []), Just (ImgEmpty []), Just (ImgEmpty [])
-      , Just ImgEmpty, Just ImgEmpty, Just ImgEmpty
+      , Just (ImgEmpty []), Just (ImgEmpty []), Just (ImgEmpty [])
       ]
     , [ Nothing, Nothing, Nothing
-      , Just ImgEmpty, Just ImgMiscTable2, Just ImgMiscTableCorner
+      , Just (ImgEmpty []), Just ImgMiscTable2, Just ImgMiscTableCorner
       ]
     , [ Nothing, Nothing, Nothing
-      , Just ImgEmpty, Just ImgEmpty, Just ImgMiscTable1
+      , Just (ImgEmpty []), Just (ImgEmpty []), Just ImgMiscTable1
       ]
     ]
+clusterMat ClusterCopier =
+  M.fromLists
+    [ [ Just (ImgEmpty [Boundaries (10/36, 8/36) (28/36, 30/36)])]
+    , [ Just (ImgEmpty [])]
+    ]
 
 clusterRoom :: Cluster -> TileState
 clusterRoom ClusterBox1 = Offi
@@ -76,6 +82,7 @@ clusterRoom ClusterTable3 = Offi
 clusterRoom ClusterTable4 = Offi
 clusterRoom ClusterCornerTable = Offi
 clusterRoom ClusterTableGroup = Offi
+clusterRoom ClusterCopier = Offi
 
 clusterPoints :: Cluster -> [ReachPoint]
 clusterPoints ClusterBox1 = []
@@ -95,6 +102,9 @@ clusterPoints ClusterTableGroup =
   , ReachPoint Table (V2 2 5) N
   , ReachPoint Table (V2 5 5) N
   ]
+clusterPoints ClusterCopier =
+  [ ReachPoint Copier (V2 2 1) NW
+  ]
 
 instance Size Cluster where
   size c =

src/Types/Map.hs

@@ -33,7 +33,7 @@ data FloorConfig = FloorConfig
 data Boundaries a = Boundaries
   { matmin :: (a, a)
   , matmax :: (a, a)
-  } deriving (Show, Eq)
+  } deriving (Show, Eq, Ord)
 
 instance Size (Boundaries Int) where
   size (Boundaries (minr, minc) (maxr, maxc)) =

src/Types/ReachPoint.hs

@@ -13,4 +13,5 @@ data ReachPoint = ReachPoint
 data PointType
   = RoomExit
   | Table
+  | Copier
   deriving (Eq, Show)

src/Util.hs

@@ -100,7 +100,7 @@ convertTileToImg mat = fromLists conversion
           | any
             (\(rr, cc) -> M.safeGet (irow + rr) (icol + cc) mat == Just Door)
             [(1, 0), (-1, 0), (0, 1), (0, -1)] ->
-            Just ImgEmpty
+            Just (ImgEmpty [])
           | otherwise ->
             Nothing
         _ ->
@@ -208,9 +208,9 @@ loadAnimationSprites fp nvg idconfs = do
     Right dimg -> do
       let img = convertRGBA8 dimg
       mapM
-        (\(i, (AnimationConfig (xoffs, yoffs) (w, h) count dur pb)) -> do
+        (\(i, (AnimationConfig (xoffs, yoffs) (w, h) (sx, sy) count dur pb)) -> do
           let crs = map
-                (\iid -> crop (xoffs + (iid * w)) yoffs w h img)
+                (\iid -> crop (xoffs + (iid * sx)) (yoffs + (iid * sy)) w h img)
                 [0 .. (count - 1)]
           mresimgs <- mapM
             (\cr ->