Add (ugly) support for fractional volumes
This commit is contained in:
@@ -67,6 +67,9 @@ itemCombinations =
|
||||
, po [FLAMETHROWER,PUMP] flameTorrent
|
||||
|
||||
, p [o PRISM,o TRANSFORMER,o PIPE] lasGun
|
||||
, p [o LASGUN,o PRISM] lasGunSway
|
||||
, p [o LASGUN,o HARDWARE] lasGunSwing
|
||||
, p [o LASGUN,o PIPE] lasGunPulse
|
||||
, p [o LASGUN,o TRANSFORMER,o PRISM] (lasGunWide 2)
|
||||
|
||||
, p [o TRANSFORMER,p 2 CAN] sparkGun
|
||||
@@ -180,6 +183,8 @@ batteryGuns =
|
||||
[ teslaGun
|
||||
, sparkGun
|
||||
, lasGun
|
||||
, lasGunSway
|
||||
, lasGunSwing
|
||||
] ++
|
||||
[ lasGunWide i | i <- [1..10]
|
||||
] ++
|
||||
|
||||
@@ -50,6 +50,9 @@ data CombineType
|
||||
| SPARKGUN
|
||||
| TESLAGUN
|
||||
| LASGUN
|
||||
| LASPULSE
|
||||
| LASGUNSWING
|
||||
| LASGUNSWAY
|
||||
| LASGUNWIDE Int
|
||||
| LASGUNFOCUS Int
|
||||
| SONICGUN
|
||||
|
||||
@@ -44,7 +44,7 @@ chaseCrit = defaultCreature
|
||||
, targetYouWhenCognizant
|
||||
, const (crMeleeCooldown %~ max 0 . subtract 1)
|
||||
]
|
||||
, _crHP = 1500
|
||||
, _crHP = 150
|
||||
, _crPict = basicCrPict green
|
||||
, _crInv = IM.fromList [(0,medkit 200)]
|
||||
, _crMeleeCooldown = 0
|
||||
|
||||
+14
-1
@@ -503,6 +503,14 @@ data Particle
|
||||
{ _ptDraw :: Particle -> Picture
|
||||
, _ptUpdate :: World -> Particle -> (World, Maybe Particle)
|
||||
}
|
||||
| LaserParticle
|
||||
{ _ptDraw :: Particle -> Picture
|
||||
, _ptUpdate :: World -> Particle -> (World, Maybe Particle)
|
||||
, _ptRange :: Float
|
||||
, _ptDamage :: Int
|
||||
, _ptColor :: Color
|
||||
, _ptPhaseV :: Float
|
||||
}
|
||||
| LinearParticle
|
||||
{ _ptDraw :: Particle -> Picture
|
||||
, _ptUpdate :: World -> Particle -> (World, Maybe Particle)
|
||||
@@ -626,7 +634,12 @@ data ItemParams
|
||||
, _shellSpinAmount :: Int
|
||||
, _shellThrustDelay :: Int
|
||||
}
|
||||
| Refracting {_phaseV :: Float}
|
||||
| Refracting
|
||||
{ _phaseV :: Float
|
||||
, _lasColor :: Color
|
||||
, _lasCycle :: Int
|
||||
, _lasDamage :: Int
|
||||
}
|
||||
| Attracting {_attractionPower :: Point2}
|
||||
| BulletShooter -- this should possibly be moved into ammo type
|
||||
{ _muzVel :: Float
|
||||
|
||||
@@ -5,9 +5,7 @@ import Dodge.Item.Weapon.InventoryDisplay
|
||||
import Dodge.Default
|
||||
import Dodge.Default.Wall
|
||||
import Dodge.Picture.Layer
|
||||
import Dodge.Item.Weapon.BatteryGuns
|
||||
import Dodge.Creature.Test
|
||||
import Dodge.Wall.Reflect
|
||||
import Dodge.Wall
|
||||
import Dodge.Magnet
|
||||
import Picture
|
||||
@@ -118,15 +116,12 @@ shieldWall crid = defaultWall
|
||||
,_wlStructure = CreaturePart crid shieldWallDamage
|
||||
}
|
||||
|
||||
-- TODO the reflection should be controled by the particle
|
||||
shieldWallDamage :: Damage -> Wall -> Int -> World -> World
|
||||
shieldWallDamage dm wl crid w = case _dmType dm of
|
||||
Lasering ->
|
||||
w & instantParticles .:~ lasRayAt 5 (da +.+ normalizeV (df -.- da)) (reflDirWall df da wl)
|
||||
shieldWallDamage dm _ crid w = case _dmType dm of
|
||||
-- Lasering -> w
|
||||
_ | isMovementDam dm -> w & creatures . ix crid . crState . crDamage .:~ dm
|
||||
_ -> w
|
||||
where
|
||||
df = _dmFrom dm
|
||||
da = _dmAt dm
|
||||
|
||||
createShieldWall :: Creature -> Int -> World -> World
|
||||
createShieldWall cr invid w = case _itEffectID $ _itEffect it of
|
||||
|
||||
@@ -1,7 +1,10 @@
|
||||
module Dodge.Item.Weapon.BatteryGuns
|
||||
( lasGun
|
||||
, lasGunWide
|
||||
, lasGunSway
|
||||
, lasGunSwing
|
||||
, lasGunFocus
|
||||
, lasGunPulse
|
||||
, sparkGun
|
||||
, teslaGun
|
||||
, tractorGun
|
||||
@@ -93,32 +96,126 @@ teslaGunPic _ = noPic $ colorSH blue $
|
||||
where
|
||||
xa = 1
|
||||
xb = 9
|
||||
lasGunPulse :: Item
|
||||
lasGunPulse = lasGun
|
||||
& itName .~ "PULSELAS"
|
||||
& itType .~ LASPULSE
|
||||
& itUse . useMods .~
|
||||
[ ammoCheckI
|
||||
, withItem $ \it -> withTempLight 1 (100 * frac it) (xyzV4 (_lasColor $ _itParams it))
|
||||
, withItem $ \it -> withSoundForVol (frac it) tone440sawtoothquietS 2
|
||||
, withItemUpdate itup
|
||||
$ \it -> withMuzPos $ flareCircleAt (_lasColor $ _itParams it) (frac it * 0.8)
|
||||
, useAmmoAmount 1
|
||||
]
|
||||
where
|
||||
itup it = it
|
||||
& itParams . lasCycle %~ (\i -> (i+1) `mod` 20)
|
||||
& itParams . lasDamage .~ ceiling ((22 :: Float) * frac it)
|
||||
& itParams . lasColor .~ frac it * orange
|
||||
frac it = 0.5 * (1 + sin (pi * fromIntegral (_lasCycle $ _itParams it) * 0.1))
|
||||
|
||||
|
||||
lasGunWide :: Int -> Item
|
||||
lasGunWide n = lasGun
|
||||
lasGunWide n = lasGun
|
||||
& itName .~ "PARALELLAS"++show n
|
||||
& itType .~ LASGUNWIDE n
|
||||
& itUse . useMods .~
|
||||
& itParams . lasColor .~ orange
|
||||
& itParams . lasDamage .~ 2
|
||||
& itUse .~ ( ruseInstant shootLaser NoHammer
|
||||
[ ammoCheckI
|
||||
, withTempLight 1 100 (V3 1 1 0)
|
||||
, withItem $ \it -> withTempLight 1 100 (xyzV4 (_lasColor $ _itParams it))
|
||||
, withItem $ \it -> withMuzPos $ flareCircleAt (_lasColor $ _itParams it) 0.8
|
||||
, withSoundForI tone440sawtoothquietS 2
|
||||
, duplicateOffsets xs
|
||||
, useAmmoAmount 1
|
||||
, duplicateOffsets xs
|
||||
]
|
||||
& useAim . aimSpeed .~ 0.4
|
||||
& useAim . aimRange .~ 1
|
||||
& useAim . aimStance .~ TwoHandTwist
|
||||
)
|
||||
where
|
||||
xs = [ 3 * (fromIntegral x - fromIntegral (n-1) /2) | x <- [0..n-1] ]
|
||||
n' = 9 * n
|
||||
xs = [ 0.25 * (fromIntegral x - fromIntegral (n'-1) /2) | x <- [0..n'-1] ]
|
||||
lasGunWidePulse :: Int -> Item
|
||||
lasGunWidePulse n = lasGun
|
||||
& itName .~ "PARALELLASPULSE"++show n
|
||||
& itType .~ LASGUNWIDE n
|
||||
& itParams . lasColor .~ orange
|
||||
& itParams . lasDamage .~ 2
|
||||
& itUse .~ ( ruseInstant shootLaser NoHammer
|
||||
[ ammoCheckI
|
||||
, withItem $ \it -> withTempLight 1 100 (xyzV4 (_lasColor $ _itParams it))
|
||||
, withItem $ \it -> withMuzPos $ flareCircleAt (_lasColor $ _itParams it) 0.8
|
||||
, withSoundForI tone440sawtoothquietS 2
|
||||
, useAmmoAmount 1
|
||||
, duplicateOffsets xs
|
||||
]
|
||||
& useAim . aimSpeed .~ 0.4
|
||||
& useAim . aimRange .~ 1
|
||||
& useAim . aimStance .~ TwoHandTwist
|
||||
)
|
||||
where
|
||||
n' = 9 * n
|
||||
xs = [ 0.25 * (fromIntegral x - fromIntegral (n'-1) /2) | x <- [0..n'-1] ]
|
||||
lasGunSway :: Item
|
||||
lasGunSway = lasGun
|
||||
& itName .~ "SWAYLAS"
|
||||
& itType .~ LASGUNSWAY
|
||||
& itParams . lasColor .~ orange
|
||||
& itParams . lasDamage .~ 11
|
||||
& itUse .~ ( ruseInstant shootLaser NoHammer
|
||||
[ ammoCheckI
|
||||
, withItem $ \it -> withTempLight 1 100 (xyzV4 (_lasColor $ _itParams it))
|
||||
, withItem $ \it -> withMuzPos $ flareCircleAt (_lasColor $ _itParams it) 0.8
|
||||
, withSoundForI tone440sawtoothquietS 2
|
||||
, useAmmoAmount 1
|
||||
, withItemUpdate itup $ \it -> duplicateOffsets (x it)
|
||||
]
|
||||
& useAim . aimSpeed .~ 0.4
|
||||
& useAim . aimRange .~ 1
|
||||
& useAim . aimStance .~ TwoHandTwist
|
||||
)
|
||||
where
|
||||
itup = itParams . lasCycle %~ (\i -> (i+1) `mod` 40)
|
||||
x it = [ 15 * sin (pi * fromIntegral x' * 0.05) ]
|
||||
where
|
||||
x' = _lasCycle $ _itParams it
|
||||
lasGunFocus :: Int -> Item
|
||||
lasGunFocus n = lasGun
|
||||
lasGunFocus n = lasGunWide n
|
||||
& itName .~ "FOCALAS"++show n
|
||||
& itType .~ LASGUNFOCUS n
|
||||
& itParams . lasColor .~ red
|
||||
& itUse . useMods .~
|
||||
[ ammoCheckI
|
||||
, withTempLight 1 100 (V3 1 1 0)
|
||||
, withItem $ \it -> withTempLight 1 100 (xyzV4 (_lasColor $ _itParams it))
|
||||
, withItem $ \it -> withMuzPos $ flareCircleAt (_lasColor $ _itParams it) 0.8
|
||||
, withSoundForI tone440sawtoothquietS 2
|
||||
, duplicateOffsetsFocus xs
|
||||
, useAmmoAmount 1
|
||||
, duplicateOffsetsFocus xs
|
||||
]
|
||||
where
|
||||
xs = [ 3 * (fromIntegral x - fromIntegral (n-1) /2) | x <- [0..n-1] ]
|
||||
n' = 9 * n
|
||||
xs = [ 0.25 * (fromIntegral x - fromIntegral (n'-1) /2) | x <- [0..n'-1] ]
|
||||
lasGunSwing :: Item
|
||||
lasGunSwing = lasGun
|
||||
& itName .~ "SWINGLAS"
|
||||
& itType .~ LASGUNSWING
|
||||
& itParams . lasColor .~ orange
|
||||
& itUse . useMods .~
|
||||
[ ammoCheckI
|
||||
, withItem $ \it -> withTempLight 1 100 (xyzV4 (_lasColor $ _itParams it))
|
||||
, withItem $ \it -> withMuzPos $ flareCircleAt (_lasColor $ _itParams it) 0.8
|
||||
, withSoundForI tone440sawtoothquietS 2
|
||||
, useAmmoAmount 1
|
||||
, withItemUpdate itup $ \it -> duplicateOffsetsFocus (x it)
|
||||
]
|
||||
where
|
||||
itup = itParams . lasCycle %~ (\i -> (i+1) `mod` 200)
|
||||
x it = [-y,y]
|
||||
where
|
||||
y = 15 * sin (pi * fromIntegral x' * 0.01)
|
||||
x' = _lasCycle $ _itParams it
|
||||
lasGun :: Item
|
||||
lasGun = defaultAutoBatteryGun
|
||||
{ _itName = "LASGUN"
|
||||
@@ -130,14 +227,20 @@ lasGun = defaultAutoBatteryGun
|
||||
}
|
||||
, _itUse = ruseInstant shootLaser NoHammer
|
||||
[ ammoCheckI
|
||||
, withTempLight 1 100 (V3 1 1 0)
|
||||
, withItem $ \it -> withTempLight 1 100 (xyzV4 (_lasColor $ _itParams it))
|
||||
, withSoundForI tone440sawtoothquietS 2
|
||||
, withItem $ \it -> withMuzPos $ flareCircleAt (_lasColor $ _itParams it) 0.8
|
||||
, useAmmoAmount 1
|
||||
]
|
||||
& useAim . aimSpeed .~ 0.4
|
||||
& useAim . aimRange .~ 1
|
||||
& useAim . aimStance .~ TwoHandTwist
|
||||
, _itParams = Refracting {_phaseV = 1}
|
||||
, _itParams = Refracting
|
||||
{ _phaseV = 1
|
||||
, _lasColor = yellow
|
||||
, _lasCycle = 0
|
||||
, _lasDamage = 11
|
||||
}
|
||||
, _itTweaks = Tweakable
|
||||
{ _tweakParams = IM.fromList [(0,lasGunTweak)]
|
||||
, _tweakSel = 0
|
||||
@@ -294,17 +397,21 @@ updateArc :: ItemParams
|
||||
updateArc = createNewArc
|
||||
|
||||
shootLaser :: Item -> Creature -> World -> World
|
||||
shootLaser it cr = (instantParticles .:~ lasRayAt phasev pos dir)
|
||||
. flareCircleAt yellow 0.8 (pos `v2z` 20)
|
||||
shootLaser it cr = instantParticles .:~ lasRayAt (_lasColor $ _itParams it) dam phasev pos dir
|
||||
where
|
||||
pos = _crPos cr +.+ aimingMuzzlePos cr it *.* unitVectorAtAngle dir
|
||||
dir = _crDir cr
|
||||
phasev = _phaseV . _itParams $ _crInv cr IM.! _crInvSel cr
|
||||
dam = _lasDamage $ _itParams it
|
||||
|
||||
lasRayAt :: Float -> Point2 -> Float -> Particle
|
||||
lasRayAt phasev pos dir = Particle
|
||||
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
|
||||
@@ -313,15 +420,17 @@ mvLaser :: Float -- ^ Phase velocity, controls deflection through windows
|
||||
-> Particle
|
||||
-> (World, Maybe Particle)
|
||||
mvLaser phasev pos dir w pt
|
||||
= ( damThingHitWith (\p1 p2 p3 -> Damage Lasering 11 p1 p2 p3 NoDamageEffect) pos xp thHit w
|
||||
= ( 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 1 $ pictures
|
||||
[ setDepth 19 . color (brightX 0 0.5 yellow) $ thickLine 20 (pos:ps)
|
||||
, setDepth 19.5 . color (brightX 10 1 yellow) $ thickLine 3 (pos:ps)
|
||||
[ 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
|
||||
|
||||
@@ -2,6 +2,7 @@ module Dodge.Item.Weapon.LaserPath
|
||||
( reflectLaserAlong
|
||||
) where
|
||||
import Dodge.Data
|
||||
import Dodge.Wall.Reflect
|
||||
--import Dodge.Creature.HandPos
|
||||
import Dodge.WorldEvent
|
||||
--import Dodge.Default
|
||||
@@ -18,12 +19,16 @@ import Data.Tuple
|
||||
|
||||
-- not sure why we need to keep a list of seen walls, but seems to loop
|
||||
-- infinitely when removed
|
||||
-- this needs to be tested with both reflections and refractions
|
||||
reflectLaserAlong :: Float -> [Wall] -> Point2 -> Point2 -> World
|
||||
-> (Maybe (Point2,Either Creature Wall),[Point2])
|
||||
reflectLaserAlong phasev seenWl sp ep w = case find (notseen seenWl)
|
||||
$ thingsHitExceptCrLongLine Nothing sp ep w of
|
||||
Just (p,Right wl)
|
||||
| _wlOpacity wl == SeeThrough -> second (p:) $ reflectLaserAlong phasev (wl:seenWl) p (refract sp ep wl p) w
|
||||
| _wlReflect wl -> second (p:) $ reflectLaserAlong phasev (wl:seenWl) p
|
||||
(p +.+ 800 *.* unitVectorAtAngle (reflDirWall sp p wl)) w
|
||||
| _wlOpacity wl == SeeThrough -> second (p:) $ reflectLaserAlong phasev (wl:seenWl) p
|
||||
(refract sp ep wl p) w
|
||||
| otherwise -> (Just (p,Right wl), [p])
|
||||
Just (p,obj) -> (Just (p,obj), [p])
|
||||
Nothing -> (Nothing, [ep])
|
||||
|
||||
@@ -7,9 +7,12 @@ module Dodge.Item.Weapon.TriggerType
|
||||
, useAmmoUpTo
|
||||
, lockInvFor
|
||||
, withMuzFlareI
|
||||
, withMuzPos
|
||||
, withOldDir
|
||||
, trigDoAlso
|
||||
, withTempLight
|
||||
, withItem
|
||||
, withItemUpdate
|
||||
, ammoUseCheck
|
||||
, rateIncAB
|
||||
, torqueBefore
|
||||
@@ -23,6 +26,7 @@ module Dodge.Item.Weapon.TriggerType
|
||||
, withSoundItemChoiceStart
|
||||
, withSoundContinue
|
||||
, withSoundForI
|
||||
, withSoundForVol
|
||||
, withSmoke
|
||||
, withThickSmokeI
|
||||
, withThinSmokeI
|
||||
@@ -60,7 +64,7 @@ import Dodge.Reloading
|
||||
import Dodge.WorldEvent
|
||||
import Dodge.RandomHelp
|
||||
import Dodge.Inventory.Lock
|
||||
--import Dodge.Creature.HandPos
|
||||
import Dodge.Creature.HandPos
|
||||
--import Dodge.Default
|
||||
import Dodge.Base
|
||||
import Sound.Data
|
||||
@@ -229,6 +233,17 @@ withSoundForI soundid playTime f item cr
|
||||
= soundContinue (CrWeaponSound (_crID cr) 0) (_crPos cr) soundid (Just playTime)
|
||||
. f item cr
|
||||
|
||||
{- | Adds a sound to a creature based world effect.
|
||||
The sound is emitted from the creature's position. -}
|
||||
withSoundForVol
|
||||
:: Float -- ^ volume
|
||||
-> SoundID -- ^ Sound id
|
||||
-> Int -- ^ Frames to play
|
||||
-> ChainEffect
|
||||
withSoundForVol vol soundid playTime f item cr
|
||||
= soundContinueVol vol (CrWeaponSound (_crID cr) 0) (_crPos cr) soundid (Just playTime)
|
||||
. f item cr
|
||||
|
||||
afterRecoil
|
||||
:: Float -- ^ Recoil amount
|
||||
-> ChainEffect
|
||||
@@ -347,6 +362,10 @@ shootL f cr invid w
|
||||
&& _rateTime (_useDelay (_itUse item)) == 0
|
||||
&& _ammoLoaded (_itConsumption item) > 0
|
||||
reloadCondition = _ammoLoaded (_itConsumption item) == 0
|
||||
withItem :: (Item -> ChainEffect) -> ChainEffect
|
||||
withItem g f it = g it f it
|
||||
withItemUpdate :: (Item -> Item) -> (Item -> ChainEffect) -> ChainEffect
|
||||
withItemUpdate up g f it cr = g it f it cr . (creatures . ix (_crID cr) . crInv . ix (_crInvSel cr) %~ up)
|
||||
withTempLight :: Int -> Float -> V3 Float -> ChainEffect
|
||||
withTempLight time rad col eff item cr = eff item cr
|
||||
. over tempLightSources (theTLS :)
|
||||
@@ -368,6 +387,14 @@ withMuzFlareI f it cr w = makeTlsTimeRadColPos 2 100 (V3 1 1 0.5) flashPos
|
||||
flashPos = addZ 0 (_crPos cr) +.+.+ rotate3z cdir (muzzleOffset +.+.+ V3 5 0 20)
|
||||
muzzleOffset = V3 (_muzPos (_dimPortage (_itDimension it))) 0 0
|
||||
cdir = _crDir cr
|
||||
|
||||
withMuzPos :: (Point3 -> World -> World) -> ChainEffect
|
||||
withMuzPos g f it cr w = g (pos `v2z` 20)
|
||||
$ f it cr w
|
||||
where
|
||||
pos = _crPos cr +.+ aimingMuzzlePos cr it *.* unitVectorAtAngle dir
|
||||
dir = _crDir cr
|
||||
|
||||
{- | Applies the effect to a randomly rotated creature,
|
||||
- rotation amount given by inaccuracy in itParams -}
|
||||
applyInaccuracy :: ChainEffect
|
||||
@@ -541,7 +568,12 @@ duplicateOffsetsFocus xs eff item cr w = foldr f w poss
|
||||
poss = map (rotateV (_crDir cr) . V2 0 ) xs
|
||||
f pos = eff item $ cr
|
||||
& crPos %~ (+.+ pos)
|
||||
& crDir .~ argV (mouseWorldPos w -.- (_crPos cr +.+ pos))
|
||||
& crDir .~ thedir pos
|
||||
thedir pos
|
||||
| dist (mouseWorldPos w) (_crPos cr) < aimingMuzzlePos cr item
|
||||
= argV (_crPos cr +.+ aimingMuzzlePos cr item *.* unitVectorAtAngle (_crDir cr)
|
||||
-.- (_crPos cr +.+ pos))
|
||||
| otherwise = argV (mouseWorldPos w -.- (_crPos cr +.+ pos))
|
||||
|
||||
duplicateOffsets :: [Float] -> ChainEffect
|
||||
duplicateOffsets xs eff item cr w = foldr f w poss
|
||||
|
||||
+32
-5
@@ -8,6 +8,7 @@ module Dodge.SoundLogic (
|
||||
-- * Manipulation of individual sounds
|
||||
soundStart
|
||||
, soundContinue
|
||||
, soundContinueVol
|
||||
, soundFromGeneral
|
||||
, soundMultiFrom
|
||||
, stopSoundFrom
|
||||
@@ -44,15 +45,16 @@ pauseSound w = w
|
||||
resumeSound :: Universe -> Universe
|
||||
resumeSound w = w
|
||||
|
||||
soundWithStatus
|
||||
:: PlayStatus
|
||||
soundWithStatusVolume
|
||||
:: Float -- ^ Volume factor, 0 - 1
|
||||
-> PlayStatus
|
||||
-> SoundOrigin -- ^ \"Creator\" of sound
|
||||
-> Point2 -- ^ Position of sound
|
||||
-> SoundID -- ^ ID of sound to be played
|
||||
-> Maybe Int -- ^ Frames to play sound for, Nothing for until finished
|
||||
-> World
|
||||
-> World
|
||||
soundWithStatus status so pos sType mtime w = over toPlaySounds (M.insertWith f so sound) w
|
||||
soundWithStatusVolume vol status so pos sType mtime w = over toPlaySounds (M.insertWith f so sound) w
|
||||
where
|
||||
sound = Sound
|
||||
{ _soundChunkID = sType
|
||||
@@ -62,13 +64,24 @@ soundWithStatus status so pos sType mtime w = over toPlaySounds (M.insertWith f
|
||||
,_isLooping = isJust mtime
|
||||
}
|
||||
, _soundChannel = Nothing
|
||||
, _soundAngDist = Just (a,0)
|
||||
, _soundAngDist = Just (a,floor (225 * (1 - vol)))
|
||||
, _soundPos = pos
|
||||
, _soundVolume = soundToVol sType
|
||||
, _soundVolume = soundToVol sType * vol
|
||||
, _soundVolumeFraction = vol
|
||||
}
|
||||
f _ s = s {_soundTime = mtime }
|
||||
a = soundAngle pos w
|
||||
|
||||
soundWithStatus
|
||||
:: PlayStatus
|
||||
-> SoundOrigin -- ^ \"Creator\" of sound
|
||||
-> Point2 -- ^ Position of sound
|
||||
-> SoundID -- ^ ID of sound to be played
|
||||
-> Maybe Int -- ^ Frames to play sound for, Nothing for until finished
|
||||
-> World
|
||||
-> World
|
||||
soundWithStatus = soundWithStatusVolume 1
|
||||
|
||||
soundStart
|
||||
:: SoundOrigin -- ^ \"Creator\" of sound
|
||||
-> Point2 -- ^ Position of sound
|
||||
@@ -86,6 +99,17 @@ soundContinue
|
||||
-> World
|
||||
soundContinue = soundWithStatus ToContinueStart
|
||||
|
||||
-- this needs to all be cleaned up, moved to general sounds
|
||||
soundContinueVol
|
||||
:: Float -- ^ volume
|
||||
-> SoundOrigin -- ^ \"Creator\" of sound
|
||||
-> Point2 -- ^ Position of sound
|
||||
-> SoundID -- ^ ID of sound to be played
|
||||
-> Maybe Int -- ^ Frames to play sound for, Nothing for until finished
|
||||
-> World
|
||||
-> World
|
||||
soundContinueVol vol = soundWithStatusVolume vol ToContinueStart
|
||||
|
||||
soundFromGeneral
|
||||
:: SoundOrigin -- ^ \"Creator\" of sound
|
||||
-> (World -> Point2) -- ^ Position of sound
|
||||
@@ -106,6 +130,7 @@ soundFromGeneral so fpos sType mtime w = over toPlaySounds (M.insertWith f so so
|
||||
, _soundAngDist = Just (a,0)
|
||||
, _soundPos = fpos w
|
||||
, _soundVolume = soundToVol sType
|
||||
, _soundVolumeFraction = 1
|
||||
}
|
||||
f _ s = s {_soundTime = mtime }
|
||||
a = soundAngle (fpos w) w
|
||||
@@ -149,6 +174,7 @@ soundMultiFrom [so] pos sType mtime w
|
||||
, _soundAngDist = Just (a,0)
|
||||
, _soundPos = pos
|
||||
, _soundVolume = soundToVol sType
|
||||
, _soundVolumeFraction = 1
|
||||
}
|
||||
a = soundAngle pos w
|
||||
soundMultiFrom (so:sos) pos sType mtime w
|
||||
@@ -166,6 +192,7 @@ soundMultiFrom (so:sos) pos sType mtime w
|
||||
, _soundAngDist = Just (a,0)
|
||||
, _soundPos = pos
|
||||
, _soundVolume = soundToVol sType
|
||||
, _soundVolumeFraction = 1
|
||||
}
|
||||
a = soundAngle pos w
|
||||
{- | Sets '_soundTime' to 0. -}
|
||||
|
||||
@@ -41,7 +41,7 @@ muzFlareAt col tranv dir w = w & instantParticles .:~ theFlare
|
||||
flareCircleAt :: Color -> Float -> Point3 -> World -> World
|
||||
flareCircleAt col alphax tranv = instantParticles .:~ Particle
|
||||
{ _ptDraw = const . setLayer 1 . translate3 tranv
|
||||
$ circleSolidCol (withAlpha 0 0) (withAlpha alphax col) 30
|
||||
$ circleSolidCol (withAlpha 0 0) (withAlpha alphax col) 50
|
||||
, _ptUpdate = ptSimpleTime 1
|
||||
}
|
||||
|
||||
|
||||
+1
-1
@@ -87,7 +87,7 @@ tryPlay sd s = do
|
||||
Mix.halt i
|
||||
Mix.playOn i timesToPlay (sd IM.! _getSoundID (_soundChunkID s))
|
||||
return $ s
|
||||
& soundChannel ?~ i
|
||||
& soundChannel ?~ i
|
||||
& soundStatus . playStatus .~ JustStartedPlaying
|
||||
where
|
||||
timesToPlay | _isLooping (_soundStatus s) = Mix.Forever
|
||||
|
||||
@@ -33,6 +33,7 @@ data Sound = Sound
|
||||
, _soundAngDist :: Maybe (Int16,Word8) -- why do BOTH of
|
||||
, _soundPos :: Point2 -- these exist?
|
||||
, _soundVolume :: Float
|
||||
, _soundVolumeFraction :: Float -- this needs cleaning up/combining
|
||||
, _soundChunkID :: SoundID
|
||||
}
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
Reference in New Issue
Block a user