{-# LANGUAGE BangPatterns #-} module Dodge.Item.Weapon ( module Dodge.Item.Weapon ) where -- imports {{{ import Dodge.Data import Dodge.Base import Dodge.SoundLogic import Dodge.CreatureAction import Dodge.RandomHelp import Dodge.WorldEvent import Dodge.Debug import Dodge.WallCreatureCollisions import Dodge.Default import Dodge.Item.Draw import Dodge.Item.Weapon.Bullet import Dodge.Item.Weapon.InventoryDisplay import Dodge.Item.Weapon.TriggerType import Dodge.Item.Weapon.Recock import Geometry import Picture import Data.List import Data.Char import Data.Maybe import Data.Function import qualified Data.ByteString as B import Control.Lens import Control.Applicative import Control.Monad.State import Control.Monad import qualified SDL as SDL --import qualified Graphics.UI.SDL.Mixer as Mix import System.Random import qualified Data.Set as S import qualified Data.IntMap.Strict as IM import qualified Data.Map as M import Foreign.ForeignPtr import Control.Concurrent -- }}} pistol,lasGun,tractorGun,launcher,autoGun ,teslaGun ,spreadGun ,multGun -- ,shatterGun ,longGun,flamer,blinkGun,forceFieldGun :: Item pistol = Weapon { _itName = "PISTOL" , _itIdentity = Pistol , _wpMaxAmmo = 15 , _wpLoadedAmmo = 15 , _wpReloadTime = 40 , _wpReloadState = 0 , _wpFireRate = 8 , _wpFireState = 0 , _wpFire = shootWithSound 0 . withRandomDir 0.1 . withMuzFlare . withVelWthHiteff (30,0) 2 $ destroyOnImpact bulHitCr' bulHitWall' bulHitFF' , _wpSpread = 0.02 , _wpRange = 20 , _itHammer = HammerUp , _itFloorPict = onLayer FlItLayer $ color green $ polygon $ rectNESW 3 3 (-3) (-3) , _itAmount = 1 , _itMaxStack = 1 , _itAimingSpeed = 1 , _itAimingRange = 0 , _itZoom = defaultItZoom , _itEquipPict = drawWeapon $ color green $ polygon $ rectNESW 3 3 (-3) (-3) , _itScrollUp = const id , _itScrollDown = const id , _itAttachment = Nothing , _itID = Nothing , _itEffect = wpRecock , _itInvDisplay = basicWeaponDisplay , _itInvColor = white } defaultGun = pistol defaultAutoGun = autoGun {_itScrollUp = const id , _itScrollDown = const id, _itInvDisplay = basicWeaponDisplay} effectGun :: String -> (Int -> World -> World) -> Item effectGun name eff = defaultGun { _itName = name ++ "Gun" , _wpFire = eff } autoEffectGun :: String -> (Int -> World -> World) -> Item autoEffectGun name eff = defaultAutoGun { _itName = name ++ "Gun" , _wpFire = eff } autoGun = defaultGun { _itName = "AUTOGUN" , _itIdentity = AutoGun , _wpMaxAmmo = 30 , _wpLoadedAmmo = 30 , _wpReloadTime = 80 , _wpReloadState = 0 , _wpFireRate = 6 , _wpFireState = 0 , _wpFire = autoFireMode , _wpSpread = autogunSpread , _wpRange = 20 , _itHammer = NoHammer -- , _itHammer = HammerUp , _itFloorPict = onLayer FlItLayer $ color red $ pictures [polygon [(-4,-4),(-4,4),(4,4),(4,-4)]] , _itAmount = 1 , _itMaxStack = 1 , _itAimingSpeed = 0.4 , _itAimingRange = 1 , _itZoom = defaultItZoom {_itAimZoomFac = 1.5} , _itEquipPict = drawWeapon $ color red $ polygon $ rectNESW 4 4 (-4) (-4) , _itEffect = NoItEffect , _itAttachment = Just $ ItMode 0 , _itScrollUp = incMode , _itScrollDown = incMode , _itInvDisplay = displayAutoGun } autoFireMode = shootWithSound (fromIntegral autoGunSound) . withRecoil 40 . torqueBefore 0.05 . withRandomDir (autogunSpread/2) . withMuzFlare . withVelWthHiteff (50,0) 3 $ destroyOnImpact bulIncCr' bulIncWall' bulHitFF' singleFireMode = shootWithSound (fromIntegral autoGunSound) . withRecoil 40 . torqueAfter 0.03 . withRandomDir (autogunSpread/2) . withMuzFlare . withVelWthHiteff (50,0) 3 $ destroyOnImpact bulHitCr' bulHitWall' bulHitFF' incMode :: Int -> World -> World incMode _ w = case newMode of 0 -> w & creatures . ix 0 . crInv . ix itRef . itAttachment . _Just . itMode .~ 0 & creatures . ix 0 . crInv . ix itRef . itHammer .~ NoHammer & creatures . ix 0 . crInv . ix itRef . itEffect .~ NoItEffect & creatures . ix 0 . crInv . ix itRef . wpFire .~ autoFireMode 1 -> w & creatures . ix 0 . crInv . ix itRef . itAttachment . _Just . itMode .~ 1 & creatures . ix 0 . crInv . ix itRef . itHammer .~ HammerUp & creatures . ix 0 . crInv . ix itRef . itEffect .~ wpRecock & creatures . ix 0 . crInv . ix itRef . wpFire .~ singleFireMode where itRef = fromMaybe (-2) $ w ^? creatures . ix 0 . crInvSel oldMode = w ^? creatures . ix 0 . crInv . ix itRef . itAttachment . _Just . itMode newMode = fromMaybe 1 $ fmap f oldMode f x = mod (x+1) 2 decMode :: Int -> World -> World decMode _ w = w & creatures . ix 0 . crInv . ix itRef . itAttachment . _Just . itMode %~ f & creatures . ix 0 . crInv . ix itRef . itName .~ "AUTOGUN" ++ g newMode where itRef = fromMaybe (-2) $ w ^? creatures . ix 0 . crInvSel oldMode = w ^? creatures . ix 0 . crInv . ix itRef . itAttachment . _Just . itMode newMode = fromMaybe 1 $ fmap f oldMode f x = mod (x-1) 2 g 1 = "-S" g 2 = "-B" g 0 = "-A" rezGun = defaultGun { _itName = "REANIMATOR" , _wpMaxAmmo = 50 , _wpLoadedAmmo = 50 , _wpReloadTime = 80 , _wpReloadState = 0 , _wpFireRate = 0 , _wpFireState = 0 , _wpFire = shoot aTeslaArc , _wpSpread = 0.001 , _wpRange = 20 , _itFloorPict = onLayer FlItLayer $ color chartreuse $ pictures [polygon $ rectNESW 7 3 1 (-3) ,polygon $ rectNESW (-1) 3 (-7) (-3) ] , _itAmount = 1 , _itMaxStack = 1 , _itAimingSpeed = 0.4 , _itAimingRange = 0 , _itEquipPict = drawWeapon $ color chartreuse $ pictures [polygon $ rectNESW 7 3 1 (-3) ,polygon $ rectNESW (-1) 3 (-7) (-3) ] } teslaGun = defaultAutoGun { _itName = "TESLA" , _itIdentity = TeslaGun , _wpMaxAmmo = 200 , _wpLoadedAmmo = 200 , _wpReloadTime = 80 , _wpReloadState = 0 , _wpFireRate = 0 , _wpFireState = 0 , _wpFire = shoot aTeslaArc , _wpSpread = 0.001 , _wpRange = 20 , _itFloorPict = onLayer FlItLayer $ color blue $ pictures [polygon $ rectNESW 7 3 1 (-3) ,polygon $ rectNESW (-1) 3 (-7) (-3) ] , _itAmount = 1 , _itMaxStack = 1 , _itAimingSpeed = 0.4 , _itZoom = defaultItZoom , _itAimingRange = 0 , _itEquipPict = drawWeapon $ color blue $ pictures [polygon $ rectNESW 7 3 1 (-3) ,polygon $ rectNESW (-1) 3 (-7) (-3) ] } lasGun = defaultAutoGun { _itName = "LASGUN ////" , _itIdentity = LasGun , _wpMaxAmmo = 200 , _wpLoadedAmmo = 200 , _wpReloadTime = 80 , _wpReloadState = 0 , _wpFireRate = 0 , _wpFireState = 0 , _wpFire = shoot aLaser , _wpSpread = 0.001 , _wpRange = 20 , _itFloorPict = onLayer FlItLayer $ color blue $ polygon $ rectNESW 3 3 (-3) (-3) , _itAmount = 1 , _itMaxStack = 1 , _itAimingSpeed = 0.4 , _itAimingRange = 1 , _itEquipPict = drawWeapon $ color blue $ polygon $ rectNESW 3 3 (-3) (-3) , _itAttachment = Just $ ItPhaseV 1 , _itScrollUp = incPhaseV , _itScrollDown = decPhaseV , _itInvDisplay = displayLasGun } incPhaseV :: Int -> World -> World incPhaseV _ w = w & creatures . ix 0 . crInv . ix itRef . itAttachment . _Just . itPhaseV %~ f where itRef = fromMaybe (-2) $ w ^? creatures . ix 0 . crInvSel oldPhaseV = w ^? creatures . ix 0 . crInv . ix itRef . itAttachment . _Just . itPhaseV newPhaseV = fromMaybe 1 $ fmap f oldPhaseV f 0.2 = 1 --f 0.5 = 1 f 1 = 5 --f 2 = 5 f 5 = 5 decPhaseV :: Int -> World -> World decPhaseV _ w = w & creatures . ix 0 . crInv . ix itRef . itAttachment . _Just . itPhaseV %~ f where itRef = fromMaybe (-2) $ w ^? creatures . ix 0 . crInvSel oldPhaseV = w ^? creatures . ix 0 . crInv . ix itRef . itAttachment . _Just . itPhaseV newPhaseV = fromMaybe 1 $ fmap f oldPhaseV f 0.2 = 0.2 --f 0.5 = 0.2 f 1 = 0.2 --f 2 = 1 f 5 = 1 forceFieldGun = defaultGun { _itName = "FORCEFIELD" , _itIdentity = ForceFieldGun , _wpMaxAmmo = 100 , _wpLoadedAmmo = 100 , _wpReloadTime = 40 , _wpReloadState = 0 , _wpFireRate = 10 , _wpFireState = 0 , _wpFire = forceFieldFire , _wpSpread = 0.02 , _wpRange = 20 , _itFloorPict = onLayer FlItLayer $ polygon [(-4,-4),(-4,4),(4,4),(4,0),(0,0),(0,-4)] , _itAmount = 1 , _itMaxStack = 1 , _itAimingSpeed = 0.4 , _itAimingRange = 0.5 } -- grapGun = defaultGun -- { _itName = "grapGun" -- , _itIdentity = GrapGun -- , _wpMaxAmmo = 1 -- , _wpLoadedAmmo = 1 -- , _wpReloadTime = 40 -- , _wpReloadState = 0 -- , _wpFireRate = 10 -- , _wpFireState = 0 -- , _wpFire = grapFire -- , _wpSpread = 0.002 -- , _wpRange = 20 -- , _wpIsAuto = False -- , _itFloorPict = onLayer FlItLayer $ polygon [(-4,-4),(-4,4),(4,4),(4,0),(0,0),(0,-4)] -- , _itAmount = 1 -- , _itMaxStack = 1 -- , _itAimingSpeed = 1 -- , _itAimingRange = 0.5 -- } tractorGun = defaultAutoGun { _itName = "TRACTORGUN" , _itIdentity = TractorGun , _wpMaxAmmo = 10000 , _wpLoadedAmmo = 10000 , _wpReloadTime = 40 , _wpReloadState = 0 , _wpFireRate = 0 , _wpFireState = 0 , _wpFire = shoot $ aTractorBeam 0 , _wpSpread = 0.00001 , _wpRange = 20 , _itFloorPict = onLayer FlItLayer $ color blue $ pictures [polygon $ rectNESW 1.5 6 (-1.5) 0 ] , _itAmount = 1 , _itMaxStack = 1 , _itAimingSpeed = 0.4 , _itAimingRange = 0.5 , _itEquipPict = drawWeapon $ color blue $ pictures [polygon $ rectNESW 1.5 6 (-1.5) 0 ] } launcher = defaultGun { _itName = "ROCKO" , _itIdentity = Launcher , _wpMaxAmmo = 30 , _wpLoadedAmmo = 30 , _wpReloadTime = 80 , _wpReloadState = 0 , _wpFireRate = 20 , _wpFireState = 0 , _wpFire = 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 } flameLauncher = launcher { _itName = "FLROCKO" , _wpFire = shoot $ aRocket' makeFlameShellAt } poisonLauncher = launcher { _itName = "POISROCK" , _wpFire = shoot $ aRocket' makePoisonShellAt } teslaLauncher = launcher { _itName = "TESLROCK" , _wpFire = shoot $ aRocket' makeTeslaShellAt } bezierGun = defaultAutoGun { _itName = "B-GUN" , _wpFire = maybeSetTarget $ \p -> shootWithSound 0 . withMuzFlare . withRecoil 40 . torqueBefore 0.05 -- I believe that this doesn't affect $ shootBezier p -- <- the start point , _itAttachment = Nothing , _itScrollUp = removeItAttachment 0 , _itScrollDown = removeItAttachment 0 , _itHammer = HammerUp , _itEffect = bezierRecock , _itZoom = defaultItZoom , _itAimingRange = 0 } maybeSetTarget :: (Point2 -> Int -> World -> World) -> Int -> World -> World maybeSetTarget f cid w = case join $ w ^? creatures . ix cid . crInv . ix itRef . itAttachment of Just (ItTargetPos targetp) -> f targetp cid w _ -> w & creatures . ix cid . crInv . ix itRef . itAttachment .~ Just (ItTargetPos mp) where mp = mouseWorldPos w cr = _creatures w IM.! cid itRef = _crInvSel cr shootBezier :: Point2 -> Int -> World -> World shootBezier targetp cid w = over particles' (theBullet :) w where theBullet = aCurveBulAt (Just cid) white startp (controlp +.+ randPos) (targetp +.+ randPos') (destroyOnImpact bulHitCr' bulHitWall' bulHitFF') 5 controlp = mouseWorldPos w cr = _creatures w IM.! cid dir = _crDir cr startp = _crPos cr +.+ rotateV dir (_crRad cr + 1,0) (randPos,randPos') = flip evalState (_randGen w) $ do a <- randInCirc 10 b <- randInCirc 20 return (a,b) removeItAttachment :: Int -> Int -> World -> World removeItAttachment i _ w = w & creatures . ix i . crInv . ix itRef . itAttachment .~ Nothing where cr = _creatures w IM.! i itRef = _crInvSel cr remoteLauncher = defaultGun { _itName = "ROCKO-REM" , _itIdentity = RemoteLauncher , _wpMaxAmmo = 1 , _wpLoadedAmmo = 1 , _wpReloadTime = 80 , _wpReloadState = 0 , _wpFireRate = 10 , _wpFireState = 0 , _wpFire = fireRemoteLauncher , _wpSpread = 0.02 , _wpRange = 20 , _itFloorPict = onLayer FlItLayer $ color cyan $ polygon $ rectNESW 5 5 (-5) (-5) , _itAmount = 1 , _itMaxStack = 1 , _itAimingSpeed = 0.2 , _itAimingRange = 0.5 , _itEquipPict = drawWeapon $ color cyan $ polygon $ rectNESW 5 5 (-5) (-5) , _itAttachment = Just $ ItScope (0,0) 0 1 True } hvAutoGun = defaultAutoGun { _itName = "AUTO-HV" , _itIdentity = HvAutoGun , _wpMaxAmmo = 100 , _wpLoadedAmmo = 100 , _wpReloadTime = 200 , _wpReloadState = 0 , _wpFireRate = 25 , _wpFireState = 0 , _wpFire = rateIncAB 24 10 (torqueBeforeForced 0.1 mkHvBul) $ torqueAfter 0.2 mkHvBul , _wpSpread = autogunSpread , _wpRange = 20 , _itFloorPict = onLayer FlItLayer $ color orange $ polygon $ rectNESW 5 5 (-5) (-5) , _itAmount = 1 , _itMaxStack = 1 , _itAimingSpeed = 0.2 , _itAimingRange = 1 , _itEquipPict = drawWeapon $ color orange $ polygon $ rectNESW 5 5 (-5) (-5) } where mkHvBul = withSound (fromIntegral longGunSound) . withThinSmoke . withMuzFlare . withVelWthHiteff (80,0) 6 $ penWalls hvBulHitCr' hvBulHitWall' bulHitFF' ltAutoGun = defaultAutoGun { _itName = "AUTO-LT" , _itIdentity = LtAutoGun , _wpMaxAmmo = 25 , _wpLoadedAmmo = 25 , _wpReloadTime = 80 , _wpReloadState = 0 , _wpFireRate = 4 , _wpFireState = 0 , _wpFire = shootWithSound 0 . withRandomDir 0.3 . withMuzFlare $ withVelWthHiteff (30,0) 2 bulletEffect' , _wpSpread = 0.5 , _wpRange = 20 , _itFloorPict = onLayer FlItLayer $ color green $ pictures [polygon $ rectNSWE 4 (-4) (-4) 0 ,circleSolid 4 ] , _itAmount = 1 , _itMaxStack = 1 , _itAimingSpeed = 1 , _itAimingRange = 0 , _itZoom = defaultItZoom , _itEquipPict = drawWeapon $ color green $ pictures [polygon $ rectNSWE 4 (-4) (-4) 0 ,circleSolid 4 ] } miniGun = defaultAutoGun { _itName = "MINI-G" , _itIdentity = MiniGun , _wpMaxAmmo = 150 , _wpLoadedAmmo = 150 , _wpReloadTime = 200 , _wpReloadState = 0 , _wpFireRate = 2 , _wpFireState = 0 , _wpFire = withWarmUp 50 . torqueBefore 0.03 . withSidePush 50 . withRecoil 15 . withRandomDir 0.1 . withRandomOffset 9 . withMuzFlare $ withVelWthHiteff (30,0) 2 bulletEffect' , _wpSpread = autogunSpread , _wpRange = 20 , _itFloorPict = onLayer FlItLayer $ color red $ polygon $ rectNESW 9 5 (-9) (-5) , _itAmount = 1 , _itMaxStack = 1 , _itAimingSpeed = 0.4 , _itAimingRange = 1 , _itEquipPict = drawWeapon $ color red $ polygon $ rectNESW 9 5 (-9) (-5) } spreadGun = defaultGun { _itName = "SPREAD" , _itIdentity = SpreadGun , _wpMaxAmmo = 5 , _wpLoadedAmmo = 5 , _wpReloadTime = 80 , _wpReloadState = 0 , _wpFireRate = 20 , _wpFireState = 0 , _wpFire = shootWithSound (fromIntegral shotgunSound) . withRecoil 100 . withMuzFlare $ spreadNumVelWthHiteff spreadGunSpread 9 (30,0) 2 bulletEffect' , _wpSpread = spreadGunSpread , _wpRange = 20 , _itFloorPict = onLayer FlItLayer $ color green $ pictures [ polygon [(-3,0),(3,6),(3,-6)] ] , _itAmount = 1 , _itMaxStack = 1 , _itAimingSpeed = 1 , _itAimingRange = 0 , _itEquipPict = drawWeapon $ color green $ pictures [ polygon [(-3,0),(3,6),(3,-6)] ] } -- shatterGun = defaultGun -- { _itName = "shatterGun" -- , _itIdentity = ShatterGun -- , _wpMaxAmmo = 50 -- , _wpLoadedAmmo = 50 -- , _wpReloadTime = 80 -- , _wpReloadState = 0 -- , _wpFireRate = 40 -- , _wpFireState = 0 -- , _wpFire = shatterGunFire -- , _wpSpread = 3.14 -- , _wpRange = 20 -- , _wpIsAuto = False -- , _itFloorPict = polygon [(-4,-4),(-4,4),(4,4),(4,0),(0,0),(0,-4)] -- , _itAmount = 1 -- , _itMaxStack = 1 -- , _itAimingSpeed = 1 -- , _itAimingRange = 0.5 -- } multGun = defaultGun { _itName = "MULTGUN" , _itIdentity = MultGun , _wpMaxAmmo = 2 , _wpLoadedAmmo = 2 , _wpReloadTime = 40 , _wpReloadState = 0 , _wpFireRate = 20 , _wpFireState = 0 , _wpFire = shootWithSound (fromIntegral shotgunSound) . withRecoil 200 . withMuzFlare $ numVelWthHitEff 5 (50,0) 5 bulletEffect' , _wpSpread = spreadGunSpread , _wpRange = 20 , _itFloorPict = onLayer FlItLayer $ multGunPic , _itAmount = 1 , _itMaxStack = 1 , _itAimingSpeed = 0.4 , _itAimingRange = 1 , _itZoom = defaultItZoom {_itAimZoomFac = 1.5} , _itEquipPict = drawWeapon $ multGunPic } where multGunPic = color red $ pictures [ polygon $ rectNSEW 12 8 2 (-2) , polygon $ rectNSEW 7 3 2 (-2) , polygon $ rectNSEW 2 (-2) 2 (-2) , polygon $ rectNSEW (-3) (-7) 2 (-2) , polygon $ rectNSEW (-8) (-12) 2 (-2) , polygon [(-1.5,12),(-2,12),(-2,-12),(-1.5,-12)] ] longGun = defaultGun { _itName = "LONGGUN" , _itIdentity = LongGun , _wpMaxAmmo = 1 , _wpLoadedAmmo = 1 , _wpReloadTime = 80 , _wpReloadState = 0 , _wpFireRate = 100 , _wpFireState = 0 , _wpFire = shootWithSound (fromIntegral longGunSound) . withThickSmoke . torqueAfter 0.05 . withMuzFlare . withVelWthHiteff (60,0) 6 $ penWalls hvBulHitCr' hvBulHitWall' bulHitFF' , _wpSpread = 0.0 , _wpRange = 200 , _itFloorPict = onLayer FlItLayer $ pictures [color orange $ polygon $ rectNESW 3 6 (-3) (-6) ] , _itAmount = 1 , _itMaxStack = 1 , _itAimingSpeed = 0.2 , _itAimingRange = 1 , _itZoom = defaultItZoom {_itAimZoomMax = 0.5, _itAimZoomMin = 0.5} , _itEquipPict = drawWeapon $ pictures [color orange $ polygon $ rectNESW 3 6 (-3) (-6) ] , _itScrollUp = startZoomInLongGun , _itScrollDown = startZoomOutLongGun , _itAttachment = Just $ ItScope (0,0) 0 1 False , _itEffect = itemLaserScopeEffect } startZoomInLongGun :: Int -> World -> World startZoomInLongGun _ w = w & creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0)) . itAttachment . _Just . scopeZoomChange %~ \x -> max 5 (x + 5) startZoomOutLongGun :: Int -> World -> World startZoomOutLongGun _ w = w & creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0)) . itAttachment . _Just . scopeZoomChange %~ \x -> min (-5) (x-5) -- (\x -> - 10) poisonSprayer = defaultAutoGun { _itName = "POISON" , _itIdentity = PoisonSprayer , _wpMaxAmmo = 500 , _wpLoadedAmmo = 500 , _wpReloadTime = 100 , _wpReloadState = 0 , _wpFireRate = 0 , _wpFireState = 0 , _wpFire = shoot $ aGasCloud , _wpSpread = flamerAngle , _wpRange = 8 , _itFloorPict = onLayer FlItLayer $ color yellow $ polygon $ rectNESW 4 4 (-4) (-4) , _itAmount = 1 , _itMaxStack = 1 , _itAimingSpeed = 0.2 , _itAimingRange = 0 , _itZoom = defaultItZoom , _itEquipPict = drawWeapon $ color yellow $ polygon $ rectNESW 4 4 (-4) (-4) } flamer = defaultAutoGun { _itName = "FLAMER" , _itIdentity = Flamethrower , _wpMaxAmmo = 250 , _wpLoadedAmmo = 250 , _wpReloadTime = 100 , _wpReloadState = 0 , _wpFireRate = 0 , _wpFireState = 0 , _wpFire = shoot $ aFlame 0 , _wpSpread = flamerAngle , _wpRange = 8 , _itFloorPict = onLayer FlItLayer $ color yellow $ polygon $ rectNESW 4 4 (-4) (-4) , _itAmount = 1 , _itMaxStack = 1 , _itAimingSpeed = 0.5 -- , _itAimingSpeed = 1 -- , _itAimingSpeed = 0.2 , _itAimingRange = 0 , _itZoom = defaultItZoom {_itAimZoomMax = 5, _itAimZoomMin = 1.5} , _itEquipPict = drawWeapon $ color yellow $ polygon $ rectNESW 4 4 (-4) (-4) , _itAttachment = Nothing } blinkGun = defaultGun { _itName = "BLINKER" , _itIdentity = Blinker , _wpMaxAmmo = 100 , _wpLoadedAmmo = 100 , _wpReloadTime = 20 , _wpReloadState = 0 , _wpFireRate = 0 , _wpFireState = 0 , _wpFire = shoot aSelf , _wpSpread = 0.05 , _wpRange = 20 , _itFloorPict = onLayer FlItLayer $ polygon [(-2,-2),(-2,2),(2,2),(2,0),(0,0),(0,-2)] , _itAmount = 1 , _itMaxStack = 1 , _itAimingSpeed = 1 , _itAimingRange = 0 } aTeslaArc :: Int -> World -> World aTeslaArc cid w = aTeslaArc' cid $ soundFrom (CrWeaponSound cid) 25 1 0 w aTeslaArc' :: Int -> World -> World aTeslaArc' cid w = teslaGunFlashAt (pos +.+ 5 *.* unitVectorAtAngle dir) $ over projectiles (IM.insert i (makeTeslaArcAt i pos dir)) $ set randGen g w where cr = (_creatures w IM.! cid) i = newProjectileKey w pos = _crPos cr +.+ ((_crRad cr +1) *.* unitVectorAtAngle dir) +.+ sideOffset *.* vNormal (unitVectorAtAngle dir) (sideOffset,g) = randomR (-5,5) $ _randGen w dir = _crDir cr aLaser :: Int -> World -> World aLaser cid w = over particles' ( (:) (makeLaserAt phaseV pos dir (Just cid))) $ soundFrom LasSound 24 1 0 $ laserGunFlashAt (pos +.+ 5 *.* unitVectorAtAngle dir) w where cr = (_creatures w IM.! cid) i = newProjectileKey w pos = _crPos cr +.+ ((_crRad cr +3) *.* unitVectorAtAngle dir) dir = _crDir cr phaseV = fromMaybe 1 $ cr ^? crInv . ix j . itAttachment . _Just . itPhaseV j = _crInvSel cr aTractorBeam :: Int -> Int -> World -> World aTractorBeam col cid w = set (creatures . ix cid . crInv . ix itRef . wpFire) (shoot $ aTractorBeam ((col + 1) `mod` 10)) $ over projectiles (IM.insert i (tractorBeamAt col i pos dir)) w where i = newProjectileKey w cr = (_creatures w IM.! cid) pos = _crPos cr +.+ ((_crRad cr +10) *.* unitVectorAtAngle dir) dir = _crDir cr itRef = _crInvSel cr -- |The aRocket' function allows us to define the shell to be used aRocket' :: (Int -> Int -> Point2 -> Float -> Projectile) -> Int -> World -> World aRocket' shell cid w = soundOnce (fromIntegral launcherSound) $ over projectiles (IM.insert i (shell i cid pos dir)) w where i = newProjectileKey w cr = (_creatures w IM.! cid) pos = _crPos cr +.+ ((_crRad cr +1) *.* unitVectorAtAngle dir) dir = _crDir cr aRocket :: Int -> World -> World aRocket = aRocket' makeShellAt -- = soundOnce (fromIntegral launcherSound) -- $ over projectiles (IM.insert i (makeShellAt i cid pos dir)) w -- where i = newProjectileKey w -- cr = (_creatures w IM.! cid) -- pos = _crPos cr +.+ ((_crRad cr +1) *.* unitVectorAtAngle dir) -- dir = _crDir cr makeShellAt :: Int -> Int -> Point2 -> Float -> Projectile makeShellAt i cid pos dir = Shell { _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)) , _ptExplosion = shellExplosionAt } makeFlameShellAt :: Int -> Int -> Point2 -> Float -> Projectile makeFlameShellAt i cid pos dir = Shell { _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)) , _ptExplosion = makeFlameExplosionAt } makePoisonShellAt :: Int -> Int -> Point2 -> Float -> Projectile makePoisonShellAt i cid pos dir = Shell { _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)) , _ptExplosion = makePoisonExplosionAt } makeTeslaShellAt :: Int -> Int -> Point2 -> Float -> Projectile makeTeslaShellAt i cid pos dir = Shell { _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)) , _ptExplosion = makeTeslaExplosionAt } moveShell :: Int -> Int -> Int -> Float -> Point2 -> World -> World moveShell time i cid rot accel w | time > 40 = if circOnSomeWall oldPos 4 w then projectileExplosion oldPos $ over projectiles (IM.delete i) w else over (projectiles . ix i . ptPos) (+.+ vel) $ set (projectiles . ix i . ptPict) piclow $ set (projectiles . ix i . ptUpdate) (moveShell (time-1) i cid rot (rotateV rot accel)) w | time == 35 = case thingHit of Just p -> projectileExplosion oldPos $ over projectiles (IM.delete i) w Nothing -> over (projectiles . ix i . ptPos) (+.+ vel) $ set (projectiles . ix i . ptPict) pic $ set (projectiles . ix i . ptUpdate) (moveShell (time-1) i cid spin accel) w | time >= 20 = case thingHit of Just p -> projectileExplosion oldPos $ over projectiles (IM.delete i) w Nothing -> over (projectiles . ix i . ptPos) (+.+ vel) $ set (projectiles . ix i . ptPict) pic $ set (projectiles . ix i . ptUpdate) (moveShell (time-1) i cid rot (rotateV rot accel)) w | time > -99 = case thingHit of Just p -> projectileExplosion oldPos $ stopSoundFrom (ShellSound i) $ over projectiles (IM.delete i) w Nothing -> over (projectiles . ix i . ptPos) (+.+ vel) $ set randGen g $ set (projectiles . ix i . ptPict) pic $ set (projectiles . ix i . ptUpdate) (moveShell (time-1) i cid rot (rotateV rot accel)) $ over (projectiles . ix i . ptVel) (\v -> accel +.+ frict *.* v) $ soundFrom (ShellSound i) (fromIntegral smokeTrailSound) (1) 250 $ makeFlameletTimed oldPos (0.5 *.* rotateV (pi+sparkD) accel) Nothing 3 10 $ smokeGen w | time > -200 = case thingHit of Just p -> projectileExplosion oldPos $ stopSoundFrom (ShellSound i) $ over projectiles (IM.delete i) w Nothing -> over (projectiles . ix i . ptPos) (+.+ vel) $ set (projectiles . ix i . ptPict) pic $ set (projectiles . ix i . ptUpdate) (moveShell (time-1) i cid rot (rotateV rot accel)) w | otherwise = projectileExplosion oldPos $ stopSoundFrom (ShellSound i) $ over projectiles (IM.delete i) w where pt = _projectiles w IM.! i oldPos = _ptPos pt vel = _ptVel pt projectileExplosion = _ptExplosion pt newPos = oldPos +.+ vel (frict,g) = randomR (0.6,0.9) $ _randGen w (sparkD,_) = randomR (-0.5,0.5) $ _randGen w dir = argV $ vel pic = onLayer PtLayer $ uncurry translate newPos $ rotate (argV accel) shellPic piclow = onLayerL [levLayer CrLayer - 2] $ uncurry translate newPos $ rotate (argV accel) shellPic hitCr = fmap fst $ collideCircCrsPoint oldPos newPos 4 w hitWl = fmap fst $ collideCircWalls' oldPos newPos 2 $ wallsNearPoint newPos w thingHit = hitCr <|> hitWl spin = case w ^? creatures . ix cid of Just cr -> min 0.1 $ max (-0.1) $ (normalizeAnglePi (dir - _crDir cr)) / 20 _ -> 0 r1 = _randGen w & evalState (randInCirc 10) smokeGen = makeSmokeCloudAt (oldPos +.+ r1 +.+ 30 *.* (normalizeV (oldPos -.- newPos))) normalizeAnglePi angle | normalizeAngle angle > pi = normalizeAngle angle - 2*pi | otherwise = normalizeAngle angle shellPic = color black $ polygon [(-6,4),(-6,-4),(6,-4),(8,0),(6,4)] remoteShellPic :: Int -> Picture remoteShellPic i | rem (i+200) 20 < 9 = polygon [(-6,4),(-6,-4),(6,-4),(8,0),(6,4)] | otherwise = pictures [ polygon [(-6,4),(-6,-4),(6,-4),(8,0),(6,4)] , color col $ circleSolid 3 ] where col | i > (-99) = green | otherwise = red shellExplosionAt = makeExplosionAt tractorBeamAt :: Int -> Int -> Point2 -> Float -> Projectile tractorBeamAt colID i pos dir = Projectile { _ptPos = pos , _ptStartPos = p' , _ptVel = d , _ptPict = blank , _ptID = i , _ptUpdate = updateTractor colID 10 i } where d = unitVectorAtAngle dir p' = pos +.+ 400 *.* d aGasCloud :: Int -> World -> World aGasCloud cid w = -- soundFrom Flame fireSound 2 500 insertCloud $ set randGen g $ w where (a,g) = randomR (-0.1,0.1) (_randGen w) cr = (_creatures w IM.! cid) dir = _crDir cr + a pos = _crPos cr +.+ ((_crRad cr + 2.9) *.* unitVectorAtAngle (_crDir cr)) pos2 = (0.5 *.* vel) +.+ _crPos cr +.+ ((_crRad cr + 2.9) *.* unitVectorAtAngle (_crDir cr)) vel = (_crPos cr -.- _crOldPos cr) +.+ 10 *.* 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 = 400 , _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)) w1 = set randGen g w 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) -- The following should be improved.... makePoisonExplosionAt :: Point2 -> World -> World makePoisonExplosionAt p w = soundOnce grenadeBang $ makeGasCloud p (velocities!!1) $ makeGasCloud p (velocities!!2) $ makeGasCloud p (velocities!!3) w where xs = randomRs (-2,2) $ _randGen w -- one infinite list of randoms velocities = zip (take 10 xs) (drop 10 xs) makeTeslaExplosionAt :: Point2 -> World -> World makeTeslaExplosionAt pos w = soundOnce grenadeBang -- This is obviously the best way.... $ over projectiles (IM.insert (pks!!1) (makeTeslaArcAt (pks!!1) pos (xs!!1))) $ over projectiles (IM.insert (pks!!2) (makeTeslaArcAt (pks!!2) pos (xs!!2))) $ over projectiles (IM.insert (pks!!3) (makeTeslaArcAt (pks!!3) pos (xs!!3))) $ over projectiles (IM.insert (pks!!4) (makeTeslaArcAt (pks!!4) pos (xs!!4))) $ over projectiles (IM.insert (pks!!5) (makeTeslaArcAt (pks!!5) pos (xs!!5))) $ over projectiles (IM.insert (pks!!6) (makeTeslaArcAt (pks!!6) pos (xs!!6))) $ over projectiles (IM.insert (pks!!7) (makeTeslaArcAt (pks!!7) pos (xs!!7))) $ over projectiles (IM.insert (pks!!8) (makeTeslaArcAt (pks!!8) pos (xs!!8))) $ over projectiles (IM.insert (pks!!9) (makeTeslaArcAt (pks!!9) pos (xs!!9))) $ over projectiles (IM.insert (pks!!10) (makeTeslaArcAt (pks!!10) pos (xs!!10))) $ over projectiles (IM.insert (pks!!11) (makeTeslaArcAt (pks!!11) pos (xs!!11))) $ over projectiles (IM.insert (pks!!12) (makeTeslaArcAt (pks!!12) pos (xs!!12))) $ over projectiles (IM.insert (pks!!13) (makeTeslaArcAt (pks!!13) pos (xs!!13))) $ over projectiles (IM.insert (pks!!14) (makeTeslaArcAt (pks!!14) pos (xs!!14))) $ over projectiles (IM.insert (pks!!15) (makeTeslaArcAt (pks!!15) pos (xs!!15))) $ over projectiles (IM.insert (pks!!16) (makeTeslaArcAt (pks!!16) pos (xs!!16))) $ over projectiles (IM.insert (pks!!17) (makeTeslaArcAt (pks!!17) pos (xs!!17))) $ over projectiles (IM.insert (pks!!18) (makeTeslaArcAt (pks!!18) pos (xs!!18))) $ over projectiles (IM.insert (pks!!19) (makeTeslaArcAt (pks!!19) pos (xs!!19))) $ over projectiles (IM.insert (pks!!20) (makeTeslaArcAt (pks!!20) pos (xs!!20))) $ over projectiles (IM.insert (pks!!21) (makeTeslaArcAt (pks!!21) pos (xs!!21))) $ over projectiles (IM.insert (pks!!22) (makeTeslaArcAt (pks!!22) pos (xs!!22))) $ over projectiles (IM.insert (pks!!23) (makeTeslaArcAt (pks!!23) pos (xs!!23))) $ over projectiles (IM.insert (pks!!24) (makeTeslaArcAt (pks!!24) pos (xs!!24))) $ over projectiles (IM.insert (pks!!25) (makeTeslaArcAt (pks!!25) pos (xs!!25))) $ over projectiles (IM.insert (pks!!26) (makeTeslaArcAt (pks!!26) pos (xs!!26))) $ over projectiles (IM.insert (pks!!27) (makeTeslaArcAt (pks!!27) pos (xs!!27))) $ over projectiles (IM.insert (pks!!28) (makeTeslaArcAt (pks!!28) pos (xs!!28))) $ over projectiles (IM.insert (pks!!29) (makeTeslaArcAt (pks!!29) pos (xs!!29))) w where -- rad or 360? xs = randomRs (0,7) $ _randGen w p = newProjectileKey w pks = [p..] makeFlameExplosionAt :: Point2 -> World -> World makeFlameExplosionAt p w = soundOnce grenadeBang $ makeFlame p (velocities!!1) (Just 0) $ makeFlame p (velocities!!2) (Just 90) $ makeFlame p (velocities!!3) (Just 180) $ makeFlame p (velocities!!4) (Just 0) $ makeFlame p (velocities!!5) (Just 0) $ makeFlame p (velocities!!6) (Just 0) $ makeFlame p (velocities!!7) (Just 0) $ makeFlame p (velocities!!8) (Just 0) $ makeFlame p (velocities!!9) (Just 0) $ makeFlame p (velocities!!10) (Just 0) $ w where xs = randomRs (-2,2) $ _randGen w -- one infinite list of randoms velocities = zip (take 10 xs) (drop 10 xs) makeFlame :: Point2 -> Point2 -> Maybe Int -> World -> World makeFlame pos vel maycid = over particles' ((:) theFlame) where theFlame = Pt' { _ptDraw = drawFlame vel , _ptUpdate' = moveFlame vel , _btVel' = vel , _btColor' = red , _btPos' = pos , _btPassThrough' = maycid , _btWidth' = 4 , _btTimer' = 100 , _btHitEffect' = destroyOnImpact (doFlameDam 1) noEff noEff } drawFlame :: Point2 -> Particle' -> Picture drawFlame rotd pt = thePic where ep = _btPos' pt thePic = pictures [ glow , aPic prot2 0.2998 (scaleChange + 1,2) red , aPic prot 0.2996 (scaleChange + 0.5,1.5) orange , aPic prot3 0.2994 (scaleChange,1) white ] aPic :: (Point2 -> Point2) -> Float -> Point2 -> Color -> Picture aPic offset depth (scalex,scaley) col = setLayer 1 . setDepth depth . uncurry translate (offset ep) . rotate (pi * 0.5 + argV rotd) . scale scalex scaley . color col $ circleSolid 5 glow = setLayer 1 $ setDepth 0.3 $ uncurry translate ep $ circleSolidCol (withAlpha 0 orange) (withAlpha 0.02 orange) 50 time = _btTimer' pt scaleChange | time < 80 = 3 | otherwise = 3 - (fromIntegral time - 80) * 0.2 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) moveFlame :: Point2 -> World -> Particle' -> (World, Maybe Particle') moveFlame rotd w pt | time <= 0 = (smokeGen w, Nothing) | otherwise = case thingsHitExceptCr (_btPassThrough' pt) sp ep w of ((p,(E3x1 cr)):_) -> (soundAndGlare damcrs , mvPt') (thing@(p,(E3x2 wl)):_) -> (fst $ hiteff [thing] damcrs , rfl wl p) _ -> (soundAndGlare damcrs , mvPt) where time = _btTimer' pt soundAndGlare = soundFrom Flame fireSound 2 500 . over worldEvents ((.) $ flameGlareAt ep) sp = _btPos' pt vel = _btVel' pt ep = sp +.+ vel mvPt = Just $ pt {_btTimer' = time - 1, _btPos' = ep , _btPassThrough' = Nothing ,_btVel' = 0.98 *.* vel} mvPt' = Just $ pt {_btTimer' = time - 1, _btPos' = ep , _btPassThrough' = Nothing ,_btVel' = 0.7 *.* vel} damcrs = foldr ($) w $ map (\cr -> fst . hiteff [(ep,E3x1 cr)]) $ filter closeCrs $ IM.elems $ _creatures w closeCrs cr = dist ep (_crPos cr) < _crRad cr + 10 - min 9 (max 0 (fromIntegral time - 80)) + 5 * angleCoeff (angleVV (ep -.- _crPos cr) rotd) angleCoeff x = abs $ 1 - (abs $ (x * 2 - pi) / (pi)) hiteff = _btHitEffect' pt pt rfl wl p = Just $ pt {_btTimer' = time -1, _btPos' = pOut p , _btVel' = reflV wl--, _ptDraw = const $ thepic $ pOut p } pOut p = p +.+ safeNormalizeV (sp -.- p) reflV wall = (0.3 *.* reflectIn (_wlLine wall !! 1 -.- _wlLine wall !! 0) vel ) +.+ (0.2 *.* vel) smokeGen = makeFlamerSmokeAt ep flamerAngle = 0.3 aSelf :: Int -> World -> World aSelf = blinkAction reflect :: Float -> Float -> Float reflect a b = a + 2*(a-b) moveGrenade :: Int -> Float -> Int -> World -> World moveGrenade 0 dir pID w = over projectiles (IM.delete pID) $ explosion (_ptPos (_projectiles w IM.! pID)) -- $ set (pointToItem (_itemPositions w IM.! wpID) . itEquipPict) -- (drawWeapon $ grenadePic 50) w where pt = _projectiles w IM.! pID explosion = _ptExplosion pt moveGrenade time dir pID w = case hitWl of Just _ -> soundOnce (fromIntegral tapQuiet) updatedWorld _ -> updatedWorld where updatedWorld = updateV $ set (projectiles . ix pID . ptPos) finalPos $ set (projectiles .ix pID.ptPict) (onLayer PtLayer $ uncurry translate newPos $ rotate dir $ grenadePic time) $ set (projectiles .ix pID.ptUpdate) (moveGrenade (time-1) dir pID) w pt = _projectiles 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 (projectiles .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 & projectiles %~ IM.delete ptid) retireRemoteRocket itid t ptid w = setScope w & projectiles . 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 ^? projectiles . 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) defaultItZoom $ set (pointToItem (_itemPositions w IM.! itid) . twFire) throwRemoteBomb (w & projectiles %~ IM.delete ptid) retireRemoteBomb itid t ptid w = setScope w & projectiles . 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 ^? projectiles . ix ptid . ptPos moveRemoteBomb :: Int -> Int -> Int -> World -> World moveRemoteBomb itid time pID w | time < -4 = setScope $ updatePicture $ set (projectiles .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 (projectiles . ix pID . ptPos) finalPos $ updatePicture $ set (projectiles .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 .~ (defaultItZoom {_itAimZoomMax = 0.5, _itAimZoomMin = 0.5}) _ -> w' pt = _projectiles 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 (projectiles .ix pID.ptVel) v updateV = fromMaybe id (fmap (setV.snd) hitWl) halfV = over (projectiles . ix pID . ptVel) (\v -> 0.5 *.* v) f x | x < -369 = -10 | otherwise = x - 1 updatePicture = set (projectiles . ix pID.ptPict) (onLayer PtLayer $ uncurry translate newPos $ remoteBombPic time) . lowLightDirected (withAlpha 0.1 red) newPos (50 *.* unitVectorAtAngle (negate $ degToRad (10 * fromIntegral time))) [-0.2,-0.15,-0.1,-0.05,0,0.05,0.1,0.15,0.2] shootRateIncrease :: Int -> Int -> (Int -> World -> World) -> Int -> World -> World shootRateIncrease startRate fastRate shootEffect cid w | repeatFire = set (pointItem . wpFireRate) (max fastRate (currentRate - 1)) $ set (pointItem . wpFireState) currentRate $ shootEffect cid w | firstFire = set (pointItem . wpFireRate) (startRate - 1) $ set (pointItem . wpFireState) startRate $ shootEffect cid w | reloadCondition = fromMaybe w $ reloadWeapon cid w | otherwise = w where cr = _creatures w IM.! cid itRef = _crInvSel cr item = _crInv cr IM.! itRef pointItem = (creatures . ix cid . crInv . ix itRef) currentRate = _wpFireRate item repeatFire = _wpReloadState item == 0 && _wpFireState item == 1 && _wpLoadedAmmo item > 0 firstFire = _wpReloadState item == 0 && _wpFireState item == 0 && _wpLoadedAmmo item > 0 reloadCondition = _wpLoadedAmmo item == 0 rateIncAB :: Int -> Int -> (Int -> World -> World) -> (Int -> World -> World) -> Int -> World -> World rateIncAB startRate fastRate shooteff1 shooteff2 cid w | repeatFire = set (pointItem . wpFireRate) (max fastRate (currentRate - 1)) $ over (pointItem . wpLoadedAmmo) (\ammo -> ammo-1) $ set (pointItem . wpFireState) currentRate $ shooteff2 cid w | firstFire = set (pointItem . wpFireRate) (startRate - 1) $ over (pointItem . wpLoadedAmmo) (\ammo -> ammo-1) $ set (pointItem . wpFireState) startRate $ shooteff1 cid w | reloadCondition = fromMaybe w $ reloadWeapon cid w | otherwise = w where cr = _creatures w IM.! cid itRef = _crInvSel cr item = _crInv cr IM.! itRef pointItem = (creatures . ix cid . crInv . ix itRef) currentRate = _wpFireRate item repeatFire = _wpReloadState item == 0 && _wpFireState item == 1 && _wpLoadedAmmo item > 0 firstFire = _wpReloadState item == 0 && _wpFireState item == 0 && _wpLoadedAmmo item > 0 reloadCondition = _wpLoadedAmmo item == 0 makeLaserAt :: Float -> Point2 -> Float -> Maybe Int -> Particle' makeLaserAt phaseV pos dir mcid = Particle' { _ptDraw = const blank , _ptUpdate' = moveLaser phaseV pos dir mcid } moveLaser :: Float -> Point2 -> Float -> Maybe Int -> World -> Particle' -> (World, Maybe Particle') moveLaser phaseV pos dir mcid w pt = ( set randGen g -- $ over worldEvents ((.) flares) $ hitEffect w , Just pt {_ptDraw = const $ onLayer PtLayer $ pic ,_ptUpdate' = ptTimer' 0 } ) where xp = pos +.+ 800 *.* unitVectorAtAngle dir (a,g) = randomR (-0.7,0.7) $ _randGen w reflectDir wall = a + (argV $ reflectIn (_wlLine wall !! 1 -.- _wlLine wall !! 0) (xp -.- pos) ) (colID,_) = randomR (0,11) $ _randGen w -- flares w = foldr (\p w' -> flareAt' yellow 0.01 0.02 p w') w flarePs -- flarePs = zipWith (\x y -> x +.+ 5 *.* normalizeV (y -.- x)) ps $ tail ps -- flarePos p = p +.+ ((a + 0.8) * 3) *.* (normalizeV (pos -.- p)) f :: [Wall] -> Point2 -> Point2 -> (Maybe (Point2,Either3 Creature Wall ForceField),[Point2]) f seenWs x y = case listToMaybe $ filter (h' seenWs) $ thingsHitExceptCrLongLine Nothing x y w of Just (p,E3x2 wl) | _wlIsSeeThrough wl -> f' p $ f (wl:seenWs) p (h x y wl p) | otherwise -> (Just (p,E3x2 wl), [p]) Just (p,obj) -> (Just (p,obj), [p]) Nothing -> (Nothing, [y]) f' p (x,ps') = (x,p:ps') h x y wl p | isEntering = p +.+ rotateV angleRef normalDist | otherwise = p +.+ rotateV angleRef' normalDist' where wlNormal = vNormal $ (_wlLine wl !! 1) -.- (_wlLine wl !! 0) normalDist = magV (p -.- y) *.* normalizeV wlNormal angleInc = piRange $ argV wlNormal - argV (x -.- y) angleRef | reflectExternal = angleInc | otherwise = asin $ sin angleInc / phaseV piRange a | a > pi = a - 2 * pi | a > 0 - pi = a | otherwise = a + 2 * pi isEntering = isLeftOf (x -.- y) ((_wlLine wl !! 1) -.- (_wlLine wl !! 0)) wlNormal' = vNormal $ (_wlLine wl !! 0) -.- (_wlLine wl !! 1) normalDist' = magV (p -.- y) *.* normalizeV wlNormal' angleInc' = piRange $ argV wlNormal' - argV (x -.- y) angleRef' | reflectInternal = angleInc' | otherwise = asin $ phaseV * sin angleInc' reflectInternal = 1 < abs (phaseV * sin angleInc') reflectExternal = 1 < abs (sin angleInc / phaseV) h' ws (_,E3x2 wl) = not $ any (\w -> _wlID w == _wlID wl) ws h' _ _ = True (thHit, ps) = f [] pos xp hitEffect = case thHit of Just (p,E3x1 cr) -> over (creatures . ix (_crID cr) . crState . crDamage) ((:) $ Lasering 3 pos p xp) -- . over worldEvents ((.) $ flareAt yellow (flarePos p)) Just (p,E3x2 wl) -> createSpark 8 colID (p +.+ safeNormalizeV (pos -.- p)) (reflectDir wl) Nothing _ -> id pic = pictures [ fadeLine pos (head ps) 0.2 40 yellow , setLayer 1 $ color (withAlpha 0.9 white) $ vThickLine (pos:ps) , setLayer 1 $ color (withAlpha 0.5 yellow) $ vvThickLine (pos:ps) ] fadeLine :: Point2 -> Point2 -> Float -> Float -> Color -> Picture fadeLine sp ep alph width col = setLayer 1 $ polygonCol [(sp , ca) ,(sp +.+ n , cb) ,(ep +.+ n , cb) ,(ep , ca) ,(ep -.- n , cb) ,(sp -.- n , cb) ] where n = width *.* (normalizeV $ vNormal $ ep -.- sp) ca = withAlpha alph col cb = withAlpha 0 col -- pictures [color (withAlpha (0.8 * alph) col) $ lineOfThickness width [sp,p 0.25] -- ,color (withAlpha (0.6 * alph) col) $ lineOfThickness width [p 0.25,p 0.5] -- ,color (withAlpha (0.4 * alph) col) $ lineOfThickness width [p 0.5,p 0.75] -- ,color (withAlpha (0.2 * alph) col) $ lineOfThickness width [p 0.75,ep] -- ] -- where p x = sp +.+ x *.* (ep -.- sp) grenadeLauncher :: Item grenadeLauncher = pistol grenade,remoteBomb :: Item grenade = Throwable { _itName = "GRENADE " ++ show fuseTime , _itIdentity = Grenade , _itMaxStack = 8 , _itAmount = 1 , _itFloorPict = onLayer FlItLayer $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)] , _twMaxRange = 150 , _twAccuracy = 30 , _twFire = throwGrenade fuseTime , _itAimingSpeed = 1 , _itAimingRange = 0 , _itZoom = defaultItZoom {_itAimZoomMax = (f fuseTime), _itAimZoomMin = (f fuseTime)} , _itEquipPict = drawWeapon $ grenadePic fuseTime , _itID = Nothing , _itAttachment = Just $ ItFuse fuseTime , _itInvColor = white , _itInvDisplay = _itName , _itEffect = wpRecock , _itHammer = HammerUp , _itScrollUp = decreaseFuse fuseTime , _itScrollDown = increaseFuse fuseTime } where fuseTime = 50 f x = 50 / fromIntegral x flameGrenade :: Item flameGrenade = grenade { _itName = "FLMGREN " ++ show fuseTime , _twFire = throwGrenade' makeFlameExplosionAt fuseTime } where fuseTime = 50 f x = 50 / fromIntegral x teslaGrenade :: Item teslaGrenade = grenade { _itName = "TLSGREN " ++ show fuseTime , _twFire = throwGrenade' makeTeslaExplosionAt fuseTime } where fuseTime = 50 f x = 50 / fromIntegral x increaseFuse :: Int -> Int -> World -> World increaseFuse fuse i w = w & creatures . ix 0 . crInv . ix itRef . itScrollUp .~ decreaseFuse newTime & creatures . ix 0 . crInv . ix itRef . itScrollDown .~ increaseFuse newTime & creatures . ix 0 . crInv . ix itRef . twFire .~ throwGrenade newTime & creatures . ix 0 . crInv . ix itRef . itName .~ "GRENADE " ++ show newTime & creatures . ix 0 . crInv . ix itRef . itAttachment .~ Just (ItFuse newTime) & creatures . ix 0 . crInv . ix itRef . itZoom .~ (defaultItZoom {_itAimZoomMax = zm, _itAimZoomMin = zm}) where itRef = fromMaybe (-2) $ w ^? creatures . ix 0 . crInvSel newTime = min (fuse + 5) 90 zm = 50 / fromIntegral newTime decreaseFuse :: Int -> Int -> World -> World decreaseFuse fuse i w = w & creatures . ix 0 . crInv . ix itRef . itScrollUp .~ decreaseFuse newTime & creatures . ix 0 . crInv . ix itRef . itScrollDown .~ increaseFuse newTime & creatures . ix 0 . crInv . ix itRef . twFire .~ throwGrenade newTime & creatures . ix 0 . crInv . ix itRef . itName .~ "GRENADE " ++ show newTime & creatures . ix 0 . crInv . ix itRef . itAttachment .~ Just (ItFuse newTime) & creatures . ix 0 . crInv . ix itRef . itZoom .~ (defaultItZoom {_itAimZoomMax = zm, _itAimZoomMin = zm}) where itRef = fromMaybe (-2) $ w ^? creatures . ix 0 . crInvSel newTime = max (fuse - 5) 20 zm = 50 / fromIntegral newTime defaultThrowable = grenade remoteBomb = defaultThrowable { _itName = "REMOTEBOMB" , _itIdentity = RemoteBomb , _itMaxStack = 1 , _itAmount = 1 , _itFloorPict = onLayer FlItLayer $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)] , _twMaxRange = 150 , _twAccuracy = 30 , _twFire = throwRemoteBomb , _itAttachment = Just $ ItScope (0,0) 0 1 True , _itEquipPict = drawWeapon $ remoteBombUnarmedPic } throwGrenade' :: (Point2 -> World -> World) -> Int -> Int -> World -> World throwGrenade' explosion fuseTime n w = setWp $ removePict $ over projectiles addG $ set randGen g w where addG = IM.insert i $ Shell { _ptPos = p , _ptStartPos = p , _ptVel = v , _ptPict = onLayer PtLayer $ uncurry translate p $ grenadePic 0 , _ptID = i , _ptUpdate = moveGrenade fuseTime dir i , _ptExplosion = explosion } j = _crInvSel $ _creatures w IM.! n removePict = set (creatures . ix n . crInv . ix j . itEquipPict) $ \ _ _ -> blank i = newProjectileKey w (a, g) = randomR (-grenadeAccA,grenadeAccA::Float) (_randGen w) (l, _) = randomR (1 - 2*grenadeAccL,1+grenadeAccL::Float) g -- v = 0.02 * l / _cameraZoom w *.* rotateV (a+_cameraRot w) (limitRange $ _mousePos w) v' = 1 / (fromIntegral fuseTime * _cameraZoom w) *.* rotateV (_cameraRot w) ( _mousePos w) v | magV v' > 6 = 6 *.* normalizeV v' | otherwise = v' cr = _creatures w IM.! n p' = _crPos cr +.+ rotateV (_crDir cr) (_crRad cr,0) p | circOnSomeWall p' 4 w = _crPos cr +.+ rotateV (_crDir cr) (_crRad cr-4,0) | otherwise = p' dir = argV v setWp :: World -> World setWp w' = w' & creatures . ix n . crInv . ix j . itEffect .~ throwArmReset 20 throwGrenade :: Int -> Int -> World -> World throwGrenade = throwGrenade' makeExplosionAt -- setWp $ removePict $ over projectiles addG $ set randGen g w -- where addG = IM.insert i -- $ Shell { _ptPos = p -- , _ptStartPos = p -- , _ptVel = v -- , _ptPict = onLayer PtLayer $ uncurry translate p $ grenadePic 0 -- , _ptID = i -- , _ptUpdate = moveGrenade fuseTime dir i -- , _ptExplosion = makeExplosionAt -- } -- j = _crInvSel $ _creatures w IM.! n -- removePict = set (creatures . ix n . crInv . ix j . itEquipPict) $ \ _ _ -> blank -- i = newProjectileKey w -- (a, g) = randomR (-grenadeAccA,grenadeAccA::Float) (_randGen w) -- (l, _) = randomR (1 - 2*grenadeAccL,1+grenadeAccL::Float) g -- -- v = 0.02 * l / _cameraZoom w *.* rotateV (a+_cameraRot w) (limitRange $ _mousePos w) -- v' = 1 / (fromIntegral fuseTime * _cameraZoom w) *.* rotateV (_cameraRot w) ( _mousePos w) -- v | magV v' > 6 = 6 *.* normalizeV v' -- | otherwise = v' -- cr = _creatures w IM.! n -- p' = _crPos cr +.+ rotateV (_crDir cr) (_crRad cr,0) -- p | circOnSomeWall p' 4 w = _crPos cr +.+ rotateV (_crDir cr) (_crRad cr-4,0) -- | otherwise = p' -- dir = argV v -- setWp :: World -> World -- setWp w' = w' & creatures . ix n . crInv . ix j . itEffect .~ throwArmReset 20 throwArmReset :: Int -> ItEffect throwArmReset x = ItInvEffect {_itInvEffect = f ,_itEffectCounter = x } where f cr i = creatures . ix (_crID cr) . crInv %~ IM.adjust counterDown i counterDown it | _itEffectCounter (_itEffect it) == 0 = it & itHammer .~ HammerUp & itEquipPict .~ (drawWeapon $ grenadePic 50) | otherwise = it & itEffect . itEffectCounter %~ (\x -> x - 1) (grenadeAccL, grenadeAccA) = (0.1, 0.1) grenadePic :: Int -> Picture grenadePic x = pictures [ color (dark $ dark green) $ circleSolid 5 , color green $ arc (degToRad $ (179 * fromIntegral x / 50) - 180 ) (degToRad $ 180 - (179 * fromIntegral x / 50) ) 5 , translate (-2) 2 $ rotate (pi*0.5) $ scale 0.05 0.05 $ color green $ text $ show $ 1 + quot x 20 ] fireRemoteLauncher :: Int -> World -> World fireRemoteLauncher cid w = setLocation $ resetFire $ resetName $ soundOnce (fromIntegral launcherSound) $ over projectiles remRocket w where i = newKey $ _projectiles w cr = _creatures w IM.! cid dir = _crDir cr pos = _crPos cr +.+ rotateV dir (_crRad cr + 1,0) remRocket = IM.insert i $ Projectile { _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 (projectiles . ix i . ptPos) (+.+ vel) $ set (projectiles . ix i . ptPict) piclow $ set (projectiles . ix i . ptUpdate) (moveRemoteShell (time-1) i cid itid newdir) $ setScope w | time >= 20 = case thingHit of Just p -> doExplosion w Nothing -> over (projectiles . ix i . ptPos) (+.+ vel) $ set (projectiles . ix i . ptPict) pic $ set (projectiles . 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 (projectiles . ix i . ptPos) (+.+ vel) $ set randGen g $ set (projectiles . ix i . ptPict) pic $ set (projectiles . ix i . ptUpdate) (moveRemoteShell (time-1) i cid itid newdir) $ over (projectiles . ix i . ptVel) (\v -> accel +.+ frict *.* v) $ soundFrom (ShellSound i) (fromIntegral smokeTrailSound) (1) 250 $ smokeGen $ makeFlameletTimed oldPos (0.5 *.* rotateV (pi+sparkD) accel) Nothing 3 10 $ setScope w | time > -200 = case thingHit of Just p -> doExplosion $ stopSoundFrom (ShellSound i) w Nothing -> over (projectiles . ix i . ptPos) (+.+ vel) $ set (projectiles . ix i . ptPict) pic $ set (projectiles . ix i . ptUpdate) (moveRemoteShell (time-1) i cid itid newdir) $ setScope w | otherwise = doExplosion $ stopSoundFrom (ShellSound i) w where pt = _projectiles w IM.! i oldPos = _ptPos pt vel = _ptVel pt newPos = oldPos +.+ vel newdir | SDL.ButtonRight `S.member` (_mouseButtons w) && w ^? creatures . ix cid . crInvSel == w ^? itemPositions . ix itid . itInvId = _cameraRot w + (argV $ _mousePos w) | otherwise = dir accel = rotateV newdir (2,0) (frict,g) = randomR (0.6,0.9) $ _randGen w (sparkD,_) = randomR (-0.5,0.5) $ _randGen w dir = argV $ vel pic = onLayer PtLayer $ uncurry translate newPos $ rotate (argV accel) $ remoteShellPic time piclow = onLayerL [levLayer CrLayer - 2] $ uncurry translate newPos $ rotate (argV accel) $ remoteShellPic time hitCr = fmap fst $ collideCircCrsPoint oldPos newPos 4 w hitWl = fmap fst $ collideCircWalls' oldPos newPos 2 $ wallsNearPoint newPos w thingHit = hitCr <|> hitWl r1 = _randGen w & evalState (randInCirc 10) smokeGen = makeSmokeCloudAt (oldPos +.+ r1 +.+ 30 *.* (normalizeV (oldPos -.- newPos))) doExplosion = explodeRemoteRocket itid i cid setScope w' = case _itemPositions w' IM.! itid of InInv cid invid -> w' & creatures . ix cid . crInv . ix invid . itAttachment . _Just . scopePos .~ (newPos -.- _crPos (_creatures w' IM.! cid)) _ -> w' explodeRemoteRocket :: Int -> Int -> Int -> World -> World explodeRemoteRocket itid ptid n w = set (projectiles . ix ptid . ptUpdate) (retireRemoteRocket itid 30 ptid) $ set (projectiles . ix ptid . ptPict) blank $ set (itPoint . wpFire) (flip const) $ resetName $ makeExplosionAt (_ptPos (_projectiles w IM.! ptid)) w where resetName = set (itPoint . itName) "REMOTELAUNCHER" itPoint = pointToItem $ _itemPositions w IM.! itid throwRemoteBomb :: Int -> World -> World throwRemoteBomb n w = setLocation $ removePict $ resetFire $ resetName $ over projectiles addG w where addG = IM.insert i $ Projectile { _ptPos = p , _ptStartPos = p , _ptVel = v , _ptPict = blank , _ptID = i , _ptUpdate = moveRemoteBomb itid 50 i } i = newProjectileKey w -- fireDist = zoom *.* (rotateV (_cameraRot w) (_mousePos w) +.+ _cameraCenter w -.- yourPos) d = argV $ _mousePos w --(l, _) = randomR (1 - grenadeAccL,1+grenadeAccL) (_randGen w) --(a, g) = randomR (-grenadeAccA,grenadeAccA) (_randGen w) v' = 0.02 / _cameraZoom w *.* rotateV (_cameraRot w) ( _mousePos w) v | magV v' > 6 = 6 *.* normalizeV v' -- zoom = 1 / _cameraZoom w j = _crInvSel $ _creatures w IM.! n resetName = set (creatures . ix n . crInv . ix j . itName) "REMOTE" removePict = set (creatures . ix n . crInv . ix j . itEquipPict) $ \ _ _ -> blank resetFire = set (creatures . ix n . crInv . ix j . twFire) $ explodeRemoteBomb itid i cr = _creatures w IM.! n p' = _crPos cr +.+ rotateV (_crDir cr) (_crRad cr,0) p | circOnSomeWall p' 4 w = _crPos cr +.+ rotateV (_crDir cr) (_crRad cr-4,0) | otherwise = p' maybeitid = w ^? creatures . ix n . crInv . ix j . itID . _Just setLocation :: World -> World setLocation w' = case maybeitid of Nothing -> w' & creatures . ix n . crInv . ix j . itID .~ Just newitid & itemPositions %~ IM.insert newitid (InInv n j) _ -> w' newitid = newKey $ _itemPositions w itid = fromMaybe newitid maybeitid explodeRemoteBomb :: Int -> Int -> Int -> World -> World explodeRemoteBomb itid ptid n w = set (projectiles . ix ptid . ptUpdate) (retireRemoteBomb itid 30 ptid) $ set (projectiles . ix ptid . ptPict) blank $ set (creatures . ix n . crInv . ix j . twFire) (flip const) $ resetName $ resetPict -- $ resetScope $ makeExplosionAt (_ptPos (_projectiles w IM.! ptid)) w -- $ makeShrapnelBombAt (_ptPos (_projectiles w IM.! ptid)) w where resetName = set (creatures . ix n . crInv . ix j . itName) "REMOTEBOMB" resetPict = set (creatures . ix n . crInv . ix j . itEquipPict ) (drawWeapon $ remoteBombUnarmedPic) -- resetScope = creatures . ix n . crInv . ix j . itScope . _Just . scopePos .~ (0,0) j = _crInvSel $ _creatures w IM.! n remoteBombPic :: Int -> Picture remoteBombPic x = pictures [ color (dark $ dark orange) $ circleSolid 5 , rotate (0 - degToRad (fromIntegral x * 10 + 45)) $ color red $ arc 0 (pi/2) 5 , rotate (0 - degToRad (fromIntegral x * 10 + 45)) $ color (withAlpha 0.05 red) $ arcSolid 0 90 50 , rotate (0 - degToRad (fromIntegral x * 10 + 20)) $ color (withAlpha 0.05 red) $ arcSolid 0 40 40 , rotate (0 - degToRad (fromIntegral x * 10 + 10)) $ color (withAlpha 0.05 red) $ arcSolid 0 20 20 ] remoteBombUnarmedPic :: Picture remoteBombUnarmedPic = color (dark $ dark orange) $ circleSolid 5 makeTeslaArcAt :: Int -> Point2 -> Float -> Projectile makeTeslaArcAt i pos dir = Projectile { _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 (projectiles . ix i . ptPict) pic $ set (projectiles . ix i . ptUpdate) (ptTimer 2 i) $ set randGen g $ createSpark 8 nc q2 (argV sv + d1) Nothing $ foldr damCrs w hitCrs where pic = setLayer 1 $ pictures [ onLayer PtLayer $ color (f2 nc) $ line ps' , onLayer UPtLayer $ color (withAlpha 0.02 cyan) $ lineOfThickness 20 ps' , onLayer UPtLayer $ color (withAlpha 0.02 cyan) $ lineOfThickness 25 ps' , onLayer UPtLayer $ color (withAlpha 0.02 cyan) $ lineOfThickness 30 ps' ] ps' = lightningMids d pers ps ps = take 15 $ p : map f (crsLightChain p d 0 w) f (E3x1 cr) = _crPos cr f (E3x2 p1) = p1 f (E3x3 p1) = p1 pers = evalState (sequence $ repeat $ randInCirc 5) $ _randGen w (nc,g) = randomR (0::Int,11) $ _randGen w f1 (E3x1 cr) = Just $ _crID cr f1 _ = Nothing hitCrs = mapMaybe f1 $ take 14 $ crsLightChain p d 0 w damCrs i = over (creatures . ix i . crHP) (\hp -> hp - 5) f2 0 = cyan f2 1 = azure f2 _ = white sID = newProjectileKey w q1 = last $ init ps' q2 = last ps' hitWall = collidePointWalls q1 ((2 *.* q2) -.- q1) $ wallsNearPoint q1 w (d1,_) = randomR (-0.7,0.7) $ _randGen w sv = fromMaybe (q2 -.- q1) $ fmap snd hitWall lightningMid :: Float -> Point2 -> Point2 -> Point2 lightningMid d p1 p2 = (0.25 *.* (p1 +.+ p2)) +.+ 0.5 *.* p3 where p3 = errorClosestPointOnLine 1 p1 (p1 +.+ unitVectorAtAngle d) p2 lightningMids :: Float -> [Point2] -> [Point2] -> [Point2] lightningMids d1 (p:pers) (p1:p3:ps) = let p2 = p +.+ lightningMid d1 p1 p3 d2 = argV $ p3 -.- p2 in p1 : p2 : lightningMids d2 pers (p3:ps) lightningMids _ _ ps = ps crsLightChain' :: Point2 -> Float -> World -> [Either3 Creature Point2 Point2] crsLightChain' p d w = case crOrWall p d w of E3x1 cr -> E3x1 cr : crsLightChain' (_crPos cr) (argV (_crPos cr -.- p)) w E3x2 p1 -> [E3x2 p1] E3x3 p1 -> E3x3 p1 : crsLightChain' p1 (dChange + argV (p1 -.- p)) (set randGen g w) -- where (dChange, g) = (0, _randGen w) where (dChange, g) = randomR (-0.05,0.05) $ _randGen w crsLightChain :: Point2 -> Float -> Float -> World -> [Either3 Creature Point2 Point2] crsLightChain p d wlAttract w = case crOrWallSensitive p d wlAttract w of E3x1 cr -> E3x1 cr : crsLightChain (_crPos cr) (argV (_crPos cr -.- p)) (min 1 (wlAttract + 0.3)) w E3x2 p1 -> [E3x2 p1] E3x3 p1 -> E3x3 p1 : crsLightChain p1 (dChange + argV (p1 -.- p)) (min 1 (wlAttract + 0.3)) (set randGen g w) -- where (dChange, g) = (0, _randGen w) where (dChange, g) = randomR (-0.05,0.05) $ _randGen w crOrWallSensitive :: Point2 -> Float -> Float -> World -> Either3 Creature Point2 Point2 crOrWallSensitive p dir wlAttract w = fromMaybe (E3x3 $ p +.+ rotateV dir (arcLen,0)) $ listToMaybe $ sortBy (compare `on` g) $ catMaybes [cr,wlp] where cr = fmap E3x1 $ nearestCrInFront p dir 100 w wlp = fmap E3x2 $ listToMaybe $ sortBy (compare `on` dist p) $ mapMaybe ( fmap fst . (\p1 -> collidePointWalls p p1 $ wallsNearPoint p w) . (+.+) p . (\d -> rotateV d (100,0)) . (+) dir ) (fmap (*wlAttract) [-(3*pi/8),-pi/4,-pi/8,0,pi/8,pi/4,3*pi/8]) --[-pi/4,-pi/8,0,pi/8,pi/4] g (E3x2 p1) = 100 + dist p p1 -- tweak makes it more likely to hit crs first --g (E3x2 p1) = dist p p1 - 100 -- tweak makes it more likely to hit walls first g (E3x1 cr1) = dist p $ _crPos cr1 (arcLen,_) = randomR (25,50) $ _randGen w -- BUG: can hit crs through walls crOrWall :: Point2 -> Float -> World -> Either3 Creature Point2 Point2 crOrWall p dir w = fromMaybe (E3x3 $ p +.+ rotateV dir (arcLen,0)) $ listToMaybe $ sortBy (compare `on` g) $ catMaybes [cr,wlp] where cr = fmap E3x1 $ nearestCrInFront p dir 100 w wlp = fmap E3x2 $ listToMaybe $ sortBy (compare `on` dist p) $ mapMaybe ( fmap fst . (\p1 -> collidePointWalls p p1 $ wallsNearPoint p w) . (+.+) p . (\d -> rotateV d (100,0)) . (+) dir ) [-(3*pi/8),-pi/4,-pi/8,0,pi/8,pi/4,3*pi/8] --[-pi/4,-pi/8,0,pi/8,pi/4] g (E3x2 p1) = 100 + dist p p1 -- tweak makes it more likely to hit crs first --g (E3x2 p1) = dist p p1 - 100 -- tweak makes it more likely to hit walls first g (E3x1 cr1) = dist p $ _crPos cr1 (arcLen,_) = randomR (25,50) $ _randGen w spreadGunSpread,autogunSpread :: Float spreadGunSpread = 0.5 autogunSpread = 0.07 pipe = Craftable { _itIdentity = Generic , _itName = "PIPE" , _itMaxStack = 3 , _itAmount = 3 , _itFloorPict = onLayer FlItLayer $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)] , _itEquipPict = \cr _ -> blank , _itID = Nothing , _itInvDisplay = _itName , _itInvColor = green } magShield = defaultEquipment { _itIdentity = MagShield , _itName = "MAGSHIELD" , _itMaxStack = 1 , _itAmount = 1 , _itFloorPict = onLayer FlItLayer $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)] , _itEquipPict = \cr _ -> blank , _itID = Nothing } flameShield = defaultEquipment { _itIdentity = FlameShield , _itName = "FLAMESHIELD" , _itMaxStack = 1 , _itAmount = 1 , _itFloorPict = onLayer FlItLayer $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)] , _itEquipPict = (\cr _ -> onLayer CrLayer $ pictures [color cyan $ circle (_crRad cr+2)] ) , _itID = Nothing } frontArmour = defaultEquipment { _itIdentity = FrontArmour , _itName = "FARMOUR" , _itMaxStack = 1 , _itAmount = 1 , _itFloorPict = onLayer FlItLayer $ translate 0 (-5) $ pictures [color (greyN 0.1) $ thickArc 0 (pi/2) 10 5 ,color (greyN 0.1) $ thickArc (3*pi/2) (2*pi) 10 5 ] , _itEquipPict = (\cr _ -> onLayer CrLayer $ pictures [color (greyN 0.1) $ thickArc 0 (pi/2) 10 5 ,color (greyN 0.1) $ thickArc (3*pi/2) (2*pi) 10 5 ] ) , _itEffect = NoItEffect , _itID = Nothing } jetPack = defaultEquipment { _itIdentity = JetPack , _itName = "JETPACK" , _itMaxStack = 1 , _itAmount = 1 , _itFloorPict = onLayer FlItLayer $ color yellow $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)] , _itEquipPict = (\cr _ -> onLayer CrLayer $ pictures [color yellow $ polygon $ rectNSEW 5 (-5) (-3) (-11) ] ) , _itEffect = NoItEffect , _itID = Nothing } latchkey :: Int -> Item latchkey n = defaultEquipment { _itIdentity = Generic , _itName = "KEY "++show n , _itMaxStack = 1 , _itAmount = 1 , _itFloorPict = onLayer FlItLayer $ latchkeyPic , _itEquipPict = \cr _ -> onLayer PtLayer $ translate (-5) (-5) $ rotate (pi/2.5) latchkeyPic , _itEffect = NoItEffect , _itHammer = HammerUp , _itID = Nothing , _itAimingSpeed = 1 , _itAimingRange = 0 , _itZoom = defaultItZoom , _itInvColor = yellow , _itInvDisplay = _itName } latchkeyPic = color yellow $ pictures [translate (-4) 0 $ thickCircle 4 2 ,lineOfThickness 2 [(0,0),(8,0),(8,-4)] ,lineOfThickness 2 [(4,0),(4,-4)] ] -- }}} forceFieldFire :: Int -> World -> World forceFieldFire cid w = w --shatterGunFire :: Int -> World -> World --shatterGunFire n w | fireCondition = -- soundOnce 0 -- set (creatures . ix n . crInv . ix itRef . wpFireState) -- (_wpFireRate (_crInv cr IM.! itRef)) -- $ over (creatures . ix n . crInv . ix itRef . wpLoadedAmmo) -- (\x -> x - 1) -- $ over projectiles (IM.insert i $ makeTremorAt i pos dir) w -- | reloadCondition = let remAmmo = _crAmmo cr M.! _wpAmmoType item -- (newA,newTotalA) = moveInt (_wpMaxAmmo item) remAmmo -- in set (pointerToItem . wpReloadState) rTime -- $ set (pointerToItem . wpLoadedAmmo) newA -- $ over (creatures . ix n . crAmmo ) -- (M.insert (_wpAmmoType item) newTotalA) w -- | emptyCondition = soundOnce 1 w -- | otherwise = w -- where i = newProjectileKey w -- cr = (_creatures w IM.! n) -- pos = _crPos cr +.+ ((_crRad cr +1) *.* unitVectorAtAngle dir) -- dir = _crDir cr -- --(colID, _) = randomR (0,11) (_randGen w) -- itRef = _crInvSel cr -- item = _crInv cr IM.! itRef -- pointerToItem = creatures . ix n . crInv . ix itRef -- rTime = _wpReloadTime (_crInv cr IM.! itRef) -- fireCondition = _wpReloadState (_crInv cr IM.! itRef) == 0 -- && _wpFireState (_crInv cr IM.! itRef) == 0 -- && _wpLoadedAmmo (_crInv cr IM.! itRef) > 0 -- reloadCondition = _wpReloadState (_crInv cr IM.! itRef) == 0 -- && _wpLoadedAmmo (_crInv cr IM.! itRef) == 0 -- && someJust (_crAmmo cr M.!? PistolBullet) -- emptyCondition = _wpLoadedAmmo (_crInv cr IM.! itRef) == 0 --for reloading, we take from the total ammo moveInt :: Int -> Int -> (Int,Int) moveInt toReload totalAmmo = (x, totalAmmo-x) where x = min toReload totalAmmo updateTractor :: Int -> Int -> Int -> World -> World updateTractor colID time i w | time > 0 = set (projectiles . ix i . ptUpdate) (updateTractor colID (time-1) i) $ set (projectiles . ix i . ptPict) pic $ over creatures (IM.map tractCr) $ over floorItems (IM.map tractFlIt) w | otherwise = over projectiles (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 = _projectiles w IM.! i q = _ptVel pt p1 = _ptPos pt p' = _ptStartPos pt p2 = fromMaybe p' $ fmap fst $ collidePointWalls p1 p' $ wallsNearPoint p' w p4 = vNormal p5 p5 = errorNormalizeV 12 $ p2 -.- p1 p3 = p1 +.+ p4 g x | x > 5 = (10 - x) / 5 | x > 1 = 1 | x > -1 = x | x > -5 = -1 | otherwise = (x - 10) / 5 d = errorNormalizeV 13 $ p' -.- p1 f x = g x / 50 cID = fromIntegral colID / 10 col = mixColors 0.5 0.5 white blue px z = (fromIntegral time + 5) *.* z pz z = fromIntegral time * 10 *.* z pic = onLayer PtLayer $ color (withAlpha 0.05 col) $ polygon [ p1 +.+ px p4 , p1 -.- 10 *.* p5 , p1 -.- px p4 , (p' -.- pz p5) -.- px p4 , (p' -.- pz p5) +.+ px p4] thickLine :: [Point2] -> Picture thickLine = lineOfThickness 2 vThickLine :: [Point2] -> Picture vThickLine = lineOfThickness 3 vvThickLine :: [Point2] -> Picture vvThickLine = lineOfThickness 6 thinLine :: [Point2] -> Picture thinLine = lineOfThickness 1 someJust (Just x) | x > 0 = True | otherwise = False shakeCr :: Int -> Float -> World -> World shakeCr cID amount w = let vec = vNormal $ unitVectorAtAngle $ _crDir $ _creatures w IM.! cID (x,g) = randomR (-amount,amount) $ _randGen w in set randGen g . over (creatures . ix cID . crPos) (+.+ (x *.* vec)) $ w radar = defaultGun { _itName = "RADAR" , _itIdentity = Generic , _wpMaxAmmo = 100 , _wpLoadedAmmo = 100 , _wpReloadTime = 200 , _wpReloadState = 0 , _wpFireRate = 120 , _wpFireState = 0 , _wpFire = shoot $ aRadarPulse , _wpSpread = autogunSpread , _wpRange = 20 , _itHammer = HammerUp , _itFloorPict = onLayer FlItLayer $ color blue $ polygon $ rectNESW 5 5 (-5) (-5) , _itAmount = 1 , _itMaxStack = 1 , _itAimingRange = 1 , _itZoom = defaultItZoom {_itAimZoomMax = 1, _itZoomMax = 1} , _itEquipPict = drawWeapon $ color blue $ polygon $ rectNESW 5 5 (-5) (-5) } sonar = defaultGun { _itName = "SONAR" , _itIdentity = Generic , _wpMaxAmmo = 100 , _wpLoadedAmmo = 100 , _wpReloadTime = 200 , _wpReloadState = 0 , _wpFireRate = 120 , _wpFireState = 0 , _wpFire = shoot $ aSonarPulse , _wpSpread = autogunSpread , _wpRange = 20 , _itHammer = HammerUp , _itFloorPict = onLayer FlItLayer $ color blue $ polygon $ rectNESW 5 5 (-5) (-5) , _itAmount = 1 , _itMaxStack = 1 , _itAimingRange = 1 , _itZoom = defaultItZoom {_itAimZoomMax = 1, _itZoomMax = 1} , _itEquipPict = drawWeapon $ color blue $ polygon $ rectNESW 5 5 (-5) (-5) } aSonarPulse :: Int -> World -> World aSonarPulse cid w = over particles' ((:) $ sonarPulseAt (_crPos (_creatures w IM.! cid))) w aRadarPulse :: Int -> World -> World aRadarPulse cid w = over particles' ((:) $ radarPulseAt (_crPos (_creatures w IM.! cid))) w blipAt :: Point2 -> Color -> Int -> Particle' blipAt p col i = Particle' {_ptDraw = const blank ,_ptUpdate' = mvBlip p col i i } mvBlip :: Point2 -> Color -> Int -> Int -> World -> Particle' -> (World, Maybe Particle') mvBlip p col maxt 0 w pt = (w, Nothing) mvBlip p col maxt t w pt = (w, Just $ pt & ptUpdate' .~ mvBlip p col maxt (t-1) & ptDraw .~ (const $ onLayerL [levLayer ShadowLayer, 2] $ uncurry translate p $ color (withAlpha (fromIntegral t / fromIntegral maxt) col) $ circleSolid 2) ) sonarPulseAt :: Point2 -> Particle' sonarPulseAt p = Particle' { _ptDraw = const blank , _ptUpdate' = mvSonar 100 p } mvSonar :: Int -> Point2 -> World -> Particle' -> (World, Maybe Particle') mvSonar 0 _ w _ = (w, Nothing) mvSonar x p w pt = (w, Just $ pt {_ptDraw = const pic ,_ptUpdate' = mvSonar (x-1) p } ) where pic = 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' { _ptDraw = const blank , _ptUpdate' = mvRadar 50 p } mvRadar :: Int -> Point2 -> World -> Particle' -> (World, Maybe Particle') mvRadar 0 _ w _ = (w, Nothing) mvRadar x p w pt = (putBlips w, Just $ pt {_ptDraw = const pic ,_ptUpdate' = mvRadar (x-1) p } ) where pic = onLayerL [levLayer ShadowLayer, 1] $ pictures $ sweepPics putBlips = over worldEvents ((.) $ over particles' ((++) blips)) blips = map (\p -> blipAt p (withAlpha (0.5*globalAlpha) red) 50) $ circPoints circPoints = mapMaybe (\wl -> collidePointCircCorrect (_wlLine wl !! 0) (_wlLine wl !! 1) r p) $ (map (over wlLine reverse) $ IM.elems $ wallsAlongCirc p r w) ++ (IM.elems $ wallsAlongCirc p r w) r = fromIntegral (800 - x*16) sweepPics = [--colHelper 0.1 $ uncurry translate p $ thickCircle r 15 --,colHelper 0.06 $ uncurry translate p $ thickCircle (r-5) 5 --,colHelper 0.03 $ uncurry translate p $ thickCircle (r-10) 5 ] globalAlpha | x > 10 = 1 | otherwise = fromIntegral x / 10 colHelper y = color (withAlpha (y * globalAlpha) red) autoSonar = defaultEquipment { _itIdentity = Generic , _itName = "AUTOSONAR" , _itMaxStack = 1 , _itAmount = 1 , _itFloorPict = onLayer FlItLayer $ color yellow $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)] , _itEquipPict = \cr _ -> blank , _itEffect = autoSonarEffect , _itID = Nothing , _itAimingSpeed = 1 , _itAimingRange = 0 , _itZoom = defaultItZoom {_itAimZoomMax = 1, _itZoomMax = 1} } autoRadar = defaultEquipment { _itIdentity = Generic , _itName = "AUTORADAR" , _itMaxStack = 1 , _itAmount = 1 , _itFloorPict = onLayer FlItLayer $ color yellow $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)] , _itEquipPict = \cr _ -> blank , _itEffect = autoRadarEffect , _itID = Nothing , _itAimingSpeed = 1 , _itAimingRange = 0 , _itZoom = defaultItZoom {_itAimZoomMax = 1, _itZoomMax = 1} } autoRadarEffect :: ItEffect autoRadarEffect = ItInvEffect {_itInvEffect = f 50 ,_itEffectCounter = 0 } where f 0 cr i w = aRadarPulse (_crID cr) w & creatures . ix (_crID cr) . crInv . ix i . itEffect . itInvEffect .~ f 100 f t cr i w = w & creatures . ix (_crID cr) . crInv . ix i . itEffect . itInvEffect .~ f (t-1) autoSonarEffect :: ItEffect autoSonarEffect = ItInvEffect {_itInvEffect = f 50 ,_itEffectCounter = 0 } where f 0 cr i w = aSonarPulse (_crID cr) w & creatures . ix (_crID cr) . crInv . ix i . itEffect . itInvEffect .~ f 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 & laserScopeTargetGlow col glowPoint -- this flare MAY be buggy... something to do with the creature glare | otherwise = w where p = _crPos cr d = _crDir cr r = _crRad cr sp = (p +.+ (r + 3) *.* unitVectorAtAngle d) xp = sp +.+ 3000 *.* unitVectorAtAngle d ep = case listToMaybe $ thingsHitLongLine sp xp w of Just (p,_) -> p Nothing -> xp glowPoint = case listToMaybe $ thingsHitLongLine sp xp w of Just (p,E3x2 wl) -> p +.+ 2 *.* wallNormal wl _ -> (ep -.- 2 *.* unitVectorAtAngle d) it = (cr ^. crInv) IM.! invid reloadFrac | _wpLoadedAmmo it == 0 = 1 | otherwise = fromIntegral (_wpReloadState it) / fromIntegral (_wpReloadTime it) col = mixColors reloadFrac (1-reloadFrac) red green moveHammerUp !HammerDown = HammerReleased moveHammerUp !_ = HammerUp makeLaserScope :: Point2 -> Point2 -> Float -> Float -> Particle' makeLaserScope p ep d relFrac = Particle' {_ptDraw = const $ onLayer PtLayer $ pictures [color (withAlpha 0.5 $ mixColors relFrac (1-relFrac) red green) $ lineOfThickness 0.5 [p,ep] ,color (withAlpha 0.2 $ mixColors relFrac (1-relFrac) red green) $ lineOfThickness 1.5 [p,ep] ,color (withAlpha 0.1 $ mixColors relFrac (1-relFrac) red green) $ lineOfThickness 2 [p,ep] ] ,_ptUpdate' = \w pt -> (w, Just $ pt & ptUpdate' .~ \w' _ -> (w',Nothing)) }