Space zooms to position on carte

This commit is contained in:
2021-04-20 20:11:15 +02:00
parent 732e5281a8
commit 7c0fbe0ce2
2 changed files with 13 additions and 7 deletions
+7 -1
View File
@@ -71,10 +71,16 @@ debugKey scancode w
debugKey _ w = Just w debugKey _ w = Just w
spaceAction :: World -> World spaceAction :: World -> World
spaceAction w = case listToMaybe $ _closeActiveObjects w of spaceAction w = if _carteDisplay w
then
w & carteCenter .~ theLoc
else
case listToMaybe $ _closeActiveObjects w of
Just (Left flit) -> pickUpItem' flit w Just (Left flit) -> pickUpItem' flit w
Just (Right but) -> _btEvent but but w Just (Right but) -> _btEvent but but w
Nothing -> w Nothing -> w
where
theLoc = fst (_seenLocations w IM.! _selLocation w) w
pauseGame :: World -> World pauseGame :: World -> World
pauseGame w = w {_menuLayers = [PauseMenu]} pauseGame w = w {_menuLayers = [PauseMenu]}
+3 -3
View File
@@ -99,9 +99,9 @@ ppEvents w = IM.foldr' (\pp w -> _ppEvent pp pp w) w $ _pressPlates w
updateSeenWalls :: World -> World updateSeenWalls :: World -> World
updateSeenWalls w = foldr markSeen w wallsToUpdate updateSeenWalls w = foldr markSeen w wallsToUpdate
where yPos = _crPos $ _creatures w IM.! 0 where yPos = _crPos $ _creatures w IM.! 0
wallsToUpdate = map _wlID $ IM.elems $ wallsNearPoint yPos w -- wallsToUpdate = map _wlID $ IM.elems $ wallsNearPoint yPos w
-- wallsToUpdate = concatMap (\p -> collidePointFindWalls yPos (yPos +.+p) $ wallsAlongLine yPos (yPos +.+ p) w) wallsToUpdate = concatMap (\p -> collidePointFindWalls yPos (yPos +.+p) $ wallsAlongLine yPos (yPos +.+ p) w)
-- $ nRays 60 $ nRays 60
markSeen i = set (walls . ix i . wlSeen) True markSeen i = set (walls . ix i . wlSeen) True
setTestStringIO :: IO World -> IO World setTestStringIO :: IO World -> IO World