This commit is contained in:
2022-06-08 21:51:00 +01:00
parent 91f426e56e
commit b90e8a2118
4 changed files with 40 additions and 45 deletions
+10 -12
View File
@@ -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)
+21 -23
View File
@@ -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 {}
+5 -5
View File
@@ -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
+4 -5
View File
@@ -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)