From bcbfd7d2fa2aab9dd4c050722b8fb9cef1e1f701 Mon Sep 17 00:00:00 2001 From: justin Date: Wed, 8 Jun 2022 12:28:11 +0100 Subject: [PATCH] Defunction-ify item modules, requires more cleanup --- src/Dodge/Annotation/Data.hs | 4 +- src/Dodge/Beam.hs | 158 +++++++++++++++++ src/Dodge/Combine.hs | 45 ++--- src/Dodge/Combine/Combinations.hs | 70 +++----- src/Dodge/Combine/Data.hs | 60 ++++++- src/Dodge/Combine/Module.hs | 64 +++++++ src/Dodge/Creature.hs | 2 +- src/Dodge/Creature/Impulse/Movement.hs | 6 - src/Dodge/Creature/LtAutoCrit.hs | 2 +- src/Dodge/Creature/State.hs | 2 +- src/Dodge/Creature/Statistics.hs | 2 +- src/Dodge/Creature/Test.hs | 2 +- src/Dodge/Data.hs | 21 +-- src/Dodge/Default.hs | 84 ++------- src/Dodge/Default/Item.hs | 88 ++++++++++ src/Dodge/Default/LightSource.hs | 36 ++++ src/Dodge/Default/Weapon.hs | 46 ++--- src/Dodge/IncBall.hs | 10 ++ src/Dodge/Item.hs | 4 + src/Dodge/Item/Consumable.hs | 4 +- src/Dodge/Item/Craftable.hs | 9 +- src/Dodge/Item/Equipment.hs | 61 +++---- src/Dodge/Item/PassKey.hs | 12 +- src/Dodge/Item/Weapon/BatteryGuns.hs | 199 +++------------------- src/Dodge/Item/Weapon/Booster.hs | 5 +- src/Dodge/Item/Weapon/BulletGun/Cane.hs | 40 ++--- src/Dodge/Item/Weapon/BulletGun/Rod.hs | 21 +-- src/Dodge/Item/Weapon/BulletGun/Stick.hs | 39 ++--- src/Dodge/Item/Weapon/BulletGuns.hs | 61 ++----- src/Dodge/Item/Weapon/Drone.hs | 5 +- src/Dodge/Item/Weapon/Grenade.hs | 8 +- src/Dodge/Item/Weapon/InventoryDisplay.hs | 48 +----- src/Dodge/Item/Weapon/Launcher.hs | 18 +- src/Dodge/Item/Weapon/Radar.hs | 10 +- src/Dodge/Item/Weapon/SonicGuns.hs | 5 +- src/Dodge/Item/Weapon/Spawn.hs | 4 +- src/Dodge/Item/Weapon/SprayGuns.hs | 22 +-- src/Dodge/Item/Weapon/Utility.hs | 38 ++--- src/Dodge/LightSource.hs | 2 +- src/Dodge/LockAndKey.hs | 10 +- src/Dodge/Module.hs | 17 +- src/Dodge/Placement/Instance/Analyser.hs | 2 +- src/Dodge/PtFlicker.hs | 11 ++ src/Dodge/Render/HUD.hs | 4 +- src/Dodge/Room/Containing.hs | 2 +- src/Dodge/Tesla.hs | 12 ++ src/Dodge/WorldEvent/Flash.hs | 6 +- src/Dodge/WorldEvent/SpawnParticle.hs | 121 ++++++------- 48 files changed, 762 insertions(+), 740 deletions(-) create mode 100644 src/Dodge/Beam.hs create mode 100644 src/Dodge/Combine/Module.hs create mode 100644 src/Dodge/Default/Item.hs create mode 100644 src/Dodge/Default/LightSource.hs create mode 100644 src/Dodge/IncBall.hs create mode 100644 src/Dodge/PtFlicker.hs create mode 100644 src/Dodge/Tesla.hs diff --git a/src/Dodge/Annotation/Data.hs b/src/Dodge/Annotation/Data.hs index 419b5b3a3..38cdf359c 100644 --- a/src/Dodge/Annotation/Data.hs +++ b/src/Dodge/Annotation/Data.hs @@ -20,8 +20,8 @@ data Annotation | AnoApplyInt Int (Int -> State StdGen (LabSubCompTree Room)) | AnoNewInt (Int -> State StdGen (SubCompTree Room)) | PassthroughLockKeyLists Int - [(Int -> State StdGen (LabSubCompTree Room), State StdGen CombineType)] - [(CombineType, State StdGen (LabSubCompTree Room))] + [(Int -> State StdGen (LabSubCompTree Room), State StdGen ItemBaseType)] + [(ItemBaseType, State StdGen (LabSubCompTree Room))] -- | SetLabel Int (State g Room) -- | UseLabel Int (State g Room) | ChainAnos [[Annotation]] diff --git a/src/Dodge/Beam.hs b/src/Dodge/Beam.hs new file mode 100644 index 000000000..b3a8bc6be --- /dev/null +++ b/src/Dodge/Beam.hs @@ -0,0 +1,158 @@ +module Dodge.Beam where +import Dodge.Data +import Dodge.Particle.Flame +import Dodge.Particle.TeslaArc +import Dodge.Item.Location +import Dodge.WorldEvent.Damage +import Dodge.WorldEvent.HelperParticle +import Dodge.Item.Weapon.LaserPath +import Geometry +import LensHelp +import Picture +import Dodge.RandomHelp +import Dodge.Zone +import Dodge.Base.Collide +import Shape + +import Data.List (sortOn) +import System.Random +import MonadHelp +import Control.Monad.State +import Data.Maybe +import qualified Data.IntMap.Strict as IM + +flameBeamCombine :: (Point2,(Point2,Point2,Beam),(Point2,Point2,Beam)) + -> World -> World +flameBeamCombine (p,(a,b,_),(x,y,_)) + = makeFlame p (2 *.* normalizeV (normalizeV (b-.-a)+.+normalizeV (y-.-x))) +lasBeamCombine :: (Point2,(Point2,Point2,Beam),(Point2,Point2,Beam)) + -> World -> World +lasBeamCombine (p,(a,b,_),(x,y,_)) + = instantParticles .:~ lasRayAt yellow 11 1 p (argV (normalizeV (b-.-a)+.+normalizeV (y-.-x))) + +splitBeamCombine :: (Point2,(Point2,Point2,Beam),(Point2,Point2,Beam)) + -> World -> World +splitBeamCombine (p,(a,b,_),(x,y,_)) + = (instantParticles .:~ lasRayAt yellow 11 1 p (dir+0.5*pi)) + . (instantParticles .:~ lasRayAt yellow 11 1 p (dir-0.5*pi)) + where + dir = argV (normalizeV (b-.-a)+.+normalizeV (y-.-x)) + +teslaBeamCombine :: (Point2,(Point2,Point2,Beam),(Point2,Point2,Beam)) + -> World -> World +teslaBeamCombine (p,(a,b,bm),(x,y,_)) w + = w' & pointToItem (_itemPositions w IM.! itid) . itParams . subParams ?~ ip + where + itid = fromJust $ _bmOrigin bm + dir = argV (normalizeV (b-.-a)+.+normalizeV (y-.-x)) + (w',ip) = shootTeslaArc' (fromJust . _subParams $ _itParams it) p dir w + it = case getItem itid w of + Nothing -> error "tried to get item use teslaBeamCombine that doesn't exist" + Just itm -> itm + +lasRayAt :: Color -> Int -> Float -> Point2 -> Float -> Particle +lasRayAt col dam phasev pos dir = LaserParticle + { _ptDraw = const blank + , _ptUpdate = mvLaser phasev pos dir + , _ptRange = 800 + , _ptDamage = dam + , _ptPhaseV = phasev + , _ptColor = col + } +mvLaser :: Float -- ^ Phase velocity, controls deflection through windows + -> Point2 + -> Float + -> World + -> Particle + -> (World, Maybe Particle) +mvLaser phasev pos dir w pt + = ( damThingHitWith (\p1 p2 p3 -> Damage LASERING dam p1 p2 p3 NoDamageEffect) pos xp thHit w + , Just pt {_ptDraw = const pic ,_ptUpdate = ptSimpleTime 0 } + ) + where + dam = _ptDamage pt + xp = pos +.+ 800 *.* unitVectorAtAngle dir + (thHit, ps) = reflectLaserAlong phasev [] pos xp w + col = _ptColor pt + pic = setLayer BloomNoZWrite $ pictures + [ setDepth 19 . color (brightX 0 0.5 col) $ thickLine 20 (pos:ps) + , setDepth 19.5 . color (brightX 10 1 col) $ thickLine 3 (pos:ps) + ] + +shootTeslaArc' :: ItemParams -> Point2 -> Float -> World -> (World,ItemParams) +shootTeslaArc' ip pos dir w = + (w & randGen .~ g + & instantParticles .:~ aTeslaArcAt col newarc + , ip & currentArc ?~ newarc + ) + where + (col,g) = takeOne [white,azure,blue,cyan] & runState $ _randGen w + newarc = createArc ip w pos dir & evalState $ _randGen w + +createArc :: ItemParams + -> World + -> Point2 + -> Float + -> State StdGen [ArcStep] +createArc arcparams@Arcing{_currentArc = Nothing} w p dir = createNewArc arcparams w p dir +createArc arcparams w p dir = updateArc arcparams w p dir + +createNewArc :: ItemParams -> World -> Point2 -> Float + -> State StdGen [ArcStep] +createNewArc arcparams w p dir = take (_arcNumber arcparams) + <$> unfoldrMID (_newArcStep arcparams arcparams w) (ArcStep p dir Nothing) + +defaultArcStep :: RandomGen g => ItemParams -> World -> ArcStep + -> State g (Maybe ArcStep) +defaultArcStep _ _ (ArcStep _ _ (Just _)) = return Nothing +defaultArcStep itparams w (ArcStep p dir _) = do + let csize = _arcSize itparams + --rot <- takeOne [pi/4,negate pi/4] + rot <- takeOne [0] + let center = csize *.* rotateV rot (unitVectorAtAngle dir) +.+ p + newp <- (center +.+) <$> randInCirc csize + let mcr = listToMaybe + . sortOn (dist center . _crPos) + . filter (\cr -> dist center (_crPos cr) < csize) + . IM.elems + $ _creatures w + wlsnearpoint = wallsNearPoint p w + mwl = listToMaybe + . sortOn (dist p . fst) + . mapMaybe (\ q -> collidePointWallsWall p (center +.+ q) wlsnearpoint) + $ polyCirc 6 csize + f (q,wl) = ArcStep q dir (Just $ Right wl) + g cr = ArcStep (_crPos cr +.+ csize *.* unitVectorAtAngle dir) dir (Just $ Left cr) + return . listToMaybe . sortOn (dist p . (^. asPos)) + $ ArcStep newp dir Nothing : catMaybes [fmap f mwl,fmap g mcr] + +updateArc :: ItemParams + -> World + -> Point2 + -> Float + -> State StdGen [ArcStep] +updateArc ip w p dir = take (_arcNumber ip) <$> zipArcs ip w (ArcStep p dir Nothing) carc + where + carc = tail $ fromJust $ _currentArc ip + +zipArcs :: ItemParams + -> World + -> ArcStep + -> [ArcStep] + -> State StdGen [ArcStep] +zipArcs ip w x (y:ys) = (x :) <$> do + defaultnext <- _newArcStep ip ip w x + case defaultnext of + Nothing -> return [] + Just z@(ArcStep _ _ (Just _)) -> return [z] + Just z -> do + p <- randInCirc 5 + let csize = _arcSize ip + center = _asPos x +.+ csize *.* unitVectorAtAngle (_asDir x) + newp = _asPos y +.+ p + --newdir = argV $ newp -.- _asPos x + newdir = _asDir x + if dist newp center < csize + then zipArcs ip w (y & asPos .~ newp & asDir .~ newdir) ys + else zipArcs ip w z ys +zipArcs ip w y _ = createNewArc ip w (_asPos y) (_asDir y) diff --git a/src/Dodge/Combine.hs b/src/Dodge/Combine.hs index 7c99a2ab6..5bf279916 100644 --- a/src/Dodge/Combine.hs +++ b/src/Dodge/Combine.hs @@ -12,7 +12,8 @@ import Dodge.Base.You import Dodge.Data import Dodge.Item.Amount import Dodge.Inventory.ItemSpace ---import Dodge.Combine.Data +import Dodge.Combine.Module +import Dodge.Combine.Data import Multiset import SimpleTrie @@ -25,7 +26,7 @@ import Data.Map.Merge.Strict import Data.Maybe import Data.List (scanl',sortOn) -combinationsTrie :: Trie (Int,CombineType) Item +combinationsTrie :: Trie (Int,ItemBaseType) Item combinationsTrie = foldr (uncurry insertInTrie . first (sortOn snd)) emptyTrie @@ -35,25 +36,25 @@ combinationsTrie = foldr -- trie going through each combine type in your inventory in order, rather than -- creating all multisets of combine types. -lookupItems :: [(M.Map ModuleSlot ItemModule,CombineType,Int,Int)] - -> [ ([(M.Map ModuleSlot ItemModule,Int)],Item) ] +lookupItems :: [(M.Map ModuleSlot ItemModuleType,ItemBaseType,Int,Int)] + -> [ ([(M.Map ModuleSlot ItemModuleType,Int)],Item) ] lookupItems xs = lookupItemsUsingTrie (sortOn (\(_,ct,_,_) -> ct) xs) combinationsTrie -lookupItemsUsingTrie :: [(M.Map ModuleSlot ItemModule,CombineType,Int,Int)] - -> Trie (Int,CombineType) Item - -> [ ([(M.Map ModuleSlot ItemModule,Int)],Item) ] +lookupItemsUsingTrie :: [(M.Map ModuleSlot ItemModuleType,ItemBaseType,Int,Int)] + -> Trie (Int,ItemBaseType) Item + -> [ ([(M.Map ModuleSlot ItemModuleType,Int)],Item) ] lookupItemsUsingTrie [] t = maybeToList $ ([],) <$> _trieMVal t lookupItemsUsingTrie ((mods,ct,i,n):xs) t = do n' <- [1..min n 4] let is = replicate n' (mods,i) concatMap (map (first (is ++)) . lookupItemsUsingTrie xs) $ maybeToList (_trieChildren t M.!? (n',ct)) -invertListInvMult :: IM.IntMap Item -> [[(M.Map ModuleSlot ItemModule,CombineType,Int,Int)]] +invertListInvMult :: IM.IntMap Item -> [[(M.Map ModuleSlot ItemModuleType,ItemBaseType,Int,Int)]] invertListInvMult = powlistUpToN 4 . invertListInv -invertListInv :: IM.IntMap Item -> [(M.Map ModuleSlot ItemModule,CombineType,Int,Int)] +invertListInv :: IM.IntMap Item -> [(M.Map ModuleSlot ItemModuleType,ItemBaseType,Int,Int)] invertListInv = IM.foldrWithKey - (\k it -> ((_itModules it,_itType it, k, itStackAmount it) :) ) + (\k it -> ((_iyModules $ _itType it,_iyBase $ _itType it, k, itStackAmount it) :) ) [] -- gives a list of indices-item pairs. @@ -65,21 +66,21 @@ combineItemListYou = map (second fst) . combineItemListYou' combineItemListYou' :: World -> [([Int],(Item,[String]))] combineItemListYou' = map addModules . concatMap lookupItems . invertListInvMult . yourInv -addModules :: ([(M.Map ModuleSlot ItemModule,Int)],Item) +addModules :: ([(M.Map ModuleSlot ItemModuleType,Int)],Item) -> ([Int],(Item,[String])) addModules (ps,it) = (is , (applyModules newm it, ss)) where (ms,is) = unzip ps - m = ([],_itModules it) + m = ([],_iyModules $ _itType it) (ss,newm) = foldr f m ms f m' (s,m'') = (s ++ s',m''') where (s',m''') = combineModules m' m'' -applyModules :: M.Map ModuleSlot ItemModule -> Item -> Item -applyModules ms it = foldr f (it & itModules .~ ms) ms +applyModules :: M.Map ModuleSlot ItemModuleType -> Item -> Item +applyModules ms it = foldr f (it & itType . iyModules .~ ms) ms where - f m = fromMaybe id (m ^? modModification) + f m = fromMaybe id (fromModuleType m ^? modModification) -- (is , ) <$> [ (it & itModules .~ themodules,s) | (themodules,s) <- combinedmodules] -- where -- (ms,is) = unzip ps @@ -88,20 +89,22 @@ applyModules ms it = foldr f (it & itModules .~ ms) ms -- f ims imss = concatMap (g ims) imss -- g ims (ims',s) = map (second (s++)) $ combineModules ims ims' -combineModules :: M.Map ModuleSlot ItemModule - -> M.Map ModuleSlot ItemModule - -> ([String],M.Map ModuleSlot ItemModule) +combineModules :: M.Map ModuleSlot ItemModuleType + -> M.Map ModuleSlot ItemModuleType + -> ([String],M.Map ModuleSlot ItemModuleType) combineModules = mergeA (traverseMaybeMissing f) (traverseMissing g) (zipWithAMatched h) where - f _ ItemModule{_modName=ss} = ("WARNING:REMOVES":ss,Nothing) + f _ imt | imt /= EMPTYMODULE = ("WARNING:REMOVES":ss imt,Nothing) f _ _ = ([],Nothing) g _ m = ([], m) - h _ ItemModule{_modName=ss} im@ItemModule{} = ("WARNING:REMOVES":ss,im) - h _ _ im@ItemModule{} = ([],im) + h _ im1 im2 | im1 /= EMPTYMODULE && im2 /= EMPTYMODULE + = ("WARNING:REMOVES":ss im1,im2) + h _ _ im | im /= EMPTYMODULE = ([],im) h _ im _ = ([],im) + ss imt = _modName $ fromModuleType imt toggleCombineInv :: World -> World toggleCombineInv w = case _hudElement (_hud w) of diff --git a/src/Dodge/Combine/Combinations.hs b/src/Dodge/Combine/Combinations.hs index f10d7d531..52cb3ef8a 100644 --- a/src/Dodge/Combine/Combinations.hs +++ b/src/Dodge/Combine/Combinations.hs @@ -8,12 +8,13 @@ import Dodge.Particle.Damage import Dodge.Item.Equipment import Dodge.Item.Craftable import Dodge.Item.Weapon +import Dodge.Combine.Module import Dodge.Base import LensHelp import Data.Maybe -itemCombinations :: [([(Int,CombineType)],Item)] +itemCombinations :: [([(Int,ItemBaseType)],Item)] itemCombinations = [ po [PIPE, HARDWARE] (bangStick 1) , po [BANGSTICK 1, TIN] pistol @@ -90,7 +91,8 @@ itemCombinations = ++ map (\i -> po [REVOLVERX i,CAN] $ revolverX (i+1)) [1..5] ++ map (\i -> p [o (BANGCANEX i),p 2 PIPE] $ bangCaneX (i+1)) [1..5] ++ map (\i -> po [MINIGUNX i,BANGCANE] $ miniGunX (i+1)) [3..15] - ++ [ po (_itType it:mtype) $ it & itModules . ix modtype .~ m + + ++ [ po (_iyBase (_itType it):mtype) $ it & itType . iyModules . ix modtype .~ m | (modtype,is,ms) <- moduleCombinations , it <- is , (mtype,m) <- ms @@ -100,7 +102,7 @@ itemCombinations = po xs it = (map o xs,it) o = (1,) -moduleCombinations :: [( ModuleSlot, [Item], [([CombineType],ItemModule)] )] +moduleCombinations :: [( ModuleSlot, [Item], [([ItemBaseType],ItemModuleType)] )] moduleCombinations = [ ( ModRifleMag , [repeater @@ -108,8 +110,8 @@ moduleCombinations = ,burstRifle ,fastBurstRifle ] - , [amod [DRUM,HARDWARE] "+DRUM MAG" (itConsumption . laMax .~ 45) - ,amod [MOTOR,HARDWARE] "+BELT FEED" (itConsumption . laMax .~ 150) + , [amod [DRUM,HARDWARE] DRUMMAG + ,amod [MOTOR,HARDWARE] BELTMAG ] ) , ( ModAutoMag @@ -117,78 +119,56 @@ moduleCombinations = ,autoPistol ,smg ] - , [amod [MAGNET,HARDWARE] "+MAGNET FEED" (itUse . useDelay . rateMax .~ 4) + , [amod [MAGNET,HARDWARE] MAGNETMAG ] ) , ( ModBullet , bulletWeapons - , [amod [INCENDIARYMODULE] "+INCENDIARY" (f $ expireAndDamage $ spawnAtBulDams incBall) - ,amod [BOUNCEMODULE] "+BOUNCE" (f $ expireAndDamage bounceBulDams) - ,amod [STATICMODULE] "+STATIC" (f $ expireAndDamage $ spawnAtBulDams aStaticBall) - ,amod [CONCUSSMODULE] "+CONCUSS" (f $ expireAndDamage $ spawnAtBulDams concBall) + , [amod [INCENDIARYMODULE] INCENDBUL + ,amod [BOUNCEMODULE] BOUNCEBUL + ,amod [STATICMODULE] STATICBUL + ,amod [CONCUSSMODULE] CONCUSBUL ] ) , ( ModTarget , homingLaunchers ++ bulletWeapons - , [amod [MICROCHIP,CREATURESENSOR] "+CREATURETARGETING" (itTargeting .~ targetRBCreature) - ,amod [MICROCHIP,PRISM] "+LASERTARGETING" (itTargeting .~ targetLaser) - ,amod [MICROCHIP,TIN] "+POSTIONALTARGETING" (itTargeting .~ targetRBPress) + , [amod [MICROCHIP,CREATURESENSOR] TARGCR + ,amod [MICROCHIP,PRISM] TARGLAS + ,amod [MICROCHIP,TIN] TARGPOS ] ) , ( ModBulletTrajectory , bulletWeapons - , [amod [MAGNET,MICROCHIP,HARDWARE] "+MAGNETTRAJECTORY" - ( (itConsumption . laType . amBulTraj .~ MagnetTrajectory) - . (itConsumption . laType . amBulVel .~ V2 10 0) - ) - ,amod [MICROCHIP,HARDWARE] "+FLECHETTETRAJECTORY" - (itConsumption . laType . amBulTraj .~ FlechetteTrajectory) - ,amod [ANTIMATTER,HARDWARE] "+BEZIERTRAJECTORY" - (itConsumption . laType . amBulTraj .~ BezierTrajectory) + , [amod [MAGNET,MICROCHIP,HARDWARE] MAGNETTRAJ + ,amod [MICROCHIP,HARDWARE] FLECHETRAJ + ,amod [ANTIMATTER,HARDWARE] BEZIERTRAJ ] ) , ( ModDualBeam , [lasGunDual] - , [amod [INCENDIARYMODULE] "+INCENDIARY" (itParams . lasBeam .~ BeamCombine flameBeamCombine) - ,amod [STATICMODULE] "+STATIC" - ( (itParams . lasBeam .~ BeamCombine teslaBeamCombine) - . (itParams . subParams ?~ teslaParams) - ) - ,amod [TRANSFORMER] "+SPLIT" (itParams . lasBeam .~ BeamCombine splitBeamCombine) + , [amod [INCENDIARYMODULE] INCENDLAS + ,amod [TRANSFORMER] SPLITLAS + ,amod [STATICMODULE] STATICLAS ] ) , ( ModTeleport , teleportableWeapons - , [amod [TELEPORTMODULE,MICROCHIP] "+DIRECTEDTELE" makeDirectedTele + , [amod [TELEPORTMODULE,MICROCHIP] WEPTELE ] ) , ( ModLauncherHoming , homingLaunchers - , [ amod [MICROCHIP,TRANSMITTER] "+TARGET HOMING" - (itConsumption . laType . amPjCreation .~ fireTrackingShell) + , [ amod [MICROCHIP,TRANSMITTER] LAUNCHHOME ] ) , ( ModBattery , batteryGuns - , [amod [BATTERY] "+BATTERY" (itConsumption . laMax +~ 1000) + , [amod [BATTERY] EXTRABATTERY ] ) ] where - makeDirectedTele it = it - & itTargeting .~ targetRBPress - & itUse . useMods .:~ withPosDirWallCheck directedTelPos --- for the camera: the simplest option is to remove all zoom/offset - & itUse . useAim . aimZoom . itZoomFac .~ 1 - & itUse . useAim . aimRange .~ 0 --- a better option would be to involve a "scope" centered on the firing --- position - directedTelPos it cr w = (p,a) - where - p = fromMaybe (_crPos cr) $ it ^? itTargeting . tgPos . _Just - a = argV (mouseWorldPos w -.- p) - f ameff = itConsumption . laType . amBulEff .~ ameff - amod cts str func = (cts,ItemModule [str] 1 func) + amod = (,) homingLaunchers :: [Item] homingLaunchers = launcher : [launcherX i | i <- [2..10]] diff --git a/src/Dodge/Combine/Data.hs b/src/Dodge/Combine/Data.hs index 7b13f5aa5..1b6a283c1 100644 --- a/src/Dodge/Combine/Data.hs +++ b/src/Dodge/Combine/Data.hs @@ -1,11 +1,22 @@ +{-# LANGUAGE TemplateHaskell #-} module Dodge.Combine.Data - (CombineType (..) - ,Detector (..) - ) where + where import Dodge.Equipment.Data +import Control.Lens +import qualified Data.Map.Strict as M + +-- this should probably store loaded ammo +data ItemType = ItemType + {_iyBase :: ItemBaseType + ,_iyModules :: M.Map ModuleSlot ItemModuleType + } + deriving (Eq,Ord,Show) + -- TODO make this an enum somehow...? -data CombineType +data ItemBaseType = NOTDEFINED + | EFFGUN String + | AUTOEFFGUN String -- Weapons | BANGSTICK Int | PISTOL @@ -76,6 +87,7 @@ data CombineType | BLINKERUNSAFE | FORCEFIELDGUN | SHRINKER + | SPAWNER -- Equipment | CLICKDETECTOR Detector | AUTODETECTOR Detector @@ -86,6 +98,7 @@ data CombineType | INVISIBILITYEQUIPMENT EquipSite | BRAINHAT | HEADLAMP + | HEADLAMP1 | POWERLEGS | SPEEDLEGS | JUMPLEGS @@ -141,11 +154,50 @@ data CombineType -- | KEYCARD Int -- + | MEDKIT Int + -- | NoCombineType deriving (Eq,Ord,Show) +data ItemModuleType + = EMPTYMODULE + | DRUMMAG + | BELTMAG + | MAGNETMAG + | INCENDBUL + | BOUNCEBUL + | STATICBUL + | CONCUSBUL + | TARGCR + | TARGLAS + | TARGPOS + | MAGNETTRAJ + | FLECHETRAJ + | BEZIERTRAJ + | INCENDLAS + | SPLITLAS + | STATICLAS + | WEPTELE + | LAUNCHHOME + | EXTRABATTERY + deriving (Eq,Ord,Show) + data Detector = ITEMDETECTOR | CREATUREDETECTOR | WALLDETECTOR deriving (Eq,Ord,Show) + +data ModuleSlot + = ModBullet + | ModRifleMag + | ModAutoMag + | ModTarget + | ModBulletTrajectory + | ModLauncherHoming + | ModBattery + | ModTeleport + | ModDualBeam + deriving (Eq,Ord,Show) + +makeLenses ''ItemType diff --git a/src/Dodge/Combine/Module.hs b/src/Dodge/Combine/Module.hs new file mode 100644 index 000000000..35fdd73ce --- /dev/null +++ b/src/Dodge/Combine/Module.hs @@ -0,0 +1,64 @@ +module Dodge.Combine.Module where +import Dodge.Data +import Dodge.Tesla +import Dodge.Particle.HitEffect.ExpireAndDamage +import Dodge.WorldEvent.SpawnParticle +import Dodge.Particle.Damage +import Dodge.IncBall +import Dodge.Item.Weapon.ExtraEffect +import Dodge.Item.Weapon.Launcher +import Dodge.Item.Weapon.TriggerType +import LensHelp +import Geometry +--import Dodge.Item.Weapon.BatteryGuns +import Dodge.Beam +import Dodge.Base.Coordinate + +import Data.Maybe + +fromModuleType :: ItemModuleType -> ItemModule +fromModuleType imt = case imt of + EMPTYMODULE -> ItemModule ["EMPTYMODULE"] 1 id + DRUMMAG -> mod "+DRUM MAG" (itConsumption . laMax .~ 45) + BELTMAG -> mod "+BELT FEED" (itConsumption . laMax .~ 150) + MAGNETMAG -> mod "+MAGNET FEED" (itUse . useDelay . rateMax .~ 4) + INCENDBUL -> mod "+INCENDIARY" (f $ expireAndDamage $ spawnAtBulDams incBall) + BOUNCEBUL -> mod "+BOUNCE" (f $ expireAndDamage bounceBulDams) + STATICBUL -> mod "+STATIC" (f $ expireAndDamage $ spawnAtBulDams aStaticBall) + CONCUSBUL -> mod "+CONCUSS" (f $ expireAndDamage $ spawnAtBulDams concBall) + TARGCR -> mod "+CREATURETARGETING" (itTargeting .~ targetRBCreature) + TARGLAS -> mod "+LASERTARGETING" (itTargeting .~ targetLaser) + TARGPOS -> mod "+POSTIONALTARGETING" (itTargeting .~ targetRBPress) + MAGNETTRAJ -> mod "+MAGNETTRAJECTORY" + ( (itConsumption . laType . amBulTraj .~ MagnetTrajectory) + . (itConsumption . laType . amBulVel .~ V2 10 0) + ) + FLECHETRAJ -> mod "+FLECHETTETRAJECTORY" + (itConsumption . laType . amBulTraj .~ FlechetteTrajectory) + BEZIERTRAJ -> mod "+BEZIERTRAJECTORY" + (itConsumption . laType . amBulTraj .~ BezierTrajectory) + INCENDLAS -> mod "+INCENDIARY" (itParams . lasBeam .~ BeamCombine flameBeamCombine) + SPLITLAS -> mod "+SPLIT" (itParams . lasBeam .~ BeamCombine splitBeamCombine) + STATICLAS -> mod "+STATIC" + ( (itParams . lasBeam .~ BeamCombine teslaBeamCombine) + . (itParams . subParams ?~ teslaParams) + ) + WEPTELE -> mod "+DIRECTEDTELE" makeDirectedTele + LAUNCHHOME -> mod "+TARGET HOMING" (itConsumption . laType . amPjCreation .~ fireTrackingShell) + EXTRABATTERY -> mod "+BATTERY" (itConsumption . laMax +~ 1000) + where + mod str func = ItemModule [str] 1 func + f ameff = itConsumption . laType . amBulEff .~ ameff + makeDirectedTele it = it + & itTargeting .~ targetRBPress + & itUse . useMods .:~ withPosDirWallCheck directedTelPos +-- for the camera: the simplest option is to remove all zoom/offset + & itUse . useAim . aimZoom . itZoomFac .~ 1 + & itUse . useAim . aimRange .~ 0 +-- a better option would be to involve a "scope" centered on the firing +-- position + directedTelPos it cr w = (p,a) + where + p = fromMaybe (_crPos cr) $ it ^? itTargeting . tgPos . _Just + a = argV (mouseWorldPos w -.- p) + --amod cts str func = (cts,ItemModule [str] 1 func) diff --git a/src/Dodge/Creature.hs b/src/Dodge/Creature.hs index bef5f0965..08195ace5 100644 --- a/src/Dodge/Creature.hs +++ b/src/Dodge/Creature.hs @@ -262,7 +262,7 @@ stackedInventory = IM.fromList $ zip [0..] ,tractorGun ,longGun ,autoGun - ,ltAutoGun + ,autoPistol ,pistol ,teslaGun ,blinkGun diff --git a/src/Dodge/Creature/Impulse/Movement.hs b/src/Dodge/Creature/Impulse/Movement.hs index b4882579a..0524eb91d 100644 --- a/src/Dodge/Creature/Impulse/Movement.hs +++ b/src/Dodge/Creature/Impulse/Movement.hs @@ -91,9 +91,3 @@ creatureTurnToward p turnSpeed cr {- | Speed modifier of an item when not aiming. -} equipSpeed :: Item -> Float equipSpeed _ = 1 -{- | Speed modifier of an item when aiming. -} -equipAimSpeed :: Item -> Float -- TODO remove/rethink -equipAimSpeed it - | _itType it == FRONTARMOUR = 0.5 - | _itType it == FLAMESHIELD = 0.5 - | otherwise = 1 diff --git a/src/Dodge/Creature/LtAutoCrit.hs b/src/Dodge/Creature/LtAutoCrit.hs index 374230259..7739594ac 100644 --- a/src/Dodge/Creature/LtAutoCrit.hs +++ b/src/Dodge/Creature/LtAutoCrit.hs @@ -49,7 +49,7 @@ ltAutoCrit = defaultCreature , _crStrategy = StrategyActions WatchAndWait [StartSentinelPost] , _crGoal = [] } - , _crInv = IM.fromList [(0,ltAutoGun),(1,medkit 100)] + , _crInv = IM.fromList [(0,autoPistol),(1,medkit 100)] , _crInvSel = 0 , _crRad = 10 , _crHP = 500 diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index e515c4d3d..6f9113545 100644 --- a/src/Dodge/Creature/State.hs +++ b/src/Dodge/Creature/State.hs @@ -185,7 +185,7 @@ movementSideEff cr w _ -> w | otherwise = footstepSideEffect cr w where - hasJetPack = any (\it -> it ^? itType == Just JETPACK) $ _crInv cr + hasJetPack = any (\it -> it ^? itType . iyBase == Just JETPACK) $ _crInv cr oldPos = _crOldPos cr momentum' = 0.97 *.* (_crPos cr -.- _crOldPos cr) momentum'' | magV momentum' > 3 = 3 *.* normalizeV momentum' diff --git a/src/Dodge/Creature/Statistics.hs b/src/Dodge/Creature/Statistics.hs index 1079a85ea..8271aa473 100644 --- a/src/Dodge/Creature/Statistics.hs +++ b/src/Dodge/Creature/Statistics.hs @@ -15,7 +15,7 @@ strFromEquipment :: Creature -> Int strFromEquipment = sum . fmap equipmentStrValue . crCurrentEquipment equipmentStrValue :: Item -> Int -equipmentStrValue itm = case _itType itm of +equipmentStrValue itm = case _iyBase $ _itType itm of FRONTARMOUR -> negate 3 POWERLEGS -> 3 _ -> 0 diff --git a/src/Dodge/Creature/Test.hs b/src/Dodge/Creature/Test.hs index a2d2209e5..380abe35e 100644 --- a/src/Dodge/Creature/Test.hs +++ b/src/Dodge/Creature/Test.hs @@ -89,7 +89,7 @@ crIsArmouredFrom = hasFrontArmour hasFrontArmour :: Point2 -> Creature -> Bool hasFrontArmour p cr = fromMaybe False $ do invid <- cr ^? crEquipment . ix OnChest - ittype <- cr ^? crInv . ix invid . itType + ittype <- cr ^? crInv . ix invid . itType . iyBase return $ FRONTARMOUR == ittype && p /= _crOldPos cr && angleVV (unitVectorAtAngle (_crDir cr + frontarmdirection)) (p -.- _crOldPos cr) < pi/2 diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 0c60ae162..fbeaa7c64 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -487,11 +487,10 @@ data ItemConsumption } | NoConsumption data Item = Item - { _itName :: String - , _itConsumption :: ItemConsumption + { _itConsumption :: ItemConsumption , _itUse :: ItemUse , _itEquipPict :: Creature -> Item -> SPic - , _itType :: CombineType + , _itType :: ItemType , _itAttachment :: ItAttachment , _itID :: Maybe Int , _itInvPos :: Maybe Int @@ -504,7 +503,6 @@ data Item = Item , _itDimension :: ItemDimension , _itCurseStatus :: CurseStatus , _itTweaks :: ItemTweaks - , _itModules :: M.Map ModuleSlot ItemModule , _itScope :: Scope , _itValue :: ItemValue , _itParams :: ItemParams @@ -523,17 +521,6 @@ data Targeting , _tgID :: Maybe Int , _tgActive :: Bool } -data ModuleSlot - = ModBullet - | ModRifleMag - | ModAutoMag - | ModTarget - | ModBulletTrajectory - | ModLauncherHoming - | ModBattery - | ModTeleport - | ModDualBeam - deriving (Eq,Ord) data ItemModule = DefaultModule @@ -555,6 +542,7 @@ data ItemPortage , _muzPos :: Float } | WornItem + | NoPortage data ReloadType = ActiveClear @@ -600,6 +588,7 @@ data WorldBeams = WorldBeams } {- | Linear beams. Last only one frame. - Can interact with one another in a limited manner + - can probably be moved to a separate file -} data Beam = Beam { _bmDraw :: Beam -> Picture @@ -1000,7 +989,7 @@ data Sensor = NoSensor deriving (Eq,Ord) data ProximityRequirement = RequireHealth {_proxReqMinHealth :: Int} - | RequireEquipment {_proxReqEquipment :: CombineType} + | RequireEquipment {_proxReqEquipment :: ItemBaseType} | RequireImpossible deriving (Eq,Ord,Show) data CloseToggle = NotClose | IsClose diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index 048e53188..628055090 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -4,8 +4,14 @@ Description : Instances of data structures This module contains prototypical data structures. -} -module Dodge.Default where +module Dodge.Default + ( module Dodge.Default + , module Dodge.Default.Item + , module Dodge.Default.LightSource + ) where import Dodge.Default.Weapon +import Dodge.Default.LightSource +import Dodge.Default.Item import Dodge.Data import Dodge.SoundLogic import Dodge.Wall.Delete @@ -149,57 +155,21 @@ defaultState = CrSt , _crSpState = GenCr , _crDropsOnDeath = DropAll } + defaultEquipment :: Item -defaultEquipment = Item - { _itCurseStatus = Uncursed - , _itType = NOTDEFINED - , _itName = "genericEquipment" --- ,_itIdentity = Generic - , _itEquipPict = \_ _ -> (,) emptySH blank - , _itEffect = NoItEffect - , _itID = Nothing - , _itIsHeld = False - , _itInvColor = yellow - , _itInvDisplay = \it -> [_itName it] - , _itInvSize = 1 - , _itInvPos = Nothing +defaultEquipment = defaultItem + { _itInvColor = yellow , _itDimension = defItDimCol yellow - , _itConsumption = NoConsumption , _itUse = EquipUse defaultEquip , _itAttachment = NoItAttachment - , _itParams = NoParams - , _itTweaks = NoTweaks - , _itModules = M.empty - , _itScope = NoScope - , _itTargeting = NoTargeting - , _itValue = defaultItemValue } defaultItZoom :: ItZoom defaultItZoom = ItZoom 20 0.2 1 defaultConsumable :: Item -defaultConsumable = Item - { _itUse = NoUse --- , _itIdentity = Generic - , _itInvSize = 1 - , _itCurseStatus = Uncursed - , _itName = "genericConsumable" - , _itConsumption = ItemItselfConsumable {_itAmount = 1} - , _itEquipPict = \_ _ -> mempty - , _itID = Nothing - , _itInvPos = Nothing - , _itIsHeld = False +defaultConsumable = defaultItem + { _itConsumption = ItemItselfConsumable {_itAmount = 1} , _itInvColor = blue - , _itInvDisplay = \it -> [_itName it ++ " x" ++ show (_itAmount $ _itConsumption it)] - , _itEffect = NoItEffect - , _itAttachment = NoItAttachment - , _itType = NoCombineType - , _itParams = NoParams , _itDimension = defItDimCol blue - , _itTweaks = NoTweaks - , _itModules = M.empty - , _itScope = NoScope - , _itTargeting = NoTargeting - , _itValue = defaultItemValue } defaultFlIt :: FloorItem @@ -299,36 +269,6 @@ defaultPP = PressPlate , _ppID = -1 , _ppText = "Pressure plate" } -defaultLS :: LightSource -defaultLS = LS - { _lsID = 0 - , _lsParam = LSParam - { _lsPos = V3 0 0 50 - , _lsRad = 700 - , _lsCol = 0.6 - } - , _lsDir = 0 - , _lsPict = defLSPic - } -defLSPic :: LightSource -> Picture -defLSPic ls = setLayer BloomNoZWrite . translate3 (_lsPos $ _lsParam ls) . color col $ circleSolid 4 - where - col = V4 r g b 2 - V3 r g b = _lsCol $ _lsParam ls -defaultTLS :: TempLightSource -defaultTLS = TLS - { _tlsParam = LSParam - { _lsPos = 0 - , _lsRad = 0 - , _lsCol = 0.5 - } - , _tlsUpdate = f - , _tlsTime = 1 - } - where - f _ t - | _tlsTime t <= 0 = Nothing - | otherwise = Just $ t & tlsTime -~ 1 upHammer :: HammerType upHammer = HasHammer HammerUp diff --git a/src/Dodge/Default/Item.hs b/src/Dodge/Default/Item.hs new file mode 100644 index 000000000..aed6b38cb --- /dev/null +++ b/src/Dodge/Default/Item.hs @@ -0,0 +1,88 @@ +module Dodge.Default.Item + ( basicItemDisplay + , maybeWarmupStatus + , maybeRateStatus + , moduleStrings + , defaultItem + ) where +import Dodge.Data +import Padding +import Dodge.Inventory.ItemSpace +import Dodge.Module +import Picture +import ShapePicture +import Shape + +import Data.Maybe +import Data.Sequence +import Control.Lens + +defaultItem :: Item +defaultItem = Item + { _itCurseStatus = Uncursed + , _itType = defaultItemType + , _itEquipPict = \_ _ -> (,) emptySH blank + , _itEffect = NoItEffect + , _itID = Nothing + , _itIsHeld = False + , _itInvColor = yellow + , _itInvDisplay = basicItemDisplay + , _itInvSize = 1 + , _itInvPos = Nothing + , _itDimension = ItemDimension 0 0 NoPortage (const mempty) + , _itConsumption = NoConsumption + , _itUse = NoUse + , _itAttachment = NoItAttachment + , _itParams = NoParams + , _itTweaks = NoTweaks + , _itScope = NoScope + , _itTargeting = NoTargeting + , _itValue = ItemValue 0 MundaneItem + } + +{- | Displays the item name, ammo if loaded, and any selected '_itCharMode'. -} +basicItemDisplay :: Item -> [String] +basicItemDisplay it = Prelude.take (itSlotsTaken it) $ + (midPadL 15 ' ' thename (' ' : thenumber) ++ theparam) + : moduleStrings it ++ repeat "*" + where + thename = show . _iyBase $ _itType it + thenumber = case it ^? itConsumption of + Just am@LoadableAmmo{} -> case _laReloadState am of + Nothing' -> show (_laLoaded am) + Just' x -> show x ++ "R" ++ show (_laLoaded am) + Just am@ChargeableAmmo{} -> show $ _wpCharge am + Just x@ItemItselfConsumable{} -> "x" ++ show (_itAmount x) + Just NoConsumption -> "" + Nothing -> "" + theparam = fromMaybe [] + . listToMaybe + $ mapMaybe ($ it) + [ maybeModeStatus +-- , maybeWarmupStatus +-- , maybeRateStatus + ] +-- this can be moved to Dodge/Module and unified with moduleSizes + +maybeModeStatus :: Item -> Maybe String +maybeModeStatus it = case it ^? itAttachment of + Just ItCharMode {_itCharMode = (c :<| _)} -> Just [' ',c] + Just ItMode {_itMode = i} -> Just $ show i + _ -> Nothing + +maybeRateStatus :: Item -> Maybe String +maybeRateStatus it = case it ^? itUse . useDelay . rateMaxMax of + Nothing -> Nothing + _ -> Just $ leftPad 3 ' ' (show (_rateMax . _useDelay $ _itUse it)) + +maybeWarmupStatus :: Item -> Maybe String +maybeWarmupStatus it = case it ^? itUse . useDelay . warmMax of + Nothing -> Nothing + Just m -> case m - (_warmTime . _useDelay $ _itUse it) of + x | x <= 1 -> Just "WARM" + | otherwise -> let n = show x + in Just $ Prelude.take (4 - Prelude.length n) "WARM" ++ n + +defaultItemType :: ItemType +defaultItemType = ItemType NOTDEFINED mempty + diff --git a/src/Dodge/Default/LightSource.hs b/src/Dodge/Default/LightSource.hs new file mode 100644 index 000000000..e67ae151d --- /dev/null +++ b/src/Dodge/Default/LightSource.hs @@ -0,0 +1,36 @@ +module Dodge.Default.LightSource where +import Dodge.Data +import Picture +import Geometry +import LensHelp + +defaultLS :: LightSource +defaultLS = LS + { _lsID = 0 + , _lsParam = LSParam + { _lsPos = V3 0 0 50 + , _lsRad = 700 + , _lsCol = 0.6 + } + , _lsDir = 0 + , _lsPict = defLSPic + } +defLSPic :: LightSource -> Picture +defLSPic ls = setLayer BloomNoZWrite . translate3 (_lsPos $ _lsParam ls) . color col $ circleSolid 4 + where + col = V4 r g b 2 + V3 r g b = _lsCol $ _lsParam ls +defaultTLS :: TempLightSource +defaultTLS = TLS + { _tlsParam = LSParam + { _lsPos = 0 + , _lsRad = 0 + , _lsCol = 0.5 + } + , _tlsUpdate = f + , _tlsTime = 1 + } + where + f _ t + | _tlsTime t <= 0 = Nothing + | otherwise = Just $ t & tlsTime -~ 1 diff --git a/src/Dodge/Default/Weapon.hs b/src/Dodge/Default/Weapon.hs index c6879084f..dd59249a1 100644 --- a/src/Dodge/Default/Weapon.hs +++ b/src/Dodge/Default/Weapon.hs @@ -1,6 +1,7 @@ module Dodge.Default.Weapon where import Dodge.Data +import Dodge.Default.Item import Dodge.Item.Weapon.InventoryDisplay import Dodge.Item.Draw import Picture @@ -94,11 +95,10 @@ defaultAimParams = AimParams , _aimStance = OneHand } + defaultGun :: Item -defaultGun = Item - { _itName = "default" - , _itType = NoCombineType - , _itCurseStatus = Uncursed +defaultGun = defaultItem + { _itCurseStatus = Uncursed , _itConsumption = defaultAmmo , _itUse = defaultrUse , _itDimension = defItDimCol white @@ -113,41 +113,23 @@ defaultGun = Item , _itInvSize = 1 , _itParams = NoParams , _itTweaks = NoTweaks - , _itModules = M.fromList - [(ModBullet, DefaultModule) - ,(ModTarget, DefaultModule) - ,(ModBulletTrajectory, DefaultModule) - ,(ModTeleport, DefaultModule) - ] , _itScope = NoScope , _itTargeting = NoTargeting - , _itValue = defaultItemValue - } + } + & itType . iyModules .~ M.fromList + [(ModBullet, EMPTYMODULE) + ,(ModTarget, EMPTYMODULE) + ,(ModBulletTrajectory, EMPTYMODULE) + ,(ModTeleport, EMPTYMODULE) + ] + defaultItemValue :: ItemValue defaultItemValue = ItemValue 10 MundaneItem defaultCraftable :: Item -defaultCraftable = Item - { _itName = "default" - , _itType = NoCombineType - , _itCurseStatus = Uncursed - , _itConsumption = NoConsumption - , _itUse = NoUse - , _itEquipPict = pictureWeaponOnAim - , _itAttachment = NoItAttachment - , _itID = Nothing - , _itInvPos = Nothing - , _itIsHeld = False - , _itEffect = NoItEffect - , _itInvDisplay = basicItemDisplay +defaultCraftable = defaultItem + { _itEquipPict = pictureWeaponOnAim , _itInvColor = green - , _itInvSize = 1 - , _itParams = NoParams , _itDimension = defItDimCol green - , _itTweaks = NoTweaks - , _itModules = M.empty - , _itScope = NoScope - , _itTargeting = NoTargeting - , _itValue = defaultItemValue } defItDim :: ItemDimension defItDim = ItemDimension diff --git a/src/Dodge/IncBall.hs b/src/Dodge/IncBall.hs new file mode 100644 index 000000000..b2ef3d8cd --- /dev/null +++ b/src/Dodge/IncBall.hs @@ -0,0 +1,10 @@ +module Dodge.IncBall where +import Dodge.Data +import Dodge.Particle.HitEffect.ExpireAndDamage +import Dodge.Particle.Damage +import Dodge.PtFlicker +import Geometry +import Picture + +import System.Random +import Control.Monad.State diff --git a/src/Dodge/Item.hs b/src/Dodge/Item.hs index bdbaada16..1928aaf37 100644 --- a/src/Dodge/Item.hs +++ b/src/Dodge/Item.hs @@ -3,6 +3,10 @@ module Dodge.Item , module Dodge.Item.Consumable , module Dodge.Item.PassKey ) where +import Dodge.Data import Dodge.Item.Weapon import Dodge.Item.Consumable import Dodge.Item.PassKey + +fromType :: ItemType -> Item +fromType ct = undefined diff --git a/src/Dodge/Item/Consumable.hs b/src/Dodge/Item/Consumable.hs index e99557461..4e946c49c 100644 --- a/src/Dodge/Item/Consumable.hs +++ b/src/Dodge/Item/Consumable.hs @@ -14,13 +14,13 @@ import qualified Data.IntMap.Strict as IM medkit :: Int -> Item medkit i = defaultConsumable - { _itName = "MEDKIT" ++ show i - , _itUse = ConsumeUse + { _itUse = ConsumeUse {_cUse = \_ cr w -> w & creatures . ix (_crID cr) . crHP +~ i } , _itEquipPict = pictureWeaponAim $ const $ (,) emptySH $ color blue $ circleSolid 3 , _itID = Nothing } + & itType . iyBase .~ MEDKIT i heal25 :: Int -> World -> Maybe World heal25 = heal 25 diff --git a/src/Dodge/Item/Craftable.hs b/src/Dodge/Item/Craftable.hs index ab87b24b7..b2b977da2 100644 --- a/src/Dodge/Item/Craftable.hs +++ b/src/Dodge/Item/Craftable.hs @@ -9,19 +9,18 @@ import Color --import Geometry import Control.Lens -makeTypeCraftNum :: Int -> CombineType -> Item +makeTypeCraftNum :: Int -> ItemBaseType -> Item makeTypeCraftNum i ct = defaultCraftable { _itInvSize = 0.5 , _itCurseStatus = Uncursed - , _itName = show ct - , _itType = ct , _itConsumption = ItemItselfConsumable i } + & itType . iyBase .~ ct -makeTypeCraft :: CombineType -> Item +makeTypeCraft :: ItemBaseType -> Item makeTypeCraft = makeTypeCraftNum 1 -makeModule :: CombineType -> Item +makeModule :: ItemBaseType -> Item makeModule ct = makeTypeCraft ct & itInvSize .~ 1 & itInvColor .~ chartreuse diff --git a/src/Dodge/Item/Equipment.hs b/src/Dodge/Item/Equipment.hs index 26224305b..8eca9187e 100644 --- a/src/Dodge/Item/Equipment.hs +++ b/src/Dodge/Item/Equipment.hs @@ -22,14 +22,13 @@ import LensHelp import Data.Maybe magShield :: Item magShield = defaultEquipment - { _itType = MAGSHIELD - , _itName = "MAGSHIELD" - , _itEquipPict = \_ _ -> (,) emptySH blank + { _itEquipPict = \_ _ -> (,) emptySH blank , _itID = Nothing , _itAttachment = ItMInt Nothing } & itUse . eqEq . eqUse .~ useMagShield & itUse . eqEq . eqSite .~ GoesOnWrist + & itType . iyBase .~ MAGSHIELD useMagShield :: Item -> Creature -> World -> World useMagShield it cr w = w & magnets . at mgid ?~ themagnet where @@ -46,37 +45,34 @@ useMagShield it cr w = w & magnets . at mgid ?~ themagnet flameShield :: Item flameShield = defaultEquipment - { _itType = FLAMESHIELD - , _itName = "FLAMESHIELD" - , _itEquipPict = \cr _ -> (,) emptySH $ setDepth 20 $ pictures [color cyan $ circle (_crRad cr+2)] + { _itEquipPict = \cr _ -> (,) emptySH $ setDepth 20 $ pictures [color cyan $ circle (_crRad cr+2)] , _itID = Nothing } & itUse . eqEq . eqSite .~ GoesOnChest + & itType . iyBase .~ FLAMESHIELD {- | Slows you down, blocks forward projectiles. -} frontArmour :: Item frontArmour = defaultEquipment - { _itType = FRONTARMOUR - , _itName = "FARMOUR" - , _itEquipPict = pictureOnEquip (emptySH , setDepth 20 $ pictures + { _itEquipPict = pictureOnEquip (emptySH , setDepth 20 $ pictures [color thecol $ thickArc 0 (pi/2) 10 5 ,color thecol $ thickArc (3*pi/2) (2*pi) 10 5 ]) , _itID = Nothing } & itUse . eqEq . eqSite .~ GoesOnChest + & itType . iyBase .~ FRONTARMOUR where thecol = yellow -- (greyN 0.1) wristArmour :: Item wristArmour = defaultEquipment - { _itType = WRISTARMOUR - , _itName = "WRISTARMOUR" - , _itEquipPict = spicForWrist mempty + { _itEquipPict = spicForWrist mempty , _itID = Nothing } & itUse . eqEq . eqSite .~ GoesOnWrist & itUse . eqEq . eqOnEquip .~ onEquipWristShield & itUse . eqEq . eqUse .~ setWristShieldPos & itUse . eqEq . eqOnRemove .~ onRemoveWristShield + & itType . iyBase .~ WRISTARMOUR onEquipWristShield :: Item -> Creature -> World -> World onEquipWristShield itm cr w = w @@ -114,8 +110,6 @@ flatShield = defaultEquipment , _itEffect = effectOnOffHeld createShieldWall removeShieldWall -- the above seems to work, but I am not sure why: it may break on edge -- cases - , _itName = "FLATSHIELD" - , _itType = FLATSHIELD , _itUse = RightUse { _rUse = \_ _ -> id , _useDelay = NoDelay @@ -135,6 +129,7 @@ flatShield = defaultEquipment ,"*" ++ replicate 13 ' ' ++ "*" ] } + & itType . iyBase .~ FLATSHIELD flatShieldEquipSPic :: Item -> SPic flatShieldEquipSPic _ = ( colorSH yellow $ upperPrismPoly 10 (rectWH 2 10) @@ -215,29 +210,25 @@ effectOnOffHeld f f' = ItInvEffectID {- | Increases speed, reduces friction, cannot only move forwards. -} jetPack :: Item jetPack = defaultEquipment - { _itType = JETPACK - , _itName = "JETPACK" - , _itEquipPict = \_ _ -> (,) emptySH $ setDepth 20 + { _itEquipPict = \_ _ -> (,) emptySH $ setDepth 20 $ pictures [color yellow $ polygon $ rectNSEW 5 (-5) (-3) (-11) ] , _itEffect = NoItEffect , _itID = Nothing } & itUse . eqEq . eqSite .~ GoesOnBack + & itType . iyBase .~ JETPACK brainHat :: Item brainHat = defaultEquipment - { _itType = BRAINHAT - , _itName = "BRAINHAT" - , _itEquipPict = pictureOnEquip (noPic $ colorSH yellow $ upperPrismPoly 3 $ rectWH 4 4) + { _itEquipPict = pictureOnEquip (noPic $ colorSH yellow $ upperPrismPoly 3 $ rectWH 4 4) , _itEffect = NoItEffect , _itID = Nothing } & itUse . eqEq . eqSite .~ GoesOnHead + & itType . iyBase .~ BRAINHAT headLamp1 :: Item headLamp1 = defaultEquipment - { _itType = HEADLAMP - , _itName = "HEADLAMP1" - , _itEquipPict = pictureOnEquip (noPic $ colorSH yellow $ + { _itEquipPict = pictureOnEquip (noPic $ colorSH yellow $ translateSHf 5 2 (upperPrismPoly 8 $ rectWH 4 1) <> translateSHf 5 (-2) (upperPrismPoly 8 $ rectWH 4 1) -- <> (upperPrismPoly 3 $ rectWH 4 4) @@ -247,16 +238,16 @@ headLamp1 = defaultEquipment } & itUse . eqEq . eqUse .~ createHeadLamp & itUse . eqEq . eqSite .~ GoesOnHead + & itType . iyBase .~ HEADLAMP1 headLamp :: Item headLamp = defaultEquipment - { _itType = HEADLAMP - , _itName = "HEADLAMP" - , _itEquipPict = pictureOnEquip (noPic headLampShape) + { _itEquipPict = pictureOnEquip (noPic headLampShape) , _itEffect = NoItEffect , _itID = Nothing } & itUse . eqEq . eqUse .~ createHeadLamp & itUse . eqEq . eqSite .~ GoesOnHead + & itType . iyBase .~ HEADLAMP headLampShape :: Shape headLampShape = colorSH yellow $ @@ -271,34 +262,28 @@ createHeadLamp _ cr = tempLightSources .:~ tlsTimeRadColPos 1 200 0.7 powerLegs :: Item powerLegs = defaultEquipment - { _itType = POWERLEGS - , _itName = "POWERLEGS" - , _itEquipPict = pictureOnEquip (noPic $ translateSH (V3 0 4 0) $ colorSH yellow $ upperPrismPoly 3 $ rectWH 2 2) + { _itEquipPict = pictureOnEquip (noPic $ translateSH (V3 0 4 0) $ colorSH yellow $ upperPrismPoly 3 $ rectWH 2 2) , _itEffect = NoItEffect , _itID = Nothing } & itUse . eqEq . eqSite .~ GoesOnLegs + & itType . iyBase .~ POWERLEGS speedLegs :: Item speedLegs = powerLegs - { _itType = SPEEDLEGS - , _itName = "SPEEDLEGS" - } + & itType . iyBase .~ SPEEDLEGS jumpLegs :: Item jumpLegs = powerLegs - { _itType = JUMPLEGS - , _itName = "JUMPLEGS" - } + & itType . iyBase .~ JUMPLEGS wristInvisibility :: Item wristInvisibility = defaultEquipment - { _itType = INVISIBILITYEQUIPMENT GoesOnWrist - , _itName = "WRISTINVISIBILITY" - , _itEquipPict = shapeForWrist (colorSH chartreuse $ upperPrismPoly 3 $ rectWH 2 2) + { _itEquipPict = shapeForWrist (colorSH chartreuse $ upperPrismPoly 3 $ rectWH 2 2) , _itID = Nothing } & itUse . eqEq . eqSite .~ GoesOnWrist & itUse . eqEq . eqOnEquip .~ overCID (crCamouflage .~ Invisible) & itUse . eqEq . eqOnRemove .~ overCID (crCamouflage .~ FullyVisible) + & itType . iyBase .~ INVISIBILITYEQUIPMENT GoesOnWrist overCID :: (Creature -> Creature) -> Item -> Creature -> World -> World overCID f _ cr = creatures . ix (_crID cr) %~ f diff --git a/src/Dodge/Item/PassKey.hs b/src/Dodge/Item/PassKey.hs index 1120f9160..79215b0d6 100644 --- a/src/Dodge/Item/PassKey.hs +++ b/src/Dodge/Item/PassKey.hs @@ -3,19 +3,19 @@ import Dodge.Data import Dodge.Default import Picture import Geometry.Data +import LensHelp --import ShapePicture import Shape keyCard :: Int -> Item keyCard n = defaultEquipment - { _itType = KEYCARD n - , _itName = "KEYCARD-"++show n - , _itEquipPict = \_ _ -> (,) emptySH $ setDepth 0 $ translate (-5) (-5) $ rotate (pi/2.5) keyPic + { _itEquipPict = \_ _ -> (,) emptySH $ setDepth 0 $ translate (-5) (-5) $ rotate (pi/2.5) keyPic , _itEffect = NoItEffect , _itID = Nothing -- , _itZoom = defaultItZoom , _itInvColor = aquamarine - , _itInvDisplay = (:[]) . _itName } + & itType . iyBase .~ KEYCARD n + keyPic :: Picture keyPic = color green $ pictures [translate (-4) 0 $ thickCircle 4 2 @@ -25,9 +25,7 @@ keyPic = color green $ latchkey :: Int -> Item latchkey n = defaultEquipment - { _itType = NOTDEFINED - , _itName = "KEY "++show n - , _itEquipPict = \_ _ -> (,) emptySH $ setDepth 0 $ translate (-5) (-5) $ rotate (pi/2.5) latchkeyPic + { _itEquipPict = \_ _ -> (,) emptySH $ setDepth 0 $ translate (-5) (-5) $ rotate (pi/2.5) latchkeyPic , _itEffect = NoItEffect , _itID = Nothing -- , _itZoom = defaultItZoom diff --git a/src/Dodge/Item/Weapon/BatteryGuns.hs b/src/Dodge/Item/Weapon/BatteryGuns.hs index 2a8d6fea8..fb7aac0f2 100644 --- a/src/Dodge/Item/Weapon/BatteryGuns.hs +++ b/src/Dodge/Item/Weapon/BatteryGuns.hs @@ -17,6 +17,8 @@ module Dodge.Item.Weapon.BatteryGuns , splitBeamCombine ) where import Dodge.Data +import Dodge.Tesla +import Dodge.Beam import Dodge.Item.Weapon.LaserPath import Dodge.Item.Location import Dodge.Creature.HandPos @@ -52,28 +54,25 @@ import Control.Monad.State defaultBatteryGun :: Item defaultBatteryGun = defaultGun - & itModules .~ batteryModules + & itType . iyModules .~ batteryModules -batteryModules :: M.Map ModuleSlot ItemModule +batteryModules :: M.Map ModuleSlot ItemModuleType batteryModules = M.fromList - [(ModBattery, DefaultModule) - ,(ModTeleport, DefaultModule) + [(ModBattery, EMPTYMODULE) + ,(ModTeleport, EMPTYMODULE) ] defaultAutoBatteryGun :: Item defaultAutoBatteryGun = defaultAutoGun - & itModules .~ batteryModules + & itType . iyModules .~ batteryModules sparkGun :: Item sparkGun = teslaGun - & itName .~ "SPARKGUN" - & itType .~ SPARKGUN + & itType . iyBase .~ SPARKGUN & itParams . arcSize .~ 10 teslaGun :: Item teslaGun = defaultBatteryGun - { _itName = "TESLA" - , _itType = TESLAGUN - , _itConsumption = defaultAmmo + { _itConsumption = defaultAmmo { _laMax = 200 , _laLoaded = 200 , _laReloadTime = 80 @@ -97,14 +96,7 @@ teslaGun = defaultBatteryGun } , _itParams = teslaParams } -teslaParams :: ItemParams -teslaParams = Arcing - { _currentArc = Nothing - , _arcSize = 20 - , _arcNumber = 10 - , _newArcStep = defaultArcStep - , _previousArcEffect = NoPreviousArcEffect - } + & itType . iyBase .~ TESLAGUN teslaGunPic :: Item -> SPic teslaGunPic _ = noPic $ colorSH blue $ upperPrismPoly 5 (rectNESW xb 8 xa 0) @@ -114,8 +106,7 @@ teslaGunPic _ = noPic $ colorSH blue $ xb = 9 lasGunPulse :: Item lasGunPulse = lasGun - & itName .~ "PULSELAS" - & itType .~ LASPULSE + & itType . iyBase .~ LASPULSE & itUse . useMods .~ [ ammoCheckI , withItem $ \it -> withTempLight 1 (100 * frac it) (xyzV4 (_lasColor $ _itParams it)) @@ -134,8 +125,7 @@ lasGunPulse = lasGun lasGunWide :: Int -> Item lasGunWide n = lasGun - & itName .~ "PARALELLAS"++show n - & itType .~ LASGUNWIDE n + & itType . iyBase .~ LASGUNWIDE n & itParams . lasColor .~ orange & itParams . lasDamage .~ 2 & itUse .~ ( ruseInstant shootLaser NoHammer @@ -155,8 +145,7 @@ lasGunWide n = lasGun xs = [ 0.25 * (fromIntegral x - fromIntegral (n'-1) /2) | x <- [0..n'-1] ] lasGunWidePulse :: Item lasGunWidePulse = lasGun - & itName .~ "LASWIDEPULSE" - & itType .~ LASGUNWIDEPULSE + & itType . iyBase .~ LASGUNWIDEPULSE & itParams . lasColor .~ orange & itParams . lasDamage .~ 2 & itUse .~ ( ruseInstant shootLaser NoHammer @@ -183,8 +172,7 @@ lasGunWidePulse = lasGun n' = (ceiling $ (150 :: Float) * frac it) :: Int lasGunSway :: Item lasGunSway = lasGun - & itName .~ "SWAYLAS" - & itType .~ LASGUNSWAY + & itType . iyBase .~ LASGUNSWAY & itParams . lasColor .~ orange & itParams . lasDamage .~ 11 & itUse .~ ( ruseInstant shootLaser NoHammer @@ -206,8 +194,7 @@ lasGunSway = lasGun x' = _lasCycle $ _itParams it lasGunFocus :: Int -> Item lasGunFocus n = lasGunWide n - & itName .~ "FOCALAS"++show n - & itType .~ LASGUNFOCUS n + & itType . iyBase .~ LASGUNFOCUS n & itParams . lasColor .~ red & itUse . useMods .~ [ ammoCheckI @@ -223,8 +210,7 @@ lasGunFocus n = lasGunWide n lasGunDual :: Item lasGunDual = lasGun - & itName .~ "DUALAS" - & itType .~ LASGUNDUAL + & itType . iyBase .~ LASGUNDUAL & itParams .~ DualBeam { _phaseV = 1 , _lasColor = orange @@ -246,11 +232,10 @@ lasGunDual = lasGun & useAim . aimRange .~ 1 & useAim . aimStance .~ TwoHandTwist ) - & itModules . at ModDualBeam ?~ DefaultModule + & itType . iyModules . at ModDualBeam ?~ EMPTYMODULE lasGunSwing :: Item lasGunSwing = lasGun - & itName .~ "SWINGLAS" - & itType .~ LASGUNSWING + & itType . iyBase .~ LASGUNSWING & itParams . lasColor .~ orange & itUse . useMods .~ [ ammoCheckI @@ -268,9 +253,7 @@ lasGunSwing = lasGun x' = _lasCycle $ _itParams it lasGun :: Item lasGun = defaultAutoBatteryGun - { _itName = "LASGUN" - , _itType = LASGUN - , _itConsumption = defaultAmmo + { _itConsumption = defaultAmmo { _laMax = 200 , _laLoaded = 200 , _laReloadTime = 80 @@ -303,6 +286,8 @@ lasGun = defaultAutoBatteryGun , _dimSPic = lasGunPic } } + & itType . iyBase .~ LASGUN + lasGunPic :: Item -> SPic lasGunPic it = ( colorSH blue $ @@ -335,9 +320,7 @@ lasGunTweak = TweakParam tractorGun :: Item tractorGun = lasGun - { _itName = "TRACTORGUN" - , _itType = TRACTORGUN - , _itConsumption = defaultAmmo + { _itConsumption = defaultAmmo { _laMax = 10000 , _laLoaded = 10000 , _laReloadTime = 40 @@ -360,6 +343,8 @@ tractorGun = lasGun , _tweakSel = 0 } } + & itType . iyBase .~ TRACTORGUN + tractorGunTweak :: TweakParam tractorGunTweak = TweakParam { _doTweak = thetweak @@ -400,84 +385,6 @@ shootTeslaArc it cr w = w' pos = _crPos cr +.+ aimingMuzzlePos cr it *.* unitVectorAtAngle dir dir = _crDir cr -shootTeslaArc' :: ItemParams -> Point2 -> Float -> World -> (World,ItemParams) -shootTeslaArc' ip pos dir w = - (w & randGen .~ g - & instantParticles .:~ aTeslaArcAt col newarc - , ip & currentArc ?~ newarc - ) - where - (col,g) = takeOne [white,azure,blue,cyan] & runState $ _randGen w - newarc = createArc ip w pos dir & evalState $ _randGen w - - -createArc :: ItemParams - -> World - -> Point2 - -> Float - -> State StdGen [ArcStep] -createArc arcparams@Arcing{_currentArc = Nothing} w p dir = createNewArc arcparams w p dir -createArc arcparams w p dir = updateArc arcparams w p dir - -createNewArc :: ItemParams -> World -> Point2 -> Float - -> State StdGen [ArcStep] -createNewArc arcparams w p dir = take (_arcNumber arcparams) - <$> unfoldrMID (_newArcStep arcparams arcparams w) (ArcStep p dir Nothing) - -defaultArcStep :: RandomGen g => ItemParams -> World -> ArcStep - -> State g (Maybe ArcStep) -defaultArcStep _ _ (ArcStep _ _ (Just _)) = return Nothing -defaultArcStep itparams w (ArcStep p dir _) = do - let csize = _arcSize itparams - --rot <- takeOne [pi/4,negate pi/4] - rot <- takeOne [0] - let center = csize *.* rotateV rot (unitVectorAtAngle dir) +.+ p - newp <- (center +.+) <$> randInCirc csize - let mcr = listToMaybe - . sortOn (dist center . _crPos) - . filter (\cr -> dist center (_crPos cr) < csize) - . IM.elems - $ _creatures w - wlsnearpoint = wallsNearPoint p w - mwl = listToMaybe - . sortOn (dist p . fst) - . mapMaybe (\ q -> collidePointWallsWall p (center +.+ q) wlsnearpoint) - $ polyCirc 6 csize - f (q,wl) = ArcStep q dir (Just $ Right wl) - g cr = ArcStep (_crPos cr +.+ csize *.* unitVectorAtAngle dir) dir (Just $ Left cr) - return . listToMaybe . sortOn (dist p . (^. asPos)) - $ ArcStep newp dir Nothing : catMaybes [fmap f mwl,fmap g mcr] - -updateArc :: ItemParams - -> World - -> Point2 - -> Float - -> State StdGen [ArcStep] -updateArc ip w p dir = take (_arcNumber ip) <$> zipArcs ip w (ArcStep p dir Nothing) carc - where - carc = tail $ fromJust $ _currentArc ip - -zipArcs :: ItemParams - -> World - -> ArcStep - -> [ArcStep] - -> State StdGen [ArcStep] -zipArcs ip w x (y:ys) = (x :) <$> do - defaultnext <- _newArcStep ip ip w x - case defaultnext of - Nothing -> return [] - Just z@(ArcStep _ _ (Just _)) -> return [z] - Just z -> do - p <- randInCirc 5 - let csize = _arcSize ip - center = _asPos x +.+ csize *.* unitVectorAtAngle (_asDir x) - newp = _asPos y +.+ p - --newdir = argV $ newp -.- _asPos x - newdir = _asDir x - if dist newp center < csize - then zipArcs ip w (y & asPos .~ newp & asDir .~ newdir) ys - else zipArcs ip w z ys -zipArcs ip w y _ = createNewArc ip w (_asPos y) (_asDir y) shootLaser :: Item -> Creature -> World -> World shootLaser it cr = instantParticles .:~ lasRayAt (_lasColor $ _itParams it) dam phasev pos dir @@ -537,64 +444,6 @@ dualRayAt :: BeamType -> Int -> World -> Color -> Int -> Float -> Point2 -> Floa dualRayAt bt itid w col dam phasev pos dir = basicBeamAt itid w col dam phasev pos dir & bmType .~ bt -flameBeamCombine :: (Point2,(Point2,Point2,Beam),(Point2,Point2,Beam)) - -> World -> World -flameBeamCombine (p,(a,b,_),(x,y,_)) - = makeFlame p (2 *.* normalizeV (normalizeV (b-.-a)+.+normalizeV (y-.-x))) - -lasBeamCombine :: (Point2,(Point2,Point2,Beam),(Point2,Point2,Beam)) - -> World -> World -lasBeamCombine (p,(a,b,_),(x,y,_)) - = instantParticles .:~ lasRayAt yellow 11 1 p (argV (normalizeV (b-.-a)+.+normalizeV (y-.-x))) - -splitBeamCombine :: (Point2,(Point2,Point2,Beam),(Point2,Point2,Beam)) - -> World -> World -splitBeamCombine (p,(a,b,_),(x,y,_)) - = (instantParticles .:~ lasRayAt yellow 11 1 p (dir+0.5*pi)) - . (instantParticles .:~ lasRayAt yellow 11 1 p (dir-0.5*pi)) - where - dir = argV (normalizeV (b-.-a)+.+normalizeV (y-.-x)) - -teslaBeamCombine :: (Point2,(Point2,Point2,Beam),(Point2,Point2,Beam)) - -> World -> World -teslaBeamCombine (p,(a,b,bm),(x,y,_)) w - = w' & pointToItem (_itemPositions w IM.! itid) . itParams . subParams ?~ ip - where - itid = fromJust $ _bmOrigin bm - dir = argV (normalizeV (b-.-a)+.+normalizeV (y-.-x)) - (w',ip) = shootTeslaArc' (fromJust . _subParams $ _itParams it) p dir w - it = case getItem itid w of - Nothing -> error "tried to get item use teslaBeamCombine that doesn't exist" - Just itm -> itm - -lasRayAt :: Color -> Int -> Float -> Point2 -> Float -> Particle -lasRayAt col dam phasev pos dir = LaserParticle - { _ptDraw = const blank - , _ptUpdate = mvLaser phasev pos dir - , _ptRange = 800 - , _ptDamage = dam - , _ptPhaseV = phasev - , _ptColor = col - } -mvLaser :: Float -- ^ Phase velocity, controls deflection through windows - -> Point2 - -> Float - -> World - -> Particle - -> (World, Maybe Particle) -mvLaser phasev pos dir w pt - = ( damThingHitWith (\p1 p2 p3 -> Damage LASERING dam p1 p2 p3 NoDamageEffect) pos xp thHit w - , Just pt {_ptDraw = const pic ,_ptUpdate = ptSimpleTime 0 } - ) - where - dam = _ptDamage pt - xp = pos +.+ 800 *.* unitVectorAtAngle dir - (thHit, ps) = reflectLaserAlong phasev [] pos xp w - col = _ptColor pt - pic = setLayer BloomNoZWrite $ pictures - [ setDepth 19 . color (brightX 0 0.5 col) $ thickLine 20 (pos:ps) - , setDepth 19.5 . color (brightX 10 1 col) $ thickLine 3 (pos:ps) - ] aTractorBeam :: Item -> Creature -> World -> World aTractorBeam _ cr w = w & props . at i ?~ tractorBeamAt i spos outpos dir power where diff --git a/src/Dodge/Item/Weapon/Booster.hs b/src/Dodge/Item/Weapon/Booster.hs index fc32c01ef..2f4647486 100644 --- a/src/Dodge/Item/Weapon/Booster.hs +++ b/src/Dodge/Item/Weapon/Booster.hs @@ -110,9 +110,7 @@ maxT = 20 boosterGun :: Item boosterGun = defaultGun - { _itName = "BOOSTER" - , _itType = BOOSTER - , _itInvColor = cyan + { _itInvColor = cyan , _itConsumption = defaultAmmo { _laMax = 100 , _laLoaded = 100 @@ -121,6 +119,7 @@ boosterGun = defaultGun , _itUse = luseInstantNoH $ boostSelfL 10 , _itEffect = resetAttachmentID } + & itType . iyBase .~ BOOSTER resetAttachmentID :: ItEffect resetAttachmentID = ItInvEffect f 0 where diff --git a/src/Dodge/Item/Weapon/BulletGun/Cane.hs b/src/Dodge/Item/Weapon/BulletGun/Cane.hs index 024515d55..763cfa029 100644 --- a/src/Dodge/Item/Weapon/BulletGun/Cane.hs +++ b/src/Dodge/Item/Weapon/BulletGun/Cane.hs @@ -41,9 +41,7 @@ import Data.Maybe bangCane :: Item bangCane = defaultGun - { _itName = "BANGCANE" - , _itType = BANGCANE - , _itParams = BulletShooter + { _itParams = BulletShooter { _muzVel = 0.8 , _rifling = 0.9 , _bore = 2 @@ -82,11 +80,10 @@ bangCane = defaultGun <> makeSingleClipAt (V3 5 0 3) it } } & itUse . useAim . aimStance .~ OneHand + & itType . iyBase .~ BANGCANE bangCaneX :: Int -> Item bangCaneX i = bangCane - { _itName = "BANGCANEx"++show i - , _itType = BANGCANEX i - , _itUse = ruseAmmoParamsRate 6 upHammer + { _itUse = ruseAmmoParamsRate 6 upHammer [ ammoHammerCheck , useTimeCheck , withSoundItemChoiceStart caneStickSoundChoice @@ -121,6 +118,7 @@ bangCaneX i = bangCane ,_brlInaccuracy = 0.1 } & itParams . torqueAfter .~ 0.48 + 0.2 * fromIntegral i + & itType . iyBase .~ BANGCANEX i caneStickSoundChoice :: Item -> SoundID caneStickSoundChoice it | _laLoaded (_itConsumption it) < 2 = tap3S @@ -146,8 +144,7 @@ rifle = bangCane } } & itUse . useAim . aimStance .~ TwoHandTwist - & itName .~ "RIFLE" - & itType .~ RIFLE + & itType . iyBase .~ RIFLE & itConsumption . laMax .~ 1 & itUse . useAim . aimWeight .~ 6 & itUse . useAim . aimRange .~ 1 @@ -155,9 +152,8 @@ rifle = bangCane & itUse . useAim . aimZoom .~ defaultItZoom {_itZoomFac = 2} repeater :: Item repeater = rifle - & itModules . at ModRifleMag ?~ DefaultModule - & itName .~ "REPEATER" - & itType .~ REPEATER + & itType . iyModules . at ModRifleMag ?~ EMPTYMODULE + & itType . iyBase .~ REPEATER & itConsumption . laReloadType .~ ActiveClear & itConsumption . laReloadTime .~ 80 & itConsumption . laMax .~ 15 @@ -173,15 +169,13 @@ baseRifleShape = colorSH red $ upperPrismPoly 3 $ rectXH 25 2 autoRifle :: Item autoRifle = repeater - & itName .~ "AUTORIFLE" - & itType .~ AUTORIFLE + & itType . iyBase .~ AUTORIFLE & itUse . useMods %~ ((ammoCheckI :) . tail) - & itModules . at ModAutoMag ?~ DefaultModule + & itType . iyModules . at ModAutoMag ?~ EMPTYMODULE -- & itUse . useDelay . rateMax .~ 6 burstRifle :: Item burstRifle = repeater - & itName .~ "BURSTRIFLE" - & itType .~ BURSTRIFLE + & itType . iyBase .~ BURSTRIFLE & itParams . gunBarrels . brlInaccuracy .~ 0.05 & itUse . useDelay . rateMax .~ 18 & itUse . useMods .~ @@ -198,8 +192,7 @@ burstRifle = repeater ] fastBurstRifle :: Item fastBurstRifle = repeater - & itName .~ "FASTBURSTRIFLE" - & itType .~ FASTBURSTRIFLE + & itType . iyBase .~ FASTBURSTRIFLE & itParams . gunBarrels . brlInaccuracy .~ 0.06 & itUse . useDelay . rateMax .~ 18 & itUse . useMods .~ @@ -216,9 +209,8 @@ fastBurstRifle = repeater ] completeBurstRifle :: Item completeBurstRifle = repeater - & itName .~ "COMPLETEBURSTRIFLE" - & itType .~ COMPLETEBURSTRIFLE - & itModules . at ModRifleMag .~ Nothing + & itType . iyBase .~ COMPLETEBURSTRIFLE + & itType . iyModules . at ModRifleMag .~ Nothing & itParams . gunBarrels . brlInaccuracy .~ 0.1 & itUse . useDelay . rateMax .~ 28 & itUse . useMods .~ @@ -262,9 +254,7 @@ miniGunUse i = ruseInstant (useAmmoParams $ Just 1) NoHammer $ miniGunX :: Int -> Item miniGunX i = defaultAutoGun - { _itName = "MINIGUN-" ++ show i - , _itType = MINIGUNX i - , _itConsumption = defaultAmmo + { _itConsumption = defaultAmmo { _laType = basicBullet , _laMax = 1500 , _laLoaded = 1500 @@ -308,7 +298,7 @@ miniGunX i = defaultAutoGun } } & itDimension . dimPortage . muzPos .~ 40 - + & itType . iyBase .~ MINIGUNX i miniGunXPictItem :: Int -> Item -> SPic miniGunXPictItem i it = miniGunXPict i spin (_laLoaded $ _itConsumption it) where diff --git a/src/Dodge/Item/Weapon/BulletGun/Rod.hs b/src/Dodge/Item/Weapon/BulletGun/Rod.hs index cdd38f8e9..3f6121bad 100644 --- a/src/Dodge/Item/Weapon/BulletGun/Rod.hs +++ b/src/Dodge/Item/Weapon/BulletGun/Rod.hs @@ -7,6 +7,7 @@ module Dodge.Item.Weapon.BulletGun.Rod , machineGun ) where import Dodge.Data +import Dodge.Default.Item import Dodge.Item.Weapon.BulletGun.Clip import Dodge.Item.Weapon.InventoryDisplay import Dodge.Particle.HitEffect @@ -41,9 +42,7 @@ import Data.Maybe bangRod :: Item bangRod = defaultGun - { _itName = "BANGROD" - , _itType = BANGROD - , _itParams = BulletShooter + { _itParams = BulletShooter { _muzVel = 0.8 , _rifling = 1 , _bore = 2 @@ -79,6 +78,7 @@ bangRod = defaultGun , _laReloadTime = 20 } } + & itType . iyBase .~ BANGROD & itUse . useAim . aimWeight .~ 8 & itUse . useAim . aimRange .~ 1 & itUse . useAim . aimStance .~ OneHand @@ -90,8 +90,7 @@ baseAMRShape :: Shape baseAMRShape = colorSH orange $ upperPrismPoly 3 $ rectXH 30 2 elephantGun :: Item elephantGun = bangRod - & itName .~ "ELEPHANTGUN" - & itType .~ ELEPHANTGUN + & itType . iyBase .~ ELEPHANTGUN & itUse . useAim . aimStance .~ TwoHandTwist & itParams . gunBarrels .~ SingleBarrel 0.05 & itDimension . dimSPic .~ (\it -> noPic $ baseAMRShape @@ -112,8 +111,7 @@ elephantGun = bangRod & itParams . torqueAfter .~ 0.1 amr :: Item amr = elephantGun - & itName .~ "ANTIMATERIELRIFLE" - & itType .~ AMR + & itType . iyBase .~ AMR & itConsumption . laMax .~ 15 & itDimension . dimSPic .~ (\it -> noPic $ baseAMRShape <> makeTinClipAt 0 (V3 10 (-2) 0) it @@ -121,14 +119,12 @@ amr = elephantGun autoAmr :: Item autoAmr = amr - & itName .~ "AUTOAMR" - & itType .~ AUTOAMR + & itType . iyBase .~ AUTOAMR & itUse . useMods %~ ((ammoCheckI :) . tail) sniperRifle :: Item sniperRifle = elephantGun - & itName .~ "SNIPERRIFLE" - & itType .~ SNIPERRIFLE + & itType . iyBase .~ SNIPERRIFLE & itParams . gunBarrels .~ SingleBarrel 0 & itUse . useAim . aimZoom .~ defaultItZoom {_itZoomMax = 0.5, _itZoomMin = 0.5} & itUse . heldScroll .~ zoomLongGun @@ -137,8 +133,7 @@ sniperRifle = elephantGun & itUse . useAim . aimZoom .~ defaultItZoom {_itZoomFac = 1} machineGun :: Item machineGun = bangRod - & itName .~ "MACHINEGUN" - & itType .~ MACHINEGUN + & itType . iyBase .~ MACHINEGUN & itUse .~ (ruseAmmoParamsRate 25 NoHammer [ ammoCheckI , rateIncAB (torqueBeforeAtLeast 0.1 0.1) withTorqueAfter diff --git a/src/Dodge/Item/Weapon/BulletGun/Stick.hs b/src/Dodge/Item/Weapon/BulletGun/Stick.hs index 27db83660..21230470b 100644 --- a/src/Dodge/Item/Weapon/BulletGun/Stick.hs +++ b/src/Dodge/Item/Weapon/BulletGun/Stick.hs @@ -41,11 +41,7 @@ bangStickSoundChoice it bangStick :: Int -> Item bangStick i = defaultGun - { _itName = case i of - 1 -> "BANGSTICK" - _ -> "BANGSTICKx"++ show i - , _itType = BANGSTICK i - , _itConsumption = defaultAmmo + { _itConsumption = defaultAmmo { _laType = basicBullet , _laMax = i , _laReloadTime = 10 @@ -62,8 +58,6 @@ bangStick i = defaultGun -- , applyInaccuracy , withRecoil ] - , _itID = Nothing - , _itInvColor = white , _itParams = BulletShooter { _muzVel = 0.8 , _rifling = 0.8 @@ -89,6 +83,7 @@ bangStick i = defaultGun <> stickClip it } } + & itType . iyBase .~ BANGSTICK i baseStickShapeX :: Int -> Shape baseStickShapeX i = foldMap f [0..i-1] where @@ -115,9 +110,7 @@ stickClip it = case it ^? itConsumption . laLoaded of revolver :: Item revolver = pistol - { _itName = "REVOLVER" - , _itType = REVOLVER - , _itConsumption = defaultAmmo + { _itConsumption = defaultAmmo { _laType = basicBullet , _laMax = 6 , _laLoaded = 0 @@ -126,6 +119,7 @@ revolver = pistol } } & itDimension . dimSPic .~ (\it -> noPic $ baseStickShape <> revolverClip it) + & itType . iyBase .~ REVOLVER revolverClip :: Item -> Shape revolverClip it = case it ^? itConsumption . laLoaded of @@ -170,9 +164,7 @@ smgAfterHamMods = pistol :: Item pistol = (bangStick 1) - { _itName = "PISTOL" - , _itType = PISTOL - , _itConsumption = defaultAmmo + { _itConsumption = defaultAmmo { _laType = basicBullet , _laMax = 15 , _laLoaded = 0 @@ -183,8 +175,6 @@ pistol = (bangStick 1) (ammoHammerCheck : pistolAfterHamMods) -- , _itZoom = defaultItZoom -- , _itEquipPict = pictureWeaponAim pistolPic - , _itID = Nothing - , _itInvColor = white } & itDimension . dimSPic .~ (\it -> noPic $ baseStickShape <> makeTinClipAt pi (V3 5 2 0) it) & itParams %~ ( ( muzVel .~ 0.8 ) @@ -194,25 +184,23 @@ pistol = (bangStick 1) . ( recoil .~ 10 ) . ( torqueAfter .~ 0.2 ) ) + & itType . iyBase .~ PISTOL autoPistol :: Item autoPistol = pistol & itUse . useMods .~ (ammoCheckI : pistolAfterHamMods) - & itName .~ "AUTOPISTOL" - & itType .~ AUTOPISTOL - & itModules . at ModAutoMag ?~ DefaultModule + & itType . iyBase .~ AUTOPISTOL + & itType . iyModules . at ModAutoMag ?~ EMPTYMODULE machinePistol :: Item machinePistol = autoPistol & itUse . useDelay . rateMax .~ 2 & itUse . useMods .~ (ammoCheckI : machinePistolAfterHamMods) - & itName .~ "MACHINEPISTOL" - & itType .~ MACHINEPISTOL - & itModules . at ModAutoMag .~ Nothing + & itType . iyBase .~ MACHINEPISTOL + & itType . iyModules . at ModAutoMag .~ Nothing & itParams . recoil .~ 20 smg :: Item smg = autoPistol -- & some parameter affecting stability & itUse . useMods .~ (ammoCheckI : smgAfterHamMods) - & itName .~ "SMG" - & itType .~ SMG + & itType . iyBase .~ SMG & itUse . useAim . aimStance .~ TwoHandTwist & itDimension . dimPortage . handlePos .~ 2 & itParams . torqueAfter .~ 0.05 @@ -220,9 +208,7 @@ smg = autoPistol -- & some parameter affecting stability <> makeTinClipAt 0 (V3 7 (-2) 0) it) revolverX :: Int -> Item revolverX i = revolver - { _itName = "REVx"++show i - , _itType = REVOLVERX i - , _itUse = ruseAmmoParamsRate 8 upHammer + { _itUse = ruseAmmoParamsRate 8 upHammer [ ammoHammerCheck , useTimeCheck -- rather than locking the inventory, a better solution may be to check @@ -238,3 +224,4 @@ revolverX i = revolver , withRecoil ] } & itConsumption . laMax .~ i * 6 + & itType . iyBase .~ REVOLVERX i diff --git a/src/Dodge/Item/Weapon/BulletGuns.hs b/src/Dodge/Item/Weapon/BulletGuns.hs index 15be51c8d..88f7866a3 100644 --- a/src/Dodge/Item/Weapon/BulletGuns.hs +++ b/src/Dodge/Item/Weapon/BulletGuns.hs @@ -5,7 +5,6 @@ module Dodge.Item.Weapon.BulletGuns , biggerBlunderbuss , biggestBlunderbuss , grenadeLauncher - , ltAutoGun , autogunSpread , autoGun , autoGunPic @@ -44,9 +43,7 @@ import System.Random autoGun :: Item autoGun = defaultAutoGun - { _itName = "AUTOGUN" - , _itType = AUTOGUN - , _itConsumption = defaultAmmo + { _itConsumption = defaultAmmo { _laType = basicBullet , _laMax = 30 , _laLoaded = 30 @@ -88,6 +85,7 @@ autoGun = defaultAutoGun } } & itUse . heldScroll .~ scrollCharMode + & itType . iyBase .~ AUTOGUN autoGunPic :: Item -> SPic autoGunPic it = noPic $ colorSH red (prismPoly @@ -100,9 +98,7 @@ autoGunPic it = noPic $ bangCone :: Item bangCone = defaultGun - { _itName = "BANGCONE" - , _itType = BANGCONE - , _itConsumption = defaultAmmo + { _itConsumption = defaultAmmo { _laType = basicBullet , _laMax = 5 , _laReloadTime = 25 @@ -143,6 +139,7 @@ bangCone = defaultGun <> upperPrismPoly 6 (rectNSEW 4 (-4) 15 5) } } + & itType . iyBase .~ BANGCONE coneRandItemUpdate :: State StdGen (Item -> Item) coneRandItemUpdate = do wth <- state $ randomR (1,5) @@ -158,9 +155,7 @@ coneRandItemParams = do blunderbuss :: Item blunderbuss = bangCone - {_itName = "BLUNDERBUSS" - ,_itType = BLUNDERBUSS - , _itDimension = ItemDimension + {_itDimension = ItemDimension { _dimRad = 8 , _dimCenter = V3 5 0 0 , _dimPortage = HeldItem @@ -175,11 +170,10 @@ blunderbuss = bangCone & itConsumption . laReloadTime .~ 30 & itUse . useAim . aimStance .~ TwoHandTwist & itUse . useAim . aimWeight .~ 6 + & itType . iyBase .~ BLUNDERBUSS bigBlunderbuss :: Item bigBlunderbuss = blunderbuss - {_itName = "BIGBLUNDERBUSS" - ,_itType = BIGBLUNDERBUSS - } + & itType . iyBase .~ BIGBLUNDERBUSS & itConsumption . laMax .~ 50 & itConsumption . laReloadTime .~ 36 & itParams . recoil .~ 200 @@ -187,9 +181,7 @@ bigBlunderbuss = blunderbuss & itParams . randomOffset .~ 16 biggerBlunderbuss :: Item biggerBlunderbuss = bigBlunderbuss - {_itName = "BIGGERBLUNDERBUSS" - ,_itType = BIGGERBLUNDERBUSS - } + & itType . iyBase .~ BIGGERBLUNDERBUSS & itConsumption . laMax .~ 75 & itConsumption . laReloadTime .~ 43 & itParams . recoil .~ 250 @@ -197,9 +189,7 @@ biggerBlunderbuss = bigBlunderbuss & itParams . randomOffset .~ 20 biggestBlunderbuss :: Item biggestBlunderbuss = biggerBlunderbuss - {_itName = "BIGGESTBLUNDERBUSS" - ,_itType = BIGGESTBLUNDERBUSS - } + & itType . iyBase .~ BIGGESTBLUNDERBUSS & itConsumption . laMax .~ 100 & itConsumption . laReloadTime .~ 50 & itParams . recoil .~ 300 @@ -209,39 +199,9 @@ biggestBlunderbuss = biggerBlunderbuss grenadeLauncher :: Int -> Item grenadeLauncher _ = bangCone -ltAutoGun :: Item -ltAutoGun = defaultAutoGun - { _itName = "AUTO-LT" - , _itType = LTAUTOGUN - , _itConsumption = defaultAmmo - { _laType = basicBullet - , _laMax = 15 - , _laLoaded = 0 - , _laReloadTime = 90 - } - , _itUse = ruseAmmoParamsRate 2 NoHammer - [ ammoCheckI - , useTimeCheck - , withSoundStart tap1S - , useAmmoAmount 1 - , applyInaccuracy - , withTorqueAfter - , withSidePushI 50 - , modClock 2 withMuzFlareI - ] --- , _itFloorPict = ltAutoGunPic - , _itParams = defBulletShooter - { _muzVel = 1 - , _rifling = 0.8 - , _bore = 2 - , _gunBarrels = SingleBarrel autogunSpread - } - } longGun :: Item longGun = defaultGun - { _itName = "LONGGUN" - , _itType = LONGGUN - , _itConsumption = defaultAmmo + { _itConsumption = defaultAmmo { _laType = hvBullet , _laMax = 1 , _laLoaded = 1 @@ -267,6 +227,7 @@ longGun = defaultGun , _itScope = ZoomScope (V2 0 0) 0 1 0.1 False -- , _itEffect = itemLaserScopeEffect } + & itType . iyBase .~ LONGGUN autogunSpread :: Float autogunSpread = 0.07 diff --git a/src/Dodge/Item/Weapon/Drone.hs b/src/Dodge/Item/Weapon/Drone.hs index cd51ea28d..348b11216 100644 --- a/src/Dodge/Item/Weapon/Drone.hs +++ b/src/Dodge/Item/Weapon/Drone.hs @@ -20,9 +20,7 @@ import Control.Lens lasDrones :: Item lasDrones = defaultGun - { _itName = "DRONES" - , _itType = DRONELAUNCHER - , _itConsumption = defaultAmmo + { _itConsumption = defaultAmmo { _laType = DroneAmmo { _amString = "LASDRONE" } , _laMax = 2 , _laLoaded = 2 @@ -39,6 +37,7 @@ lasDrones = defaultGun & useAim . aimStance .~ TwoHandTwist , _itEffect = NoItEffect } + & itType . iyBase .~ DRONELAUNCHER lasDronesPic :: Item -> SPic lasDronesPic _ = diff --git a/src/Dodge/Item/Weapon/Grenade.hs b/src/Dodge/Item/Weapon/Grenade.hs index 931f8123d..a67ad78c9 100644 --- a/src/Dodge/Item/Weapon/Grenade.hs +++ b/src/Dodge/Item/Weapon/Grenade.hs @@ -220,7 +220,7 @@ throwRemoteBomb :: Creature -> World -> World throwRemoteBomb cr w = setLocation $ removePict $ resetFire - $ resetName +-- $ resetName $ over props addG w where cid = _crID cr @@ -237,7 +237,7 @@ throwRemoteBomb cr w = setLocation v | magV v' > 6 = 6 *.* normalizeV v' | otherwise = v' j = _crInvSel cr - resetName = set (creatures . ix cid . crInv . ix j . itName) "REMOTE" +-- resetName = set (creatures . ix cid . crInv . ix j . itName) "REMOTE" removePict = set (creatures . ix cid . crInv . ix j . itEquipPict) $ \ _ _ -> emptyBlank resetFire = set (creatures . ix cid . crInv . ix j . itUse . rUse) $ \_ -> explodeRemoteBomb itid i @@ -258,14 +258,14 @@ explodeRemoteBomb itid pjid cr w = set (props . ix pjid . pjUpdate) (\_ -> retireRemoteBomb itid 30 pjid) -- $ set (props . ix pjid . pjDraw) (\_ -> blank) $ set (creatures . ix cid . crInv . ix j . itUse . rUse) (\_ -> const id) - $ resetName +-- $ resetName $ resetPict -- $ resetScope $ makeExplosionAt (_pjPos (_props w IM.! pjid)) w -- - $ makeShrapnelBombAt (_pjPos (_props w IM.! pjid)) w where cid = _crID cr - resetName = set (creatures . ix cid . crInv . ix j . itName) "REMOTEBOMB" +-- resetName = set (creatures . ix cid . crInv . ix j . itName) "REMOTEBOMB" resetPict = set (creatures . ix cid . crInv . ix j . itEquipPict ) (pictureWeaponAim $ \_ -> (,) emptySH remoteBombUnarmedPic) -- resetScope = creatures . ix cid . crInv . ix j . itScope . _Just . scopePos .~ (0,0) diff --git a/src/Dodge/Item/Weapon/InventoryDisplay.hs b/src/Dodge/Item/Weapon/InventoryDisplay.hs index cfd1420c3..219d958b6 100644 --- a/src/Dodge/Item/Weapon/InventoryDisplay.hs +++ b/src/Dodge/Item/Weapon/InventoryDisplay.hs @@ -2,11 +2,7 @@ Display of weapon strings in the inventory. -} module Dodge.Item.Weapon.InventoryDisplay - ( basicItemDisplay - , maybeWarmupStatus - , maybeRateStatus - , moduleStrings - ) where + where import Dodge.Data import Padding import Dodge.Inventory.ItemSpace @@ -15,46 +11,4 @@ import Dodge.Module import Data.Maybe import Data.Sequence import Control.Lens -{- | Displays the item name, ammo if loaded, and any selected '_itCharMode'. -} -basicItemDisplay :: Item -> [String] -basicItemDisplay it = Prelude.take (itSlotsTaken it) $ - (midPadL 15 ' ' thename (' ' : thenumber) ++ theparam) - : moduleStrings it ++ repeat "*" - where - thename = _itName it - thenumber = case it ^? itConsumption of - Just am@LoadableAmmo{} -> case _laReloadState am of - Nothing' -> show (_laLoaded am) - Just' x -> show x ++ "R" ++ show (_laLoaded am) - Just am@ChargeableAmmo{} -> show $ _wpCharge am - Just x@ItemItselfConsumable{} -> "x" ++ show (_itAmount x) - Just NoConsumption -> "" - Nothing -> "" - theparam = fromMaybe [] - . listToMaybe - $ mapMaybe ($ it) - [ maybeModeStatus --- , maybeWarmupStatus --- , maybeRateStatus - ] --- this can be moved to Dodge/Module and unified with moduleSizes - -maybeModeStatus :: Item -> Maybe String -maybeModeStatus it = case it ^? itAttachment of - Just ItCharMode {_itCharMode = (c :<| _)} -> Just [' ',c] - Just ItMode {_itMode = i} -> Just $ show i - _ -> Nothing - -maybeRateStatus :: Item -> Maybe String -maybeRateStatus it = case it ^? itUse . useDelay . rateMaxMax of - Nothing -> Nothing - _ -> Just $ leftPad 3 ' ' (show (_rateMax . _useDelay $ _itUse it)) - -maybeWarmupStatus :: Item -> Maybe String -maybeWarmupStatus it = case it ^? itUse . useDelay . warmMax of - Nothing -> Nothing - Just m -> case m - (_warmTime . _useDelay $ _itUse it) of - x | x <= 1 -> Just "WARM" - | otherwise -> let n = show x - in Just $ Prelude.take (4 - Prelude.length n) "WARM" ++ n diff --git a/src/Dodge/Item/Weapon/Launcher.hs b/src/Dodge/Item/Weapon/Launcher.hs index 735083233..f294970e1 100644 --- a/src/Dodge/Item/Weapon/Launcher.hs +++ b/src/Dodge/Item/Weapon/Launcher.hs @@ -38,9 +38,7 @@ import System.Random launcher :: Item launcher = defaultGun - { _itName = "ROCKO" - , _itType = LAUNCHER - , _itConsumption = defaultAmmo + { _itConsumption = defaultAmmo { _laType = ProjectileAmmo { _amPayload = makeExplosionAt , _amString = "EXPLOSIVE SHELL" @@ -71,7 +69,6 @@ launcher = defaultGun , _tweakParams = basicAmPjMoves } , _itInvSize = 3 - , _itInvDisplay = basicItemDisplay , _itDimension = ItemDimension { _dimRad = 9 , _dimCenter = V3 10 0 0 @@ -82,12 +79,12 @@ launcher = defaultGun , _dimSPic = launcherPic } } - & itModules . at ModLauncherHoming ?~ DefaultModule + & itType . iyBase .~ LAUNCHER + & itType . iyModules . at ModLauncherHoming ?~ EMPTYMODULE launcherX :: Int -> Item launcherX i = launcher - & itName .~ ("ROCKO-" ++ show i) - & itType .~ LAUNCHERX i + & itType . iyBase .~ LAUNCHERX i & itConsumption . laMax .~ i & itConsumption . laLoaded .~ i & itUse . rUse .~ usePjCreationX i @@ -287,8 +284,7 @@ remoteLauncherName = "ROCKO-REMOTE" remoteLauncher :: Item remoteLauncher = launcher - & itName .~ remoteLauncherName - & itType .~ REMOTELAUNCHER + & itType . iyBase .~ REMOTELAUNCHER & itUse . rUse .~ fireRemoteShell & itScope .~ RemoteScope (V2 0 0) 1 True & itConsumption . laType . amPjDraw .~ drawRemoteShell @@ -297,7 +293,7 @@ remoteLauncher = launcher fireRemoteShell :: Item -> Creature -> World -> World fireRemoteShell it cr w = set (creatures . ix cid . crInv . ix j . itUse . rUse) (\_ _ -> explodeRemoteRocket itid i) - $ set (creatures . ix cid . crInv . ix j . itName) remoteLauncherName +-- $ set (creatures . ix cid . crInv . ix j . itName) remoteLauncherName $ addRemRocket w' where (w',itid) = getHeldItemLoc cr w @@ -358,7 +354,7 @@ explodeRemoteRocket itid pjid w = w & props . ix pjid . pjUpdate .~ (\_ -> retireRemoteProj fireRemoteShell itid 30 pjid) & props . ix pjid . prDraw .~ const mempty & itPoint . itUse . rUse .~ (\_ _ -> id) - & itPoint . itName .~ "REMOTELAUNCHER" +-- & itPoint . itName .~ "REMOTELAUNCHER" & _pjPayload thepj (_pjPos thepj) where itPoint = pointToItem $ _itemPositions w IM.! itid diff --git a/src/Dodge/Item/Weapon/Radar.hs b/src/Dodge/Item/Weapon/Radar.hs index 6fc91bb5f..74471ed23 100644 --- a/src/Dodge/Item/Weapon/Radar.hs +++ b/src/Dodge/Item/Weapon/Radar.hs @@ -23,9 +23,7 @@ import Control.Lens Sends out pulses that display walls. -} clickDetector :: Detector -> Item clickDetector dt = defaultGun - { _itName = show dt - , _itType = CLICKDETECTOR dt - , _itConsumption = defaultAmmo + { _itConsumption = defaultAmmo , _itUse = ruseRate 20 (detectorEffect dt) upHammer [ ammoUseCheck ] @@ -34,12 +32,11 @@ clickDetector dt = defaultGun -- , _itZoom = defaultItZoom { _itZoomMax = 1} , _itEquipPict = pictureWeaponAim $ \_ -> (,) emptySH $ color blue $ polygon $ rectNESW 5 5 (-5) (-5) } + & itType . iyBase .~ CLICKDETECTOR dt autoDetector :: Detector -> Item autoDetector dt = defaultEquipment - { _itType = AUTODETECTOR dt - , _itName = "AUTO-" ++ show dt - , _itEquipPict = shapeForWrist (colorSH (detectorColor dt) $ upperPrismPoly 3 $ rectWH 2 2) + {_itEquipPict = shapeForWrist (colorSH (detectorColor dt) $ upperPrismPoly 3 $ rectWH 2 2) -- , _itEffect = autoRadarEffect , _itID = Nothing } @@ -47,6 +44,7 @@ autoDetector dt = defaultEquipment & itUse . eqEq . eqUse .~ autoEffect (detectorEffect dt) 100 click1S & itUse . eqEq . eqParams .~ EquipCounter 0 & itUse . eqEq . eqViewDist ?~ 350 + & itType . iyBase .~ AUTODETECTOR dt detectorColor :: Detector -> Color detectorColor dt = case dt of diff --git a/src/Dodge/Item/Weapon/SonicGuns.hs b/src/Dodge/Item/Weapon/SonicGuns.hs index a218c8108..0d57af056 100644 --- a/src/Dodge/Item/Weapon/SonicGuns.hs +++ b/src/Dodge/Item/Weapon/SonicGuns.hs @@ -30,9 +30,7 @@ import LensHelp sonicGun :: Item sonicGun = defaultAutoGun - { _itName = "SONICGUN" - , _itType = SONICGUN - , _itConsumption = defaultAmmo + { _itConsumption = defaultAmmo { _laMax = 10 , _laLoaded = 10 , _laReloadTime = 80 @@ -54,6 +52,7 @@ sonicGun = defaultAutoGun , _dimSPic = const $ noPic baseSonicShape } } + & itType . iyBase .~ SONICGUN baseSonicShape :: Shape baseSonicShape = colorSH rose $ upperPrismPoly 3 $ rectXH 25 2 diff --git a/src/Dodge/Item/Weapon/Spawn.hs b/src/Dodge/Item/Weapon/Spawn.hs index a79a42621..167c44152 100644 --- a/src/Dodge/Item/Weapon/Spawn.hs +++ b/src/Dodge/Item/Weapon/Spawn.hs @@ -16,8 +16,7 @@ import Control.Lens Creates a creature next to the creature using the item. -} spawnGun :: Creature -> Item spawnGun cr = defaultGun - { _itName = "SPAWNER" - , _itConsumption = defaultAmmo + { _itConsumption = defaultAmmo { _laMax = 1 , _laLoaded = 1 , _laReloadTime = 80 @@ -29,6 +28,7 @@ spawnGun cr = defaultGun , hammerCheckI ] } + & itType . iyBase .~ SPAWNER spawnCrNextTo :: Creature -- ^ Creature to spawn -> Creature -- ^ existing creature that will be spawned next to diff --git a/src/Dodge/Item/Weapon/SprayGuns.hs b/src/Dodge/Item/Weapon/SprayGuns.hs index 1141c682e..5abb840c5 100644 --- a/src/Dodge/Item/Weapon/SprayGuns.hs +++ b/src/Dodge/Item/Weapon/SprayGuns.hs @@ -39,9 +39,7 @@ import Control.Monad.State import System.Random poisonSprayer :: Item poisonSprayer = flameThrower - { _itName = "POISONSPRAYER" - , _itType = POISONSPRAYER - } + & itType . iyBase .~ POISONSPRAYER & itConsumption . laType .~ GasAmmo { _amString = "POISONGAS" , _amCreateGas = aGasCloud @@ -68,8 +66,7 @@ flamerPic it = am = fractionLoadedAmmo2 it flameSpitter :: Item flameSpitter = flameThrower - & itName .~ "FLAMESPITTER" - & itType .~ FLAMESPITTER + & itType . iyBase .~ FLAMESPITTER & itConsumption . laMax .~ 10 & itConsumption . laReloadTime .~ 20 & itParams . sprayNozzles . ix 0 . nzPressure .~ 4 @@ -92,8 +89,7 @@ flameSpitter = flameThrower flameTorrent :: Item flameTorrent = flameThrower - & itName .~ "FLAMETORRENT" - & itType .~ FLAMETORRENT + & itType . iyBase .~ FLAMETORRENT & itUse . useAim . aimZoom .~ defaultItZoom & itParams . sprayNozzles . ix 0 %~ ( (nzPressure .~ 10) @@ -103,12 +99,10 @@ flameTorrent = flameThrower blowTorch :: Item blowTorch = flameThrower - & itName .~ "BLOWTORCH" - & itType .~ BLOWTORCH + & itType . iyBase .~ BLOWTORCH flameWall :: Item flameWall = flameThrower - & itName .~ "FLAMEWALL" - & itType .~ FLAMEWALL + & itType . iyBase .~ FLAMEWALL & itParams . sprayNozzles .~ zipWith makeNozzle [0,0.6,-0.6] [2,2.5,2.5] where makeNozzle dir pres = Nozzle @@ -122,9 +116,7 @@ flameWall = flameThrower flameThrower :: Item flameThrower = defaultAutoGun - { _itName = "FLAMETHROWER" - , _itType = FLAMETHROWER - , _itConsumption = defaultAmmo + { _itConsumption = defaultAmmo { _laMax = 250 , _laLoaded = 0 , _laReloadTime = 100 @@ -145,7 +137,6 @@ flameThrower = defaultAutoGun & useAim . aimStance .~ TwoHandTwist -- , _itFloorPict = flamerPic -- , _itZoom = defaultItZoom - , _itAttachment = NoItAttachment , _itParams = Sprayer { _sprayNozzles = [ Nozzle @@ -169,6 +160,7 @@ flameThrower = defaultAutoGun } -- , _itFloorPict = flamerPic } + & itType . iyBase .~ FLAMETHROWER aGasCloud :: Float -> Point2 -> Float -> Creature -> World -> World aGasCloud pressure pos dir cr = makeGasCloud pos diff --git a/src/Dodge/Item/Weapon/Utility.hs b/src/Dodge/Item/Weapon/Utility.hs index b729a2fa8..8423f67bb 100644 --- a/src/Dodge/Item/Weapon/Utility.hs +++ b/src/Dodge/Item/Weapon/Utility.hs @@ -23,9 +23,7 @@ import Control.Lens rewindGun :: Item rewindGun = defaultGun - { _itName = "REWINDER" - , _itType = REWINDER - , _itInvColor = cyan + { _itInvColor = cyan , _itConsumption = ChargeableAmmo { _wpMaxCharge = 250 , _wpCharge = 0 @@ -35,6 +33,7 @@ rewindGun = defaultGun & lUse .~ useRewindGun & eqEq . eqSite .~ GoesOnChest } + & itType . iyBase .~ REWINDER rewindEffect :: Item -> Creature -> World -> World rewindEffect itm cr w | Just invid == _crLeftInvSel cr = w & rewindWorlds %~ (take maxcharge . (w' : )) @@ -65,14 +64,13 @@ useRewindGun _ _ w = case _rewindWorlds w of -- needs to shift this item to the current inventory slot shrinkGun :: Item shrinkGun = defaultGun - { _itName = "SHRINKER" - , _itType = SHRINKER - , _itConsumption = defaultAmmo + { _itConsumption = defaultAmmo , _itUse = defaultlUse {_lUse = hammerCheckL useShrinkGun} & useHammer .~ upHammer -- , _itFloorPict = shrinkGunPic , _itAttachment = ItBool True } + & itType . iyBase .~ SHRINKER shrinkGunPic :: Item -> SPic shrinkGunPic _ = noPic $ colorSH violet $ upperPrismPoly 5 $ square 5 @@ -92,9 +90,7 @@ useShrinkGun it cr w = if _itBool $ _itAttachment it blinkGun :: Item blinkGun = defaultGun - { _itName = "BLINKER" - , _itType = BLINKER - , _itInvColor = cyan + { _itInvColor = cyan , _itConsumption = defaultAmmo , _itUse = defaultlUse & lUse .~ hammerCheckL (shootL $ const blinkAction) @@ -102,42 +98,36 @@ blinkGun = defaultGun & eqEq . eqSite .~ GoesOnWrist -- , _itFloorPict = const . noPic . colorSH chartreuse $ upperPrismPoly 2 $ square 2 } + & itType . iyBase .~ BLINKER unsafeBlinkGun :: Item unsafeBlinkGun = blinkGun - & itName .~ "BLINKER-UNSAFE" - & itType .~ BLINKERUNSAFE + & itType . iyBase .~ BLINKERUNSAFE & itUse . lUse .~ hammerCheckL (shootL $ const unsafeBlinkAction) & itUse . eqEq . eqViewDist ?~ 400 effectGun :: String -> (Creature -> World -> World) -> Item effectGun name eff = defaultGun - { _itName = name ++ "Gun" - , _itUse = defaultrUse + { _itUse = defaultrUse & rUse .~ const eff & useMods .~ [hammerCheckI] } -effectGunCont :: String -> (Creature -> World -> World) -> Item -effectGunCont name eff = defaultGun - { _itName = name ++ "Gun" - , _itUse = defaultrUse {_rUse = const eff} - } + & itType . iyBase .~ EFFGUN name autoEffectGun :: String -> (Creature -> World -> World) -> Item -autoEffectGun name eff = defaultAutoGun - { _itName = name ++ "Gun" - , _itUse = defaultrUse {_rUse = const eff} +autoEffectGun name eff = defaultGun + { _itUse = defaultrUse {_rUse = const eff} } + & itType . iyBase .~ AUTOEFFGUN name forceFieldGun :: Item forceFieldGun = defaultGun - { _itName = "FORCEFIELDGUN" - , _itType = FORCEFIELDGUN - , _itConsumption = defaultAmmo & laType .~ ForceFieldAmmo forceField + { _itConsumption = defaultAmmo & laType .~ ForceFieldAmmo forceField , _itUse = ruseInstant useForceFieldGun (HasHammer HammerUp) [ hammerCheckI , ammoCheckI , useAmmoAmount 1] -- , _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2 [(-4,-4),(-4,4),(4,4),(4,0),(0,0),(0,-4)] , _itTargeting = targetRBPress & tgDraw .~ targetDistanceDraw , _itParams = ParamMID Nothing } + & itType . iyBase .~ FORCEFIELDGUN -- I believe because the targeting returns to nothing straight after you release -- the rmb, it is possible for this to do nothing -- TODO investigate more and fix diff --git a/src/Dodge/LightSource.hs b/src/Dodge/LightSource.hs index fbe370da2..9faa4d9e6 100644 --- a/src/Dodge/LightSource.hs +++ b/src/Dodge/LightSource.hs @@ -13,7 +13,7 @@ module Dodge.LightSource ) where import Dodge.Data import Geometry.Data -import Dodge.Default +import Dodge.Default.LightSource import LensHelp lsPosRad :: Point3 -> Float -> LightSource diff --git a/src/Dodge/LockAndKey.hs b/src/Dodge/LockAndKey.hs index b53642a5c..7de8a8b68 100644 --- a/src/Dodge/LockAndKey.hs +++ b/src/Dodge/LockAndKey.hs @@ -15,12 +15,12 @@ import Dodge.Item import System.Random import Control.Monad.State -bossKeyItems :: RandomGen g => [ (State g (SubCompTree Room), State g CombineType) ] +bossKeyItems :: RandomGen g => [ (State g (SubCompTree Room), State g ItemBaseType) ] bossKeyItems = [(return . UseAll <$> bossRoom autoCrit, takeOne [PISTOL]) ] -lockRoomMultiItems :: RandomGen g => [ ( State g (LabSubCompTree Room) , State g [CombineType] ) ] +lockRoomMultiItems :: RandomGen g => [ ( State g (LabSubCompTree Room) , State g [ItemBaseType] ) ] lockRoomMultiItems = [ (blinkAcrossChallenge, takeOne [[BLINKERUNSAFE,AUTODETECTOR WALLDETECTOR] ,[BLINKERUNSAFE,CLICKDETECTOR WALLDETECTOR] @@ -28,7 +28,7 @@ lockRoomMultiItems = ) ] -lockRoomKeyItems :: RandomGen g => [ (Int -> State g (LabSubCompTree Room) , State g CombineType ) ] +lockRoomKeyItems :: RandomGen g => [ (Int -> State g (LabSubCompTree Room) , State g ItemBaseType ) ] lockRoomKeyItems = [(lasCenSensEdge, takeOne [LAUNCHER,LASGUN,SPARKGUN,FLATSHIELD,FORCEFIELDGUN] ) ,(sensorRoomRunPast ELECTRICAL, takeOne [STATICMODULE,SPARKGUN] ) @@ -40,12 +40,12 @@ lockRoomKeyItems = ,(const $ lasTunnelRunPast 400, takeOne [FLATSHIELD,FORCEFIELDGUN]) ,(keyCardRoomRunPast 0, return (KEYCARD 0)) ] -keyCardRunPastRand :: RandomGen g => [ (Int -> State g (LabSubCompTree Room) , State g CombineType ) ] +keyCardRunPastRand :: RandomGen g => [ (Int -> State g (LabSubCompTree Room) , State g ItemBaseType ) ] keyCardRunPastRand = [(keyCardRoomRunPast 0, return (KEYCARD 0)) ] -itemRooms :: RandomGen g => [(CombineType, State g (LabSubCompTree Room))] +itemRooms :: RandomGen g => [(ItemBaseType, State g (LabSubCompTree Room))] itemRooms = [ (LAUNCHER , join $ takeOne [corridorBoss launcherCrit diff --git a/src/Dodge/Module.hs b/src/Dodge/Module.hs index 487f1ae5d..df6d04189 100644 --- a/src/Dodge/Module.hs +++ b/src/Dodge/Module.hs @@ -3,15 +3,24 @@ module Dodge.Module , moduleStrings ) where import Dodge.Data +--import Dodge.Combine.Module +import qualified Data.Map.Strict as M import Control.Lens import Data.Maybe +--moduleSizes :: Item -> Int +--moduleSizes = moduleFold (+) (^? modSize) 0 moduleSizes :: Item -> Int -moduleSizes = moduleFold (+) (^? modSize) 0 +moduleSizes = length . _iyModules . _itType +--moduleStrings :: Item -> [String] +--moduleStrings = moduleFold (++) (^? modName) [] moduleStrings :: Item -> [String] -moduleStrings = moduleFold (++) (^? modName) [] +moduleStrings = map show . M.elems . _iyModules . _itType -moduleFold :: (m -> m -> m) -> (ItemModule -> Maybe m) -> m -> Item -> m -moduleFold g f e = foldr (g . fromMaybe e . f) e . _itModules +--moduleFold :: (m -> m -> m) -> (ItemModule -> Maybe m) -> m -> Item -> m +--moduleFold g f e = foldr (g . fromMaybe e . f) e +-- . fmap fromModuleType +-- . _iyModules +-- . _itType diff --git a/src/Dodge/Placement/Instance/Analyser.hs b/src/Dodge/Placement/Instance/Analyser.hs index e1b9512ca..f3cbf1ecf 100644 --- a/src/Dodge/Placement/Instance/Analyser.hs +++ b/src/Dodge/Placement/Instance/Analyser.hs @@ -78,7 +78,7 @@ mcProximitySensorUpdate mc w = case mcProxTest :: Machine -> World -> Bool mcProxTest mc w = case mc ^? mcSensor . proxRequirement of Just (RequireHealth x) -> _crHP cr >= x - Just (RequireEquipment ct) -> any (\itm -> _itType itm == ct) (_crInv cr) + Just (RequireEquipment ct) -> any (\itm -> _iyBase (_itType itm) == ct) (_crInv cr) _ -> False where cr = you w diff --git a/src/Dodge/PtFlicker.hs b/src/Dodge/PtFlicker.hs new file mode 100644 index 000000000..49eb10d2c --- /dev/null +++ b/src/Dodge/PtFlicker.hs @@ -0,0 +1,11 @@ +module Dodge.PtFlicker where +import Dodge.Data +import Dodge.LightSource +import LensHelp +import Geometry + +ptFlicker :: Particle -> World -> World +ptFlicker pt + | _ptTimer pt `mod` 7 == 0 = tempLightSources + .:~ tlsTimeRadColPos 1 70 (0.5 *.*.* xyzV4 (_ptColor pt)) (addZ 10 $ _ptPos pt) + | otherwise = id diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index 20b0f3350..cb2c41cc0 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -172,10 +172,10 @@ drawRBOptions cfig w EquipOptions{_opEquip = es,_opSel=i, _opAllocateEquipment=a midtext str = listTextPictureAt 252 0 cfig curpos (text str) extratext str = listTextPictureAt 432 0 cfig curpos (text (str ++ deactivatetext)) deactivatetext = case w ^? rbOptions . opActivateEquipment . deactivateEquipment of - Just k -> " DEACTIVATES " ++ _itName (_crInv (you w) IM.! k) + Just k -> " DEACTIVATES " ++ show (_iyBase $ _itType (_crInv (you w) IM.! k)) Nothing -> "" curpos = invSelPos w - otheritem j = _itName (_crInv (you w) IM.! j) + otheritem j = show $ _iyBase $ _itType (_crInv (you w) IM.! j) drawRBOptions _ _ _ = mempty eqPosText :: EquipPosition -> String diff --git a/src/Dodge/Room/Containing.hs b/src/Dodge/Room/Containing.hs index 214fe797f..2f4e8ea48 100644 --- a/src/Dodge/Room/Containing.hs +++ b/src/Dodge/Room/Containing.hs @@ -24,7 +24,7 @@ roomsContaining crs its = do ] return (treeFromPost [] $ UseAll endroom ,TreeSubLabelling ("roomsContaining-creatures:" ++ intercalate "," (map _crName crs) - ++ "-items:" ++ intercalate "," (map _itName its)) Nothing) + ++ "-items:" ++ intercalate "," (map (show . _iyBase . _itType) its)) Nothing) pedestalRoom :: RandomGen g => Item -> State g Room pedestalRoom it = do diff --git a/src/Dodge/Tesla.hs b/src/Dodge/Tesla.hs new file mode 100644 index 000000000..5387f96d7 --- /dev/null +++ b/src/Dodge/Tesla.hs @@ -0,0 +1,12 @@ +module Dodge.Tesla where +import Dodge.Data +import Dodge.Beam + +teslaParams :: ItemParams +teslaParams = Arcing + { _currentArc = Nothing + , _arcSize = 20 + , _arcNumber = 10 + , _newArcStep = defaultArcStep + , _previousArcEffect = NoPreviousArcEffect + } diff --git a/src/Dodge/WorldEvent/Flash.hs b/src/Dodge/WorldEvent/Flash.hs index 5a0ed8fb7..b3e6f63b0 100644 --- a/src/Dodge/WorldEvent/Flash.hs +++ b/src/Dodge/WorldEvent/Flash.hs @@ -15,6 +15,7 @@ module Dodge.WorldEvent.Flash , flareCircleAt ) where import Dodge.Data +import Dodge.PtFlicker import Dodge.LightSource import Dodge.WorldEvent.HelperParticle --import Dodge.Default @@ -52,8 +53,3 @@ explosionFlashAt p = tempLightSources .:~ tlsTimeRadFunPos 20 150 intensityFunc | x < 10 = 1 / (10 - fromIntegral x) | otherwise = 1 -ptFlicker :: Particle -> World -> World -ptFlicker pt - | _ptTimer pt `mod` 7 == 0 = tempLightSources - .:~ tlsTimeRadColPos 1 70 (0.5 *.*.* xyzV4 (_ptColor pt)) (addZ 10 $ _ptPos pt) - | otherwise = id diff --git a/src/Dodge/WorldEvent/SpawnParticle.hs b/src/Dodge/WorldEvent/SpawnParticle.hs index 4af08d95e..c7b035c25 100644 --- a/src/Dodge/WorldEvent/SpawnParticle.hs +++ b/src/Dodge/WorldEvent/SpawnParticle.hs @@ -12,6 +12,7 @@ import Dodge.Base import Dodge.Zone import Dodge.Particle.HitEffect.ExpireAndDamage import Dodge.Particle.Damage +import Dodge.IncBall --import Dodge.WorldEvent.HitEffect import Dodge.WorldEvent.ThingsHit import Dodge.WorldEvent.Cloud @@ -114,21 +115,6 @@ moveFlame rotd w pt reflV wall = (0.3 *.* reflectIn (uncurry (-.-) . swap $ _wlLine wall) vel ) +.+ (0.2 *.* vel) -incBall :: RandomGen g => Point2 -> State g Particle -incBall p = do - rot <- state $ randomR (0,3) - return PtZ - { _ptDraw = drawFlameletZ rot - , _ptUpdate = moveFlamelet - , _ptVel = 0 - , _ptColor = red - , _ptPos = p - , _ptCrIgnore = Nothing - , _ptWidth = 3 - , _ptTimer = 20 - , _ptHitEff = expireAndDamage $ simpleDam FLAMING 20 - , _ptZ = 20 - } concBall :: Point2 -> State g Particle concBall p = return Shockwave @@ -207,6 +193,67 @@ drawStaticBall pt = setLayer BloomNoZWrite . uncurryV translate (_ptPos pt) $ circleSolidCol (_ptColor pt) (withAlpha 0.5 white) (_ptWidth pt+5) + +moveStaticBall :: World -> Particle -> (World, Maybe Particle) +moveStaticBall = moveFlamelet + +-- | Note damgeInRadius by itself never destroys the particle +damageInRadius :: Float -> Particle -> World -> World +damageInRadius size pt w = damwls damcrs + where + p = _ptPos pt + damcrs = foldr (\cr -> fst . hiteff [(p,Left cr)]) w $ IM.filter isClose $ _creatures w + damwls w' = foldr (\wl -> fst . hiteff [(p,Right wl)]) w' $ IM.filter closeWls $ wallsNearPoint p w + closeWls wl = uncurry circOnSeg (_wlLine wl) p size + isClose cr = dist p (_crPos cr) < _crRad cr + size + hiteff = _ptHitEff pt pt + +-- | At writing the radius is half the size of the effect area +makeGasCloud + :: Point2 -- ^ Position + -> Point2 -- ^ Velocity + -> World + -> World +makeGasCloud pos vel w = w + & clouds .:~ theCloud + & randGen .~ g + where + theCloud = Cloud + { _clPos = addZ 20 pos + , _clVel = addZ 0 vel + , _clPict = \_ -> setLayer MidLayer . setDepth 30 $ color (withAlpha 0.05 col) + $ circleSolid 20 + , _clRad = 10 + , _clAlt = 25 + , _clTimer = 400 + , _clType = GasCloud + , _clEffect = cloudPoisonDamage + } + (col, g) = runState (takeOne [green,yellow]) $ _randGen w +{- Attach poison cloud damage to creatures near cloud. -} +cloudPoisonDamage :: Cloud -> World -> World +cloudPoisonDamage c w = w & creatures %~ flip (foldr (IM.adjust doDam)) damagedCrs + where + damagedCrs = IM.keys $ IM.filter f $ creaturesNearPoint clpos w + f cr = dist3 (addZ 20 $ _crPos cr) (_clPos c) < _crRad cr + _clRad c + 10 + doDam cr = cr & crState . crDamage .:~ Damage POISONDAM 1 clpos clpos clpos NoDamageEffect + clpos = stripZ $ _clPos c + +incBall :: RandomGen g => Point2 -> State g Particle +incBall p = do + rot <- state $ randomR (0,3) + return PtZ + { _ptDraw = drawFlameletZ rot + , _ptUpdate = moveFlamelet + , _ptVel = 0 + , _ptColor = red + , _ptPos = p + , _ptCrIgnore = Nothing + , _ptWidth = 3 + , _ptTimer = 20 + , _ptHitEff = expireAndDamage $ simpleDam FLAMING 20 + , _ptZ = 20 + } drawFlameletZ :: Float -- ^ Rotation -> Particle @@ -252,8 +299,6 @@ drawFlameletZ rot pt = pictures s1 = (*) 2 $ log $ 2 + fromIntegral time / 40 s2 = 0.5 * (sc + s1) -moveStaticBall :: World -> Particle -> (World, Maybe Particle) -moveStaticBall = moveFlamelet {- Update of a flamelet. Applies movement and attaches damage to nearby creatures. -} -- This should be unified in many ways with moveFlame @@ -267,45 +312,3 @@ moveFlamelet w pt & ptPos .~ _ptPos pt +.+ _ptVel pt & ptCrIgnore .~ Nothing & ptVel .*.*~ 0.8 - --- | Note damgeInRadius by itself never destroys the particle -damageInRadius :: Float -> Particle -> World -> World -damageInRadius size pt w = damwls damcrs - where - p = _ptPos pt - damcrs = foldr (\cr -> fst . hiteff [(p,Left cr)]) w $ IM.filter isClose $ _creatures w - damwls w' = foldr (\wl -> fst . hiteff [(p,Right wl)]) w' $ IM.filter closeWls $ wallsNearPoint p w - closeWls wl = uncurry circOnSeg (_wlLine wl) p size - isClose cr = dist p (_crPos cr) < _crRad cr + size - hiteff = _ptHitEff pt pt - --- | At writing the radius is half the size of the effect area -makeGasCloud - :: Point2 -- ^ Position - -> Point2 -- ^ Velocity - -> World - -> World -makeGasCloud pos vel w = w - & clouds .:~ theCloud - & randGen .~ g - where - theCloud = Cloud - { _clPos = addZ 20 pos - , _clVel = addZ 0 vel - , _clPict = \_ -> setLayer MidLayer . setDepth 30 $ color (withAlpha 0.05 col) - $ circleSolid 20 - , _clRad = 10 - , _clAlt = 25 - , _clTimer = 400 - , _clType = GasCloud - , _clEffect = cloudPoisonDamage - } - (col, g) = runState (takeOne [green,yellow]) $ _randGen w -{- Attach poison cloud damage to creatures near cloud. -} -cloudPoisonDamage :: Cloud -> World -> World -cloudPoisonDamage c w = w & creatures %~ flip (foldr (IM.adjust doDam)) damagedCrs - where - damagedCrs = IM.keys $ IM.filter f $ creaturesNearPoint clpos w - f cr = dist3 (addZ 20 $ _crPos cr) (_clPos c) < _crRad cr + _clRad c + 10 - doDam cr = cr & crState . crDamage .:~ Damage POISONDAM 1 clpos clpos clpos NoDamageEffect - clpos = stripZ $ _clPos c