diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 9e84d9b4c..123e736fe 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -341,7 +341,7 @@ data Item , _itID :: Maybe Int , _itEffect :: ItEffect , _itInvSize :: Int - , _itInvDisplay :: Item -> String + , _itInvDisplay :: Item -> [String] , _itInvColor :: Color , _itTargeting :: Maybe (World -> Maybe Point2, Int -> Item -> Creature -> World -> Picture) , _itDimension :: ItemDimension @@ -358,7 +358,7 @@ data Item , _itEquipPict :: Creature -> Int -> SPic , _itIdentity :: ItemIdentity , _itID :: Maybe Int - , _itInvDisplay :: Item -> String + , _itInvDisplay :: Item -> [String] , _itInvColor :: Color , _itEffect :: ItEffect , _itCurseStatus :: CurseStatus @@ -372,7 +372,7 @@ data Item , _itEquipPict :: Creature -> Int -> SPic , _itIdentity :: ItemIdentity , _itID :: Maybe Int - , _itInvDisplay :: Item -> String + , _itInvDisplay :: Item -> [String] , _itInvColor :: Color , _itCurseStatus :: CurseStatus , _itDimension :: ItemDimension @@ -385,7 +385,7 @@ data Item , _itEffect :: ItEffect , _itID :: Maybe Int , _itZoom :: ItZoom - , _itInvDisplay :: Item -> String + , _itInvDisplay :: Item -> [String] , _itInvColor :: Color , _itCurseStatus :: CurseStatus , _itDimension :: ItemDimension @@ -403,7 +403,7 @@ data Item , _itIdentity :: ItemIdentity , _itID :: Maybe Int , _itAttachment :: ItAttachment - , _itInvDisplay :: Item -> String + , _itInvDisplay :: Item -> [String] , _itInvColor :: Color , _itEffect :: ItEffect , _itScroll :: Float -> Creature -> Item -> Item diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index 8e8382466..8dfef05fe 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -140,7 +140,7 @@ defaultEquipment = Equipment , _itID = Nothing , _itZoom = defaultItZoom , _itInvColor = yellow - , _itInvDisplay = _itName + , _itInvDisplay = \it -> [_itName it] , _itDimension = defaultItemDimension } defaultItZoom :: ItZoom @@ -157,7 +157,7 @@ defaultConsumable = Consumable , _itEquipPict = \_ _ -> (,) emptySH blank , _itID = Nothing , _itInvColor = blue - , _itInvDisplay = \it -> _itName it ++ " x" ++ show (_itAmount it) + , _itInvDisplay = \it -> [_itName it ++ " x" ++ show (_itAmount it)] , _itEffect = NoItEffect , _itDimension = defaultItemDimension } @@ -204,7 +204,7 @@ defaultIt = Consumable , _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ polygon $ square 3 , _itEquipPict = \_ _ -> (,) emptySH blank , _itID = Nothing - , _itInvDisplay = _itName + , _itInvDisplay = (:[]) . _itName , _itInvColor = blue , _itEffect = NoItEffect } diff --git a/src/Dodge/Item.hs b/src/Dodge/Item.hs index 835a4f5f9..e776d118c 100644 --- a/src/Dodge/Item.hs +++ b/src/Dodge/Item.hs @@ -20,7 +20,7 @@ keyToken n = defaultEquipment , _itID = Nothing -- , _itZoom = defaultItZoom , _itInvColor = yellow - , _itInvDisplay = _itName + , _itInvDisplay = (:[]) . _itName } keyPic :: Picture keyPic = color green $ @@ -41,7 +41,6 @@ latchkey n = defaultEquipment , _itID = Nothing -- , _itZoom = defaultItZoom , _itInvColor = yellow - , _itInvDisplay = _itName } latchkeyPic :: Picture latchkeyPic = color yellow $ diff --git a/src/Dodge/Item/Craftable.hs b/src/Dodge/Item/Craftable.hs index 4ea156bc8..bd5ace37e 100644 --- a/src/Dodge/Item/Craftable.hs +++ b/src/Dodge/Item/Craftable.hs @@ -17,6 +17,6 @@ pipe = Craftable $ onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)] , _itEquipPict = \_ _ -> mempty , _itID = Nothing - , _itInvDisplay = _itName + , _itInvDisplay = (:[]) . _itName , _itInvColor = green } diff --git a/src/Dodge/Item/Weapon/BulletGuns.hs b/src/Dodge/Item/Weapon/BulletGuns.hs index fcfa89b98..08f74a459 100644 --- a/src/Dodge/Item/Weapon/BulletGuns.hs +++ b/src/Dodge/Item/Weapon/BulletGuns.hs @@ -257,6 +257,7 @@ miniGun = defaultAutoGun , _itEquipPict = pictureWeaponAim miniGunPictItem , _itTweaks = defaultBulletSelTweak , _itInvSize = 2 + , _itInvDisplay = \it -> basicWeaponDisplay it ++ [" COLD"] } & itDimension . muzzleLength .~ 15 where recoilAmount = 5 diff --git a/src/Dodge/Item/Weapon/InventoryDisplay.hs b/src/Dodge/Item/Weapon/InventoryDisplay.hs index 8dfa77361..2d51e477a 100644 --- a/src/Dodge/Item/Weapon/InventoryDisplay.hs +++ b/src/Dodge/Item/Weapon/InventoryDisplay.hs @@ -11,8 +11,8 @@ import Data.Maybe import Data.Sequence import Control.Lens {- | Displays the item name, ammo if loaded, and any selected '_itCharMode'. -} -basicWeaponDisplay :: Item -> String -basicWeaponDisplay it = midPadL 10 ' ' thename (' ' : thenumber) ++ theparam +basicWeaponDisplay :: Item -> [String] +basicWeaponDisplay it = [midPadL 10 ' ' thename (' ' : thenumber) ++ theparam] where thename = _itName it thenumber = case it ^? itConsumption of diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index 6117d6b50..92915b373 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -38,24 +38,37 @@ drawInventory cfig w = subInventoryDisplay cfig w `appendPic` displayInv 0 cfig subInventoryDisplay :: Configuration -> World -> Picture subInventoryDisplay cfig w = case _inventoryMode w of - LockedInventory -> topInvCursor col iPos cfig w + LockedInventory -> mempty -- topInvCursor col cursPos cfig w TopInventory -> pictures [ closeObjectTexts cfig w - , topInvCursor col iPos cfig w +-- , topInvCursor col cursPos cfig w ] TweakInventory -> pictures [ mCurs it cfig w - , cursorAt 120 col 5 0 iPos cfig - , cursorsZ cfig iPos it + , cursorAt 120 col 5 0 cursPos cfig + , cursorsZ cfig cursPos it , displayMidList cfig (ammoTweakStrings it) "TWEAK" ] CombineInventory -> invHead cfig "COMBINE" InspectInventory -> invHead cfig "INSPECT" where itCol = fromMaybe (greyN 0.5) . (^? itInvColor) - iPos = _crInvSel $ _creatures w IM.! _yourID w + cr = you w it = yourItem w col = itCol it + cursPos = crInvSelPos cr + +crInvSelSize :: Creature -> Int +crInvSelSize cr = theitinvsize $ _crInv cr IM.! _crInvSel cr + where + theitinvsize NoItem = 1 -- this should be removable later + theitinvsize x = _itInvSize x + +crInvSelPos :: Creature -> Int +crInvSelPos cr = sum . fmap theitinvsize . fst $ IM.split (_crInvSel cr) (_crInv cr) + where + theitinvsize NoItem = 1 -- this should be removable later + theitinvsize x = _itInvSize x cursorsZ :: Configuration -> Int -> Item -> Picture cursorsZ cfig ipos it = case it ^? itTweaks . tweakSel of @@ -67,13 +80,6 @@ cursorsZ cfig ipos it = case it ^? itTweaks . tweakSel of hw = halfWidth cfig sp = V2 (125 - hw) ( hh - (20 * fromIntegral ipos + 17.5)) -topInvCursor :: Color -> Int -> Configuration -> World -> Picture -topInvCursor col iPos cfig w - | ButtonRight `S.member` _mouseButtons w = - cursorAt 100 col 5 0 iPos cfig - `appendPic` openCursorAt 20 col 105 0 iPos cfig - | otherwise = mainListCursor col iPos cfig - ammoTweakStrings :: Item -> [String] ammoTweakStrings it = case it ^? itTweaks . tweakParams of Just l -> map tweakString $ IM.elems l @@ -107,17 +113,22 @@ invHead cfig s = winScale cfig . scale 0.4 0.4 $ text s -renderItemMapAt :: Float -> Float -> Configuration -> IM.IntMap Item -> Picture -{-# INLINE renderItemMapAt #-} -renderItemMapAt tx ty cfig = concatMapPic (uncurry $ listItemAt tx ty cfig) . IM.toList +--renderItemMapAt :: Float -> Float -> Configuration -> IM.IntMap Item -> Picture +--{-# INLINE renderItemMapAt #-} +--renderItemMapAt tx ty cfig = concatMapPic (uncurry $ listItemAt tx ty cfig) . IM.toList + displayInv :: Int -> Configuration -> World -> Picture -displayInv n cfig w = renderItemMapAt 0 0 cfig (_crInv cr) +displayInv n cfig w = listTextPicturesAt 0 0 cfig (concatMap itemToTextPictures $ IM.elems $ _crInv cr) <> equipcursor + <> listCursorAt 0 0 cfig curpos white curx cury where + curpos = crInvSelPos $ you w + curx = 10 + cury = crInvSelSize $ you w equipcursor = case _crLeftInvSel cr of Nothing -> mempty - Just invid -> openCursorAt 20 yellow 105 0 invid cfig + Just invid -> openCursorAt 20 yellow 0 0 invid cfig cr = _creatures w IM.! n drawLocations :: Configuration -> World -> Picture @@ -186,32 +197,19 @@ closeObjectTexts cfig w = pictures $ mainListCursor :: Color -> Int -> Configuration -> Picture mainListCursor c = openCursorAt 120 c 5 0 -listItemAt - :: Float -- ^ x offset - -> Float -- ^ y offset - -> Configuration - -> Int -- ^ y offset (discrete) - -> Item -- ^ The item - -> Picture -{-# INLINE listItemAt #-} -listItemAt xoff yoff w yint - = winScale w - . translate (xoff + 15 - hw) (yoff + hh - (20 * (fromIntegral yint+1))) - . scale 0.1 0.1 - . itemText - where - hw = halfWidth w - hh = halfHeight w +itemToTextPictures :: Item -> [Picture] +itemToTextPictures it = itemText it -itemText :: Item -> Picture + +itemText :: Item -> [Picture] {-# INLINE itemText #-} --itemText NoItem = dShadCol (greyN 0.5) $ text "----" --itemText it = dShadCol (_itInvColor it) $ text (_itInvDisplay it it) -itemText NoItem = text "----" +itemText NoItem = [text "----"] itemText it = case _itCurseStatus it of - UndroppableIdentified -> color black (text (_itInvDisplay it it)) - <> color (withAlpha 0.9 thecolor) (polygon (rectNSEW 110 (-65) 885 (-90))) - _ -> color thecolor $ text (_itInvDisplay it it) + UndroppableIdentified -> map (color yellow . text) (_itInvDisplay it it) +-- <> color (withAlpha 0.9 thecolor) (polygon (rectNSEW 110 (-65) 885 (-90))) + _ -> map (color thecolor . text) (_itInvDisplay it it) where thecolor = _itInvColor it diff --git a/src/Dodge/Render/List.hs b/src/Dodge/Render/List.hs index f554edab9..f46cefd6b 100644 --- a/src/Dodge/Render/List.hs +++ b/src/Dodge/Render/List.hs @@ -1,13 +1,45 @@ -module Dodge.Render.List - ( renderListAt - , dShadCol - , winScale - ) - where +module Dodge.Render.List where import Dodge.Data import Dodge.Base.Window import Dodge.WinScale import Picture +import Geometry + +-- given a list of pictures that are each the size of a "text" call, displays them as +-- a list on the screen +listTextPicturesAt :: Float -> Float -> Configuration -> [Picture] -> Picture +listTextPicturesAt tx ty cfig = mconcat . zipWith (listTextPictureAt tx ty cfig) [0..] + +-- displays a cursor that should match up to list text pictures +-- the width of a character appears to be 9(?!) +listCursorAt :: Float -> Float -> Configuration -> Int -> Color -> Int -> Int -> Picture +listCursorAt xoff yoff cfig yint col cursxsize cursysize = winScale cfig + . translate (10.5+xoff-halfWidth cfig) (halfHeight cfig - (20* fromIntegral yint + yoff) - 20) + $ lineCol + [(V2 0 12.5 , col) + ,(V2 wth 12.5 ,col) + ] <> + lineCol + [(V2 0 (12.5 - hgt),col) + ,(V2 wth (12.5 - hgt),col) + ] + --[(V2 wth 12.5 ,withAlpha 0 col) + --,(V2 0 12.5 ,col) + --,(V2 0 (12.5 - hgt),col) + --,(V2 wth (12.5 - hgt),withAlpha 0 col) + --] + where + x = 9 + wth = x * fromIntegral cursxsize + hgt = 20 * fromIntegral cursysize + +listTextPictureAt :: Float -> Float -> Configuration -> Int -> Picture -> Picture +listTextPictureAt xoff yoff cfig yint = winScale cfig + . translate (xoff + 15 - hw) (yoff + hh - (20 * (fromIntegral yint+1))) + . scale 0.1 0.1 + where + hw = halfWidth cfig + hh = halfHeight cfig renderListAt :: Float -> Float -> Configuration -> [(String,Color)] -> Picture renderListAt tx ty cfig =