Move UseCondition out of record

This commit is contained in:
2025-06-05 19:41:33 +01:00
parent 16f5c05f19
commit 816ab4222f
15 changed files with 325 additions and 382 deletions
-16
View File
@@ -1,16 +0,0 @@
module Dodge.Cuse where
import Dodge.Inventory
import Control.Lens
import Dodge.Data.World
import Data.Maybe
useC :: Cuse -> Item -> Creature -> World -> World
useC cu itm cr = fromMaybe id $ do
i <- itm ^? itLocation . ilInvID
return $ rmInvItem (_crID cr) i . useC' cu itm cr
useC' :: Cuse -> Item -> Creature -> World -> World
useC' cu = case cu of
CDoNothing -> const $ const id
CHeal x -> const $ \cr -> cWorld . lWorld . creatures . ix (_crID cr) . crHP +~ x
+1 -1
View File
@@ -40,7 +40,7 @@ data Consumables
data Item = Item
{ _itUse :: ItemUse
, _itUseCondition :: UseCondition
-- , _itUseCondition :: UseCondition
, _itConsumables :: Consumables
, _itType :: ItemType
, _itID :: NewInt ItmInt
-28
View File
@@ -1,28 +0,0 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.Item.HeldUse where
--import Dodge.Data.Item.Use.Consumption.Ammo
import Dodge.Data.Magnet
import Data.Aeson
import Data.Aeson.TH
import Control.Lens
data Cuse
= CDoNothing
| CHeal Int
deriving (Eq, Ord, Show, Read) --Generic, Flat)
data Euse
= EDoNothing
| EMagShield MagnetBuBu
| EWristShield
| EHeadLamp
deriving (Eq, Ord, Show, Read) --Generic, Flat)
makeLenses ''Euse
deriveJSON defaultOptions ''Cuse
deriveJSON defaultOptions ''Euse
+3 -66
View File
@@ -5,7 +5,6 @@
module Dodge.Data.Item.Use (
module Dodge.Data.Item.Use,
module Dodge.Data.Item.HeldUse,
module Dodge.Data.Item.Use.Consumption,
module Dodge.Data.Item.Targeting,
module Dodge.Data.GenFloat,
@@ -19,8 +18,6 @@ import Data.Aeson.TH
import qualified Data.Set as S
import Dodge.Data.GenFloat
import Dodge.Data.Item.BulletMod
--import Dodge.Data.Item.HeldDelay
import Dodge.Data.Item.HeldUse
import Dodge.Data.Item.Scope
import Dodge.Data.Item.Targeting
import Dodge.Data.Item.Use.Consumption
@@ -47,11 +44,6 @@ data UseFocus
| UseFromLocation
deriving (Eq, Show, Read)
data UseCondition
= UseableWhenAimed
| UseableAnytime
deriving (Eq, Show, Read)
data AttachParams
= APProjectiles {_apProjectiles :: [Int]}
| APInt {_apInt :: Int}
@@ -65,68 +57,13 @@ data AmmoParams
| NoAmmoParams
deriving (Eq, Show, Read) --Generic, Flat)
data FlareType
= NoFlare
| BasicFlare
| NoLightFlare
| MiniGunFlare
| HeavySmokeFlare
| LasGunFlare
| TeslaGunFlare
deriving (Eq, Ord, Show, Read) --Generic, Flat)
data MuzzleEffect
= MuzzleShootBullet
| MuzzleLaser
| MuzzleTesla
| MuzzleTractor
| MuzzleRLauncher
| MuzzleGLauncher
| MuzzleNozzle
{ _nzPressure :: GenFloat
, _nzMaxWalkAngle :: Float
, _nzWalkSpeed :: Float
}
| MuzzleShatter
| MuzzleDetector
| MuzzleBlink
| MuzzleUnsafeBlink
| MuzzleRewind
| MuzzleStopper
| MuzzleScroller
deriving (Eq, Ord, Show, Read) --Generic, Flat)
data AmmoPerShot
= UseExactly {_useExactly :: Int}
| UseUpTo {_useUpTo :: Int}
deriving (Eq, Ord, Show, Read) --Generic, Flat)
data Muzzle = Muzzle
{ _mzPos :: V2 Float
, _mzRot :: Float
, _mzInaccuracy :: Float
, _mzAmmoSlot :: Int
, _mzFlareType :: FlareType
, _mzEffect :: MuzzleEffect
, _mzAmmoPerShot :: AmmoPerShot
, _mzFrame :: Int
}
deriving (Eq, Ord, Show, Read) --Generic, Flat)
makeLenses ''ItemUse
makeLenses ''Muzzle
makeLenses ''AttachParams
makeLenses ''AmmoParams
makeLenses ''MuzzleEffect
makeLenses ''AmmoPerShot
makeLenses ''UseCondition
--makeLenses ''UseCondition
makeLenses ''UseFocus
deriveJSON defaultOptions ''UseFocus
deriveJSON defaultOptions ''UseCondition
deriveJSON defaultOptions ''MuzzleEffect
deriveJSON defaultOptions ''FlareType
--deriveJSON defaultOptions ''UseFocus
--deriveJSON defaultOptions ''UseCondition
deriveJSON defaultOptions ''AmmoParams
deriveJSON defaultOptions ''AmmoPerShot
deriveJSON defaultOptions ''Muzzle
deriveJSON defaultOptions ''AttachParams
deriveJSON defaultOptions ''ItemUse
+59
View File
@@ -0,0 +1,59 @@
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.Muzzle where
import Dodge.Data.GenFloat
import Linear
import Control.Lens
data Muzzle = Muzzle
{ _mzPos :: V2 Float
, _mzRot :: Float
, _mzInaccuracy :: Float
, _mzAmmoSlot :: Int
, _mzFlareType :: FlareType
, _mzEffect :: MuzzleEffect
, _mzAmmoPerShot :: AmmoPerShot
, _mzFrame :: Int
}
deriving (Eq, Ord, Show, Read) --Generic, Flat)
data FlareType
= NoFlare
| BasicFlare
| NoLightFlare
| MiniGunFlare
| HeavySmokeFlare
| LasGunFlare
| TeslaGunFlare
deriving (Eq, Ord, Show, Read) --Generic, Flat)
data MuzzleEffect
= MuzzleShootBullet
| MuzzleLaser
| MuzzleTesla
| MuzzleTractor
| MuzzleRLauncher
| MuzzleGLauncher
| MuzzleNozzle
{ _nzPressure :: GenFloat
, _nzMaxWalkAngle :: Float
, _nzWalkSpeed :: Float
}
| MuzzleShatter
| MuzzleDetector
| MuzzleBlink
| MuzzleUnsafeBlink
| MuzzleRewind
| MuzzleStopper
| MuzzleScroller
deriving (Eq, Ord, Show, Read) --Generic, Flat)
data AmmoPerShot
= UseExactly {_useExactly :: Int}
| UseUpTo {_useUpTo :: Int}
deriving (Eq, Ord, Show, Read) --Generic, Flat)
makeLenses ''Muzzle
makeLenses ''MuzzleEffect
makeLenses ''AmmoPerShot
+12
View File
@@ -0,0 +1,12 @@
{-# LANGUAGE StrictData #-}
module Dodge.Data.UseCondition
where
data UseCondition
= UseableWhenAimed
| UseableWhenHeld
| UseableAnytime
| NeverUsable
deriving (Eq, Show, Read)
+1 -3
View File
@@ -1,12 +1,10 @@
module Dodge.Default.Item (
defaultHeldItem,
defaultCraftItem,
module Dodge.Default.Item.Use,
) where
import Control.Lens
import Dodge.Data.Item
import Dodge.Default.Item.Use
defaultHeldItem :: Item
defaultHeldItem =
@@ -19,7 +17,7 @@ defaultHeldItem =
, _itLocation = InVoid
, _itUse = UseHeld
, _itParams = NoParams
, _itUseCondition = UseableWhenAimed
-- , _itUseCondition = UseableWhenAimed
, _itScroll = NoItemScroll
, _itTimeLastUsed = 0
}
-14
View File
@@ -1,14 +0,0 @@
module Dodge.Default.Item.Use (
module Dodge.Default.Item.Use,
) where
import Dodge.Data.Item.Use
defaultEquipUse :: ItemUse
defaultEquipUse = UseEquip
--defaultHeldUse :: ItemUse
--defaultHeldUse =
-- UseHeld
-- { _heldFrame = 0
-- }
+8 -14
View File
@@ -3,11 +3,11 @@ module Dodge.Equipment (
effectOnEquip,
) where
import Dodge.Data.Equipment.Misc
import Control.Lens
import Data.Maybe
import Dodge.Creature.HandPos
import Dodge.Creature.Test
import Dodge.Data.Equipment.Misc
import Dodge.Data.World
import Dodge.Item.Location
import Dodge.Wall.Delete
@@ -18,34 +18,29 @@ import qualified IntMapHelp as IM
effectOnRemove :: Item -> Creature -> World -> World
effectOnRemove itm = case itm ^. itType of
EQUIP WRISTARMOUR -> onRemoveWristShield' itm
EQUIP WRISTARMOUR -> onRemoveWristShield itm
_ -> \_ -> id
onRemoveWristShield' :: Item -> Creature -> World -> World
onRemoveWristShield' itm _ =
--(pointerToItem itm . itUse . uequipEffect . eeParams .~ NoEquipParams) . mremovewall
onRemoveWristShield :: Item -> Creature -> World -> World
onRemoveWristShield itm _ =
(pointerToItem itm . itParams .~ NoParams) . mremovewall
where
mremovewall = fromMaybe id $ do
--i <- itm ^? itUse . uequipEffect . eeParams . eparamID
i <- itm ^? itParams . itParamID
return $ deleteWallID i
effectOnEquip :: Item -> Creature -> World -> World
effectOnEquip itm = case itm ^. itType of
EQUIP WRISTARMOUR -> onEquipWristShield' itm
EQUIP WRISTARMOUR -> onEquipWristShield itm
_ -> \_ -> id
onEquipWristShield' :: Item -> Creature -> World -> World
onEquipWristShield' itm cr w =
onEquipWristShield :: Item -> Creature -> World -> World
onEquipWristShield itm cr w =
w
-- & pointerToItem itm . itUse . uequipEffect . eeParams .~ EquipID i
& pointerToItem itm . itParams .~ ItemParamID{_itParamID = i}
& cWorld . lWorld . walls . at i ?~ forceField{_wlID = i}
& setWristShieldPos
( itm
-- & itUse . uequipEffect . eeParams .~ EquipID i
& itParams .~ ItemParamID{_itParamID = i}
( itm & itParams .~ ItemParamID{_itParamID = i}
)
cr
where
@@ -54,7 +49,6 @@ onEquipWristShield' itm cr w =
setWristShieldPos :: Item -> Creature -> World -> World
setWristShieldPos itm cr w = w & moveWallIDUnsafe i wlline
where
--i = _eparamID $ _eeParams $ _uequipEffect $ _itUse itm
i = _itParamID $ _itParams itm
wlline = (f (V3 (-10) 7 0), f (V3 10 7 0))
invid = _ilInvID (_itLocation itm)
+1
View File
@@ -10,6 +10,7 @@ module Dodge.HeldUse (
heldEffectMuzzles,
) where
import Dodge.Data.Muzzle
import Dodge.Data.UseDelay
import Dodge.Item.UseDelay
import Dodge.Base
+4 -2
View File
@@ -7,6 +7,8 @@ module Dodge.Item.Grammar (
allInvLocs,
) where
import Dodge.ItemUseCondition
import Dodge.Data.UseCondition
import Dodge.Item.MagAmmoType
import Dodge.Data.AmmoType
import Dodge.Item.AmmoSlots
@@ -150,8 +152,8 @@ itemToFunction itm = case itm ^. itType of
ITEMSCAN -> ToggleSF
INTROSCAN {} -> IntroScanSF
HELD LASER -> WeaponTargetingSF
HELD{} -> case itm ^? itUseCondition of
Just UseableWhenAimed -> HeldPlatformSF
HELD{} -> case itUseCondition itm of
UseableWhenAimed -> HeldPlatformSF
--Just MustBeHeld -> UnloadedWeaponSF
_ -> GadgetPlatformSF
_
+3 -20
View File
@@ -33,30 +33,13 @@ torch =
-- | Sends out pulses that display walls.
detector :: Detector -> Item
detector dt =
defaultHeldItem
& itUseCondition .~ UseableAnytime
-- & itUse . heldDelay . rateMax .~ 20
-- & itAmmoSlots .~ singleAmmo ElectricalAmmo
& itType .~ DETECTOR dt
-- & itUse . heldMuzzles . ix 0 . mzEffect .~ MuzzleDetector
-- & itUse . heldMuzzles . ix 0 . mzAmmoPerShot .~ UseExactly 100
detector dt = defaultHeldItem & itType .~ DETECTOR dt
blinker :: Item
blinker =
defaultHeldItem
& itUseCondition .~ UseableAnytime
-- & itUse . heldDelay . rateMax .~ 20
-- & itAmmoSlots .~ singleAmmo ElectricalAmmo
-- & itUse . heldMuzzles . ix 0 . mzEffect .~ MuzzleBlink
-- & itUse . heldMuzzles . ix 0 . mzAmmoPerShot .~ UseExactly 10000000
& itType .~ HELD BLINKER
blinker = defaultHeldItem & itType .~ HELD BLINKER
unsafeBlinker :: Item
unsafeBlinker =
blinker
-- & itUse . heldMuzzles . ix 0 . mzEffect .~ MuzzleUnsafeBlink
& itType .~ HELD BLINKERUNSAFE
unsafeBlinker = blinker & itType .~ HELD BLINKERUNSAFE
rewinder :: Item
rewinder =
+11
View File
@@ -0,0 +1,11 @@
module Dodge.ItemUseCondition (itUseCondition) where
import Dodge.Data.Item
import Dodge.Data.UseCondition
itUseCondition :: Item -> UseCondition
itUseCondition itm = case _itType itm of
DETECTOR _ -> UseableAnytime
HELD BLINKER -> UseableAnytime
HELD UNSAFEBLINKER -> UseableAnytime
_ -> UseableWhenAimed
+1
View File
@@ -6,6 +6,7 @@ module Dodge.Projectile.Create (
--import Dodge.Data.ComposedItem
--import Dodge.Data.DoubleTree
import Dodge.Data.Muzzle
import Data.Maybe
import Dodge.Data.World
import Dodge.Item.Location
+221 -218
View File
File diff suppressed because it is too large Load Diff