Beef up minigun

This commit is contained in:
2021-08-28 12:09:39 +01:00
parent 1168da0531
commit 882a8e9824
17 changed files with 263 additions and 237 deletions
+47 -8
View File
@@ -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