Cleanup
This commit is contained in:
+10
-12
@@ -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
@@ -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 {}
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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)
|
||||
|
||||
Reference in New Issue
Block a user