justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Defunction-ify item modules, requires more cleanup

Browse Source
This commit is contained in:
justin
2022-06-08 12:28:11 +01:00
parent d91a53f76c
commit bcbfd7d2fa
48 changed files with 762 additions and 740 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Annotation/Data.hs
+2 -2
View File
@@ -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]]
src/Dodge/Beam.hs
+158
View File
@@ -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)
src/Dodge/Combine.hs
+24 -21
View File
@@ -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
src/Dodge/Combine/Combinations.hs
+25 -45
View File
@@ -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]]
src/Dodge/Combine/Data.hs
+56 -4
View File
@@ -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
src/Dodge/Combine/Module.hs
+64
View File
@@ -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)
src/Dodge/Creature.hs
+1 -1
View File
@@ -262,7 +262,7 @@ stackedInventory = IM.fromList $ zip [0..]
,tractorGun
,longGun
,autoGun
,ltAutoGun
,autoPistol
,pistol
,teslaGun
,blinkGun
src/Dodge/Creature/Impulse/Movement.hs
-6
View File
@@ -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
src/Dodge/Creature/LtAutoCrit.hs
+1 -1
View File
@@ -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
src/Dodge/Creature/State.hs
+1 -1
View File
@@ -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'
src/Dodge/Creature/Statistics.hs
+1 -1
View File
@@ -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
src/Dodge/Creature/Test.hs
+1 -1
View File
@@ -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
src/Dodge/Data.hs
+5 -16
View File
@@ -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
src/Dodge/Default.hs
+12 -72
View File
@@ -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
src/Dodge/Default/Item.hs
+88
View File
@@ -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
src/Dodge/Default/LightSource.hs
+36
View File
@@ -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
src/Dodge/Default/Weapon.hs
+14 -32
View File
@@ -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
src/Dodge/IncBall.hs
+10
View File
@@ -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
src/Dodge/Item.hs
+4
View File
@@ -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
src/Dodge/Item/Consumable.hs
+2 -2
View File
@@ -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
src/Dodge/Item/Craftable.hs
+4 -5
View File
@@ -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
src/Dodge/Item/Equipment.hs
+23 -38
View File
@@ -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
src/Dodge/Item/PassKey.hs
+5 -7
View File
@@ -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
src/Dodge/Item/Weapon/BatteryGuns.hs
+24 -175
View File
@@ -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
src/Dodge/Item/Weapon/Booster.hs
+2 -3
View File
@@ -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
src/Dodge/Item/Weapon/BulletGun/Cane.hs
+15 -25
View File
@@ -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
src/Dodge/Item/Weapon/BulletGun/Rod.hs
+8 -13
View File
@@ -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
src/Dodge/Item/Weapon/BulletGun/Stick.hs
+13 -26
View File
@@ -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
src/Dodge/Item/Weapon/BulletGuns.hs
+11 -50
View File
@@ -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
src/Dodge/Item/Weapon/Drone.hs
+2 -3
View File
@@ -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 _ =
src/Dodge/Item/Weapon/Grenade.hs
+4 -4
View File
@@ -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)
src/Dodge/Item/Weapon/InventoryDisplay.hs
+1 -47
View File
@@ -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
src/Dodge/Item/Weapon/Launcher.hs
+7 -11
View File
@@ -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
src/Dodge/Item/Weapon/Radar.hs
+4 -6
View File
@@ -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
src/Dodge/Item/Weapon/SonicGuns.hs
+2 -3
View File
@@ -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
src/Dodge/Item/Weapon/Spawn.hs
+2 -2
View File
@@ -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
src/Dodge/Item/Weapon/SprayGuns.hs
+7 -15
View File
@@ -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
src/Dodge/Item/Weapon/Utility.hs
+14 -24
View File
@@ -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
src/Dodge/LightSource.hs
+1 -1
View File
@@ -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
src/Dodge/LockAndKey.hs
+5 -5
View File
@@ -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
src/Dodge/Module.hs
+13 -4
View File
@@ -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
src/Dodge/Placement/Instance/Analyser.hs
+1 -1
View File
@@ -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
src/Dodge/PtFlicker.hs
+11
View File
@@ -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
src/Dodge/Render/HUD.hs
+2 -2
View File
@@ -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
src/Dodge/Room/Containing.hs
+1 -1
View File
@@ -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
src/Dodge/Tesla.hs
+12
View File
@@ -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
}
src/Dodge/WorldEvent/Flash.hs
+1 -5
View File
@@ -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
src/Dodge/WorldEvent/SpawnParticle.hs
+62 -59
View File
@@ -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