Start implementing location display on map

This commit is contained in:
jgk
2021-03-25 17:00:08 +01:00
parent d1a4dad3c0
commit d79a8a862e
4 changed files with 34 additions and 11 deletions
+1
View File
@@ -80,6 +80,7 @@ data World = World
, _lightSources :: !(IM.IntMap LightSource)
, _tempLightSources :: ![TempLightSource]
, _closeActiveObjects :: [Either FloorItem Button]
, _seenLocations :: IM.IntMap (World -> Point2,String)
-- , _remap :: Keycode -> Keycode
}
+1
View File
@@ -223,6 +223,7 @@ basicWorld = World
, _lightSources = IM.empty
, _tempLightSources = [youLight]
, _closeActiveObjects = []
, _seenLocations = IM.fromList [(0, (_crPos . you, "YOURPOS"))]
-- , _remap = keyremapDefault
}
youLight =
+6 -6
View File
@@ -41,22 +41,22 @@ worldPictures w
fixedCoordPictures :: World -> Picture
fixedCoordPictures w = pictures
[ hudIfNoMap
[ scaler $ hudDrawings w
, scaler . onLayer MenuLayer $ menuScreen w
, setDepth (-1) $ closeObjectTexts w
]
where scaler = setDepth (-1) . scale (2 / _windowX w) (2 / _windowY w)
hudIfNoMap = case _mapDisplay w of
(True,_) -> blank
_ -> scaler $ hudDrawings w
mapOverlay :: World -> [Picture]
mapOverlay w = case _mapDisplay w of
(True,mapZoom) -> map ( setLayer 1 . setDepth (-1) . doZoom)
(True,mapZoom) -> (setLayer 1 . setDepth (-1) . color (withAlpha 0.5 black)
. polygon $ screenPolygon w)
:
(map ( setLayer 1 . setDepth (-1) . doZoom )
. mapMaybe mapWall
. IM.elems
$ _walls w
)
where
doZoom = uncurry translate (_cameraPos w)
. scale zoom zoom
+26 -5
View File
@@ -13,9 +13,14 @@ import qualified Data.IntMap as IM
import Control.Lens
hudDrawings :: World -> Picture
hudDrawings w = setLayer 1 $ (onLayer InvLayer)
hudDrawings w = case _mapDisplay w of
(True,_) -> drawLocations w
_ -> drawInventory w
drawInventory :: World -> Picture
drawInventory w =
setLayer 1 $ (onLayer InvLayer)
$ pictures
[ displayInv 0 w
, dShadCol white $ displayHP 0 w
@@ -25,10 +30,26 @@ hudDrawings w = setLayer 1 $ (onLayer InvLayer)
]
where itCol = fromMaybe (greyN 0.5) . (^? itInvColor)
drawLocations w = displayListTopLeft locs w
where locs = map (\(_,s) -> (s,white)) . IM.elems . _seenLocations $ w
displayListTopLeft :: [(String,Color)] -> World -> Picture
displayListTopLeft scols w = pictures $ zipWith (translate (15-halfWidth w))
( map (\x -> halfHeight w - (20 * (fromIntegral x+1))) [0..] )
( map (\(s,col) -> scale 0.1 0.1 . dShadCol col $ text s) scols )
displayInv :: Int -> World -> Picture
displayInv n w = pictures $ zipWith (translate (15-halfWidth w))
(map (\x-> halfHeight w-(20*(fromIntegral x+1))) ns) $ map dItem' is
where (ns,is) = unzip $ IM.toList $ _crInv $ _creatures w IM.! n
displayInv n w = displayListTopLeft scols w
where scols = map itemStringCol . IM.elems . _crInv $ _creatures w IM.! n
--displayInv :: Int -> World -> Picture
--displayInv n w = pictures $ zipWith (translate (15-halfWidth w))
-- (map (\x-> halfHeight w-(20*(fromIntegral x+1))) ns) $ map dItem' is
-- where (ns,is) = unzip $ IM.toList $ _crInv $ _creatures w IM.! n
itemStringCol :: Item -> (String,Color)
itemStringCol NoItem = ("----", greyN 0.5)
itemStringCol itm = (_itInvDisplay itm itm, _itInvColor itm)
dItem' NoItem = scale 0.1 0.1 $ dShadCol (greyN 0.5) $ text "----"
dItem' i = scale 0.1 0.1 $ dShadCol (_itInvColor i) t