From b90e8a211841e51d97e56ffd7d1f2d786a1db336 Mon Sep 17 00:00:00 2001 From: justin Date: Wed, 8 Jun 2022 21:51:00 +0100 Subject: [PATCH] Cleanup --- src/Dodge/Combine.hs | 22 ++++++++---------- src/Dodge/Render/HUD.hs | 44 +++++++++++++++++------------------ src/Dodge/Render/List.hs | 10 ++++---- src/Dodge/WorldEvent/Flash.hs | 9 ++++--- 4 files changed, 40 insertions(+), 45 deletions(-) diff --git a/src/Dodge/Combine.hs b/src/Dodge/Combine.hs index bf384047a..55c6399fc 100644 --- a/src/Dodge/Combine.hs +++ b/src/Dodge/Combine.hs @@ -3,7 +3,7 @@ module Dodge.Combine ( combinePoss , combineSizes , combineItemListYou - , combineItemListStringInfo + , combineListInfo , toggleCombineInv , enterCombineInv ) where @@ -45,24 +45,22 @@ splitIcAmounts = concatMap f where f (x,n,y) = [((i,x),(i,y)) | i <- [1..n]] -lookupItems' :: IM.IntMap Item -> [([(IcAmount,Int)],Item)] -lookupItems' = flip multiLookupTrieI combinationsTrie . sortOn fst . splitIcAmounts . invertInventory +lookupItems :: IM.IntMap Item -> [([(IcAmount,Int)],Item)] +lookupItems = flip multiLookupTrieI combinationsTrie . sortOn fst . splitIcAmounts . invertInventory combineItemListYouX :: World -> [([Int],Item)] -combineItemListYouX = map (first f) . lookupItems' . yourInv +combineItemListYouX = map (first $ concatMap g) . lookupItems . yourInv where - f = concatMap g g (amount,i) = replicate (_toInt amount) i -combineItemListStringInfo :: World -> [([Int],([String],Item))] -combineItemListStringInfo w = filter (f . snd . snd) . map (cmm inv) $ combineItemListYouX w ---combineItemListStringInfo w = map (cmm inv) $ combineItemListYouX w +combineListInfo :: World -> [([Int],([String],Item))] +combineListInfo w = filter (f . snd . snd) . map (cmm inv) $ combineItemListYouX w where inv = yourInv w f itm = _itType itm `notElem` fmap _itType inv combineItemListYou :: World -> [([Int],Item)] -combineItemListYou = map (second snd) . combineItemListStringInfo +combineItemListYou = map (second snd) . combineListInfo cmm :: IM.IntMap Item -> ([Int],Item) -> ([Int],([String],Item)) cmm inv (is,itm) = (is,itm & itType . iyModules %%~ flip combineModuleMaps mms) @@ -72,12 +70,12 @@ cmm inv (is,itm) = (is,itm & itType . iyModules %%~ flip combineModuleMaps mms) combineModuleMaps :: M.Map ModuleSlot ItemModuleType -> [M.Map ModuleSlot ItemModuleType] -> ([String],M.Map ModuleSlot ItemModuleType) -combineModuleMaps = foldM cMod +combineModuleMaps = foldM combineTwoModuleMaps -cMod :: M.Map ModuleSlot ItemModuleType +combineTwoModuleMaps :: M.Map ModuleSlot ItemModuleType -> M.Map ModuleSlot ItemModuleType -> ([String],M.Map ModuleSlot ItemModuleType) -cMod = mergeA +combineTwoModuleMaps = mergeA preserveMissing (filterAMissing f) (zipWithAMatched g) diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index 4383a71e8..7a401c6a8 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -39,12 +39,12 @@ hudDrawings cfig w = case _hudElement $ _hud w of drawInGameHUD :: Configuration -> World -> Picture drawInGameHUD cfig w = pictures [ winScale cfig . dShadCol white $ displayHP 0 cfig w - , listTextPicturesAt (halfWidth cfig) 0 cfig $ map text (_testString w w) + , listPicturesAt (halfWidth cfig) 0 cfig $ map text (_testString w w) , inventoryDisplay cfig w ] inventoryDisplay :: Configuration -> World -> Picture -inventoryDisplay cfig w = listTextPicturesAt 0 0 cfig invlist +inventoryDisplay cfig w = listPicturesAt 0 0 cfig invlist where cr = you w inv = _crInv cr @@ -84,36 +84,34 @@ subInventoryDisplay subinv cfig w = case subinv of return $ lnkMidInvSel cfig w curpos tweaki <> listCursorNSW subInvX 60 cfig tweaki white (length $ tweakstring ++ tweakname) 1 , invHead cfig "TWEAK" - , listTextPicturesAt subInvX 60 cfig $ map text (ammoTweakStrings it) + , listPicturesAt subInvX 60 cfig $ map text (ammoTweakStrings it) ] DisplayTerminal tid -> displayTerminal tid cfig w CombineInventory mi -> pictures [ invHead cfig "COMBINE" - , listTextPicturesAt subInvX 60 cfig $ combineListStringPictures w + , listPicturesAt subInvX 60 cfig $ combineListStringPictures w , fromMaybe mempty $ do - i <- mi - cpos <- combinePoss w !? i - strs <- fmap (fst . snd) (combineItemListStringInfo w !? i) - return $ listTextPicturesAtOffset (subInvX + 150) 60 cfig cpos $ map (color red . text) strs - , fromMaybe mempty $ do - i <- mi - cpos <- combinePoss w !? i - csize <- combineSizes w !? i + i <- mi + cpos <- combinePoss w !? i col <- (combineItemListYou w !? i) <&> _itInvColor . snd - return $ listCursorNSW subInvX 60 cfig cpos col 15 csize - , fromMaybe mempty $ do - i <- mi - cpos <- combinePoss w !? i - col <- (combineItemListYou w !? i) <&> _itInvColor . snd - lnks <- map fst (combineItemListYou w) !? i - return $ lnkMidPosInvSelsCol cfig w cpos col lnks - <> foldMap (topCursorTypeWidth listCursorNESW (topInvW +2) cfig w) lnks - <> combineCounts cfig w lnks + return $ pictures + [ fromMaybe mempty $ do + strs <- fmap (fst . snd) (combineListInfo w !? i) + return $ listPicturesAtOff (subInvX + 150) 60 cfig cpos $ map (color red . text) strs + , fromMaybe mempty $ do + csize <- combineSizes w !? i + return $ listCursorNSW subInvX 60 cfig cpos col 15 csize + , fromMaybe mempty $ do + lnks <- map fst (combineItemListYou w) !? i + return $ lnkMidPosInvSelsCol cfig w cpos col lnks + <> foldMap (topCursorTypeWidth listCursorNESW (topInvW +2) cfig w) lnks + <> combineCounts cfig w lnks + ] ] InspectInventory -> mconcat [ selcursor' listCursorNESW , invHead cfig "INSPECT" - , listTextPicturesAt subInvX 60 cfig $ map text (itmInfo it) + , listPicturesAt subInvX 60 cfig $ map text (itmInfo it) ] where closeobjectcursor = case selectedCloseObject w of @@ -165,7 +163,7 @@ displayTerminal tid cfig w = fromMaybe mempty $ do drawRBOptions :: Configuration -> World -> RightButtonOptions -> Picture drawRBOptions cfig w EquipOptions{_opEquip = es,_opSel=i, _opAllocateEquipment=ae} = - listTextPicturesAtOffset 342 0 cfig (curpos-i) (map (text . eqPosText) es) + listPicturesAtOff 342 0 cfig (curpos-i) (map (text . eqPosText) es) <> case ae of DoNotMoveEquipment -> mempty PutOnEquipment {} diff --git a/src/Dodge/Render/List.hs b/src/Dodge/Render/List.hs index d1e675316..97a4fc1ea 100644 --- a/src/Dodge/Render/List.hs +++ b/src/Dodge/Render/List.hs @@ -9,11 +9,11 @@ import Data.Maybe -- 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 = listTextPicturesAtOffset tx ty cfig 0 +listPicturesAt :: Float -> Float -> Configuration -> [Picture] -> Picture +listPicturesAt tx ty cfig = listPicturesAtOff tx ty cfig 0 -listTextPicturesAtOffset :: Float -> Float -> Configuration -> Int -> [Picture] -> Picture -listTextPicturesAtOffset tx ty cfig i = mconcat . zipWith (listTextPictureAt tx ty cfig) [i..] +listPicturesAtOff :: Float -> Float -> Configuration -> Int -> [Picture] -> Picture +listPicturesAtOff tx ty cfig i = mconcat . zipWith (listTextPictureAt tx ty cfig) [i..] -- displays a cursor that should match up to list text pictures -- the width of a character appears to be 9(?!) @@ -61,7 +61,7 @@ listTextPictureAt xoff yoff cfig yint = winScale cfig hh = halfHeight cfig renderListAt :: Float -> Float -> Configuration -> [(String,Color)] -> Picture -renderListAt tx ty cfig = listTextPicturesAt tx ty cfig . map (\(str,col) -> color col $ text str) +renderListAt tx ty cfig = listPicturesAt tx ty cfig . map (\(str,col) -> color col $ text str) -- concatMapPic (winScale cfig) . zipWith (listPairAt tx ty cfig) [0..] --TODO put the following functions in an appropriate place diff --git a/src/Dodge/WorldEvent/Flash.hs b/src/Dodge/WorldEvent/Flash.hs index 5a0ed8fb7..fea90e0c2 100644 --- a/src/Dodge/WorldEvent/Flash.hs +++ b/src/Dodge/WorldEvent/Flash.hs @@ -25,12 +25,11 @@ import LensHelp import System.Random muzFlareAt :: Color -> Point3 -> Float -> World -> World -muzFlareAt col tranv dir w = w & instantParticles .:~ theFlare +muzFlareAt col tranv dir w = w & instantParticles .:~ Particle + { _ptDraw = const $ setLayer BloomNoZWrite . translate3 tranv $ theShape + , _ptUpdate = ptSimpleTime 2 + } where - theFlare = Particle - { _ptDraw = const $ setLayer BloomNoZWrite . translate3 tranv $ theShape - , _ptUpdate = ptSimpleTime 2 - } theShape = rotate dir . color col $ polygon [ V2 0 0 , V2 a (-b)