{-# LANGUAGE BangPatterns #-} module Dodge.Weapons where -- imports {{{ import Dodge.Data import Dodge.Base import Dodge.SoundLogic import Dodge.CreatureActions import Dodge.RandomHelp import Dodge.WorldActions import Dodge.Debug import Dodge.WallCreatureCollisions import Dodge.Prototypes import Geometry import Picture import Data.List import Data.Char import Data.Maybe import Data.Function --import Data.Graph.Inductive.Graph --import Data.Graph.Inductive.PatriciaTree --import Codec.BMP 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 , _wpAmmoType = PistolBullet , _wpReloadTime = 40 , _wpReloadState = 0 , _wpFireRate = 8 , _wpFireState = 0 , _wpFire = shootWithSound 0 $ withAccVelWthHiteff' 0.1 (30,0) 2 -- $ threeEff' bulIncCr' bulIncWall' bulHitFF' $ 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 basicWeaponDisplay :: Item -> String basicWeaponDisplay it = _itName it ++ " " ++ aIfLoaded ++ "/" ++ availableAmmo where availableAmmo = show $ _wpMaxAmmo it -- availableAmmo = if _unlimitedAmmo w -- then show $ _wpMaxAmmo it -- else show $ case _crAmmo (you w) M.!? _wpAmmoType it of -- Nothing -> 0 -- Just x -> x aIfLoaded = case (_wpReloadState it) of 0 -> show $ _wpLoadedAmmo it x -> "R" ++ show x effectGun :: String -> (Int -> World -> World) -> Item effectGun name eff = defaultGun { _itName = name ++ "Gun" , _wpFire = eff } autoEffectGun :: String -> (Int -> World -> World) -> Item autoEffectGun name eff = autoGun { _itName = name ++ "Gun" , _wpFire = eff } autoGun = defaultGun { _itName = "autoGun .........." , _itIdentity = AutoGun , _wpMaxAmmo = 30 , _wpLoadedAmmo = 30 , _wpAmmoType = PistolBullet , _wpReloadTime = 80 , _wpReloadState = 0 -- , _wpFireRate = 6 , _wpFireRate = 5 , _wpFireState = 0 , _wpFire = autoFireMode , _wpSpread = autogunSpread , _wpRange = 20 , _itHammer = NoHammer , _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 } autoFireMode = shootWithSound (fromIntegral autoGunSound) $ withRecoil 40 $ torqueBefore 0.05 $ withAccVelWthHiteff' (autogunSpread/2) (50,0) 3 $ threeEff' bulHitCr' bulHitWall' bulHitFF' singleFireMode = shootWithSound (fromIntegral autoGunSound) $ withRecoil 40 $ torqueAfter 0.03 $ withAccVelWthHiteff' (autogunSpread/2) (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 . itName .~ "autoGun .........." & 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 . itName .~ "autoGun ." & 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 = " ." g 2 = " ..." g 0 = " .........." rezGun = defaultGun { _itName = "reanimator" , _wpMaxAmmo = 50 , _wpLoadedAmmo = 50 , _wpAmmoType = Battery , _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 = autoGun { _itName = "teslaGun" , _itIdentity = TeslaGun , _wpMaxAmmo = 200 , _wpLoadedAmmo = 200 , _wpAmmoType = Battery , _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 = autoGun { _itName = "lasGun ////" , _itIdentity = LasGun , _wpMaxAmmo = 200 , _wpLoadedAmmo = 200 , _wpAmmoType = Battery , _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 } incPhaseV :: Int -> World -> World incPhaseV _ w = w & creatures . ix 0 . crInv . ix itRef . itAttachment . _Just . itPhaseV %~ f & creatures . ix 0 . crInv . ix itRef . itName .~ "lasGun" ++ g newPhaseV 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.5 f 0.5 = 1 f 1 = 2 f 2 = 5 f 5 = 5 g 0.2 = " //\\\\" g 0.5 = " ///\\" g 1 = " ////" g 2 = " \\///" g 5 = " \\\\//" decPhaseV :: Int -> World -> World decPhaseV _ w = w & creatures . ix 0 . crInv . ix itRef . itAttachment . _Just . itPhaseV %~ f & creatures . ix 0 . crInv . ix itRef . itName .~ "lasGun" ++ g newPhaseV 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.5 f 2 = 1 f 5 = 2 g 0.2 = " //\\\\" g 0.5 = " ///\\" g 1 = " ////" g 2 = " \\///" g 5 = " \\\\//" forceFieldGun = defaultGun { _itName = "forceField" , _itIdentity = ForceFieldGun , _wpMaxAmmo = 100 , _wpLoadedAmmo = 100 , _wpAmmoType = Battery , _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 -- , _wpAmmoType = Battery -- , _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 = autoGun { _itName = "tractorGun" , _itIdentity = TractorGun , _wpMaxAmmo = 10000 , _wpLoadedAmmo = 10000 , _wpAmmoType = Battery , _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 = "launcher" , _itIdentity = Launcher , _wpMaxAmmo = 30 , _wpLoadedAmmo = 30 , _wpAmmoType = Shell , _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 } remoteLauncher = defaultGun { _itName = "remoteLauncher" , _itIdentity = RemoteLauncher , _wpMaxAmmo = 1 , _wpLoadedAmmo = 1 , _wpAmmoType = Shell , _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 = autoGun { _itName = "hvMachineGun" , _itIdentity = HvAutoGun , _wpMaxAmmo = 100 , _wpLoadedAmmo = 100 , _wpAmmoType = PistolBullet , _wpReloadTime = 200 , _wpReloadState = 0 , _wpFireRate = 25 , _wpFireState = 0 , _wpFire = rateIncAB 24 12 (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 $ withAccVelWthHiteff' 0 (80,0) 6 $ threeEff' hvBulHitCr' hvBulHitWall' bulHitFF' ltAutoGun = autoGun { _itName = "autoPistol" , _itIdentity = LtAutoGun , _wpMaxAmmo = 25 , _wpLoadedAmmo = 25 , _wpAmmoType = PistolBullet , _wpReloadTime = 80 , _wpReloadState = 0 , _wpFireRate = 4 , _wpFireState = 0 , _wpFire = shootWithSound 0 $ withAccVelWthHiteff' 0.3 (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 = autoGun { _itName = "miniGun" , _itIdentity = MiniGun , _wpMaxAmmo = 150 , _wpLoadedAmmo = 150 , _wpAmmoType = PistolBullet , _wpReloadTime = 200 , _wpReloadState = 0 , _wpFireRate = 2 , _wpFireState = 0 , _wpFire = withWarmUp 50 $ torqueBefore 0.03 $ withSidePush 50 $ withRecoil 15 $ withOffsetAccVelWthHiteff' 9 0.1 (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 = "spreadgun" , _itIdentity = SpreadGun , _wpMaxAmmo = 5 , _wpLoadedAmmo = 5 , _wpAmmoType = PistolBullet , _wpReloadTime = 80 , _wpReloadState = 0 , _wpFireRate = 20 , _wpFireState = 0 , _wpFire = shootWithSound (fromIntegral shotgunSound) $ withRecoil 100 $ 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 -- , _wpAmmoType = PistolBullet -- , _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 , _wpAmmoType = PistolBullet , _wpReloadTime = 40 , _wpReloadState = 0 , _wpFireRate = 20 , _wpFireState = 0 , _wpFire = shootWithSound (fromIntegral shotgunSound) $ withRecoil 200 $ 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 = "elephantGun" , _itIdentity = LongGun , _wpMaxAmmo = 1 , _wpLoadedAmmo = 1 , _wpAmmoType = PistolBullet , _wpReloadTime = 80 , _wpReloadState = 0 , _wpFireRate = 100 , _wpFireState = 0 , _wpFire = shootWithSound (fromIntegral longGunSound) $ withThickSmoke $ torqueAfter 0.05 $ withAccVelWthHiteff' 0 (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 = autoGun { _itName = "poisonSprayer" , _itIdentity = PoisonSprayer , _wpMaxAmmo = 500 , _wpLoadedAmmo = 500 , _wpAmmoType = LiquidFuel , _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 = autoGun { _itName = "flamethrower" , _itIdentity = Flamethrower , _wpMaxAmmo = 250 , _wpLoadedAmmo = 250 , _wpAmmoType = LiquidFuel , _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 , _wpAmmoType = Battery , _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 } withWarmUp :: Int -> (Int -> World -> World) -> Int -> World -> World withWarmUp t f cid w | reloadCondition = fromMaybe w $ reloadWeapon cid w | _wpReloadState item /= 0 = w | fState == 0 = set (pointerToItem . wpFire) (withWarmUp 100 f) $ set (pointerToItem . wpFireState) 2 w | t > 1 = set (pointerToItem . wpFire) (withWarmUp (t-1) f) $ set (pointerToItem . wpFireState) 2 $ soundFrom (CrWeaponSound cid) 26 1 0 w | t > 0 = set (pointerToItem . wpFire) (withWarmUp (t-1) f) $ set (pointerToItem . wpFireState) 2 w -- | otherwise = set (pointerToItem . wpFire) (withWarmUp 0 f) | otherwise = set (pointerToItem . wpFire) (withWarmUp 1 f) $ over (pointerToItem . wpLoadedAmmo) (\ammo -> ammo-1) $ set (pointerToItem . wpFireState) 2 $ f cid $ continueSoundFrom (CrWeaponSound cid) 28 2 0 w where cr = _creatures w IM.! cid itRef = _crInvSel cr item = _crInv cr IM.! itRef pointerToItem = creatures . ix cid . crInv . ix itRef fState = _wpFireState item fRate = _wpFireRate item reloadCondition = _wpLoadedAmmo item == 0 -- rotC = case cid of 0 -> fst $ randomR (-0.03,0.03) (_randGen w) -- _ -> 0 withSound :: Int -> (Int -> World -> World) -> Int -> World -> World withSound soundid f cid = soundOnce soundid . f cid withRecoil :: Float -> (Int -> World -> World) -> Int -> World -> World withRecoil recoilAmount eff cid w = eff cid . over (creatures . ix cid) pushback $ w where pushback cr = over crPos -- where pushback cr = colCrWall w $ over crPos (+.+ rotateV (_crDir cr) ((-recoilAmount) / _crMass cr ,0)) cr withSidePush :: Float -> (Int -> World -> World) -> Int -> World -> World withSidePush maxSide eff cid w = eff cid . over (creatures . ix cid) push $ w where push cr = over crPos (+.+ rotateV (_crDir cr) (0,(pushAmount) / _crMass cr)) cr (pushAmount, _) = randomR (-maxSide,maxSide) $ _randGen w shootWithSound :: Int -> (Int -> World -> World) -> Int -> World -> World shootWithSound soundid f cid w | fireCondition = over (pointerToItem . wpLoadedAmmo) (\ammo -> ammo-1) $ soundOnce soundid $ set (pointerToItem . wpFireState) (_wpFireRate item) $ f cid w | reloadCondition = fromMaybe w $ reloadWeapon cid w | otherwise = w where cr = (_creatures w IM.! cid) itRef = _crInvSel cr item = _crInv cr IM.! itRef pointerToItem = creatures . ix cid . crInv . ix itRef fireCondition = _wpReloadState item == 0 && _wpFireState item == 0 && _wpLoadedAmmo item > 0 reloadCondition = _wpLoadedAmmo item == 0 shoot :: (Int -> World -> World) -> Int -> World -> World shoot f cid w | fireCondition = over (pointerToItem . wpLoadedAmmo) (\ammo -> ammo-1) $ set (pointerToItem . wpFireState) (_wpFireRate item) $ f cid w | reloadCondition = fromMaybe w $ reloadWeapon cid w | otherwise = w where cr = (_creatures w IM.! cid) itRef = _crInvSel cr item = _crInv cr IM.! itRef pointerToItem = creatures . ix cid . crInv . ix itRef fireCondition = _wpReloadState item == 0 && _wpFireState item == 0 && _wpLoadedAmmo item > 0 reloadCondition = _wpLoadedAmmo item == 0 aTeslaArc :: Int -> World -> World aTeslaArc cid w = aTeslaArc' cid $ soundFrom (CrWeaponSound cid) 25 1 0 w aTeslaArc' :: Int -> World -> World aTeslaArc' cid w = over particles (IM.insert i (makeTeslaArcAt i pos dir)) $ flareAt' cyan 0.03 0.1 (pos +.+ 5 *.* unitVectorAtAngle 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 $ 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 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 (-radToDeg (argV accel)) shellPic piclow = onLayerL [levLayer CrLayer - 2] $ uncurry translate newPos $ rotate (-radToDeg (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 spreadNumVelWthHiteff' :: Float -> Int -> Point2 -> Float -> HitEffect' -> Int -> World -> World spreadNumVelWthHiteff' spread num vel wth eff cid w = over particles' (newbuls ++) $ flip (foldr muzFlareAt) poss w where cr = _creatures w IM.! cid newbuls = zipWith3 (\pos d colid -> aGenBulAt' (Just cid) (numColor colid) pos (rotateV d vel) eff wth ) poss dirs colids pos' = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr) poss = map ((+.+) $ _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr)) $ evalState ((sequence . take num . repeat . randInCirc) 5) $ _randGen w dirs = map ((+) (_crDir cr)) $ zipWith (+) [-spread,-spread+(2*spread/(fromIntegral num))..] $ randomRs (0,spreadGunSpread/5) (_randGen w) colids = take num $ randomRs (0,11) (_randGen w) numVelWthHitEff' :: Int -> Point2 -> Float -> HitEffect' -> Int -> World -> World numVelWthHitEff' num vel wth eff cid w = over particles' (newbuls ++) $ flip (foldr muzFlareAt) (take num poss) w where cr = _creatures w IM.! cid newbuls = zipWith (\pos colid -> aGenBulAt' (Just cid) (numColor colid) pos (rotateV d vel) eff wth) poss colids d = _crDir cr poss = map (\o -> o +.+ pos) offsets maxOffset = fromIntegral num * 2.5 - 2.5 offsets = map (\y -> rotateV d (0,y)) [-maxOffset,5-maxOffset..] colids = take num $ randomRs (0,11) (_randGen w) pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle d pos2 = _crPos cr +.+ (2 * _crRad cr) *.* unitVectorAtAngle (_crDir cr) 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 ((.) $ lowLightRadAt orange 0.05 8 50 ep) damcrs , mvPt') (thing@(p,(E3x2 wl)):_) -> (hiteff thing damcrs, rfl wl p) _ -> (soundFrom Flame fireSound 2 500 -- adding reflective glare is too intensive for this laptop $ over worldEvents ((.) $ lowLightRadAt orange 0.05 8 50 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 -> 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 [ pic p' , piu p' , pi2 p' , glow p' ] pic p' = onLayerL [levLayer UPtLayer,6] $ uncurry translate (prot3 p') $ rotate (90 + (negate $ radToDeg $ argV rotd)) $ scale scaleChange 1 -- $ color white -- $ circleSolid 5 $ pictures [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' = onLayerL [levLayer UPtLayer,4] $ uncurry translate (prot p') -- $ rotate ( (fromIntegral time * 5)) $ rotate (90 + (negate $ radToDeg $ 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 [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' = onLayerL [levLayer UPtLayer,2] $ uncurry translate (prot2 p') $ rotate (90 + (negate $ radToDeg $ argV rotd)) -- $ rotate ((fromIntegral time * (-10))) $ scale (scaleChange + 1) 2 $ pictures [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' = onLayerL [levLayer UPtLayer,0] $ uncurry translate p' $ color (withAlpha 0.02 orange) $ circleSolid 50 pOut p = p +.+ safeNormalizeV (sp -.- p) --reflV wall = (0.6 *.* reflectIn (_wlLine wall !! 1 -.- _wlLine wall !! 0) -- vel ) -- +.+ -- (0.4 *.* vel) 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 withAccVelWthHiteff' :: Float -> Point2 -> Float -> HitEffect' -> Int -> World -> World withAccVelWthHiteff' acc vel width hiteff cid w = over particles' ((:) newbul) . over tempLightSources ((:) (tLightAt 4 pos)) . lowLightAt pos2 $ set randGen g w where cr = _creatures w IM.! cid newbul = aGenBulAt' (Just cid) (numColor colid) pos (rotateV dir vel) hiteff width (colid, g) = randomR (0,11) $ _randGen w (a, _) = randomR (-acc,acc) $ _randGen w dir = _crDir cr + a pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr) pos2 = _crPos cr +.+ (2 * _crRad cr) *.* unitVectorAtAngle (_crDir cr) withOffsetAccVelWthHiteff' :: Float -> Float -> Point2 -> Float -> HitEffect' -> Int -> World -> World withOffsetAccVelWthHiteff' offsetAmount acc vel width hiteff cid w = over particles' ((:) newbul ) $ muzFlareAt pos $ set randGen g w where cr = _creatures w IM.! cid newbul = aGenBulAt' (Just cid) (numColor colid) pos (rotateV dir vel) hiteff width (colid, g) = randomR (0,11) $ _randGen w (a, _) = randomR (-acc,acc) $ _randGen w dir = _crDir cr + a pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr) +.+ offset (offsetVal , _) = randomR (-offsetAmount,offsetAmount) $ _randGen w offset = rotateV (_crDir cr) (0,offsetVal) torqueBeforeForced :: Float -> (Int -> World -> World) -> Int -> World -> World torqueBeforeForced torque feff cid w | cid == 0 = feff cid $ set randGen g $ over (creatures . ix cid . crDir) (+rot') $ over cameraRot (+rot') w | otherwise = feff cid $ set randGen g $ over (creatures . ix cid . crDir) (+rot') w where (rot, g) = randomR (-torque,torque) $ _randGen w rot' | rot < 0 = rot - 0.1 | otherwise = rot + 0.1 torqueBefore :: Float -> (Int -> World -> World) -> Int -> World -> World torqueBefore torque feff cid w | cid == 0 = feff cid $ set randGen g $ over (creatures . ix cid . crDir) (+rot) $ over cameraRot (+rot) w | otherwise = feff cid $ set randGen g $ over (creatures . ix cid . crDir) (+rot) w where (rot, g) = randomR (-torque,torque) $ _randGen w torqueAfter :: Float -> (Int -> World -> World) -> Int -> World -> World torqueAfter torque feff cid w | cid == 0 = rotateScope $ set randGen g $ over cameraRot (+rot) $ feff cid w | otherwise = set randGen g $ over (creatures . ix cid . crDir) (+rot) $ feff cid w where (rot, g) = randomR (-torque,torque) $ _randGen w rotateScope w = w & creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0)) . itAttachment . _Just . scopePos %~ rotateV rot aGenBulAt' :: Maybe Int -> Color -> Point2 -> Point2 -> HitEffect' -> Float -> Particle' aGenBulAt' maycid col pos vel hiteff width = Bul' { _ptPict' = blank , _ptUpdate' = mvGenBullet' , _btVel' = vel , _btColor' = col , _btTrail' = [pos] , _btPassThrough' = maycid , _btWidth' = width , _btTimer' = 90 , _btHitEffect' = hiteff } -- bullet effects bulHitCr' :: Particle' -> Point2 -> Creature -> World -> World bulHitCr' bt p cr w = let sp = head $ _btTrail' bt ep = sp +.+ _btVel' bt -- mvDams = [TorqueDam 1 d1 , PushDam 1 $ 2 *.* (ep -.- sp) ] mvDams = [ PushDam 1 $ 2 *.* (ep -.- sp) ] addDamage = over (creatures . ix cid . crState . crDamage) (\dams -> (Piercing 100 sp p ep : mvDams) ++ dams) addDamageArmoured = over (creatures . ix cid . crState . crDamage) (\dams -> mvDams ++ dams) hitSound = soundMultiFrom [CrHitSound 0] 15 10 0 flashEff = over worldEvents ((.) $ flareAt red p) bulVel = ep -.- sp ck cid = (+.+) (crKnockBack cid *.* bulVel) crKnockBack cid = (/) 1 $ (+) 2 $ _crMass $ _creatures w IM.! cid hasArmour cr = any (\it -> it ^? itIdentity == Just FrontArmour) $ _crInv cr cid = _crID cr sID = newParticleKey w (d1,g) = randomR (-0.7,0.7) $ _randGen w (colID,_) = randomR (0,11) $ _randGen w hitEffect = addDamage . hitSound . flashEff $ w in case hasArmour cr of --shit this is ugly, to refactor True -> if hitBack then hitEffect else createSpark 8 colID p1 (argV (p -.- _crPos (_creatures w IM.! cid)) + d1) Nothing . addDamageArmoured $ w where cpos = _crPos $ _creatures w IM.! cid relHitPos = p -.- cpos hitBack = errorAngleVV 19 (unitVectorAtAngle (_crDir $ _creatures w IM.! cid)) relHitPos > pi/2 p1 = p +.+ 2 *.* safeNormalizeV relHitPos _ -> hitEffect bulPenCr' :: Particle' -> Point2 -> Creature -> World -> World bulPenCr' bt p cr w = over (creatures . ix cid . crState . crDamage) (\dams -> [Piercing 50 sp p ep ,Blunt 50 sp p ep ,TorqueDam 1 d1 ,PushDam 1 $ 3 *.* (ep -.- sp) ] ++ dams ) $ soundMultiFrom [CrHitSound 0] 15 10 0 $ over worldEvents addPiercer w where (d1,g) = randomR (-0.7,0.7) $ _randGen w cid = _crID cr sp = head $ _btTrail' bt ep = sp +.+ _btVel' bt addPiercer = (.) $ over particles' ((:) piercer) piercer = (aGenBulAt' (Just cid) (_btColor' bt) p (_btVel' bt) (_btHitEffect' bt) (_btWidth' bt) ) {_btTimer' = _btTimer' bt - 1} hvBulHitCr' :: Particle' -> Point2 -> Creature -> World -> World hvBulHitCr' bt p cr w = over (creatures . ix cid . crState . crDamage) (\dams -> [Piercing 200 sp p ep ,Blunt 100 sp p ep ,TorqueDam 1 d1 ,PushDam 1 $ 3 *.* (ep -.- sp) ] ++ dams ) $ soundMultiFrom [CrHitSound 0] 15 10 0 w where (d1,g) = randomR (-0.7,0.7) $ _randGen w cid = _crID cr sp = head $ _btTrail' bt ep = sp +.+ _btVel' bt bulIncCr' :: Particle' -> Point2 -> Creature -> World -> World bulIncCr' bt p cr w = over (creatures . ix cid . crState . crDamage) (\dams -> [Piercing 60 sp p ep ] ++ dams ) $ soundMultiFrom [CrHitSound 0] 15 10 0 $ incFlamelets w where cid = _crID cr sp = head $ _btTrail' bt ep = sp +.+ _btVel' bt v = evalState (randInCirc 1) $ _randGen w incFlamelets = over worldEvents $ (.) (makeFlamelet p v (levLayer UPtLayer) Nothing 3) bulConCr' :: Particle' -> Point2 -> Creature -> World -> World bulConCr' bt p cr w = over (creatures . ix cid . crState . crDamage) (\dams -> [Piercing 60 sp p ep ] ++ dams ) $ soundMultiFrom [CrHitSound 0] 15 10 0 $ mkwave w where cid = _crID cr sp = head $ _btTrail' bt ep = sp +.+ _btVel' bt mkwave = over worldEvents $ (.) (makeShockwaveAt p 15 4 1 white) bulHitWall' :: Particle' -> Point2 -> Wall -> World -> World bulHitWall' bt p x w = damageBlocks x $ createSpark 8 colID pOut (reflectDir x) Nothing $ set randGen g w where sp = head $ _btTrail' bt pOut = p +.+ safeNormalizeV (sp -.- p) (colID,g) = randomR (0,11) $ _randGen w (a, _) = randomR (-0.1,0.1) $ _randGen w spid = newKey $ _particles w reflectDir wall = a + (argV $ reflectIn (_wlLine wall !! 1 -.- _wlLine wall !! 0) (p -.- sp) ) damageBlocks wall w = case wall ^? blHP of Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 5)) w (_blIDs wall) _ -> w bulBounceWall' :: Particle' -> Point2 -> Wall -> World -> World bulBounceWall' bt p wl w = damageBlocks wl $ over worldEvents addBouncer -- yay for hack -- should have used this before? or never? w where sp = head $ _btTrail' bt pOut = p +.+ safeNormalizeV (sp -.- p) damageBlocks wall w = case wall ^? blHP of Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 5)) w (_blIDs wall) _ -> w bouncer = (aGenBulAt' Nothing (_btColor' bt) pOut reflectVel (_btHitEffect' bt) (_btWidth' bt) ) {_btTimer' = _btTimer' bt - 1} wallV = (_wlLine wl !! 1 -.- _wlLine wl !! 0) reflectVel = (reflectIn wallV (_btVel' bt)) addBouncer = (.) (over particles' ((:) bouncer)) -- the hack is to get around the fact that the particles' list gets reset after -- all particles in it are checked, so we cannot add to it as we accumulate over -- this list bulIncWall' :: Particle' -> Point2 -> Wall -> World -> World bulIncWall' bt p wl w = damageBlocks wl $ incFlamelets -- yay for hack -- should have used this before? or never? w where sp = head $ _btTrail' bt pOut = p +.+ safeNormalizeV (sp -.- p) damageBlocks wall w = case wall ^? blHP of Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 5)) w (_blIDs wall) _ -> w wallV = (_wlLine wl !! 1 -.- _wlLine wl !! 0) reflectVel = safeNormalizeV $ reflectIn wallV (_btVel' bt) incFlamelets = over worldEvents $ (.) (makeFlamelet pOut reflectVel (levLayer UPtLayer) Nothing 3) bulConWall' :: Particle' -> Point2 -> Wall -> World -> World bulConWall' bt p wl w = damageBlocks wl $ mkwave -- yay for hack -- should have used this before? or never? w where sp = head $ _btTrail' bt pOut = p +.+ safeNormalizeV (sp -.- p) damageBlocks wall w = case wall ^? blHP of Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 5)) w (_blIDs wall) _ -> w wallV = (_wlLine wl !! 1 -.- _wlLine wl !! 0) mkwave = over worldEvents $ (.) (makeShockwaveAt p 15 4 1 white) hvBulHitWall' :: Particle' -> Point2 -> Wall -> World -> World hvBulHitWall' bt p x w = damageBlocks x $ set randGen g $ foldr ($) w (sparks pOut sv) where sp = head $ _btTrail' bt pOut = p +.+ safeNormalizeV (sp -.- p) (a, g) = randomR (-0.1,0.1) $ _randGen w spid = newKey $ _particles w reflectDir wall = a + (argV $ reflectIn (_wlLine wall !! 1 -.- _wlLine wall !! 0) (p -.- sp) ) sv = unitVectorAtAngle $ reflectDir x damageBlocks wall w = case wall ^? blHP of Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 20)) w (_blIDs wall) _ -> w sID = newParticleKey w cs = take 10 $ randomRs (0,11) $ _randGen w ds = randomRs (-0.7,0.7) $ _randGen w ts = randomRs (4,8) $ _randGen w sparks pos vel = zipWith3 (\t c d -> createSpark t c pos (argV vel + d) Nothing) ts cs ds bulHitFF' :: Particle' -> Point2 -> ForceField -> World -> World bulHitFF' _ _ _ = id bulletEffect' :: HitEffect' bulletEffect' = threeEff' bulHitCr' bulHitWall' bulHitFF' bulletParticleSideEffect :: Particle' -> HitEffect' bulletParticleSideEffect pt = threeEff' mkPt mkPt noEff where mkPt _ p _ = over particles' ((:) pt {_btTrail' = [p]}) reflect :: Float -> Float -> Float reflect a b = a + 2*(a-b) 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) $ hitSpecific w , Just pt {_ptPict' = onLayer PtLayer $ pic ,_ptUpdate' = ptTimer' 0 } ) where sp = pos xp = sp +.+ 800 *.* unitVectorAtAngle dir --thHit = listToMaybe $ filter notSeeThrough $ thingsHitExceptCrLongLine mcid sp xp w (a,g) = randomR (-0.7,0.7) $ _randGen w reflectDir wall = a + (argV $ reflectIn (_wlLine wall !! 1 -.- _wlLine wall !! 0) (xp -.- sp) ) notSeeThrough (p,E3x2 wl) = not $ _wlIsSeeThrough wl notSeeThrough _ = True (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 (sp -.- 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 [] sp xp hitSpecific = case thHit of Just (p,E3x1 cr) -> over (creatures . ix (_crID cr) . crState . crDamage) ((:) $ Lasering 3 sp p xp) . over worldEvents ((.) $ flareAt yellow (flarePos p)) Just (p,E3x2 wl) -> createSpark 8 colID (p +.+ safeNormalizeV (sp -.- p)) (reflectDir wl) Nothing _ -> id pic = case thHit of Nothing -> pictures [color (withAlpha 0.05 yellow) $ lineOfThickness (a*20+40) (sp:ps) ,color (withAlpha 0.3 yellow) $ vvThickLine (sp:ps) ,color (withAlpha 0.9 white) $ vThickLine (sp:ps) ,fadeLine lp op 0.9 3 white ,fadeLine lp op 0.3 3 yellow ,fadeLine lp op 0.05 (a*20+40) yellow ] _ -> pictures [color (withAlpha 0.05 yellow) $ lineOfThickness (a*20+40) (sp:ps) ,color (withAlpha 0.3 yellow) $ vvThickLine (sp:ps) ,color (withAlpha 0.9 white) $ vThickLine (sp:ps) ] where lp = last ps lp' = last $ init (sp:ps) op = lp +.+ 50 *.* normalizeV (lp -.- lp') fadeLine :: Point2 -> Point2 -> Float -> Float -> Color -> Picture fadeLine sp ep alph width 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) closestOfThree :: Point2 -> Maybe (Point2,a) -> Maybe (Point2,b) -> Maybe (Point2,c) -> Maybe (Point2, Either3 a b c) closestOfThree p x1 x2 x3 = listToMaybe $ sortBy g $ catMaybes [fmap f1 x1,fmap f2 x2,fmap f3 x3] where f1 (r1,s1) = (r1, E3x1 s1) f2 (r2,s2) = (r2, E3x2 s2) f3 (r3,s3) = (r3, E3x3 s3) g (x,_) (y,_) = compare (magV (x -.- p)) (magV (y -.- p)) grenadeLauncher :: Item grenadeLauncher = pistol 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 n w = rmInvItem n $ over particles addG $ set randGen g w 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 = negate $ radToDeg $ argV $ v setWp :: World -> World setWp w' = w' & creatures . ix n . crInv . ix j . itEffect .~ throwArmReset 20 --maybewpid = w ^? creatures . ix n . crInv . ix j . itID . _Just --setWpLocation :: World -> World --setWpLocation w' = case maybewpid of -- Nothing -> w' & creatures . ix n . crInv . ix j . itID .~ Just newitid -- & itemPositions %~ IM.insert newitid (InInv n j) -- _ -> w' --newitid = newKey $ _itemPositions w --wpid = fromMaybe newitid maybewpid 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 ((179 * fromIntegral x / 50) - 180 ) (180 - (179 * fromIntegral x / 50) ) 5 , translate (-2) 2 $ rotate 90 $ 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 (-radToDeg (argV accel)) $ remoteShellPic time piclow = onLayerL [levLayer CrLayer - 2] $ uncurry translate newPos $ rotate (-radToDeg (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'' v1 s1 t1 (newPos +.+ r1) . makeSmokeAt'' v2 s2 t2 (newPos +.+ r2) -- . 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 (fromIntegral x * 10 + 45) $ color red $ arc 0 90 5 , rotate (fromIntegral x * 10 + 45) $ color (withAlpha 0.05 red) $ arcSolid 0 90 50 , rotate (fromIntegral x * 10 + 20) $ color (withAlpha 0.05 red) $ arcSolid 0 40 40 , rotate (fromIntegral x * 10 + 10) $ color (withAlpha 0.05 red) $ arcSolid 0 20 20 ] remoteBombUnarmedPic :: Picture remoteBombUnarmedPic = color (dark $ dark orange) $ circleSolid 5 drawWeapon :: Picture -> Creature -> Int -> Drawing drawWeapon p cr posInInv | _crInvSel cr == posInInv = onLayer PtLayer drawnWep | otherwise = blank where drawnWep = uncurry translate (_crRad cr,0) p --drawWeapon :: Picture -> Creature -> Int -> Maybe (Picture, [Int]) --drawWeapon p cr posInInv -- | _crInvSel cr == posInInv = Just (drawnWep, [levLayer PtLayer]) -- | otherwise = Nothing -- where drawnWep = uncurry translate (_crRad cr,0) p medkit :: Int -> Item medkit i = basicConsumable { _itIdentity = Medkit25 , _itName = "medkit" ++ show i , _itMaxStack = 9 , _itAmount = 1 , _cnEffect = heal i , _itFloorPict = onLayer FlItLayer $ color blue $ circleSolid 3 , _itEquipPict = drawWeapon $ color blue $ circleSolid 3 , _itID = Nothing } makeTeslaArcAt :: Int -> Point2 -> Float -> Particle makeTeslaArcAt i pos dir = Particle { _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 = 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 -- grapFire :: Int -> World -> World -- grapFire n w | fireCondition = set (creatures . ix n . crInv . ix itRef . wpFireState) -- (_wpFireRate (_crInv cr IM.! itRef)) -- $ over (creatures . ix n . crInv . ix itRef . wpLoadedAmmo) -- (\x -> x - 1) -- $ set randGen g -- $ over particles (IM.insert i (makeGrapFrom i n 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 -- + a -- (a,g) = randomR (-0.2,0.2::Float) (_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 -- -- makeGrapFrom :: Int -> Int -> Point -> Float -> Particle -- makeGrapFrom i ci pos dir = Particle -- { _ptPos = pos -- , _ptStartPos = pos -- , _ptVel = rotateV dir (10,0) -- , _ptPict = Line [(0,0)] -- , _ptID = i -- , _ptUpdate = moveGrap 50 [pos] ci i -- } -- -- moveGrap :: Int -> [Point] -> Int -> Int -> World -> World -- moveGrap x ls ci i w -- -- | x < 0 || lineCollide = windGrap' (zipWith (-.-) ls ls5) ci i w -- | otherwise = case tHit of -- Just (Left (p,crID)) -> set (particles . ix i . ptUpdate) (windGrap'' i crID ci -- (_crPos (_creatures w IM.! crID)) -- sCrP) -- w -- Just (Right (p,sv)) -> set (particles . ix i . ptUpdate) -- (windGrap sCrP (zipWith (-.-) ls ls5 ++[p]) ci i) -- w -- _ -> set (particles . ix i . ptUpdate) (moveGrap (x-1) ls1 ci i) -- $ set (particles . ix i. ptPos) pNewPos -- $ set (particles . ix i. ptPict) pic -- w -- where sCr = _creatures w IM.! ci -- sCrP = _crPos sCr -- pic = thickLine ls1 -- pOldPos = _ptPos (_particles w IM.! i) -- vel = _ptVel (_particles w IM.! i) -- ls1 = zipWith (+.+) ls2 $ zipWith f [1,1-step..] ls ++ [pNewPos] -- step = 1/ (51 - fromIntegral x) -- f y p = p +.+ (y) *.* crMv -- pNewPos = pOldPos +.+ vel -- crMv = sCrP -.- _crOldPos sCr -- ls3 = (:) (0,0) $ drop x $ take 48 $ cycle $ -- [lineWidth *.* vNormal vel -- ,(0,0) -- ,(-lineWidth) *.* vNormal vel -- ,(-lineWidth) *.* vNormal vel -- ,(0,0) -- ,lineWidth *.* vNormal vel -- ] -- lineWidth = 1 -- lineWidth2 = 0.5 -- ls2 = ls3 ++ repeat (0,0) -- ls5 = (:) (0,0) $ drop (x+z) $ take (48+z) $ cycle $ -- [lineWidth *.* vNormal vel -- ,(0,0) -- ,(-lineWidth) *.* vNormal vel -- ,(-lineWidth) *.* vNormal vel -- ,(0,0) -- ,lineWidth *.* vNormal vel -- ] -- where z = 2 -- ls6 = (:) (0,0) $ drop (x+z) $ take (48+z) $ cycle $ -- [lineWidth2 *.* vNormal vel -- ,(0,0) -- ,(-lineWidth2) *.* vNormal vel -- ,(-lineWidth2) *.* vNormal vel -- ,(0,0) -- ,lineWidth2 *.* vNormal vel -- ] -- where z = 2 -- hitCr = collidePointCrsPoint pOldPos pNewPos w -- hitWl = collidePointWalls pOldPos pNewPos $ wallsNearPoint pNewPos w -- tHit = thingHit' pOldPos hitCr hitWl -- lineCollide = foldr (||) False $ zipWith -- (\a b -> isJust $ collidePointWalls a b -- $ wallsNearPoint b w) -- ls (tail ls) thingHit' :: Point2 -> Maybe (Point2,a) -> Maybe (Point2,c) -> Maybe (Either (Point2,a) (Point2,c)) thingHit' p Nothing Nothing = Nothing thingHit' p (Just x) Nothing = Just (Left x) thingHit' p Nothing (Just x) = Just (Right x) thingHit' p (Just x@(p1,_)) (Just y@(p2,_)) | magV (p -.- p1) > magV (p -.- p2) = Just (Right y) | otherwise = Just (Left x) -- windGrap :: Point -> [Point] -> Int -> Int -> World -> World -- windGrap cp (x:y:xs) ci i w -- | dist (_crPos cr) cp < 5 -- = set (particles . ix i . ptUpdate) (windGrap cNewPos (y:xs) ci i) -- $ set (particles . ix i . ptPict) (thickLine (y:xs)) -- $ set (creatures . ix ci . crPos) cNewPos -- w -- | otherwise = windGrap' (x:y:xs) ci i w -- where cr = _creatures w IM.! ci -- cNewPos = y -.- d -- d = _crRad cr *.* errorNormalizeV 31 (y -.- x) -- windGrap _ _ _ i w -- = over particles (IM.delete i) w -- -- windGrap' :: [Point] -> Int -> Int -> World -> World -- windGrap' (x:[]) _ i w -- = over particles (IM.delete i) w -- windGrap' (x:xs) ci i w -- = set (particles . ix i . ptUpdate) (windGrap' ys ci i) -- $ set (particles . ix i . ptPict) (thickLine ys) -- w -- where ys = init $ zipWith f [1,1-step..] (x:xs) -- crMv = sCrP -.- _crOldPos sCr -- sCr = _creatures w IM.! ci -- sCrP = _crPos sCr -- f y p = p +.+ (y) *.* crMv -- step = 1/ (fromIntegral (length xs) + 1) -- -- windGrap'' :: Int -> Int -> Int -> Point -> Point -> World -> World -- windGrap'' pti ci1 ci2 p1 p2 w -- | dist cp1 cp2 < r1 + r2 + 1 -- = over particles (IM.delete pti) w -- | dist cp1 p1 > 5 || dist cp2 p2 > 5 -- = over particles (IM.delete pti) w -- | otherwise -- = set (creatures . ix ci1 . crPos) cpn1 -- $ set (creatures . ix ci2 . crPos) cpn2 -- $ set (particles . ix pti . ptPict) (thickLine [ cp1, cp2]) -- $ set (particles . ix pti . ptUpdate) (windGrap'' pti ci1 ci2 cpn1 cpn2) -- w -- where cr1 = _creatures w IM.! ci1 -- cr2 = _creatures w IM.! ci2 -- cp1 = _crPos cr1 -- cp2 = _crPos cr2 -- r1 = _crRad cr1 -- r2 = _crRad cr2 -- m1 = _crMass cr1 -- m2 = _crMass cr2 -- v = errorNormalizeV 32 $ cp2 -.- cp1 -- v1 = 10 * m2 / (m1 + m2) *.* v -- v2 = (-10 * m1 / (m1 + m2)) *.* v -- cpn1 = cp1 +.+ v1 -- cpn2 = cp2 +.+ v2 spreadGunSpread,autogunSpread :: Float spreadGunSpread = 0.5 autogunSpread = 0.07 medkit25,pipe,magShield :: Item medkit25 = basicConsumable { _itIdentity = Medkit25 , _itName = "medkit25" , _itMaxStack = 3 , _itAmount = 2 , _cnEffect = heal25 , _itFloorPict = onLayer FlItLayer $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)] , _itEquipPict = \cr _ -> blank } 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 = "frontArmour" , _itMaxStack = 1 , _itAmount = 1 , _itFloorPict = onLayer FlItLayer $ translate 0 (-5) $ pictures [color (greyN 0.1) $ thickArc 0 90 10 5 ,color (greyN 0.1) $ thickArc 270 360 10 5 ] , _itEquipPict = (\cr _ -> onLayer CrLayer $ pictures [color (greyN 0.1) $ thickArc 0 90 (_crRad cr) 5 ,color (greyN 0.1) $ thickArc 270 360 (_crRad cr) 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 50 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)] ] -- }}} heal25 :: Int -> World -> Maybe World heal25 n w | _crHP (_creatures w IM.! n) >= 200 = Nothing | otherwise = Just $ soundOnce healSound $ over (creatures . ix n . crHP) ((\x-> min x 100). (+ 25) ) w heal :: Int -> Int -> World -> Maybe World heal hp n w | _crHP (_creatures w IM.! n) >= 1000 = Nothing | otherwise = Just $ soundOnce healSound $ over (creatures . ix n . crHP) ((\x-> min x 1000). (+ hp) ) w 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 , _wpAmmoType = PistolBullet , _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 , _wpAmmoType = PistolBullet , _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)) }