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

Refactor, add bullet modules and weapon effect modifiers

Browse Source
This commit is contained in:
jgk
2021-05-27 02:50:33 +02:00
parent 0187ae6001
commit 346c426b43
13 changed files with 395 additions and 144 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Combine.hs
+35
View File
@@ -0,0 +1,35 @@
module Dodge.Combine
where
--import Dodge.Data
import Dodge.Combine.Data
--import qualified Data.IntMap.Strict as IM
--import qualified Data.IntSet as IS
import qualified Data.Map.Strict as M
--combineList :: IM.IntMap Item -> [(Item , IS.IntSet)]
--combineList
invert :: (Ord a) => M.Map b a -> M.Map a [b]
invert = M.foldrWithKey (\k val -> M.insertWith (++) val [k]) M.empty
combineList :: [([ItemType], ItemType)]
combineList =
[ ( [ Pistol, Pipe, Hardware ] , Rifle )
, ( [ Rifle, Hardware ] , Pistol )
, ( [ Pistol, Pistol, Hardware ] , SpreadGun 2 )
, ( [ SpreadGun 2, Pistol, Hardware ] , SpreadGun 3 )
, ( [ SpreadGun 3, Pistol, Hardware ] , SpreadGun 4 )
, ( [ SpreadGun 4, Pistol, Hardware ] , SpreadGun 5 )
, ( [ Pistol, AutoGun, Hardware ] , LtAutoGun )
, ( [ LtAutoGun, Pipe, Hardware ] , AutoGun )
, ( [ Rifle, Rifle, Hardware ] , MultGun 2 )
, ( [ MultGun 2, Rifle, Hardware ] , MultGun 3 )
, ( [ MultGun 3, Rifle, Hardware ] , MultGun 4 )
, ( [ MultGun 4, Rifle, Hardware ] , MultGun 5 )
, ( [ LtAutoGun, Pipe, Hardware ] , AutoGun )
, ( [ Pistol, BigTube, Hardware] , Launcher 1 )
, ( [ Launcher 1, BigTube, Pistol, Hardware] , Launcher 2)
, ( [ Launcher 2, BigTube, Pistol, Hardware] , Launcher 3)
]
src/Dodge/Combine/Data.hs
+34
View File
@@ -0,0 +1,34 @@
module Dodge.Combine.Data
where
data ItemType
= Pipe
| BigTube
| Plate
| MChip
| Magnet
| Motor
| LED
| Hardware
| Nailbox
| Plank
| Prism
| LightSensor
| SoundSensor
| HeatSensor
| CopperWire
| EmptyCan
| Pistol
| AutoGun
| Rifle
| LtAutoGun
| HvAutoGun
| HvRifle
| MultGun Int
| SpreadGun Int
| Launcher Int
| Battery
| PortableFusion
| AutoFiringMech
| FiringMech
| TargetingModule
deriving (Eq,Ord)
src/Dodge/Creature.hs
+2 -1
View File
@@ -157,7 +157,8 @@ startCr = defaultCreature
startInventory :: IM.IntMap Item
startInventory = IM.fromList (zip [0..20]
(
[blinkGun
[hvAutoGun
,blinkGun
,miniGun
,bezierGun
,multGun
src/Dodge/Creature/Action/UseItem.hs
+1 -1
View File
@@ -32,7 +32,7 @@ itemEffect
-> World
-> World
itemEffect cr Consumable{_cnEffect=eff } w = maybe w (rmSelectedInvItem (_crID cr)) (eff (_crID cr) w)
itemEffect cr it@Weapon{_itUse=eff} w = eff it cr w
itemEffect cr it@Weapon{_itUse=eff} w = foldr ($) eff (_itUseModifiers it) it cr w
itemEffect cr it@Throwable{_itUse = eff} w = eff it cr w
itemEffect _ _ w = w
src/Dodge/Data.hs
+13 -4
View File
@@ -194,8 +194,8 @@ data PressPlate = PressPlate
}
data FloorItem = FlIt { _flIt :: Item , _flItPos :: Point2 , _flItRot :: Float, _flItID :: Int}
data ItemPos
= InInv { _itCrId :: Int , _itInvId :: Int }
| OnFloor { _itFlID :: Int }
= InInv { _itCrId :: Int , _itInvId :: Int }
| OnFloor { _itFlID :: Int }
data Item
= Weapon
{ _itName :: String
@@ -207,6 +207,7 @@ data Item
, _itUseRate :: Int
, _itUseTime :: Int
, _itUse :: Item -> Creature -> World -> World
, _itUseModifiers :: [(Item -> Creature -> World -> World) -> Item -> Creature -> World -> World]
, _itLeftClickUse :: Maybe (Creature -> Int -> World -> World)
, _wpSpread :: Float
, _wpRange :: Float
@@ -391,23 +392,30 @@ data Particle
, _btMaxTime' :: Int
, _btTimer' :: Int
}
type HitEffect = Particle -> [(Point2, Either3 Creature Wall ForceField)] -> World -> (World,Maybe Particle)
type HitEffect = Particle
-> [(Point2, Either3 Creature Wall ForceField)]
-> World
-> (World,Maybe Particle)
data Ammo
= ShellAmmo
{ _amPayload :: Point2 -> World -> World
, _amString :: String
, _amPjMove :: [PjParam]
, _amPjParams :: [PjParam]
, _amPjDraw :: Projectile -> Picture
, _amParamSel :: Int
}
| BulletAmmo
{ _amString :: String
, _amBulEff :: HitEffect
, _amBulWth :: Float
, _amBulVel :: Point2
}
| GenericAmmo
data PjParam = PjParam
{ _pjMoveParam :: Int -> Item -> Creature -> Projectile -> World -> World
, _pjIntParam :: Int
, _pjMaxParam :: Int
, _pjDisplayParam :: Int -> String
}
data Projectile
@@ -677,6 +685,7 @@ makeLenses ''ItEffect
makeLenses ''ItZoom
makeLenses ''FloorItem
makeLenses ''Ammo
makeLenses ''PjParam
makeLenses ''Projectile
makeLenses ''Particle
makeLenses ''Wall
src/Dodge/Default/Weapon.hs
+3 -1
View File
@@ -16,6 +16,7 @@ defaultGun = Weapon
, _itUseRate = 8
, _itUseTime = 0
, _itUse = \_ _ -> id
, _itUseModifiers = []
, _itLeftClickUse = Nothing
, _wpSpread = 0.02
, _wpRange = 20
@@ -37,6 +38,7 @@ defaultGun = Weapon
, _itTargeting = Nothing
, _itWorldTrigger = Nothing
}
defaultAutoGun :: Item
defaultAutoGun = defaultGun
{ _itScrollUp = const id
@@ -48,7 +50,7 @@ defaultShellAmmo :: Ammo
defaultShellAmmo = ShellAmmo
{ _amPayload = \_ -> id
, _amString = "Shell"
, _amPjMove = []
, _amPjParams = []
, _amPjDraw = \_ -> blank
, _amParamSel = 0
}
src/Dodge/Event.hs
+19 -3
View File
@@ -92,12 +92,16 @@ wheelEvent y w = case (_carteDisplay w, _inventoryMode w) of
| otherwise -> w & selLocation %~ (`mod` numLocs) . (+ yi)
(_, TopInventory)
| rbDown -> fromMaybe (closeObjScrollDir y w) $ (yourItem w ^? itScrollUp)
<*> pure (_crInvSel (you w))
<*> pure w
<*> pure (_crInvSel (you w))
<*> pure w
| lbDown -> w & cameraZoom +~ y
| invKeyDown -> swapInvDir yi $ dirInvPos yi w
| otherwise -> dirInvPos yi w
(_, TweakInventory) -> w
(_, TweakInventory)
| invKeyDown && rbDown -> w & moveYourAmmoSel yi
| invKeyDown -> dirInvPos yi w
| rbDown -> w & moveYourAmmoParam yi
| otherwise -> w & moveYourAmmoSel yi
(_, _) -> w
where
yi = round $ signum y
@@ -106,6 +110,18 @@ wheelEvent y w = case (_carteDisplay w, _inventoryMode w) of
lbDown = ButtonLeft `S.member` _mouseButtons w
invKeyDown = ScancodeCapsLock `S.member` _keys w
moveYourAmmoSel :: Int -> World -> World
moveYourAmmoSel i w = case yourItem w ^? wpAmmo . amPjParams of
Just l -> w & creatures . ix (_yourID w) . crInv . ix (_crInvSel (you w))
. wpAmmo . amParamSel %~ (`mod` (length l)) . (subtract i)
_ -> w
moveYourAmmoParam :: Int -> World -> World
moveYourAmmoParam i w = case yourItem w ^? wpAmmo . amPjParams . ix paramid . pjMaxParam of
Just n -> w & creatures . ix (_yourID w) . crInv . ix (_crInvSel (you w))
. wpAmmo . amPjParams . ix paramid . pjIntParam %~ (`mod` n) . (+ i)
_ -> w
where
paramid = _amParamSel $ _wpAmmo $ yourItem w
swapInvDir :: Int -> World -> World
swapInvDir k w = w & creatures . ix (_yourID w) . crInv %~ IM.swapKeys (i `mod` n) ((i + k) `mod` n)
where
src/Dodge/Event/Keyboard.hs
+8 -10
View File
@@ -16,7 +16,7 @@ import Dodge.LightSources
import Dodge.LevelGen
import Dodge.Creature.Inanimate
import qualified Data.IntMap.Strict as IM
--import Dodge.Event.Test
import Dodge.Event.Test
import Dodge.Event.Menu
import SDL
@@ -51,13 +51,13 @@ handlePressedKeyInGame scode w
| scode == dropItemKey (_keyConfig w) = Just $ youDropItem w
| scode == toggleMapKey (_keyConfig w) = Just $ toggleMap w
| scode == reloadKey (_keyConfig w) = Just $ fromMaybe w $ startReloadingWeapon (you w) w
-- | scode == testEventKey (_keyConfig w) = Just $ testEvent w
| scode == testEventKey (_keyConfig w) = Just $ testEvent w
| scode == spaceActionKey (_keyConfig w) = Just $ spaceAction w
| scode == rotateCameraPlusKey (_keyConfig w) = Just $ w & cameraRot +~ 0.01
| scode == rotateCameraMinusKey (_keyConfig w) = Just $ w & cameraRot -~ 0.01
| scode == ScancodeF5 = Just $ dropLight w
| scode == ScancodeF6 = Just $ dropLight' w
| scode == ScancodeT = Just $ w & inventoryMode %~ toggleInv TweakInventory
| scode == ScancodeX = Just $ w & inventoryMode %~ toggleInv TweakInventory
| scode == ScancodeC = Just $ w & inventoryMode %~ toggleInv CombineInventory
| scode == ScancodeI = Just $ w & inventoryMode %~ toggleInv InspectInventory
handlePressedKeyInGame _ w = Just w
@@ -79,13 +79,11 @@ gotoTerminal w = case _menuLayers w of
spaceAction :: World -> World
spaceAction w = if _carteDisplay w
then
w & carteCenter .~ theLoc
else
case listToMaybe $ _closeActiveObjects w of
Just (Left flit) -> pickUpItem 0 flit w
Just (Right but) -> updateTopCloseObject (_btID but) $ _btEvent but but w
Nothing -> w
then w & carteCenter .~ theLoc
else case (_inventoryMode w, listToMaybe $ _closeActiveObjects w) of
(TopInventory,Just (Left flit)) -> pickUpItem 0 flit w
(TopInventory,Just (Right but)) -> updateTopCloseObject (_btID but) $ _btEvent but but w
_ -> w & inventoryMode .~ TopInventory
where
theLoc = fst (_seenLocations w IM.! _selLocation w) w
updateTopCloseObject i = closeActiveObjects %~ ( Right (_buttons w IM.! i) : ) . tail
src/Dodge/Item/Weapon.hs
+80 -70
View File
@@ -18,6 +18,7 @@ import Dodge.Item.Weapon.TriggerType
import Dodge.Item.Weapon.ExtraEffect
import Dodge.Item.Weapon.UseEffect
import Dodge.Item.Weapon.Laser
import Dodge.Item.Weapon.Shell
import Dodge.Default.Weapon
import Dodge.Item.Weapon.Booster
import Dodge.Item.Weapon.Grenade
@@ -43,23 +44,22 @@ import qualified Data.Set as S
--import qualified Data.Map as M
pistol :: Item
pistol = Weapon
pistol = defaultGun
{ _itName = "PISTOL"
, _itIdentity = Pistol
, _wpMaxAmmo = 15
, _wpLoadedAmmo = 15
, _wpAmmo = GenericAmmo
, _wpReloadTime = 40
, _wpReloadState = 0
, _itUseRate = 8
, _itUseTime = 0
, _itUse = \_ ->
hammerCheck
. shootWithSound 0
. withRandomDir 0.1
. withMuzFlare
. withVelWthHiteff (30,0) 2
$ destroyOnImpact bulHitCr bulHitWall' bulHitFF'
, _itUse = useAmmoParams
, _itUseModifiers =
[ hammerCheckI
, shootWithSoundI 0
, withRandomDirI 0.1
, withMuzFlareI
]
, _itLeftClickUse = Nothing
, _wpSpread = 0.02
, _wpRange = 20
@@ -80,7 +80,20 @@ pistol = Weapon
, _itInvColor = white
, _itTargeting = Nothing
, _itWorldTrigger = Nothing
, _wpAmmo = basicBullet
}
basicBullet :: Ammo
basicBullet = BulletAmmo
{ _amString = "BULLET"
, _amBulEff = destroyOnImpact bulHitCr bulHitWall' bulHitFF'
, _amBulWth = 2
, _amBulVel = (30,0)
}
useAmmoParams :: Item -> Creature -> World -> World
useAmmoParams it = withVelWthHiteff (_amBulVel b) (_amBulWth b) (_amBulEff b)
where
b = _wpAmmo it
effectGun :: String -> (Creature -> World -> World) -> Item
effectGun name eff = defaultGun
{ _itName = name ++ "Gun"
@@ -118,6 +131,7 @@ autoGun = defaultGun
, _itScrollUp = incCharMode
, _itScrollDown = decCharMode
, _itInvDisplay = basicWeaponDisplay
, _wpAmmo = basicBullet
}
autoFireMode, singleFireMode, autoGunNonTwistEff :: Creature -> World -> World
autoFireMode = shootWithSound (fromIntegral autoGunSound)
@@ -289,19 +303,25 @@ hvAutoGun = defaultAutoGun
, _wpReloadState = 0
, _itUseRate = 25
, _itUseTime = 0
, _itUse = \_ -> rateIncAB 24 10 (torqueBeforeForced 0.1 mkHvBul) $ torqueAfter 0.2 mkHvBul
, _itUse = \it -> rateIncAB 24 10 (torqueBeforeForced 0.1 (mkHvBul it))
(torqueAfter 0.2 (mkHvBul it))
, _wpRange = 20
, _itFloorPict = onLayer FlItLayer $ color orange $ polygon $ rectNESW 5 5 (-5) (-5)
, _itAimingSpeed = 0.2
, _itAimingRange = 1
, _itEquipPict = pictureWeaponOnAim $ color orange $ polygon $ rectNESW 5 5 (-5) (-5)
, _wpAmmo = BulletAmmo
{_amString = "HVBULLET"
, _amBulEff = penWalls hvBulHitCr' hvBulHitWall' bulHitFF'
, _amBulWth = 6
, _amBulVel = (80,0)
}
}
where
mkHvBul = withSound (fromIntegral longGunSound)
mkHvBul it = withSound (fromIntegral longGunSound)
. withThinSmoke
. withMuzFlare
. withVelWthHiteff (80,0) 6
$ penWalls hvBulHitCr' hvBulHitWall' bulHitFF'
$ useAmmoParams it
ltAutoGun :: Item
ltAutoGun = defaultAutoGun
{ _itName = "AUTO-LT"
@@ -337,11 +357,11 @@ miniGun = defaultAutoGun
, _itUseRate = 2
, _itUseTime = 0
, _itUse = \_ -> withWarmUp 50 . torqueBefore 0.03 . withSidePush 50 . withRecoil 15
. withRandomDir 0.1
. withRandomOffset 9
. withMuzFlare
. withVelWthHiteff (30,0) 2
$ destroyOnImpact bulBounceArmCr' bulHitWall' bulHitFF'
. withRandomDir 0.1
. withRandomOffset 9
. withMuzFlare
. withVelWthHiteff (30,0) 2
$ destroyOnImpact bulBounceArmCr' bulHitWall' bulHitFF'
, _wpRange = 20
, _itFloorPict = onLayer FlItLayer $ color red $ polygon $ rectNESW 9 5 (-9) (-5)
, _itAimingSpeed = 0.4
@@ -529,6 +549,16 @@ aTeslaArc' cr w
(sideOffset,g) = randomR (-5,5) $ _randGen w
dir = _crDir cr
remoteShellPic' :: Projectile -> Picture
remoteShellPic' pj
| t > 40 = onLayerL [levLayer CrLayer - 2]
$ uncurry translate pos $ rotate dir $ remoteShellPic t
| otherwise = uncurry translate pos $ rotate dir $ remoteShellPic t
where
t = _pjTimer pj
pos = _pjPos pj
dir = _pjDir pj
remoteShellPic
:: Int -- ^ Timer
-> Picture
@@ -735,13 +765,18 @@ fireRemoteLauncher cr w = setLocation
cid = _crID cr
dir = _crDir cr
pos = _crPos cr +.+ rotateV dir (_crRad cr + 1,0)
remRocket = IM.insert i $ Projectile
remRocket = IM.insert i $ Shell
{ _pjPos = pos
, _pjStartPos = pos
, _pjVel = rotateV dir (1,0)
, _pjDraw = \_ -> blank
, _pjDraw = remoteShellPic'
, _pjID = i
, _pjUpdate = \_ -> moveRemoteShell 50 i cid itid dir
, _pjUpdate = \pj -> decTimMvVel pj . moveRemoteShell cid itid pj
, _pjAcc = (0,0)
, _pjDir = dir
, _pjSpin = 0
, _pjPayload = makeExplosionAt
, _pjTimer = 50
}
j = _crInvSel cr
newitid = IM.newKey $ _itemPositions w
@@ -756,69 +791,44 @@ fireRemoteLauncher cr w = setLocation
_ -> w'
itid = fromMaybe newitid maybeitid
moveRemoteShell :: Int -> Int -> Int -> Int -> Float -> World -> World
moveRemoteShell time i cid itid _ w
moveRemoteShell :: Int -> Int -> Projectile -> World -> World
moveRemoteShell cid itid pj w
| time > 40 = if circOnSomeWall oldPos 4 w
then doExplosion w
else over (projectiles . ix i . pjPos) (+.+ vel)
$ set (projectiles . ix i . pjDraw) (\_ -> piclow)
$ set (projectiles . ix i . pjUpdate)
(\_ -> moveRemoteShell (time-1) i cid itid newdir)
$ setScope
w
then doExplosion w
else w & setScope
| time >= 20 = case thingHit of
Just _ -> doExplosion w
Nothing -> over (projectiles . ix i . pjPos) (+.+ vel)
$ set (projectiles . ix i . pjDraw) (\_ -> pic)
$ set (projectiles . ix i . pjUpdate)
(\_ -> moveRemoteShell (time-1) i cid itid newdir)
$ setScope
w
Nothing -> setScope w & projectiles . ix i . pjDir .~ newdir
| time > -99 = case thingHit of
Just _ -> doExplosion
$ stopSoundFrom (ShellSound i)
w
Nothing -> over (projectiles . ix i . pjPos) (+.+ vel)
$ set randGen g
$ set (projectiles . ix i . pjDraw) (\_ -> pic)
$ set (projectiles . ix i . pjUpdate) (\_ -> moveRemoteShell (time-1) i cid itid newdir)
$ over (projectiles . ix i . pjVel) (\v -> accel +.+ frict *.* v)
$ soundFromPos (ShellSound i) newPos (fromIntegral smokeTrailSound) 1 250
$ smokeGen
$ makeFlameletTimed oldPos (0.5 *.* rotateV (pi+sparkD) accel) Nothing 3 10
$ setScope
w
Just _ -> doExplosion $ stopSoundFrom (ShellSound i) w
Nothing -> w & set randGen g
& projectiles . ix i %~
( ( pjVel %~ ( (accel +.+) . (frict *.*) ) )
. ( pjDir .~ newdir )
)
& soundFromPos (ShellSound i) newPos (fromIntegral smokeTrailSound) 1 250
& smokeGen
& makeFlameletTimed oldPos (0.5 *.* rotateV (pi+sparkD) accel) Nothing 3 10
& setScope
| time > -200 = case thingHit of
Just _ -> doExplosion
$ stopSoundFrom (ShellSound i)
w
Nothing -> over (projectiles . ix i . pjPos) (+.+ vel)
$ set (projectiles . ix i . pjDraw) (\_ -> pic)
$ set (projectiles . ix i . pjUpdate) (\_ -> moveRemoteShell (time-1) i cid itid newdir)
$ setScope
w
| otherwise = doExplosion
$ stopSoundFrom (ShellSound i)
w
Just _ -> doExplosion $ stopSoundFrom (ShellSound i) w
Nothing -> setScope w
| otherwise = doExplosion $ stopSoundFrom (ShellSound i) w
where
pj = _projectiles w IM.! i
oldPos = _pjPos pj
vel = _pjVel pj
newPos = oldPos +.+ vel
time = _pjTimer pj
i = _pjID pj
oldPos = _pjPos pj
vel = _pjVel pj
newPos = oldPos +.+ vel
newdir
| SDL.ButtonRight `S.member` _mouseButtons w
&& w ^? creatures . ix cid . crInvSel == w ^? itemPositions . ix itid . itInvId
= _cameraRot w + argV (_mousePos w)
| otherwise = dir
accel = rotateV newdir (2,0)
(frict,g) = randomR (0.6,0.9) $ _randGen w
(frict,g) = randomR (0.6,0.9) $ _randGen w
(sparkD,_) = randomR (-0.5,0.5) $ _randGen w
dir = argV vel
pic = uncurry translate newPos
$ rotate (argV accel) $ remoteShellPic time
piclow = onLayerL [levLayer CrLayer - 2]
$ uncurry translate newPos $ rotate (argV accel)
$ remoteShellPic time
hitCr = fst <$> collideCircCrsPoint oldPos newPos 4 w
hitWl = fst <$> collideCircWalls' oldPos newPos 2 (wallsNearPoint newPos w)
thingHit = hitCr <|> hitWl
src/Dodge/Item/Weapon/Launcher.hs
+69 -37
View File
@@ -1,21 +1,22 @@
module Dodge.Item.Weapon.Launcher
where
import Dodge.Data
import Dodge.Item.Weapon.TriggerType
import Dodge.Default.Weapon
import Dodge.Default.Shell
import Dodge.SoundLogic.Synonyms
import Picture
import qualified IntMapHelp as IM
import Dodge.WorldEvent.Explosion
import Dodge.Picture.Layer
import Dodge.Item.Draw
import Geometry
import Dodge.Default.Shell
import Dodge.Item.Weapon.Shell
import Dodge.Item.Weapon.TriggerType
import Dodge.Base
import Dodge.SoundLogic
import Dodge.WorldEvent.SpawnParticle
import Dodge.WorldEvent.Cloud
import Dodge.RandomHelp
import Geometry
import Picture
import qualified IntMapHelp as IM
import Data.Maybe
import Control.Lens
@@ -45,7 +46,7 @@ launcher = defaultGun
, _wpAmmo = defaultShellAmmo
{ _amPayload = makeExplosionAt
, _amString = ""
, _amPjMove = basicAmPjMoves
, _amPjParams = basicAmPjMoves
, _amPjDraw = shellPic
}
}
@@ -54,19 +55,58 @@ basicAmPjMoves :: [PjParam]
basicAmPjMoves =
[spinDrag
,spinStart
,thrustParam
]
spinDrag :: PjParam
spinDrag = PjParam
{ _pjMoveParam = \_ _ _ -> reduceSpinBy 0.995
, _pjIntParam = 0
, _pjDisplayParam = ("SPIN DRAG:" ++ ) . show
{ _pjMoveParam = \i _ _ -> reduceSpinBy (1 - (fromIntegral i)*2 / 200)
, _pjIntParam = 1
, _pjDisplayParam = pjPadText "SPIN SLOWDOWN" . show
, _pjMaxParam = 5
}
pjPadText :: String -> String -> String
pjPadText s = (rightPad 12 ' ' s ++ ) . (' ':)
spinStart :: PjParam
spinStart = PjParam
{ _pjMoveParam = \_ _ cr -> pjEffAtTime 35 $ trySpinByCID (_crID cr)
, _pjIntParam = 0
, _pjDisplayParam = ("SPIN START:" ++ ) . show
{ _pjMoveParam = \i _ cr -> pjEffAtTime 35 $ trySpinByCID (_crID cr) i
, _pjIntParam = 2
, _pjDisplayParam = pjPadText "SPIN AMOUNT" . show
, _pjMaxParam = 5
}
thrustParam :: PjParam
thrustParam = PjParam
{ _pjMoveParam = \i _ _ -> pjThrust i
, _pjIntParam = 1
, _pjDisplayParam = pjPadText "THRUST DELAY" . show
, _pjMaxParam = 5
}
pjThrust :: Int -> Projectile -> World -> World
pjThrust i = pjEffTimeRange (st,et) $ doThrust
where
et | i == 0 = 36
| otherwise = 40 - (fromIntegral i * 20)
st = et - 100
doThrust :: Projectile -> World -> World
doThrust pj w = w
& randGen .~ g
& projectiles . ix i . pjVel %~ (\v -> accel +.+ frict *.* v)
& soundFromPos (ShellSound i) newPos (fromIntegral smokeTrailSound) 1 250
& makeFlameletTimed (oldPos -.- vel) (vel +.+ rotateV (pi+sparkD) accel) Nothing 3 10
& smokeGen
where
accel = _pjAcc pj
i = _pjID pj
oldPos = _pjPos pj
vel = _pjVel pj
newPos = oldPos +.+ vel
(frict,g) = randomR (0.6,0.9) $ _randGen w
(sparkD,_) = randomR (-0.2,0.2) $ _randGen w
r1 = randInCirc 10 & evalState $ _randGen w
smokeGen = makeSmokeCloudAt (oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos))
flameLauncher :: Item
flameLauncher = launcher & wpAmmo . amPayload .~ makeFlameExplosionAt
@@ -86,7 +126,7 @@ aRocketWithItemParams it cr w = over projectiles (IM.insert i theShell) w
i = IM.newKey $ _projectiles w
pos = _crPos cr +.+ ((_crRad cr +1) *.* unitVectorAtAngle dir)
dir = _crDir cr
ammoMvs pj w' = foldr (\pjP -> (_pjMoveParam pjP) (_pjIntParam pjP) it cr pj) w' (_amPjMove am)
ammoMvs pj w' = foldr (\pjP -> (_pjMoveParam pjP) (_pjIntParam pjP) it cr pj) w' (_amPjParams am)
theShell = defaultShell
{ _pjPos = pos
, _pjStartPos = pos
@@ -108,18 +148,10 @@ moveShell pj w
then doExplode
else w
| isJust thingHit = doExplode
| time >= 20 = w
| time > -99 = w
& randGen .~ g
& projectiles . ix i . pjVel %~ (\v -> accel +.+ frict *.* v)
& soundFromPos (ShellSound i) newPos (fromIntegral smokeTrailSound) 1 250
& makeFlameletTimed (oldPos -.- vel) (vel +.+ rotateV (pi+sparkD) accel) Nothing 3 10
& smokeGen
| time > -200 = w
| time > -300 = w
| otherwise = doExplode
where
time = _pjTimer pj
accel = _pjAcc pj
doExplode = w
& projectileExplosion oldPos
& stopSoundFrom (ShellSound i)
@@ -129,13 +161,9 @@ moveShell pj w
vel = _pjVel pj
projectileExplosion = _pjPayload pj
newPos = oldPos +.+ vel
(frict,g) = randomR (0.6,0.9) $ _randGen w
(sparkD,_) = randomR (-0.2,0.2) $ _randGen w
hitCr = fst <$> collideCircCrsPoint oldPos newPos 4 w
hitWl = fst <$> collideCircWalls' oldPos newPos 2 (wallsNearPoint newPos w)
thingHit = hitCr <|> hitWl
r1 = randInCirc 10 & evalState $ _randGen w
smokeGen = makeSmokeCloudAt (oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos))
reduceSpinBy :: Float -> Projectile -> World -> World
reduceSpinBy x pj = projectiles . ix (_pjID pj) . pjSpin *~ x
@@ -151,16 +179,18 @@ shellPic pj
pos = _pjPos pj
t = _pjTimer pj
decTimMvVel :: Projectile -> World -> World
decTimMvVel pj = projectiles . ix pjid %~
( (pjTimer -~ 1)
. (pjPos %~ (+.+ vel) )
. (pjAcc %~ rotateV rot )
)
pjEffTimeRange
:: (Int,Int)
-> (Projectile -> World -> World)
-> Projectile
-> World
-> World
pjEffTimeRange (st,et) f pj
| t <= et && t >= st = f pj
| otherwise = id
where
rot = _pjSpin pj
vel = _pjVel pj
pjid = _pjID pj
t = _pjTimer pj
pjEffAtTime
:: Int
@@ -174,13 +204,15 @@ pjEffAtTime t f pj
trySpinByCID
:: Int -- ^ creature id
-> Int -- ^ Spin amount
-> Projectile
-> World
-> World
trySpinByCID cid pj w = w & projectiles . ix pjid . pjSpin .~ newSpin
trySpinByCID cid i pj w = w & projectiles . ix pjid . pjSpin .~ newSpin
where
pjid = _pjID pj
dir = argV $ _pjVel pj
newSpin = case w ^? creatures . ix cid of
Just cr -> negate $ min 0.2 $ max (-0.2) $ normalizeAnglePi (dir - _crDir cr) / 20
Just cr -> negate $ min 0.2 $ max (-0.2) $ normalizeAnglePi (dir - _crDir cr) / spinFactor
_ -> 0
spinFactor = 5 * (6 - fromIntegral i)
src/Dodge/Item/Weapon/Shell.hs
+27
View File
@@ -0,0 +1,27 @@
module Dodge.Item.Weapon.Shell
where
import Dodge.Data
import Geometry.Vector
import Control.Lens
decTimMvVel :: Projectile -> World -> World
decTimMvVel pj = projectiles . ix pjid %~
( (pjTimer -~ 1)
. (pjPos %~ (+.+ vel) )
. (pjAcc %~ rotateV rot )
)
where
rot = _pjSpin pj
vel = _pjVel pj
pjid = _pjID pj
--pjAutoSpin :: Projectile -> World -> World
--pjAutoSpin pj = projectiles . ix pjid %~
-- ( (pjDir -~ 1)
-- . (pjPos %~ (+.+ vel) )
-- . (pjAcc %~ rotateV rot )
-- )
-- where
-- rot = _pjSpin pj
-- vel = _pjVel pj
-- pjid = _pjID pj
src/Dodge/Item/Weapon/TriggerType.hs
+61 -2
View File
@@ -153,8 +153,7 @@ withSidePushAfter maxSide eff cr w = over (creatures . ix cid) push . eff cr $ w
cid = _crID cr
push = over crPos (+.+ rotateV (_crDir cr) (0,pushAmount / _crMass cr))
(pushAmount, _) = randomR (-maxSide,maxSide) $ _randGen w
{- |
Applies a world effect and sound effect after an ammo check. -}
{- | Applies a world effect and sound effect after an ammo check. -}
shootWithSound
:: Int -- ^ Sound identifier
-> (Creature -> World -> World)
@@ -178,6 +177,30 @@ shootWithSound soundid f cr w
&& _itUseTime item == 0
&& _wpLoadedAmmo item > 0
reloadCondition = _wpLoadedAmmo item == 0
{- | Applies a world effect and sound effect after an ammo check. -}
shootWithSoundI
:: Int -- ^ Sound identifier
-> (Item -> Creature -> World -> World)
-- ^ Shoot effect, takes creature id as input
-> Item
-> Creature
-> World
-> World
shootWithSoundI soundid f item cr w
| fireCondition = over (pointerToItem . wpLoadedAmmo) (\ammo -> ammo-1)
$ soundOncePos soundid (_crPos cr)
$ set (pointerToItem . itUseTime) (_itUseRate item)
$ f item cr w
| reloadCondition = fromMaybe w $ startReloadingWeapon cr w
| otherwise = w
where
cid = _crID cr
itRef = _crInvSel cr
pointerToItem = creatures . ix cid . crInv . ix itRef
fireCondition = _wpReloadState item == 0
&& _itUseTime item == 0
&& _wpLoadedAmmo item > 0
reloadCondition = _wpLoadedAmmo item == 0
{- |
Applies a world effect after an item use cooldown check. -}
useTimeCheck
@@ -205,6 +228,19 @@ hammerCheck f cr w = case (_crInv cr IM.! _crInvSel cr) ^? itHammer of
where
cid = _crID cr
setHammerDown = creatures . ix cid . crInv . ix (_crInvSel cr) . itHammer .~ HammerDown
{- | Applies a world effect after a hammer position check. -}
hammerCheckI
:: (Item -> Creature -> World -> World) -- ^ Underlying effect
-> Item
-> Creature
-> World
-> World
hammerCheckI f it cr w = case it ^? itHammer of
Just HammerUp -> f it cr $ setHammerDown w
_ -> setHammerDown w
where
cid = _crID cr
setHammerDown = creatures . ix cid . crInv . ix (_crInvSel cr) . itHammer .~ HammerDown
{- | Applies a world effect after an ammo check. -}
shoot
:: (Creature -> World -> World)
@@ -272,6 +308,17 @@ withMuzFlare f cr w = tempLightForAt 3 pos . muzzleFlashAt pos2 $ f cr w
where
pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr)
pos2 = _crPos cr +.+ (2 * _crRad cr) *.* unitVectorAtAngle (_crDir cr)
withMuzFlareI
:: (Item -> Creature -> World -> World) -- ^ Underlying effect
-> Item
-> Creature
-> World
-> World
withMuzFlareI f it cr w = tempLightForAt 3 pos . muzzleFlashAt pos2 $ f it cr w
where
pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr)
pos2 = _crPos cr +.+ (2 * _crRad cr) *.* unitVectorAtAngle (_crDir cr)
{- | Applies the effect to a randomly rotated creature. -}
withRandomDir
:: Float -- ^ Max possible rotation
@@ -283,6 +330,18 @@ withRandomDir
withRandomDir acc f cr w = f (cr & crDir +~ a) $ set randGen g w
where
(a, g) = randomR (-acc,acc) $ _randGen w
{- | Applies the effect to a randomly rotated creature. -}
withRandomDirI
:: Float -- ^ Max possible rotation
-> (Item -> Creature -> World -> World)
-- ^ Underlying effect
-> Item
-> Creature
-> World
-> World
withRandomDirI acc f it cr w = f it (cr & crDir +~ a) $ set randGen g w
where
(a, g) = randomR (-acc,acc) $ _randGen w
{- | Creates a bullet with a given velocity, width, and 'HitEffect' -}
withVelWthHiteff
:: Point2 -- ^ Velocity, x direction is forward with respect to the creature
src/Dodge/Render/HUD.hs
+43 -15
View File
@@ -35,10 +35,11 @@ drawInventory w = case _inventoryMode w of
++ displayInv 0 w
TweakInventory ->
mCurs it w
++ [cursorAt 120 col 5 iPos w]
++ [cursorAt 120 col 5 0 iPos w
,cursorsZ w iPos it
]
++ displayInv 0 w
++ displayMidList w (ammoTweakStrings it) "TWEAK"
++ mCurs it w
CombineInventory -> displayInv 0 w ++ invHead w "COMBINE"
InspectInventory -> displayInv 0 w ++ invHead w "INSPECT"
where
@@ -47,22 +48,47 @@ drawInventory w = case _inventoryMode w of
it = yourItem w
col = itCol it
cursorsZ :: World -> Int -> Item -> Picture
cursorsZ w ipos it = case it ^? wpAmmo . amParamSel of
Nothing -> winScale w $ zDraw sp (155- hw, hh - 77.5)
Just jpos -> winScale w $ zDraw sp (155 - hw, hh - (20 * fromIntegral jpos + 77.5))
where
hh = halfHeight w
hw = halfWidth w
sp = (125 - hw, hh - (20 * fromIntegral ipos + 17.5))
topInvCursor :: Color -> Int -> World -> [Picture]
topInvCursor col iPos w
| ButtonRight `S.member` _mouseButtons w =
[cursorAt 100 col 5 iPos w
,openCursorAt 20 col 105 iPos w]
| otherwise = [ openCursorAt 120 col 5 iPos w ]
[cursorAt 100 col 5 0 iPos w
,openCursorAt 20 col 105 0 iPos w]
| otherwise = [ openCursorAt 120 col 5 0 iPos w ]
ammoTweakStrings :: Item -> [String]
ammoTweakStrings it = case it ^? wpAmmo . amPjMove of
ammoTweakStrings it = case it ^? wpAmmo . amPjParams of
Just l -> map pjTweakString l
_ -> ["NOT TWEAKABLE"]
mCurs :: Item -> World -> [Picture]
mCurs it w = case it ^? wpAmmo . amParamSel of
Nothing -> []
Just i -> [openCursorAt 120 white 200 i w]
Just i
| ButtonRight `S.member` _mouseButtons w ->
[cursorAt x white y 60 i w
,openCursorAt 20 white (x+y) 60 i w
]
| otherwise -> [openCursorAt 140 white 155 60 i w]
where
x = 117.5
y = 155
zDraw :: Point2 -> Point2 -> Picture
zDraw (x,y) (a,b) = line
[(x,y)
,(0.5 * (x+a), y)
,(0.5 * (x+a), b)
,(a, b)
]
pjTweakString :: PjParam -> String
pjTweakString pj = _pjDisplayParam pj $ _pjIntParam pj
@@ -70,11 +96,11 @@ pjTweakString pj = _pjDisplayParam pj $ _pjIntParam pj
displayMidList :: World -> [String] -> String -> [Picture]
displayMidList w strs s =
invHead w s
++ renderListAt (200,0) (map (,white) strs) w
++ renderListAt (150,-60) (map (,white) strs) w
invHead :: World -> String -> [Picture]
invHead w s = [winScale w . translate (-150) (150-halfHeight w)
. dShadCol white . scale 0.5 0.5 $ text s
invHead w s = [winScale w . translate (-130) (halfHeight w - 40)
. dShadCol white . scale 0.4 0.4 $ text s
]
displayListTopLeft :: [(String,Color)] -> World -> [Picture]
@@ -200,17 +226,18 @@ dShadCol c p = pictures
]
drawListCursor :: Color -> Int -> World -> Picture
drawListCursor c = openCursorAt 120 c 5
drawListCursor c = openCursorAt 120 c 5 0
openCursorAt
:: Float -- ^ Width
-> Color
-> Float -- ^ x offset
-> Float -- ^ y offset
-> Int -- ^ y offset (discrete)
-> World
-> Picture
openCursorAt wth col xoff yint w = winScale w
. translate (xoff-halfWidth w) (halfHeight w - (20* fromIntegral yint) - 20)
openCursorAt wth col xoff yoff yint w = winScale w
. translate (xoff-halfWidth w) (halfHeight w - (20* fromIntegral yint + yoff) - 20)
$ lineCol
[(( wth,12.5) ,withAlpha 0 col)
,(( 0,12.5) ,col)
@@ -221,11 +248,12 @@ cursorAt
:: Float -- ^ Width
-> Color
-> Float -- ^ x offset
-> Float -- ^ y offset
-> Int -- ^ y offset (discrete)
-> World
-> Picture
cursorAt wth col xoff yint w = winScale w
. translate (xoff-halfWidth w) (halfHeight w - (20* fromIntegral yint) - 20)
cursorAt wth col xoff yoff yint w = winScale w
. translate (xoff-halfWidth w) (halfHeight w - (20* fromIntegral yint + yoff) - 20)
. color col
$ line
[( wth,12.5)