Beef up minigun

src/Dodge/Render/HUD.hs

@@ -17,6 +17,7 @@ import qualified Data.IntMap.Strict as IM
 import qualified Data.Set as S
 import Control.Lens
 import SDL (MouseButton (..))
+--import Data.Bifunctor
 
 hudDrawings :: World -> Picture
 hudDrawings w = pictures
@@ -104,18 +105,29 @@ displayMidList w strs s =
 invHead :: World -> String -> Picture
 invHead w s = winScale w . translate (-130) (halfHeight w - 40) . dShadCol white . scale 0.4 0.4 $ text s
 
+renderItemMapAt :: Float -> Float -> IM.IntMap Item -> World -> Picture
+{-# INLINE renderItemMapAt #-}
+renderItemMapAt tx ty scols w =
+    --concatMapPic (winScale w) $ IM.mapWithKey (listItemAt tx ty w) scols
+    --concatMapPic (winScale w . uncurry (listItemAt tx ty w)) $ IM.toList scols
+    concatMapPic (uncurry $ listItemAt' tx ty w) $ IM.toList scols
+
+--renderPairListAt :: Float -> Float -> [(Int,(String,Color))] -> World -> Picture
+--renderPairListAt tx ty scols w =
+--    concatMapPic (winScale w) $ map (uncurry $ listPairAt tx ty w) scols
+
 renderListAt :: Float -> Float -> [(String,Color)] -> World -> Picture
 renderListAt tx ty scols w =
-    concatMapPic (winScale w) $ zipWith (listItemAt tx ty w) [0..] scols
+    concatMapPic (winScale w) $ zipWith (listPairAt tx ty w) [0..] scols
 
 displayInv :: Int -> World -> Picture
-displayInv n w = renderListAt 0 0 scols w
+displayInv n w = renderItemMapAt 0 0 items w
   where 
-    scols = map itemStringCol . IM.elems . _crInv $ _creatures w IM.! n
+    items = _crInv $ _creatures w IM.! n
 
-itemStringCol :: Item -> (String,Color)
-itemStringCol NoItem    = ("----", greyN 0.5)
-itemStringCol itm       = (_itInvDisplay itm itm, _itInvColor itm)
+--itemStringCol :: Item -> (String,Color)
+--itemStringCol NoItem    = ("----", greyN 0.5)
+--itemStringCol itm       = (_itInvDisplay itm itm, _itInvColor itm)
 
 drawLocations :: World -> Picture
 drawLocations wrld = pictures $ 
@@ -191,14 +203,41 @@ dShadCol c p = pictures
 mainListCursor :: Color -> Int -> World -> Picture
 mainListCursor c = openCursorAt 120 c 5 0
 
-listItemAt
+listItemAt'
+    :: Float    -- ^ x offset
+    -> Float    -- ^ y offset
+    -> World 
+    -> Int      -- ^ y offset (discrete)
+    -> Item   -- ^ The item
+    -> Picture
+{-# INLINE listItemAt' #-}
+listItemAt' xoff yoff w yint item = winScale w . translate (xoff + 15 - halfWidth w) (yoff + halfHeight w - (20 * (fromIntegral yint+1)))
+    . scale 0.1 0.1
+    . dShadCol col
+    $ text s
+  where
+    (s,col) = case item of 
+        NoItem -> ("----", greyN 0.5)
+        _       -> (_itInvDisplay item item , _itInvColor item)
+
+--listItemAt
+--    :: Float    -- ^ x offset
+--    -> Float    -- ^ y offset
+--    -> World 
+--    -> Int      -- ^ y offset (discrete)
+--    -> Item   -- ^ The item
+--    -> Picture
+--{-# INLINE listItemAt #-}
+--listItemAt xoff yoff w yint = listPairAt xoff yoff w yint . itemStringCol
+listPairAt
     :: Float    -- ^ x offset
     -> Float    -- ^ y offset
     -> World 
     -> Int      -- ^ y offset (discrete)
     -> (String,Color)   -- ^ The text item
     -> Picture
-listItemAt xoff yoff w yint (s,col) 
+{-# INLINE listPairAt #-}
+listPairAt xoff yoff w yint (s,col) 
     = translate (xoff + 15 - halfWidth w) (yoff + halfHeight w - (20 * (fromIntegral yint+1)))
     . scale 0.1 0.1
     . dShadCol col

src/Dodge/Render/Picture.hs

@@ -219,9 +219,14 @@ wallsAndWindows w
 wallsToList :: [((Point2,Point2),Point4)] -> [Float]
 wallsToList = concatMap (\((V2 a b,V2 c d),V4 e f g h) -> [a,b,c,d,e,f,g,h])
 
-
 lightsForGloom :: World -> [(Point3,Float,Point3)]
-lightsForGloom w = map getLS (IM.elems $ _lightSources w) ++ map getTLS (_tempLightSources w)
+lightsForGloom w = mapMaybe getLS (IM.elems $ _lightSources w) ++ mapMaybe getTLS (_tempLightSources w)
   where 
-    getLS ls  = ( _lsPos ls,  _lsRad ls , _lsIntensity ls)
-    getTLS ls = ( _tlsPos ls, _tlsRad ls, _tlsIntensity ls)
+    getLS ls  
+        | dist campos (fst2 $ _lsPos ls) > 1000 = Nothing
+        | otherwise = Just ( _lsPos ls,  _lsRad ls , _lsIntensity ls)
+    getTLS ls 
+        | dist campos (fst2 $ _tlsPos ls) > 1000 = Nothing
+        | otherwise = Just ( _tlsPos ls, _tlsRad ls, _tlsIntensity ls)
+    campos = _cameraCenter w
+    fst2 (V3 a b _) = V2 a b