{-# LANGUAGE BangPatterns #-} module Dodge.Item.Weapon ( module Dodge.Item.Weapon ) where -- imports {{{ import Dodge.Data import Dodge.Base import Dodge.SoundLogic import Dodge.CreatureAction import Dodge.RandomHelp import Dodge.WorldEvent import Dodge.Debug import Dodge.WallCreatureCollisions import Dodge.Prototypes import Dodge.Item.Draw import Dodge.Item.Weapon.Bullet import Dodge.Item.Weapon.InventoryDisplay import Dodge.Item.Weapon.TriggerType import Dodge.Item.Weapon.Recock import Geometry import Picture import Data.List import Data.Char import Data.Maybe import Data.Function import qualified Data.ByteString as B import Control.Lens import Control.Applicative import Control.Monad.State import Control.Monad import qualified SDL as SDL --import qualified Graphics.UI.SDL.Mixer as Mix import System.Random import qualified Data.Set as S import qualified Data.IntMap.Strict as IM import qualified Data.Map as M import Foreign.ForeignPtr import Control.Concurrent -- }}} pistol,lasGun,tractorGun,launcher,autoGun ,teslaGun ,spreadGun ,multGun -- ,shatterGun ,longGun,flamer,blinkGun,forceFieldGun :: Item pistol = Weapon { _itName = "PISTOL" , _itIdentity = Pistol , _wpMaxAmmo = 15 , _wpLoadedAmmo = 15 , _wpReloadTime = 40 , _wpReloadState = 0 , _wpFireRate = 8 , _wpFireState = 0 , _wpFire = shootWithSound 0 . withRandomDir 0.1 . withMuzFlare . withVelWthHiteff (30,0) 2 $ threeEff' bulHitCr' bulHitWall' bulHitFF' , _wpSpread = 0.02 , _wpRange = 20 , _itHammer = HammerUp , _itFloorPict = onLayer FlItLayer $ color green $ polygon $ rectNESW 3 3 (-3) (-3) , _itAmount = 1 , _itMaxStack = 1 , _itAimingSpeed = 1 , _itAimingRange = 0 , _itZoom = basicItZoom , _itEquipPict = drawWeapon $ color green $ polygon $ rectNESW 3 3 (-3) (-3) , _itScrollUp = const id , _itScrollDown = const id , _itAttachment = Nothing , _itID = Nothing , _itEffect = wpRecock , _itInvDisplay = basicWeaponDisplay , _itInvColor = white } defaultGun = pistol defaultAutoGun = autoGun {_itScrollUp = const id , _itScrollDown = const id, _itInvDisplay = basicWeaponDisplay} effectGun :: String -> (Int -> World -> World) -> Item effectGun name eff = defaultGun { _itName = name ++ "Gun" , _wpFire = eff } autoEffectGun :: String -> (Int -> World -> World) -> Item autoEffectGun name eff = defaultAutoGun { _itName = name ++ "Gun" , _wpFire = eff } autoGun = defaultGun { _itName = "AUTOGUN" , _itIdentity = AutoGun , _wpMaxAmmo = 30 , _wpLoadedAmmo = 30 , _wpReloadTime = 80 , _wpReloadState = 0 , _wpFireRate = 6 , _wpFireState = 0 , _wpFire = autoFireMode , _wpSpread = autogunSpread , _wpRange = 20 , _itHammer = NoHammer -- , _itHammer = HammerUp , _itFloorPict = onLayer FlItLayer $ color red $ pictures [polygon [(-4,-4),(-4,4),(4,4),(4,-4)]] , _itAmount = 1 , _itMaxStack = 1 , _itAimingSpeed = 0.4 , _itAimingRange = 1 , _itZoom = basicItZoom {_itAimZoomFac = 1.5} , _itEquipPict = drawWeapon $ color red $ polygon $ rectNESW 4 4 (-4) (-4) , _itEffect = NoItEffect , _itAttachment = Just $ ItMode 0 , _itScrollUp = incMode , _itScrollDown = incMode , _itInvDisplay = displayAutoGun } autoFireMode = shootWithSound (fromIntegral autoGunSound) . withRecoil 40 . torqueBefore 0.05 . withRandomDir (autogunSpread/2) . withMuzFlare . withVelWthHiteff (50,0) 3 $ threeEff' bulHitCr' bulHitWall' bulHitFF' singleFireMode = shootWithSound (fromIntegral autoGunSound) . withRecoil 40 . torqueAfter 0.03 . withRandomDir (autogunSpread/2) . withMuzFlare . withVelWthHiteff (50,0) 3 $ threeEff' bulHitCr' bulHitWall' bulHitFF' incMode :: Int -> World -> World incMode _ w = case newMode of 0 -> w & creatures . ix 0 . crInv . ix itRef . itAttachment . _Just . itMode .~ 0 & creatures . ix 0 . crInv . ix itRef . itHammer .~ NoHammer & creatures . ix 0 . crInv . ix itRef . itEffect .~ NoItEffect & creatures . ix 0 . crInv . ix itRef . wpFire .~ autoFireMode 1 -> w & creatures . ix 0 . crInv . ix itRef . itAttachment . _Just . itMode .~ 1 & creatures . ix 0 . crInv . ix itRef . itHammer .~ HammerUp & creatures . ix 0 . crInv . ix itRef . itEffect .~ wpRecock & creatures . ix 0 . crInv . ix itRef . wpFire .~ singleFireMode where itRef = fromMaybe (-2) $ w ^? creatures . ix 0 . crInvSel oldMode = w ^? creatures . ix 0 . crInv . ix itRef . itAttachment . _Just . itMode newMode = fromMaybe 1 $ fmap f oldMode f x = mod (x+1) 2 decMode :: Int -> World -> World decMode _ w = w & creatures . ix 0 . crInv . ix itRef . itAttachment . _Just . itMode %~ f & creatures . ix 0 . crInv . ix itRef . itName .~ "AUTOGUN" ++ g newMode where itRef = fromMaybe (-2) $ w ^? creatures . ix 0 . crInvSel oldMode = w ^? creatures . ix 0 . crInv . ix itRef . itAttachment . _Just . itMode newMode = fromMaybe 1 $ fmap f oldMode f x = mod (x-1) 2 g 1 = "-S" g 2 = "-B" g 0 = "-A" rezGun = defaultGun { _itName = "REANIMATOR" , _wpMaxAmmo = 50 , _wpLoadedAmmo = 50 , _wpReloadTime = 80 , _wpReloadState = 0 , _wpFireRate = 0 , _wpFireState = 0 , _wpFire = shoot aTeslaArc , _wpSpread = 0.001 , _wpRange = 20 , _itFloorPict = onLayer FlItLayer $ color chartreuse $ pictures [polygon $ rectNESW 7 3 1 (-3) ,polygon $ rectNESW (-1) 3 (-7) (-3) ] , _itAmount = 1 , _itMaxStack = 1 , _itAimingSpeed = 0.4 , _itAimingRange = 0 , _itEquipPict = drawWeapon $ color chartreuse $ pictures [polygon $ rectNESW 7 3 1 (-3) ,polygon $ rectNESW (-1) 3 (-7) (-3) ] } teslaGun = defaultAutoGun { _itName = "TESLA" , _itIdentity = TeslaGun , _wpMaxAmmo = 200 , _wpLoadedAmmo = 200 , _wpReloadTime = 80 , _wpReloadState = 0 , _wpFireRate = 0 , _wpFireState = 0 , _wpFire = shoot aTeslaArc , _wpSpread = 0.001 , _wpRange = 20 , _itFloorPict = onLayer FlItLayer $ color blue $ pictures [polygon $ rectNESW 7 3 1 (-3) ,polygon $ rectNESW (-1) 3 (-7) (-3) ] , _itAmount = 1 , _itMaxStack = 1 , _itAimingSpeed = 0.4 , _itZoom = basicItZoom , _itAimingRange = 0 , _itEquipPict = drawWeapon $ color blue $ pictures [polygon $ rectNESW 7 3 1 (-3) ,polygon $ rectNESW (-1) 3 (-7) (-3) ] } lasGun = defaultAutoGun { _itName = "LASGUN ////" , _itIdentity = LasGun , _wpMaxAmmo = 200 , _wpLoadedAmmo = 200 , _wpReloadTime = 80 , _wpReloadState = 0 , _wpFireRate = 0 , _wpFireState = 0 , _wpFire = shoot aLaser , _wpSpread = 0.001 , _wpRange = 20 , _itFloorPict = onLayer FlItLayer $ color blue $ polygon $ rectNESW 3 3 (-3) (-3) , _itAmount = 1 , _itMaxStack = 1 , _itAimingSpeed = 0.4 , _itAimingRange = 1 , _itEquipPict = drawWeapon $ color blue $ polygon $ rectNESW 3 3 (-3) (-3) , _itAttachment = Just $ ItPhaseV 1 , _itScrollUp = incPhaseV , _itScrollDown = decPhaseV , _itInvDisplay = displayLasGun } incPhaseV :: Int -> World -> World incPhaseV _ w = w & creatures . ix 0 . crInv . ix itRef . itAttachment . _Just . itPhaseV %~ f where itRef = fromMaybe (-2) $ w ^? creatures . ix 0 . crInvSel oldPhaseV = w ^? creatures . ix 0 . crInv . ix itRef . itAttachment . _Just . itPhaseV newPhaseV = fromMaybe 1 $ fmap f oldPhaseV f 0.2 = 1 --f 0.5 = 1 f 1 = 5 --f 2 = 5 f 5 = 5 decPhaseV :: Int -> World -> World decPhaseV _ w = w & creatures . ix 0 . crInv . ix itRef . itAttachment . _Just . itPhaseV %~ f where itRef = fromMaybe (-2) $ w ^? creatures . ix 0 . crInvSel oldPhaseV = w ^? creatures . ix 0 . crInv . ix itRef . itAttachment . _Just . itPhaseV newPhaseV = fromMaybe 1 $ fmap f oldPhaseV f 0.2 = 0.2 --f 0.5 = 0.2 f 1 = 0.2 --f 2 = 1 f 5 = 1 forceFieldGun = defaultGun { _itName = "FORCEFIELD" , _itIdentity = ForceFieldGun , _wpMaxAmmo = 100 , _wpLoadedAmmo = 100 , _wpReloadTime = 40 , _wpReloadState = 0 , _wpFireRate = 10 , _wpFireState = 0 , _wpFire = forceFieldFire , _wpSpread = 0.02 , _wpRange = 20 , _itFloorPict = onLayer FlItLayer $ polygon [(-4,-4),(-4,4),(4,4),(4,0),(0,0),(0,-4)] , _itAmount = 1 , _itMaxStack = 1 , _itAimingSpeed = 0.4 , _itAimingRange = 0.5 } -- grapGun = defaultGun -- { _itName = "grapGun" -- , _itIdentity = GrapGun -- , _wpMaxAmmo = 1 -- , _wpLoadedAmmo = 1 -- , _wpReloadTime = 40 -- , _wpReloadState = 0 -- , _wpFireRate = 10 -- , _wpFireState = 0 -- , _wpFire = grapFire -- , _wpSpread = 0.002 -- , _wpRange = 20 -- , _wpIsAuto = False -- , _itFloorPict = onLayer FlItLayer $ polygon [(-4,-4),(-4,4),(4,4),(4,0),(0,0),(0,-4)] -- , _itAmount = 1 -- , _itMaxStack = 1 -- , _itAimingSpeed = 1 -- , _itAimingRange = 0.5 -- } tractorGun = defaultAutoGun { _itName = "TRACTORGUN" , _itIdentity = TractorGun , _wpMaxAmmo = 10000 , _wpLoadedAmmo = 10000 , _wpReloadTime = 40 , _wpReloadState = 0 , _wpFireRate = 0 , _wpFireState = 0 , _wpFire = shoot $ aTractorBeam 0 , _wpSpread = 0.00001 , _wpRange = 20 , _itFloorPict = onLayer FlItLayer $ color blue $ pictures [polygon $ rectNESW 1.5 6 (-1.5) 0 ] , _itAmount = 1 , _itMaxStack = 1 , _itAimingSpeed = 0.4 , _itAimingRange = 0.5 , _itEquipPict = drawWeapon $ color blue $ pictures [polygon $ rectNESW 1.5 6 (-1.5) 0 ] } launcher = defaultGun { _itName = "ROCKO" , _itIdentity = Launcher , _wpMaxAmmo = 30 , _wpLoadedAmmo = 30 , _wpReloadTime = 80 , _wpReloadState = 0 , _wpFireRate = 20 , _wpFireState = 0 , _wpFire = shoot $ aRocket , _wpSpread = 0.02 , _wpRange = 20 , _itFloorPict = onLayer FlItLayer $ color cyan $ polygon $ rectNESW 5 5 (-5) (-5) , _itAmount = 1 , _itMaxStack = 1 , _itAimingSpeed = 0.2 , _itAimingRange = 0.5 , _itEquipPict = drawWeapon $ color cyan $ polygon $ rectNESW 5 5 (-5) (-5) , _itHammer = NoHammer , _itEffect = NoItEffect } bezierGun = defaultAutoGun { _itName = "B-GUN" , _wpFire = maybeSetTarget shootBezier , _itAttachment = Nothing , _itScrollUp = removeItAttachment 0 , _itScrollDown = removeItAttachment 0 , _itHammer = HammerUp , _itEffect = bezierRecock , _itZoom = basicItZoom , _itAimingRange = 0 } maybeSetTarget :: (Point2 -> Int -> World -> World) -> Int -> World -> World maybeSetTarget f cid w = case join $ w ^? creatures . ix cid . crInv . ix itRef . itAttachment of Just (ItTargetPos targetp) -> f targetp cid w _ -> w & creatures . ix cid . crInv . ix itRef . itAttachment .~ Just (ItTargetPos mp) where mp = mouseWorldPos w cr = _creatures w IM.! cid itRef = _crInvSel cr shootBezier :: Point2 -> Int -> World -> World shootBezier targetp cid w = (shootWithSound 0 . withMuzFlare . withRecoil 40 . torqueBefore 0.05 ) bezBul cid w where -- note that torqueBefore will not affect the startp here bezBul = mkBezierBul startp controlp targetp controlp = mouseWorldPos w cr = _creatures w IM.! cid dir = _crDir cr startp = _crPos cr +.+ rotateV dir (_crRad cr + 1,0) mkBezierBul :: Point2 -> Point2 -> Point2 -> Int -> World -> World mkBezierBul startp controlp targetp cid w = over particles' (bbul :) w where bbul = aCurveBulAt (Just cid) white startp (controlp +.+ randPos) (targetp +.+ randPos') (threeEff' bulHitCr' bulHitWall' bulHitFF') 5 (randPos,randPos') = flip evalState (_randGen w) $ do a <- randInCirc 10 b <- randInCirc 20 return (a,b) removeItAttachment :: Int -> Int -> World -> World removeItAttachment i _ w = w & creatures . ix i . crInv . ix itRef . itAttachment .~ Nothing where cr = _creatures w IM.! i itRef = _crInvSel cr remoteLauncher = defaultGun { _itName = "ROCKO-REM" , _itIdentity = RemoteLauncher , _wpMaxAmmo = 1 , _wpLoadedAmmo = 1 , _wpReloadTime = 80 , _wpReloadState = 0 , _wpFireRate = 10 , _wpFireState = 0 , _wpFire = fireRemoteLauncher , _wpSpread = 0.02 , _wpRange = 20 , _itFloorPict = onLayer FlItLayer $ color cyan $ polygon $ rectNESW 5 5 (-5) (-5) , _itAmount = 1 , _itMaxStack = 1 , _itAimingSpeed = 0.2 , _itAimingRange = 0.5 , _itEquipPict = drawWeapon $ color cyan $ polygon $ rectNESW 5 5 (-5) (-5) , _itAttachment = Just $ ItScope (0,0) 0 1 True } hvAutoGun = defaultAutoGun { _itName = "AUTO-HV" , _itIdentity = HvAutoGun , _wpMaxAmmo = 100 , _wpLoadedAmmo = 100 , _wpReloadTime = 200 , _wpReloadState = 0 , _wpFireRate = 25 , _wpFireState = 0 , _wpFire = rateIncAB 24 10 (torqueBeforeForced 0.1 mkHvBul) $torqueAfter 0.2 mkHvBul , _wpSpread = autogunSpread , _wpRange = 20 , _itFloorPict = onLayer FlItLayer $ color orange $ polygon $ rectNESW 5 5 (-5) (-5) , _itAmount = 1 , _itMaxStack = 1 , _itAimingSpeed = 0.2 , _itAimingRange = 1 , _itEquipPict = drawWeapon $ color orange $ polygon $ rectNESW 5 5 (-5) (-5) } where mkHvBul = withSound (fromIntegral longGunSound) . withThinSmoke . withMuzFlare . withVelWthHiteff (80,0) 6 $ threeEff' hvBulHitCr' hvBulHitWall' bulHitFF' ltAutoGun = defaultAutoGun { _itName = "AUTO-LT" , _itIdentity = LtAutoGun , _wpMaxAmmo = 25 , _wpLoadedAmmo = 25 , _wpReloadTime = 80 , _wpReloadState = 0 , _wpFireRate = 4 , _wpFireState = 0 , _wpFire = shootWithSound 0 . withRandomDir 0.3 . withMuzFlare $ withVelWthHiteff (30,0) 2 bulletEffect' , _wpSpread = 0.5 , _wpRange = 20 , _itFloorPict = onLayer FlItLayer $ color green $ pictures [polygon $ rectNSWE 4 (-4) (-4) 0 ,circleSolid 4 ] , _itAmount = 1 , _itMaxStack = 1 , _itAimingSpeed = 1 , _itAimingRange = 0 , _itZoom = basicItZoom , _itEquipPict = drawWeapon $ color green $ pictures [polygon $ rectNSWE 4 (-4) (-4) 0 ,circleSolid 4 ] } miniGun = defaultAutoGun { _itName = "MINI-G" , _itIdentity = MiniGun , _wpMaxAmmo = 150 , _wpLoadedAmmo = 150 , _wpReloadTime = 200 , _wpReloadState = 0 , _wpFireRate = 2 , _wpFireState = 0 , _wpFire = withWarmUp 50 . torqueBefore 0.03 . withSidePush 50 . withRecoil 15 . withRandomDir 0.1 . withRandomOffset 9 . withMuzFlare $ withVelWthHiteff (30,0) 2 bulletEffect' , _wpSpread = autogunSpread , _wpRange = 20 , _itFloorPict = onLayer FlItLayer $ color red $ polygon $ rectNESW 9 5 (-9) (-5) , _itAmount = 1 , _itMaxStack = 1 , _itAimingSpeed = 0.4 , _itAimingRange = 1 , _itEquipPict = drawWeapon $ color red $ polygon $ rectNESW 9 5 (-9) (-5) } spreadGun = defaultGun { _itName = "SPREAD" , _itIdentity = SpreadGun , _wpMaxAmmo = 5 , _wpLoadedAmmo = 5 , _wpReloadTime = 80 , _wpReloadState = 0 , _wpFireRate = 20 , _wpFireState = 0 , _wpFire = shootWithSound (fromIntegral shotgunSound) . withRecoil 100 . withMuzFlare $ spreadNumVelWthHiteff spreadGunSpread 9 (30,0) 2 bulletEffect' , _wpSpread = spreadGunSpread , _wpRange = 20 , _itFloorPict = onLayer FlItLayer $ color green $ pictures [ polygon [(-3,0),(3,6),(3,-6)] ] , _itAmount = 1 , _itMaxStack = 1 , _itAimingSpeed = 1 , _itAimingRange = 0 , _itEquipPict = drawWeapon $ color green $ pictures [ polygon [(-3,0),(3,6),(3,-6)] ] } -- shatterGun = defaultGun -- { _itName = "shatterGun" -- , _itIdentity = ShatterGun -- , _wpMaxAmmo = 50 -- , _wpLoadedAmmo = 50 -- , _wpReloadTime = 80 -- , _wpReloadState = 0 -- , _wpFireRate = 40 -- , _wpFireState = 0 -- , _wpFire = shatterGunFire -- , _wpSpread = 3.14 -- , _wpRange = 20 -- , _wpIsAuto = False -- , _itFloorPict = polygon [(-4,-4),(-4,4),(4,4),(4,0),(0,0),(0,-4)] -- , _itAmount = 1 -- , _itMaxStack = 1 -- , _itAimingSpeed = 1 -- , _itAimingRange = 0.5 -- } multGun = defaultGun { _itName = "MULTGUN" , _itIdentity = MultGun , _wpMaxAmmo = 2 , _wpLoadedAmmo = 2 , _wpReloadTime = 40 , _wpReloadState = 0 , _wpFireRate = 20 , _wpFireState = 0 , _wpFire = shootWithSound (fromIntegral shotgunSound) . withRecoil 200 . withMuzFlare $ numVelWthHitEff 5 (50,0) 4 bulletEffect' , _wpSpread = spreadGunSpread , _wpRange = 20 , _itFloorPict = onLayer FlItLayer $ multGunPic , _itAmount = 1 , _itMaxStack = 1 , _itAimingSpeed = 0.4 , _itAimingRange = 1 , _itZoom = basicItZoom {_itAimZoomFac = 1.5} , _itEquipPict = drawWeapon $ multGunPic } where multGunPic = color red $ pictures [ polygon $ rectNSEW 12 8 2 (-2) , polygon $ rectNSEW 7 3 2 (-2) , polygon $ rectNSEW 2 (-2) 2 (-2) , polygon $ rectNSEW (-3) (-7) 2 (-2) , polygon $ rectNSEW (-8) (-12) 2 (-2) , polygon [(-1.5,12),(-2,12),(-2,-12),(-1.5,-12)] ] longGun = defaultGun { _itName = "LONGGUN" , _itIdentity = LongGun , _wpMaxAmmo = 1 , _wpLoadedAmmo = 1 , _wpReloadTime = 80 , _wpReloadState = 0 , _wpFireRate = 100 , _wpFireState = 0 , _wpFire = shootWithSound (fromIntegral longGunSound) . withThickSmoke . torqueAfter 0.05 . withMuzFlare . withVelWthHiteff (60,0) 6 $ threeEff' hvBulHitCr' hvBulHitWall' bulHitFF' , _wpSpread = 0.0 , _wpRange = 200 , _itFloorPict = onLayer FlItLayer $ pictures [color orange $ polygon $ rectNESW 3 6 (-3) (-6) ] , _itAmount = 1 , _itMaxStack = 1 , _itAimingSpeed = 0.2 , _itAimingRange = 1 , _itZoom = basicItZoom {_itAimZoomMax = 0.5, _itAimZoomMin = 0.5} , _itEquipPict = drawWeapon $ pictures [color orange $ polygon $ rectNESW 3 6 (-3) (-6) ] , _itScrollUp = startZoomInLongGun , _itScrollDown = startZoomOutLongGun , _itAttachment = Just $ ItScope (0,0) 0 1 False , _itEffect = itemLaserScopeEffect } startZoomInLongGun :: Int -> World -> World startZoomInLongGun _ w = w & creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0)) . itAttachment . _Just . scopeZoomChange %~ \x -> max 5 (x + 5) startZoomOutLongGun :: Int -> World -> World startZoomOutLongGun _ w = w & creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0)) . itAttachment . _Just . scopeZoomChange %~ \x -> min (-5) (x-5) -- (\x -> - 10) poisonSprayer = defaultAutoGun { _itName = "POISON" , _itIdentity = PoisonSprayer , _wpMaxAmmo = 500 , _wpLoadedAmmo = 500 , _wpReloadTime = 100 , _wpReloadState = 0 , _wpFireRate = 0 , _wpFireState = 0 , _wpFire = shoot $ aGasCloud , _wpSpread = flamerAngle , _wpRange = 8 , _itFloorPict = onLayer FlItLayer $ color yellow $ polygon $ rectNESW 4 4 (-4) (-4) , _itAmount = 1 , _itMaxStack = 1 , _itAimingSpeed = 0.2 , _itAimingRange = 0 , _itZoom = basicItZoom , _itEquipPict = drawWeapon $ color yellow $ polygon $ rectNESW 4 4 (-4) (-4) } flamer = defaultAutoGun { _itName = "FLAMER" , _itIdentity = Flamethrower , _wpMaxAmmo = 250 , _wpLoadedAmmo = 250 , _wpReloadTime = 100 , _wpReloadState = 0 , _wpFireRate = 0 , _wpFireState = 0 , _wpFire = shoot $ aFlame 0 , _wpSpread = flamerAngle , _wpRange = 8 , _itFloorPict = onLayer FlItLayer $ color yellow $ polygon $ rectNESW 4 4 (-4) (-4) , _itAmount = 1 , _itMaxStack = 1 , _itAimingSpeed = 0.5 -- , _itAimingSpeed = 1 -- , _itAimingSpeed = 0.2 , _itAimingRange = 0 , _itZoom = basicItZoom {_itAimZoomMax = 5, _itAimZoomMin = 1.5} , _itEquipPict = drawWeapon $ color yellow $ polygon $ rectNESW 4 4 (-4) (-4) , _itAttachment = Nothing } blinkGun = defaultGun { _itName = "BLINKER" , _itIdentity = Blinker , _wpMaxAmmo = 100 , _wpLoadedAmmo = 100 , _wpReloadTime = 20 , _wpReloadState = 0 , _wpFireRate = 0 , _wpFireState = 0 , _wpFire = shoot aSelf , _wpSpread = 0.05 , _wpRange = 20 , _itFloorPict = onLayer FlItLayer $ polygon [(-2,-2),(-2,2),(2,2),(2,0),(0,0),(0,-2)] , _itAmount = 1 , _itMaxStack = 1 , _itAimingSpeed = 1 , _itAimingRange = 0 } aTeslaArc :: Int -> World -> World aTeslaArc cid w = aTeslaArc' cid $ soundFrom (CrWeaponSound cid) 25 1 0 w aTeslaArc' :: Int -> World -> World aTeslaArc' cid w = flareAt' cyan 0.03 0.1 (pos +.+ 5 *.* unitVectorAtAngle dir) $ over particles (IM.insert i (makeTeslaArcAt i pos dir)) $ set randGen g w where cr = (_creatures w IM.! cid) i = newParticleKey w pos = _crPos cr +.+ ((_crRad cr +1) *.* unitVectorAtAngle dir) +.+ sideOffset *.* vNormal (unitVectorAtAngle dir) (sideOffset,g) = randomR (-5,5) $ _randGen w dir = _crDir cr aLaser :: Int -> World -> World aLaser cid w = over particles' ( (:) (makeLaserAt phaseV pos dir (Just cid))) $ soundFrom LasSound 24 1 0 $ flareAt' yellow 0.02 0.05 (pos +.+ 5 *.* unitVectorAtAngle dir) w where cr = (_creatures w IM.! cid) i = newParticleKey w pos = _crPos cr +.+ ((_crRad cr +3) *.* unitVectorAtAngle dir) dir = _crDir cr phaseV = fromMaybe 1 $ cr ^? crInv . ix j . itAttachment . _Just . itPhaseV j = _crInvSel cr aTractorBeam :: Int -> Int -> World -> World aTractorBeam col cid w = set (creatures . ix cid . crInv . ix itRef . wpFire) (shoot $ aTractorBeam ((col + 1) `mod` 10)) $ over particles (IM.insert i (tractorBeamAt col i pos dir)) w where i = newParticleKey w cr = (_creatures w IM.! cid) pos = _crPos cr +.+ ((_crRad cr +10) *.* unitVectorAtAngle dir) dir = _crDir cr itRef = _crInvSel cr aRocket :: Int -> World -> World aRocket cid w = soundOnce (fromIntegral launcherSound) $ over particles (IM.insert i (makeShellAt i cid pos dir)) w where i = newParticleKey w cr = (_creatures w IM.! cid) pos = _crPos cr +.+ ((_crRad cr +1) *.* unitVectorAtAngle dir) dir = _crDir cr makeShellAt :: Int -> Int -> Point2 -> Float -> Particle makeShellAt i cid pos dir = Particle { _ptPos = pos , _ptStartPos = pos , _ptVel = rotateV dir (1,0) , _ptPict = blank -- onLayer PtLayer $ uncurry translate pos $ rotate (radToDeg dir) shellPic , _ptID = i , _ptUpdate = moveShell 50 i cid 0 (rotateV dir (2,0)) } moveShell :: Int -> Int -> Int -> Float -> Point2 -> World -> World moveShell time i cid rot accel w | time > 40 = if circOnSomeWall oldPos 4 w then shellExplosionAt oldPos $ over particles (IM.delete i) w else over (particles . ix i . ptPos) (+.+ vel) $ set (particles . ix i . ptPict) piclow $ set (particles . ix i . ptUpdate) (moveShell (time-1) i cid rot (rotateV rot accel)) w | time == 35 = case thingHit of Just p -> shellExplosionAt oldPos $ over particles (IM.delete i) w Nothing -> over (particles . ix i . ptPos) (+.+ vel) $ set (particles . ix i . ptPict) pic $ set (particles . ix i . ptUpdate) (moveShell (time-1) i cid spin accel) w | time >= 20 = case thingHit of Just p -> shellExplosionAt oldPos $ over particles (IM.delete i) w Nothing -> over (particles . ix i . ptPos) (+.+ vel) $ set (particles . ix i . ptPict) pic $ set (particles . ix i . ptUpdate) (moveShell (time-1) i cid rot (rotateV rot accel)) w | time > -99 = case thingHit of Just p -> shellExplosionAt oldPos $ stopSoundFrom (ShellSound i) $ over particles (IM.delete i) w Nothing -> over (particles . ix i . ptPos) (+.+ vel) $ set randGen g $ set (particles . ix i . ptPict) pic $ set (particles . ix i . ptUpdate) (moveShell (time-1) i cid rot (rotateV rot accel)) $ over (particles . ix i . ptVel) (\v -> accel +.+ frict *.* v) $ soundFrom (ShellSound i) (fromIntegral smokeTrailSound) (1) 250 $ makeFlameletTimed oldPos (0.5 *.* rotateV (pi+sparkD) accel) (levLayer UPtLayer) Nothing 3 20 $ makeFlameletTimed (0.5 *.* (newPos +.+ oldPos)) (0.5 *.* rotateV (pi+sparkD) accel) (levLayer UPtLayer) Nothing 3 20 $ smokeGen w | time > -200 = case thingHit of Just p -> shellExplosionAt oldPos $ stopSoundFrom (ShellSound i) $ over particles (IM.delete i) w Nothing -> over (particles . ix i . ptPos) (+.+ vel) $ set (particles . ix i . ptPict) pic $ set (particles . ix i . ptUpdate) (moveShell (time-1) i cid rot (rotateV rot accel)) w | otherwise = shellExplosionAt oldPos $ stopSoundFrom (ShellSound i) $ over particles (IM.delete i) w where pt = _particles w IM.! i oldPos = _ptPos pt vel = _ptVel pt newPos = oldPos +.+ vel (frict,g) = randomR (0.6,0.9) $ _randGen w (sparkD,_) = randomR (-0.5,0.5) $ _randGen w dir = argV $ vel pic = onLayer PtLayer $ uncurry translate newPos $ rotate (argV accel) shellPic piclow = onLayerL [levLayer CrLayer - 2] $ uncurry translate newPos $ rotate (argV accel) shellPic hitCr = fmap fst $ collideCircCrsPoint oldPos newPos 4 w hitWl = fmap fst $ collideCircWalls' oldPos newPos 2 $ wallsNearPoint newPos w thingHit = hitCr <|> hitWl spin = case w ^? creatures . ix cid of Just cr -> min 0.1 $ max (-0.1) $ (normalizeAnglePi (dir - _crDir cr)) / 20 _ -> 0 (v1:v2:v3:_) = fst $ runState ((sequence . repeat . randInCirc) 0.1) $ _randGen w (r1:r2:r3:_) = map ((*.*) 100) (v2:v3:v1:[]) (t1:t2:t3:_) = randomRs ( 15,20) $ _randGen w (s1:s2:s3:_) = map (\s -> fromIntegral s * 0.1 - 1) (t3:t2:t1:[]) -- ((r1:r2:r3:_),_) = runState ((sequence . repeat . randInCirc) 10) $ _randGen w -- v1 = fst $ runState (randInCirc 0.5) $ _randGen w smokeGen = makeSmokeAt'' v1 s1 t1 (newPos +.+ r1) . makeSmokeAt'' v2 s2 t2 (newPos +.+ r2) -- . makeSmokeAt'' v3 s3 t3 (newPos +.+ r3) normalizeAnglePi angle | normalizeAngle angle > pi = normalizeAngle angle - 2*pi | otherwise = normalizeAngle angle shellPic = color black $ polygon [(-6,4),(-6,-4),(6,-4),(8,0),(6,4)] remoteShellPic :: Int -> Picture remoteShellPic i | rem (i+200) 20 < 9 = polygon [(-6,4),(-6,-4),(6,-4),(8,0),(6,4)] | otherwise = pictures [ polygon [(-6,4),(-6,-4),(6,-4),(8,0),(6,4)] , color col $ circleSolid 3 ] where col | i > (-99) = green | otherwise = red shellExplosionAt = makeExplosionAt tractorBeamAt :: Int -> Int -> Point2 -> Float -> Particle tractorBeamAt colID i pos dir = Particle { _ptPos = pos , _ptStartPos = p' , _ptVel = d , _ptPict = blank , _ptID = i , _ptUpdate = updateTractor colID 10 i } where d = unitVectorAtAngle dir p' = pos +.+ 400 *.* d aGasCloud :: Int -> World -> World aGasCloud cid w = -- soundFrom Flame fireSound 2 500 insertCloud $ set randGen g $ w where (a,g) = randomR (-0.1,0.1) (_randGen w) cr = (_creatures w IM.! cid) dir = _crDir cr + a pos = _crPos cr +.+ ((_crRad cr + 2.9) *.* unitVectorAtAngle (_crDir cr)) pos2 = (0.5 *.* vel) +.+ _crPos cr +.+ ((_crRad cr + 2.9) *.* unitVectorAtAngle (_crDir cr)) vel = (_crPos cr -.- _crOldPos cr) +.+ 4 *.* unitVectorAtAngle dir insertCloud = makeGasCloud pos vel -- . makeFlame pos2 vel (Just cid) makeGasCloud :: Point2 -> Point2 -> World -> World makeGasCloud pos vel w = over clouds (IM.insert i theCloud) $ set randGen g w where i = newKey $ _clouds w theCloud = Cloud { _clID = i , _clPos = pos , _clVel = vel , _clPict = \_ -> onLayer CrLayer $ color (withAlpha 0.1 col) $ circleSolid 20 , _clRad = 20 , _clTimer = 200 , _clEffect = cloudPoisonDamage } (col, g) = runState (takeOne [green,yellow]) $ _randGen w cloudPoisonDamage :: Cloud -> World -> World cloudPoisonDamage c w = w & creatures %~ flip (foldr (IM.adjust doDam)) damagedCrs where damagedCrs = IM.keys $ IM.filter f $ creaturesNearPoint (_clPos c) w f cr = dist (_crPos cr) (_clPos c) < _crRad cr + _clRad c doDam cr = cr & crState . crDamage %~ (:) (PoisonDam 1) aFlame :: Float -> Int -> World -> World aFlame a cid w = shakeCr cid 2 $ soundFrom Flame fireSound 2 500 $ insertFlame $ resetAngle $ set randGen g $ w where (a2,g) = randomR (-0.1,0.1) (_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)) pos2 = (0.5 *.* vel) +.+ _crPos cr +.+ ((_crRad cr + 2.9) *.* unitVectorAtAngle (_crDir cr)) w1 = set randGen g w i = newParticleKey w1 -- vel = (_crPos cr -.- _crOldPos cr) +.+ 4 *.* unitVectorAtAngle dir vel = (_crPos cr -.- _crOldPos cr) +.+ 4 *.* unitVectorAtAngle dir insertFlame = makeFlame pos vel (Just cid) -- . makeFlame pos2 vel (Just cid) resetAngle = set (creatures . ix cid . crInv . ix (_crInvSel cr) . wpFire) (shoot $ aFlame angle) makeFlame :: Point2 -> Point2 -> Maybe Int -> World -> World makeFlame pos vel maycid = over particles' ((:) theFlame) where theFlame = Pt' { _ptPict' = blank , _ptUpdate' = moveFlame vel , _btVel' = vel , _btColor' = red , _btPos' = pos , _btPassThrough' = maycid , _btWidth' = 4 , _btTimer' = 100 , _btHitEffect' = threeEff' (doFlameDam 1) noEff noEff } moveFlame :: Point2 -> World -> Particle' -> (World, Maybe Particle') moveFlame rotd w pt = case _btTimer' pt of time | time <= 0 -> (smokeGen w, Nothing) | otherwise -> case thingsHitExceptCr (_btPassThrough' pt) sp ep w of -- ((p,(E3x1 cr)):_) -> (damcr cr p $ smokeGen damcrs, Nothing) ((p,(E3x1 cr)):_) -> (soundFrom Flame fireSound 2 500 $ over worldEvents ((.) $ flameGlareAt ep) damcrs , mvPt') (thing@(p,(E3x2 wl)):_) -> (fst $ hiteff [thing] damcrs, rfl wl p) _ -> (soundFrom Flame fireSound 2 500 -- adding reflective glare is too intensive for this laptop $ over worldEvents ((.) $ flameGlareAt ep) damcrs , mvPt) where sp = _btPos' pt vel = _btVel' pt ep = sp +.+ vel mvPt = Just $ pt {_btTimer' = time - 1, _btPos' = ep, _ptPict' = thepic ep , _btPassThrough' = Nothing ,_btVel' = 0.98 *.* vel} mvPt' = Just $ pt {_btTimer' = time - 1, _btPos' = ep, _ptPict' = thepic ep , _btPassThrough' = Nothing ,_btVel' = 0.7 *.* vel} damcrs = foldr ($) w $ map (\cr -> fst . hiteff [(ep,E3x1 cr)]) $ filter closeCrs $ IM.elems $ _creatures w closeCrs cr = dist ep (_crPos cr) < _crRad cr + 10 - min 9 (max 0 (fromIntegral time - 80)) + 5 * angleCoeff (angleVV (ep -.- _crPos cr) rotd) angleCoeff x = abs $ 1 - (abs $ (x * 2 - pi) / (pi)) damcr cr p = over (creatures . ix (_crID cr) . crState . crDamage) ((:) $ Flaming (div time 10) sp p ep) hiteff = _btHitEffect' pt pt thepic p' = pictures $ reverse [ pic p' , piu p' , pi2 p' , glow p' ] pic p' = setLayer 1 $ onLayerL [levLayer UPtLayer,6] $ uncurry translate (prot3 p') $ rotate (pi * 0.5 + argV rotd) $ scale scaleChange 1 -- $ color white -- $ circleSolid 5 $ pictures $ reverse [color white $ circleSolid 4 ,color (withAlpha 0.5 white) $ circleSolid 5 ] -- $ rotate (radToDeg (fromIntegral time * 10)) -- $ polygon [(-5,-2),(5,-2),(5,2),(-5,2)] pi2 p' = setLayer 1 $ onLayerL [levLayer UPtLayer,4] $ uncurry translate (prot p') -- $ rotate ( (fromIntegral time * 5)) $ rotate (pi * 0.5 + argV rotd) -- $ color (mixColors 0.5 0.5 orange white) -- $ polygon [(-6,-6),(6,-6),(6,6),(-6,6)] $ scale (scaleChange + 0.5) 1.5 $ pictures $ reverse [color orange $ circleSolid 4.5 ,color (withAlpha 0.5 orange) $ circleSolid 5 ] -- $ color orange -- $ circleSolid 5 prot p' = p' +.+ rotateV (fromIntegral time * 1) (0,1) prot2 p' = p' +.+ rotateV (negate $ fromIntegral time * 1) (0,1) prot3 p' = p' +.+ rotateV (2 + fromIntegral time * 0.1) (0,2) piu p' = setLayer 1 $ onLayerL [levLayer UPtLayer,2] $ uncurry translate (prot2 p') $ rotate (pi*0.5 + argV rotd) -- $ rotate ((fromIntegral time * (-10))) $ scale (scaleChange + 1) 2 $ pictures $ reverse [color red $ circleSolid 4.5 ,color (withAlpha 0.5 red) $ circleSolid 5 ] -- $ color (dark red) -- $ circleSolid 5 -- $ polygon [(-8,-8),(8,-8),(8,8),(-8,8) ] rfl wl p = Just $ pt {_btTimer' = time -1, _btPos' = pOut p , _btVel' = reflV wl, _ptPict' = thepic $ pOut p } glow p' = setLayer 1 $ onLayerL [levLayer UPtLayer,0] $ uncurry translate p' $ circleSolidCol (withAlpha 0 orange) (withAlpha 0.02 orange) -- (withAlpha 0 orange) 50 50 pOut p = p +.+ safeNormalizeV (sp -.- p) reflV wall = (0.3 *.* reflectIn (_wlLine wall !! 1 -.- _wlLine wall !! 0) vel ) +.+ (0.2 *.* vel) scaleChange | time < 80 = 3 | otherwise = 3 - (fromIntegral time - 80) * 0.2 g = _randGen w tms = randomRs (15,20) g scs = randomRs (0.1,0.5) g (rs,g1) = runState ((sequence . take 5 . repeat . randInCirc) 20) $ _randGen w f sc tm r = makeColorSmokeAt (greyN 0.3) (0.5 *.* vel) sc tm (ep +.+ r) smokeGen w = set randGen g1 $ foldr ($) w (zipWith3 f scs tms rs) flamerAngle = 0.3 aSelf :: Int -> World -> World aSelf = blinkAction reflect :: Float -> Float -> Float reflect a b = a + 2*(a-b) moveGrenade :: Int -> Float -> Int -> World -> World moveGrenade 0 dir pID w = over particles (IM.delete pID) $ makeExplosionAt (_ptPos (_particles w IM.! pID)) -- $ set (pointToItem (_itemPositions w IM.! wpID) . itEquipPict) -- (drawWeapon $ grenadePic 50) w moveGrenade time dir pID w = case hitWl of Just _ -> soundOnce (fromIntegral tapQuiet) updatedWorld _ -> updatedWorld where updatedWorld = updateV $ set (particles . ix pID . ptPos) finalPos $ set (particles.ix pID.ptPict) (onLayer PtLayer $ uncurry translate newPos $ rotate dir $ grenadePic time) $ set (particles.ix pID.ptUpdate) (moveGrenade (time-1) dir pID) w pt = _particles w IM.! pID oldPos = _ptPos pt newPos = _ptVel pt +.+ oldPos hitWl = collideCircWalls' oldPos newPos 4 $ wallsNearPoint newPos w finalPos = fromMaybe newPos (fmap fst hitWl) setV v = set (particles.ix pID.ptVel) v updateV = fromMaybe id (fmap (setV.snd) hitWl) pointToItem (InInv cid invid) = creatures . ix cid . crInv . ix invid pointToItem (OnFloor flid) = floorItems . ix flid . flIt retireRemoteRocket :: Int -> Int -> Int -> World -> World retireRemoteRocket itid 0 ptid w = set (pointToItem (_itemPositions w IM.! itid) . itAttachment . _Just . scopePos) (0,0) $ set (pointToItem (_itemPositions w IM.! itid) . wpFire) fireRemoteLauncher (w & particles %~ IM.delete ptid) retireRemoteRocket itid t ptid w = setScope w & particles . ix ptid . ptUpdate .~ retireRemoteRocket itid (t-1) ptid where setScope w' = case _itemPositions w' IM.! itid of InInv cid invid -> w' & creatures . ix cid . crInv . ix invid . itAttachment . _Just . scopePos .~ (pos -.- _crPos (_creatures w' IM.! cid)) _ -> w' pos = fromMaybe (0,0) $ w ^? particles . ix ptid . ptPos retireRemoteBomb :: Int -> Int -> Int -> World -> World retireRemoteBomb itid 0 ptid w = set (pointToItem (_itemPositions w IM.! itid) . itAttachment . _Just . scopePos) (0,0) $ set (pointToItem (_itemPositions w IM.! itid) . itZoom) basicItZoom $ set (pointToItem (_itemPositions w IM.! itid) . twFire) throwRemoteBomb (w & particles %~ IM.delete ptid) retireRemoteBomb itid t ptid w = setScope w & particles . ix ptid . ptUpdate .~ retireRemoteBomb itid (t-1) ptid where setScope w' = case _itemPositions w' IM.! itid of InInv cid invid -> w' & creatures . ix cid . crInv . ix invid . itAttachment . _Just . scopePos .~ (pos -.- _crPos (_creatures w' IM.! cid)) _ -> w' pos = fromMaybe (0,0) $ w ^? particles . ix ptid . ptPos moveRemoteBomb :: Int -> Int -> Int -> World -> World moveRemoteBomb itid time pID w | time < -4 = setScope $ updatePicture $ set (particles.ix pID.ptUpdate) (moveRemoteBomb itid (f time) pID) w | time < 2 = case hitWl of Just _ -> soundOnce (fromIntegral tapQuiet) $ halfV updatedWorld _ -> halfV updatedWorld | otherwise = case hitWl of Just _ -> soundOnce (fromIntegral tapQuiet) updatedWorld _ -> updatedWorld where updatedWorld = updateV $ set (particles . ix pID . ptPos) finalPos $ updatePicture $ set (particles.ix pID.ptUpdate) (moveRemoteBomb itid (time-1) pID) $ setScope w setScope w' = case _itemPositions w' IM.! itid of InInv cid invid -> w' & creatures . ix cid . crInv . ix invid . itAttachment . _Just . scopePos .~ (newPos -.- _crPos (_creatures w' IM.! cid)) & creatures . ix cid . crInv . ix invid . itZoom .~ (basicItZoom {_itAimZoomMax = 0.5, _itAimZoomMin = 0.5}) _ -> w' pt = _particles w IM.! pID oldPos = _ptPos pt newPos = _ptVel pt +.+ oldPos -- this is hacky, should use a version of collidePointWalls' that collides -- circles and walls invShift x = x -.- 5 *.* normalizeV (_ptVel pt) hitWl = collideCircWalls' oldPos newPos 4 $ wallsNearPoint newPos w finalPos = fromMaybe newPos (fmap (invShift . fst) hitWl) setV v = set (particles.ix pID.ptVel) v updateV = fromMaybe id (fmap (setV.snd) hitWl) halfV = over (particles . ix pID . ptVel) (\v -> 0.5 *.* v) f x | x < -369 = -10 | otherwise = x - 1 updatePicture = set (particles . ix pID.ptPict) (onLayer PtLayer $ uncurry translate newPos $ remoteBombPic time) . lowLightDirected red 0.1 newPos (50 *.* unitVectorAtAngle (negate $ degToRad (10 * fromIntegral time))) [-0.2,-0.15,-0.1,-0.05,0,0.05,0.1,0.15,0.2] shootRateIncrease :: Int -> Int -> (Int -> World -> World) -> Int -> World -> World shootRateIncrease startRate fastRate shootEffect cid w | repeatFire = set (pointItem . wpFireRate) (max fastRate (currentRate - 1)) $ set (pointItem . wpFireState) currentRate $ shootEffect cid w | firstFire = set (pointItem . wpFireRate) (startRate - 1) $ set (pointItem . wpFireState) startRate $ shootEffect cid w | reloadCondition = fromMaybe w $ reloadWeapon cid w | otherwise = w where cr = _creatures w IM.! cid itRef = _crInvSel cr item = _crInv cr IM.! itRef pointItem = (creatures . ix cid . crInv . ix itRef) currentRate = _wpFireRate item repeatFire = _wpReloadState item == 0 && _wpFireState item == 1 && _wpLoadedAmmo item > 0 firstFire = _wpReloadState item == 0 && _wpFireState item == 0 && _wpLoadedAmmo item > 0 reloadCondition = _wpLoadedAmmo item == 0 rateIncAB :: Int -> Int -> (Int -> World -> World) -> (Int -> World -> World) -> Int -> World -> World rateIncAB startRate fastRate shooteff1 shooteff2 cid w | repeatFire = set (pointItem . wpFireRate) (max fastRate (currentRate - 1)) $ over (pointItem . wpLoadedAmmo) (\ammo -> ammo-1) $ set (pointItem . wpFireState) currentRate $ shooteff2 cid w | firstFire = set (pointItem . wpFireRate) (startRate - 1) $ over (pointItem . wpLoadedAmmo) (\ammo -> ammo-1) $ set (pointItem . wpFireState) startRate $ shooteff1 cid w | reloadCondition = fromMaybe w $ reloadWeapon cid w | otherwise = w where cr = _creatures w IM.! cid itRef = _crInvSel cr item = _crInv cr IM.! itRef pointItem = (creatures . ix cid . crInv . ix itRef) currentRate = _wpFireRate item repeatFire = _wpReloadState item == 0 && _wpFireState item == 1 && _wpLoadedAmmo item > 0 firstFire = _wpReloadState item == 0 && _wpFireState item == 0 && _wpLoadedAmmo item > 0 reloadCondition = _wpLoadedAmmo item == 0 withThinSmoke :: (Int -> World -> World) -> Int -> World -> World withThinSmoke eff cid w = eff cid $ foldr ($) w smokeGen where cr = _creatures w IM.! cid dir = _crDir cr pos = _crPos cr +.+ ((_crRad cr +0.5) *.* unitVectorAtAngle dir) (vs,_) = runState ((sequence . repeat . randInCirc) 0.4) $ _randGen w (sps,_) = runState ((sequence . repeat . randInCirc) 8) $ _randGen w ts = randomRs (250,1000) $ _randGen w ss = take 3 $ randomRs (10,20) $ _randGen w smokeGen = zipWith4 (\ v s t sp -> makeThinSmokeAt (greyN 0.1) v s t (pos +.+ sp)) vs ss ts sps withThickSmoke :: (Int -> World -> World) -> Int -> World -> World withThickSmoke eff cid w = eff cid $ foldr ($) w smokeGen where cr = _creatures w IM.! cid dir = _crDir cr pos = _crPos cr +.+ ((_crRad cr +0.5) *.* unitVectorAtAngle dir) (vs,_) = runState ((sequence . repeat . randInCirc) 0.4) $ _randGen w (sps,_) = runState ((sequence . repeat . randInCirc) 8) $ _randGen w ts = randomRs (18,20) $ _randGen w ss = take 20 $ randomRs (0.1,1) $ _randGen w smokeGen = zipWith4 (\ v s t sp -> makeColorSmokeAt (greyN 0.1) v s t (pos +.+ sp)) vs ss ts sps makeThinSmokeAt :: Color -> Point2 -> Float -> Int -> Point2 -> World -> World makeThinSmokeAt col vel scal time p w = over particles (IM.insert n smP) w where n = newParticleKey w smP = Particle { _ptPos = p , _ptStartPos = p , _ptVel = vel , _ptPict = onLayer PtLayer $ uncurry translate p $ color col $ circleSolid 1 , _ptID = n , _ptUpdate = moveThinSmoke col scal time n } moveThinSmoke :: Color -> Float -> Int -> Int -> World -> World moveThinSmoke col scal time i w | time > 0 = set (particles . ix i . ptPict) pic . set (particles . ix i . ptUpdate) (moveThinSmoke col scal (time-1) i) . set (particles . ix i . ptPos) newPos . setVel $ w | time > -10 = set (particles . ix i . ptPict) pi1 . set (particles . ix i . ptUpdate) (moveThinSmoke col scal (time-1) i) . set (particles . ix i . ptPos) newPos . setVel $ w | otherwise = over particles (IM.delete i) w where oldPos = _ptPos $ _particles w IM.! i newPos = oldPos +.+ (_ptVel $ _particles w IM.! i) setVel = over (particles . ix i . ptVel) $ (*.*) 0.99 pic = onLayer PtLayer $ uncurry translate newPos $ color (withAlpha 0.1 col) $ circleSolid scal pi1 = onLayer PtLayer $ uncurry translate newPos $ color (withAlpha (0.1 + fromIntegral time /100) col) $ circleSolid $ scal makeLaserAt :: Float -> Point2 -> Float -> Maybe Int -> Particle' makeLaserAt phaseV pos dir mcid = Particle' { _ptPict' = blank , _ptUpdate' = moveLaser phaseV pos dir mcid } moveLaser :: Float -> Point2 -> Float -> Maybe Int -> World -> Particle' -> (World, Maybe Particle') moveLaser phaseV pos dir mcid w pt = ( set randGen g -- $ over worldEvents ((.) flares) $ hitEffect w , Just pt {_ptPict' = onLayer PtLayer $ pic ,_ptUpdate' = ptTimer' 0 } ) where xp = pos +.+ 800 *.* unitVectorAtAngle dir (a,g) = randomR (-0.7,0.7) $ _randGen w reflectDir wall = a + (argV $ reflectIn (_wlLine wall !! 1 -.- _wlLine wall !! 0) (xp -.- pos) ) (colID,_) = randomR (0,11) $ _randGen w -- flares w = foldr (\p w' -> flareAt' yellow 0.01 0.02 p w') w flarePs -- flarePs = zipWith (\x y -> x +.+ 5 *.* normalizeV (y -.- x)) ps $ tail ps -- flarePos p = p +.+ ((a + 0.8) * 3) *.* (normalizeV (pos -.- p)) f :: [Wall] -> Point2 -> Point2 -> (Maybe (Point2,Either3 Creature Wall ForceField),[Point2]) f seenWs x y = case listToMaybe $ filter (h' seenWs) $ thingsHitExceptCrLongLine Nothing x y w of Just (p,E3x2 wl) | _wlIsSeeThrough wl -> f' p $ f (wl:seenWs) p (h x y wl p) | otherwise -> (Just (p,E3x2 wl), [p]) Just (p,obj) -> (Just (p,obj), [p]) Nothing -> (Nothing, [y]) f' p (x,ps') = (x,p:ps') h x y wl p | isEntering = p +.+ rotateV angleRef normalDist | otherwise = p +.+ rotateV angleRef' normalDist' where wlNormal = vNormal $ (_wlLine wl !! 1) -.- (_wlLine wl !! 0) normalDist = magV (p -.- y) *.* normalizeV wlNormal angleInc = piRange $ argV wlNormal - argV (x -.- y) angleRef | reflectExternal = angleInc | otherwise = asin $ sin angleInc / phaseV piRange a | a > pi = a - 2 * pi | a > 0 - pi = a | otherwise = a + 2 * pi isEntering = isLeftOf (x -.- y) ((_wlLine wl !! 1) -.- (_wlLine wl !! 0)) wlNormal' = vNormal $ (_wlLine wl !! 0) -.- (_wlLine wl !! 1) normalDist' = magV (p -.- y) *.* normalizeV wlNormal' angleInc' = piRange $ argV wlNormal' - argV (x -.- y) angleRef' | reflectInternal = angleInc' | otherwise = asin $ phaseV * sin angleInc' reflectInternal = 1 < abs (phaseV * sin angleInc') reflectExternal = 1 < abs (sin angleInc / phaseV) h' ws (_,E3x2 wl) = not $ any (\w -> _wlID w == _wlID wl) ws h' _ _ = True (thHit, ps) = f [] pos xp hitEffect = case thHit of Just (p,E3x1 cr) -> over (creatures . ix (_crID cr) . crState . crDamage) ((:) $ Lasering 3 pos p xp) -- . over worldEvents ((.) $ flareAt yellow (flarePos p)) Just (p,E3x2 wl) -> createSpark 8 colID (p +.+ safeNormalizeV (pos -.- p)) (reflectDir wl) Nothing _ -> id pic = pictures [ fadeLine pos (head ps) 0.2 40 yellow , setLayer 1 $ color (withAlpha 0.9 white) $ vThickLine (pos:ps) , setLayer 1 $ color (withAlpha 0.5 yellow) $ vvThickLine (pos:ps) ] fadeLine :: Point2 -> Point2 -> Float -> Float -> Color -> Picture fadeLine sp ep alph width col = setLayer 1 $ polygonCol [(sp , ca) ,(sp +.+ n , cb) ,(ep +.+ n , cb) ,(ep , ca) ,(ep -.- n , cb) ,(sp -.- n , cb) ] where n = width *.* (normalizeV $ vNormal $ ep -.- sp) ca = withAlpha alph col cb = withAlpha 0 col -- pictures [color (withAlpha (0.8 * alph) col) $ lineOfThickness width [sp,p 0.25] -- ,color (withAlpha (0.6 * alph) col) $ lineOfThickness width [p 0.25,p 0.5] -- ,color (withAlpha (0.4 * alph) col) $ lineOfThickness width [p 0.5,p 0.75] -- ,color (withAlpha (0.2 * alph) col) $ lineOfThickness width [p 0.75,ep] -- ] -- where p x = sp +.+ x *.* (ep -.- sp) grenadeLauncher :: Item grenadeLauncher = pistol grenade,remoteBomb :: Item grenade = Throwable { _itName = "GRENADE " ++ show fuseTime , _itIdentity = Grenade , _itMaxStack = 8 , _itAmount = 1 , _itFloorPict = onLayer FlItLayer $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)] , _twMaxRange = 150 , _twAccuracy = 30 , _twFire = throwGrenade fuseTime , _itAimingSpeed = 1 , _itAimingRange = 0 , _itZoom = basicItZoom {_itAimZoomMax = (f fuseTime), _itAimZoomMin = (f fuseTime)} , _itEquipPict = drawWeapon $ grenadePic fuseTime , _itID = Nothing , _itAttachment = Just $ ItFuse fuseTime , _itInvColor = white , _itInvDisplay = _itName , _itEffect = wpRecock , _itHammer = HammerUp , _itScrollUp = decreaseFuse fuseTime , _itScrollDown = increaseFuse fuseTime } where fuseTime = 50 f x = 50 / fromIntegral x increaseFuse :: Int -> Int -> World -> World increaseFuse fuse i w = w & creatures . ix 0 . crInv . ix itRef . itScrollUp .~ decreaseFuse newTime & creatures . ix 0 . crInv . ix itRef . itScrollDown .~ increaseFuse newTime & creatures . ix 0 . crInv . ix itRef . twFire .~ throwGrenade newTime & creatures . ix 0 . crInv . ix itRef . itName .~ "GRENADE " ++ show newTime & creatures . ix 0 . crInv . ix itRef . itAttachment .~ Just (ItFuse newTime) & creatures . ix 0 . crInv . ix itRef . itZoom .~ (basicItZoom {_itAimZoomMax = zm, _itAimZoomMin = zm}) where itRef = fromMaybe (-2) $ w ^? creatures . ix 0 . crInvSel newTime = min (fuse + 5) 90 zm = 50 / fromIntegral newTime decreaseFuse :: Int -> Int -> World -> World decreaseFuse fuse i w = w & creatures . ix 0 . crInv . ix itRef . itScrollUp .~ decreaseFuse newTime & creatures . ix 0 . crInv . ix itRef . itScrollDown .~ increaseFuse newTime & creatures . ix 0 . crInv . ix itRef . twFire .~ throwGrenade newTime & creatures . ix 0 . crInv . ix itRef . itName .~ "GRENADE " ++ show newTime & creatures . ix 0 . crInv . ix itRef . itAttachment .~ Just (ItFuse newTime) & creatures . ix 0 . crInv . ix itRef . itZoom .~ (basicItZoom {_itAimZoomMax = zm, _itAimZoomMin = zm}) where itRef = fromMaybe (-2) $ w ^? creatures . ix 0 . crInvSel newTime = max (fuse - 5) 20 zm = 50 / fromIntegral newTime defaultThrowable = grenade remoteBomb = defaultThrowable { _itName = "REMOTEBOMB" , _itIdentity = RemoteBomb , _itMaxStack = 1 , _itAmount = 1 , _itFloorPict = onLayer FlItLayer $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)] , _twMaxRange = 150 , _twAccuracy = 30 , _twFire = throwRemoteBomb , _itAttachment = Just $ ItScope (0,0) 0 1 True , _itEquipPict = drawWeapon $ remoteBombUnarmedPic } throwGrenade :: Int -> Int -> World -> World throwGrenade fuseTime n w = setWp $ removePict $ over particles addG $ set randGen g w where addG = IM.insert i $ Particle { _ptPos = p , _ptStartPos = p , _ptVel = v , _ptPict = onLayer PtLayer $ uncurry translate p $ grenadePic 0 , _ptID = i , _ptUpdate = moveGrenade fuseTime dir i } j = _crInvSel $ _creatures w IM.! n removePict = set (creatures . ix n . crInv . ix j . itEquipPict) $ \ _ _ -> blank i = newParticleKey w (a, g) = randomR (-grenadeAccA,grenadeAccA::Float) (_randGen w) (l, _) = randomR (1 - 2*grenadeAccL,1+grenadeAccL::Float) g -- v = 0.02 * l / _cameraZoom w *.* rotateV (a+_cameraRot w) (limitRange $ _mousePos w) v' = 1 / (fromIntegral fuseTime * _cameraZoom w) *.* rotateV (_cameraRot w) ( _mousePos w) v | magV v' > 6 = 6 *.* normalizeV v' | otherwise = v' cr = _creatures w IM.! n p' = _crPos cr +.+ rotateV (_crDir cr) (_crRad cr,0) p | circOnSomeWall p' 4 w = _crPos cr +.+ rotateV (_crDir cr) (_crRad cr-4,0) | otherwise = p' dir = argV v setWp :: World -> World setWp w' = w' & creatures . ix n . crInv . ix j . itEffect .~ throwArmReset 20 throwArmReset :: Int -> ItEffect throwArmReset x = ItInvEffect {_itInvEffect = f ,_itEffectCounter = x } where f cr i = creatures . ix (_crID cr) . crInv %~ IM.adjust counterDown i counterDown it | _itEffectCounter (_itEffect it) == 0 = it & itHammer .~ HammerUp & itEquipPict .~ (drawWeapon $ grenadePic 50) | otherwise = it & itEffect . itEffectCounter %~ (\x -> x - 1) (grenadeAccL, grenadeAccA) = (0.1, 0.1) grenadePic :: Int -> Picture grenadePic x = pictures [ color (dark $ dark green) $ circleSolid 5 , color green $ arc (degToRad $ (179 * fromIntegral x / 50) - 180 ) (degToRad $ 180 - (179 * fromIntegral x / 50) ) 5 , translate (-2) 2 $ rotate (pi*0.5) $ scale 0.05 0.05 $ color green $ text $ show $ 1 + quot x 20 ] fireRemoteLauncher :: Int -> World -> World fireRemoteLauncher cid w = setLocation $ resetFire $ resetName $ soundOnce (fromIntegral launcherSound) $ over particles remRocket w where i = newKey $ _particles w cr = _creatures w IM.! cid dir = _crDir cr pos = _crPos cr +.+ rotateV dir (_crRad cr + 1,0) remRocket = IM.insert i $ Particle { _ptPos = pos , _ptStartPos = pos , _ptVel = rotateV dir (1,0) , _ptPict = blank , _ptID = i , _ptUpdate = moveRemoteShell 50 i cid itid dir } j = _crInvSel $ _creatures w IM.! cid newitid = newKey $ _itemPositions w maybeitid = w ^? creatures . ix cid . crInv . ix j . itID . _Just resetFire = set (creatures . ix cid . crInv . ix j . wpFire) $ explodeRemoteRocket itid i resetName = set (creatures . ix cid . crInv . ix j . itName) "REMOTEROCKET" setLocation :: World -> World setLocation w' = case maybeitid of Nothing -> w' & creatures . ix cid . crInv . ix j . itID .~ Just newitid & itemPositions %~ IM.insert newitid (InInv cid j) _ -> w' itid = fromMaybe newitid maybeitid moveRemoteShell :: Int -> Int -> Int -> Int -> Float -> World -> World moveRemoteShell time i cid itid dir w | time > 40 = if circOnSomeWall oldPos 4 w then doExplosion w else over (particles . ix i . ptPos) (+.+ vel) $ set (particles . ix i . ptPict) piclow $ set (particles . ix i . ptUpdate) (moveRemoteShell (time-1) i cid itid newdir) $ setScope w | time >= 20 = case thingHit of Just p -> doExplosion w Nothing -> over (particles . ix i . ptPos) (+.+ vel) $ set (particles . ix i . ptPict) pic $ set (particles . ix i . ptUpdate) (moveRemoteShell (time-1) i cid itid newdir) $ setScope w | time > -99 = case thingHit of Just p -> doExplosion $ stopSoundFrom (ShellSound i) w Nothing -> over (particles . ix i . ptPos) (+.+ vel) $ set randGen g $ set (particles . ix i . ptPict) pic $ set (particles . ix i . ptUpdate) (moveRemoteShell (time-1) i cid itid newdir) $ over (particles . ix i . ptVel) (\v -> accel +.+ frict *.* v) $ soundFrom (ShellSound i) (fromIntegral smokeTrailSound) (1) 250 $ smokeGen $ makeFlameletTimed oldPos (0.5 *.* rotateV (pi+sparkD) accel) (levLayer UPtLayer) Nothing 3 20 $ makeFlameletTimed (0.5 *.* (newPos +.+ oldPos)) (0.5 *.* rotateV (pi+sparkD) accel) (levLayer UPtLayer) Nothing 3 20 $ setScope w | time > -200 = case thingHit of Just p -> doExplosion $ stopSoundFrom (ShellSound i) w Nothing -> over (particles . ix i . ptPos) (+.+ vel) $ set (particles . ix i . ptPict) pic $ set (particles . ix i . ptUpdate) (moveRemoteShell (time-1) i cid itid newdir) $ setScope w | otherwise = doExplosion $ stopSoundFrom (ShellSound i) w where pt = _particles w IM.! i oldPos = _ptPos pt vel = _ptVel pt 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 (sparkD,_) = randomR (-0.5,0.5) $ _randGen w dir = argV $ vel pic = onLayer PtLayer $ uncurry translate newPos $ rotate (argV accel) $ remoteShellPic time piclow = onLayerL [levLayer CrLayer - 2] $ uncurry translate newPos $ rotate (argV accel) $ remoteShellPic time hitCr = fmap fst $ collideCircCrsPoint oldPos newPos 4 w hitWl = fmap fst $ collideCircWalls' oldPos newPos 2 $ wallsNearPoint newPos w thingHit = hitCr <|> hitWl (v1:v2:v3:_) = fst $ runState ((sequence . repeat . randInCirc) 0.1) $ _randGen w (r1:r2:r3:_) = map ((*.*) 100) (v2:v3:v1:[]) (t1:t2:t3:_) = randomRs ( 15,20) $ _randGen w (s1:s2:s3:_) = map (\s -> fromIntegral s * 0.1 - 1) (t3:t2:t1:[]) -- ((r1:r2:r3:_),_) = runState ((sequence . repeat . randInCirc) 10) $ _randGen w -- v1 = fst $ runState (randInCirc 0.5) $ _randGen w smokeGen = makeSmokeAt'' v2 s2 t2 (newPos +.+ r2) . makeSmokeAt'' v1 s1 t1 (newPos +.+ r1) -- . makeSmokeAt'' v3 s3 t3 (newPos +.+ r3) doExplosion = explodeRemoteRocket itid i cid setScope w' = case _itemPositions w' IM.! itid of InInv cid invid -> w' & creatures . ix cid . crInv . ix invid . itAttachment . _Just . scopePos .~ (newPos -.- _crPos (_creatures w' IM.! cid)) _ -> w' explodeRemoteRocket :: Int -> Int -> Int -> World -> World explodeRemoteRocket itid ptid n w = set (particles . ix ptid . ptUpdate) (retireRemoteRocket itid 30 ptid) $ set (particles . ix ptid . ptPict) blank $ set (itPoint . wpFire) (flip const) $ resetName -- $ resetScope $ makeExplosionAt (_ptPos (_particles w IM.! ptid)) w -- $ makeShrapnelBombAt (_ptPos (_particles w IM.! ptid)) w where resetName = set (itPoint . itName) "REMOTELAUNCHER" -- resetScope = creatures . ix n . crInv . ix j . itScope . _Just . scopePos .~ (0,0) itPoint = pointToItem $ _itemPositions w IM.! itid throwRemoteBomb :: Int -> World -> World throwRemoteBomb n w = setLocation $ removePict $ resetFire -- $ resetName $ over particles addG $ set randGen g w $ resetName $ over particles addG w where addG = IM.insert i $ Particle { _ptPos = p , _ptStartPos = p , _ptVel = v , _ptPict = blank , _ptID = i , _ptUpdate = moveRemoteBomb itid 50 i } i = newParticleKey w -- fireDist = zoom *.* (rotateV (_cameraRot w) (_mousePos w) +.+ _cameraPos w -.- yourPos) d = argV $ _mousePos w --(l, _) = randomR (1 - grenadeAccL,1+grenadeAccL) (_randGen w) --(a, g) = randomR (-grenadeAccA,grenadeAccA) (_randGen w) v' = 0.02 / _cameraZoom w *.* rotateV (_cameraRot w) ( _mousePos w) v | magV v' > 6 = 6 *.* normalizeV v' -- zoom = 1 / _cameraZoom w j = _crInvSel $ _creatures w IM.! n resetName = set (creatures . ix n . crInv . ix j . itName) "REMOTE" removePict = set (creatures . ix n . crInv . ix j . itEquipPict) $ \ _ _ -> blank resetFire = set (creatures . ix n . crInv . ix j . twFire) $ explodeRemoteBomb itid i cr = _creatures w IM.! n p' = _crPos cr +.+ rotateV (_crDir cr) (_crRad cr,0) p | circOnSomeWall p' 4 w = _crPos cr +.+ rotateV (_crDir cr) (_crRad cr-4,0) | otherwise = p' maybeitid = w ^? creatures . ix n . crInv . ix j . itID . _Just setLocation :: World -> World setLocation w' = case maybeitid of Nothing -> w' & creatures . ix n . crInv . ix j . itID .~ Just newitid & itemPositions %~ IM.insert newitid (InInv n j) _ -> w' newitid = newKey $ _itemPositions w itid = fromMaybe newitid maybeitid explodeRemoteBomb :: Int -> Int -> Int -> World -> World explodeRemoteBomb itid ptid n w = set (particles . ix ptid . ptUpdate) (retireRemoteBomb itid 30 ptid) $ set (particles . ix ptid . ptPict) blank $ set (creatures . ix n . crInv . ix j . twFire) (flip const) $ resetName $ resetPict -- $ resetScope $ makeExplosionAt (_ptPos (_particles w IM.! ptid)) w -- $ makeShrapnelBombAt (_ptPos (_particles w IM.! ptid)) w where resetName = set (creatures . ix n . crInv . ix j . itName) "REMOTEBOMB" resetPict = set (creatures . ix n . crInv . ix j . itEquipPict ) (drawWeapon $ remoteBombUnarmedPic) -- resetScope = creatures . ix n . crInv . ix j . itScope . _Just . scopePos .~ (0,0) j = _crInvSel $ _creatures w IM.! n remoteBombPic :: Int -> Picture remoteBombPic x = pictures [ color (dark $ dark orange) $ circleSolid 5 , rotate (0 - degToRad (fromIntegral x * 10 + 45)) $ color red $ arc 0 (pi/2) 5 , rotate (0 - degToRad (fromIntegral x * 10 + 45)) $ color (withAlpha 0.05 red) $ arcSolid 0 90 50 , rotate (0 - degToRad (fromIntegral x * 10 + 20)) $ color (withAlpha 0.05 red) $ arcSolid 0 40 40 , rotate (0 - degToRad (fromIntegral x * 10 + 10)) $ color (withAlpha 0.05 red) $ arcSolid 0 20 20 ] remoteBombUnarmedPic :: Picture remoteBombUnarmedPic = color (dark $ dark orange) $ circleSolid 5 makeTeslaArcAt :: Int -> Point2 -> Float -> Particle makeTeslaArcAt i pos dir = Particle { _ptPos = pos , _ptStartPos = pos , _ptVel = (0,0) , _ptPict = onLayer PtLayer $ line [(0,0),(0,0)] , _ptID = i , _ptUpdate = moveTeslaArc pos dir i } moveTeslaArc :: Point2 -> Float -> Int -> World -> World moveTeslaArc p d i w = set (particles . ix i . ptPict) pic $ set (particles . ix i . ptUpdate) (ptTimer 2 i) $ set randGen g $ createSpark 8 nc q2 (argV sv + d1) Nothing $ foldr damCrs w hitCrs where pic = setLayer 1 $ pictures [ onLayer PtLayer $ color (f2 nc) $ line ps' , onLayer UPtLayer $ color (withAlpha 0.02 cyan) $ lineOfThickness 20 ps' , onLayer UPtLayer $ color (withAlpha 0.02 cyan) $ lineOfThickness 25 ps' , onLayer UPtLayer $ color (withAlpha 0.02 cyan) $ lineOfThickness 30 ps' ] ps' = lightningMids d pers ps ps = take 15 $ p : map f (crsLightChain p d 0 w) f (E3x1 cr) = _crPos cr f (E3x2 p1) = p1 f (E3x3 p1) = p1 pers = evalState (sequence $ repeat $ randInCirc 5) $ _randGen w (nc,g) = randomR (0::Int,11) $ _randGen w f1 (E3x1 cr) = Just $ _crID cr f1 _ = Nothing hitCrs = mapMaybe f1 $ take 14 $ crsLightChain p d 0 w damCrs i = over (creatures . ix i . crHP) (\hp -> hp - 5) f2 0 = cyan f2 1 = azure f2 _ = white sID = newParticleKey w q1 = last $ init ps' q2 = last ps' hitWall = collidePointWalls q1 ((2 *.* q2) -.- q1) $ wallsNearPoint q1 w (d1,_) = randomR (-0.7,0.7) $ _randGen w sv = fromMaybe (q2 -.- q1) $ fmap snd hitWall lightningMid :: Float -> Point2 -> Point2 -> Point2 lightningMid d p1 p2 = (0.25 *.* (p1 +.+ p2)) +.+ 0.5 *.* p3 where p3 = errorClosestPointOnLine 1 p1 (p1 +.+ unitVectorAtAngle d) p2 lightningMids :: Float -> [Point2] -> [Point2] -> [Point2] lightningMids d1 (p:pers) (p1:p3:ps) = let p2 = p +.+ lightningMid d1 p1 p3 d2 = argV $ p3 -.- p2 in p1 : p2 : lightningMids d2 pers (p3:ps) lightningMids _ _ ps = ps crsLightChain' :: Point2 -> Float -> World -> [Either3 Creature Point2 Point2] crsLightChain' p d w = case crOrWall p d w of E3x1 cr -> E3x1 cr : crsLightChain' (_crPos cr) (argV (_crPos cr -.- p)) w E3x2 p1 -> [E3x2 p1] E3x3 p1 -> E3x3 p1 : crsLightChain' p1 (dChange + argV (p1 -.- p)) (set randGen g w) -- where (dChange, g) = (0, _randGen w) where (dChange, g) = randomR (-0.05,0.05) $ _randGen w crsLightChain :: Point2 -> Float -> Float -> World -> [Either3 Creature Point2 Point2] crsLightChain p d wlAttract w = case crOrWallSensitive p d wlAttract w of E3x1 cr -> E3x1 cr : crsLightChain (_crPos cr) (argV (_crPos cr -.- p)) (min 1 (wlAttract + 0.3)) w E3x2 p1 -> [E3x2 p1] E3x3 p1 -> E3x3 p1 : crsLightChain p1 (dChange + argV (p1 -.- p)) (min 1 (wlAttract + 0.3)) (set randGen g w) -- where (dChange, g) = (0, _randGen w) where (dChange, g) = randomR (-0.05,0.05) $ _randGen w crOrWallSensitive :: Point2 -> Float -> Float -> World -> Either3 Creature Point2 Point2 crOrWallSensitive p dir wlAttract w = fromMaybe (E3x3 $ p +.+ rotateV dir (arcLen,0)) $ listToMaybe $ sortBy (compare `on` g) $ catMaybes [cr,wlp] where cr = fmap E3x1 $ nearestCrInFront p dir 100 w wlp = fmap E3x2 $ listToMaybe $ sortBy (compare `on` dist p) $ mapMaybe ( fmap fst . (\p1 -> collidePointWalls p p1 $ wallsNearPoint p w) . (+.+) p . (\d -> rotateV d (100,0)) . (+) dir ) (fmap (*wlAttract) [-(3*pi/8),-pi/4,-pi/8,0,pi/8,pi/4,3*pi/8]) --[-pi/4,-pi/8,0,pi/8,pi/4] g (E3x2 p1) = 100 + dist p p1 -- tweak makes it more likely to hit crs first --g (E3x2 p1) = dist p p1 - 100 -- tweak makes it more likely to hit walls first g (E3x1 cr1) = dist p $ _crPos cr1 (arcLen,_) = randomR (25,50) $ _randGen w -- BUG: can hit crs through walls crOrWall :: Point2 -> Float -> World -> Either3 Creature Point2 Point2 crOrWall p dir w = fromMaybe (E3x3 $ p +.+ rotateV dir (arcLen,0)) $ listToMaybe $ sortBy (compare `on` g) $ catMaybes [cr,wlp] where cr = fmap E3x1 $ nearestCrInFront p dir 100 w wlp = fmap E3x2 $ listToMaybe $ sortBy (compare `on` dist p) $ mapMaybe ( fmap fst . (\p1 -> collidePointWalls p p1 $ wallsNearPoint p w) . (+.+) p . (\d -> rotateV d (100,0)) . (+) dir ) [-(3*pi/8),-pi/4,-pi/8,0,pi/8,pi/4,3*pi/8] --[-pi/4,-pi/8,0,pi/8,pi/4] g (E3x2 p1) = 100 + dist p p1 -- tweak makes it more likely to hit crs first --g (E3x2 p1) = dist p p1 - 100 -- tweak makes it more likely to hit walls first g (E3x1 cr1) = dist p $ _crPos cr1 (arcLen,_) = randomR (25,50) $ _randGen w spreadGunSpread,autogunSpread :: Float spreadGunSpread = 0.5 autogunSpread = 0.07 pipe = Craftable { _itIdentity = Generic , _itName = "PIPE" , _itMaxStack = 3 , _itAmount = 3 , _itFloorPict = onLayer FlItLayer $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)] , _itEquipPict = \cr _ -> blank , _itID = Nothing , _itInvDisplay = _itName , _itInvColor = green } magShield = basicEquipment { _itIdentity = MagShield , _itName = "MAGSHIELD" , _itMaxStack = 1 , _itAmount = 1 , _itFloorPict = onLayer FlItLayer $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)] , _itEquipPict = \cr _ -> blank , _itID = Nothing } flameShield = basicEquipment { _itIdentity = FlameShield , _itName = "FLAMESHIELD" , _itMaxStack = 1 , _itAmount = 1 , _itFloorPict = onLayer FlItLayer $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)] , _itEquipPict = (\cr _ -> onLayer CrLayer $ pictures [color cyan $ circle (_crRad cr+2)] ) , _itID = Nothing } frontArmour = basicEquipment { _itIdentity = FrontArmour , _itName = "FARMOUR" , _itMaxStack = 1 , _itAmount = 1 , _itFloorPict = onLayer FlItLayer $ translate 0 (-5) $ pictures [color (greyN 0.1) $ thickArc 0 (pi/2) 10 5 ,color (greyN 0.1) $ thickArc (3*pi/2) (2*pi) 10 5 ] , _itEquipPict = (\cr _ -> onLayer CrLayer $ pictures [color (greyN 0.1) $ thickArc 0 (pi/2) 10 5 ,color (greyN 0.1) $ thickArc (3*pi/2) (2*pi) 10 5 ] ) , _itEffect = NoItEffect , _itID = Nothing } jetPack = basicEquipment { _itIdentity = JetPack , _itName = "JETPACK" , _itMaxStack = 1 , _itAmount = 1 , _itFloorPict = onLayer FlItLayer $ color yellow $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)] , _itEquipPict = (\cr _ -> onLayer CrLayer $ pictures [color yellow $ polygon $ rectNSEW 5 (-5) (-3) (-11) ] ) , _itEffect = NoItEffect , _itID = Nothing } latchkey :: Int -> Item latchkey n = basicEquipment { _itIdentity = Generic , _itName = "KEY "++show n , _itMaxStack = 1 , _itAmount = 1 , _itFloorPict = onLayer FlItLayer $ latchkeyPic , _itEquipPict = \cr _ -> onLayer PtLayer $ translate (-5) (-5) $ rotate (pi/2.5) latchkeyPic , _itEffect = NoItEffect , _itHammer = HammerUp , _itID = Nothing , _itAimingSpeed = 1 , _itAimingRange = 0 , _itZoom = basicItZoom , _itInvColor = yellow , _itInvDisplay = _itName } latchkeyPic = color yellow $ pictures [translate (-4) 0 $ thickCircle 4 2 ,lineOfThickness 2 [(0,0),(8,0),(8,-4)] ,lineOfThickness 2 [(4,0),(4,-4)] ] -- }}} forceFieldFire :: Int -> World -> World forceFieldFire cid w = w --shatterGunFire :: Int -> World -> World --shatterGunFire n w | fireCondition = -- soundOnce 0 -- set (creatures . ix n . crInv . ix itRef . wpFireState) -- (_wpFireRate (_crInv cr IM.! itRef)) -- $ over (creatures . ix n . crInv . ix itRef . wpLoadedAmmo) -- (\x -> x - 1) -- $ over particles (IM.insert i $ makeTremorAt i pos dir) w -- | reloadCondition = let remAmmo = _crAmmo cr M.! _wpAmmoType item -- (newA,newTotalA) = moveInt (_wpMaxAmmo item) remAmmo -- in set (pointerToItem . wpReloadState) rTime -- $ set (pointerToItem . wpLoadedAmmo) newA -- $ over (creatures . ix n . crAmmo ) -- (M.insert (_wpAmmoType item) newTotalA) w -- | emptyCondition = soundOnce 1 w -- | otherwise = w -- where i = newParticleKey w -- cr = (_creatures w IM.! n) -- pos = _crPos cr +.+ ((_crRad cr +1) *.* unitVectorAtAngle dir) -- dir = _crDir cr -- --(colID, _) = randomR (0,11) (_randGen w) -- itRef = _crInvSel cr -- item = _crInv cr IM.! itRef -- pointerToItem = creatures . ix n . crInv . ix itRef -- rTime = _wpReloadTime (_crInv cr IM.! itRef) -- fireCondition = _wpReloadState (_crInv cr IM.! itRef) == 0 -- && _wpFireState (_crInv cr IM.! itRef) == 0 -- && _wpLoadedAmmo (_crInv cr IM.! itRef) > 0 -- reloadCondition = _wpReloadState (_crInv cr IM.! itRef) == 0 -- && _wpLoadedAmmo (_crInv cr IM.! itRef) == 0 -- && someJust (_crAmmo cr M.!? PistolBullet) -- emptyCondition = _wpLoadedAmmo (_crInv cr IM.! itRef) == 0 --for reloading, we take from the total ammo moveInt :: Int -> Int -> (Int,Int) moveInt toReload totalAmmo = (x, totalAmmo-x) where x = min toReload totalAmmo updateTractor :: Int -> Int -> Int -> World -> World updateTractor colID time i w | time > 0 = set (particles . ix i . ptUpdate) (updateTractor colID (time-1) i) $ set (particles . ix i . ptPict) pic $ over creatures (IM.map tractCr) $ over floorItems (IM.map tractFlIt) w | otherwise = over particles (IM.delete i) w where tractCr cr | circOnLine p1 p2 cP 10 = over crPos (\p -> p -.- m *.* ((0.3/ x) *.* q +.+ (f y *.* p4)) ) cr | otherwise = cr where x = abs y + 1 y = errorClosestPointOnLineParam 1 p1 p3 cP cP = _crPos cr m | dist cP p1 < 350 = 1 | otherwise = (400 - dist cP p1) / 50 tractFlIt it | circOnLine p1 p2 iP 10 = over flItPos (\p -> p -.- m *.* ( (0.3/ x) *.* q +.+ (f y *.* p4)) ) it | otherwise = it where x = abs y + 1 y = errorClosestPointOnLineParam 2 p1 p3 iP iP = _flItPos it m | dist iP p1 < 350 = 1 | otherwise = (410 - dist iP p1) / 60 pt = _particles w IM.! i q = _ptVel pt p1 = _ptPos pt p' = _ptStartPos pt p2 = fromMaybe p' $ fmap fst $ collidePointWalls p1 p' $ wallsNearPoint p' w p4 = vNormal p5 p5 = errorNormalizeV 12 $ p2 -.- p1 p3 = p1 +.+ p4 g x | x > 5 = (10 - x) / 5 | x > 1 = 1 | x > -1 = x | x > -5 = -1 | otherwise = (x - 10) / 5 d = errorNormalizeV 13 $ p' -.- p1 f x = g x / 50 cID = fromIntegral colID / 10 col = mixColors 0.5 0.5 white blue px z = (fromIntegral time + 5) *.* z pz z = fromIntegral time * 10 *.* z pic = onLayer PtLayer $ color (withAlpha 0.05 col) $ polygon [ p1 +.+ px p4 , p1 -.- 10 *.* p5 , p1 -.- px p4 , (p' -.- pz p5) -.- px p4 , (p' -.- pz p5) +.+ px p4] thickLine :: [Point2] -> Picture thickLine = lineOfThickness 2 vThickLine :: [Point2] -> Picture vThickLine = lineOfThickness 3 vvThickLine :: [Point2] -> Picture vvThickLine = lineOfThickness 6 thinLine :: [Point2] -> Picture 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 radar = defaultGun { _itName = "RADAR" , _itIdentity = Generic , _wpMaxAmmo = 100 , _wpLoadedAmmo = 100 , _wpReloadTime = 200 , _wpReloadState = 0 , _wpFireRate = 120 , _wpFireState = 0 , _wpFire = shoot $ aRadarPulse , _wpSpread = autogunSpread , _wpRange = 20 , _itHammer = HammerUp , _itFloorPict = onLayer FlItLayer $ color blue $ polygon $ rectNESW 5 5 (-5) (-5) , _itAmount = 1 , _itMaxStack = 1 , _itAimingRange = 1 , _itZoom = basicItZoom {_itAimZoomMax = 1, _itZoomMax = 1} , _itEquipPict = drawWeapon $ color blue $ polygon $ rectNESW 5 5 (-5) (-5) } sonar = defaultGun { _itName = "SONAR" , _itIdentity = Generic , _wpMaxAmmo = 100 , _wpLoadedAmmo = 100 , _wpReloadTime = 200 , _wpReloadState = 0 , _wpFireRate = 120 , _wpFireState = 0 , _wpFire = shoot $ aSonarPulse , _wpSpread = autogunSpread , _wpRange = 20 , _itHammer = HammerUp , _itFloorPict = onLayer FlItLayer $ color blue $ polygon $ rectNESW 5 5 (-5) (-5) , _itAmount = 1 , _itMaxStack = 1 , _itAimingRange = 1 , _itZoom = basicItZoom {_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 blipAt :: Point2 -> Color -> Int -> Particle' blipAt p col i = Particle' {_ptPict' = 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) & ptPict' .~ (onLayerL [levLayer ShadowLayer, 2] $ uncurry translate p $ color (withAlpha (fromIntegral t / fromIntegral maxt) col) $ circleSolid 2) ) sonarPulseAt :: Point2 -> Particle' sonarPulseAt p = Particle' { _ptPict' = 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 {_ptPict' = pic ,_ptUpdate' = mvSonar (x-1) p } ) where pic = onLayerL [levLayer ShadowLayer, 2] $ 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' { _ptPict' = 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 {_ptPict' = 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) autoSonar = basicEquipment { _itIdentity = Generic , _itName = "AUTOSONAR" , _itMaxStack = 1 , _itAmount = 1 , _itFloorPict = onLayer FlItLayer $ color yellow $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)] , _itEquipPict = \cr _ -> blank , _itEffect = autoSonarEffect , _itID = Nothing , _itAimingSpeed = 1 , _itAimingRange = 0 , _itZoom = basicItZoom {_itAimZoomMax = 1, _itZoomMax = 1} } autoRadar = basicEquipment { _itIdentity = Generic , _itName = "AUTORADAR" , _itMaxStack = 1 , _itAmount = 1 , _itFloorPict = onLayer FlItLayer $ color yellow $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)] , _itEquipPict = \cr _ -> blank , _itEffect = autoRadarEffect , _itID = Nothing , _itAimingSpeed = 1 , _itAimingRange = 0 , _itZoom = basicItZoom {_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 40 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 & flareWidth 2 1 15 32 col 0.05 0.1 (ep -.- 4 *.* unitVectorAtAngle d) -- 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 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' {_ptPict' = 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)) }