From c8e84c775fc61166f14dabf961c9c9bdd4b216d7 Mon Sep 17 00:00:00 2001 From: jgk Date: Fri, 30 Apr 2021 13:21:37 +0200 Subject: [PATCH] Linting, refactor random angle walk for flamer --- shader/fullscreen.frag | 5 + src/Dodge/Creature.hs | 2 +- src/Dodge/Default.hs | 10 +- src/Dodge/Event.hs | 16 +- src/Dodge/Item/Weapon.hs | 237 ++++------------------ src/Dodge/Item/Weapon/Bullet.hs | 223 ++++++++++---------- src/Dodge/Item/Weapon/Decoration.hs | 29 +++ src/Dodge/Item/Weapon/ExtraEffect.hs | 96 +++++++++ src/Dodge/Item/Weapon/InventoryDisplay.hs | 16 +- src/Dodge/Item/Weapon/Recock.hs | 36 ---- src/Dodge/Item/Weapon/TriggerType.hs | 50 ++++- src/Dodge/Item/Weapon/UseEffect.hs | 110 ++++++++++ src/Picture/Preload.hs | 2 +- src/Picture/Render.hs | 5 + 14 files changed, 460 insertions(+), 377 deletions(-) create mode 100644 src/Dodge/Item/Weapon/Decoration.hs create mode 100644 src/Dodge/Item/Weapon/ExtraEffect.hs delete mode 100644 src/Dodge/Item/Weapon/Recock.hs create mode 100644 src/Dodge/Item/Weapon/UseEffect.hs diff --git a/shader/fullscreen.frag b/shader/fullscreen.frag index ab067e6af..e41911e41 100644 --- a/shader/fullscreen.frag +++ b/shader/fullscreen.frag @@ -6,6 +6,11 @@ uniform sampler2D screenTexture; void main() { +// vec4 col = vec4(0,0,0,0); +// for (int i = 0; i < 9; i++) +// { +// col += +// } fColor = texture(screenTexture, vTexPos); // fColor = vec4(1,1,1,0); } diff --git a/src/Dodge/Creature.hs b/src/Dodge/Creature.hs index 500e4e4cc..b4432c757 100644 --- a/src/Dodge/Creature.hs +++ b/src/Dodge/Creature.hs @@ -266,7 +266,7 @@ startInventory = IM.fromList (zip [0..20] ( [lasGun ,autoGun - ,bezierGun + ,flamer --,blinkGun --,spawnGun lamp --,poisonSprayer diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index fa8f1fb31..96973b836 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -6,8 +6,7 @@ Description : Instances of data structures This module contains prototypical data structures. -} module Dodge.Default where - -import Dodge.Item.Weapon.Recock +import Dodge.Item.Weapon.ExtraEffect import Dodge.Data import Dodge.Data.Menu import Dodge.SoundLogic @@ -24,10 +23,8 @@ import qualified Data.Map as M import qualified Data.Set as S import Data.Graph.Inductive.Graph hiding ((&)) import Data.List - {- -Indestructible wall. --} +Indestructible wall. -} defaultWall = Wall { _wlLine = [(0,0),(50,0)] , _wlID = 0 @@ -37,8 +34,7 @@ defaultWall = Wall } {- Door that opens on approach. -Pathable. --} +Pathable. -} defaultAutoDoor = Door { _wlLine = [(0,0),(50,0)] , _wlID = 0 diff --git a/src/Dodge/Event.hs b/src/Dodge/Event.hs index 0df9bab03..e49e0195f 100644 --- a/src/Dodge/Event.hs +++ b/src/Dodge/Event.hs @@ -67,7 +67,7 @@ handleMouseWheelEvent mwev w = case _menuLayers w of | otherwise -> Just w _ -> Just w -{- +{- | Resets the world window size, and resizes the fbo that gets the light map drawn into it. -} handleResizeEvent :: WindowSizeChangedEventData -> World -> Maybe World @@ -122,14 +122,16 @@ wheelDownEvent w = case _carteDisplay w of upInvPos :: World -> World upInvPos w = stopSoundFrom (CrReloadSound 0) $ set (creatures . ix (_yourID w) . crInvSel) x w - where is = IM.keys $ _crInv $ _creatures w IM.! _yourID w - isis = is ++ is - x = before (_crInvSel (you w)) isis + where + is = IM.keys $ _crInv $ _creatures w IM.! _yourID w + isis = is ++ is + x = before (_crInvSel (you w)) isis downInvPos :: World -> World downInvPos w = stopSoundFrom (CrReloadSound 0) $ set (creatures . ix (_yourID w) . crInvSel) x w - where is = IM.keys $ _crInv $ _creatures w IM.! _yourID w - isis = is ++ is - x = after (_crInvSel (you w)) isis + where + is = IM.keys $ _crInv $ _creatures w IM.! _yourID w + isis = is ++ is + x = after (_crInvSel (you w)) isis -- these are incomplete: should put in error case here! before y (x:z:ys) | y == z = x diff --git a/src/Dodge/Item/Weapon.hs b/src/Dodge/Item/Weapon.hs index f267f4dff..ce2fae81b 100644 --- a/src/Dodge/Item/Weapon.hs +++ b/src/Dodge/Item/Weapon.hs @@ -1,4 +1,4 @@ -{- +{- | Definitions of weapons. In progress: move out effects into other modules. -} @@ -16,9 +16,11 @@ import Dodge.WorldEvent import Dodge.Default import Dodge.Item.Draw import Dodge.Item.Weapon.Bullet +import Dodge.Item.Weapon.Decoration import Dodge.Item.Weapon.InventoryDisplay import Dodge.Item.Weapon.TriggerType -import Dodge.Item.Weapon.Recock +import Dodge.Item.Weapon.ExtraEffect +import Dodge.Item.Weapon.UseEffect import Dodge.Item.Attachment.Data import Dodge.Item.Attachment import Geometry @@ -410,7 +412,7 @@ ltAutoGun = defaultAutoGun , _wpFireRate = 4 , _wpFireState = 0 , _wpFire = shootWithSound 0 . withRandomDir 0.3 . withSidePush 50 - . withMuzFlare $ withVelWthHiteff (30,0) 2 bulletEffect' + . withMuzFlare $ withVelWthHiteff (30,0) 2 basicBulletEffect , _wpSpread = 0.5 , _wpRange = 20 , _itFloorPict = onLayer FlItLayer $ color green $ pictures [polygon $ rectNSWE 4 (-4) (-4) 0 @@ -461,7 +463,7 @@ spreadGun = defaultGun , _wpFire = shootWithSound (fromIntegral shotgunSound) . withRecoil 100 . withMuzFlare - $ spreadNumVelWthHiteff spreadGunSpread 9 (30,0) 2 bulletEffect' + $ spreadNumVelWthHiteff spreadGunSpread 9 (30,0) 2 basicBulletEffect , _wpSpread = spreadGunSpread , _wpRange = 20 , _itFloorPict = onLayer FlItLayer $ color green $ pictures [ polygon [(-3,0),(3,6),(3,-6)] @@ -504,7 +506,7 @@ multGun = defaultGun , _wpFire = shootWithSound (fromIntegral shotgunSound) . withRecoil 200 . withMuzFlare - $ numVelWthHitEff 5 (50,0) 5 bulletEffect' + $ numVelWthHitEff 5 (50,0) 5 basicBulletEffect , _wpSpread = spreadGunSpread , _wpRange = 20 , _itFloorPict = onLayer FlItLayer $ multGunPic @@ -571,7 +573,7 @@ poisonSprayer = defaultAutoGun , _wpFireRate = 0 , _wpFireState = 0 , _wpFire = shoot $ aGasCloud - , _wpSpread = flamerAngle + , _wpSpread = 0.3 , _wpRange = 8 , _itFloorPict = onLayer FlItLayer $ color yellow $ polygon $ rectNESW 4 4 (-4) (-4) , _itAmount = 1 @@ -591,8 +593,8 @@ flamer = defaultAutoGun , _wpReloadState = 0 , _wpFireRate = 0 , _wpFireState = 0 - , _wpFire = shoot $ aFlame 0 - , _wpSpread = flamerAngle + , _wpFire = shoot $ withSidePushAfter 10 $ randWalkAngle 0.5 0.05 aFlame + , _wpSpread = 0 , _wpRange = 8 , _itFloorPict = onLayer FlItLayer $ color yellow $ polygon $ rectNESW 4 4 (-4) (-4) , _itAmount = 1 @@ -804,30 +806,16 @@ aGasCloud cid w vel = (_crPos cr -.- _crOldPos cr) +.+ 10 *.* unitVectorAtAngle dir insertCloud = makeGasCloud pos vel -- . makeFlame pos2 vel (Just cid) - -aFlame :: Float -> Int -> World -> World -aFlame a cid w - = shakeCr cid 2 - $ insertFlame $ resetAngle $ set randGen g $ - w - where - (a2,g) = randomR (-0.1,0.1) (_randGen w) - (t,_) = randomR (99,101) (_randGen w) - angle = min flamerAngle $ max (-flamerAngle) (a + a2) - cr = (_creatures w IM.! cid) - dir = _crDir cr + angle - pos = _crPos cr +.+ ((_crRad cr + 2.9) *.* unitVectorAtAngle (_crDir cr)) - w1 = set randGen g w - vel = (_crPos cr -.- _crOldPos cr) +.+ 4 *.* unitVectorAtAngle dir - insertFlame = makeFlame t pos vel (Just cid) -- . makeFlame pos2 vel (Just cid) - resetAngle = set (creatures . ix cid . crInv . ix (_crInvSel cr) . wpFire) - (shoot $ aFlame angle) - - - +aFlame :: Int -> World -> World +aFlame cid w = insertFlame w + where + (t,_) = randomR (99,101) (_randGen w) + cr = (_creatures w IM.! cid) + dir = _crDir cr + pos = _crPos cr +.+ ((_crRad cr + 2.9) *.* unitVectorAtAngle (_crDir cr)) + vel = (_crPos cr -.- _crOldPos cr) +.+ 4 *.* unitVectorAtAngle dir + insertFlame = makeFlame t pos vel (Just cid) -- . makeFlame pos2 vel (Just cid) -flamerAngle = 0.3 - aSelf :: Int -> World -> World aSelf = blinkAction @@ -1610,14 +1598,8 @@ thinLine = lineOfThickness 1 someJust (Just x) | x > 0 = True | otherwise = False - -shakeCr :: Int -> Float -> World -> World -shakeCr cID amount w = - let vec = vNormal $ unitVectorAtAngle $ _crDir $ _creatures w IM.! cID - (x,g) = randomR (-amount,amount) $ _randGen w - in set randGen g . over (creatures . ix cID . crPos) (+.+ (x *.* vec)) $ w - - +{- | +Sends out pulses that display walls. -} radar = defaultGun { _itName = "RADAR" , _itIdentity = Generic @@ -1627,7 +1609,7 @@ radar = defaultGun , _wpReloadState = 0 , _wpFireRate = 120 , _wpFireState = 0 - , _wpFire = shoot $ aRadarPulse + , _wpFire = shoot aRadarPulse , _wpSpread = autogunSpread , _wpRange = 20 , _itHammer = HammerUp @@ -1638,7 +1620,8 @@ radar = defaultGun , _itZoom = defaultItZoom {_itAimZoomMax = 1, _itZoomMax = 1} , _itEquipPict = drawWeapon $ color blue $ polygon $ rectNESW 5 5 (-5) (-5) } - +{- | +Sends out pulses that display creatures. -} sonar = defaultGun { _itName = "SONAR" , _itIdentity = Generic @@ -1648,7 +1631,7 @@ sonar = defaultGun , _wpReloadState = 0 , _wpFireRate = 120 , _wpFireState = 0 - , _wpFire = shoot $ aSonarPulse + , _wpFire = shoot aSonarPulse , _wpSpread = autogunSpread , _wpRange = 20 , _itHammer = HammerUp @@ -1659,96 +1642,8 @@ sonar = defaultGun , _itZoom = defaultItZoom {_itAimZoomMax = 1, _itZoomMax = 1} , _itEquipPict = drawWeapon $ color blue $ polygon $ rectNESW 5 5 (-5) (-5) } - -aSonarPulse :: Int -> World -> World -aSonarPulse cid w = over particles ((:) $ sonarPulseAt (_crPos (_creatures w IM.! cid))) w - -aRadarPulse :: Int -> World -> World -aRadarPulse cid w = over particles ((:) $ radarPulseAt (_crPos (_creatures w IM.! cid))) w - -{- -Radar blip at a point. - -} -blipAt :: Point2 -> Color -> Int -> Particle -blipAt p col i = Particle - {_ptDraw = const blank - ,_ptUpdate' = mvBlip p col i i - } - -mvBlip :: Point2 -> Color -> Int -> Int -> World -> Particle -> (World, Maybe Particle) -mvBlip p col maxt 0 w pt = (w, Nothing) -mvBlip p col maxt t w pt - = (w, Just $ pt & ptUpdate' .~ mvBlip p col maxt (t-1) - & ptDraw .~ (const . setDepth (-0.5) - . setLayer 1 - $ uncurry translate p - $ color (withAlpha (fromIntegral t / fromIntegral maxt) col) - $ circleSolid 2) - ) - -sonarPulseAt :: Point2 -> Particle -sonarPulseAt p = Particle - { _ptDraw = const blank - , _ptUpdate' = mvSonar 100 p - } - -mvSonar :: Int -> Point2 -> World -> Particle -> (World, Maybe Particle) -mvSonar 0 _ w _ = (w, Nothing) -mvSonar x p w pt = (w, Just $ pt {_ptDraw = const pic - ,_ptUpdate' = mvSonar (x-1) p - } - ) - where - pic = setDepth (-0.5) . setLayer 1 $ pictures - -- $ sweepPics ++ - crBlips -- ++ wallBlips - crBlips = mapMaybe crBlip $ IM.elems $ _creatures w - crBlip cr | dist cpos p < r + crad && dist cpos p > r - (crad + 100) - = Just $ colHelper (0.5 * (1 - (r - dist cpos p) /100)) - $ uncurry translate cpos $ circleSolid crad - | otherwise = Nothing - where crad = _crRad cr - cpos = _crPos cr - r = fromIntegral (500 - x*5) - sweepPics = [colHelper 0.05 $ uncurry translate p $ thickCircle r 5 --- ,colHelper 0.3 $ uncurry translate p $ thickCircle (r-5) 5 --- ,colHelper 0.1 $ uncurry translate p $ thickCircle (r-10) 5 - ] - globalAlpha | x > 10 = 1 - | otherwise = fromIntegral x / 10 - colHelper y = color (withAlpha (y * globalAlpha) green) --- wallBlips - - -radarPulseAt :: Point2 -> Particle -radarPulseAt p = Particle - { _ptDraw = const blank - , _ptUpdate' = mvRadar 50 p - } - -mvRadar :: Int -> Point2 -> World -> Particle -> (World, Maybe Particle) -mvRadar 0 _ w _ = (w, Nothing) -mvRadar x p w pt = (putBlips w, Just $ pt {_ptDraw = const pic - ,_ptUpdate' = mvRadar (x-1) p - } - ) - where - pic = onLayerL [levLayer ShadowLayer, 1] $ pictures $ sweepPics - putBlips = over worldEvents ((.) $ over particles ((++) blips)) - blips = map (\p -> blipAt p (withAlpha (0.5*globalAlpha) red) 50) - $ circPoints - circPoints = mapMaybe (\wl -> collidePointCircCorrect (_wlLine wl !! 0) (_wlLine wl !! 1) r p) - $ (map (over wlLine reverse) $ IM.elems $ wallsAlongCirc p r w) - ++ (IM.elems $ wallsAlongCirc p r w) - r = fromIntegral (800 - x*16) - sweepPics = [--colHelper 0.1 $ uncurry translate p $ thickCircle r 15 - --,colHelper 0.06 $ uncurry translate p $ thickCircle (r-5) 5 - --,colHelper 0.03 $ uncurry translate p $ thickCircle (r-10) 5 - ] - globalAlpha | x > 10 = 1 - | otherwise = fromIntegral x / 10 - colHelper y = color (withAlpha (y * globalAlpha) red) - +{- | +Automatically sends out pulses that display creatures. -} autoSonar = defaultEquipment { _itIdentity = Generic , _itName = "AUTOSONAR" @@ -1762,6 +1657,8 @@ autoSonar = defaultEquipment , _itAimingRange = 0 , _itZoom = defaultItZoom {_itAimZoomMax = 1, _itZoomMax = 1} } +{- | +Automatically sends out pulses that display walls. -} autoRadar = defaultEquipment { _itIdentity = Generic , _itName = "AUTORADAR" @@ -1775,74 +1672,8 @@ autoRadar = defaultEquipment , _itAimingRange = 0 , _itZoom = defaultItZoom {_itAimZoomMax = 1, _itZoomMax = 1} } - -autoRadarEffect :: ItEffect -autoRadarEffect = ItInvEffect {_itInvEffect = f 50 - ,_itEffectCounter = 0 - } - where f 0 cr i w = aRadarPulse (_crID cr) - w & creatures . ix (_crID cr) . crInv . ix i - . itEffect . itInvEffect .~ f 100 - f t cr i w = w & creatures . ix (_crID cr) . crInv . ix i - . itEffect . itInvEffect .~ f (t-1) - -autoSonarEffect :: ItEffect -autoSonarEffect = ItInvEffect {_itInvEffect = f 50 - ,_itEffectCounter = 0 - } - where f 0 cr i w = aSonarPulse (_crID cr) - w & creatures . ix (_crID cr) . crInv . ix i - . itEffect . itInvEffect .~ f 140 - f t cr i w = w & creatures . ix (_crID cr) . crInv . ix i - . itEffect . itInvEffect .~ f (t-1) - -itemLaserScopeEffect :: ItEffect -itemLaserScopeEffect - = ItInvEffect {_itInvEffect = f - ,_itEffectCounter = 0 - } - where f cr invid w - | invid == _crInvSel cr - = w & particles %~ (:) (makeLaserScope sp ep d reloadFrac) - & creatures . ix (_crID cr) . crInv . ix invid . itHammer %~ moveHammerUp - & laserScopeTargetGlow col glowPoint --- this flare MAY be buggy... something to do with the creature glare - | otherwise = w - where - p = _crPos cr - d = _crDir cr - r = _crRad cr - sp = (p +.+ (r + 3) *.* unitVectorAtAngle d) - xp = sp +.+ 3000 *.* unitVectorAtAngle d - ep = case listToMaybe $ thingsHitLongLine sp xp w of - Just (p,_) -> p - Nothing -> xp - glowPoint = case listToMaybe $ thingsHitLongLine sp xp w of - Just (p,E3x2 wl) -> p +.+ 2 *.* wallNormal wl - _ -> (ep -.- 2 *.* unitVectorAtAngle d) - it = (cr ^. crInv) IM.! invid - reloadFrac - | _wpLoadedAmmo it == 0 = 1 - | otherwise = fromIntegral (_wpReloadState it) / fromIntegral (_wpReloadTime it) - col = mixColors reloadFrac (1-reloadFrac) red green - moveHammerUp !HammerDown = HammerReleased - moveHammerUp !_ = HammerUp - -makeLaserScope :: Point2 -> Point2 -> Float -> Float -> Particle -makeLaserScope p ep d relFrac = Particle - {_ptDraw = const $ onLayer PtLayer $ pictures - [color (withAlpha 0.5 $ mixColors relFrac (1-relFrac) red green) - $ lineOfThickness 0.5 [p,ep] - ,color (withAlpha 0.2 $ mixColors relFrac (1-relFrac) red green) - $ lineOfThickness 1.5 [p,ep] - ,color (withAlpha 0.1 $ mixColors relFrac (1-relFrac) red green) - $ lineOfThickness 2 [p,ep] - ] - ,_ptUpdate' = \w pt -> (w, Just $ pt & ptUpdate' .~ \w' _ -> (w',Nothing)) - } - - - +{- | +Creates a creature next to the creature using the item. -} spawnGun :: Creature -> Item spawnGun cr = defaultGun { _itName = "SPAWNER" @@ -1854,7 +1685,11 @@ spawnGun cr = defaultGun , _wpFire = spawnCrNextTo cr } -spawnCrNextTo :: Creature -> Int -> World -> World +spawnCrNextTo + :: Creature -- ^ Creature to spawn + -> Int -- ^ ID of existing creature that will be spawned next to + -> World + -> World spawnCrNextTo cr i w = w & creatures %~ IM.insert k newCr where k = newKey $ _creatures w diff --git a/src/Dodge/Item/Weapon/Bullet.hs b/src/Dodge/Item/Weapon/Bullet.hs index 503ac9ab1..bdc15e790 100644 --- a/src/Dodge/Item/Weapon/Bullet.hs +++ b/src/Dodge/Item/Weapon/Bullet.hs @@ -1,3 +1,6 @@ +{- | +Effects of bullets upon impact with walls or creatures, and possibly force fields. + -} module Dodge.Item.Weapon.Bullet where import Dodge.Data @@ -6,21 +9,16 @@ import Dodge.WorldEvent import Dodge.SoundLogic import Dodge.RandomHelp import Dodge.WorldEvent.Shockwave - import Dodge.Creature.Property - import Geometry - -import System.Random - -import Control.Lens -import Control.Monad.State - -import qualified Data.IntMap.Strict as IM - import Picture --- | bullet effects +import System.Random +import Control.Lens +import Control.Monad.State +import qualified Data.IntMap.Strict as IM + +-- | Basic bullet hit creature effect. bulHitCr' :: Particle -> Point2 -> Creature -> World -> World bulHitCr' bt p cr w | crIsArmouredFrom p cr @@ -35,13 +33,13 @@ bulHitCr' bt p cr w addDamage = creatures . ix cid . crState . crDamage %~ ((Piercing 100 sp p ep : mvDams) ++ ) addDamageArmoured = creatures . ix cid . crState . crDamage %~ (mvDams ++) hitSound = soundMultiFrom [CrHitSound 0] 15 10 0 - flashEff = over worldEvents ((.) $ bloodFlashAt p) + flashEff = over worldEvents (bloodFlashAt p . ) cid = _crID cr (d1,g) = randomR (-0.7,0.7) $ _randGen w (colID,_) = randomR (0,11) $ _randGen w p1 = p +.+ 2 *.* safeNormalizeV (p -.- _crPos cr) -{- +{- | Bounce off armoured creatures, otherwise do damage. -} bulBounceArmCr' :: Particle -> Point2 -> Creature -> World -> World @@ -63,112 +61,104 @@ bulBounceArmCr' bt p cr w newDir = safeNormalizeV (p -.- _crPos cr) pOut = p +.+ 2 *.* newDir reflectVel = magV bulVel *.* newDir - addBouncer = worldEvents %~ ((over particles (bouncer :) ) . ) + addBouncer = worldEvents %~ ( over particles (bouncer :) . ) bouncer = (aGenBulAt' Nothing (_btColor' bt) pOut reflectVel (_btHitEffect' bt) (_btWidth' bt) ) {_btTimer' = _btTimer' bt - 1} -{- +{- | Bullet pass through creatures. -} bulPenCr' :: Particle -> Point2 -> Creature -> World -> World bulPenCr' bt p cr w = over (creatures . ix cid . crState . crDamage) - (\dams -> [Piercing 50 sp p ep - ,Blunt 50 sp p ep - ,TorqueDam 1 d1 - ,PushDam 1 $ 3 *.* (ep -.- sp) - ] ++ dams - ) - $ soundMultiFrom [CrHitSound 0] 15 10 0 - $ over worldEvents addPiercer - w - where (d1,g) = randomR (-0.7,0.7) $ _randGen w - cid = _crID cr - sp = head $ _btTrail' bt - ep = sp +.+ _btVel' bt - addPiercer = (.) $ over particles (piercer :) - piercer = (aGenBulAt' (Just cid) (_btColor' bt) p (_btVel' bt) - (_btHitEffect' bt) (_btWidth' bt) - ) {_btTimer' = _btTimer' bt - 1} - -{- Heavy bullet effects when hitting creature: -piercing, blunt, twisting and pushback damage all applied. - -} -hvBulHitCr' :: Particle -> Point2 -> Creature -> World -> World -hvBulHitCr' bt p cr w = over (creatures . ix cid . crState . crDamage) - (\dams -> [Piercing 200 sp p ep - ,Blunt 100 sp p ep - ,TorqueDam 1 d1 - ,PushDam 1 $ 3 *.* (ep -.- sp) - ] ++ dams - ) - $ soundMultiFrom [CrHitSound 0] 15 10 0 - w + ([Piercing 50 sp p ep + ,Blunt 50 sp p ep + ,TorqueDam 1 d1 + ,PushDam 1 $ 3 *.* (ep -.- sp) + ] + ++ + ) + $ soundMultiFrom [CrHitSound 0] 15 10 0 + $ over worldEvents (addPiercer . ) + w where (d1,g) = randomR (-0.7,0.7) $ _randGen w cid = _crID cr sp = head $ _btTrail' bt ep = sp +.+ _btVel' bt - + addPiercer = over particles (piercer :) + piercer = (aGenBulAt' (Just cid) (_btColor' bt) p (_btVel' bt) + (_btHitEffect' bt) (_btWidth' bt) + ) {_btTimer' = _btTimer' bt - 1} +{- | +Heavy bullet effects when hitting creature: +piercing, blunt, twisting and pushback damage all applied. -} +hvBulHitCr' :: Particle -> Point2 -> Creature -> World -> World +hvBulHitCr' bt p cr w + = over (creatures . ix cid . crState . crDamage) + ([Piercing 200 sp p ep + ,Blunt 100 sp p ep + ,TorqueDam 1 d1 + ,PushDam 1 $ 3 *.* (ep -.- sp) + ] + ++ + ) + $ soundMultiFrom [CrHitSound 0] 15 10 0 + w + where + (d1,g) = randomR (-0.7,0.7) $ _randGen w + cid = _crID cr + sp = head $ _btTrail' bt + ep = sp +.+ _btVel' bt +{- | +Create a flamelet when hitting a creature. -} bulIncCr' :: Particle -> Point2 -> Creature -> World -> World bulIncCr' bt p cr w = over (creatures . ix cid . crState . crDamage) - (\dams -> [Piercing 60 sp p ep - ] ++ dams - ) - $ soundMultiFrom [CrHitSound 0] 15 10 0 - $ incFlamelets - w + ( Piercing 60 sp p ep : ) + $ soundMultiFrom [CrHitSound 0] 15 10 0 + $ incFlamelets + w where cid = _crID cr sp = head $ _btTrail' bt ep = sp +.+ _btVel' bt v = evalState (randInCirc 1) $ _randGen w incFlamelets = over worldEvents $ (.) (makeFlameletTimed p v Nothing 3 20) - -{- -Creates a shockwave when hitting a creature. - -} +{- | +Creates a shockwave when hitting a creature. -} bulConCr' :: Particle -> Point2 -> Creature -> World -> World bulConCr' bt p cr w = over (creatures . ix cid . crState . crDamage) - (\dams -> [Piercing 60 sp p ep - ] ++ dams - ) - $ soundMultiFrom [CrHitSound 0] 15 10 0 - $ mkwave - w + ( Piercing 60 sp p ep : ) + $ soundMultiFrom [CrHitSound 0] 15 10 0 + $ mkwave + w where cid = _crID cr sp = head $ _btTrail' bt ep = sp +.+ _btVel' bt mkwave = over worldEvents $ (.) (makeShockwaveAt [] p 15 4 1 white) - -{- -Hitting wall effects: create a spark, damage blocks. - -} +{- | +Hitting wall effects: create a spark, damage blocks. -} bulHitWall' :: Particle -> Point2 -> Wall -> World -> World -bulHitWall' bt p x w = damageBlocks x - $ createSpark 8 colID pOut (reflectDir x) Nothing - $ set randGen g - w +bulHitWall' bt p x w = damageBlocks x + $ createSpark 8 colID pOut (reflectDir x) Nothing + $ set randGen g + w where sp = head $ _btTrail' bt pOut = p +.+ safeNormalizeV (sp -.- p) (colID,g) = randomR (0,11) $ _randGen w (a, _) = randomR (-0.1,0.1) $ _randGen w spid = newKey $ _projectiles w - reflectDir wall = a + (argV $ reflectIn - (_wlLine wall !! 1 -.- _wlLine wall !! 0) - (p -.- sp) - ) - damageBlocks wall w - = case wall ^? blHP of + reflectDir wall = a + + argV (reflectIn (_wlLine wall !! 1 -.- _wlLine wall !! 0) (p -.- sp) ) + damageBlocks wall w = case wall ^? blHP of Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 5)) w (_blIDs wall) _ -> w - -{- +{- | Bounce off walls, do damage to blocks. -} bulBounceWall' :: Particle -> Point2 -> Wall -> World -> World @@ -183,16 +173,21 @@ bulBounceWall' bt p wl w = damageBlocks wl $ over worldEvents addBouncer w bouncer = (aGenBulAt' Nothing (_btColor' bt) pOut reflectVel (_btHitEffect' bt) (_btWidth' bt) ) {_btTimer' = _btTimer' bt - 1} - wallV = (_wlLine wl !! 1 -.- _wlLine wl !! 0) + wallV = _wlLine wl !! 1 -.- _wlLine wl !! 0 reflectVel = (reflectIn wallV (_btVel' bt)) addBouncer = (.) ( over particles (bouncer : ) ) -- the hack is to get around the fact that the particles list gets reset after -- all projectiles in it are checked, so we cannot add to it as we accumulate over -- this list -{- Create flamelet on wall. +{- | Create flamelet on wall. -} -bulIncWall' :: Particle -> Point2 -> Wall -> World -> World +bulIncWall' + :: Particle + -> Point2 -- Impact point + -> Wall + -> World + -> World bulIncWall' bt p wl w = damageBlocks wl $ incFlamelets w where sp = head $ _btTrail' bt @@ -201,12 +196,17 @@ bulIncWall' bt p wl w = damageBlocks wl $ incFlamelets w = case wall ^? blHP of Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 5)) w (_blIDs wall) _ -> w - wallV = (_wlLine wl !! 1 -.- _wlLine wl !! 0) + wallV = _wlLine wl !! 1 -.- _wlLine wl !! 0 reflectVel = safeNormalizeV $ reflectIn wallV (_btVel' bt) incFlamelets = over worldEvents $ (.) (makeFlameletTimed pOut reflectVel Nothing 3 20) -{- Create a shockwave on wall-} -bulConWall' :: Particle -> Point2 -> Wall -> World -> World +{- | Create a shockwave on wall-} +bulConWall' + :: Particle + -> Point2 -- Impact point + -> Wall + -> World + -> World bulConWall' bt p wl w = damageBlocks wl $ mkwave w where sp = head $ _btTrail' bt @@ -215,25 +215,27 @@ bulConWall' bt p wl w = damageBlocks wl $ mkwave w = case wall ^? blHP of Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 5)) w (_blIDs wall) _ -> w - wallV = (_wlLine wl !! 1 -.- _wlLine wl !! 0) + wallV = _wlLine wl !! 1 -.- _wlLine wl !! 0 mkwave = over worldEvents $ (.) (makeShockwaveAt [] p 15 4 1 white) -hvBulHitWall' :: Particle -> Point2 -> Wall -> World -> World +hvBulHitWall' + :: Particle + -> Point2 -- Impact point + -> Wall + -> World + -> World hvBulHitWall' bt p x w = damageBlocks x $ set randGen g $ foldr ($) w (sparks pOut sv) where sp = head $ _btTrail' bt pOut = p +.+ safeNormalizeV (sp -.- p) (a, g) = randomR (-0.1,0.1) $ _randGen w spid = newKey $ _projectiles w - reflectDir wall = a + (argV $ reflectIn - (_wlLine wall !! 1 -.- _wlLine wall !! 0) - (p -.- sp) - ) + reflectDir wall = a + + argV (reflectIn (_wlLine wall !! 1 -.- _wlLine wall !! 0) (p -.- sp) ) sv = unitVectorAtAngle $ reflectDir x - damageBlocks wall w - = case wall ^? blHP of - Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 20)) w (_blIDs wall) - _ -> w + damageBlocks wall w = case wall ^? blHP of + Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 20)) w (_blIDs wall) + _ -> w cs = take 10 $ randomRs (0,11) $ _randGen w ds = randomRs (-0.7,0.7) $ _randGen w ts = randomRs (4,8) $ _randGen w @@ -242,15 +244,20 @@ hvBulHitWall' bt p x w = damageBlocks x $ set randGen g $ foldr ($) w (sparks p bulHitFF' :: Particle -> Point2 -> ForceField -> World -> World bulHitFF' _ _ _ = id -bulletEffect' :: HitEffect -bulletEffect' = destroyOnImpact bulHitCr' bulHitWall' bulHitFF' +{- +Typical effect: destroy on impact, damage creatures and blocks, create spark on walls. + -} +basicBulletEffect :: HitEffect +basicBulletEffect = destroyOnImpact bulHitCr' bulHitWall' bulHitFF' -bulletParticleSideEffect :: Particle -> HitEffect -bulletParticleSideEffect pt = destroyOnImpact mkPt mkPt noEff - where - mkPt _ p _ = over particles ((pt {_btTrail' = [p]}) :) - -aGenBulAt' :: Maybe Int -> Color -> Point2 -> Point2 -> HitEffect -> Float -> Particle +aGenBulAt' + :: Maybe Int -- ^ Pass-through creature id + -> Color + -> Point2 -- ^ Start position + -> Point2 -- ^ Velocity + -> HitEffect + -> Float -- ^ Bullet width + -> Particle aGenBulAt' maycid col pos vel hiteff width = Bul' { _ptDraw = drawBul , _ptUpdate' = mvGenBullet' @@ -263,7 +270,15 @@ aGenBulAt' maycid col pos vel hiteff width = Bul' , _btHitEffect' = hiteff } -aCurveBulAt :: Maybe Int -> Color -> Point2 -> Point2 -> Point2 -> HitEffect -> Float -> Particle +aCurveBulAt + :: Maybe Int -- ^ Pass-through creature id + -> Color + -> Point2 -- ^ Start position + -> Point2 -- ^ Control position + -> Point2 -- ^ Target position + -> HitEffect + -> Float -- ^ Bullet width + -> Particle aCurveBulAt maycid col pos control targ hiteff width = Bul' { _ptDraw = drawBul , _ptUpdate' = \w -> mvGenBullet' w . setVel diff --git a/src/Dodge/Item/Weapon/Decoration.hs b/src/Dodge/Item/Weapon/Decoration.hs new file mode 100644 index 000000000..36c02a5bc --- /dev/null +++ b/src/Dodge/Item/Weapon/Decoration.hs @@ -0,0 +1,29 @@ +{- | +Particles and pictures that decorate weapons, such as laser scopes etc. +-} +module Dodge.Item.Weapon.Decoration + where +import Dodge.Data +import Dodge.Base +import Geometry.Data +import Picture + +import Control.Lens + +makeLaserScope + :: Point2 -- ^ Start point + -> Point2 -- ^ End point + -> Float -- ^ Fraction of red/green + -> Particle +makeLaserScope p ep relFrac = Particle + {_ptDraw = const $ onLayer PtLayer $ pictures + [color (withAlpha 0.5 $ mixColors relFrac (1-relFrac) red green) + $ lineOfThickness 0.5 [p,ep] + ,color (withAlpha 0.2 $ mixColors relFrac (1-relFrac) red green) + $ lineOfThickness 1.5 [p,ep] + ,color (withAlpha 0.1 $ mixColors relFrac (1-relFrac) red green) + $ lineOfThickness 2 [p,ep] + ] + ,_ptUpdate' = \w pt -> (w, Just $ pt & ptUpdate' .~ \w' _ -> (w',Nothing)) + } + diff --git a/src/Dodge/Item/Weapon/ExtraEffect.hs b/src/Dodge/Item/Weapon/ExtraEffect.hs new file mode 100644 index 000000000..d04520661 --- /dev/null +++ b/src/Dodge/Item/Weapon/ExtraEffect.hs @@ -0,0 +1,96 @@ +{-# LANGUAGE BangPatterns #-} +{- | +Extra weapon effects, supplementing explicit use effects. + -} +module Dodge.Item.Weapon.ExtraEffect + where +import Dodge.Data +import Dodge.Base +import Dodge.Item.Weapon.Decoration +import Dodge.Item.Weapon.UseEffect +import Dodge.WorldEvent.Flash +import Dodge.WorldEvent.ThingsHit +import Picture +import Geometry.Vector + +import Data.Maybe +import Control.Lens +import qualified Data.IntMap.Strict as IM +{- | +Controls resetting a weapon, allows for non-continuous fire needing a button release. -} +wpRecock :: ItEffect +wpRecock = ItInvEffect + {_itInvEffect = f + ,_itEffectCounter = 0 + } + where + f cr i = creatures . ix (_crID cr) . crInv %~ IM.adjust fOnIt i + moveHammerUp HammerDown = HammerReleased + moveHammerUp HammerReleased = HammerUp + moveHammerUp HammerUp = HammerUp + fOnIt it = it & itHammer %~ moveHammerUp +{- | +Special recock for the bezier gun. +Not sure of its purpose at this time... -} +bezierRecock :: ItEffect +bezierRecock = ItInvEffect + {_itInvEffect = f + ,_itEffectCounter = 0 + } + where + f cr i = creatures . ix (_crID cr) . crInv %~ IM.adjust fOnIt i + fOnIt it = case _itHammer it of + HammerDown -> it & itHammer .~ HammerUp + _ -> it & itAttachment .~ Nothing +{- | +Creates a laser scope and recocks the weapon. + -} +itemLaserScopeEffect :: ItEffect +itemLaserScopeEffect + = ItInvEffect {_itInvEffect = f ,_itEffectCounter = 0 } + where + moveHammerUp !HammerDown = HammerReleased + moveHammerUp !_ = HammerUp + f cr invid w + | invid == _crInvSel cr = w + & particles %~ (:) (makeLaserScope sp ep reloadFrac) + & creatures . ix (_crID cr) . crInv . ix invid . itHammer %~ moveHammerUp + & laserScopeTargetGlow col glowPoint + | otherwise = w + where + p = _crPos cr + d = _crDir cr + r = _crRad cr + sp = p +.+ (r + 3) *.* unitVectorAtAngle d + xp = sp +.+ 3000 *.* unitVectorAtAngle d + ep = case listToMaybe $ thingsHitLongLine sp xp w of + Just (p,_) -> p + Nothing -> xp + glowPoint = case listToMaybe $ thingsHitLongLine sp xp w of + Just (p,E3x2 wl) -> p +.+ 2 *.* wallNormal wl + _ -> ep -.- 2 *.* unitVectorAtAngle d + it = (cr ^. crInv) IM.! invid + reloadFrac + | _wpLoadedAmmo it == 0 = 1 + | otherwise = fromIntegral (_wpReloadState it) / fromIntegral (_wpReloadTime it) + col = mixColors reloadFrac (1-reloadFrac) red green +{- | +Automatically send out radar pulses that detect walls. -} +autoRadarEffect :: ItEffect +autoRadarEffect = ItInvEffect {_itInvEffect = f 50 ,_itEffectCounter = 0 } + where + f 0 cr i w = aRadarPulse (_crID cr) w + & creatures . ix (_crID cr) . crInv . ix i + . itEffect . itInvEffect .~ f 100 + f t cr i w = w + & creatures . ix (_crID cr) . crInv . ix i + . itEffect . itInvEffect .~ f (t-1) +{- | +Automatically send out sonar pulses that detect creatures. -} +autoSonarEffect :: ItEffect +autoSonarEffect = ItInvEffect {_itInvEffect = f 50 ,_itEffectCounter = 0 } + where f 0 cr i w = aSonarPulse (_crID cr) + w & creatures . ix (_crID cr) . crInv . ix i + . itEffect . itInvEffect .~ f 140 + f t cr i w = w & creatures . ix (_crID cr) . crInv . ix i + . itEffect . itInvEffect .~ f (t-1) diff --git a/src/Dodge/Item/Weapon/InventoryDisplay.hs b/src/Dodge/Item/Weapon/InventoryDisplay.hs index 2b23559b6..47cfe2a34 100644 --- a/src/Dodge/Item/Weapon/InventoryDisplay.hs +++ b/src/Dodge/Item/Weapon/InventoryDisplay.hs @@ -13,23 +13,15 @@ import Control.Monad -- not sure if this is in the right place... +{- | +Displays the item name, ammo if loaded, and any selected '_itCharMode'. + -} basicWeaponDisplay :: Item -> String basicWeaponDisplay it = case it ^? itAttachment . _Just . itCharMode of Just (c :<| _) -> midPadL 10 ' ' (_itName it) (' ' : aIfLoaded) ++ [' ',c] _ -> midPadL 10 ' ' (_itName it) (' ' : aIfLoaded) where availableAmmo = show $ _wpMaxAmmo it - aIfLoaded = case (_wpReloadState it) of + aIfLoaded = case _wpReloadState it of 0 -> show $ _wpLoadedAmmo it x -> "R" ++ show x - -displayLasGun :: Item -> String -displayLasGun it@(Weapon {_itAttachment = mayPhase}) - = midPadL 10 ' ' "LASER" (' ':aIfLoaded) ++ (' ':phaseS) - where aIfLoaded = case (_wpReloadState it) of - 0 -> show $ _wpLoadedAmmo it - x -> "R" ++ show x - phaseS = case mayPhase of - Just (ItPhaseV 0.2) -> "V" - Just (ItPhaseV 1) -> "/" - Just (ItPhaseV 5) -> "Z" diff --git a/src/Dodge/Item/Weapon/Recock.hs b/src/Dodge/Item/Weapon/Recock.hs deleted file mode 100644 index 4fe76a28d..000000000 --- a/src/Dodge/Item/Weapon/Recock.hs +++ /dev/null @@ -1,36 +0,0 @@ -{-# LANGUAGE BangPatterns #-} -{- | -Controls for continuous and non-continuous fire. - -} -module Dodge.Item.Weapon.Recock - where -import Dodge.Data - -import Control.Lens -import qualified Data.IntMap.Strict as IM -{- | -Controls resetting a weapon, allows for non-continuous fire needing a button release. -} -wpRecock :: ItEffect -wpRecock = ItInvEffect - {_itInvEffect = f - ,_itEffectCounter = 0 - } - where - f cr i = creatures . ix (_crID cr) . crInv %~ IM.adjust fOnIt i - moveHammerUp HammerDown = HammerReleased - moveHammerUp HammerReleased = HammerUp - moveHammerUp HammerUp = HammerUp - fOnIt it = it & itHammer %~ moveHammerUp -{- | -Special recock for the bezier gun. -Not sure of its purpose at this time... -} -bezierRecock :: ItEffect -bezierRecock = ItInvEffect - {_itInvEffect = f - ,_itEffectCounter = 0 - } - where - f cr i = creatures . ix (_crID cr) . crInv %~ IM.adjust fOnIt i - fOnIt it = case _itHammer it of - HammerDown -> it & itHammer .~ HammerUp - _ -> it & itAttachment .~ Nothing diff --git a/src/Dodge/Item/Weapon/TriggerType.hs b/src/Dodge/Item/Weapon/TriggerType.hs index 423cb8894..3eec22682 100644 --- a/src/Dodge/Item/Weapon/TriggerType.hs +++ b/src/Dodge/Item/Weapon/TriggerType.hs @@ -99,7 +99,9 @@ withRecoil withRecoil recoilAmount eff cid = eff cid . over (creatures . ix cid) pushback where pushback cr = over crPos (+.+ rotateV (_crDir cr) ((-recoilAmount) / _crMass cr ,0)) cr - +{- | +Pushes a creature sideways by a random amount. +Applied before the underlying effect. -} withSidePush :: Float -- ^ Maximal possible side push amount -> (Int -> World -> World) @@ -111,6 +113,19 @@ withSidePush maxSide eff cid w = eff cid . over (creatures . ix cid) push $ w push cr = over crPos (+.+ rotateV (_crDir cr) (0,pushAmount / _crMass cr)) cr (pushAmount, _) = randomR (-maxSide,maxSide) $ _randGen w {- | +Pushes a creature sideways by a random amount. +Applied after the underlying effect. -} +withSidePushAfter + :: Float -- ^ Maximal possible side push amount + -> (Int -> World -> World) + -- ^ Underlying world effect, takes creature id as input + -> Int -- ^ Creature id + -> World -> World +withSidePushAfter maxSide eff cid w = over (creatures . ix cid) push . eff cid $ w + where + push cr = over crPos (+.+ rotateV (_crDir cr) (0,pushAmount / _crMass cr)) cr + (pushAmount, _) = randomR (-maxSide,maxSide) $ _randGen w +{- | Applies a world effect and sound effect after an ammo check. -} shootWithSound :: Int -- ^ Sound identifier @@ -134,7 +149,8 @@ shootWithSound soundid f cid w && _wpFireState item == 0 && _wpLoadedAmmo item > 0 reloadCondition = _wpLoadedAmmo item == 0 -{- | Applies a world effect after a hammer position check. -} +{- | +Applies a world effect after a hammer position check. -} hammerCheck :: (Int -> World -> World) -- ^ Underlying effect -> Int -- ^ Creature id @@ -146,8 +162,8 @@ hammerCheck f cid w = case (_crInv cr IM.! _crInvSel cr) ^? itHammer of where cr = _creatures w IM.! cid setHammerDown = creatures . ix cid . crInv . ix (_crInvSel cr) . itHammer .~ HammerDown - -{- | Applies a world effect after an ammo check. -} +{- | +Applies a world effect after an ammo check. -} shoot :: (Int -> World -> World) -- ^ Underlying effect, takes creature id as input @@ -175,8 +191,7 @@ withMuzFlare -> Int -- ^ Creature id -> World -> World -withMuzFlare f cid w = tempLightForAt 3 pos - . muzzleFlashAt pos2 $ f cid w +withMuzFlare f cid w = tempLightForAt 3 pos . muzzleFlashAt pos2 $ f cid w where cr = _creatures w IM.! cid dir = _crDir cr @@ -184,8 +199,7 @@ withMuzFlare f cid w = tempLightForAt 3 pos pos2 = _crPos cr +.+ (2 * _crRad cr) *.* unitVectorAtAngle (_crDir cr) {- | -Rotates the creature randomly, applies the effect, rotates the creature back. --} +Rotates the creature randomly, applies the effect, rotates the creature back. -} withRandomDir :: Float -- ^ Max possible rotation -> (Int -> World -> World) @@ -336,3 +350,23 @@ numVelWthHitEff num vel wth eff cid w = over particles (newbuls ++) w offsets = map (\y -> rotateV d (0,y)) [-maxOffset,5-maxOffset..] colids = take num $ randomRs (0,11) (_randGen w) pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle d + +{- | +Uses '_wpSpread' as a parameter for the current offset angle. -} +randWalkAngle + :: Float -- ^ Max offset angle + -> Float -- ^ Walk speed + -> (Int -> World -> World) -- ^ Underlying effect + -> Int -- ^ Creature id + -> World + -> World +randWalkAngle ma aspeed f cid w = w + & creatures . ix cid . crDir -~ a + & f cid + & creatures . ix cid . crDir +~ a + & creatures . ix cid . crInv . ix i . wpSpread .~ newa + where + a = _wpSpread $ _crInv (_creatures w IM.! cid) IM.! i + (walka, g) = randomR (-aspeed,aspeed) (_randGen w) + newa = min ma $ max (negate ma) (a + walka) + i = _crInvSel $ _creatures w IM.! cid diff --git a/src/Dodge/Item/Weapon/UseEffect.hs b/src/Dodge/Item/Weapon/UseEffect.hs new file mode 100644 index 000000000..78f168848 --- /dev/null +++ b/src/Dodge/Item/Weapon/UseEffect.hs @@ -0,0 +1,110 @@ +{- | +Effects centered on creatures. +These are typically item effects, and typical occur when an item is explictly used. -} +module Dodge.Item.Weapon.UseEffect + where +import Dodge.Data +import Dodge.Base +import Dodge.Item.Weapon.Decoration +import Dodge.WorldEvent.Flash +import Dodge.WorldEvent.ThingsHit +import Picture +import Geometry + +import Data.Maybe +import Control.Lens +import qualified Data.IntMap.Strict as IM +{- | +Creates an outwardly increasing circle that draws creatures, even those behind walls. -} +aSonarPulse :: Int -> World -> World +aSonarPulse cid w = over particles ((:) $ sonarPulseAt (_crPos (_creatures w IM.! cid))) w + +{- | +Creates an outwardly increasing circle that displays walls, even those behind other walls. -} +aRadarPulse :: Int -> World -> World +aRadarPulse cid w = over particles ((:) $ radarPulseAt (_crPos (_creatures w IM.! cid))) w + +{- | +Radar blip at a point. + -} +blipAt :: Point2 -> Color -> Int -> Particle +blipAt p col i = Particle + {_ptDraw = const blank + ,_ptUpdate' = mvBlip p col i i + } + +mvBlip :: Point2 -> Color + -> Int -- ^ Max possible timer value + -> Int -- ^ Current timer value + -> World -> Particle -> (World, Maybe Particle) +mvBlip p col maxt 0 w pt = (w, Nothing) +mvBlip p col maxt t w pt + = (w, Just $ pt & ptUpdate' .~ mvBlip p col maxt (t-1) + & ptDraw .~ (const . setDepth (-0.5) + . setLayer 1 + $ uncurry translate p + $ color (withAlpha (fromIntegral t / fromIntegral maxt) col) + $ circleSolid 2) + ) + +{- | +An outwardly increasing circle that draws creatures, even those behind walls. -} +sonarPulseAt :: Point2 -> Particle +sonarPulseAt p = Particle { _ptDraw = const blank , _ptUpdate' = mvSonar 100 p } + +mvSonar + :: Int -- ^ Timer + -> Point2 -- ^ Center of expanding circle + -> World -> Particle -> (World, Maybe Particle) +mvSonar 0 _ w _ = (w, Nothing) +mvSonar x p w pt = (w, Just $ pt {_ptDraw = const pic + ,_ptUpdate' = mvSonar (x-1) p + } + ) + where + pic = setDepth (-0.5) . setLayer 1 $ pictures crBlips + crBlips = mapMaybe crBlip $ IM.elems $ _creatures w + crBlip cr | dist cpos p < r + crad && dist cpos p > r - (crad + 100) + = Just $ colHelper (0.5 * (1 - (r - dist cpos p) /100)) + $ uncurry translate cpos $ circleSolid crad + | otherwise = Nothing + where crad = _crRad cr + cpos = _crPos cr + r = fromIntegral (500 - x*5) + sweepPics = [colHelper 0.05 $ uncurry translate p $ thickCircle r 5 ] + globalAlpha | x > 10 = 1 + | otherwise = fromIntegral x / 10 + colHelper y = color (withAlpha (y * globalAlpha) green) +{- | +An outwardly increasing circle that displays walls, even those behind other walls. -} +radarPulseAt :: Point2 -> Particle +radarPulseAt p = Particle + { _ptDraw = const blank + , _ptUpdate' = mvRadar 50 p + } + +mvRadar + :: Int -- ^ Timer + -> Point2 -- ^ Center of expanding circle + -> World -> Particle -> (World, Maybe Particle) +mvRadar 0 _ w _ = (w, Nothing) +mvRadar x p w pt = (putBlips w, Just $ pt {_ptDraw = const pic + ,_ptUpdate' = mvRadar (x-1) p + } + ) + where + pic = onLayerL [levLayer ShadowLayer, 1] $ pictures $ sweepPics + putBlips = over worldEvents ((.) $ over particles ((++) blips)) + blips = map (\p -> blipAt p (withAlpha (0.5*globalAlpha) red) 50) + $ circPoints + circPoints = mapMaybe (\wl -> collidePointCircCorrect (_wlLine wl !! 0) (_wlLine wl !! 1) r p) + $ (map (over wlLine reverse) $ IM.elems $ wallsAlongCirc p r w) + ++ (IM.elems $ wallsAlongCirc p r w) + r = fromIntegral (800 - x*16) + sweepPics = [--colHelper 0.1 $ uncurry translate p $ thickCircle r 15 + --,colHelper 0.06 $ uncurry translate p $ thickCircle (r-5) 5 + --,colHelper 0.03 $ uncurry translate p $ thickCircle (r-10) 5 + ] + globalAlpha | x > 10 = 1 + | otherwise = fromIntegral x / 10 + colHelper y = color (withAlpha (y * globalAlpha) red) diff --git a/src/Picture/Preload.hs b/src/Picture/Preload.hs index 2bb0d50e4..746a1953d 100644 --- a/src/Picture/Preload.hs +++ b/src/Picture/Preload.hs @@ -120,7 +120,7 @@ setupFramebuffer = do textureBinding Texture2D $= Just fboTO texImage2D Texture2D NoProxy 0 RGBA8 (TextureSize2D 800 600) 0 (PixelData RGBA UnsignedByte nullPtr) texImage2D Texture2D NoProxy 0 RGBA8 (TextureSize2D 8 6) 0 (PixelData RGBA UnsignedByte nullPtr) - textureFilter Texture2D $= ((Linear',Just Linear') , Nearest) + textureFilter Texture2D $= ((Linear',Just Linear') , Linear') generateMipmap' Texture2D framebufferTexture2D Framebuffer (ColorAttachment 0) Texture2D fboTO 0 diff --git a/src/Picture/Render.hs b/src/Picture/Render.hs index 8287ce599..f5835d3f8 100644 --- a/src/Picture/Render.hs +++ b/src/Picture/Render.hs @@ -140,7 +140,12 @@ createLightMap pdata resDiv wallPoints lightPoints bindFramebuffer Framebuffer $= defaultFramebufferObject colorMask $= Color4 Disabled Disabled Disabled Enabled bindShaderBuffers [_fullscreenShader pdata] [4] +-- by upscaling the shadowmap texture and using Linear' magnification +-- interpolation, we get a poor mans blur textureBinding Texture2D $= Just (_fboTexture pdata) + textureFilter Texture2D $= ((Linear',Just Linear') , Linear') +-- not sure about the perforamnce implications ^^^ + generateMipmap' Texture2D drawShader (_fullscreenShader pdata) 4 colorMask $= Color4 Enabled Enabled Enabled Enabled blend $= Enabled