diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 23f9986af..b1ea83cba 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -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 } diff --git a/src/Dodge/Prototypes.hs b/src/Dodge/Prototypes.hs index 732e90cab..e039abef5 100644 --- a/src/Dodge/Prototypes.hs +++ b/src/Dodge/Prototypes.hs @@ -223,6 +223,7 @@ basicWorld = World , _lightSources = IM.empty , _tempLightSources = [youLight] , _closeActiveObjects = [] + , _seenLocations = IM.fromList [(0, (_crPos . you, "YOURPOS"))] -- , _remap = keyremapDefault } youLight = diff --git a/src/Dodge/Rendering.hs b/src/Dodge/Rendering.hs index 5659d0241..ce36e428e 100644 --- a/src/Dodge/Rendering.hs +++ b/src/Dodge/Rendering.hs @@ -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 diff --git a/src/Dodge/Rendering/HUD.hs b/src/Dodge/Rendering/HUD.hs index 328f7c872..52a12a1fe 100644 --- a/src/Dodge/Rendering/HUD.hs +++ b/src/Dodge/Rendering/HUD.hs @@ -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