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

Allow for stacking of items and combining sensibly

Browse Source
This commit is contained in:
justin
2021-12-03 17:18:06 +00:00
parent b2a9192fe4
commit b41e3e3637
24 changed files with 166 additions and 159 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Combine.hs
+44 -7
View File
@@ -15,32 +15,66 @@ import qualified Data.Map.Strict as M
import Data.Maybe
itemCombinations :: [ (M.Map CombineType Int, Item) ]
itemCombinations = map (first toMultiset)
[ p [PIPE,HARDWARE] bangStick
itemCombinations = map (first toMultiset) $
[ p [PIPE,HARDWARE] (bangStick 1)
, p [LONGPIPE,HARDWARE] bangCane
, p [VERYLONGPIPE,HARDWARE] bangRod
, p [PIPE,PIPE] $ makeTypeCraft LONGPIPE
, p [LONGPIPE,PIPE] $ makeTypeCraft VERYLONGPIPE
]
] ++
map (\i -> ([PIPE,BANGSTICK i],bangStick (i+1))) [1..8]
where
p = (,)
combinations :: [(M.Map CombineType Int, CombineType)]
combinations = map (second _itCombineType) itemCombinations
combineToItem :: M.Map CombineType Int -> Maybe Item
combineToItem m = lookup m itemCombinations
combineItemList :: IM.IntMap CombineType -> [([Int],Item)]
combineItemList m = mapMaybe (pushoutmaybe . second (combineToItem . toMultiset) . unzip)
combineItemList :: IM.IntMap Item -> [([Int],Item)]
combineItemList m = mapMaybe (pushoutmaybe . second combineToItem)
. concatMap itemsMultisets
. powlistN 4
$ IM.toList m
where
pushoutmaybe (_,Nothing) = Nothing
pushoutmaybe (x,Just y) = Just (x,y)
--combineItemList :: IM.IntMap CombineType -> [([Int],Item)]
--combineItemList m = mapMaybe (pushoutmaybe . second (combineToItem . toMultiset) . unzip)
-- . powlistN 4
-- $ IM.toList m
-- where
-- pushoutmaybe (_,Nothing) = Nothing
-- pushoutmaybe (x,Just y) = Just (x,y)
-- multiple multisets produced by a single item stack are combined using the list monad
itemsMultisets :: [(Int,Item)] -> [([Int],M.Map CombineType Int)]
itemsMultisets = map mconcat . mapM itemMultisets
-- individual items can produce multiple multisets if they are a stack of more
-- than one item
itemMultisets :: (Int,Item) -> [([Int],M.Map CombineType Int)]
itemMultisets (i,it) = case it ^? itConsumption . itAmount' of
Nothing -> [ ([i], M.singleton thetype 1 ) ]
Just n -> map (\k -> (replicate k i, M.singleton thetype k)) [1..n]
where
thetype = _itCombineType it
itemTypeAmounts :: Item -> [[CombineType]]
itemTypeAmounts it = case it ^? itConsumption . itAmount' of
Nothing -> [[thetype]]
Just i -> map (flip replicate thetype) [1 .. i]
where
thetype = _itCombineType it
combineItemListYou :: World -> [([Int],Item)]
combineItemListYou = combineItemList . fmap _itCombineType . yourInv
combineItemListYou = combineItemList . yourInv
combineListYou :: World -> [([Int],CombineType)]
combineListYou = combineList . fmap _itCombineType . yourInv
combineListYou = fmap (second _itCombineType) . combineItemListYou
toggleCombineInv :: World -> World
toggleCombineInv w = case _inventoryMode w of
@@ -51,3 +85,6 @@ enterCombineInv :: World -> World
enterCombineInv w = w & inventoryMode .~ CombineInventory mi
where
mi = const 0 <$> listToMaybe (combineListYou w)
combine :: M.Map CombineType Int -> Maybe CombineType
combine m = lookup m combinations
src/Dodge/Combine/Combinations.hs
-45
View File
@@ -1,45 +0,0 @@
{-# LANGUAGE TupleSections #-}
module Dodge.Combine.Combinations
where
--import Dodge.Data
import Dodge.Combine.Data
import Data.Bifunctor
import qualified Data.IntMap.Strict as IM
--import qualified Data.IntSet as IS
import qualified Data.Map.Strict as M
import Control.Monad
import Data.Maybe
combineList :: IM.IntMap CombineType -> [([Int],CombineType)]
combineList m = mapMaybe (pushoutmaybe . second (combine . toMultiset) . unzip)
. powlistN 4
$ IM.toList m
where
pushoutmaybe (_,Nothing) = Nothing
pushoutmaybe (x,Just y) = Just (x,y)
powlistN :: Int -> [a] ->[[a]]
powlistN _ [] = [[]]
powlistN n (x:xs)
| n <=0 = [[]]
| otherwise = ((x:) <$> powlistN (n-1) xs) ++ powlistN n xs
-- expo
powlist :: [a] -> [[a]]
powlist = filterM (const [True,False])
combine :: M.Map CombineType Int -> Maybe CombineType
combine m = lookup m combinations
toMultiset :: Ord a => [a] -> M.Map a Int
toMultiset = foldr (uncurry $ M.insertWith (+)) M.empty . map (,1)
combinations :: [(M.Map CombineType Int, CombineType)]
combinations = map (first toMultiset)
[ ( [ PIPE, HARDWARE ] , BANGSTICK )
, ( [ LONGPIPE, HARDWARE ] , BANGCANE )
, ( [ VERYLONGPIPE, HARDWARE ] , BANGROD )
, ( [ PIPE, PIPE ] , LONGPIPE )
, ( [ LONGPIPE, PIPE ] , VERYLONGPIPE )
]
src/Dodge/Combine/Data.hs
+1 -1
View File
@@ -5,7 +5,7 @@ module Dodge.Combine.Data
data CombineType
= NOTDEFINED
-- Weapons
| BANGSTICK
| BANGSTICK Int
| BANGCANE
| BANGROD
| PISTOL
src/Dodge/Creature.hs
+5
View File
@@ -169,6 +169,11 @@ startInvList =
]
startInventory :: IM.IntMap Item
startInventory = IM.fromList $ zip [0..] startInvList
testInventory :: IM.IntMap Item
testInventory = IM.fromList $ zip [0..]
[ makeTypeCraftNum 9 PIPE
, makeTypeCraft HARDWARE
]
stackedInventory :: IM.IntMap Item
stackedInventory = IM.fromList $ zip [0..]
[spreadGun
src/Dodge/Creature/Action.hs
+3 -13
View File
@@ -17,6 +17,7 @@ module Dodge.Creature.Action
, pickUpItemID
)
where
import Dodge.Inventory.Add
import Dodge.Path
import Dodge.Default
import Dodge.WallCreatureCollisions
@@ -252,16 +253,5 @@ pickUpItemID cid flid w = pickUpItem cid (_floorItems w IM.! flid) w
{- | Pick up a specific item. -}
pickUpItem :: Int -> FloorItem -> World -> World
pickUpItem cid flit w = case maybeInvSlot of
Nothing -> w
Just i -> w
& soundStart (CrSound cid) (_flItPos flit) pickUpS Nothing
& updateItLocation i
& floorItems %~ IM.delete (_flItID flit)
& creatures . ix cid . crInv %~ IM.insertWith (const $ itAmount +~ 1) i it
where
it = _flIt flit
maybeInvSlot = checkInvSlotsYou it w
updateItLocation invid w' = case _itID it of
Nothing -> w'
Just j -> w' & itemPositions . ix j .~ InInv 0 invid
pickUpItem cid flit w = maybe w (soundStart (CrSound cid) (_flItPos flit) pickUpS Nothing)
$ tryPutItemInInv cid flit w
src/Dodge/Data.hs
+5 -6
View File
@@ -327,8 +327,7 @@ data ItemConsumption
, _wpCharge :: Int
}
| ItemItselfConsumable
{ _itMaxStack' :: Int
, _itAmount' :: Int
{ _itAmount' :: Int
}
| NoConsumption
data Item
@@ -343,7 +342,7 @@ data Item
, _itAttachment :: ItAttachment
, _itID :: Maybe Int
, _itEffect :: ItEffect
, _itInvSize :: Int
, _itInvSize :: Float
, _itInvDisplay :: Item -> [String]
, _itInvColor :: Color
, _itTargeting :: Maybe (World -> Maybe Point2, Int -> Item -> Creature -> World -> Picture)
@@ -391,7 +390,7 @@ data Item
, _itID :: Maybe Int
, _itCombineType :: CombineType
, _itZoom :: ItZoom
, _itInvSize :: Int
, _itInvSize :: Float
, _itInvDisplay :: Item -> [String]
, _itInvColor :: Color
, _itCurseStatus :: CurseStatus
@@ -400,7 +399,7 @@ data Item
| Throwable
{ _itName :: String
, _itMaxStack :: Int
, _itAmount :: Int
-- , _itAmount :: Int
, _itFloorPict :: Item -> SPic
, _twMaxRange :: Float
, _twAccuracy :: Float
@@ -411,7 +410,7 @@ data Item
, _itID :: Maybe Int
, _itAttachment :: ItAttachment
, _itCombineType :: CombineType
, _itInvSize :: Int
, _itInvSize :: Float
, _itInvDisplay :: Item -> [String]
, _itInvColor :: Color
, _itEffect :: ItEffect
src/Dodge/Debug/Terminal.hs
+2
View File
@@ -10,6 +10,8 @@ applyTerminalString "NOCLIP" w = w & config . debug_noclip %~ not
applyTerminalString "LOADME" w = w & uvWorld . creatures . ix 0 . crInv .~ stackedInventory
& uvWorld . creatures . ix 0 . crInvCapacity .~ 50
applyTerminalString "LM" w = applyTerminalString "LOADME" w
applyTerminalString "LT" w = w & uvWorld . creatures . ix 0 . crInv .~ testInventory
& uvWorld . creatures . ix 0 . crInvCapacity .~ 50
applyTerminalString _ w = w
loadme :: a
src/Dodge/Default.hs
+1 -1
View File
@@ -154,7 +154,7 @@ defaultConsumable = Item
, _itInvSize = 1
, _itCurseStatus = Uncursed
, _itName = "genericConsumable"
, _itConsumption = ItemItselfConsumable {_itMaxStack' = 9, _itAmount' = 1}
, _itConsumption = ItemItselfConsumable {_itAmount' = 1}
, _itFloorPict = \_ -> noShape $ onLayer FlItLayer $ color blue $ circleSolid 3
, _itEquipPict = \_ _ -> mempty
, _itID = Nothing
src/Dodge/Default/Weapon.hs
+3 -3
View File
@@ -17,7 +17,7 @@ defaultAmmo :: ItemConsumption
defaultAmmo = LoadableAmmo
{ _aoType = GenericAmmo
, _ammoMax = 15
, _ammoLoaded = 15
, _ammoLoaded = 0
, _reloadTime = 40
, _reloadState = Nothing'
, _reloadType = ActiveClear
@@ -99,7 +99,7 @@ defaultGun = Item
, _itAttachment = NoItAttachment
, _itID = Nothing
, _itEffect = NoItEffect
, _itInvDisplay = basicWeaponDisplay
, _itInvDisplay = basicItemDisplay
, _itInvColor = white
, _itInvSize = 1
, _itTargeting = Nothing
@@ -125,7 +125,7 @@ defaultCraftable = Item
, _itAttachment = NoItAttachment
, _itID = Nothing
, _itEffect = NoItEffect
, _itInvDisplay = \it -> take (_itInvSize it) (_itName it : repeat "*")
, _itInvDisplay = basicItemDisplay
, _itInvColor = green
, _itInvSize = 1
, _itTargeting = Nothing
src/Dodge/Event.hs
+1 -1
View File
@@ -22,7 +22,7 @@ import Dodge.PreloadData
--import Dodge.Creature.Action
import Dodge.SoundLogic
import Dodge.Inventory
import Dodge.Inventory.PickUp
import Dodge.Inventory.Add
--import Geometry
--import Preload.Update
import qualified IntMapHelp as IM
src/Dodge/FloorItem.hs
+1 -1
View File
@@ -28,7 +28,7 @@ copyItemToFloorID pos it w = (,) flid $ w'
_ -> id
flid = IM.newKey $ _floorItems w
theflit = FlIt
{_flIt = it
{_flIt = it & itConsumption . itAmount' %~ const 1
,_flItPos = p'
,_flItRot = rot
,_flItID = flid
src/Dodge/Inventory.hs
+6 -5
View File
@@ -20,6 +20,7 @@ module Dodge.Inventory
import Dodge.Data
import Dodge.Inventory.CloseObject
import Dodge.Inventory.CheckSlots
import Dodge.Inventory.ItemSpace
import Dodge.Base
import Dodge.Base.Collide
import Geometry
@@ -38,8 +39,8 @@ import Control.Lens
rmInvItem :: Int -- ^ Creature id
-> Int -- ^ Inventory position
-> World -> World
rmInvItem cid invid w = case w ^? creatures . ix cid . crInv . ix invid . itAmount of
Just x | x > 1 -> w & creatures . ix cid . crInv . ix invid . itAmount %~ subtract 1
rmInvItem cid invid w = case w ^? creatures . ix cid . crInv . ix invid . itConsumption . itAmount' of
Just x | x > 1 -> w & creatures . ix cid . crInv . ix invid . itConsumption . itAmount' %~ subtract 1
_ -> w & creatures . ix cid . crInv %~ f
& creatures . ix cid . crInvSel %~ g
& creatures . ix cid . crLeftInvSel . _Just %~ g
@@ -54,7 +55,7 @@ rmSelectedInvItem :: Int -> World -> World
rmSelectedInvItem cid w = rmInvItem cid (_crInvSel (_creatures w IM.! cid)) w
augmentedInvSizes :: World -> IM.IntMap Int
augmentedInvSizes = bimapAugmentInv _itInvSize closeObjectSize
augmentedInvSizes = bimapAugmentInv itSlotsTaken closeObjectSize
bimapAugmentInv :: (Item -> a) -> (Either FloorItem Button -> a) -> World -> IM.IntMap a
bimapAugmentInv f g w = IM.union
@@ -66,7 +67,7 @@ invSelSize i w = fromMaybe 1 $ augmentedInvSizes w IM.!? i
closeObjectSize :: Either FloorItem Button -> Int
closeObjectSize e = case e of
Left flit -> _itInvSize $ _flIt flit
Left flit -> itSlotsTaken $ _flIt flit
Right _ -> 1
@@ -150,7 +151,7 @@ bestCloseObjectIndex :: World -> Maybe Int
bestCloseObjectIndex w = findIndex f $ _closeObjects w
where
f (Right _) = True
f (Left flit) = _itInvSize (_flIt flit) <= _crInvCapacity ycr - crInvSize ycr
f (Left flit) = itSlotsTaken (_flIt flit) <= _crInvCapacity ycr - crInvSize ycr
ycr = you w
selectedCloseObject :: World -> Maybe (Int,Either FloorItem Button)
src/Dodge/Inventory/CheckSlots.hs
+16 -4
View File
@@ -1,21 +1,33 @@
module Dodge.Inventory.CheckSlots where
import Dodge.Data
import Dodge.Base.You
import Dodge.Inventory.ItemSpace
import qualified IntMapHelp as IM
import Data.Maybe
--import Control.Lens
import qualified Data.IntMap.Strict as IM
-- | checks whether or not an item will fit in your inventory
-- if so return Just the next slot to be used
checkInvSlotsYou :: Item -> World -> Maybe Int
checkInvSlotsYou it w
| crNumFreeSlots ycr >= _itInvSize it
= Just $ maybe 0 ((+1) . fst) $ IM.lookupMax inv
| crNumFreeSlots ycr >= ceiling (_itInvSize it)
= Just $ findItemSlot it inv
| otherwise = Nothing
where
ycr = you w
inv = _crInv ycr
-- 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 _itConsumption it of
ItemItselfConsumable _
-> fromMaybe newslot $ IM.findIndex (\it' -> _itCombineType it == _itCombineType it') inv
_ -> newslot
where
newslot = maybe 0 ((+1) . fst) $ IM.lookupMax inv
crNumFreeSlots :: Creature -> Int
crNumFreeSlots cr = _crInvCapacity cr - invSize (_crInv cr)
@@ -23,4 +35,4 @@ crInvSize :: Creature -> Int
crInvSize = invSize . _crInv
invSize :: IM.IntMap Item -> Int
invSize = sum . fmap _itInvSize
invSize = sum . fmap itSlotsTaken
src/Dodge/Inventory/PickUp.hs
-25
View File
@@ -1,25 +0,0 @@
module Dodge.Inventory.PickUp where
import Dodge.Data
import Dodge.Inventory.CheckSlots
import Control.Lens
import qualified Data.IntMap.Strict as IM
putItemInInvID :: Int -> Int -> World -> World
putItemInInvID cid flid w = putItemInInv cid (_floorItems w IM.! flid) w
{- | Pick up a specific item. -}
putItemInInv :: Int -> FloorItem -> World -> World
putItemInInv cid flit w = case maybeInvSlot of
Nothing -> w
Just i -> w
& updateItLocation i
& floorItems %~ IM.delete (_flItID flit)
& creatures . ix cid . crInv %~ IM.insertWith (const $ itAmount +~ 1) i it
where
it = _flIt flit
maybeInvSlot = checkInvSlotsYou it w
updateItLocation invid w' = case _itID it of
Nothing -> w'
Just j -> w' & itemPositions . ix j .~ InInv 0 invid
src/Dodge/Item.hs
-2
View File
@@ -13,7 +13,6 @@ keyToken n = defaultEquipment
{ _itCombineType = NOTDEFINED
, _itName = "KEYTOKEN "++show n
, _itMaxStack = 5
, _itAmount = 1
, _itFloorPict = \_ -> (,) emptySH $ setDepth 0.5 keyPic
, _itEquipPict = \_ _ -> (,) emptySH $ setDepth 0 $ translate (-5) (-5) $ rotate (pi/2.5) keyPic
, _itEffect = NoItEffect
@@ -34,7 +33,6 @@ latchkey n = defaultEquipment
{ _itCombineType = NOTDEFINED
, _itName = "KEY "++show n
, _itMaxStack = 1
, _itAmount = 1
, _itFloorPict = \_ -> (,) emptySH $ setDepth 0.5 latchkeyPic
, _itEquipPict = \_ _ -> (,) emptySH $ setDepth 0 $ translate (-5) (-5) $ rotate (pi/2.5) latchkeyPic
, _itEffect = NoItEffect
src/Dodge/Item/Craftable.hs
+7 -4
View File
@@ -5,13 +5,16 @@ import Dodge.Default.Weapon
--import Picture
--import Geometry
makeTypeCraft :: CombineType -> Item
makeTypeCraft ct = defaultCraftable
{ _itInvSize = 1
makeTypeCraftNum :: Int -> CombineType -> Item
makeTypeCraftNum i ct = defaultCraftable
{ _itInvSize = 0.5
, _itCurseStatus = Uncursed
, _itName = show ct
, _itCombineType = ct
, _itConsumption = ItemItselfConsumable 3 3
, _itConsumption = ItemItselfConsumable i
}
makeTypeCraft :: CombineType -> Item
makeTypeCraft = makeTypeCraftNum 1
pipe :: Item
pipe = makeTypeCraft PIPE
src/Dodge/Item/Weapon/BulletGuns.hs
+18 -17
View File
@@ -72,7 +72,6 @@ autoGun = defaultAutoGun
, _itEquipPict = pictureWeaponOnAim
, _itAttachment = ItCharMode $ Seq.fromList "MS"
, _itScroll = scrollCharMode
, _itInvDisplay = basicWeaponDisplay
, _itParams = BulletShooter
{ _muzVel = 1
, _rifling = 0.9
@@ -90,15 +89,14 @@ autoGunPic it = noPic $
<> translateSHf 0 (-1) (rotateSHx (negate $ pi/4) . upperPrismPoly 2 $ rectNESW (negate $ 3 + 0.25 * x) 0 3 (-5))
where
x = fromIntegral $ _ammoLoaded $ _itConsumption it
bangStick :: Item
bangStick = defaultGun
{ _itName = "BANGSTICK"
, _itCombineType = BANGSTICK
bangStick :: Int -> Item
bangStick i = defaultGun
{ _itName = "BANGSTICK"++ show i
, _itCombineType = BANGSTICK i
, _itConsumption = defaultAmmo
{ _aoType = basicBullet
, _ammoMax = 1
, _ammoLoaded = 1
, _reloadTime = 20
, _ammoMax = i
, _reloadTime = 15
, _reloadType = ActivePartial 1
}
, _itUse = useAmmoParamsRate 8 upHammer
@@ -106,27 +104,31 @@ bangStick = defaultGun
, hammerCheckI
, useTimeCheck
, withSoundStart tap3S
, useAmmoAmount 1
, applyInaccuracy
, useAllAmmo
-- , applyInaccuracy
, withMuzFlareI
, spreadLoaded
, withRecoilI 25
]
, _itFloorPict = pistolPic
-- , _itZoom = defaultItZoom
, _itEquipPict = pictureWeaponAim pistolPic
, _itID = Nothing
, _itInvDisplay = basicWeaponDisplay
, _itInvColor = white
, _itTargeting = Nothing
, _itParams = BulletShooter
{ _muzVel = 0.8
, _rifling = 0.8
, _bore = 2
, _gunBarrels = SingleBarrel 0.05
, _gunBarrels = MultiBarrel
{_brlNum = i
,_brlSpread = SpreadBarrels 0.2
}
}
, _itTweaks = defaultBulletSelTweak
}
bangCane,bangRod :: Item
bangCane = bangStick
bangCane = defaultGun
{ _itParams = BulletShooter
{ _muzVel = 0.8
, _rifling = 0.9
@@ -175,7 +177,6 @@ pistol = defaultGun
-- , _itZoom = defaultItZoom
, _itEquipPict = pictureWeaponAim pistolPic
, _itID = Nothing
, _itInvDisplay = basicWeaponDisplay
, _itInvColor = white
, _itTargeting = Nothing
, _itParams = BulletShooter
@@ -224,7 +225,7 @@ hvAutoGun = defaultAutoGun
& useDelay .~ VariableRate {_rateMax = 25, _rateMaxMax = 24, _rateMinMax = 7, _rateTime = 0}
, _itFloorPict = hvAutoGunPic
, _itInvSize = 3
, _itInvDisplay = \it -> basicWeaponDisplay it ++
, _itInvDisplay = \it -> basicItemDisplay it ++
["* FRATE: *"
,"* " ++ fromMaybe " " (maybeRateStatus it) ++ " *"
]
@@ -339,7 +340,7 @@ miniGun = defaultAutoGun
, _itEquipPict = pictureWeaponAim miniGunPictItem
, _itTweaks = defaultBulletSelTweak
, _itInvSize = 4
, _itInvDisplay = \it -> basicWeaponDisplay it ++
, _itInvDisplay = \it -> basicItemDisplay it ++
["*" ++ replicate 8 ' ' ++ "*"
,"* " ++ fromMaybe " " (maybeWarmupStatus it) ++ " *"
,"*" ++ replicate 8 ' ' ++ "*" ]
@@ -446,7 +447,7 @@ multGun = defaultGun
, useAllAmmo
, withRecoilI 200
, withMuzFlareI
, duplicateEachLoadedBarrel
, duplicateLoadedBarrels
]
& useAim . aimSpeed .~ 0.4
& useAim . aimRange .~ 1
src/Dodge/Item/Weapon/Grenade.hs
+1 -3
View File
@@ -30,7 +30,6 @@ grenade = Throwable
, _itDimension = defaultItemDimension
, _itCurseStatus = Uncursed
, _itMaxStack = 8
, _itAmount = 1
, _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)]
, _twMaxRange = 150
, _twAccuracy = 30
@@ -43,7 +42,7 @@ grenade = Throwable
, _itID = Nothing
, _itAttachment = ItFuse fuseTime
, _itInvColor = white
, _itInvDisplay = basicWeaponDisplay
, _itInvDisplay = basicItemDisplay
, _itEffect = NoItEffect
, _itScroll = changeFuse
}
@@ -215,7 +214,6 @@ remoteBomb = defaultThrowable
{ _itName = "REMOTEBOMB"
, _itCombineType = REMOTEBOMB
, _itMaxStack = 1
, _itAmount = 1
, _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2
[(-3,-3),(-3,3),(3,3),(3,-3)]
, _twMaxRange = 150
src/Dodge/Item/Weapon/InventoryDisplay.hs
+7 -4
View File
@@ -2,19 +2,22 @@
Display of weapon strings in the inventory.
-}
module Dodge.Item.Weapon.InventoryDisplay
( basicWeaponDisplay
( basicItemDisplay
, maybeWarmupStatus
, maybeRateStatus
) where
import Dodge.Data
import Padding
import Dodge.Inventory.ItemSpace
import Data.Maybe
import Data.Sequence
import Control.Lens
{- | Displays the item name, ammo if loaded, and any selected '_itCharMode'. -}
basicWeaponDisplay :: Item -> [String]
basicWeaponDisplay it = [midPadL 10 ' ' thename (' ' : thenumber) ++ theparam]
basicItemDisplay :: Item -> [String]
basicItemDisplay it = Prelude.take (itSlotsTaken it) $
[midPadL 15 ' ' thename (' ' : thenumber) ++ theparam]
++ repeat "*"
where
thename = _itName it
thenumber = case it ^? itConsumption of
@@ -22,7 +25,7 @@ basicWeaponDisplay it = [midPadL 10 ' ' thename (' ' : thenumber) ++ theparam]
Nothing' -> show (_ammoLoaded am)
Just' x -> show x ++ "R" ++ show (_ammoLoaded am)
Just am@ChargeableAmmo{} -> show $ _wpCharge am
Just x@ItemItselfConsumable{} -> show $ _itMaxStack' x
Just x@ItemItselfConsumable{} -> "x" ++ show (_itAmount' x)
Just NoConsumption -> "NOCONSUMPTION"
Nothing -> ""
theparam = fromMaybe []
src/Dodge/Item/Weapon/Launcher.hs
+1 -1
View File
@@ -69,7 +69,7 @@ launcher = defaultGun
, _tweakParams = basicAmPjMoves
}
, _itInvSize = 3
, _itInvDisplay = \it -> basicWeaponDisplay it ++
, _itInvDisplay = \it -> basicItemDisplay it ++
["!" ++ replicate 8 ch ++ "!"
,"!" ++ replicate 8 ch ++ "!"]
}
src/Dodge/Item/Weapon/Radar.hs
-2
View File
@@ -62,7 +62,6 @@ autoSonar = defaultEquipment
{ _itCombineType = RADAR
, _itName = "AUTOSONAR"
, _itMaxStack = 1
, _itAmount = 1
, _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ color yellow $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)]
, _itEquipPict = \_ _ -> (,) emptySH blank
, _itEffect = autoSonarEffect
@@ -76,7 +75,6 @@ autoRadar = defaultEquipment
{ _itCombineType = RADAR
, _itName = "AUTORADAR"
, _itMaxStack = 1
, _itAmount = 1
, _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ color yellow $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)]
, _itEquipPict = \_ _ -> (,) emptySH blank
, _itEffect = autoRadarEffect
src/Dodge/Item/Weapon/TriggerType.hs
+31 -13
View File
@@ -26,8 +26,9 @@ module Dodge.Item.Weapon.TriggerType
, withSidePushI
, withWarmUp
, spreadNumI
, numBarrels
, duplicateEachLoadedBarrel
, spreadLoaded
-- , numBarrels
, duplicateLoadedBarrels
, randWalkAngle -- ^ should be made into a modifier, perhaps
, hammerCheckI
, hammerCheckL
@@ -387,6 +388,7 @@ torqueAfterI torque feff item cr w
(rot, g) = randomR (-torque,torque) $ _randGen w
rotateScope = creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
. itAttachment . scopePos %~ rotateV rot
spreadNumI :: ChainEffect
spreadNumI eff item cr w = foldr f w dirs
where
@@ -396,8 +398,24 @@ spreadNumI eff item cr w = foldr f w dirs
f dir = eff item (cr & crDir +~ dir)
spread = _spreadAngle . _brlSpread . _gunBarrels $ _itParams item
numBul = _brlNum . _gunBarrels $ _itParams item
duplicateEachLoadedBarrel :: ChainEffect
duplicateEachLoadedBarrel eff item cr w = foldr f w poss
spreadLoaded :: ChainEffect
spreadLoaded eff item cr w = foldr f w dirs
where
cd = 0.5 * spread * fromIntegral (numBulLoaded -1)
ds = (subtract cd . (spread *) . fromIntegral) <$> [0 .. numBulLoaded - 1]
-- dirs = ds
dirs = zipWith (+)
ds
(randomRs (-spread,spread) (_randGen w))
f dir = eff item (cr & crDir +~ dir)
spread = (_spreadAngle . _brlSpread . _gunBarrels $ _itParams item)
-- numBarrels = _brlNum . _gunBarrels $ _itParams item
-- spread = (_spreadAngle . _brlSpread . _gunBarrels $ _itParams item) * loadedSpreadParam
-- loadedSpreadParam = 0.5 * (fromIntegral (numBulLoaded - numBarrels) + 1)
numBulLoaded = _ammoLoaded $ _itConsumption item
duplicateLoadedBarrels :: ChainEffect
duplicateLoadedBarrels eff item cr w = foldr f w poss
where
cp :: Float
cp = -0.5 * (fromIntegral numBar - 1)
@@ -406,15 +424,15 @@ duplicateEachLoadedBarrel eff item cr w = foldr f w poss
f pos = eff item (cr & crPos %~ (+.+ pos))
numBar = _brlNum . _gunBarrels $ _itParams item
numBul = _ammoLoaded $ _itConsumption item
numBarrels :: ChainEffect
numBarrels eff item cr w = foldr f w poss
where
cp :: Float
cp = -0.5 * fromIntegral numBul
poss :: [V2 Float]
poss = map (rotateV (_crDir cr) . V2 0 . (*5) . (+ cp) . fromIntegral) [0 .. numBul - 1]
f pos = eff item (cr & crPos %~ (+.+ pos))
numBul = _brlNum . _gunBarrels $ _itParams item
--numBarrels :: ChainEffect
--numBarrels eff item cr w = foldr f w poss
-- where
-- cp :: Float
-- cp = -0.5 * fromIntegral numBul
-- poss :: [V2 Float]
-- poss = map (rotateV (_crDir cr) . V2 0 . (*5) . (+ cp) . fromIntegral) [0 .. numBul - 1]
-- f pos = eff item (cr & crPos %~ (+.+ pos))
-- numBul = _brlNum . _gunBarrels $ _itParams item
{- | Uses '_wpSpread' as a parameter for the current offset angle. -}
randWalkAngle
:: (Creature -> World -> World) -- ^ Underlying effect
src/Dodge/Render/HUD.hs
+2 -1
View File
@@ -9,6 +9,7 @@ import Dodge.Base
import Dodge.Base.Window
--import Dodge.Combine.Combinations
import Dodge.Inventory
import Dodge.Inventory.ItemSpace
import Dodge.Render.Connectors
import Dodge.Render.List
import Picture
@@ -170,7 +171,7 @@ closeObjectToTextPictures nfreeslots e = case e of
where
textindent = text . (" "++)
applycolor it
| nfreeslots >= _itInvSize it = color $ _itInvColor it
| nfreeslots >= itSlotsTaken it = color $ _itInvColor it
| otherwise = color invDimColor
drawLocations :: Configuration -> World -> Picture
src/IntMapHelp.hs
+11
View File
@@ -4,6 +4,7 @@ module IntMapHelp
, insertNewKey
, insertWithNewKeys
, swapKeys
, findIndex
)
where
--import Data.List hiding (foldr,insert)
@@ -23,3 +24,13 @@ insertWithNewKeys xs m = union m $ fromList $ zip [newKey m..] xs
{- | Swaps two keys. Unsafe: assumes both keys exist. -}
swapKeys :: Int -> Int -> IntMap a -> IntMap a
swapKeys i j m = insert i (m ! j) $ insert j (m ! i) m
-- ideally this should short circuit, I am not sure whether it does or not
-- though
findIndex :: (a -> Bool) -> IntMap a -> Maybe Int
findIndex t = foldrWithKey f Nothing
where
f _ _ (Just k) = Just k
f k x _
| t x = Just k
| otherwise = Nothing