Work on cleaning up item effects/attachments etc

This commit is contained in:
2022-07-27 16:39:58 +01:00
parent 8d17ce66e9
commit b52adddd5d
39 changed files with 696 additions and 844 deletions
+1 -1
View File
@@ -40,7 +40,7 @@ splitBeamCombine (p,(a,b,_),(x,y,_))
teslaBeamCombine :: (Point2,(Point2,Point2,Beam),(Point2,Point2,Beam))
-> World -> World
teslaBeamCombine (p,(a,b,bm),(x,y,_)) w
= w' & pointerToItem (_itemPositions (_cWorld w) IM.! itid) . itParams . subParams ?~ ip
= w' & pointerToItemLocation (_itemLocations (_cWorld w) IM.! itid) . itParams . subParams ?~ ip
where
itid = fromJust $ _bmOrigin bm
dir = argV (normalizeV (b-.-a)+.+normalizeV (y-.-x))
+188 -185
View File
@@ -1,118 +1,96 @@
{-# LANGUAGE TupleSections #-}
module Dodge.Combine.Combinations where
--import Geometry
import Dodge.Data
--import Dodge.WorldEvent.SpawnParticle
--import Dodge.Particle.HitEffect.ExpireAndDamage
--import Dodge.Particle.Damage
import Dodge.Item.Equipment
import Dodge.Item.Craftable
import Dodge.Item.Weapon
--import Dodge.Combine.Module
--import Dodge.Base
import Dodge.Data.Item
import Dodge.Item
import LensHelp
--import Data.Maybe
itemCombinations :: [([(ItAmount,ItemBaseType)],Item)]
itemCombinations :: [([(ItAmount, ItemBaseType)], Item)]
itemCombinations =
[ po [CRAFT PIPE, CRAFT HARDWARE] (bangStick 1)
, po [HELD (BANGSTICK 1), CRAFT TIN] pistol
[ po [CRAFT PIPE, CRAFT HARDWARE] (bangStick 1)
, po [HELD (BANGSTICK 1), CRAFT TIN] pistol
, po [HELD PISTOL, CRAFT SPRING] autoPistol
, po [HELD AUTOPISTOL, cr PLANK] smg
, po [HELD AUTOPISTOL, cr SPRING] machinePistol
, po [HELD (BANGSTICK 1),cr CAN] revolver
, po [HELD (BANGSTICK 1), cr CAN] revolver
, po [HELD REVOLVER, cr SPRING] $ revolverX 1
, po [cr CAN, cr HARDWARE] bangCone
, po [HELD BANGCONE, cr PLANK] blunderbuss
, po [HELD BLUNDERBUSS, cr DRUM] (grapeCannon 1)
, -- , po [BANGCONE,PUMP,HARDWARE] $ grenadeLauncher 1
-- , po [GRENADELAUNCHER 1,MOTOR,DRUM] $ grenadeLauncher 2
, po [cr CAN,cr HARDWARE] bangCone
, po [HELD BANGCONE,cr PLANK] blunderbuss
, po [HELD BLUNDERBUSS,cr DRUM] (grapeCannon 1)
-- , po [BANGCONE,PUMP,HARDWARE] $ grenadeLauncher 1
-- , po [GRENADELAUNCHER 1,MOTOR,DRUM] $ grenadeLauncher 2
-- , po [cr PIPE, cr HARDWARE] (volleyGun 1)
, po [HELD (BANGSTICK 1),cr PLANK] rifle
, po [HELD (BANGSTICK 1),HELD (BANGSTICK 1),HELD (BANGSTICK 1)] (volleyGun 3)
, po [HELD RIFLE,cr TIN] repeater
, po [HELD REPEATER,cr SPRING] autoRifle
, po [HELD REPEATER,cr CAN] burstRifle
-- , po [BURSTRIFLE,cr SPRING,cr HARDWARE] fastBurstRifle
-- , po [FASTBURSTRIFLE,cr SPRING,cr HARDWARE] completeBurstRifle
]
++ [ po [cr MOTOR,HELD (VOLLEYGUN i)] $ miniGunX i | i <- [3..10]
] ++
-- , po [BANGSTICK 1,cr TUBE] elephantGun
[ po [HELD AMR,cr PIPE] sniperRifle
, po [HELD RIFLE,cr PIPE] amr
, po [HELD AMR,cr SPRING] autoAmr
, po [HELD AMR,cr MOTOR] machineGun
, p [p 2 $ cr TUBE,o $ cr HARDWARE] launcher
, p [p 2 $ cr TUBE,o $ HELD LAUNCHER] (launcherX 2)
] ++ [ p [p 2 $ cr TUBE,o $ HELD (LAUNCHERX i)] (launcherX (i+1)) | i <- [2..9]]
++
[ po [cr LIGHTER,cr PUMP,cr CAN] flameSpitter
, po [HELD FLAMESPITTER,cr CAN,cr PUMP] blowTorch
, po [HELD FLAMESPITTER,cr DRUM] flameThrower
, po [HELD FLAMETHROWER,cr DRUM] flameWall
, po [HELD FLAMETHROWER,cr PUMP] flameTorrent
, p [o $ cr PRISM,o $ cr TRANSFORMER,o $ cr PIPE] lasGun
-- , p [o LASGUN,o $ cr PRISM] lasSway
-- , p [o LASGUN,o $ cr HARDWARE] lasSwing
-- , p [o LASGUN,o PIPE] lasGunPulse
, po [HELD LASGUN,HELD LASGUN,cr HARDWARE] dualBeam
-- , p [o LASGUN,o $ cr PIPE, o $ cr PRISM] lasWidePulse
, po [HELD LASGUN, cr TRANSFORMER] (lasWide 2)
, po [HELD LASGUN,HELD LASGUN,HELD LASGUN,cr HARDWARE] lasCircle
, p [o $ cr TRANSFORMER,p 2 $ cr CAN] sparkGun
, p [o (HELD SPARKGUN),p 2 $ cr PIPE] teslaGun
, p [o $ cr TELEPORTMODULE,p 2 $ cr MICROCHIP] blinkGun
, p [o $ LEFT BLINKER, p 2 $ cr MICROCHIP] unsafeBlinkGun
, po [cr MAGNET,cr TIN] magShield
, p [p 2 $ cr PIPE,o $ cr PLATE,o $ cr MOTOR] powerLegs
, p [p 4 $ cr CAN] plateCraft
, p [p 3 $ cr TIN] plateCraft
, p [p 2 $ cr DRUM] plateCraft
, p [p 2 $ cr PLATE] flatShield
, po [cr MICROCHIP, cr PRISM] (makeTypeCraft LIGHTSENSOR)
, po [cr MICROCHIP, cr MAGNET] (makeTypeCraft SOUNDSENSOR)
, po [cr MICROCHIP, cr THERMOMETER] (makeTypeCraft HEATSENSOR)
, po [cr MICROCHIP, cr TRANSMITTER, cr LIGHTSENSOR] (autoDetector ITEMDETECTOR)
, po [cr MICROCHIP, cr TRANSMITTER, cr SOUNDSENSOR] (autoDetector WALLDETECTOR)
, po [cr MICROCHIP, cr TRANSMITTER, cr HEATSENSOR] (autoDetector CREATUREDETECTOR)
, po [cr BATTERY, cr LED] torch
, po [hd TORCH, eq HAT] headLamp
, po [cr LIGHTER, cr THERMOMETER, cr MICROCHIP] (makeTypeCraft INCENDIARYMODULE)
, po [cr TRANSFORMER, cr BATTERY, cr MICROCHIP] (makeTypeCraft STATICMODULE)
]
++ map (\i -> po [HELD (LASWIDE i),cr TRANSFORMER] $ lasWide (i+1)) [2..9]
-- ++ map (\i -> po [LASGUNWIDE i,cr HARDWARE] $ lasFocus i) [2..10]
++ map (\i -> po [cr PIPE,HELD (BANGSTICK i)] $ bangStick (i+1)) [1..8]
++ map (\i -> po [hd (REVOLVERX i),cr CAN] $ revolverX (i+1)) [1..5]
++ map (\i -> po [hd (VOLLEYGUN i),HELD (BANGSTICK 1)] $ volleyGun (i+1)) [3..5]
++ map (\i -> po [hd (MINIGUNX i),HELD (BANGSTICK 1)] $ miniGunX (i+1)) [3..15]
++ map (\i -> po [hd (GRAPECANNON i),cr DRUM] $ grapeCannon (i+1)) [1,2,3]
++ [ po (_iyBase (_itType it):mtype) $ it & itType . iyModules . ix modtype .~ m
| (modtype,is,ms) <- moduleCombinations
, it <- is
, (mtype,m) <- ms
-- , po [cr PIPE, cr HARDWARE] (volleyGun 1)
po [HELD (BANGSTICK 1), cr PLANK] rifle
, po [HELD (BANGSTICK 1), HELD (BANGSTICK 1), HELD (BANGSTICK 1)] (volleyGun 3)
, po [HELD RIFLE, cr TIN] repeater
, po [HELD REPEATER, cr SPRING] autoRifle
, po [HELD REPEATER, cr CAN] burstRifle
-- , po [BURSTRIFLE,cr SPRING,cr HARDWARE] fastBurstRifle
-- , po [FASTBURSTRIFLE,cr SPRING,cr HARDWARE] completeBurstRifle
]
++ [ po [cr MOTOR, HELD (VOLLEYGUN i)] $ miniGunX i | i <- [3 .. 10]
]
++
-- , po [BANGSTICK 1,cr TUBE] elephantGun
[ po [HELD AMR, cr PIPE] sniperRifle
, po [HELD RIFLE, cr PIPE] amr
, po [HELD AMR, cr SPRING] autoAmr
, po [HELD AMR, cr MOTOR] machineGun
, p [p 2 $ cr TUBE, o $ cr HARDWARE] launcher
, p [p 2 $ cr TUBE, o $ HELD LAUNCHER] (launcherX 2)
]
++ [p [p 2 $ cr TUBE, o $ HELD (LAUNCHERX i)] (launcherX (i + 1)) | i <- [2 .. 9]]
++ [ po [cr LIGHTER, cr PUMP, cr CAN] flameSpitter
, po [HELD FLAMESPITTER, cr CAN, cr PUMP] blowTorch
, po [HELD FLAMESPITTER, cr DRUM] flameThrower
, po [HELD FLAMETHROWER, cr DRUM] flameWall
, po [HELD FLAMETHROWER, cr PUMP] flameTorrent
, p [o $ cr PRISM, o $ cr TRANSFORMER, o $ cr PIPE] lasGun
, -- , p [o LASGUN,o $ cr PRISM] lasSway
-- , p [o LASGUN,o $ cr HARDWARE] lasSwing
-- , p [o LASGUN,o PIPE] lasGunPulse
po [HELD LASGUN, HELD LASGUN, cr HARDWARE] dualBeam
, -- , p [o LASGUN,o $ cr PIPE, o $ cr PRISM] lasWidePulse
po [HELD LASGUN, cr TRANSFORMER] (lasWide 2)
, po [HELD LASGUN, HELD LASGUN, HELD LASGUN, cr HARDWARE] lasCircle
, p [o $ cr TRANSFORMER, p 2 $ cr CAN] sparkGun
, p [o (HELD SPARKGUN), p 2 $ cr PIPE] teslaGun
, p [o $ cr TELEPORTMODULE, p 2 $ cr MICROCHIP] blinkGun
, p [o $ LEFT BLINKER, p 2 $ cr MICROCHIP] unsafeBlinkGun
, po [cr MAGNET, cr TIN] magShield
, p [p 2 $ cr PIPE, o $ cr PLATE, o $ cr MOTOR] powerLegs
, p [p 4 $ cr CAN] plateCraft
, p [p 3 $ cr TIN] plateCraft
, p [p 2 $ cr DRUM] plateCraft
, p [p 2 $ cr PLATE] flatShield
, po [cr MICROCHIP, cr PRISM] (makeTypeCraft LIGHTSENSOR)
, po [cr MICROCHIP, cr MAGNET] (makeTypeCraft SOUNDSENSOR)
, po [cr MICROCHIP, cr THERMOMETER] (makeTypeCraft HEATSENSOR)
, po [cr MICROCHIP, cr TRANSMITTER, cr LIGHTSENSOR] (autoDetector ITEMDETECTOR)
, po [cr MICROCHIP, cr TRANSMITTER, cr SOUNDSENSOR] (autoDetector WALLDETECTOR)
, po [cr MICROCHIP, cr TRANSMITTER, cr HEATSENSOR] (autoDetector CREATUREDETECTOR)
, po [cr BATTERY, cr LED] torch
, po [hd TORCH, eq HAT] headLamp
, po [cr LIGHTER, cr THERMOMETER, cr MICROCHIP] (makeTypeCraft INCENDIARYMODULE)
, po [cr TRANSFORMER, cr BATTERY, cr MICROCHIP] (makeTypeCraft STATICMODULE)
]
++ map (\i -> po [HELD (LASWIDE i), cr TRANSFORMER] $ lasWide (i + 1)) [2 .. 9]
-- ++ map (\i -> po [LASGUNWIDE i,cr HARDWARE] $ lasFocus i) [2..10]
++ map (\i -> po [cr PIPE, HELD (BANGSTICK i)] $ bangStick (i + 1)) [1 .. 8]
++ map (\i -> po [hd (REVOLVERX i), cr CAN] $ revolverX (i + 1)) [1 .. 5]
++ map (\i -> po [hd (VOLLEYGUN i), HELD (BANGSTICK 1)] $ volleyGun (i + 1)) [3 .. 5]
++ map (\i -> po [hd (MINIGUNX i), HELD (BANGSTICK 1)] $ miniGunX (i + 1)) [3 .. 15]
++ map (\i -> po [hd (GRAPECANNON i), cr DRUM] $ grapeCannon (i + 1)) [1, 2, 3]
++ [ po (_iyBase (_itType it) : mtype) $ it & itType . iyModules . ix modtype .~ m
| (modtype, is, ms) <- moduleCombinations
, it <- is
, (mtype, m) <- ms
]
where
p = (,)
po xs it = (map o xs,it)
po xs it = (map o xs, it)
o = (1,)
cr = CRAFT
hd = HELD
@@ -121,81 +99,106 @@ itemCombinations =
-- so there are two requirements for a module combination: the module slot must
-- exist on the item, and the item must be in the given list below
-- these two requirements should probably be combined
moduleCombinations :: [( ModuleSlot, [Item], [([ItemBaseType],ItemModuleType)] )]
moduleCombinations :: [(ModuleSlot, [Item], [([ItemBaseType], ItemModuleType)])]
moduleCombinations =
[ ( ModRifleMag
, [repeater
,autoRifle
,burstRifle
-- ,fastBurstRifle
[
( ModRifleMag
,
[ repeater
, autoRifle
, burstRifle
-- ,fastBurstRifle
]
, [amod [cr DRUM,cr HARDWARE] DRUMMAG
,amod [cr MOTOR,cr HARDWARE] BELTMAG
,
[ amod [cr DRUM, cr HARDWARE] DRUMMAG
, amod [cr MOTOR, cr HARDWARE] BELTMAG
]
)
, ( ModHeldAttach
, [rifle
,autoRifle
,burstRifle
,
( ModHeldAttach
,
[ rifle
, autoRifle
, burstRifle
]
, [amod [cr DUCTTAPE,HELD TORCH] ATTACHTORCH
,
[ amod [cr DUCTTAPE, HELD TORCH] ATTACHTORCH
]
)
, ( ModAutoMag
, [autoRifle
,autoPistol
,smg
,
( ModAutoMag
,
[ autoRifle
, autoPistol
, smg
]
, [amod [cr MAGNET,cr HARDWARE] MAGNETMAG
,
[ amod [cr MAGNET, cr HARDWARE] MAGNETMAG
]
)
, ( ModBullet
, bulletWeapons
, [amod [cr BOUNCEMODULE] BOUNCEBUL
,amod [cr PENMODULE] PENBUL
,
( ModBullet
, bulletWeapons
,
[ amod [cr BOUNCEMODULE] BOUNCEBUL
, amod [cr PENMODULE] PENBUL
]
)
, ( ModBulletSpawn
, bulletWeapons
, [amod [cr INCENDIARYMODULE] INCENDBUL
,amod [cr STATICMODULE] STATICBUL
,amod [cr CONCUSSMODULE] CONCUSBUL
,
( ModBulletSpawn
, bulletWeapons
,
[ amod [cr INCENDIARYMODULE] INCENDBUL
, amod [cr STATICMODULE] STATICBUL
, amod [cr CONCUSSMODULE] CONCUSBUL
]
)
, ( ModTarget
,
( ModTarget
, homingLaunchers ++ bulletWeapons
, [amod [cr MICROCHIP,cr HEATSENSOR] TARGCR
,amod [cr MICROCHIP,cr LIGHTSENSOR] TARGLAS
,amod [cr MICROCHIP,cr SOUNDSENSOR] TARGPOS
,
[ amod [cr MICROCHIP, cr HEATSENSOR] TARGCR
, amod [cr MICROCHIP, cr LIGHTSENSOR] TARGLAS
, amod [cr MICROCHIP, cr SOUNDSENSOR] TARGPOS
]
)
, ( ModBulletTrajectory
, bulletWeapons
, [amod [cr MAGNET, cr MICROCHIP,cr HARDWARE] MAGNETTRAJ
,amod [cr MICROCHIP, cr HARDWARE] FLECHETRAJ
,amod [cr ANTIMATTER,cr HARDWARE] BEZIERTRAJ
,
( ModBulletTrajectory
, bulletWeapons
,
[ amod [cr MAGNET, cr MICROCHIP, cr HARDWARE] MAGNETTRAJ
, amod [cr MICROCHIP, cr HARDWARE] FLECHETRAJ
, amod [cr ANTIMATTER, cr HARDWARE] BEZIERTRAJ
]
)
, ( ModDualBeam
, [dualBeam]
, [amod [cr INCENDIARYMODULE] INCENDLAS
,amod [cr TRANSFORMER] SPLITLAS
,amod [cr STATICMODULE] STATICLAS
,
( ModDualBeam
, [dualBeam]
,
[ amod [cr INCENDIARYMODULE] INCENDLAS
, amod [cr TRANSFORMER] SPLITLAS
, amod [cr STATICMODULE] STATICLAS
]
)
, ( ModTeleport
, teleportableWeapons
, [amod [cr TELEPORTMODULE,cr MICROCHIP] WEPTELE
,
( ModTeleport
, teleportableWeapons
,
[ amod [cr TELEPORTMODULE, cr MICROCHIP] WEPTELE
]
)
, ( ModLauncherHoming
, homingLaunchers
, [ amod [cr MICROCHIP,cr TRANSMITTER] LAUNCHHOME
,
( ModLauncherHoming
, homingLaunchers
,
[ amod [cr MICROCHIP, cr TRANSMITTER] LAUNCHHOME
]
)
, ( ModBattery
,
( ModBattery
, batteryGuns
, [amod [cr BATTERY] EXTRABATTERY
,
[ amod [cr BATTERY] EXTRABATTERY
]
)
]
@@ -204,49 +207,49 @@ moduleCombinations =
cr = CRAFT
homingLaunchers :: [Item]
homingLaunchers = launcher : [launcherX i | i <- [2..10]]
homingLaunchers = launcher : [launcherX i | i <- [2 .. 10]]
batteryGuns :: [Item]
batteryGuns =
[ teslaGun
, sparkGun
, lasGun
-- , lasSway
-- , lasSwing
] ++
[ lasWide i | i <- [2..10]
]
-- , lasSway
-- , lasSwing
]
++ [ lasWide i | i <- [2 .. 10]
]
-- ++
-- [ lasFocus i | i <- [1..10]]
teleportableWeapons :: [Item]
teleportableWeapons = bulletWeapons ++ batteryGuns ++ homingLaunchers
teleportableWeapons = bulletWeapons ++ batteryGuns ++ homingLaunchers
bulletWeapons :: [Item]
bulletWeapons
= [bangStick i | i <- [1..9] ]
++ [volleyGun i | i <- [3..6] ]
++ [revolverX i | i <- [1..5] ]
++ [miniGunX i | i <- [3..16] ]
++ [grapeCannon i | i <- [1,2,3,4] ]
++
[pistol
,autoPistol
,smg
,machinePistol
,revolver
,rifle
,repeater
,autoRifle
,burstRifle
-- ,fastBurstRifle
-- ,completeBurstRifle
,bangCone
,blunderbuss
,machineGun
,elephantGun
,sniperRifle
,amr
,autoAmr
,bangRod
]
bulletWeapons =
[bangStick i | i <- [1 .. 9]]
++ [volleyGun i | i <- [3 .. 6]]
++ [revolverX i | i <- [1 .. 5]]
++ [miniGunX i | i <- [3 .. 16]]
++ [grapeCannon i | i <- [1, 2, 3, 4]]
++ [ pistol
, autoPistol
, smg
, machinePistol
, revolver
, rifle
, repeater
, autoRifle
, burstRifle
, -- ,fastBurstRifle
-- ,completeBurstRifle
bangCone
, blunderbuss
, machineGun
, elephantGun
, sniperRifle
, amr
, autoAmr
, bangRod
]
+1 -4
View File
@@ -21,10 +21,7 @@ import Dodge.Creature.PistolCrit
import Dodge.Creature.SpreadGunCrit
import Dodge.Data
import Dodge.Default
import Dodge.Item.Consumable
import Dodge.Item.Craftable
import Dodge.Item.Equipment
import Dodge.Item.Weapon
import Dodge.Item
import Geometry.Data
import qualified IntMapHelp as IM
import Picture
+2 -2
View File
@@ -53,7 +53,7 @@ tryReload cr it w f
| _crID cr == _yourID (_cWorld w) && itNeedsLoading it && _mouseButtons w M.!? SDL.ButtonLeft == Just False =
crToggleReloading cr
| otherwise =
(runIdentity . pointerToItem (_itPos it) (return . (itUse . useHammer .~ HammerDown)))
(runIdentity . pointerToItemLocation (_itLocation it) (return . (itUse . useHammer .~ HammerDown)))
. f
itNeedsLoading :: Item -> Bool
@@ -116,7 +116,7 @@ useLeftItem cid w
itm <- cr ^? crInv . ix invid
f <- cr ^? crInv . ix invid . itUse . lUse
return
. (runIdentity . pointerToItem (_itPos itm) (return . (itUse . useHammer .~ HammerDown)))
. (runIdentity . pointerToItemLocation (_itLocation itm) (return . (itUse . useHammer .~ HammerDown)))
. useL f itm cr
$ w
where
+1 -1
View File
@@ -213,7 +213,7 @@ itemUpdate cr i
| otherwise = baseupdate False
where
baseupdate bool = updateAutoRecharge . (itUse %~ useUpdate)
. (itPos .~ InInv (_crID cr) i)
. (itLocation .~ InInv (_crID cr) i)
. (itIsHeld .~ bool)
updateAutoRecharge :: Item -> Item
updateAutoRecharge it = case it ^? itUse . leftConsumption of
+1 -1
View File
@@ -71,7 +71,7 @@ data CWorld = CWorld
, _creatures :: IM.IntMap Creature
, _crZoning :: IM.IntMap (IM.IntMap IS.IntSet)
, _creatureGroups :: IM.IntMap CrGroupParams
, _itemPositions :: IM.IntMap ItemPos
, _itemLocations :: IM.IntMap ItemLocation
, _clouds :: [Cloud]
, _clZoning :: IM.IntMap (IM.IntMap [Cloud])
, _gusts :: IM.IntMap Gust
+3 -4
View File
@@ -9,7 +9,7 @@ module Dodge.Data.Item (
module Dodge.Data.Item.Params,
module Dodge.Data.Item.Use,
module Dodge.Data.Item.CurseStatus,
module Dodge.Data.Item.Attachment,
module Dodge.Data.Item.Scope,
module Dodge.Data.Item.Combine,
module Dodge.Data.Item.Targeting,
) where
@@ -20,7 +20,7 @@ import Data.Aeson
import Data.Aeson.TH
import Dodge.Data.Item.Combine
import Dodge.Data.Item.Effect
import Dodge.Data.Item.Attachment
import Dodge.Data.Item.Scope
import Dodge.Data.Item.CurseStatus
import Dodge.Data.Item.Misc
import Dodge.Data.Item.Params
@@ -31,9 +31,8 @@ import Dodge.Data.Item.Targeting
data Item = Item
{ _itUse :: ItemUse
, _itType :: ItemType
, _itAttachment :: ItAttachment
, _itID :: Maybe Int
, _itPos :: ItemPos
, _itLocation :: ItemLocation
, _itIsHeld :: Bool
, _itEffect :: ItEffect
, _itInvSize :: Float
+9 -21
View File
@@ -1,14 +1,14 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.Item.Combine where
import Dodge.Data.Item.Use.Consumption
import Control.Lens
import Data.Aeson
import Data.Aeson.TH
import qualified Data.Map.Strict as M
import Dodge.Data.Equipment.Misc
import Dodge.Data.Item.Use.Consumption
data ItemType = ItemType
{ _iyBase :: ItemBaseType
@@ -79,6 +79,7 @@ data ItemBaseType
data ConsumableItemType
= MEDKIT Int
| EXPLOSIVES
deriving (Eq, Ord, Show, Read)
data EquipItemType
@@ -90,7 +91,6 @@ data EquipItemType
| BRAINHAT
| HAT
| HEADLAMP
| HEADLAMP1
| POWERLEGS
| SPEEDLEGS
| JUMPLEGS
@@ -118,17 +118,13 @@ data HeldItemType
| BANGCONE
| BLUNDERBUSS
| GRAPECANNON {_xNum :: Int}
| -- | GRENADELAUNCHER Int -- number of chambers that can be reloaded
-- | MORTARCONE / HANDMORTAR
MINIGUNX {_xNum :: Int}
| MINIGUNX {_xNum :: Int}
| VOLLEYGUN {_xNum :: Int}
| RIFLE
| REPEATER
| AUTORIFLE
| BURSTRIFLE
| -- | FASTBURSTRIFLE
-- | COMPLETEBURSTRIFLE
BANGROD
| BANGROD
| ELEPHANTGUN
| AMR
| AUTOAMR
@@ -143,20 +139,12 @@ data HeldItemType
| TESLAGUN
| LASGUN
| LASCIRCLE
| -- | LASPULSE
DUALBEAM
| -- | LASGUNSWING
-- | LASGUNSWAY
-- | LASGUNWIDEPULSE
LASWIDE {_xNum :: Int}
| -- | LASGUNFOCUS Int
-- | SONICGUN
TRACTORGUN
| DUALBEAM
| LASWIDE {_xNum :: Int}
| TRACTORGUN
| LAUNCHER
| LAUNCHERX {_xNum :: Int}
| -- | TRACKINGLAUNCHER
REMOTELAUNCHER
| REMOTELAUNCHER
| POISONSPRAYER
| DRONELAUNCHER
| SHATTERGUN
+9 -25
View File
@@ -7,39 +7,23 @@ import Control.Lens
import Data.Aeson
import Data.Aeson.TH
data ItEffect
= NoItEffect
| ItInvEffect
{ _ieInv :: ItInvEffect --Item -> Creature -> World -> World
, _ieCounter :: Int
}
| ItRewindEffect
{ _ieInv :: ItInvEffect --Item -> Creature -> World -> World
}
| ItEffect
{ _ieInv :: ItInvEffect --Item -> Creature -> World -> World
, _ieFloor :: ItFloorEffect --Int -> World -> World
, _ieCounter :: Int
}
| ItInvEffectID
{ _ieInv :: ItInvEffect --Item -> Creature -> World -> World
, _ieMID :: Maybe Int
} -- the duplication of ieMID may cause errors...
| ItInvEffectDrop
{ _ieInv :: ItInvEffect --Item -> Creature -> World -> World
, _ieDrop :: ItDropEffect --Item -> Creature -> World -> World
, _ieMID :: Maybe Int
}
data ItEffect = ItEffect
{ _ieInv :: ItInvEffect --Item -> Creature -> World -> World
, _ieOnInsert :: ItInvEffect
, _ieOnDrop :: ItInvEffect --Item -> Creature -> World -> World
, _ieOnHeld :: ItInvEffect
, _ieOnStash :: ItInvEffect
}
deriving (Eq, Ord, Show, Read)
data ItInvEffect
= NoInvEffect
| RewindEffect
| ResetAttachmentEffect
| OnOffHeldEffect ItInvEffect ItInvEffect
| EffectIfHeld ItInvEffect ItInvEffect
| CreateHeldLight
| CreateShieldWall
| RemoveShieldWall
| EffectWhileHeld ItInvEffect
deriving (Eq, Ord, Show, Read)
data ItFloorEffect = NoFloorEffect
+30 -33
View File
@@ -1,53 +1,50 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.Item.Misc where
import GHC.Generics
import Data.Aeson
import Geometry.Data
import Control.Lens
import Data.Aeson
import Data.Aeson.TH
import Geometry.Data
data ItemDimension = ItemDimension
{ _dimRad :: Float
, _dimCenter :: Point3
{ _dimRad :: Float
, _dimCenter :: Point3
, _dimAttachPos :: Point3
}
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON ItemDimension where
toEncoding = genericToEncoding defaultOptions
instance FromJSON ItemDimension
data ItemPortage
deriving (Eq, Show, Read)
data ItemPortage
= HeldItem
{ _handlePos :: Float
, _muzPos :: Float
, _muzPos :: Float
}
| WornItem
| NoPortage
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON ItemPortage where
toEncoding = genericToEncoding defaultOptions
instance FromJSON ItemPortage
deriving (Eq, Show, Read)
data ItemValue = ItemValue
{ _ivInt :: Int
, _ivType :: ItemValueType
}
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON ItemValue where
toEncoding = genericToEncoding defaultOptions
instance FromJSON ItemValue
deriving (Eq, Show, Read)
data ItemValueType = MundaneItem | ArtefactItem
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON ItemValueType where
toEncoding = genericToEncoding defaultOptions
instance FromJSON ItemValueType
data ItemPos
= InInv { _ipCrID :: Int , _ipInvID :: Int }
| OnFloor { _ipFlID :: Int }
deriving (Eq, Show, Read)
data ItemLocation
= InInv {_ipCrID :: Int, _ipInvID :: Int}
| OnFloor {_ipFlID :: Int}
| VoidItm
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON ItemPos where
toEncoding = genericToEncoding defaultOptions
instance FromJSON ItemPos
deriving (Eq, Show, Read)
makeLenses ''ItemDimension
makeLenses ''ItemPortage
makeLenses ''ItemValue
makeLenses ''ItemPos
makeLenses ''ItemLocation
deriveJSON defaultOptions ''ItemDimension
deriveJSON defaultOptions ''ItemPortage
deriveJSON defaultOptions ''ItemValue
deriveJSON defaultOptions ''ItemValueType
deriveJSON defaultOptions ''ItemLocation
+9 -9
View File
@@ -13,6 +13,12 @@ import Geometry.Data
data ItemParams
= NoParams
| MagShieldParams
{_magShieldMgMIX :: Maybe Int}
| ShrinkGunParams
{_shrinkGunStatus :: ShrinkGunStatus}
| FlatShieldParams
{_flatShieldWlMIX :: Maybe Int}
| ShellLauncher
{ _shellSpinDrag :: Int
, _shellSpinAmount :: Int
@@ -62,13 +68,12 @@ data ItemParams
| BoostPropIX {_boostPropIX :: Maybe Int}
deriving (Eq, Ord, Show, Read)
data ShrinkGunStatus = FullSize | Shrunk
deriving (Eq, Ord, Show, Read)
data PreviousArcEffect = NoPreviousArcEffect | PerturbTillBreakPreviousArc
deriving (Eq, Ord, Show, Read)
data GunBarrels
= MultiBarrel
{ _brlSpread :: BarrelSpread
@@ -82,8 +87,6 @@ data GunBarrels
| SingleBarrel {_brlInaccuracy :: Float}
deriving (Eq, Ord, Show, Read)
data Nozzle = Nozzle
{ _nzPressure :: Float
, _nzDir :: Float
@@ -94,21 +97,18 @@ data Nozzle = Nozzle
}
deriving (Eq, Ord, Show, Read)
data BarrelSpread
= AlignedBarrels
| SpreadBarrels {_spreadAngle :: Float}
| RotatingBarrels {_rotatingBarrelInaccuracy :: Float}
deriving (Eq, Ord, Show, Read)
makeLenses ''BarrelSpread
makeLenses ''ItemParams
makeLenses ''Nozzle
makeLenses ''GunBarrels
deriveJSON defaultOptions ''ItemParams
deriveJSON defaultOptions ''ShrinkGunStatus
deriveJSON defaultOptions ''PreviousArcEffect
deriveJSON defaultOptions ''GunBarrels
deriveJSON defaultOptions ''Nozzle
@@ -1,23 +1,13 @@
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.Item.Attachment where
module Dodge.Data.Item.Scope where
import Control.Lens
import Data.Aeson
import Data.Aeson.TH
import Geometry.Data
data ItAttachment
= AttachFuse {_atFuseTime :: Int}
| AttachTargetPos {_atTargetPos :: Point2}
| AttachInt {_atInt :: Int}
| AttachMInt {_atMInt :: Maybe Int}
| AttachFloat {_atFloat :: Float}
| AttachBool {_atBool :: Bool}
| NoItAttachment
deriving (Eq, Ord, Show, Read)
data Scope
= NoScope
| RemoteScope
@@ -36,9 +26,7 @@ data Scope
, -- | if the camera offset is also the center of vision
_scopeIsCamera :: Bool
}
deriving (Eq, Ord, Show, Read)
deriving (Eq, Show, Read)
makeLenses ''ItAttachment
makeLenses ''Scope
deriveJSON defaultOptions ''ItAttachment
deriveJSON defaultOptions ''Scope
+21 -21
View File
@@ -1,37 +1,37 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.Item.Tweak where
import GHC.Generics
import Data.Aeson
import Control.Lens
import Data.Aeson
import Data.Aeson.TH
import qualified IntMapHelp as IM
data ItemTweaks
= NoTweaks
| Tweakable
{ _tweakParams :: IM.IntMap TweakParam
}
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON ItemTweaks where
toEncoding = genericToEncoding defaultOptions
instance FromJSON ItemTweaks
data TweakType = TweakPhaseV
deriving (Eq, Show, Read)
data TweakType
= TweakPhaseV
| TweakTractionPower
| TweakSpinDrag
| TweakSpinAmount
| TweakThrustDelay
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON TweakType where
toEncoding = genericToEncoding defaultOptions
instance FromJSON TweakType
deriving (Eq, Show, Read)
data TweakParam = TweakParam
{ _tweakType :: TweakType -- Int -> Item -> Item
, _tweakVal :: Int
, _tweakMax :: Int
}
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON TweakParam where
toEncoding = genericToEncoding defaultOptions
instance FromJSON TweakParam
{ _tweakType :: TweakType -- Int -> Item -> Item
, _tweakVal :: Int
, _tweakMax :: Int
}
deriving (Eq, Show, Read)
makeLenses ''TweakParam
makeLenses ''ItemTweaks
deriveJSON defaultOptions ''ItemTweaks
deriveJSON defaultOptions ''TweakType
deriveJSON defaultOptions ''TweakParam
+19 -19
View File
@@ -1,30 +1,30 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.Magnet where
import GHC.Generics
import Data.Aeson
import Geometry.Data
import Control.Lens
import Data.Aeson
import Data.Aeson.TH
import Geometry.Data
newtype MagnetUpdate = MagnetUpdateTimer Int
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON MagnetUpdate where
toEncoding = genericToEncoding defaultOptions
instance FromJSON MagnetUpdate
data MagnetBuBu = MagnetBuId
deriving (Eq, Ord, Show, Read)
data MagnetBuBu
= MagnetBuId
| MagnetBuBuCurveAroundField Float Float
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON MagnetBuBu where
toEncoding = genericToEncoding defaultOptions
instance FromJSON MagnetBuBu
deriving (Eq, Ord, Show, Read)
data Magnet = Magnet
{ _mgID :: Int
, _mgUpdate :: MagnetUpdate
, _mgPos :: Point2
, _mgField :: MagnetBuBu
, _mgField :: MagnetBuBu
}
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON Magnet where
toEncoding = genericToEncoding defaultOptions
instance FromJSON Magnet
deriving (Eq, Ord, Show, Read)
makeLenses ''Magnet
deriveJSON defaultOptions ''MagnetUpdate
deriveJSON defaultOptions ''MagnetBuBu
deriveJSON defaultOptions ''Magnet
+75 -66
View File
@@ -1,93 +1,102 @@
{- |
Module : Dodge.Default
Description : Instances of data structures
Description : Instances of data structures
This module contains prototypical data structures.
-}
module Dodge.Default
( module Dodge.Default
, module Dodge.Default.Item
, module Dodge.Default.LightSource
, module Dodge.Default.Weapon
, module Dodge.Default.Wall
, module Dodge.Default.Creature
, module Dodge.Default.Terminal
) where
module Dodge.Default (
module Dodge.Default,
module Dodge.Default.Item,
module Dodge.Default.LightSource,
module Dodge.Default.Weapon,
module Dodge.Default.Wall,
module Dodge.Default.Creature,
module Dodge.Default.Terminal,
) where
import Control.Lens
import Dodge.Data
import Dodge.Default.Creature
import Dodge.Default.Item
import Dodge.Default.LightSource
import Dodge.Default.Terminal
import Dodge.Default.Wall
import Dodge.Default.Creature
import Dodge.Default.Weapon
import Dodge.Default.LightSource
import Dodge.Default.Item
import Dodge.Data
import Dodge.SoundLogic
import Geometry
import Picture
import Control.Lens
defaultEquipment :: Item
defaultEquipment = defaultItem
{ _itInvColor = yellow
, _itUse = EquipUse defaultEquip
, _itAttachment = NoItAttachment
}
defaultEquipment =
defaultItem
& itInvColor .~ yellow
& itUse .~ EquipUse defaultEquip
defaultItZoom :: ItZoom
defaultItZoom = ItZoom 20 0.2 1
defaultConsumable :: Item
defaultConsumable = defaultItem
& itUse .~ ConsumeUse CDoNothing 1
& itInvColor .~ blue
defaultConsumable =
defaultItem
& itUse .~ ConsumeUse CDoNothing 1
& itInvColor .~ blue
defaultFlIt :: FloorItem
defaultFlIt = FlIt {_flItRot=0,_flIt = defaultConsumable, _flItPos = V2 0 0, _flItID = 0}
defaultFlIt = FlIt{_flItRot = 0, _flIt = defaultConsumable, _flItPos = V2 0 0, _flItID = 0}
defaultMachine :: Machine
defaultMachine = Machine
{ _mcID = 0
, _mcWallIDs = mempty
, _mcDraw = MachineDrawMempty
, _mcColor = white
, _mcPos = V2 0 0
, _mcDir = 0
, _mcHP = 1000
, _mcSensor = NoSensor
, _mcMaterial = Electronics
, _mcDamage = []
, _mcType = StaticMachine
, _mcName = ""
, _mcMounts = mempty
, _mcCloseSound = Nothing
}
defaultMachine =
Machine
{ _mcID = 0
, _mcWallIDs = mempty
, _mcDraw = MachineDrawMempty
, _mcColor = white
, _mcPos = V2 0 0
, _mcDir = 0
, _mcHP = 1000
, _mcSensor = NoSensor
, _mcMaterial = Electronics
, _mcDamage = []
, _mcType = StaticMachine
, _mcName = ""
, _mcMounts = mempty
, _mcCloseSound = Nothing
}
defaultButton :: Button
defaultButton = Button
{ _btPict = DefaultDrawButton (dark red)
, _btPos = V2 0 0
, _btRot = 0
, _btEvent = ButtonPress BtNoLabel ButtonDoNothing click1S NoWorldEffect
, _btID = 0
, _btText = "Button"
, _btState = BtOff
, _btTermMID = Nothing
, _btName = ""
, _btColor = red
}
defaultButton =
Button
{ _btPict = DefaultDrawButton (dark red)
, _btPos = V2 0 0
, _btRot = 0
, _btEvent = ButtonPress BtNoLabel ButtonDoNothing click1S NoWorldEffect
, _btID = 0
, _btText = "Button"
, _btState = BtOff
, _btTermMID = Nothing
, _btName = ""
, _btColor = red
}
defaultPP :: PressPlate
defaultPP = PressPlate
{ _ppPict = setDepth 1 . color (dim . dim $ bright blue) $ circleSolid 5
, _ppPos = V2 0 0
, _ppRot = 0
, _ppEvent = PressPlateId
, _ppID = -1
, _ppText = "Pressure plate"
}
defaultPP =
PressPlate
{ _ppPict = setDepth 1 . color (dim . dim $ bright blue) $ circleSolid 5
, _ppPos = V2 0 0
, _ppRot = 0
, _ppEvent = PressPlateId
, _ppID = -1
, _ppText = "Pressure plate"
}
upHammer :: HammerType
upHammer = HasHammer HammerUp
defaultProximitySensor :: Sensor
defaultProximitySensor = ProximitySensor
{ _proxStatus = NotClose
, _proxDist = 40
, _proxRequirement = RequireImpossible
, _sensToggle = False
}
defaultProximitySensor =
ProximitySensor
{ _proxStatus = NotClose
, _proxDist = 40
, _proxRequirement = RequireImpossible
, _sensToggle = False
}
+13 -3
View File
@@ -1,5 +1,6 @@
module Dodge.Default.Item (
defaultItem,
defaultItEffect,
) where
import Dodge.Data.Item
@@ -12,12 +13,12 @@ defaultItem =
{ _itCurseStatus = Uncursed
, _itType = defaultItemType
, -- , _itEquipPict = \_ _ -> (,) emptySH blank
_itEffect = NoItEffect
_itEffect = defaultItEffect
, _itID = Nothing
, _itIsHeld = False
, _itInvColor = yellow
, _itInvSize = 1
, _itPos = VoidItm
, _itLocation = VoidItm
, _itDimension = ItemDimension 2 0 (V3 10 (-5) 3)
, _itUse = CraftUse (ItAmount 1)
, _itParams = NoParams
@@ -25,7 +26,16 @@ defaultItem =
, _itScope = NoScope
, _itTargeting = NoTargeting
, _itValue = ItemValue 0 MundaneItem
, _itAttachment = NoItAttachment
}
defaultItEffect :: ItEffect
defaultItEffect =
ItEffect
{ _ieInv = NoInvEffect
, _ieOnInsert = NoInvEffect
, _ieOnDrop = NoInvEffect
, _ieOnHeld = NoInvEffect
, _ieOnStash = NoInvEffect
}
defaultItemType :: ItemType
+1 -1
View File
@@ -47,7 +47,7 @@ defaultCWorld = CWorld
, _clZoning = mempty
, _gusts = IM.empty
, _gsZoning = mempty --Zoning IM.empty clZoneSize (zonePos _guPos)
, _itemPositions = IM.empty
, _itemLocations = IM.empty
, _props = IM.empty
, _projectiles = IM.empty
, _instantBullets = []
+117 -3
View File
@@ -1,9 +1,22 @@
module Dodge.Euse where
import Dodge.LightSource
import Dodge.Item.HeldOffset
import Dodge.Wall.Create
import Color
import Dodge.Default.Wall
import Dodge.Creature.Test
import Dodge.Creature.HandPos
import Geometry
import Dodge.Wall.Move
import Dodge.Wall.Delete
import Dodge.Wall.ForceField
import Dodge.Item.Location
import Dodge.Data
import Dodge.Item.Weapon.ExtraEffect
import Dodge.Item.Weapon.Radar
import Dodge.SoundLogic.ExternallyGeneratedSounds
import Dodge.Item.Equipment
import qualified IntMapHelp as IM
import LensHelp
useE :: Euse -> Item -> Creature -> World -> World
@@ -14,7 +27,108 @@ useE eo = case eo of
EWristShield -> setWristShieldPos
EHeadLamp -> createHeadLamp
ECamouflage vis -> overCID (crCamouflage .~ vis)
EonWristShield -> onEquipWristShield
EoffWristShield -> onRemoveWristShield
useMagShield :: Item -> Creature -> World -> World
useMagShield it cr w = w & cWorld . magnets . at mgid ?~ themagnet
where
themagnet =
Magnet
{ _mgID = mgid
, _mgUpdate = MagnetUpdateTimer 1
, _mgPos = _crPos cr
, _mgField = MagnetBuBuCurveAroundField 50 200
}
mgid = case it ^? itParams . magShieldMgMIX . _Just of
Just mgid' -> mgid'
Nothing -> IM.newKey $ _magnets (_cWorld w)
onEquipWristShield :: Item -> Creature -> World -> World
onEquipWristShield itm cr w =
w
& pointerToItem itm . itUse . eqEq . eqParams .~ EquipID i
& cWorld . walls . at i ?~ forceField{_wlID = i}
& setWristShieldPos (itm & itUse . eqEq . eqParams .~ EquipID i) cr
where
i = IM.newKey (_walls (_cWorld w))
onRemoveWristShield :: Item -> Creature -> World -> World
onRemoveWristShield itm _ =
(pointerToItem itm . itUse . eqEq . eqParams .~ NoEquipParams) . deleteWallID i
where
i = _eparamID $ _eqParams $ _eqEq $ _itUse itm
setWristShieldPos :: Item -> Creature -> World -> World
setWristShieldPos itm cr w =
w
& moveWallIDUnsafe i wlline
where
i = _eparamID $ _eqParams $ _eqEq $ _itUse itm
wlline = (f (V3 (-10) 7 0), f (V3 10 7 0))
invid = _ipInvID (_itLocation itm)
handtrans = case cr ^? crInvEquipped . ix invid of
Just OnLeftWrist -> \cr' -> translatePointToLeftHand cr' . g
_ -> translatePointToRightHand
g
| twists cr = (+.+.+ V3 (-5) 10 0)
| otherwise = id
f = (+.+ _crPos cr) . stripZ . rotate3 (_crDir cr) . handtrans cr
shieldWall :: Int -> Wall
shieldWall crid =
defaultWall
{ _wlColor = yellow
, _wlOpacity = SeeAbove
, _wlPathable = True
, _wlWalkable = True
, _wlFireThrough = True
, _wlReflect = True
, _wlUnshadowed = False
, _wlRotateTo = False
, _wlStructure = CreaturePart crid -- shieldWallDamage
}
-- TODO the reflection should be controled by the particle
--shieldWallDamage :: Damage -> Wall -> Int -> World -> World
--shieldWallDamage dm _ crid w = case _dmType dm of
---- Lasering -> w
-- _ | isMovementDam dm -> w & creatures . ix crid . crState . crDamage .:~ dm
-- _ -> w
createShieldWall :: Item -> Creature -> World -> World
createShieldWall it cr w = case it ^? itParams . flatShieldWlMIX . _Just of
Nothing ->
let (wlid, w') = createWall ((shieldWall crid){_wlLine = wlline, _wlID = wlid}) w
in w' & pointerToItem it . itParams .~ FlatShieldParams (Just wlid)
Just wid -> moveWallID wid wlline w
where
crid = _crID cr
wlline = (a, b)
crdirv = unitVectorAtAngle $ _crDir cr
crpos = _crPos cr
rad = _crRad cr + 2
a = crpos +.+ rad *.* crdirv -.- 10 *.* therot crdirv
b = crpos +.+ rad *.* crdirv +.+ 10 *.* therot crdirv
therot
| crIsAiming cr = vNormal
| otherwise = rotateV (twoFlatHRot cr) . vNormal
removeShieldWall :: Item -> Creature -> World -> World
removeShieldWall it _ w = case it ^? itParams . flatShieldWlMIX . _Just of
Nothing -> w
Just wid ->
w & deleteWallID wid
& pointerToItem it . itParams . flatShieldWlMIX .~ Nothing
createHeadLamp :: Item -> Creature -> World -> World
createHeadLamp _ cr =
cWorld . tempLightSources
.:~ tlsTimeRadColPos
1
200
0.7
((_crPos cr `v2z` 0) +.+.+ rotate3 (_crDir cr) (translatePointToHead cr (V3 5 0 3)))
overCID :: (Creature -> Creature) -> Item -> Creature -> World -> World
overCID f _ cr = cWorld . creatures . ix (_crID cr) %~ f
+1 -1
View File
@@ -24,7 +24,7 @@ copyItemToFloorID pos it w = (,) flid $ w'
(p',w') = findWallFreeDropPoint (_dimRad $ _itDimension it) pos w
rot = fst . randomR (-pi,pi) $ _randGen w
updateLocation = case it ^? itID of
Just (Just i') -> cWorld . itemPositions . ix i' .~ OnFloor flid
Just (Just i') -> cWorld . itemLocations . ix i' .~ OnFloor flid
_ -> id
flid = IM.newKey $ _floorItems (_cWorld w)
theflit = FlIt
+2 -2
View File
@@ -76,8 +76,8 @@ rmInvItem cid invid w = case w ^? cWorld . creatures . ix cid . crInv . ix invid
rmf <- itm ^? itUse . eqEq . eqOnRemove
return $ useE rmf itm cr
doanyitemeffect = fromMaybe id $ do
rmf <- itm ^? itEffect . ieDrop
return $ doDropEffect rmf itm cr
rmf <- itm ^? itEffect . ieOnDrop
return $ doInvEffect rmf itm cr
removeAnySlotEquipment = case w ^? cWorld . creatures . ix cid . crInvEquipped . ix invid of
Just epos -> cWorld . creatures . ix cid . crEquipment . at epos .~ Nothing
Nothing -> id
+1 -1
View File
@@ -31,7 +31,7 @@ tryPutItemInInv cid flit w = case maybeInvSlot of
maybeInvSlot = checkInvSlotsYou it w
updateItLocation invid w' = case _itID it of
Nothing -> w'
Just j -> w' & cWorld . itemPositions . ix j .~ InInv cid invid
Just j -> w' & cWorld . itemLocations . ix j .~ InInv cid invid
--{- | Pick up a specific item. -}
--putItemInInv :: Int -> FloorItem -> World -> World
+14 -17
View File
@@ -1,6 +1,7 @@
module Dodge.ItEffect where
import Dodge.Euse
import Dodge.Data
import Dodge.Item.Equipment
import Dodge.LightSource.Torch
import Control.Lens
@@ -8,25 +9,21 @@ doInvEffect :: ItInvEffect -> Item -> Creature -> World -> World
doInvEffect iie = case iie of
NoInvEffect -> const $ const id
RewindEffect -> rewindEffect
ResetAttachmentEffect -> resetAttachmentEffect
OnOffHeldEffect f g -> onOffEff f g
-- ResetAttachmentEffect -> resetAttachmentEffect
EffectIfHeld f g -> onOffEff f g
CreateHeldLight -> createHeldLight
CreateShieldWall -> createShieldWall
RemoveShieldWall -> removeShieldWall
EffectWhileHeld f -> onOffEff f NoInvEffect
doFloorEffect :: ItFloorEffect -> Int -> World -> World
doFloorEffect NoFloorEffect = const id
doDropEffect :: ItDropEffect -> Item -> Creature -> World -> World
doDropEffect iie = case iie of
NoDropEffect -> const $ const id
onOffEff :: ItInvEffect -> ItInvEffect -> Item -> Creature -> World -> World
onOffEff f g it
| _itIsHeld it = doInvEffect f it
| otherwise = doInvEffect g it
rewindEffect :: Item -> Creature -> World -> World
rewindEffect itm cr w
| Just invid == _crLeftInvSel cr = w & cWorld . rewindWorlds %~ (take maxcharge . (cw : ))
@@ -34,20 +31,20 @@ rewindEffect itm cr w
| otherwise = w & cWorld . rewindWorlds .~ []
& ptrWpCharge .~ 0
where
invid = _ipInvID $ _itPos itm
invid = _ipInvID $ _itLocation itm
ptrWpCharge = cWorld . creatures . ix (_crID cr) . crInv . ix invid . itUse . leftConsumption . wpCharge
maxcharge = itm ^?! itUse . leftConsumption . wpMaxCharge
cw = _cWorld w
& rewindWorlds .~ []
resetAttachmentEffect :: Item -> Creature -> World -> World
resetAttachmentEffect itm cr w
| _ieCounter iteff < 0 = w & pointToIt . itAttachment .~ NoItAttachment
| otherwise = w & pointToIt . itEffect . ieCounter -~ 1
where
iteff = _itEffect itm
invid = _ipInvID $ _itPos itm
pointToIt = cWorld . creatures . ix (_crID cr) . crInv . ix invid
--resetAttachmentEffect :: Item -> Creature -> World -> World
--resetAttachmentEffect itm cr w
-- | _ieCounter iteff < 0 = w & pointToIt . itAttachment .~ NoItAttachment
-- | otherwise = w & pointToIt . itEffect . ieCounter -~ 1
-- where
-- iteff = _itEffect itm
-- invid = _ipInvID $ _itLocation itm
-- pointToIt = cWorld . creatures . ix (_crID cr) . crInv . ix invid
createHeldLight :: Item -> Creature -> World -> World
createHeldLight itm cr = createTorchLightOffset cr itm 0
+80 -89
View File
@@ -1,19 +1,21 @@
module Dodge.Item
( module Dodge.Item.Weapon
, module Dodge.Item.Consumable
, module Dodge.Item.Equipment
, module Dodge.Item.PassKey
, module Dodge.Item.Craftable
, itemFromBase
) where
import Dodge.Data
import Dodge.Item.Weapon
import Dodge.Item.Equipment
import Dodge.Item.Consumable
import Dodge.Item.PassKey
import Dodge.Item.Craftable
module Dodge.Item (
module Dodge.Item.Weapon,
module Dodge.Item.Held,
module Dodge.Item.Consumable,
module Dodge.Item.Equipment,
module Dodge.Item.PassKey,
module Dodge.Item.Craftable,
itemFromBase,
) where
import Dodge.Data
import Dodge.Item.Consumable
import Dodge.Item.Craftable
import Dodge.Item.Equipment
import Dodge.Item.Held
import Dodge.Item.PassKey
import Dodge.Item.Weapon
-- this is not ideal, should fold the itemtype into a stackable/unstackable type
itemFromBase :: ItemBaseType -> Item
itemFromBase ibt = case ibt of
HELD ht -> itemFromHeldType ht
@@ -21,94 +23,83 @@ itemFromBase ibt = case ibt of
EQUIP et -> itemFromEquipType et
Consumable et -> itemFromConsumableType et
CRAFT cr -> makeTypeCraft cr
itemFromConsumableType :: ConsumableItemType -> Item
itemFromConsumableType ct = case ct of
MEDKIT i -> medkit i
EXPLOSIVES -> undefined
itemFromEquipType :: EquipItemType -> Item
itemFromEquipType et = case et of
MAGSHIELD -> magShield
FLAMESHIELD -> flameShield
FRONTARMOUR -> frontArmour
WRISTARMOUR -> wristArmour
FLAMESHIELD -> flameShield
FRONTARMOUR -> frontArmour
WRISTARMOUR -> wristArmour
INVISIBILITYEQUIPMENT GoesOnWrist -> wristInvisibility
INVISIBILITYEQUIPMENT _ -> error "need to define invisibility for more than wrist"
BRAINHAT -> brainHat
HAT -> hat
HEADLAMP -> headLamp
HEADLAMP1 -> headLamp1
POWERLEGS -> powerLegs
SPEEDLEGS -> speedLegs
JUMPLEGS -> jumpLegs
JETPACK -> jetPack
AUTODETECTOR d -> autoDetector d
BRAINHAT -> brainHat
HAT -> hat
HEADLAMP -> headLamp
POWERLEGS -> powerLegs
SPEEDLEGS -> speedLegs
JUMPLEGS -> jumpLegs
JETPACK -> jetPack
AUTODETECTOR d -> autoDetector d
itemFromLeftType :: LeftItemType -> Item
itemFromLeftType lt = case lt of
BOOSTER -> boosterGun
REWINDER -> rewindGun
BLINKER -> blinkGun
BLINKERUNSAFE -> unsafeBlinkGun
SHRINKER -> shrinkGun
SPAWNER -> error "need to datify creatures first"
-- Equipment
REWINDER -> rewindGun
BLINKER -> blinkGun
BLINKERUNSAFE -> unsafeBlinkGun
SHRINKER -> shrinkGun
SPAWNER -> error "need to datify creatures first"
-- Equipment
itemFromHeldType :: HeldItemType -> Item
itemFromHeldType ht = case ht of
KEYCARD i -> keyCard i
TORCH -> torch
SHATTERGUN -> shatterGun
TORCH -> torch
SHATTERGUN -> shatterGun
BANGSTICK i -> bangStick i
PISTOL -> pistol
REVOLVER -> revolver
REVOLVERX i -> revolverX i
MACHINEPISTOL -> machinePistol
AUTOPISTOL -> autoPistol
SMG -> smg
BANGCONE -> bangCone
BLUNDERBUSS -> blunderbuss
GRAPECANNON i -> grapeCannon i
--GRENADELAUNCHER Int -- number of chambers that can be reloaded
-- --| MORTARCONE / HANDMORTAR
MINIGUNX i -> miniGunX i
VOLLEYGUN i -> volleyGun i
RIFLE -> rifle
REPEATER -> repeater
AUTORIFLE -> autoRifle
BURSTRIFLE -> burstRifle
-- FASTBURSTRIFLE -> fastBurstRifle
-- COMPLETEBURSTRIFLE -> completeBurstRifle
BANGROD -> bangRod
ELEPHANTGUN -> elephantGun
AMR -> amr
AUTOAMR -> autoAmr
SNIPERRIFLE -> sniperRifle
MACHINEGUN -> machineGun
FLAMESPITTER -> flameSpitter
FLAMETHROWER -> flameThrower
FLAMETORRENT -> flameTorrent
FLAMEWALL -> flameWall
BLOWTORCH -> blowTorch
-- SPREADGUN -> spreadGun
-- MULTGUN -> multGun
SPARKGUN -> sparkGun
TESLAGUN -> teslaGun
LASGUN -> lasGun
LASCIRCLE -> lasCircle
--LASPULSE -> lasPulse
DUALBEAM -> dualBeam
--LASGUNSWING -> lasSwing
--LASGUNSWAY -> lasSway
-- LASGUNWIDEPULSE -> lasWidePulse
LASWIDE i -> lasWide i
--LASGUNFOCUS i -> lasFocus i
-- SONICGUN -> sonicGun
TRACTORGUN -> tractorGun
LAUNCHER -> launcher
LAUNCHERX i -> launcherX i
-- --| TRACKINGLAUNCHER
PISTOL -> pistol
REVOLVER -> revolver
REVOLVERX i -> revolverX i
MACHINEPISTOL -> machinePistol
AUTOPISTOL -> autoPistol
SMG -> smg
BANGCONE -> bangCone
BLUNDERBUSS -> blunderbuss
GRAPECANNON i -> grapeCannon i
MINIGUNX i -> miniGunX i
VOLLEYGUN i -> volleyGun i
RIFLE -> rifle
REPEATER -> repeater
AUTORIFLE -> autoRifle
BURSTRIFLE -> burstRifle
BANGROD -> bangRod
ELEPHANTGUN -> elephantGun
AMR -> amr
AUTOAMR -> autoAmr
SNIPERRIFLE -> sniperRifle
MACHINEGUN -> machineGun
FLAMESPITTER -> flameSpitter
FLAMETHROWER -> flameThrower
FLAMETORRENT -> flameTorrent
FLAMEWALL -> flameWall
BLOWTORCH -> blowTorch
SPARKGUN -> sparkGun
TESLAGUN -> teslaGun
LASGUN -> lasGun
LASCIRCLE -> lasCircle
DUALBEAM -> dualBeam
LASWIDE i -> lasWide i
TRACTORGUN -> tractorGun
LAUNCHER -> launcher
LAUNCHERX i -> launcherX i
REMOTELAUNCHER -> remoteLauncher
POISONSPRAYER -> poisonSprayer
DRONELAUNCHER -> droneLauncher
FORCEFIELDGUN -> forceFieldGun
POISONSPRAYER -> poisonSprayer
DRONELAUNCHER -> droneLauncher
FORCEFIELDGUN -> forceFieldGun
HELDDETECTOR d -> clickDetector d
FLATSHIELD -> flatShield
FLATSHIELD -> flatShield
-42
View File
@@ -1,42 +0,0 @@
module Dodge.Item.Attachment
( charFiringStratI
, changeFuse
) where
import Dodge.Data
import Dodge.ChainEffect
import Dodge.Default
import Control.Lens hiding ((|>),(<|))
import Data.Sequence
import Data.Maybe
import qualified IntMapHelp as IM
charFiringStratI
:: [(Char, ChainEffect)] -- ^ Different firing effects for different characters
-> ChainEffect
charFiringStratI strats eff item cr w = case w ^? cWorld . creatures . ix cid . crInv
. ix (crSel $ _creatures (_cWorld w) IM.! cid) . itUse . heldScroll . hsCharMode of
Just (c :<| _) -> fromMaybe id (Prelude.lookup c strats) eff item cr w
_ -> w
where
cid = _crID cr
changeFuse
:: Float -- ^ Old fuse time
-> Creature -- ^ Inventory item reference (I believe)
-> Item
-> Item
changeFuse scrollAmount _ it = it
& ( itAttachment .~ AttachFuse newTime )
& ( itUse . useAim . aimZoom .~ defaultItZoom{_itZoomMax = zm, _itZoomMin = zm} )
where
oldTime = _atFuseTime $ _itAttachment it
newTime = min 90 $ max 20 $ oldTime - round (5 * scrollAmount)
zm = 50 / fromIntegral newTime
--removeItAttachment :: Int -> Int -> World -> World
--removeItAttachment i _ w = w & creatures . ix i . crInv . ix itRef . itAttachment .~ NoItAttachment
-- where
-- cr = _creatures w IM.! i
-- itRef = _crInvSel cr
+1 -1
View File
@@ -33,7 +33,7 @@ pictureWeaponAim
-> Creature
-> Item
-> SPic
pictureWeaponAim f cr itm = case _itPos itm of
pictureWeaponAim f cr itm = case _itLocation itm of
InInv _ i -> pictureWeaponOnAimItem (f itm) cr i
_ -> mempty
-1
View File
@@ -31,7 +31,6 @@ equipItemSPic et _ = case et of
BRAINHAT -> noPic (colorSH yellow $ upperPrismPoly 3 $ rectWH 4 4)
HAT -> noPic (colorSH yellow $ upperPrismPoly 3 $ rectWH 4 4)
HEADLAMP -> noPic headLampShape
HEADLAMP1 -> noPic headLampShape
POWERLEGS -> legsSPic yellow
SPEEDLEGS -> legsSPic green
JUMPLEGS -> legsSPic red
+9 -208
View File
@@ -3,283 +3,89 @@ module Dodge.Item.Equipment (
torch,
magShield,
powerLegs,
flatShield,
wristInvisibility,
wristArmour,
hat,
brainHat,
frontArmour,
headLamp,
headLamp1,
jetPack,
speedLegs,
jumpLegs,
flameShield,
useMagShield,
setWristShieldPos,
createHeadLamp,
overCID,
onEquipWristShield,
onRemoveWristShield,
createShieldWall,
removeShieldWall,
) where
import Data.Maybe
import Dodge.Creature.HandPos
import Dodge.Creature.Test
import Dodge.Data
import Dodge.Data.CamouflageStatus
import Dodge.Data.Item
import Dodge.Default
import Dodge.Item.Equipment.Booster
import Dodge.Item.HeldOffset
import Dodge.LightSource
import Dodge.Wall
import Dodge.Wall.ForceField
import Geometry
import qualified IntMapHelp as IM
import LensHelp
import Picture
magShield :: Item
magShield =
defaultEquipment
{ _itID = Nothing
, _itAttachment = AttachMInt Nothing
}
& itUse . eqEq . eqUse .~ EMagShield --useMagShield
& itParams .~ MagShieldParams Nothing
& itUse . eqEq . eqUse .~ EMagShield
& itUse . eqEq . eqSite .~ GoesOnWrist
& itType . iyBase .~ EQUIP MAGSHIELD
useMagShield :: Item -> Creature -> World -> World
useMagShield it cr w = w & cWorld . magnets . at mgid ?~ themagnet
where
themagnet =
Magnet
{ _mgID = mgid
, _mgUpdate = MagnetUpdateTimer 1
, _mgPos = _crPos cr
, _mgField = MagnetBuBuCurveAroundField 50 200
}
mgid = case it ^? itAttachment . atMInt . _Just of
Just mgid' -> mgid'
Nothing -> IM.newKey $ _magnets (_cWorld w)
-- it = _crInv cr IM.! invid
flameShield :: Item
flameShield =
defaultEquipment
{ _itID = Nothing
}
& itUse . eqEq . eqSite .~ GoesOnChest
& itType . iyBase .~ EQUIP FLAMESHIELD
-- | Slows you down, blocks forward projectiles.
frontArmour :: Item
frontArmour =
defaultEquipment
{ _itID = Nothing
}
& itUse . eqEq . eqSite .~ GoesOnChest
& itType . iyBase .~ EQUIP FRONTARMOUR
wristArmour :: Item
wristArmour =
defaultEquipment
{ _itID = Nothing
}
& itUse . eqEq . eqSite .~ GoesOnWrist
& itUse . eqEq . eqOnEquip .~ EonWristShield --onEquipWristShield
& itUse . eqEq . eqUse .~ EWristShield --setWristShieldPos
& itUse . eqEq . eqOnRemove .~ EoffWristShield --onRemoveWristShield
& itUse . eqEq . eqOnEquip .~ EonWristShield
& itUse . eqEq . eqUse .~ EWristShield
& itUse . eqEq . eqOnRemove .~ EoffWristShield
& itType . iyBase .~ EQUIP WRISTARMOUR
onEquipWristShield :: Item -> Creature -> World -> World
onEquipWristShield itm cr w =
w
& cWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID (_itPos itm)) . itUse . eqEq . eqParams .~ EquipID i
& cWorld . walls . at i ?~ forceField{_wlID = i}
& setWristShieldPos (itm & itUse . eqEq . eqParams .~ EquipID i) cr
where
i = IM.newKey (_walls (_cWorld w))
onRemoveWristShield :: Item -> Creature -> World -> World
onRemoveWristShield itm cr w =
w
& cWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID (_itPos itm)) . itUse . eqEq . eqParams .~ NoEquipParams
& deleteWallID i
where
i = _eparamID $ _eqParams $ _eqEq $ _itUse itm
setWristShieldPos :: Item -> Creature -> World -> World
setWristShieldPos itm cr w =
w
& moveWallIDUnsafe i wlline
where
i = _eparamID $ _eqParams $ _eqEq $ _itUse itm
wlline = (f (V3 (-10) 7 0), f (V3 10 7 0))
invid = _ipInvID (_itPos itm)
--wlline = (V2 10 0, V2 (-10) 100)
handtrans = case cr ^? crInvEquipped . ix invid of
Just OnLeftWrist -> \cr' -> translatePointToLeftHand cr' . g
_ -> translatePointToRightHand
g
| twists cr = (+.+.+ V3 (-5) 10 0)
| otherwise = id
f = (+.+ _crPos cr) . stripZ . rotate3 (_crDir cr) . handtrans cr
torch :: Item
torch =
defaultWeapon
& itEffect .~ effectOnOffHeld CreateHeldLight NoInvEffect -- createHeldLight (const $ const id)
& itEffect . ieInv .~ EffectWhileHeld CreateHeldLight
& itType . iyBase .~ HELD TORCH
& itUse . useAim . aimHandlePos .~ 5
& itUse . useAim . aimMuzPos .~ 10
flatShield :: Item
flatShield =
defaultWeapon
& itEffect .~ effectOnOffHeld CreateShieldWall RemoveShieldWall
& itUse
.~ defaultrUse
{ _useAim =
AimParams
{ _aimWeight = 5
, _aimRange = 0
, _aimZoom = ItZoom 20 0.2 1
, _aimStance = TwoHandFlat
, _aimHandlePos = 0
, _aimMuzPos = 0
}
}
& itInvSize .~ 3
& itType . iyBase .~ HELD FLATSHIELD
shieldWall :: Int -> Wall
shieldWall crid =
defaultWall
{ _wlColor = yellow
, _wlOpacity = SeeAbove
, _wlPathable = True
, _wlWalkable = True
, _wlFireThrough = True
, _wlReflect = True
, _wlUnshadowed = False
, _wlRotateTo = False
, _wlStructure = CreaturePart crid -- shieldWallDamage
}
-- TODO the reflection should be controled by the particle
--shieldWallDamage :: Damage -> Wall -> Int -> World -> World
--shieldWallDamage dm _ crid w = case _dmType dm of
---- Lasering -> w
-- _ | isMovementDam dm -> w & creatures . ix crid . crState . crDamage .:~ dm
-- _ -> w
createShieldWall :: Item -> Creature -> World -> World
createShieldWall it cr w = case it ^? itEffect . ieMID . _Just of
Nothing ->
let (wlid, w') = createWall ((shieldWall crid){_wlLine = wlline, _wlID = wlid}) w
in w' & cWorld . creatures . ix crid . crInv . ix invid . itEffect . ieMID ?~ wlid
Just wid -> moveWallID wid wlline w
where
invid = fromJust $ _itID it
crid = _crID cr
wlline = (a, b)
crdirv = unitVectorAtAngle $ _crDir cr
crpos = _crPos cr
rad = _crRad cr + 2
a = crpos +.+ rad *.* crdirv -.- 10 *.* therot crdirv
b = crpos +.+ rad *.* crdirv +.+ 10 *.* therot crdirv
therot
| crIsAiming cr = vNormal
| otherwise = rotateV (twoFlatHRot cr) . vNormal
removeShieldWall :: Item -> Creature -> World -> World
removeShieldWall it cr w = case _ieMID $ _itEffect it of
Nothing -> w
Just wid ->
w & deleteWallID wid
& cWorld . creatures . ix crid . crInv . ix invid . itEffect . ieMID .~ Nothing
where
crid = _crID cr
invid = fromJust (_itID it)
effectOnOffHeld ::
-- | effect when held
ItInvEffect ->
-- | effect when not held
ItInvEffect ->
ItEffect
effectOnOffHeld f f' =
ItInvEffectID
{ _ieInv = OnOffHeldEffect f f'
, _ieMID = Nothing
}
-- | Increases speed, reduces friction, cannot only move forwards.
jetPack :: Item
jetPack =
defaultEquipment
{ _itEffect = NoItEffect
, _itID = Nothing
}
& itUse . eqEq . eqSite .~ GoesOnBack
& itType . iyBase .~ EQUIP JETPACK
brainHat :: Item
brainHat =
defaultEquipment
{ _itEffect = NoItEffect
, _itID = Nothing
}
& itUse . eqEq . eqSite .~ GoesOnHead
& itType . iyBase .~ EQUIP BRAINHAT
hat :: Item
hat =
defaultEquipment
{ _itEffect = NoItEffect
, _itID = Nothing
}
& itUse . eqEq . eqSite .~ GoesOnHead
& itType . iyBase .~ EQUIP HAT
headLamp1 :: Item
headLamp1 =
defaultEquipment
{ _itEffect = NoItEffect
, _itID = Nothing
}
& itUse . eqEq . eqUse .~ EHeadLamp --createHeadLamp
& itUse . eqEq . eqSite .~ GoesOnHead
& itType . iyBase .~ EQUIP HEADLAMP1
headLamp :: Item
headLamp =
defaultEquipment
{ _itEffect = NoItEffect
, _itID = Nothing
}
& itUse . eqEq . eqUse .~ EHeadLamp --createHeadLamp
& itUse . eqEq . eqUse .~ EHeadLamp
& itUse . eqEq . eqSite .~ GoesOnHead
& itType . iyBase .~ EQUIP HEADLAMP
createHeadLamp :: Item -> Creature -> World -> World
createHeadLamp _ cr =
cWorld . tempLightSources
.:~ tlsTimeRadColPos
1
200
0.7
((_crPos cr `v2z` 0) +.+.+ rotate3 (_crDir cr) (translatePointToHead cr (V3 5 0 3)))
powerLegs :: Item
powerLegs =
defaultEquipment
{ _itEffect = NoItEffect
, _itID = Nothing
}
& itUse . eqEq . eqSite .~ GoesOnLegs
& itType . iyBase .~ EQUIP POWERLEGS
@@ -296,12 +102,7 @@ jumpLegs =
wristInvisibility :: Item
wristInvisibility =
defaultEquipment
{ _itID = Nothing
}
& itUse . eqEq . eqSite .~ GoesOnWrist
& itUse . eqEq . eqOnEquip .~ ECamouflage Invisible --overCID (crCamouflage .~ Invisible)
& itUse . eqEq . eqOnRemove .~ ECamouflage FullyVisible --overCID (crCamouflage .~ FullyVisible)
& itType . iyBase .~ EQUIP (INVISIBILITYEQUIPMENT GoesOnWrist)
overCID :: (Creature -> Creature) -> Item -> Creature -> World -> World
overCID f _ cr = cWorld . creatures . ix (_crID cr) %~ f
+3 -3
View File
@@ -12,9 +12,9 @@ boosterGun =
defaultLeftItem
{ _itInvColor = cyan
, _itUse = luseInstantNoH LBoost
, _itEffect = resetAttachmentID
-- , _itEffect = resetAttachmentID
}
& itType . iyBase .~ LEFT BOOSTER
resetAttachmentID :: ItEffect
resetAttachmentID = ItInvEffect ResetAttachmentEffect 0
--resetAttachmentID :: ItEffect
--resetAttachmentID = ItInvEffect ResetAttachmentEffect 0
+1 -1
View File
@@ -8,7 +8,7 @@ import Data.Maybe
pictureOnEquip :: SPic -> Creature -> Item -> SPic
pictureOnEquip sp cr itm = fromMaybe mempty $ do
i <- itm ^? itPos . ipInvID
i <- itm ^? itLocation . ipInvID
epos <- cr^? crInvEquipped . ix i
return $ equipPosition epos cr sp
+24
View File
@@ -0,0 +1,24 @@
module Dodge.Item.Held
where
import Dodge.Default.Weapon
import Dodge.Data.Item
import Control.Lens
flatShield :: Item
flatShield =
defaultWeapon
& itEffect . ieInv .~ EffectIfHeld CreateShieldWall RemoveShieldWall
& itUse
.~ defaultrUse
{ _useAim =
AimParams
{ _aimWeight = 5
, _aimRange = 0
, _aimZoom = ItZoom 20 0.2 1
, _aimStance = TwoHandFlat
, _aimHandlePos = 0
, _aimMuzPos = 0
}
}
& itInvSize .~ 3
& itType . iyBase .~ HELD FLATSHIELD
+11 -7
View File
@@ -12,26 +12,30 @@ getHeldItemLoc :: Creature -> World -> (World,Int)
getHeldItemLoc cr w = case maybeitid of
Nothing ->
( w & cWorld . creatures . ix cid . crInv . ix j . itID ?~ newitid
& cWorld . itemPositions %~ IM.insert newitid (InInv cid j)
& cWorld . itemLocations %~ IM.insert newitid (InInv cid j)
, itid)
_ -> (w, itid)
where
cid = _crID cr
j = crSel cr
newitid = IM.newKey $ _itemPositions (_cWorld w)
newitid = IM.newKey $ _itemLocations (_cWorld w)
maybeitid = cr ^? crInv . ix j . itID . _Just
itid = fromMaybe newitid maybeitid
getItem :: Int -> World -> Maybe Item
getItem itid w = do
itpos <- w ^? cWorld . itemPositions . ix itid
itpos <- w ^? cWorld . itemLocations . ix itid
case itpos of
OnFloor flitid -> w ^? cWorld . floorItems . ix flitid . flIt
InInv cid invid -> w ^? cWorld . creatures . ix cid . crInv . ix invid
VoidItm -> Nothing
pointerToItemLocation :: Applicative f =>
ItemLocation -> (Item -> f Item) -> World -> f World
pointerToItemLocation (InInv cid invid) = cWorld . creatures . ix cid . crInv . ix invid
pointerToItemLocation (OnFloor flid) = cWorld . floorItems . ix flid . flIt
pointerToItemLocation _ = const pure
pointerToItem :: Applicative f =>
ItemPos -> (Item -> f Item) -> World -> f World
pointerToItem (InInv cid invid) = cWorld . creatures . ix cid . crInv . ix invid
pointerToItem (OnFloor flid) = cWorld . floorItems . ix flid . flIt
pointerToItem _ = const pure
Item -> (Item -> f Item) -> World -> f World
pointerToItem = pointerToItemLocation . _itLocation
+2 -10
View File
@@ -5,17 +5,9 @@ import Picture
import LensHelp
keyCard :: Int -> Item
keyCard n = defaultEquipment
{ _itEffect = NoItEffect
, _itID = Nothing
-- , _itZoom = defaultItZoom
, _itInvColor = aquamarine
}
& itInvColor .~ aquamarine
& itType . iyBase .~ HELD (KEYCARD n)
latchkey :: Int -> Item
latchkey _ = defaultEquipment
{ _itEffect = NoItEffect
, _itID = Nothing
-- , _itZoom = defaultItZoom
, _itInvColor = yellow
}
& itInvColor .~ yellow
+2 -2
View File
@@ -38,11 +38,11 @@ import qualified SDL
autoEffect :: (Item -> Creature -> World -> World) -> Int -> SoundID -> Item -> Creature -> World -> World
autoEffect eff t sid itm cr w
| _eparamInt (_eqParams (_eqEq $ _itUse itm)) < 1 = eff itm cr w
& cWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID $ _itPos itm)
& cWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID $ _itLocation itm)
. itUse . eqEq . eqParams . eparamInt .~ t
& soundStart OnceSound (_crPos cr) sid Nothing
| otherwise = w
& cWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID $ _itPos itm)
& cWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID $ _itLocation itm)
. itUse . eqEq . eqParams . eparamInt -~ 1
{- | Automatically send out radar pulses that detect walls. -}
+1 -1
View File
@@ -118,5 +118,5 @@ explodeRemoteRocket itid pjid w =
& itPoint . itUse . rUse .~ HeldDoNothing
& usePayload (_prjPayload thepj) (_prjPos thepj)
where
itPoint = pointerToItem $ _itemPositions (_cWorld w) IM.! itid
itPoint = pointerToItemLocation $ _itemLocations (_cWorld w) IM.! itid
thepj = _projectiles (_cWorld w) IM.! pjid
+3 -5
View File
@@ -1,18 +1,16 @@
module Dodge.Item.Weapon.Remote
( pointerToItem
, setRemoteScope
( setRemoteScope
, setRemoteBombScope
) where
import Dodge.Data
import Dodge.Default
import Geometry
import Dodge.Item.Location
import qualified IntMapHelp as IM
import Control.Lens
setRemoteBombScope :: Int -> Prop -> World -> World
setRemoteBombScope itid pj w' = case _itemPositions (_cWorld w') IM.! itid of
setRemoteBombScope itid pj w' = case _itemLocations (_cWorld w') IM.! itid of
InInv cid invid
-> w' & cWorld . creatures . ix cid . crInv . ix invid . itScope
. scopePos .~ (_prPos pj -.- _crPos (_creatures (_cWorld w') IM.! cid))
@@ -21,7 +19,7 @@ setRemoteBombScope itid pj w' = case _itemPositions (_cWorld w') IM.! itid of
_ -> w'
setRemoteScope :: Int -> Point2 -> World -> World
setRemoteScope itid pos w' = case w' ^? cWorld . itemPositions . ix itid of
setRemoteScope itid pos w' = case w' ^? cWorld . itemLocations . ix itid of
Just (InInv cid' invid )
-> w' & cWorld . creatures . ix cid' . crInv . ix invid . itScope
. scopePos .~ (pos -.- _crPos (_creatures (_cWorld w') IM.! cid'))
+1 -1
View File
@@ -363,7 +363,7 @@ shootL f item cr w
| otherwise = w
where
cid = _crID cr
invid = _ipInvID $ _itPos item
invid = _ipInvID $ _itLocation item
pointerToItem = cWorld . creatures . ix cid . crInv . ix invid
fireCondition = _rateTime (_useDelay (_itUse item)) == 0
&& _arLoaded (_leftConsumption (_itUse item)) > 0
+4 -6
View File
@@ -18,12 +18,12 @@ rewindGun :: Item
rewindGun =
defaultLeftItem
{ _itInvColor = cyan
, _itEffect = ItRewindEffect RewindEffect -- []
, _itUse =
defaultlUse
& lUse .~ LRewind --useRewindGun
& eqEq . eqSite .~ GoesOnChest
}
& itEffect . ieInv .~ RewindEffect
& itType . iyBase .~ LEFT REWINDER
& itUse . leftConsumption
.~ ChargeableAmmo
@@ -35,10 +35,8 @@ rewindGun =
shrinkGun :: Item
shrinkGun =
defaultLeftItem
{ _itUse = defaultlUse & lUse .~ LShrink -- hammerCheckL useShrinkGun
-- , _itFloorPict = shrinkGunPic
, _itAttachment = AttachBool True
}
& itUse .~ (defaultlUse & lUse .~ LShrink)
& itParams .~ ShrinkGunParams FullSize
& itType . iyBase .~ LEFT SHRINKER
shrinkGunPic :: Item -> SPic
@@ -100,7 +98,7 @@ useForceFieldGun itm cr w = fromMaybe w $ do
return $
w
& cWorld . walls %~ IM.insertWith (\_ x -> x) i forceField{_wlID = i}
& cWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID (_itPos itm)) . itParams . paramMID ?~ i
& cWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID (_itLocation itm)) . itParams . paramMID ?~ i
& moveWallIDUnsafe i wlline
where
i = fromMaybe (IM.newKey (_walls (_cWorld w))) $ itm ^? itParams . paramMID . _Just
+29 -28
View File
@@ -1,7 +1,6 @@
module Dodge.Luse where
import Dodge.Base
import Data.Maybe
import Dodge.Creature.Action
import Dodge.Data
import Dodge.Default.Creature
@@ -38,16 +37,16 @@ useRewindGun _ _ w = case _rewindWorlds (_cWorld w) of
-- creature but using the old crInvSel value
-- 22.05.23 this has been changed from using invids to items
useShrinkGun :: Item -> Creature -> World -> World
useShrinkGun it cr w =
if _atBool $ _itAttachment it
then tryResize 0.5 $ stripNoItems cr . f False UndroppableIdentified . dropExcept cr invid
else tryResize 1 $ f True Uncursed . setMinInvSize defaultInvSize cr
useShrinkGun it cr w = case it ^? itParams . shrinkGunStatus of
Just FullSize -> tryResize 0.5 $ stripNoItems cr . f Shrunk UndroppableIdentified . dropExcept cr invid
Just Shrunk -> tryResize 1 $ f FullSize Uncursed . setMinInvSize defaultInvSize cr
Nothing -> error "useShrinkGun applied to item with incorrect ItParam"
where
invid = _ipInvID $ _itPos it
invid = _ipInvID $ _itLocation it
tryResize x g = maybe w g $ sizeSelf x cr w
f isInUse cstatus =
cWorld . creatures . ix (_crID cr) . crInv . ix invid
%~ ((itAttachment . atBool .~ isInUse) . (itCurseStatus .~ cstatus))
%~ ((itParams . shrinkGunStatus .~ isInUse) . (itCurseStatus .~ cstatus))
boostSelfL ::
-- | boost amount
@@ -56,27 +55,29 @@ boostSelfL ::
Creature ->
World ->
World
boostSelfL x itm cr w = case boostPoint x cr w of
Left p -> crEff p (itUse . leftConsumption . arLoaded .~ 0)
Right p -> crEff p (itUse . leftConsumption . arLoaded -~ 1)
where
invid = _ipInvID $ _itPos itm
cid = _crID cr
cpos = _crPos cr
r = _crRad cr
pid =
fromMaybe
(IM.newKey $ _props (_cWorld w))
(cr ^? crInv . ix invid . itAttachment . atInt)
crEff p ammoEff =
addBoostShockwave pid p (r *.* normalizeV (p -.- cpos)) w
& cWorld . creatures . ix cid
%~ (crPos .~ p)
. ( crInv . ix invid
%~ ammoEff
. (itEffect . ieCounter .~ 1)
. (itAttachment .~ AttachInt pid)
)
boostSelfL = undefined
--boostSelfL x itm cr w = case boostPoint x cr w of
-- Left p -> crEff p (itUse . leftConsumption . arLoaded .~ 0)
-- Right p -> crEff p (itUse . leftConsumption . arLoaded -~ 1)
-- where
-- invid = _ipInvID $ _itLocation itm
-- cid = _crID cr
-- cpos = _crPos cr
-- r = _crRad cr
-- pid =
-- fromMaybe
-- (IM.newKey $ _props (_cWorld w))
-- (cr ^? crInv . ix invid . itAttachment . atInt)
-- crEff p ammoEff =
-- addBoostShockwave pid p (r *.* normalizeV (p -.- cpos)) w
-- & cWorld . creatures . ix cid
-- %~ (crPos .~ p)
-- . ( crInv . ix invid
-- %~ ammoEff
-- . (itEffect . ieCounter .~ 1)
-- . (itAttachment .~ AttachInt pid)
-- )
-- | Move a creature towards the mouse position, with shockwave
boostPoint ::
+5 -5
View File
@@ -69,9 +69,9 @@ explodeRemoteRocket' mitid thepj w =
where
updateitem = fromMaybe (cWorld . projectiles . at pjid .~ Nothing) $ do
itid <- mitid
itpos <- w ^? cWorld . itemPositions . ix itid
itpos <- w ^? cWorld . itemLocations . ix itid
return $
(pointerToItem itpos . itUse . rUse .~ HeldDoNothing)
(pointerToItemLocation itpos . itUse . rUse .~ HeldDoNothing)
. (cWorld . projectiles . ix pjid . prjUpdates .~ [PJRetireRemote itid 30 pjid])
pjid = _prjID thepj
@@ -125,7 +125,7 @@ upProjectile pu pj = case pu of
retireRemoteProj'' :: Int -> Int -> World -> World
retireRemoteProj'' itid pjid w =
w
& pointerToItem (_itemPositions (_cWorld w) IM.! itid)
& pointerToItemLocation (_itemLocations (_cWorld w) IM.! itid)
%~ ( (itScope . scopePos .~ V2 0 0)
. (itUse . rUse .~ HeldFireRemoteShell)
)
@@ -138,7 +138,7 @@ setRemoteDir cid itid pj w = w & cWorld . projectiles . ix (_prjID pj) . prjDir
newdir
| SDL.ButtonRight `M.member` _mouseButtons w
&& w ^? cWorld . creatures . ix cid . crInvSel . iselPos
== w ^? cWorld . itemPositions . ix itid . ipInvID =
== w ^? cWorld . itemLocations . ix itid . ipInvID =
_cameraRot (_cWorld w) + argV (_mousePos w)
| otherwise = _prjDir pj
@@ -189,7 +189,7 @@ pjTrack' itid pj w = rotateToTarget pj w
(_prjPos pj)
tpos
(argV $ _prjAcc pj)
itPoint = pointerToItem $ _itemPositions (_cWorld w) IM.! itid
itPoint = pointerToItemLocation $ _itemLocations (_cWorld w) IM.! itid
reduceSpinBy' :: Float -> Proj -> World -> World
reduceSpinBy' x pj = cWorld . projectiles . ix (_prjID pj) . prjSpin *~ x