Commit before changes to item grammar

This commit is contained in:
2024-09-25 11:13:01 +01:00
parent f765b02f2c
commit 600b8cd309
23 changed files with 152 additions and 150 deletions
+4 -4
View File
@@ -268,7 +268,10 @@ testInventory =
stackedInventory :: [Item]
stackedInventory =
[ targetingScope TARGETLASER
[ launcher
, remoteScreen
, megaShellMag
, targetingScope TARGETLASER
, zoomScope
, burstRifle
, megaTinMag
@@ -278,9 +281,6 @@ stackedInventory =
, chemFuelPouch
, bulletSynthesizer
, drumMag
, launcher
, rocketRemoteScreen
, megaShellMag
, launcherX 3
, megaShellMag
, megaShellMag
+1 -1
View File
@@ -15,7 +15,7 @@ data ComposeLinkType
| AmmoModLink
| WeaponScopeLink
| WeaponTargetingLink
| RocketRemoteScreenLink
| RemoteScreenLink
deriving (Eq,Ord,Show,Read)
data ComposedItem = WeaponCI
+1 -1
View File
@@ -99,7 +99,7 @@ data AttachType
| TARGETATTACH {_ibtAttachTarget :: TargetType}
| BULLETSYNTHESIZER
| ROCKETHOMER
| ROCKETREMOTESCREEN
| REMOTESCREEN
-- | BULPAYLOADATTACH
-- | BULTRAJECTORYATTACH
deriving (Eq, Ord, Show, Read)
+1 -1
View File
@@ -166,7 +166,7 @@ data Muzzle = Muzzle
, _mzAmmoSlot :: Int
, _mzFlareType :: FlareType
, _mzEffect :: MuzzleEffect
, _mzChargeRequirement :: Maybe Int
-- , _mzChargeRequirement :: Maybe Int
-- , _mzRecoil :: Float
-- , _mzTorque :: Float
-- , _mzSidePush :: Float
+12 -12
View File
@@ -6,7 +6,7 @@ module Dodge.Default.Item (
import qualified Data.IntMap.Strict as IM
import Control.Lens
import qualified Data.Map.Strict as M
--import qualified Data.Map.Strict as M
import Dodge.Data.Item
import Dodge.Default.Item.Effect
import Dodge.Default.Item.Use
@@ -46,24 +46,24 @@ singleAmmo x = IM.insert 0 x mempty
defaultBulletWeapon :: Item
defaultBulletWeapon =
defaultWeapon
defaultHeldItem
& itUse . heldMods .~ PistolMod
& itUse . heldAmmoTypes .~ singleAmmo BulletAmmo
-- & itUse . heldUse .~ HeldUseAmmoParams -- useAmmoParams
& itType . iyModules . at ModBulletCollision ?~ EMPTYMODULE
& itUse . heldAim . aimMuzzles .~ [Muzzle (V2 15 0) 0 0.01 0 PistolFlare MuzzleShootBullet Nothing]
& itUse . heldAim . aimMuzzles .~ [Muzzle (V2 15 0) 0 0.01 0 PistolFlare MuzzleShootBullet]
-- & itType . iyModules . at ModBulletPayload ?~ EMPTYMODULE
-- & itType . iyModules . at ModBulletTrajectory ?~ EMPTYMODULE
defaultWeapon :: Item
defaultWeapon =
defaultHeldItem
& itUse .~ defaultHeldUse
& itType . iyModules
.~ M.fromList
[ (ModTarget, EMPTYMODULE)
, (ModTeleport, EMPTYMODULE)
]
--defaultWeapon :: Item
--defaultWeapon =
-- defaultHeldItem
-- & itUse .~ defaultHeldUse
-- & itType . iyModules
-- .~ M.fromList
-- [ (ModTarget, EMPTYMODULE)
-- , (ModTeleport, EMPTYMODULE)
-- ]
defaultConsumable :: Item
defaultConsumable = defaultHeldItem & itUse .~ ConsumeUse CDoNothing
+11 -16
View File
@@ -11,24 +11,19 @@ defaultAimParams =
, _aimRange = 0
, _aimZoom = defaultItZoom
, _aimStance = OneHand
, --, _aimHandlePos = 10
_aimHandlePos = V2 3 0
, _aimMuzzles = [defaultMuzzle]
-- , _aimMuzPos = 20
, _aimHandlePos = V2 3 0
, _aimMuzzles =
[ Muzzle
{ _mzPos = V2 20 0
, _mzRot = 0
, _mzInaccuracy = 0.05
, _mzAmmoSlot = 0
, _mzFlareType = DefaultFlareType
, _mzEffect = MuzzleShootBullet
}
]
}
defaultMuzzle :: Muzzle
defaultMuzzle = Muzzle
{ _mzPos = V2 20 0
, _mzRot = 0
, _mzInaccuracy = 0.05
, _mzAmmoSlot = 0
, _mzFlareType = DefaultFlareType
, _mzEffect = MuzzleShootBullet
, _mzChargeRequirement = Nothing
}
defaultItZoom :: ItZoom
defaultItZoom =
ItZoom
+34 -7
View File
@@ -131,15 +131,15 @@ applyTorqueCME itm cr w
-- (Muzzle,Int,Int) = (muzzle, amountloaded, id of mag taken from)
loadMuzzle :: LabelDoubleTree ComposeLinkType Item
-> Muzzle -> (LabelDoubleTree ComposeLinkType Item,(Muzzle, Int,Maybe Int))
loadMuzzle t@(LDT _ l _) mz = fromMaybe (t,(mz, 0,Nothing)) $ do
-> Muzzle -> (LabelDoubleTree ComposeLinkType Item,Maybe (Muzzle, Int,LabelDoubleTree ComposeLinkType Item))
loadMuzzle t@(LDT _ l _) mz = fromMaybe (t,Nothing) $ do
let as = _mzAmmoSlot mz
amamount = 1
(i,(_,mag)) <- findWithIx (isAmmoIntLink as . fst) l
availableammo <- mag ^? ldtValue . itUse . amagLoadStatus . iaLoaded
let usedammo = min amamount availableammo
return (t & ldtLeft . ix i . _2 . ldtValue . itUse . amagLoadStatus . iaLoaded -~ usedammo
, (mz, usedammo, mag ^? ldtValue . itLocation . ilInvID)
, Just (mz, usedammo, mag)
)
makeMuzzleFlare :: Muzzle -> Item -> Creature -> World -> World
@@ -183,20 +183,23 @@ isAmmoIntLink :: Int -> ComposeLinkType -> Bool
isAmmoIntLink i (AmmoInLink j _) = i == j
isAmmoIntLink _ _ = False
useLoadedAmmo :: Item -> Creature -> (CumulativeMuzzleEffect,World) -> (Int,(Muzzle,Int,Maybe Int))
useLoadedAmmo :: Item -> Creature -> (CumulativeMuzzleEffect,World)
-> (Int,Maybe (Muzzle,Int,LabelDoubleTree ComposeLinkType Item))
-> (CumulativeMuzzleEffect,World)
useLoadedAmmo _ _ (cme,w) (_,(_,0,_)) = (cme, w)
useLoadedAmmo itm cr (cme,w) (mzid,(mz,x,mid)) = (,) (cme & cmeSound .~ True) $
useLoadedAmmo _ _ (cme,w) (_,Nothing) = (cme, w)
useLoadedAmmo itm cr (cme,w) (mzid,Just (mz,x,magtree)) = (,) (cme & cmeSound .~ True) $
removeAmmoFromMag x mid cr . makeMuzzleFlare mz itm cr $ case _mzEffect mz of
MuzzleShootBullet -> shootBullet itm cr w (mz,x,mid)
MuzzleLaser -> shootLaser' itm cr mz w
MuzzleTesla -> shootTeslaArc itm cr mz w
MuzzleTractor -> shootTractorBeam itm cr w
MuzzleLauncher -> createProjectile mid mz itm cr w
MuzzleLauncher -> createProjectile magtree mz itm cr w
MuzzleNozzle {} -> useGasParams mid mz itm cr $ walkNozzle mzid mz itm cr w
MuzzleShatter -> shootShatter itm cr w
MuzzleForceField -> useForceFieldGun itm cr w
MuzzleDetector -> itemDetectorEffect itm cr w
where
mid = magtree ^? ldtValue . itLocation . ilInvID
itemDetectorEffect :: Item -> Creature -> World -> World
itemDetectorEffect itm cr w = fromMaybe w $ do
@@ -493,3 +496,27 @@ useForceFieldGun itm cr w = fromMaybe w $ do
& moveWallIDUnsafe i wlline
where
i = fromMaybe (IM.newKey (_walls (_lWorld (_cWorld w)))) $ itm ^? itParams . paramMID . _Just
createProjectile :: LabelDoubleTree ComposeLinkType Item -> Muzzle -> Item -> Creature -> World -> World
createProjectile mmagtree muz itm cr = fromMaybe failsound $ do
magid <- mmagtree ^? ldtValue . itLocation . ilInvID
ammoitem <- cr ^? crInv . ix magid
-- let mremotescreen = magtree ^.
-- matype <- ammoitem ^? itUse . amagType
-- guard $ matype == ProjectileAmmo
j <- ammoitem ^? itLocation . ilInvID
pt <- ammoitem ^? itUse . amagParams . ampPjCreation
return $ case pt of
CreateShell -> fireShell ammoitem muz itm cr . extrafuncs j
CreateTrackingShell -> fireTrackingShell ammoitem muz itm cr . extrafuncs j
where
--extrafuncs j = cancelanyreloading . startthesound . useammo j
extrafuncs j = startthesound . useammo j
useammo j = cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix j . itUse . amagLoadStatus . iaLoaded -~ 1
--cancelanyreloading = cWorld . lWorld . creatures . ix (_crID cr) %~ crCancelReloading
-- the sound should be moved to the projectile firing
startthesound = soundMultiFrom [CrWeaponSound (_crID cr) j | j <- [0..3]] (_crPos cr) tap4S Nothing
failsound w' = case w' ^? input . mouseButtons . ix SDL.ButtonLeft of
Just 0 -> soundStart (CrWeaponSound (_crID cr) 0) (_crPos cr) click1S Nothing w'
_ -> soundContinue (CrWeaponSound (_crID cr) 0) (_crPos cr) click1S Nothing w'
+1 -1
View File
@@ -41,7 +41,7 @@ itemFromAttachType at = case at of
ZOOMSCOPE -> zoomScope
TARGETATTACH tt -> targetingScope tt
BULLETSYNTHESIZER -> bulletSynthesizer
ROCKETREMOTESCREEN -> rocketRemoteScreen
REMOTESCREEN -> remoteScreen
ROCKETHOMER -> rocketHomer
+5 -5
View File
@@ -60,7 +60,7 @@ itemString :: Item -> String
itemString = head . basicItemDisplay
itemBaseName :: Item -> String
itemBaseName it = case _iyBase $ _itType it of
itemBaseName itm = case _iyBase $ _itType itm of
CRAFT str -> show str
HELD hit -> case hit ^? xNum of
Just i -> takeWhile (/= ' ') (show hit) ++ show i
@@ -68,15 +68,15 @@ itemBaseName it = case _iyBase $ _itType it of
LEFT lit -> show lit
EQUIP eit -> showEquipItem eit
CONSUMABLE cit -> show cit
ATTACH ait -> showAttachItem ait
ATTACH ait -> showAttachItem ait itm
AMMOMAG ait -> show ait
showAttachItem :: AttachType -> String
showAttachItem t = case t of
showAttachItem :: AttachType -> Item -> String
showAttachItem t itm = case t of
ZOOMSCOPE -> "ZOOMSCOPE"
TARGETATTACH x -> show x
BULLETSYNTHESIZER -> "BSYNTH"
ROCKETREMOTESCREEN -> "REMOTE SCREEN"
REMOTESCREEN -> "REMOTE SCREEN " ++ show (itm ^? itUse . atLinkedProjectile . _Just)
ROCKETHOMER -> "HOMING MOD"
showEquipItem :: EquipItemType -> String
+1 -1
View File
@@ -32,7 +32,7 @@ baseComposedItem ibt itm = case ibt of
ATTACH (TARGETATTACH{}) -> (WeaponTargetingCI, [], [])
ATTACH ZOOMSCOPE -> (WeaponScopeCI, [], [])
ATTACH ROCKETHOMER -> (AmmoModifierCI ProjectileAmmo, [], [])
ATTACH ROCKETREMOTESCREEN -> (AmmoModifierCI ProjectileAmmo, [], [])
ATTACH REMOTESCREEN -> (AmmoModifierCI ProjectileAmmo, [], [])
_ -> (UncomposableCI, [], [])
heldComposedItem :: Item -> HeldItemType -> CIL
+8 -2
View File
@@ -32,7 +32,10 @@ teslaGun =
& itUse . heldAim . aimWeight .~ 6
& itUse . heldAim . aimStance .~ TwoHandFlat
-- & itUse . heldAim . aimMuzPos .~ 4
& itUse . heldAim . aimMuzzles .~ [Muzzle (V2 4 0) 0 0 0 TeslaGunFlare MuzzleTesla Nothing]
& itUse . heldAim . aimMuzzles . ix 0 . mzPos .~ V2 4 0
& itUse . heldAim . aimMuzzles . ix 0 . mzInaccuracy .~ 0
& itUse . heldAim . aimMuzzles . ix 0 . mzFlareType .~ TeslaGunFlare
& itUse . heldAim . aimMuzzles . ix 0 . mzEffect .~ MuzzleTesla
& itType . iyBase .~ HELD TESLAGUN
& itUse . heldAmmoTypes .~ singleAmmo ElectricalAmmo
& itUse . heldTriggerType .~ AutoTrigger
@@ -46,7 +49,10 @@ lasGun =
& itUse . heldAmmoTypes .~ singleAmmo ElectricalAmmo
& itUse . heldDelay .~ NoDelay
& itUse . heldTriggerType .~ AutoTrigger
& itUse . heldAim . aimMuzzles .~ [Muzzle (V2 30 0) 0 0 0 LasGunFlare MuzzleLaser Nothing]
& itUse . heldAim . aimMuzzles . ix 0 . mzPos .~ V2 30 0
& itUse . heldAim . aimMuzzles . ix 0 . mzInaccuracy .~ 0
& itUse . heldAim . aimMuzzles . ix 0 . mzFlareType .~ LasGunFlare
& itUse . heldAim . aimMuzzles . ix 0 . mzEffect .~ MuzzleLaser
& itParams
.~ Refracting
{ _phaseV = 1
+1 -2
View File
@@ -42,7 +42,6 @@ volleyGun i =
<*> ZipList [0..i-1]
<*> pure PistolFlare
<*> pure MuzzleShootBullet
<*> pure Nothing
)
& itUse . heldParams . torqueAfter .~ 0.15 + 0.05 * fromIntegral i
& itUse . heldParams . recoil .~ 20 + 10 * fromIntegral i
@@ -97,7 +96,7 @@ miniGunX i =
& itUse . heldParams . bulGunSound ?~ (mini1S,2)
& itUse . heldAim . aimTurnSpeed .~ 0.5
& itUse . heldAim . aimMuzzles
.~ replicate i (Muzzle (V2 30 0) 0 0.05 0 MiniGunFlare MuzzleShootBullet Nothing)
.~ replicate i (Muzzle (V2 30 0) 0 0.05 0 MiniGunFlare MuzzleShootBullet)
& itUse . heldParams . recoil .~ 10 * fromIntegral i
& itUse . heldParams . torqueAfter .~ 0.04 + 0.02 * fromIntegral i
& itUse . heldParams . sidePush .~ 10 * fromIntegral i
+1 -1
View File
@@ -17,7 +17,7 @@ bangCone =
& itUse . heldMods .~ PistolMod
-- & itUse . heldAim . aimHandlePos .~ 5
& itUse . heldAim . aimMuzzles
.~ replicate 15 (Muzzle (V2 15 0) 0 0.5 0 DefaultFlareType MuzzleShootBullet Nothing)
.~ replicate 15 (Muzzle (V2 15 0) 0 0.5 0 DefaultFlareType MuzzleShootBullet)
& itUse . heldParams . muzVel .~ UniRandFloat 0.5 0.8
& itUse . heldParams . rifling .~ UniRandFloat 0.3 0.8
& itUse . heldParams . recoil .~ 150
-1
View File
@@ -56,7 +56,6 @@ launcherX i =
<*> ZipList [0..]
<*> pure DefaultFlareType
<*> pure MuzzleLauncher
<*> pure Nothing
)
& itUse . heldAmmoTypes .~ IM.fromList [(j,ProjectileAmmo) | j <- [0..i-1]]
where
-1
View File
@@ -92,7 +92,6 @@ flameThrower =
, _nzWalkSpeed = 0.01
, _nzCurrentWalkAngle = 0
}
Nothing
]
& itUse . heldAmmoTypes .~ singleAmmo GasAmmo
& itType . iyBase .~ HELD FLAMETHROWER
+1 -1
View File
@@ -27,7 +27,7 @@ bangStick i =
-- & itUse . heldMods .~ BangStickMod
& itUse . heldMods .~ PistolMod
& itUse . heldAim . aimMuzzles
.~ [Muzzle (V2 10 0) a 0.01 0 DefaultFlareType MuzzleShootBullet Nothing | a <- spreadAroundCenter i baseStickSpread]
.~ [Muzzle (V2 10 0) a 0.01 0 DefaultFlareType MuzzleShootBullet | a <- spreadAroundCenter i baseStickSpread]
baseStickSpread :: Float
baseStickSpread = 0.2
+2 -2
View File
@@ -33,7 +33,7 @@ torch =
forceFieldGun :: Item
forceFieldGun =
defaultWeapon
defaultHeldItem
-- & itUse . useTargeting ?~ TargetRBLine
& itType . iyModules . at ModTarget ?~ TARGET TargetRBLine
& itParams .~ ParamMID Nothing
@@ -52,7 +52,7 @@ Sends out pulses that display walls.
-}
clickDetector :: Detector -> Item
clickDetector dt =
defaultWeapon
defaultHeldItem
& itUse . heldDelay . rateMax .~ 20
-- & itUse . heldUse .~ HeldDetectorEffect dt --detectorEffect dt
-- & itUse . heldMods .~ AmmoUseCheckMod
+4 -4
View File
@@ -1,7 +1,7 @@
module Dodge.Item.Scope (
zoomScope,
targetingScope,
rocketRemoteScreen,
remoteScreen,
) where
import Control.Lens
@@ -21,8 +21,8 @@ targetingScope tt =
& itType . iyBase .~ ATTACH (TARGETATTACH tt)
& itUse .~ AttachUse Nothing
rocketRemoteScreen :: Item
rocketRemoteScreen =
remoteScreen :: Item
remoteScreen =
defaultHeldItem
& itType . iyBase .~ ATTACH ROCKETREMOTESCREEN
& itType . iyBase .~ ATTACH REMOTESCREEN
& itUse .~ AttachUse Nothing
+5 -26
View File
@@ -1,38 +1,17 @@
module Dodge.Projectile.Create
( createProjectile
( fireShell
, fireTrackingShell
) where
import Dodge.SoundLogic
import Control.Monad
--import Dodge.SoundLogic
--import Control.Monad
import Data.Maybe
import Dodge.Data.World
import Geometry
import qualified IntMapHelp as IM
import LensHelp
import qualified SDL
--import qualified SDL
createProjectile :: Maybe Int -> Muzzle -> Item -> Creature -> World -> World
createProjectile mmagid muz itm cr = fromMaybe failsound $ do
magid <- mmagid
ammoitem <- cr ^? crInv . ix magid
matype <- ammoitem ^? itUse . amagType
guard $ matype == ProjectileAmmo
j <- ammoitem ^? itLocation . ilInvID
pt <- ammoitem ^? itUse . amagParams . ampPjCreation
return $ case pt of
CreateShell -> fireShell ammoitem muz itm cr . extrafuncs j
CreateTrackingShell -> fireTrackingShell ammoitem muz itm cr . extrafuncs j
where
--extrafuncs j = cancelanyreloading . startthesound . useammo j
extrafuncs j = startthesound . useammo j
useammo j = cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix j . itUse . amagLoadStatus . iaLoaded -~ 1
--cancelanyreloading = cWorld . lWorld . creatures . ix (_crID cr) %~ crCancelReloading
-- the sound should be moved to the projectile firing
startthesound = soundMultiFrom [CrWeaponSound (_crID cr) j | j <- [0..3]] (_crPos cr) tap4S Nothing
failsound w' = case w' ^? input . mouseButtons . ix SDL.ButtonLeft of
Just 0 -> soundStart (CrWeaponSound (_crID cr) 0) (_crPos cr) click1S Nothing w'
_ -> soundContinue (CrWeaponSound (_crID cr) 0) (_crPos cr) click1S Nothing w'
fireShell :: Item -> Muzzle -> Item -> Creature -> World -> World
fireShell ammoitem muz it cr =
+10 -9
View File
@@ -20,15 +20,16 @@ import Dodge.Data.Universe
import qualified IntMapHelp as IM
testStringInit :: Universe -> [String]
testStringInit u = (topTestPart u
<>) $ map showh $
-- (IM.toList . IM.filter (\itloc -> itloc ^? ilCrID == Just 0) $ (u ^. uvWorld . cWorld . lWorld . itemLocations)) <>
( IM.elems $ fmap h (u ^?! uvWorld . cWorld . lWorld . creatures . ix 0 . crInv))
where
h itm = (_itID itm, _itLocation itm)
showh (x,(InInv a b c d e)) = show x ++ "," ++ show a ++ "," ++ show b ++"," ++ show c ++"," ++ show d
++ "," ++ show e
showh _ = ""
testStringInit = const mempty
--testStringInit u = (topTestPart u
-- <>) $ map showh $
---- (IM.toList . IM.filter (\itloc -> itloc ^? ilCrID == Just 0) $ (u ^. uvWorld . cWorld . lWorld . itemLocations)) <>
-- ( IM.elems $ fmap h (u ^?! uvWorld . cWorld . lWorld . creatures . ix 0 . crInv))
-- where
-- h itm = (_itID itm, _itLocation itm)
-- showh (x,(InInv a b c d e)) = show x ++ "," ++ show a ++ "," ++ show b ++"," ++ show c ++"," ++ show d
-- ++ "," ++ show e
-- showh _ = ""
topTestPart :: Universe -> [String]
topTestPart u = [show $ u ^? uvWorld . hud . hudElement . diSections . sssExtra . sssSelPos