Move item inv size and item dimensions from records to external function

This commit is contained in:
2024-11-26 23:36:08 +00:00
parent 9534698a24
commit b21513c4dd
22 changed files with 187 additions and 176 deletions
+2 -1
View File
@@ -3,6 +3,7 @@ module Dodge.Combine (
combineList,
) where
import Dodge.Item.InvSize
import Dodge.Item.Grammar
import Data.Bifunctor
import Data.Foldable
@@ -23,7 +24,7 @@ combineList = map f . combineItemListYouX
f (is, itm) =
SelectionItem
{ _siPictures = basicItemDisplay itm
, _siHeight = _itInvSize itm
, _siHeight = itInvHeight itm
, _siWidth = 15
, _siIsSelectable = True
, _siColor = itemInvColor . pciToCI $ basePCI itm
-2
View File
@@ -36,8 +36,6 @@ data Item = Item
, _itEffect :: ItEffect
, _itTargeting :: ItemTargeting
, _itAmmoSlots :: IM.IntMap AmmoType
, _itInvSize :: Int
, _itDimension :: ItemDimension
, _itParams :: ItemParams
}
-9
View File
@@ -14,13 +14,6 @@ import Dodge.Data.Item
import Dodge.Default.Item.Use
import Geometry.Data
defaultItemDimension :: ItemDimension
defaultItemDimension = ItemDimension
{ _dimRad = 2
, _dimCenter = 0
, _dimAttachPos = V3 10 (-5) 3
}
defaultHeldItem :: Item
defaultHeldItem = Item
{ _itType = HELD PISTOL
@@ -28,9 +21,7 @@ defaultHeldItem = Item
, _itID = 0 -- should this return an error ? const $ error "itID not correctly initialised" ?
, _itTargeting = NoItTargeting
, _itAmmoSlots = mempty
, _itInvSize = 1
, _itLocation = InVoid
, _itDimension = defaultItemDimension
, _itUse = defaultHeldUse
, _itParams = NoParams
}
+2 -1
View File
@@ -3,6 +3,7 @@ module Dodge.FloorItem (
copyItemToFloorID,
) where
import Dodge.Item.InvSize
import NewInt
import Control.Lens
import Data.Maybe
@@ -28,7 +29,7 @@ copyItemToFloorID pos it w =
-- & hud . hudElement . diSections . ix 3 . ssOffset .~ 0
-- ensures dropped item is at the top of the close item selection list
where
(p', w') = findWallFreeDropPoint (_dimRad $ _itDimension it) pos w
(p', w') = findWallFreeDropPoint (_dimRad $ itDim it) pos w
rot = fst . randomR (- pi, pi) $ _randGen w
flid = IM.newKey . _unNIntMap . _floorItems . _lWorld $ _cWorld w
theflit =
+3 -2
View File
@@ -4,6 +4,7 @@ module Dodge.Inventory.CheckSlots (
crInvSize,
) where
import Dodge.Item.InvSize
import Control.Lens
import Data.Monoid
import Dodge.Base.You
@@ -15,7 +16,7 @@ import qualified IntMapHelp as IM
-}
checkInvSlotsYou :: Item -> World -> Maybe Int
checkInvSlotsYou it w
| crNumFreeSlots ycr >= _itInvSize it =
| crNumFreeSlots ycr >= itInvHeight it =
Just . IM.newKey $ _crInv ycr
| otherwise = Nothing
where
@@ -28,5 +29,5 @@ crInvSize :: Creature -> Int
crInvSize = invSize . _crInv
invSize :: IM.IntMap Item -> Int
invSize = alaf Sum foldMap _itInvSize
invSize = alaf Sum foldMap itInvHeight
--invSize = sum . fmap _itInvSize
+2 -1
View File
@@ -6,6 +6,7 @@ module Dodge.Inventory.SelectionList (
closeButtonToSelectionItem,
) where
import Dodge.Item.InvSize
import Dodge.Data.ComposedItem
import Dodge.Data.SelectionList
import Dodge.Data.World
@@ -22,7 +23,7 @@ invSelectionItem :: Int -> Creature -> Int -> ComposedItem -> SelectionItem ()
invSelectionItem indent cr i ci =
SelectionItem
{ _siPictures = pics & ix 0 %~ (++ anyequippos ++ anyhotkey)
, _siHeight = _itInvSize $ _cItem ci
, _siHeight = itInvHeight $ _cItem ci
, _siWidth = 15
, _siIsSelectable = True
, _siColor = col
+4 -5
View File
@@ -7,7 +7,6 @@ import Dodge.Data.Item
makeTypeCraftNum :: Int -> CraftType -> [Item]
makeTypeCraftNum i ct = replicate i $
defaultCraftItem
& itInvSize .~ 1
& itType .~ CRAFT ct
makeTypeCraft :: CraftType -> Item
@@ -28,16 +27,16 @@ makeTypeCraft = head . makeTypeCraftNum 1
--bounceModule = bulletBodyCraft BounceBullet
teleportModule :: Item
teleportModule = makeTypeCraft TELEPORTMODULE & itInvSize .~ 1
teleportModule = makeTypeCraft TELEPORTMODULE
timeModule :: Item
timeModule = makeTypeCraft TIMEMODULE & itInvSize .~ 1
timeModule = makeTypeCraft TIMEMODULE
sizeModule :: Item
sizeModule = makeTypeCraft SIZEMODULE & itInvSize .~ 1
sizeModule = makeTypeCraft SIZEMODULE
gravityModule :: Item
gravityModule = makeTypeCraft GRAVITYMODULE & itInvSize .~ 1
gravityModule = makeTypeCraft GRAVITYMODULE
pipe :: Item
pipe = makeTypeCraft PIPE
+2 -1
View File
@@ -5,6 +5,7 @@ module Dodge.Item.Display (
basicItemDisplay,
) where
import Dodge.Item.InvSize
import Dodge.Data.ComposedItem
import ShortShow
import Data.Maybe
@@ -32,7 +33,7 @@ itemDisplayPad ls rs
basicItemDisplay :: Item -> [String]
basicItemDisplay itm =
Prelude.take (_itInvSize itm) $
Prelude.take (itInvHeight itm) $
itemBaseName itm :
--catMaybes [maybeWarmupStatus itm, maybeRateStatus itm]
catMaybes [maybeWarmupStatus itm]
-6
View File
@@ -22,8 +22,6 @@ teslaGun :: Item
teslaGun =
defaultHeldItem
& itUse . heldParams .~ BeamShooterParams (Just (elecCrackleS,2))
& itDimension . dimRad .~ 9
& itDimension . dimCenter .~ V3 4 0 0
& itParams .~ teslaParams
& itUse . heldDelay .~ NoDelay
& itUse . heldAim . aimWeight .~ 6
@@ -53,8 +51,6 @@ laser =
, _itTgID = Nothing
, _itTgActive = False
}
& itDimension . dimRad .~ 10
& itDimension . dimCenter .~ V3 15 0 0
& itUse . heldAim . aimWeight .~ 6
& itUse . heldAim . aimRange .~ 1
& itUse . heldAim . aimStance .~ TwoHandFlat
@@ -74,8 +70,6 @@ tractorGun =
, _itTgID = Nothing
, _itTgActive = False
}
& itDimension . dimRad .~ 10
& itDimension . dimCenter .~ V3 15 0 0
& itUse . heldAim . aimWeight .~ 6
& itUse . heldAim . aimRange .~ 1
& itUse . heldAim . aimStance .~ TwoHandUnder
-7
View File
@@ -22,8 +22,6 @@ defaultBangCane =
& itUse . heldParams . rifling .~ ConstFloat 0.9
& itUse . heldParams . recoil .~ 50
& itUse . heldParams . torqueAfter .~ 0.1
& itDimension . dimRad .~ 8
& itDimension . dimCenter .~ V3 5 0 0
& itUse . heldDelay . rateMax .~ 6
-- & itUse . heldMods .~ BangCaneMod
& itUse . heldAim . aimStance .~ OneHand
@@ -57,7 +55,6 @@ rifle =
& itUse . heldAim . aimRange .~ 1
& itUse . heldAim . aimZoom .~ defaultItZoom{_izFac = 1.5}
& itUse . heldAim . aimMuzzles . ix 0 . mzPos .~ V2 25 0
-- & itType . iyModules . at ModHeldAttach ?~ EMPTYMODULE
--repeater :: Item
--repeater =
@@ -97,8 +94,4 @@ miniGunX i =
& itUse . heldParams . sidePush .~ 10 * fromIntegral i
& itUse . heldParams . randomOffset .~ 10
& itUse . heldParams . rifling .~ UniRandFloat 0.8 0.9
& itInvSize .~ (i + 3) `div` 2
& itDimension . dimRad .~ 20
& itDimension . dimCenter .~ V3 5 0 0
& itDimension . dimAttachPos .~ V3 5 (-5) 0
& itType .~ HELD (MINIGUNX i)
-4
View File
@@ -11,11 +11,7 @@ import Linear
bangCone :: Item
bangCone =
defaultBulletWeapon
& itDimension . dimRad .~ 8
& itDimension . dimCenter .~ V3 5 0 0
& itUse . heldDelay . rateMax .~ 20
-- & itUse . heldMods .~ PistolMod
-- & itUse . heldAim . aimHandlePos .~ 5
& itUse . heldAim . aimMuzzles
.~ replicate 15 (Muzzle (V2 15 0) 0 0.5 0 DefaultFlareType MuzzleShootBullet)
& itUse . heldParams . muzVel .~ UniRandFloat 0.5 0.8
-3
View File
@@ -12,9 +12,6 @@ import Geometry.Data
launcher :: Item
launcher =
defaultHeldItem
& itInvSize .~ 3
& itDimension . dimRad .~ 9
& itDimension . dimCenter .~ V3 10 0 0
& itUse . heldDelay . rateMax .~ 20
& itUse . heldAim . aimWeight .~ 8
& itUse . heldAim . aimRange .~ 0.5
-2
View File
@@ -23,8 +23,6 @@ bangRod =
& itUse . heldParams . torqueAfter .~ 0.3
& itUse . heldParams . bulGunSound ?~ (bangEchoS,0)
& itUse . heldDelay . rateMax .~ 12
& itDimension . dimRad .~ 12
& itDimension . dimCenter .~ V3 5 0 0
& itType .~ HELD BANGROD
& itUse . heldAim . aimWeight .~ 8
& itUse . heldAim . aimRange .~ 1
-5
View File
@@ -73,12 +73,7 @@ flameThrower :: Item
flameThrower =
defaultHeldItem
& itParams .~ NoParams
& itDimension . dimRad .~ 7
& itDimension . dimCenter .~ V3 9 0 0
-- & itUse . heldUse .~ HeldOverNozzlesUseGasParams -- overNozzles useGasParams
& itUse . heldDelay .~ NoDelay
-- & itUse . heldMods .~ FlameThrowerMod
-- & itUse . heldMods .~ PistolMod
& itUse . heldAim . aimWeight .~ 5
& itUse . heldAim . aimZoom .~ defaultItZoom{_izMax = 5, _izMin = 1.5}
& itUse . heldAim . aimStance .~ TwoHandUnder
-5
View File
@@ -20,12 +20,7 @@ bangStick i =
& itUse . heldParams . recoil .~ 25
& itUse . heldParams . torqueAfter .~ 0.18 + 0.02 * fromIntegral i
& itType .~ HELD (BANGSTICK i)
& itInvSize .~ max 1 (i `div` 2)
& itDimension . dimRad .~ 5
& itDimension . dimCenter .~ V3 5 0 0
& itUse . heldDelay . rateMax .~ 8
-- & itUse . heldMods .~ BangStickMod
-- & itUse . heldMods .~ PistolMod
& itUse . heldAim . aimMuzzles
.~ [Muzzle (V2 10 0) a 0.01 0 DefaultFlareType MuzzleShootBullet | a <- spreadAroundCenter i baseStickSpread]
-1
View File
@@ -14,7 +14,6 @@ flatShield =
& itUse . heldAim . aimTurnSpeed .~ 0.5
& itUse . heldAim . aimStance .~ TwoHandFlat
-- & itUse . heldAim . aimHandlePos .~ 0
& itInvSize .~ 3
& itType .~ HELD FLATSHIELD
keyCard :: Int -> Item
+2 -1
View File
@@ -2,6 +2,7 @@ module Dodge.Item.Info
( itemInfo
) where
import Dodge.Item.InvSize
import Data.Char
--import qualified Data.Map.Strict as M
import Dodge.Data.Item
@@ -15,7 +16,7 @@ itemInfo itm =
++ itmSpaceInfo itm
itmSpaceInfo :: Item -> String
itmSpaceInfo itm = case _itInvSize itm of
itmSpaceInfo itm = case itInvHeight itm of
1 -> " It takes up one inventory slot. "
x -> " It takes up " ++ showInt x ++ " inventory slots. "
+53
View File
@@ -0,0 +1,53 @@
{-# LANGUAGE LambdaCase #-}
module Dodge.Item.InvSize (
itInvHeight,
itDim,
) where
import Control.Lens
import Dodge.Data.Item
import Linear.V3
itInvHeight :: Item -> Int
itInvHeight x = case x ^. itType of
HELD (MINIGUNX i) -> (i + 3) `div` 2
HELD LAUNCHER -> 3
HELD FLATSHIELD -> 3
HELD (BANGSTICK i) -> max 1 (i `div` 2)
_ -> 1
itDim :: Item -> ItemDimension
itDim x = case x ^. itType of
HELD TESLAGUN -> ItemDimension 9 (V3 4 0 0) (V3 10 (-5) 3)
HELD LASER -> did & dimRad .~ 10
& dimCenter .~ V3 15 0 0
HELD TRACTORGUN -> did & dimRad .~ 10
& dimCenter .~ V3 15 0 0
HELD FLAMETHROWER -> did & dimRad .~ 7
& dimCenter .~ V3 9 0 0
HELD y | hasCaneGunDim y -> did & dimRad .~ 8
& dimCenter .~ V3 5 0 0
HELD (MINIGUNX {}) -> did & dimRad .~ 20
& dimCenter .~ V3 5 0 0
& dimAttachPos .~ V3 5 (-5) 0
HELD LAUNCHER -> did & dimRad .~ 9
& dimCenter .~ V3 10 0 0
HELD BANGSTICK{} -> did
& dimRad .~ 5
& dimCenter .~ V3 5 0 0
HELD BANGROD -> did
& dimRad .~ 12
& dimCenter .~ V3 5 0 0
HELD BANGCONE -> did
& dimRad .~ 8
& dimCenter .~ V3 5 0 0
_ -> did
hasCaneGunDim :: HeldItemType -> Bool
hasCaneGunDim = \case
VOLLEYGUN {} -> True -- this shouldn't really be the case
RIFLE -> True
_ -> False
did :: ItemDimension
did = ItemDimension 2 0 (V3 10 (-5) 3)
+2 -1
View File
@@ -4,6 +4,7 @@ module Dodge.Render.HUD (
drawHUD,
) where
import Dodge.Item.InvSize
import Control.Applicative
import Control.Lens
import Control.Monad
@@ -215,7 +216,7 @@ closeObjectInfo n x = case x of
floorItemPickupInfo :: Int -> Item -> String
floorItemPickupInfo n itm
| n >= _itInvSize itm = ", but you have space to pick it up."
| n >= itInvHeight itm = ", but you have space to pick it up."
| otherwise = ", and you don't have space to pick it up."
-- note the use of ^?!
+1 -4
View File
@@ -67,8 +67,7 @@ makeSelectionListPictures = concatMap f
where
f si = map (color (_siColor si) . text) $ _siPictures si
-- note this does not take into account any selectionsection indent, nor the LDP
-- selection width
-- note this does not take into account any selectionsection indent
drawCursorAt ::
Maybe Int ->
[SelectionItem a] ->
@@ -125,13 +124,11 @@ selSecDrawCursorAt ldp curs sss (i, j) = fold $ do
(_siHeight si)
selSecDrawCursor ::
-- Int ->
ListDisplayParams ->
CursorDisplay ->
IM.IntMap (SelectionSection a) ->
Maybe (Int, Int) ->
Picture
--selSecDrawCursor xsize ldp curs = maybe mempty . selSecDrawCursorAt xsize ldp curs
selSecDrawCursor ldp curs = maybe mempty . selSecDrawCursorAt ldp curs
-- displays a cursor that should match up to list text pictures
+3 -2
View File
@@ -4,6 +4,7 @@ module Dodge.Update.Input.InGame (
updateMouseInGame,
) where
import Dodge.Item.InvSize
import Data.Monoid
import NewInt
import Control.Applicative
@@ -125,7 +126,7 @@ tryPickupSelected k mpos w = do
let nfreeslots = crNumFreeSlots cr
xs <- w ^? hud . hudElement . diSelection . _Just . _3
let itmstopickup = mapMaybe g $ IS.toList xs
let slotsneeded = alaf Sum foldMap (_itInvSize . _flIt) itmstopickup
let slotsneeded = alaf Sum foldMap (itInvHeight . _flIt) itmstopickup
guard $ nfreeslots >= slotsneeded
return $ case mpos of
Just (0,j) -> foldr (pickUpItemAt j 0) w itmstopickup
@@ -507,7 +508,7 @@ spaceAction w = case w ^. hud . hudElement of
DisplayCarte -> w & hud . carteCenter .~ theLoc
DisplayInventory{_subInventory = NoSubInventory{}} -> fromMaybe w $ do
cobj <- selCloseObj w
return $ case cobj of -- case Left <$> selectedCloseItem w of
return $ case cobj of
(Left flit) -> pickUpItem 0 flit w
& worldEventFlags . at InventoryChange ?~ ()
(Right but) -> doButtonEvent (_btEvent but) but w