justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Cleanup

Browse Source
This commit is contained in:
justin
2022-06-08 21:51:00 +01:00
parent 91f426e56e
commit b90e8a2118
4 changed files with 40 additions and 45 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Combine.hs
+10 -12
View File
@@ -3,7 +3,7 @@ module Dodge.Combine
( combinePoss ( combinePoss
, combineSizes , combineSizes
, combineItemListYou , combineItemListYou
, combineItemListStringInfo , combineListInfo
, toggleCombineInv , toggleCombineInv
, enterCombineInv , enterCombineInv
) where ) where
@@ -45,24 +45,22 @@ splitIcAmounts = concatMap f
where where
f (x,n,y) = [((i,x),(i,y)) | i <- [1..n]] f (x,n,y) = [((i,x),(i,y)) | i <- [1..n]]
lookupItems' :: IM.IntMap Item -> [([(IcAmount,Int)],Item)] lookupItems :: IM.IntMap Item -> [([(IcAmount,Int)],Item)]
lookupItems' = flip multiLookupTrieI combinationsTrie . sortOn fst . splitIcAmounts . invertInventory lookupItems = flip multiLookupTrieI combinationsTrie . sortOn fst . splitIcAmounts . invertInventory
combineItemListYouX :: World -> [([Int],Item)] combineItemListYouX :: World -> [([Int],Item)]
combineItemListYouX = map (first f) . lookupItems' . yourInv combineItemListYouX = map (first $ concatMap g) . lookupItems . yourInv
where where
f = concatMap g
g (amount,i) = replicate (_toInt amount) i g (amount,i) = replicate (_toInt amount) i
combineItemListStringInfo :: World -> [([Int],([String],Item))] combineListInfo :: World -> [([Int],([String],Item))]
combineItemListStringInfo w = filter (f . snd . snd) . map (cmm inv) $ combineItemListYouX w combineListInfo w = filter (f . snd . snd) . map (cmm inv) $ combineItemListYouX w
--combineItemListStringInfo w = map (cmm inv) $ combineItemListYouX w
where where
inv = yourInv w inv = yourInv w
f itm = _itType itm `notElem` fmap _itType inv f itm = _itType itm `notElem` fmap _itType inv
combineItemListYou :: World -> [([Int],Item)] combineItemListYou :: World -> [([Int],Item)]
combineItemListYou = map (second snd) . combineItemListStringInfo combineItemListYou = map (second snd) . combineListInfo
cmm :: IM.IntMap Item -> ([Int],Item) -> ([Int],([String],Item)) cmm :: IM.IntMap Item -> ([Int],Item) -> ([Int],([String],Item))
cmm inv (is,itm) = (is,itm & itType . iyModules %%~ flip combineModuleMaps mms) 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 combineModuleMaps :: M.Map ModuleSlot ItemModuleType
-> [M.Map ModuleSlot ItemModuleType] -> [M.Map ModuleSlot ItemModuleType]
-> ([String],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 -> M.Map ModuleSlot ItemModuleType
-> ([String],M.Map ModuleSlot ItemModuleType) -> ([String],M.Map ModuleSlot ItemModuleType)
cMod = mergeA combineTwoModuleMaps = mergeA
preserveMissing preserveMissing
(filterAMissing f) (filterAMissing f)
(zipWithAMatched g) (zipWithAMatched g)
src/Dodge/Render/HUD.hs
+21 -23
View File
@@ -39,12 +39,12 @@ hudDrawings cfig w = case _hudElement $ _hud w of
drawInGameHUD :: Configuration -> World -> Picture drawInGameHUD :: Configuration -> World -> Picture
drawInGameHUD cfig w = pictures drawInGameHUD cfig w = pictures
[ winScale cfig . dShadCol white $ displayHP 0 cfig w [ 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 cfig w
] ]
inventoryDisplay :: Configuration -> World -> Picture inventoryDisplay :: Configuration -> World -> Picture
inventoryDisplay cfig w = listTextPicturesAt 0 0 cfig invlist inventoryDisplay cfig w = listPicturesAt 0 0 cfig invlist
where where
cr = you w cr = you w
inv = _crInv cr inv = _crInv cr
@@ -84,36 +84,34 @@ subInventoryDisplay subinv cfig w = case subinv of
return $ lnkMidInvSel cfig w curpos tweaki return $ lnkMidInvSel cfig w curpos tweaki
<> listCursorNSW subInvX 60 cfig tweaki white (length $ tweakstring ++ tweakname) 1 <> listCursorNSW subInvX 60 cfig tweaki white (length $ tweakstring ++ tweakname) 1
, invHead cfig "TWEAK" , 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 DisplayTerminal tid -> displayTerminal tid cfig w
CombineInventory mi -> pictures CombineInventory mi -> pictures
[ invHead cfig "COMBINE" [ invHead cfig "COMBINE"
, listTextPicturesAt subInvX 60 cfig $ combineListStringPictures w , listPicturesAt subInvX 60 cfig $ combineListStringPictures w
, fromMaybe mempty $ do , fromMaybe mempty $ do
i <- mi i <- mi
cpos <- combinePoss w !? i 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
col <- (combineItemListYou w !? i) <&> _itInvColor . snd col <- (combineItemListYou w !? i) <&> _itInvColor . snd
return $ listCursorNSW subInvX 60 cfig cpos col 15 csize return $ pictures
, fromMaybe mempty $ do [ fromMaybe mempty $ do
i <- mi strs <- fmap (fst . snd) (combineListInfo w !? i)
cpos <- combinePoss w !? i return $ listPicturesAtOff (subInvX + 150) 60 cfig cpos $ map (color red . text) strs
col <- (combineItemListYou w !? i) <&> _itInvColor . snd , fromMaybe mempty $ do
lnks <- map fst (combineItemListYou w) !? i csize <- combineSizes w !? i
return $ lnkMidPosInvSelsCol cfig w cpos col lnks return $ listCursorNSW subInvX 60 cfig cpos col 15 csize
<> foldMap (topCursorTypeWidth listCursorNESW (topInvW +2) cfig w) lnks , fromMaybe mempty $ do
<> combineCounts cfig w lnks 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 InspectInventory -> mconcat
[ selcursor' listCursorNESW [ selcursor' listCursorNESW
, invHead cfig "INSPECT" , invHead cfig "INSPECT"
, listTextPicturesAt subInvX 60 cfig $ map text (itmInfo it) , listPicturesAt subInvX 60 cfig $ map text (itmInfo it)
] ]
where where
closeobjectcursor = case selectedCloseObject w of closeobjectcursor = case selectedCloseObject w of
@@ -165,7 +163,7 @@ displayTerminal tid cfig w = fromMaybe mempty $ do
drawRBOptions :: Configuration -> World -> RightButtonOptions -> Picture drawRBOptions :: Configuration -> World -> RightButtonOptions -> Picture
drawRBOptions cfig w EquipOptions{_opEquip = es,_opSel=i, _opAllocateEquipment=ae} = 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 <> case ae of
DoNotMoveEquipment -> mempty DoNotMoveEquipment -> mempty
PutOnEquipment {} PutOnEquipment {}
src/Dodge/Render/List.hs
+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 -- given a list of pictures that are each the size of a "text" call, displays them as
-- a list on the screen -- a list on the screen
listTextPicturesAt :: Float -> Float -> Configuration -> [Picture] -> Picture listPicturesAt :: Float -> Float -> Configuration -> [Picture] -> Picture
listTextPicturesAt tx ty cfig = listTextPicturesAtOffset tx ty cfig 0 listPicturesAt tx ty cfig = listPicturesAtOff tx ty cfig 0
listTextPicturesAtOffset :: Float -> Float -> Configuration -> Int -> [Picture] -> Picture listPicturesAtOff :: Float -> Float -> Configuration -> Int -> [Picture] -> Picture
listTextPicturesAtOffset tx ty cfig i = mconcat . zipWith (listTextPictureAt tx ty cfig) [i..] listPicturesAtOff tx ty cfig i = mconcat . zipWith (listTextPictureAt tx ty cfig) [i..]
-- displays a cursor that should match up to list text pictures -- displays a cursor that should match up to list text pictures
-- the width of a character appears to be 9(?!) -- the width of a character appears to be 9(?!)
@@ -61,7 +61,7 @@ listTextPictureAt xoff yoff cfig yint = winScale cfig
hh = halfHeight cfig hh = halfHeight cfig
renderListAt :: Float -> Float -> Configuration -> [(String,Color)] -> Picture 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..] -- concatMapPic (winScale cfig) . zipWith (listPairAt tx ty cfig) [0..]
--TODO put the following functions in an appropriate place --TODO put the following functions in an appropriate place
src/Dodge/WorldEvent/Flash.hs
+4 -5
View File
@@ -25,12 +25,11 @@ import LensHelp
import System.Random import System.Random
muzFlareAt :: Color -> Point3 -> Float -> World -> World 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 where
theFlare = Particle
{ _ptDraw = const $ setLayer BloomNoZWrite . translate3 tranv $ theShape
, _ptUpdate = ptSimpleTime 2
}
theShape = rotate dir . color col $ polygon theShape = rotate dir . color col $ polygon
[ V2 0 0 [ V2 0 0
, V2 a (-b) , V2 a (-b)