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

Only display combinations for first items in list

Browse Source
This commit is contained in:
justin
2024-09-08 21:00:16 +01:00
parent 4de15d2c21
commit db4a6a10de
16 changed files with 192 additions and 76 deletions
Download Patch File Download Diff File Expand all files Collapse all files
ghcidOutput
+58 -13
View File
@@ -1,18 +1,18 @@
/home/justin/Haskell/loop/src/Dodge/Combine.hs:37:1-20: warning: [-Wunused-top-binds]
Defined but not used: ‘invertInventoryToMap’
/home/justin/Haskell/loop/src/Dodge/Combine.hs:31:1-15: warning: [-Wunused-top-binds]
Defined but not used: ‘invertInventory’
|
37 | invertInventoryToMap =
| ^^^^^^^^^^^^^^^^^^^^
31 | invertInventory =
| ^^^^^^^^^^^^^^^
/home/justin/Haskell/loop/src/Dodge/Combine.hs:43:1-14: warning: [-Wunused-top-binds]
Defined but not used: ‘splitItAmounts’
|
43 | splitItAmounts = concatMap f
| ^^^^^^^^^^^^^^
/home/justin/Haskell/loop/src/Dodge/Combine.hs:48:1-21: warning: [-Wunused-top-binds]
Defined but not used: ‘groupSplitItemAmounts’
/home/justin/Haskell/loop/src/Dodge/Combine.hs:53:1-18: warning: [-Wunused-top-binds]
Defined but not used: ‘flatSplitItAmounts’
|
48 | groupSplitItemAmounts = M.foldrWithKey f []
| ^^^^^^^^^^^^^^^^^^^^^
53 | flatSplitItAmounts = concatMap f
| ^^^^^^^^^^^^^^^^^^
/home/justin/Haskell/loop/src/Dodge/Combine.hs:58:1-11: warning: [-Wunused-top-binds]
Defined but not used: ‘lookupItems’
|
@@ -23,27 +23,72 @@
|
9 | import Data.Bifunctor
| ^^^^^^^^^^^^^^^^^^^^^
/home/justin/Haskell/loop/src/Dodge/Item/Grammar.hs:3:1: warning: [-Wunused-imports]
/home/justin/Haskell/loop/src/Dodge/Render/HUD.hs:237:15-18: warning: [-Wunused-matches]
Defined but not used: ‘cfig’
|
237 | combineCounts cfig w = foldMap f . group
| ^^^^
/home/justin/Haskell/loop/src/Dodge/Render/HUD.hs:237:20: warning: [-Wunused-matches]
Defined but not used: ‘w’
|
237 | combineCounts cfig w = foldMap f . group
| ^
/home/justin/Haskell/loop/src/Dodge/Item/Amount.hs:3:1-19: warning: [-Wunused-imports]
The import of ‘Control.Lens’ is redundant
|
3 | import Control.Lens
| ^^^^^^^^^^^^^^^^^^^
/home/justin/Haskell/loop/src/Dodge/Item/Amount.hs:4:1-17: warning: [-Wunused-imports]
The import of ‘Data.Maybe’ is redundant
|
4 | import Data.Maybe
| ^^^^^^^^^^^^^^^^^
/home/justin/Haskell/loop/src/Dodge/Item/Amount.hs:8:15-16: warning: [-Wunused-matches]
Defined but not used: ‘it’
|
8 | itStackAmount it = 1 -- fromMaybe 1 $ it ^? itUse . useAmount
| ^^
/home/justin/Haskell/loop/src/Dodge/Inventory/CheckSlots.hs:7:1-19: warning: [-Wunused-imports]
The import of ‘Control.Lens’ is redundant
|
7 | import Control.Lens
| ^^^^^^^^^^^^^^^^^^^
/home/justin/Haskell/loop/src/Dodge/Inventory/CheckSlots.hs:8:1-17: warning: [-Wunused-imports]
The import of ‘Data.Maybe’ is redundant
|
8 | import Data.Maybe
| ^^^^^^^^^^^^^^^^^
/home/justin/Haskell/loop/src/Dodge/Inventory/CheckSlots.hs:28:14-15: warning: [-Wunused-matches]
Defined but not used: ‘it’
|
28 | findItemSlot it inv = maybe 0 ((+ 1) . fst) $ IM.lookupMax inv
| ^^
/home/justin/Haskell/loop/src/Dodge/Item/SlotsTaken.hs:5:1-19: warning: [-Wunused-imports]
The import of ‘Control.Lens’ is redundant
|
5 | import Control.Lens
| ^^^^^^^^^^^^^^^^^^^
/home/justin/Haskell/loop/src/Dodge/Item/Grammar.hs:3:1-22: warning: [-Wunused-imports]
The import of ‘Dodge.Data.Item’ is redundant
|
3 | import Dodge.Data.Item
| ^^^^^^^^^^^^^^^^^^^^^^
/home/justin/Haskell/loop/src/Dodge/Item/Draw/SPic.hs:20:1: warning: [-Wunused-top-binds]
/home/justin/Haskell/loop/src/Dodge/Item/Draw/SPic.hs:20:1-15: warning: [-Wunused-top-binds]
Defined but not used: ‘itemHeldAmmoPic’
|
20 | itemHeldAmmoPic itm amit = itemSPic itm <> addAmmoClip itm amit
| ^^^^^^^^^^^^^^^
/home/justin/Haskell/loop/src/Dodge/Item/Draw/SPic.hs:23:1: warning: [-Wunused-top-binds]
/home/justin/Haskell/loop/src/Dodge/Item/Draw/SPic.hs:23:1-11: warning: [-Wunused-top-binds]
Defined but not used: ‘addAmmoClip’
|
23 | addAmmoClip itm amit = fromMaybe mempty $ do
| ^^^^^^^^^^^
/home/justin/Haskell/loop/src/Dodge/Item/Draw/SPic.hs:23:17: warning: [-Wunused-matches]
/home/justin/Haskell/loop/src/Dodge/Item/Draw/SPic.hs:23:17-20: warning: [-Wunused-matches]
Defined but not used: ‘amit’
|
23 | addAmmoClip itm amit = fromMaybe mempty $ do
| ^^^^
/home/justin/Haskell/loop/src/Dodge/Item/Draw/SPic.hs:24:5: warning: [-Wunused-matches]
/home/justin/Haskell/loop/src/Dodge/Item/Draw/SPic.hs:24:5-7: warning: [-Wunused-matches]
Defined but not used: ‘hit’
|
24 | hit <- itm ^? itType . iyBase . ibtHeld
saveSlot/LevelStart0
+1 -1
View File
File diff suppressed because one or more lines are too long
src/Dodge/Combine.hs
+5 -5
View File
@@ -57,12 +57,12 @@ flatSplitItAmounts = concatMap f
lookupItems :: IM.IntMap Item -> [([(ItAmount, Int)], Item)]
lookupItems = flip multiLookupTrieI combinationsTrie . sortOn fst . splitItAmounts . invertInventory
--flatLookupItems :: IM.IntMap Item -> [([[Int]],Item)]
--flatLookupItems = flip multiLookupTrieI combinationsTrie . sortOn fst . groupSplitItemAmounts
-- . invertInventoryToMap
flatLookupItems :: IM.IntMap Item -> [([[Int]],Item)]
flatLookupItems = flip multiLookupTrieI combinationsTrie . sortOn fst . flatSplitItAmounts
. invertInventory
flatLookupItems = flip multiLookupTrieI combinationsTrie . sortOn fst . groupSplitItemAmounts
. invertInventoryToMap
--flatLookupItems :: IM.IntMap Item -> [([[Int]],Item)]
--flatLookupItems = flip multiLookupTrieI combinationsTrie . sortOn fst . flatSplitItAmounts
-- . invertInventory
combineItemListYouX :: World -> [([Int], Item)]
combineItemListYouX = map (first $ concat) . flatLookupItems . yourInv
src/Dodge/Creature.hs
+18 -13
View File
@@ -116,7 +116,8 @@ inventoryX :: Char -> [Item]
inventoryX c = case c of
'A' ->
[ clickDetector ITEMDETECTOR
, makeTypeCraftNum 1 TRANSFORMER
] <> fold
[ makeTypeCraftNum 1 TRANSFORMER
, makeTypeCraftNum 2 CAN
, makeTypeCraftNum 2 PIPE
]
@@ -130,7 +131,8 @@ inventoryX c = case c of
, tinMag
, machinePistol
, tinMag
, makeTypeCraftNum 4 MICROCHIP
] <> fold
[ makeTypeCraftNum 4 MICROCHIP
, makeTypeCraftNum 2 TIN
, makeTypeCraftNum 2 HARDWARE
, makeTypeCraftNum 2 CAN
@@ -148,7 +150,7 @@ inventoryX c = case c of
, unsafeBlinkGun
, autoDetector WALLDETECTOR
]
'E' ->
'E' -> fold
[ makeTypeCraftNum 3 PIPE
, makeTypeCraftNum 5 HARDWARE
, makeTypeCraftNum 1 TIN
@@ -158,7 +160,7 @@ inventoryX c = case c of
, makeTypeCraftNum 1 STEELDRUM
, makeTypeCraftNum 1 MOTOR
]
'F' ->
'F' -> fold
[ makeTypeCraftNum 5 PIPE
, makeTypeCraftNum 5 TUBE
, makeTypeCraftNum 5 HARDWARE
@@ -181,7 +183,8 @@ inventoryX c = case c of
, tinMag
, pistol
, tinMag
, makeTypeCraftNum 2 HARDWARE
] <> fold
[ makeTypeCraftNum 2 HARDWARE
, makeTypeCraftNum 2 MAGNET
, makeTypeCraftNum 5 (ENERGYBALLCRAFT IncBall)
, makeTypeCraftNum 5 (ENERGYBALLCRAFT TeslaBall)
@@ -192,22 +195,23 @@ inventoryX c = case c of
'H' -> [shatterGun]
'I' ->
[ makeTypeCraft TELEPORTMODULE
, makeTypeCraftNum 2 TIMEMODULE
, makeTypeCraftNum 2 MICROCHIP
, makeTypeCraft HARDDRIVE
, makeTypeCraft RAM
] <> fold
[ makeTypeCraftNum 2 TIMEMODULE
, makeTypeCraftNum 2 MICROCHIP
]
'J' ->
[ lasGun
, lasGun
, dualBeam
, makeTypeCraftNum 10 TRANSFORMER
]
] <> makeTypeCraftNum 10 TRANSFORMER
'K' ->
[ autoRifle
, tinMag
, targetingHat TargetRBPress
, makeTypeCraftNum 7 MICROCHIP
] <> fold
[ makeTypeCraftNum 7 MICROCHIP
, makeTypeCraftNum 4 HARDWARE
, makeTypeCraftNum 2 MAGNET
, makeTypeCraftNum 1 MOTOR
@@ -239,8 +243,7 @@ inventoryX c = case c of
testInventory :: [Item]
testInventory =
[ makeTypeCraftNum 9 PIPE
, autoAmr
[ autoAmr
, brainHat
, headLamp
, autoDetector WALLDETECTOR
@@ -249,11 +252,13 @@ testInventory =
, wristArmour
, flatShield
, sniperRifle
, makeTypeCraftNum 1 MOTOR
, makeTypeCraft (ENERGYBALLCRAFT IncBall)
, makeTypeCraft (ENERGYBALLCRAFT TeslaBall)
, makeTypeCraft (ENERGYBALLCRAFT ConcBall)
, teleportModule
] <> fold
[ makeTypeCraftNum 1 MOTOR
, makeTypeCraftNum 9 PIPE
, makeTypeCraftNum 10 HARDWARE
, makeTypeCraftNum 3 SPRING
, makeTypeCraftNum 10 CAN
src/Dodge/Creature/Impulse/UseItem.hs
+1 -1
View File
@@ -44,7 +44,7 @@ itemEffect cr it w = case it ^. itUse of
LeftUse{} -> doequipmentchange
EquipUse{} -> doequipmentchange
-- ConsumeUse will cause problems if the item is not selected
(ConsumeUse eff _) -> useC eff it cr $ rmInvItem (_crID cr) itRef w
(ConsumeUse eff) -> useC eff it cr $ rmInvItem (_crID cr) itRef w
CraftUse{} -> w
AttachUse{} -> w
AmmoMagUse{} -> w
src/Dodge/Data/Item/Use.hs
+2 -2
View File
@@ -45,14 +45,14 @@ data ItemUse
}
| ConsumeUse
{ _cUse :: Cuse
, _useAmount :: ItAmount
-- , _useAmount :: ItAmount
}
| EquipUse
{ _equipEffect :: EquipEffect
, _equipTargeting :: Maybe TargetType
}
| CraftUse
{_useAmount :: ItAmount}
-- {_useAmount :: ItAmount}
| AttachUse
{_attachParams :: AttachParams}
| AmmoMagUse
src/Dodge/Default/Item.hs
+2 -2
View File
@@ -39,7 +39,7 @@ defaultLeftItem :: Item
defaultLeftItem = defaultHeldItem & itUse .~ defaultLeftUse
defaultCraftItem :: Item
defaultCraftItem = defaultHeldItem & itUse .~ CraftUse 1
defaultCraftItem = defaultHeldItem & itUse .~ CraftUse
defaultBulletWeapon :: Item
defaultBulletWeapon =
@@ -61,5 +61,5 @@ defaultWeapon =
]
defaultConsumable :: Item
defaultConsumable = defaultHeldItem & itUse .~ ConsumeUse CDoNothing 1
defaultConsumable = defaultHeldItem & itUse .~ ConsumeUse CDoNothing
src/Dodge/FloorItem.hs
+2 -1
View File
@@ -29,7 +29,8 @@ copyItemToFloorID pos it w =
flid = IM.newKey $ _floorItems (_lWorld (_cWorld w))
theflit =
FlIt
{ _flIt = it & itUse . useAmount %~ const 1
-- { _flIt = it & itUse . useAmount %~ const 1
{ _flIt = it
, _flItPos = p'
, _flItRot = rot
, _flItID = flid
src/Dodge/Inventory.hs
+66 -8
View File
@@ -42,13 +42,7 @@ rmInvItem ::
Int ->
World ->
World
rmInvItem cid invid w = case w ^? getcid . crInv . ix invid . itUse . useAmount of
Just x
| x > 1 ->
w & pointcid . crInv . ix invid . itUse . useAmount -~ 1
& worldEventFlags . at InventoryChange ?~ ()
_ ->
w
rmInvItem cid invid w = w
-- & pointcid %~ crCancelReloading
& doanyitemeffect
& dounequipfunction --the ordering of these is
@@ -67,7 +61,6 @@ rmInvItem cid invid w = case w ^? getcid . crInv . ix invid . itUse . useAmount
& updateselection
& worldEventFlags . at InventoryChange ?~ ()
where
getcid = cWorld . lWorld . creatures . ix cid
pointcid = cWorld . lWorld . creatures . ix cid
updateselection
@@ -99,6 +92,71 @@ rmInvItem cid invid w = case w ^? getcid . crInv . ix invid . itUse . useAmount
| x > invid || Just x == maxk = max 0 $ x - 1
| otherwise = x
---- | after this the item at the inventory position will no longer exist
--rmInvItem ::
-- -- | Creature id
-- Int ->
-- -- | Inventory position
-- Int ->
-- World ->
-- World
--rmInvItem cid invid w = case w ^? getcid . crInv . ix invid . itUse . useAmount of
-- Just x
-- | x > 1 ->
-- w & pointcid . crInv . ix invid . itUse . useAmount -~ 1
-- & worldEventFlags . at InventoryChange ?~ ()
-- _ ->
-- w
---- & pointcid %~ crCancelReloading
-- & doanyitemeffect
-- & dounequipfunction --the ordering of these is
-- & pointcid . crInv %~ f -- important
--
-- & removeAnySlotEquipment
-- & pointcid . crEquipment . each %~ g
-- & pointcid . crInvEquipped %~ IM.delete invid
-- & pointcid . crInvEquipped %~ IM.mapKeys g
--
-- & removeanyactivation
-- & pointcid . crHotkeys . each %~ g
-- & pointcid . crInvHotkeys %~ IM.delete invid
-- & pointcid . crInvHotkeys %~ IM.mapKeys g
--
-- & updateselection
-- & worldEventFlags . at InventoryChange ?~ ()
-- where
-- getcid = cWorld . lWorld . creatures . ix cid
-- pointcid = cWorld . lWorld . creatures . ix cid
--
-- updateselection
-- | cid == 0 && cr ^? crManipulation . manObject . inInventory . ispItem == Just invid =
-- scrollAugInvSel (-1) . scrollAugInvSel 1 . updateInventorySectionItems
-- | otherwise =
-- pointcid . crManipulation . manObject . inInventory . ispItem %~ g
--
-- cr = w ^?! cWorld . lWorld . creatures . ix cid
-- itm = _crInv cr IM.! invid
-- dounequipfunction = fromMaybe id $ do
-- rmf <- itm ^? itUse . equipEffect . eeOnRemove
-- return $ useE rmf itm cr
-- doanyitemeffect = fromMaybe id $ do
-- rmf <- itm ^? itEffect . ieOnDrop
-- return $ doInvEffect rmf itm cr
-- removeAnySlotEquipment = fromMaybe id $ do
-- epos <- w ^? cWorld . lWorld . creatures . ix cid . crInvEquipped . ix invid
-- return $ pointcid . crEquipment . at epos .~ Nothing
-- removeanyactivation = fromMaybe id $ do
-- epos <- w ^? cWorld . lWorld . creatures . ix cid . crInvHotkeys . ix invid
-- return $ pointcid . crHotkeys . at epos .~ Nothing
-- maxk = fmap fst $ IM.lookupMax $ cr ^. crInv
-- f inv =
-- let (xs, ys) = IM.split invid inv
-- in xs `IM.union` IM.mapKeysMonotonic (subtract 1) ys
-- -- the following might not work if a non-player creature drops their last item
-- g x
-- | x > invid || Just x == maxk = max 0 $ x - 1
-- | otherwise = x
rmSelectedInvItem :: Int -> World -> World
rmSelectedInvItem cid w = case w ^? cWorld . lWorld . creatures . ix cid . crManipulation . manObject . inInventory . ispItem of
Just i -> rmInvItem cid i w
src/Dodge/Inventory/Add.hs
+2 -1
View File
@@ -21,7 +21,8 @@ putItemInInvID cid flid w = fromMaybe (Nothing, w) $ do
return (Just i, w')
putItemInInvSlot :: Int -> Item -> IM.IntMap Item -> IM.IntMap Item
putItemInInvSlot = IM.insertWith (const $ itUse . useAmount +~ 1)
putItemInInvSlot = IM.insert
--putItemInInvSlot = IM.insertWith (const $ itUse . useAmount +~ 1)
-- | Pick up a specific item.
tryPutItemInInv :: Int -> FloorItem -> World -> Maybe (Int, World)
src/Dodge/Inventory/CheckSlots.hs
+7 -6
View File
@@ -25,12 +25,13 @@ checkInvSlotsYou it w
-- Assumes that the item is singular.
-- Do not want to stack floor items for now
findItemSlot :: Item -> IM.IntMap Item -> Int
findItemSlot it inv = case it ^? itUse . useAmount of
Just _ ->
fromMaybe newslot $ IM.findIndex (\it' -> _itType it == _itType it') inv
_ -> newslot
where
newslot = maybe 0 ((+ 1) . fst) $ IM.lookupMax inv
findItemSlot it inv = maybe 0 ((+ 1) . fst) $ IM.lookupMax inv
--findItemSlot it inv = case it ^? itUse . useAmount of
-- Just _ ->
-- fromMaybe newslot $ IM.findIndex (\it' -> _itType it == _itType it') inv
-- _ -> newslot
-- where
-- newslot = maybe 0 ((+ 1) . fst) $ IM.lookupMax inv
crNumFreeSlots :: Creature -> Int
crNumFreeSlots cr = _crInvCapacity cr - invSize (_crInv cr)
src/Dodge/Item/Amount.hs
+1 -1
View File
@@ -5,4 +5,4 @@ import Data.Maybe
import Dodge.Data.Item
itStackAmount :: Item -> ItAmount
itStackAmount it = fromMaybe 1 $ it ^? itUse . useAmount
itStackAmount it = 1 -- fromMaybe 1 $ it ^? itUse . useAmount
src/Dodge/Item/Craftable.hs
+4 -4
View File
@@ -4,16 +4,16 @@ import Dodge.Default.Item
import Control.Lens
import Dodge.Data.Item
makeTypeCraftNum :: Int -> CraftType -> Item
makeTypeCraftNum i ct =
makeTypeCraftNum :: Int -> CraftType -> [Item]
makeTypeCraftNum i ct = replicate i $
defaultCraftItem
& itInvSize .~ 0.5
& itCurseStatus .~ Uncursed
& itUse . useAmount .~ fromIntegral i
-- & itUse . useAmount .~ fromIntegral i
& itType . iyBase .~ CRAFT ct
makeTypeCraft :: CraftType -> Item
makeTypeCraft = makeTypeCraftNum 1
makeTypeCraft = head . makeTypeCraftNum 1
energyBallCraft :: EnergyBallType -> Item
energyBallCraft ebt = makeTypeCraft (ENERGYBALLCRAFT ebt) & itInvSize .~ 1
src/Dodge/Item/Display.hs
+4 -2
View File
@@ -121,8 +121,10 @@ itemNumberDisplay cr itm = case iu of
HeldUse{} -> []
LeftUse{} -> [showAutoRechargeProgress (_leftConsumption iu)]
EquipUse{} -> showEquipmentNumber cr itm
CraftUse x -> [show $ x ^. getItAmount]
ConsumeUse {_useAmount = x} -> [show $ x ^. getItAmount]
--CraftUse x -> [show $ x ^. getItAmount]
CraftUse -> []
--ConsumeUse {_useAmount = x} -> [show $ x ^. getItAmount]
ConsumeUse {} -> []
AttachUse {} -> [] --[showReloadProgress cr itm]
AmmoMagUse {} -> [showLoadedAmount itm]
-- this could be cleaner here...
src/Dodge/Item/SlotsTaken.hs
+6 -3
View File
@@ -7,6 +7,9 @@ import Dodge.Data.Item
import Dodge.Module
itSlotsTaken :: Item -> Int
itSlotsTaken it = case it ^? itUse . useAmount of
Nothing -> moduleSizes it + ceiling (_itInvSize it)
Just i -> moduleSizes it + ceiling (_itInvSize it * fromIntegral i)
itSlotsTaken it = moduleSizes it + ceiling (_itInvSize it)
--itSlotsTaken :: Item -> Int
--itSlotsTaken it = case it ^? itUse . useAmount of
-- Nothing -> moduleSizes it + ceiling (_itInvSize it)
-- Just i -> moduleSizes it + ceiling (_itInvSize it * fromIntegral i)
src/Dodge/Render/HUD.hs
+13 -13
View File
@@ -236,19 +236,19 @@ displayTerminal tid cfig w = fromMaybe mempty $ do
combineCounts :: Configuration -> World -> [Int] -> Picture
combineCounts cfig w = foldMap f . group
where
f (i : is) = fromMaybe mempty $ do
_ <- yourInv w ^? ix i . itUse . useAmount
sss <- w ^? hud . hudElement . diSections
--p <- selNumTextEndPos cfig (invDisplayParams w) sss 0 i
col <- selSecSelCol 0 i sss
yint <- selSecYint 0 i sss
--return $ color col $ uncurryV translate p . scale 0.1 0.1 . text $ ('-' : show (length is + 1))
return
. translateScreenPos cfig (invDisplayParams w ^. ldpPos)
. color col
. drawListElement 0 1 15 yint
. text
$ ('-' : show (length is + 1))
-- f (i : is) = fromMaybe mempty $ do
-- _ <- yourInv w ^? ix i . itUse . useAmount
-- sss <- w ^? hud . hudElement . diSections
-- --p <- selNumTextEndPos cfig (invDisplayParams w) sss 0 i
-- col <- selSecSelCol 0 i sss
-- yint <- selSecYint 0 i sss
-- --return $ color col $ uncurryV translate p . scale 0.1 0.1 . text $ ('-' : show (length is + 1))
-- return
-- . translateScreenPos cfig (invDisplayParams w ^. ldpPos)
-- . color col
-- . drawListElement 0 1 15 yint
-- . text
-- $ ('-' : show (length is + 1))
f _ = mempty
lnkMidPosInvSelsCol :: Configuration -> World -> Int -> Color -> [Int] -> Picture