diff --git a/shader/wallShadow.geom b/shader/wallShadow.geom index 9b141fe65..ee8265377 100644 --- a/shader/wallShadow.geom +++ b/shader/wallShadow.geom @@ -39,6 +39,7 @@ void main() // emitLine (frontR); // emitLine (backR); // emitLine (frontR); + emitLine (backR); emitLine (backL); } diff --git a/src/Dodge/Critters.hs b/src/Dodge/Critters.hs index c993d3fe7..c0c102173 100644 --- a/src/Dodge/Critters.hs +++ b/src/Dodge/Critters.hs @@ -1,12 +1,13 @@ module Dodge.Critters where -- imports {{{ import Dodge.Data -import Dodge.Weapons import Dodge.AIs import Dodge.CreatureState import Dodge.Prototypes import Dodge.Base import Dodge.Smoke +import Dodge.Item.Weapon +import Dodge.Item.Consumable import Picture import Geometry diff --git a/src/Dodge/Item/Consumable.hs b/src/Dodge/Item/Consumable.hs new file mode 100644 index 000000000..ab94863b1 --- /dev/null +++ b/src/Dodge/Item/Consumable.hs @@ -0,0 +1,34 @@ +module Dodge.Item.Consumable + where +import Dodge.Data +import Dodge.Base +import Dodge.Prototypes +import Dodge.SoundLogic + +import Dodge.Item.Draw + +import Picture + +import Control.Lens + +import qualified Data.IntMap.Strict as IM + +medkit :: Int -> Item +medkit i = basicConsumable + { _itIdentity = Medkit25 + , _itName = "MEDKIT" ++ show i + , _itMaxStack = 9 + , _itAmount = 1 + , _cnEffect = heal i + , _itFloorPict = onLayer FlItLayer $ color blue $ circleSolid 3 + , _itEquipPict = drawWeapon $ color blue $ circleSolid 3 + , _itID = Nothing + } + +heal25 :: Int -> World -> Maybe World +heal25 = heal 25 +heal :: Int -> Int -> World -> Maybe World +heal hp n w | _crHP (_creatures w IM.! n) >= 10000 = Nothing + | otherwise = Just $ soundOnce healSound + $ over (creatures . ix n . crHP) ((\x-> min x 10000). (+ hp) ) w + diff --git a/src/Dodge/Item/Draw.hs b/src/Dodge/Item/Draw.hs new file mode 100644 index 000000000..75fa6323e --- /dev/null +++ b/src/Dodge/Item/Draw.hs @@ -0,0 +1,13 @@ +module Dodge.Item.Draw + where +import Dodge.Data +import Dodge.Base + +import Picture + +drawWeapon :: Picture -> Creature -> Int -> Drawing +drawWeapon p cr posInInv + | _crInvSel cr == posInInv = onLayer PtLayer drawnWep + | otherwise = blank + where drawnWep = uncurry translate (_crRad cr,0) p + diff --git a/src/Dodge/Weapons.hs b/src/Dodge/Item/Weapon.hs similarity index 88% rename from src/Dodge/Weapons.hs rename to src/Dodge/Item/Weapon.hs index ddb933ede..cf263834e 100644 --- a/src/Dodge/Weapons.hs +++ b/src/Dodge/Item/Weapon.hs @@ -1,5 +1,5 @@ {-# LANGUAGE BangPatterns #-} -module Dodge.Weapons where +module Dodge.Item.Weapon where -- imports {{{ import Dodge.Data import Dodge.Base @@ -11,6 +11,11 @@ import Dodge.Debug import Dodge.WallCreatureCollisions import Dodge.Prototypes +import Dodge.Item.Draw + +import Dodge.Item.Weapon.Bullet +import Dodge.Item.Weapon.InventoryDisplay + import Geometry import Picture @@ -53,7 +58,6 @@ pistol = Weapon , _wpFireState = 0 , _wpFire = shootWithSound 0 $ withAccVelWthHiteff' 0.1 (30,0) 2 --- $ threeEff' bulIncCr' bulIncWall' bulHitFF' $ threeEff' bulHitCr' bulHitWall' bulHitFF' , _wpSpread = 0.02 , _wpRange = 20 @@ -76,15 +80,6 @@ pistol = Weapon defaultGun = pistol defaultAutoGun = autoGun {_itScrollUp = const id , _itScrollDown = const id, _itInvDisplay = basicWeaponDisplay} -basicWeaponDisplay :: Item -> String -basicWeaponDisplay it = midPadL 10 ' ' (_itName it) (' ' : aIfLoaded) ---basicWeaponDisplay it = rightPad 8 ' ' (_itName it) ++ leftPad 3 ' ' aIfLoaded --- ++ "/" ++ leftPad 3 ' ' availableAmmo - where - availableAmmo = show $ _wpMaxAmmo it - aIfLoaded = case (_wpReloadState it) of - 0 -> show $ _wpLoadedAmmo it - x -> "R" ++ show x effectGun :: String -> (Int -> World -> World) -> Item effectGun name eff = defaultGun { _itName = name ++ "Gun" @@ -104,7 +99,6 @@ autoGun = defaultGun , _wpAmmoType = PistolBullet , _wpReloadTime = 80 , _wpReloadState = 0 --- , _wpFireRate = 6 , _wpFireRate = 6 , _wpFireState = 0 , _wpFire = autoFireMode @@ -124,16 +118,6 @@ autoGun = defaultGun , _itScrollDown = incMode , _itInvDisplay = displayAutoGun } -displayAutoGun :: Item -> String -displayAutoGun it@(Weapon {_itAttachment = mayMode}) - = midPadL 10 ' ' "AUTOGUN" (' ':aIfLoaded) ++ (' ':phaseS) - where aIfLoaded = case (_wpReloadState it) of - 0 -> show $ _wpLoadedAmmo it - x -> "R" ++ show x - phaseS = case mayMode of - Just (ItMode 0) -> "M" - Just (ItMode 1) -> "S" - Just (ItMode 2) -> "B" autoFireMode = shootWithSound (fromIntegral autoGunSound) $ withRecoil 40 $ torqueBefore 0.05 @@ -245,16 +229,6 @@ lasGun = defaultAutoGun , _itScrollDown = decPhaseV , _itInvDisplay = displayLasGun } -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" incPhaseV :: Int -> World -> World incPhaseV _ w = w & creatures . ix 0 . crInv . ix itRef . itAttachment . _Just . itPhaseV %~ f @@ -1140,225 +1114,7 @@ torqueAfter torque feff cid w rotateScope w = w & creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0)) . itAttachment . _Just . scopePos %~ rotateV rot -aGenBulAt' :: Maybe Int -> Color -> Point2 -> Point2 -> HitEffect' -> Float -> Particle' -aGenBulAt' maycid col pos vel hiteff width = Bul' - { _ptPict' = blank - , _ptUpdate' = mvGenBullet' - , _btVel' = vel - , _btColor' = col - , _btTrail' = [pos] - , _btPassThrough' = maycid - , _btWidth' = width - , _btTimer' = 90 - , _btHitEffect' = hiteff - } --- bullet effects -bulHitCr' :: Particle' -> Point2 -> Creature -> World -> World -bulHitCr' bt p cr w = - let sp = head $ _btTrail' bt - ep = sp +.+ _btVel' bt - -- mvDams = [TorqueDam 1 d1 , PushDam 1 $ 2 *.* (ep -.- sp) ] - mvDams = [ PushDam 1 $ 2 *.* (ep -.- sp) ] - addDamage = over (creatures . ix cid . crState . crDamage) - (\dams -> (Piercing 100 sp p ep : mvDams) ++ dams) - addDamageArmoured = over (creatures . ix cid . crState . crDamage) - (\dams -> mvDams ++ dams) - hitSound = soundMultiFrom [CrHitSound 0] 15 10 0 - flashEff = over worldEvents ((.) $ flareAt red p) - bulVel = ep -.- sp - ck cid = (+.+) (crKnockBack cid *.* bulVel) - crKnockBack cid = (/) 1 $ (+) 2 $ _crMass $ _creatures w IM.! cid - hasArmour cr = any (\it -> it ^? itIdentity == Just FrontArmour) $ _crInv cr - cid = _crID cr - sID = newParticleKey w - (d1,g) = randomR (-0.7,0.7) $ _randGen w - (colID,_) = randomR (0,11) $ _randGen w - hitEffect = addDamage . hitSound . flashEff $ w - in case hasArmour cr of --shit this is ugly, to refactor - True -> if hitBack - then hitEffect - else createSpark 8 colID p1 - (argV (p -.- _crPos (_creatures w IM.! cid)) + d1) - Nothing - . addDamageArmoured - $ w - where cpos = _crPos $ _creatures w IM.! cid - relHitPos = p -.- cpos - hitBack = errorAngleVV 19 (unitVectorAtAngle (_crDir $ _creatures w IM.! cid)) - relHitPos - > pi/2 - p1 = p +.+ 2 *.* safeNormalizeV relHitPos - _ -> hitEffect - -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} - -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 - where (d1,g) = randomR (-0.7,0.7) $ _randGen w - cid = _crID cr - sp = head $ _btTrail' bt - ep = sp +.+ _btVel' bt - -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 - where cid = _crID cr - sp = head $ _btTrail' bt - ep = sp +.+ _btVel' bt - v = evalState (randInCirc 1) $ _randGen w - incFlamelets = over worldEvents $ (.) (makeFlamelet p v (levLayer UPtLayer) Nothing 3) - -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 - where cid = _crID cr - sp = head $ _btTrail' bt - ep = sp +.+ _btVel' bt - mkwave = over worldEvents $ (.) (makeShockwaveAt p 15 4 1 white) - - - -bulHitWall' :: Particle' -> Point2 -> Wall -> World -> World -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 $ _particles w - 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 - -bulBounceWall' :: Particle' -> Point2 -> Wall -> World -> World -bulBounceWall' bt p wl w = damageBlocks wl - $ over worldEvents addBouncer - -- yay for hack -- should have used this before? or never? - w - where sp = head $ _btTrail' bt - pOut = p +.+ safeNormalizeV (sp -.- p) - damageBlocks wall w - = case wall ^? blHP of - Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 5)) w (_blIDs wall) - _ -> w - bouncer = (aGenBulAt' Nothing (_btColor' bt) pOut reflectVel - (_btHitEffect' bt) (_btWidth' bt) - ) {_btTimer' = _btTimer' bt - 1} - 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 particles in it are checked, so we cannot add to it as we accumulate over --- this list - -bulIncWall' :: Particle' -> Point2 -> Wall -> World -> World -bulIncWall' bt p wl w = damageBlocks wl - $ incFlamelets - -- yay for hack -- should have used this before? or never? - w - where sp = head $ _btTrail' bt - pOut = p +.+ safeNormalizeV (sp -.- p) - damageBlocks wall 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) - reflectVel = safeNormalizeV $ reflectIn wallV (_btVel' bt) - incFlamelets = over worldEvents $ (.) (makeFlamelet pOut reflectVel (levLayer UPtLayer) Nothing 3) - -bulConWall' :: Particle' -> Point2 -> Wall -> World -> World -bulConWall' bt p wl w = damageBlocks wl - $ mkwave - -- yay for hack -- should have used this before? or never? - w - where sp = head $ _btTrail' bt - pOut = p +.+ safeNormalizeV (sp -.- p) - damageBlocks wall 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) - mkwave = over worldEvents $ (.) (makeShockwaveAt p 15 4 1 white) - -hvBulHitWall' :: Particle' -> Point2 -> 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 $ _particles w - 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 - sID = newParticleKey w - cs = take 10 $ randomRs (0,11) $ _randGen w - ds = randomRs (-0.7,0.7) $ _randGen w - ts = randomRs (4,8) $ _randGen w - sparks pos vel = zipWith3 (\t c d -> createSpark t c pos (argV vel + d) Nothing) ts cs ds -bulHitFF' :: Particle' -> Point2 -> ForceField -> World -> World -bulHitFF' _ _ _ = id - -bulletEffect' :: HitEffect' -bulletEffect' = threeEff' bulHitCr' bulHitWall' bulHitFF' - -bulletParticleSideEffect :: Particle' -> HitEffect' -bulletParticleSideEffect pt = threeEff' mkPt mkPt noEff - where mkPt _ p _ = over particles' ((:) pt {_btTrail' = [p]}) reflect :: Float -> Float -> Float reflect a b = a + 2*(a-b) @@ -1682,14 +1438,6 @@ fadeLine sp ep alph width col = setLayer 1 $ -- ] -- where p x = sp +.+ x *.* (ep -.- sp) -closestOfThree :: Point2 -> Maybe (Point2,a) -> Maybe (Point2,b) -> Maybe (Point2,c) - -> Maybe (Point2, Either3 a b c) -closestOfThree p x1 x2 x3 = listToMaybe $ sortBy g $ catMaybes [fmap f1 x1,fmap f2 x2,fmap f3 x3] - where f1 (r1,s1) = (r1, E3x1 s1) - f2 (r2,s2) = (r2, E3x2 s2) - f3 (r3,s3) = (r3, E3x3 s3) - g (x,_) (y,_) = compare (magV (x -.- p)) (magV (y -.- p)) - grenadeLauncher :: Item grenadeLauncher = pistol @@ -2012,24 +1760,6 @@ remoteBombPic x = pictures [ color (dark $ dark orange) $ circleSolid 5 remoteBombUnarmedPic :: Picture remoteBombUnarmedPic = color (dark $ dark orange) $ circleSolid 5 -drawWeapon :: Picture -> Creature -> Int -> Drawing -drawWeapon p cr posInInv - | _crInvSel cr == posInInv = onLayer PtLayer drawnWep - | otherwise = blank - where drawnWep = uncurry translate (_crRad cr,0) p - -medkit :: Int -> Item -medkit i = basicConsumable - { _itIdentity = Medkit25 - , _itName = "MEDKIT" ++ show i - , _itMaxStack = 9 - , _itAmount = 1 - , _cnEffect = heal i - , _itFloorPict = onLayer FlItLayer $ color blue $ circleSolid 3 - , _itEquipPict = drawWeapon $ color blue $ circleSolid 3 - , _itID = Nothing - } - makeTeslaArcAt :: Int -> Point2 -> Float -> Particle makeTeslaArcAt i pos dir = Particle @@ -2249,13 +1979,6 @@ latchkeyPic = color yellow $ -- }}} -heal25 :: Int -> World -> Maybe World -heal25 = heal 25 -heal :: Int -> Int -> World -> Maybe World -heal hp n w | _crHP (_creatures w IM.! n) >= 10000 = Nothing - | otherwise = Just $ soundOnce healSound - $ over (creatures . ix n . crHP) ((\x-> min x 10000). (+ hp) ) w - forceFieldFire :: Int -> World -> World forceFieldFire cid w = w diff --git a/src/Dodge/Item/Weapon/Bullet.hs b/src/Dodge/Item/Weapon/Bullet.hs new file mode 100644 index 000000000..1591dba26 --- /dev/null +++ b/src/Dodge/Item/Weapon/Bullet.hs @@ -0,0 +1,238 @@ +module Dodge.Item.Weapon.Bullet + where +import Dodge.Data +import Dodge.Base +import Dodge.WorldActions +import Dodge.SoundLogic +import Dodge.RandomHelp + +import Geometry + +import System.Random + +import Control.Lens +import Control.Monad.State + +import qualified Data.IntMap.Strict as IM + +import Picture + +-- bullet effects +bulHitCr' :: Particle' -> Point2 -> Creature -> World -> World +bulHitCr' bt p cr w = + let sp = head $ _btTrail' bt + ep = sp +.+ _btVel' bt + -- mvDams = [TorqueDam 1 d1 , PushDam 1 $ 2 *.* (ep -.- sp) ] + mvDams = [ PushDam 1 $ 2 *.* (ep -.- sp) ] + addDamage = over (creatures . ix cid . crState . crDamage) + (\dams -> (Piercing 100 sp p ep : mvDams) ++ dams) + addDamageArmoured = over (creatures . ix cid . crState . crDamage) + (\dams -> mvDams ++ dams) + hitSound = soundMultiFrom [CrHitSound 0] 15 10 0 + flashEff = over worldEvents ((.) $ flareAt red p) + bulVel = ep -.- sp + ck cid = (+.+) (crKnockBack cid *.* bulVel) + crKnockBack cid = (/) 1 $ (+) 2 $ _crMass $ _creatures w IM.! cid + hasArmour cr = any (\it -> it ^? itIdentity == Just FrontArmour) $ _crInv cr + cid = _crID cr + sID = newParticleKey w + (d1,g) = randomR (-0.7,0.7) $ _randGen w + (colID,_) = randomR (0,11) $ _randGen w + hitEffect = addDamage . hitSound . flashEff $ w + in case hasArmour cr of --shit this is ugly, to refactor + True -> if hitBack + then hitEffect + else createSpark 8 colID p1 + (argV (p -.- _crPos (_creatures w IM.! cid)) + d1) + Nothing + . addDamageArmoured + $ w + where cpos = _crPos $ _creatures w IM.! cid + relHitPos = p -.- cpos + hitBack = errorAngleVV 19 (unitVectorAtAngle (_crDir $ _creatures w IM.! cid)) + relHitPos + > pi/2 + p1 = p +.+ 2 *.* safeNormalizeV relHitPos + _ -> hitEffect + +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} + +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 + where (d1,g) = randomR (-0.7,0.7) $ _randGen w + cid = _crID cr + sp = head $ _btTrail' bt + ep = sp +.+ _btVel' bt + +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 + where cid = _crID cr + sp = head $ _btTrail' bt + ep = sp +.+ _btVel' bt + v = evalState (randInCirc 1) $ _randGen w + incFlamelets = over worldEvents $ (.) (makeFlamelet p v (levLayer UPtLayer) Nothing 3) + +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 + where cid = _crID cr + sp = head $ _btTrail' bt + ep = sp +.+ _btVel' bt + mkwave = over worldEvents $ (.) (makeShockwaveAt p 15 4 1 white) + + + +bulHitWall' :: Particle' -> Point2 -> Wall -> World -> World +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 $ _particles w + 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 + +bulBounceWall' :: Particle' -> Point2 -> Wall -> World -> World +bulBounceWall' bt p wl w = damageBlocks wl + $ over worldEvents addBouncer + -- yay for hack -- should have used this before? or never? + w + where sp = head $ _btTrail' bt + pOut = p +.+ safeNormalizeV (sp -.- p) + damageBlocks wall w + = case wall ^? blHP of + Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 5)) w (_blIDs wall) + _ -> w + bouncer = (aGenBulAt' Nothing (_btColor' bt) pOut reflectVel + (_btHitEffect' bt) (_btWidth' bt) + ) {_btTimer' = _btTimer' bt - 1} + 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 particles in it are checked, so we cannot add to it as we accumulate over +-- this list + +bulIncWall' :: Particle' -> Point2 -> Wall -> World -> World +bulIncWall' bt p wl w = damageBlocks wl + $ incFlamelets + -- yay for hack -- should have used this before? or never? + w + where sp = head $ _btTrail' bt + pOut = p +.+ safeNormalizeV (sp -.- p) + damageBlocks wall 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) + reflectVel = safeNormalizeV $ reflectIn wallV (_btVel' bt) + incFlamelets = over worldEvents $ (.) (makeFlamelet pOut reflectVel (levLayer UPtLayer) Nothing 3) + +bulConWall' :: Particle' -> Point2 -> Wall -> World -> World +bulConWall' bt p wl w = damageBlocks wl + $ mkwave + -- yay for hack -- should have used this before? or never? + w + where sp = head $ _btTrail' bt + pOut = p +.+ safeNormalizeV (sp -.- p) + damageBlocks wall 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) + mkwave = over worldEvents $ (.) (makeShockwaveAt p 15 4 1 white) + +hvBulHitWall' :: Particle' -> Point2 -> 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 $ _particles w + 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 + sID = newParticleKey w + cs = take 10 $ randomRs (0,11) $ _randGen w + ds = randomRs (-0.7,0.7) $ _randGen w + ts = randomRs (4,8) $ _randGen w + sparks pos vel = zipWith3 (\t c d -> createSpark t c pos (argV vel + d) Nothing) ts cs ds +bulHitFF' :: Particle' -> Point2 -> ForceField -> World -> World +bulHitFF' _ _ _ = id + +bulletEffect' :: HitEffect' +bulletEffect' = threeEff' bulHitCr' bulHitWall' bulHitFF' + +bulletParticleSideEffect :: Particle' -> HitEffect' +bulletParticleSideEffect pt = threeEff' mkPt mkPt noEff + where mkPt _ p _ = over particles' ((:) pt {_btTrail' = [p]}) + +aGenBulAt' :: Maybe Int -> Color -> Point2 -> Point2 -> HitEffect' -> Float -> Particle' +aGenBulAt' maycid col pos vel hiteff width = Bul' + { _ptPict' = blank + , _ptUpdate' = mvGenBullet' + , _btVel' = vel + , _btColor' = col + , _btTrail' = [pos] + , _btPassThrough' = maycid + , _btWidth' = width + , _btTimer' = 90 + , _btHitEffect' = hiteff + } diff --git a/src/Dodge/Item/Weapon/InventoryDisplay.hs b/src/Dodge/Item/Weapon/InventoryDisplay.hs new file mode 100644 index 000000000..062ed92b9 --- /dev/null +++ b/src/Dodge/Item/Weapon/InventoryDisplay.hs @@ -0,0 +1,34 @@ +module Dodge.Item.Weapon.InventoryDisplay + where +import Dodge.Data +import Dodge.Base + +basicWeaponDisplay :: Item -> String +basicWeaponDisplay it = midPadL 10 ' ' (_itName it) (' ' : aIfLoaded) + where + availableAmmo = show $ _wpMaxAmmo it + aIfLoaded = case (_wpReloadState it) of + 0 -> show $ _wpLoadedAmmo it + x -> "R" ++ show x + +displayAutoGun :: Item -> String +displayAutoGun it@(Weapon {_itAttachment = mayMode}) + = midPadL 10 ' ' "AUTOGUN" (' ':aIfLoaded) ++ (' ':phaseS) + where aIfLoaded = case (_wpReloadState it) of + 0 -> show $ _wpLoadedAmmo it + x -> "R" ++ show x + phaseS = case mayMode of + Just (ItMode 0) -> "M" + Just (ItMode 1) -> "S" + Just (ItMode 2) -> "B" + +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/Layout.hs b/src/Dodge/Layout.hs index b8fa34a03..997ad5613 100644 --- a/src/Dodge/Layout.hs +++ b/src/Dodge/Layout.hs @@ -126,6 +126,7 @@ noBoundClip = not . boundClip connectRoom :: a -> Tree (Either a a) connectRoom r = Node (Right r) [] + deadRoom :: a -> Tree (Either a a) deadRoom r = Node (Left r) [] diff --git a/src/Dodge/Rooms.hs b/src/Dodge/Rooms.hs index fc8e03c83..a7286c0b7 100644 --- a/src/Dodge/Rooms.hs +++ b/src/Dodge/Rooms.hs @@ -1,7 +1,7 @@ module Dodge.Rooms where -- imports {{{ import Dodge.Data -import Dodge.Weapons +import Dodge.Item.Weapon import Dodge.Critters import Dodge.LevelGen import Dodge.Base @@ -89,8 +89,6 @@ corridor = Room where lnks = [((20,70) ,0) ,((20,80) +.+ rotateV (0-pi/3) (-20,0), pi/6) ,((20,80) +.+ rotateV ( pi/3) ( 20,0),0-pi/6) --- ,((40,0) +.+ rotateV ( pi/3) (-20,0), 2*pi/3) --- ,(( 0,0) +.+ rotateV (0-pi/3) ( 20,0),0-2*pi/3) ,((20,10) ,pi) ] corridorN :: Room @@ -207,7 +205,8 @@ door = Room { _rmPolys = [rectNSWE 40 0 0 40] , _rmLinks = lnks , _rmPath = [((20,35),(20,5))] - , _rmPS = [PS (0,20) 0 $ PutAutoDoor (0,0) (40,0)] +-- door extends into side walls (for shadows as rendered 12/03) + , _rmPS = [PS (0,20) 0 $ PutAutoDoor (-10,0) (50,0)] , _rmBound = [] } where lnks = [((20,35),0) @@ -531,11 +530,14 @@ weaponLongCorridor = do i2 <- state $ randomR (2,5) let branch1 = treeTrunk (replicate i1 $ Left corridor) (connectRoom $ putCrs connectingRoom) let branch2 = treeTrunk (replicate i2 $ Left corridor) (deadRoom $ putWp corridorN) - return $ Node (Left root) [branch1,branch2] + return $ Node (Left $ addLS root) [branch1,branch2] where putCrs = set rmPS [PS (10,40) (-pi/2) $ randC - ,PS (-10,40) (-pi/2) $ randC - ] - putWp = set rmPS [PS (20,40) 0 $ RandPS randFirstWeapon] + ,PS (-10,40) (-pi/2) $ randC + ] + putWp = set rmPS [PS (20,40) 0 $ RandPS randFirstWeapon + ,PS (20,60) 0 $ basicLS + ] + addLS = id -- set rmPS [PS (0,60) 0 $ basicLS] critInDeadEnd :: Room critInDeadEnd = set rmPS [PS (0,0) 0 $ randC] deadEndRoom