{-# LANGUAGE BangPatterns #-} module Dodge.Item.Weapon ( module Dodge.Item.Weapon ) where import Dodge.Data import Dodge.Base import Dodge.SoundLogic import Dodge.Creature.Action import Dodge.RandomHelp import Dodge.WorldEvent import Dodge.Debug import Dodge.WallCreatureCollisions import Dodge.Default 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 $ destroyOnImpact 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 = defaultItZoom , _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 = defaultItZoom {_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) . torqueBefore 0.05 $ autoGunNonTwistEff singleFireMode = shootWithSound (fromIntegral autoGunSound) . torqueAfter 0.03 $ autoGunNonTwistEff autoGunNonTwistEff = withRecoil 40 . withRandomDir (autogunSpread/2) . withMuzFlare . withVelWthHiteff (50,0) 3 $ destroyOnImpact 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 = defaultItZoom , _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 = shootWithSound (fromIntegral launcherSound) $ aRocketWithPayload makeExplosionAt , _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 } flameLauncher = launcher { _itName = "FLROCKO" , _wpFire = shootWithSound (fromIntegral launcherSound) $ aRocketWithPayload makeFlameExplosionAt } poisonLauncher = launcher { _itName = "POISROCK" , _wpFire = shootWithSound (fromIntegral launcherSound) $ aRocketWithPayload makePoisonExplosionAt } teslaLauncher = launcher { _itName = "TESLROCK" , _wpFire = shootWithSound (fromIntegral launcherSound) $ aRocketWithPayload makeTeslaExplosionAt } bezierGun = defaultAutoGun { _itName = "B-GUN" , _wpFire = maybeSetTarget $ \p -> shootWithSound 0 . withMuzFlare . withRecoil 40 . torqueBefore 0.05 -- I believe that this doesn't affect $ shootBezier p -- <- the start point , _itAttachment = Nothing , _itScrollUp = removeItAttachment 0 , _itScrollDown = removeItAttachment 0 , _itHammer = HammerUp , _itEffect = bezierRecock , _itZoom = defaultItZoom , _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 = over particles' (theBullet :) w where theBullet = aCurveBulAt (Just cid) white startp (controlp +.+ randPos) (targetp +.+ randPos') (destroyOnImpact bulHitCr' bulHitWall' bulHitFF') 5 controlp = mouseWorldPos w cr = _creatures w IM.! cid dir = _crDir cr startp = _crPos cr +.+ rotateV dir (_crRad cr + 1,0) (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 $ penWalls 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 . withSidePush 50 . 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 = defaultItZoom , _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 $ destroyOnImpact bulBounceArmCr' bulHitWall' bulHitFF' , _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) 5 bulletEffect' , _wpSpread = spreadGunSpread , _wpRange = 20 , _itFloorPict = onLayer FlItLayer $ multGunPic , _itAmount = 1 , _itMaxStack = 1 , _itAimingSpeed = 0.4 , _itAimingRange = 1 , _itZoom = defaultItZoom {_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 $ penWalls 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 = defaultItZoom {_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 = defaultItZoom , _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 = defaultItZoom {_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 = teslaGunFlashAt (pos +.+ 5 *.* unitVectorAtAngle dir) $ over projectiles (IM.insert i (makeTeslaArcAt i pos dir)) $ set randGen g w where cr = (_creatures w IM.! cid) i = newProjectileKey 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 $ laserGunFlashAt (pos +.+ 5 *.* unitVectorAtAngle dir) w where cr = (_creatures w IM.! cid) i = newProjectileKey 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 projectiles (IM.insert i (tractorBeamAt col i pos dir)) w where i = newProjectileKey w cr = (_creatures w IM.! cid) pos = _crPos cr +.+ ((_crRad cr +10) *.* unitVectorAtAngle dir) dir = _crDir cr itRef = _crInvSel cr aRocketWithPayload :: (Point2 -> World -> World) -- ^ Payload -> Int -- ^ Creature id -> World -> World aRocketWithPayload pl cid w = over projectiles (IM.insert i theShell) w where i = newProjectileKey w cr = (_creatures w IM.! cid) pos = _crPos cr +.+ ((_crRad cr +1) *.* unitVectorAtAngle dir) dir = _crDir cr theShell = makeShellAt pl i cid pos dir makeShellAt :: (Point2 -> World -> World) -- ^ Payload -> Int -- ^ Projectile id -> Int -- ^ Creature id -> Point2 -- ^ Start position -> Float -- ^ Direction -> Projectile makeShellAt pl i cid pos dir = Shell { _pjPos = pos , _pjStartPos = pos , _pjVel = rotateV dir (1,0) , _pjPict = blank , _pjID = i , _pjUpdate = moveShell 50 i cid 0 (rotateV dir (3,0)) , _pjPayload = pl } moveShell :: Int -- ^ Timer (frames) -> Int -- ^ Projectile id -> Int -- ^ Creature id -> Float -- ^ Rotation -> Point2 -- ^ Acceleration -> World -> World moveShell time i cid rot accel w | time > 40 = if circOnSomeWall oldPos 4 w then doExplode else w & projectiles . ix i . pjPos %~ (+.+ vel) & projectiles . ix i . pjPict .~ piclow & projectiles . ix i . pjUpdate .~ moveShell (time-1) i cid rot (rotateV rot accel) | isJust thingHit = doExplode | time == 35 = w & projectiles . ix i . pjPos %~ (+.+ vel) & projectiles . ix i . pjPict .~ pic & projectiles . ix i . pjUpdate .~ moveShell (time-1) i cid spin accel | time >= 20 = w & projectiles . ix i . pjPos %~ (+.+ vel) & projectiles . ix i . pjPict .~ pic & projectiles . ix i . pjUpdate .~ moveShell (time-1) i cid rot (rotateV rot accel) | time > -99 = w & projectiles . ix i . pjPos %~ (+.+ vel) & randGen .~ g & projectiles . ix i . pjPict .~ pic & projectiles . ix i . pjUpdate .~ (moveShell (time-1) i cid rot (rotateV rot accel)) & projectiles . ix i . pjVel %~ (\v -> accel +.+ frict *.* v) & soundFromPos (ShellSound i) newPos (fromIntegral smokeTrailSound) (1) 250 & makeFlameletTimed (oldPos -.- vel) (vel +.+ rotateV (pi+sparkD) accel) Nothing 3 10 & smokeGen | time > -200 = w & projectiles . ix i . pjPos %~ (+.+ vel) & projectiles . ix i . pjPict .~ pic & projectiles . ix i . pjUpdate .~ moveShell (time-1) i cid rot (rotateV rot accel) | otherwise = doExplode where doExplode = w & projectileExplosion oldPos & stopSoundFrom (ShellSound i) & projectiles %~ IM.delete i pj = _projectiles w IM.! i oldPos = _pjPos pj vel = _pjVel pj projectileExplosion = _pjPayload pj newPos = oldPos +.+ vel (frict,g) = randomR (0.6,0.9) $ _randGen w (sparkD,_) = randomR (-0.2,0.2) $ _randGen w 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.2 $ max (-0.2) $ (normalizeAnglePi (dir - _crDir cr)) / 20 _ -> 0 r1 = _randGen w & evalState (randInCirc 10) smokeGen = makeSmokeCloudAt (oldPos +.+ r1 +.+ 30 *.* (normalizeV (oldPos -.- newPos))) 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 -> Projectile tractorBeamAt colID i pos dir = Projectile { _pjPos = pos , _pjStartPos = p' , _pjVel = d , _pjPict = blank , _pjID = i , _pjUpdate = updateTractor colID 10 i } where d = unitVectorAtAngle dir p' = pos +.+ 400 *.* d aGasCloud :: Int -> World -> World aGasCloud cid w = 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) +.+ 10 *.* unitVectorAtAngle dir insertCloud = makeGasCloud pos vel -- . makeFlame pos2 vel (Just cid) aFlame :: Float -> Int -> World -> World aFlame a cid w = shakeCr cid 2 $ insertFlame $ resetAngle $ set randGen g $ w where (a2,g) = randomR (-0.1,0.1) (_randGen w) (t,_) = randomR (99,101) (_randGen w) angle = min flamerAngle $ max (-flamerAngle) (a + a2) cr = (_creatures w IM.! cid) dir = _crDir cr + angle pos = _crPos cr +.+ ((_crRad cr + 2.9) *.* unitVectorAtAngle (_crDir cr)) w1 = set randGen g w vel = (_crPos cr -.- _crOldPos cr) +.+ 4 *.* unitVectorAtAngle dir insertFlame = makeFlame t pos vel (Just cid) -- . makeFlame pos2 vel (Just cid) resetAngle = set (creatures . ix cid . crInv . ix (_crInvSel cr) . wpFire) (shoot $ aFlame angle) 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 projectiles (IM.delete pID) $ explosion (_pjPos (_projectiles w IM.! pID)) -- set (pointToItem (_itemPositions w IM.! wpID) . itEquipPict) -- (drawWeapon $ grenadePic 50) w where pj = _projectiles w IM.! pID explosion = _pjPayload pj moveGrenade time dir pID w = case hitWl of Just _ -> soundOnce (fromIntegral tapQuiet) updatedWorld _ -> updatedWorld where updatedWorld = updateV $ set (projectiles . ix pID . pjPos) finalPos $ set (projectiles .ix pID.pjPict) (onLayer PtLayer $ uncurry translate newPos $ rotate dir $ grenadePic time) $ set (projectiles .ix pID.pjUpdate) (moveGrenade (time-1) dir pID) w pj = _projectiles w IM.! pID oldPos = _pjPos pj newPos = _pjVel pj +.+ oldPos hitWl = collideCircWalls' oldPos newPos 4 $ wallsNearPoint newPos w finalPos = fromMaybe newPos (fmap fst hitWl) setV v = set (projectiles .ix pID.pjVel) 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 pjid w = set (pointToItem (_itemPositions w IM.! itid) . itAttachment . _Just . scopePos) (0,0) $ set (pointToItem (_itemPositions w IM.! itid) . wpFire) fireRemoteLauncher (w & projectiles %~ IM.delete pjid) retireRemoteRocket itid t pjid w = setScope w & projectiles . ix pjid . pjUpdate .~ retireRemoteRocket itid (t-1) pjid 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 ^? projectiles . ix pjid . pjPos retireRemoteBomb :: Int -> Int -> Int -> World -> World retireRemoteBomb itid 0 pjid w = set (pointToItem (_itemPositions w IM.! itid) . itAttachment . _Just . scopePos) (0,0) $ set (pointToItem (_itemPositions w IM.! itid) . itZoom) defaultItZoom $ set (pointToItem (_itemPositions w IM.! itid) . twFire) throwRemoteBomb (w & projectiles %~ IM.delete pjid) retireRemoteBomb itid t pjid w = setScope w & projectiles . ix pjid . pjUpdate .~ retireRemoteBomb itid (t-1) pjid 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 ^? projectiles . ix pjid . pjPos moveRemoteBomb :: Int -> Int -> Int -> World -> World moveRemoteBomb itid time pID w | time < -4 = setScope $ updatePicture $ set (projectiles .ix pID.pjUpdate) (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 (projectiles . ix pID . pjPos) finalPos $ updatePicture $ set (projectiles .ix pID.pjUpdate) (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 .~ (defaultItZoom {_itAimZoomMax = 0.5, _itAimZoomMin = 0.5}) _ -> w' pj = _projectiles w IM.! pID oldPos = _pjPos pj newPos = _pjVel pj +.+ oldPos -- this is hacky, should use a version of collidePointWalls' that collides -- circles and walls invShift x = x -.- 5 *.* normalizeV (_pjVel pj) hitWl = collideCircWalls' oldPos newPos 4 $ wallsNearPoint newPos w finalPos = fromMaybe newPos (fmap (invShift . fst) hitWl) setV v = set (projectiles .ix pID.pjVel) v updateV = fromMaybe id (fmap (setV.snd) hitWl) halfV = over (projectiles . ix pID . pjVel) (\v -> 0.5 *.* v) f x | x < -369 = -10 | otherwise = x - 1 updatePicture = set (projectiles . ix pID.pjPict) (onLayer PtLayer $ uncurry translate newPos $ remoteBombPic time) . lowLightDirected (withAlpha 0.1 red) 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 makeLaserAt :: Float -> Point2 -> Float -> Maybe Int -> Particle' makeLaserAt phaseV pos dir mcid = Particle' { _ptDraw = const 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 {_ptDraw = const $ 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 19 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 = defaultItZoom {_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 flameGrenade :: Item flameGrenade = grenade { _itName = "FLMGREN " ++ show fuseTime , _twFire = throwGrenade' makeFlameExplosionAt fuseTime } where fuseTime = 50 f x = 50 / fromIntegral x teslaGrenade :: Item teslaGrenade = grenade { _itName = "TLSGREN " ++ show fuseTime , _twFire = throwGrenade' makeTeslaExplosionAt 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 .~ (defaultItZoom {_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 .~ (defaultItZoom {_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' :: (Point2 -> World -> World) -> Int -> Int -> World -> World throwGrenade' explosion fuseTime n w = setWp $ removePict $ over projectiles addG $ set randGen g w where addG = IM.insert i $ Shell { _pjPos = p , _pjStartPos = p , _pjVel = v , _pjPict = onLayer PtLayer $ uncurry translate p $ grenadePic 0 , _pjID = i , _pjUpdate = moveGrenade fuseTime dir i , _pjPayload = explosion } j = _crInvSel $ _creatures w IM.! n removePict = set (creatures . ix n . crInv . ix j . itEquipPict) $ \ _ _ -> blank i = newProjectileKey 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 throwGrenade :: Int -> Int -> World -> World throwGrenade = throwGrenade' makeExplosionAt 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 projectiles remRocket w where i = newKey $ _projectiles w cr = _creatures w IM.! cid dir = _crDir cr pos = _crPos cr +.+ rotateV dir (_crRad cr + 1,0) remRocket = IM.insert i $ Projectile { _pjPos = pos , _pjStartPos = pos , _pjVel = rotateV dir (1,0) , _pjPict = blank , _pjID = i , _pjUpdate = 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 (projectiles . ix i . pjPos) (+.+ vel) $ set (projectiles . ix i . pjPict) piclow $ set (projectiles . ix i . pjUpdate) (moveRemoteShell (time-1) i cid itid newdir) $ setScope w | time >= 20 = case thingHit of Just p -> doExplosion w Nothing -> over (projectiles . ix i . pjPos) (+.+ vel) $ set (projectiles . ix i . pjPict) pic $ set (projectiles . ix i . pjUpdate) (moveRemoteShell (time-1) i cid itid newdir) $ setScope w | time > -99 = case thingHit of Just p -> doExplosion $ stopSoundFrom (ShellSound i) w Nothing -> over (projectiles . ix i . pjPos) (+.+ vel) $ set randGen g $ set (projectiles . ix i . pjPict) pic $ set (projectiles . ix i . pjUpdate) (moveRemoteShell (time-1) i cid itid newdir) $ over (projectiles . ix i . pjVel) (\v -> accel +.+ frict *.* v) $ soundFromPos (ShellSound i) newPos (fromIntegral smokeTrailSound) (1) 250 $ smokeGen $ makeFlameletTimed oldPos (0.5 *.* rotateV (pi+sparkD) accel) Nothing 3 10 $ setScope w | time > -200 = case thingHit of Just p -> doExplosion $ stopSoundFrom (ShellSound i) w Nothing -> over (projectiles . ix i . pjPos) (+.+ vel) $ set (projectiles . ix i . pjPict) pic $ set (projectiles . ix i . pjUpdate) (moveRemoteShell (time-1) i cid itid newdir) $ setScope w | otherwise = doExplosion $ stopSoundFrom (ShellSound i) w where pj = _projectiles w IM.! i oldPos = _pjPos pj vel = _pjVel pj newPos = oldPos +.+ vel newdir | SDL.ButtonRight `S.member` (_mouseButtons w) && w ^? creatures . ix cid . crInvSel == w ^? itemPositions . ix itid . itInvId = _cameraRot w + (argV $ _mousePos w) | otherwise = dir accel = rotateV newdir (2,0) (frict,g) = randomR (0.6,0.9) $ _randGen w (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 r1 = _randGen w & evalState (randInCirc 10) smokeGen = makeSmokeCloudAt (oldPos +.+ r1 +.+ 30 *.* (normalizeV (oldPos -.- newPos))) 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 pjid n w = set (projectiles . ix pjid . pjUpdate) (retireRemoteRocket itid 30 pjid) $ set (projectiles . ix pjid . pjPict) blank $ set (itPoint . wpFire) (flip const) $ resetName $ makeExplosionAt (_pjPos (_projectiles w IM.! pjid)) w where resetName = set (itPoint . itName) "REMOTELAUNCHER" itPoint = pointToItem $ _itemPositions w IM.! itid throwRemoteBomb :: Int -> World -> World throwRemoteBomb n w = setLocation $ removePict $ resetFire $ resetName $ over projectiles addG w where addG = IM.insert i $ Projectile { _pjPos = p , _pjStartPos = p , _pjVel = v , _pjPict = blank , _pjID = i , _pjUpdate = moveRemoteBomb itid 50 i } i = newProjectileKey w -- fireDist = zoom *.* (rotateV (_cameraRot w) (_mousePos w) +.+ _cameraCenter 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 pjid n w = set (projectiles . ix pjid . pjUpdate) (retireRemoteBomb itid 30 pjid) $ set (projectiles . ix pjid . pjPict) blank $ set (creatures . ix n . crInv . ix j . twFire) (flip const) $ resetName $ resetPict -- $ resetScope $ makeExplosionAt (_pjPos (_projectiles w IM.! pjid)) w -- - $ makeShrapnelBombAt (_pjPos (_projectiles w IM.! pjid)) 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 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 = defaultEquipment { _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 = defaultEquipment { _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 = defaultEquipment { _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 = defaultEquipment { _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 } -- }}} 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 projectiles (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 = newProjectileKey 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 (projectiles . ix i . pjUpdate) (updateTractor colID (time-1) i) $ set (projectiles . ix i . pjPict) pic $ over creatures (IM.map tractCr) $ over floorItems (IM.map tractFlIt) w | otherwise = over projectiles (IM.delete i) w where tractCr cr | circOnSeg 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 | circOnSeg 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 pj = _projectiles w IM.! i q = _pjVel pj p1 = _pjPos pj p' = _pjStartPos pj 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 = defaultItZoom {_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 = defaultItZoom {_itAimZoomMax = 1, _itZoomMax = 1} , _itEquipPict = drawWeapon $ color blue $ polygon $ rectNESW 5 5 (-5) (-5) } aSonarPulse :: Int -> World -> World aSonarPulse cid w = over particles' ((:) $ sonarPulseAt (_crPos (_creatures w IM.! cid))) w aRadarPulse :: Int -> World -> World aRadarPulse cid w = over particles' ((:) $ radarPulseAt (_crPos (_creatures w IM.! cid))) w blipAt :: Point2 -> Color -> Int -> Particle' blipAt p col i = Particle' {_ptDraw = const blank ,_ptUpdate' = mvBlip p col i i } mvBlip :: Point2 -> Color -> Int -> Int -> World -> Particle' -> (World, Maybe Particle') mvBlip p col maxt 0 w pt = (w, Nothing) mvBlip p col maxt t w pt = (w, Just $ pt & ptUpdate' .~ mvBlip p col maxt (t-1) & ptDraw .~ (const . setDepth (-0.5) . setLayer 1 $ uncurry translate p $ color (withAlpha (fromIntegral t / fromIntegral maxt) col) $ circleSolid 2) ) sonarPulseAt :: Point2 -> Particle' sonarPulseAt p = Particle' { _ptDraw = const blank , _ptUpdate' = mvSonar 100 p } mvSonar :: Int -> Point2 -> World -> Particle' -> (World, Maybe Particle') mvSonar 0 _ w _ = (w, Nothing) mvSonar x p w pt = (w, Just $ pt {_ptDraw = const pic ,_ptUpdate' = mvSonar (x-1) p } ) where pic = setDepth (-0.5) . setLayer 1 $ pictures -- $ sweepPics ++ crBlips -- ++ wallBlips crBlips = mapMaybe crBlip $ IM.elems $ _creatures w crBlip cr | dist cpos p < r + crad && dist cpos p > r - (crad + 100) = Just $ colHelper (0.5 * (1 - (r - dist cpos p) /100)) $ uncurry translate cpos $ circleSolid crad | otherwise = Nothing where crad = _crRad cr cpos = _crPos cr r = fromIntegral (500 - x*5) sweepPics = [colHelper 0.05 $ uncurry translate p $ thickCircle r 5 -- ,colHelper 0.3 $ uncurry translate p $ thickCircle (r-5) 5 -- ,colHelper 0.1 $ uncurry translate p $ thickCircle (r-10) 5 ] globalAlpha | x > 10 = 1 | otherwise = fromIntegral x / 10 colHelper y = color (withAlpha (y * globalAlpha) green) -- wallBlips radarPulseAt :: Point2 -> Particle' radarPulseAt p = Particle' { _ptDraw = const blank , _ptUpdate' = mvRadar 50 p } mvRadar :: Int -> Point2 -> World -> Particle' -> (World, Maybe Particle') mvRadar 0 _ w _ = (w, Nothing) mvRadar x p w pt = (putBlips w, Just $ pt {_ptDraw = const pic ,_ptUpdate' = mvRadar (x-1) p } ) where pic = onLayerL [levLayer ShadowLayer, 1] $ pictures $ sweepPics putBlips = over worldEvents ((.) $ over particles' ((++) blips)) blips = map (\p -> blipAt p (withAlpha (0.5*globalAlpha) red) 50) $ circPoints circPoints = mapMaybe (\wl -> collidePointCircCorrect (_wlLine wl !! 0) (_wlLine wl !! 1) r p) $ (map (over wlLine reverse) $ IM.elems $ wallsAlongCirc p r w) ++ (IM.elems $ wallsAlongCirc p r w) r = fromIntegral (800 - x*16) sweepPics = [--colHelper 0.1 $ uncurry translate p $ thickCircle r 15 --,colHelper 0.06 $ uncurry translate p $ thickCircle (r-5) 5 --,colHelper 0.03 $ uncurry translate p $ thickCircle (r-10) 5 ] globalAlpha | x > 10 = 1 | otherwise = fromIntegral x / 10 colHelper y = color (withAlpha (y * globalAlpha) red) autoSonar = defaultEquipment { _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 = defaultItZoom {_itAimZoomMax = 1, _itZoomMax = 1} } autoRadar = defaultEquipment { _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 = defaultItZoom {_itAimZoomMax = 1, _itZoomMax = 1} } autoRadarEffect :: ItEffect autoRadarEffect = ItInvEffect {_itInvEffect = f 50 ,_itEffectCounter = 0 } where f 0 cr i w = aRadarPulse (_crID cr) w & creatures . ix (_crID cr) . crInv . ix i . itEffect . itInvEffect .~ f 100 f t cr i w = w & creatures . ix (_crID cr) . crInv . ix i . itEffect . itInvEffect .~ f (t-1) autoSonarEffect :: ItEffect autoSonarEffect = ItInvEffect {_itInvEffect = f 50 ,_itEffectCounter = 0 } where f 0 cr i w = aSonarPulse (_crID cr) w & creatures . ix (_crID cr) . crInv . ix i . itEffect . itInvEffect .~ f 140 f t cr i w = w & creatures . ix (_crID cr) . crInv . ix i . itEffect . itInvEffect .~ f (t-1) itemLaserScopeEffect :: ItEffect itemLaserScopeEffect = ItInvEffect {_itInvEffect = f ,_itEffectCounter = 0 } where f cr invid w | invid == _crInvSel cr = w & particles' %~ (:) (makeLaserScope sp ep d reloadFrac) & creatures . ix (_crID cr) . crInv . ix invid . itHammer %~ moveHammerUp & laserScopeTargetGlow col glowPoint -- this flare MAY be buggy... something to do with the creature glare | otherwise = w where p = _crPos cr d = _crDir cr r = _crRad cr sp = (p +.+ (r + 3) *.* unitVectorAtAngle d) xp = sp +.+ 3000 *.* unitVectorAtAngle d ep = case listToMaybe $ thingsHitLongLine sp xp w of Just (p,_) -> p Nothing -> xp glowPoint = case listToMaybe $ thingsHitLongLine sp xp w of Just (p,E3x2 wl) -> p +.+ 2 *.* wallNormal wl _ -> (ep -.- 2 *.* unitVectorAtAngle d) it = (cr ^. crInv) IM.! invid reloadFrac | _wpLoadedAmmo it == 0 = 1 | otherwise = fromIntegral (_wpReloadState it) / fromIntegral (_wpReloadTime it) col = mixColors reloadFrac (1-reloadFrac) red green moveHammerUp !HammerDown = HammerReleased moveHammerUp !_ = HammerUp makeLaserScope :: Point2 -> Point2 -> Float -> Float -> Particle' makeLaserScope p ep d relFrac = Particle' {_ptDraw = const $ onLayer PtLayer $ pictures [color (withAlpha 0.5 $ mixColors relFrac (1-relFrac) red green) $ lineOfThickness 0.5 [p,ep] ,color (withAlpha 0.2 $ mixColors relFrac (1-relFrac) red green) $ lineOfThickness 1.5 [p,ep] ,color (withAlpha 0.1 $ mixColors relFrac (1-relFrac) red green) $ lineOfThickness 2 [p,ep] ] ,_ptUpdate' = \w pt -> (w, Just $ pt & ptUpdate' .~ \w' _ -> (w',Nothing)) } spawnGun :: Creature -> Item spawnGun cr = defaultGun { _itName = "SPAWNER" , _wpMaxAmmo = 1 , _wpLoadedAmmo = 1 , _wpReloadTime = 80 , _wpReloadState = 0 , _wpFireRate = 100 , _wpFire = spawnCrNextTo cr } spawnCrNextTo :: Creature -> Int -> World -> World spawnCrNextTo cr i w = w & creatures %~ IM.insert k newCr where k = newKey $ _creatures w sCr = _creatures w IM.! i newCr = cr & crID .~ k & crPos .~ _crPos sCr +.+ unitVectorAtAngle (_crDir sCr) & crOldPos .~ _crPos sCr +.+ unitVectorAtAngle (_crDir sCr)