diff --git a/src/Dodge/Creature.hs b/src/Dodge/Creature.hs index 9a7ce956b..8e516554e 100644 --- a/src/Dodge/Creature.hs +++ b/src/Dodge/Creature.hs @@ -245,7 +245,6 @@ startCr = defaultCreature , _crDir = 0 , _crID = 0 , _crPict = basicCrPict $ greyN 0.8 - , _crUpdate = stateUpdate yourControl , _crRad = 10 , _crMass = 10 @@ -275,21 +274,6 @@ startCr = defaultCreature ,poisonSprayer ] ++ repeat NoItem)) - -- startInv --- ([pistol,flameGrenade, teslaGrenade, autoGun,launcher,flameLauncher, poisonLauncher, teslaLauncher, lasGun,grenade --- ,ltAutoGun,flamer,multGun,spreadGun,remoteLauncher --- ,longGun --- ,hvAutoGun --- ,teslaGun --- ,latchkey 0 --- ,miniGun --- ,medkit 50 --- ,bezierGun --- ,poisonSprayer --- ,blinkGun --- ] --- ++ repeat NoItem)) --- -- startInv , _crCorpse = onLayer CorpseLayer $ color (greyN 0.5) $ pictures [color (greyN 0.8) $ circleSolid 10, circLine 10] } diff --git a/src/Dodge/Item/Weapon.hs b/src/Dodge/Item/Weapon.hs index 12846e785..090f6489c 100644 --- a/src/Dodge/Item/Weapon.hs +++ b/src/Dodge/Item/Weapon.hs @@ -890,26 +890,6 @@ aGasCloud cid w 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 @@ -929,119 +909,7 @@ aFlame a cid w resetAngle = set (creatures . ix cid . crInv . ix (_crInvSel cr) . wpFire) (shoot $ aFlame angle) --- The following should be improved.... I've made a first pass -makePoisonExplosionAt :: Point2 -> World -> World -makePoisonExplosionAt p w = soundOnce grenadeBang $ foldr (makeGasCloud p) w vels - where - vels = evalState (sequence ( replicate 25 (randInCirc 2) )) (_randGen w) --- just change the number after replicate to get more or less clouds --- suggested change: use random positions, offset from p, rather than velocities --- so, p +.+ randomOffset --- currently the clouds push away from each other rather hard if they are close -makeTeslaExplosionAt :: Point2 -> World -> World -makeTeslaExplosionAt pos w = soundOnce grenadeBang $ foldr ($) w listOfFunctions -- a bit shorter - where - -- rad or 360? Radians (hopefully) everywhere - xs = randomRs (0, 2*pi) $ _randGen w - p = newProjectileKey w - pks = [p..] - listOfFunctions = map - (\i -> over projectiles (IM.insert (pks!!i) (makeTeslaArcAt (pks!!i) pos (xs!!i)))) - [1 .. 29] - --- slightly more work done on this one, want the flames to last for different --- times --- the new flames are directly added to the list of particles -makeFlameExplosionAt :: Point2 -> World -> World -makeFlameExplosionAt p w = soundOnce grenadeBang $ over particles' (newFlames ++ ) w - where - newFlames = zipWith makeFlameWithVelAndTime velocities timers - makeFlameWithVelAndTime vel time = aFlameParticle time p vel Nothing - velocities = evalState (sequence ( replicate 15 (randInCirc 1) )) (_randGen w) - timers = randomRs (80,100) $ _randGen w - -- the ( Nthing :: Maybe Int ) here is "maybe" a creature id that the - -- particle passes through for the first frame of its existence - --- take out the flame particle from makeFlame -aFlameParticle :: Int -> Point2 -> Point2 -> Maybe Int -> Particle' -aFlameParticle t pos vel maycid = Pt' - { _ptDraw = drawFlame vel - , _ptUpdate' = moveFlame vel - , _btVel' = vel - , _btColor' = red - , _btPos' = pos - , _btPassThrough' = maycid - , _btWidth' = 4 - , _btTimer' = t - , _btHitEffect' = destroyOnImpact (doFlameDam 1) noEff noEff - } - -makeFlame :: Point2 -> Point2 -> Maybe Int -> World -> World -makeFlame pos vel maycid = over particles' (aFlameParticle 100 pos vel maycid : ) - -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 @@ -1663,123 +1531,6 @@ 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 diff --git a/src/Dodge/Rooms.hs b/src/Dodge/Rooms.hs index d8b8f273e..eae5c6180 100644 --- a/src/Dodge/Rooms.hs +++ b/src/Dodge/Rooms.hs @@ -256,7 +256,7 @@ glassSwitchBack = do ,blockLine (wth-wllen, 2*hf) ( wth,2*hf) ,blockLine ( 0, 3*hf) (wllen,3*hf) ,blockLine (wth-wllen, 4*hf) ( wth,4*hf) - , PS (wth/2,hgt/2) 0 $ PutCrit lamp + , PS (wth/2,hgt/2) 0 $ putLamp ] return $ set rmPS plmnts $ roomRect' wth hgt 2 6 @@ -494,14 +494,13 @@ weaponLongCorridor = do i2 <- state $ randomR (2,5) let branch1 = treeTrunk (replicate i1 $ Left corridor) (connectRoom $ putCrs connectingRoom) let branch2 = treeTrunk (replicate i2 $ Left corridor) (deadRoom $ putWp corridorN) - return $ Node (Left $ addLS root) [branch1,branch2] + return $ Node (Left root) [branch1,branch2] where putCrs = set rmPS [PS (10,40) (-pi/2) $ randC ,PS (-10,40) (-pi/2) $ randC ] putWp = set rmPS [PS (20,40) 0 $ RandPS randFirstWeapon ,PS (20,60) 0 $ putLamp ] - addLS = id -- set rmPS [PS (0,60) 0 $ putLamp] critInDeadEnd :: Room critInDeadEnd = set rmPS [PS (0,0) 0 $ randC] deadEndRoom @@ -531,10 +530,11 @@ weaponRoom = do roomCCrits :: RandomGen g => State g (Tree (Either Room Room)) roomCCrits = do - ps <- sequence $ replicate 25 $ randInCirc 9 + ps <- sequence $ replicate 20 $ randInCirc 9 let plmnts = map (\p -> PS p 0 $ randC) $ zipWith (+.+) [(x,y) | x<-[110,130,150,170,190], y<- [70,90,110,130,150]] ps - return $ connectRoom $ over rmPS (++plmnts) $ roomC 200 200 + lamps = [PS (50,100) 0 putLamp , PS (175,100) 0 putLamp] + return $ connectRoom $ over rmPS ((lamps ++) . (plmnts ++)) $ roomC 200 200 branchRectWith :: RandomGen g => State g (Tree (Either Room Room)) -> State g (Tree (Either Room Room)) branchRectWith t = do diff --git a/src/Dodge/WorldEvent.hs b/src/Dodge/WorldEvent.hs index e117c2040..a09ee41e0 100644 --- a/src/Dodge/WorldEvent.hs +++ b/src/Dodge/WorldEvent.hs @@ -6,6 +6,8 @@ module Dodge.WorldEvent , module Dodge.WorldEvent.HelperParticle , module Dodge.WorldEvent.Cloud , module Dodge.WorldEvent.HitEffect + , module Dodge.WorldEvent.Explosion + , module Dodge.WorldEvent.SpawnParticle ) where @@ -15,6 +17,8 @@ import Dodge.WorldEvent.ThingsHit import Dodge.WorldEvent.HelperParticle import Dodge.WorldEvent.Cloud import Dodge.WorldEvent.HitEffect +import Dodge.WorldEvent.Explosion +import Dodge.WorldEvent.SpawnParticle import Dodge.LightSources import Dodge.Data @@ -34,25 +38,6 @@ import Data.Function import Data.List import qualified Data.IntMap.Strict as IM -makeExplosionAt :: Point2 -> World -> World -makeExplosionAt p w = soundOnce grenadeBang - . addFlames - . explosionFlashAt p - $ makeShockwaveAt p 50 10 1 white - w - where fVs = fst $ runState ((sequence . take 75 . repeat . randInCirc) 1) $ _randGen w - fPs' = evalState ((sequence . take 75 . repeat . randInCirc) 15) $ _randGen w - fPs = map (pushAgainstWalls . (+.+) p . (*.*) 0.5) - fPs' - inversePushOut v = (15 - magV v) * 0.01 *.* v - fVs' = zipWith (+.+) fVs $ map inversePushOut fPs' - sizes = randomRs (2,6) $ _randGen w - times = randomRs (20,25) $ _randGen w - mF q v size time = makeFlameletTimed q v Nothing size time - newFs = zipWith4 mF fPs (fmap (3 *.*) fVs') sizes times - addFlames w = foldr ($) w newFs - pushAgainstWalls q = fromMaybe q $ fmap (\(x,y)-> x +.+ y) - $ collidePointWalls p q $ wallsNearPoint q w shockWaveDamage :: Point2 -> Float -> Int -> World -> World shockWaveDamage p rad amount w = flip (foldr damageBlocks) hitBlocks $ over creatures (IM.map f) w @@ -67,75 +52,6 @@ shockWaveDamage p rad amount w = flip (foldr damageBlocks) hitBlocks $ over crea (_blIDs wall) _ -> w -makeShockwaveAt :: Point2 -> Float -> Int -> Float -> Color - -> World -> World -makeShockwaveAt p rad dam push col = over particles' ((:) theShockwave) - where theShockwave = shockwaveAt p rad dam push col 10 - -shockwaveAt :: Point2 -> Float -> Int -> Float -> Color -> Int -> Particle' -shockwaveAt p rad dam push col maxtime - = Shockwave' - { _ptDraw = const blank - , _ptUpdate' = mvShockwave' - , _btColor' = col - , _btPos' = p - , _btRad' = rad - , _btDam' = dam - , _btPush' = push - , _btMaxTime' = maxtime - , _btTimer' = maxtime - } - -mvShockwave' :: World -> Particle' -> (World, Maybe Particle') -mvShockwave' w pt - | _btTimer' pt <= 0 = (w, Nothing) - | otherwise - = (dams w , Just $ set btTimer' (t - 1) $ set ptDraw (const pic) pt) - where r = _btRad' pt - p = _btPos' pt - push = _btPush' pt - dam = _btDam' pt - t = _btTimer' pt - tFraction = fromIntegral t / fromIntegral (_btMaxTime' pt) - pic = onLayer PtLayer $ uncurry translate p - $ color (_btColor' pt) $ thickCircle rad thickness - rad = r - (3/4) * r * tFraction - thickness = tFraction**2 * r - dams = over creatures (IM.map damCr) . flip (foldr damageBlocks) hitBlocks - hitBlocks = wallsOnCirc p rad $ wallsNearPoint p w - damageBlocks wall w - = case wall ^? blHP of - Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 1)) - w - (_blIDs wall) - _ -> w - damCr cr | dist (_crPos cr) p < rad + _crRad cr - = over (crState . crDamage) - ((:) $ PushDam dam (25 * push *.* safeNormalizeV (_crPos cr -.- p))) - cr - | otherwise = cr -moveShockWave :: Int -> Point2 -> Float -> Float -> Float -> World -> Particle' -> (World, Maybe Particle') -moveShockWave 0 _ _ _ _ w _ = (w, Nothing) -moveShockWave t p r push pushexp w pt - = (dams w, Just $ newupdate $ newpic pt ) - where newupdate = set ptUpdate' $ moveShockWave (t-1) p r push pushexp - newpic = set ptDraw (const $ onLayer PtLayer $ uncurry translate p - $ color cyan $ thickCircle rad thickness) - rad = r - (3/40) * r * fromIntegral t - thickness = (fromIntegral t)**2 * rad / 40 - dams = over creatures (IM.map damCr) . flip (foldr damageBlocks) hitBlocks - hitBlocks = wallsOnCirc p rad $ wallsNearPoint p w - damageBlocks wall w - = case wall ^? blHP of - Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 1)) - w - (_blIDs wall) - _ -> w - damCr cr | dist (_crPos cr) p < rad + _crRad cr - = over (crState . crDamage) - ((:) $ PushDam 1 (25 *.* safeNormalizeV (_crPos cr -.- p))) - cr - | otherwise = cr inverseShockwaveAt :: Point2 -> Float -> Int -> Float -> Float -> World -> World inverseShockwaveAt p rad dam push pushexp = over particles' ((:) theShockwave) @@ -167,33 +83,6 @@ moveInverseShockWave t p r push pushexp w pt cr | otherwise = cr --- if the spark is created by another Particle', it cannot be directly added to --- the list, hence the redirect through worldEvents -createSpark :: Int -> Int -> Point2 -> Float -> Maybe Int -> World -> World -createSpark time colid pos dir maycid w = over worldEvents - ((.) $ ( over particles' ((:) spark) --- . flareAt' white 0.02 0.05 pos') - . sparkFlashAt pos') - ) w - where spark = Bul' { _ptDraw = drawBul - , _ptUpdate' = mvGenBullet' - , _btVel' = rotateV dir (5,0) - , _btColor' = numColor colid - , _btTrail' = [pos] - , _btPassThrough' = maycid - , _btWidth' = 1 - , _btTimer' = time - , _btHitEffect' = destroyOnImpact sparkEff noEff noEff - } - x = fst $ randomR (0,20) $ _randGen w - pos' = pos +.+ rotateV dir (x,0) - sparkEff bt p cr = over (creatures . ix (_crID cr) . crState . crDamage) - ((:) $ SparkDam 1 sp p ep) - where sp = head (_btTrail' bt) - ep = sp +.+ _btVel' bt - -drawBul :: Particle' -> Picture -drawBul pt = setLayer 1 . color white $ thickLine (take 2 $ _btTrail' pt) (_btWidth' pt) createBarrelSpark :: Int -> Int -> Point2 -> Float -> Maybe Int -> World -> World createBarrelSpark time colid pos dir maycid w = over worldEvents @@ -217,83 +106,9 @@ createBarrelSpark time colid pos dir maycid w = over worldEvents where sp = head (_btTrail' bt) ep = sp +.+ _btVel' bt -noEff _ _ _ = id -makeFlameletTimed :: Point2 -> Point2 -> Maybe Int -> Float -> Int -> World -> World -makeFlameletTimed pos vel maycid size time w - = set randGen g $ over particles' ((:) theFlamelet) w - where theFlamelet = - Pt' { _ptDraw = drawFlamelet rot - , _ptUpdate' = moveFlamelet - , _btVel' = vel - , _btColor' = red - , _btPos' = pos - , _btPassThrough' = maycid - , _btWidth' = size - , _btTimer' = time - , _btHitEffect' = destroyOnImpact (doFlameDam 1) noEff noEff - } - (rot ,g) = randomR (0,3) $ _randGen w - -drawFlamelet :: Float -> Particle' -> Picture -drawFlamelet rot pt = setLayer 1 $ pictures [pic , piu , pi2 , glow] - where - sp = _btPos' pt - vel = _btVel' pt - ep = sp +.+ vel - size = _btWidth' pt - siz2 = size + 0.2 - time = _btTimer' pt - glow = setDepth 0.336 $ uncurry translate ep - $ circleSolidCol (withAlpha 0 red) (withAlpha 0.05 red) 30 - piu = setDepth 0.334 $ uncurry translate ep - $ color (dark red) $ rotate (0 - (rot - 0.1 * fromIntegral time)) - $ scale s1 s1 - $ polygon $ rectNSWE (siz2) (-siz2) (-siz2) (siz2) - pi2 = setDepth 0.332 $ uncurry translate ep - $ color (mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time) - orange (dark red) - ) - $ rotate (0 - (rot + 0.2 * fromIntegral time)) - $ scale s2 s2 - $ polygon $ rectNSWE (siz2) (-siz2) (-siz2) (siz2) - pic = setDepth 0.33 $ uncurry translate ep - $ color (mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time) - white (dark red) - ) - $ rotate (0 - ( 0.1 * fromIntegral time + rot)) - $ scale sc sc - $ polygon [(-size,-size),(size,-size),(size,size),(-size,size)] - sc = (*) 2 $ log $ 1 + fromIntegral time / 20 - s1 = (*) 2 $ log $ 2 + fromIntegral time / 40 - s2 = 0.5 * (sc + s1) - thepicture = pictures [pic , piu , pi2 , glow] - -moveFlamelet :: World -> Particle' -> (World, Maybe Particle') -moveFlamelet w pt - | _btTimer' pt <= 0 = ( w, Nothing) - | otherwise = (damcrs, mvPt) - where - sp = _btPos' pt - vel = _btVel' pt - ep = sp +.+ vel - size = _btWidth' pt - mvPt = Just $ pt & btTimer' -~ 1 - & btPos' .~ ep - & btPassThrough' .~ Nothing - & btVel' .~ 0.8 *.* vel - damcrs = foldr ($) w $ map dodam $ filter closeCrs $ IM.elems $ _creatures w - closeCrs cr = dist ep (_crPos cr) < _crRad cr + size - dodam cr = over (creatures . ix (_crID cr) . crState . crDamage) - ((:) $ Flaming 3 sp ep ep) -doFlameDam :: Int -> Particle' -> Point2 -> Creature -> World -> World -doFlameDam amount pt p cr = over (creatures . ix (_crID cr) . crState . crDamage) - ((:) $ Flaming amount sp p ep) - where sp = _btPos' pt - ep = sp +.+ _btVel' pt - damCrsOnLine :: Int -> Point2 -> Point2 -> World -> World damCrsOnLine dam p1 p2 = over creatures (IM.map damIfOnLine) where damIfOnLine cr | circOnLine p1 p2 (_crPos cr) (_crRad cr) diff --git a/src/Dodge/WorldEvent/Explosion.hs b/src/Dodge/WorldEvent/Explosion.hs new file mode 100644 index 000000000..6f0621907 --- /dev/null +++ b/src/Dodge/WorldEvent/Explosion.hs @@ -0,0 +1,146 @@ +module Dodge.WorldEvent.Explosion + where + +import Dodge.Data +import Dodge.Base +import Dodge.WorldEvent.SpawnParticle +import Dodge.WorldEvent.Flash +import Dodge.RandomHelp +import Dodge.SoundLogic + +import Geometry +import Picture + +import Control.Monad.State +import Data.List +import Data.Maybe +import System.Random +import qualified Data.IntMap.Strict as IM +import Control.Lens + +-- The following should be improved.... I've made a first pass +makePoisonExplosionAt :: Point2 -> World -> World +makePoisonExplosionAt p w = soundOnce grenadeBang $ foldr (makeGasCloud p) w vels + where + vels = evalState (sequence ( replicate 25 (randInCirc 2) )) (_randGen w) +-- just change the number after replicate to get more or less clouds +-- suggested change: use random positions, offset from p, rather than velocities +-- so, p +.+ randomOffset +-- currently the clouds push away from each other rather hard if they are close + +makeTeslaExplosionAt :: Point2 -> World -> World +makeTeslaExplosionAt pos w = soundOnce grenadeBang $ foldr ($) w listOfFunctions -- a bit shorter + where + -- rad or 360? Radians (hopefully) everywhere + xs = randomRs (0, 2*pi) $ _randGen w + p = newProjectileKey w + pks = [p..] + listOfFunctions = map + (\i -> over projectiles (IM.insert (pks!!i) (makeTeslaArcAt (pks!!i) pos (xs!!i)))) + [1 .. 29] + +-- slightly more work done on this one, want the flames to last for different +-- times +-- the new flames are directly added to the list of particles +makeFlameExplosionAt :: Point2 -> World -> World +makeFlameExplosionAt p w = soundOnce grenadeBang $ over particles' (newFlames ++ ) w + where + newFlames = zipWith makeFlameWithVelAndTime velocities timers + makeFlameWithVelAndTime vel time = aFlameParticle time p vel Nothing + velocities = evalState (sequence ( replicate 15 (randInCirc 1) )) (_randGen w) + timers = randomRs (80,100) $ _randGen w + -- the ( Nthing :: Maybe Int ) here is "maybe" a creature id that the + -- particle passes through for the first frame of its existence + + +makeExplosionAt :: Point2 -> World -> World +makeExplosionAt p w = soundOnce grenadeBang + . addFlames + . explosionFlashAt p + $ makeShockwaveAt p 50 10 1 white + w + where + fVs = fst $ runState ((sequence . take 75 . repeat . randInCirc) 1) $ _randGen w + fPs' = evalState ((sequence . take 75 . repeat . randInCirc) 15) $ _randGen w + fPs = map (pushAgainstWalls . (+.+) p . (*.*) 0.5) + fPs' + inversePushOut v = (15 - magV v) * 0.01 *.* v + fVs' = zipWith (+.+) fVs $ map inversePushOut fPs' + sizes = randomRs (2,6) $ _randGen w + times = randomRs (20,25) $ _randGen w + mF q v size time = makeFlameletTimed q v Nothing size time + newFs = zipWith4 mF fPs (fmap (3 *.*) fVs') sizes times + addFlames w = foldr ($) w newFs + pushAgainstWalls q = fromMaybe q $ fmap (\(x,y)-> x +.+ y) + $ collidePointWalls p q $ wallsNearPoint q w + +makeShockwaveAt :: Point2 -> Float -> Int -> Float -> Color + -> World -> World +makeShockwaveAt p rad dam push col = over particles' ((:) theShockwave) + where theShockwave = shockwaveAt p rad dam push col 10 + +shockwaveAt :: Point2 -> Float -> Int -> Float -> Color -> Int -> Particle' +shockwaveAt p rad dam push col maxtime + = Shockwave' + { _ptDraw = const blank + , _ptUpdate' = mvShockwave' + , _btColor' = col + , _btPos' = p + , _btRad' = rad + , _btDam' = dam + , _btPush' = push + , _btMaxTime' = maxtime + , _btTimer' = maxtime + } + +mvShockwave' :: World -> Particle' -> (World, Maybe Particle') +mvShockwave' w pt + | _btTimer' pt <= 0 = (w, Nothing) + | otherwise + = (dams w , Just $ set btTimer' (t - 1) $ set ptDraw (const pic) pt) + where + r = _btRad' pt + p = _btPos' pt + push = _btPush' pt + dam = _btDam' pt + t = _btTimer' pt + tFraction = fromIntegral t / fromIntegral (_btMaxTime' pt) + pic = onLayer PtLayer $ uncurry translate p + $ color (_btColor' pt) $ thickCircle rad thickness + rad = r - (3/4) * r * tFraction + thickness = tFraction**2 * r + dams = over creatures (IM.map damCr) . flip (foldr damageBlocks) hitBlocks + hitBlocks = wallsOnCirc p rad $ wallsNearPoint p w + damageBlocks wall w + = case wall ^? blHP of + Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 1)) + w + (_blIDs wall) + _ -> w + damCr cr | dist (_crPos cr) p < rad + _crRad cr + = over (crState . crDamage) + ((:) $ PushDam dam (25 * push *.* safeNormalizeV (_crPos cr -.- p))) + cr + | otherwise = cr +moveShockWave :: Int -> Point2 -> Float -> Float -> Float -> World -> Particle' -> (World, Maybe Particle') +moveShockWave 0 _ _ _ _ w _ = (w, Nothing) +moveShockWave t p r push pushexp w pt + = (dams w, Just $ newupdate $ newpic pt ) + where newupdate = set ptUpdate' $ moveShockWave (t-1) p r push pushexp + newpic = set ptDraw (const $ onLayer PtLayer $ uncurry translate p + $ color cyan $ thickCircle rad thickness) + rad = r - (3/40) * r * fromIntegral t + thickness = (fromIntegral t)**2 * rad / 40 + dams = over creatures (IM.map damCr) . flip (foldr damageBlocks) hitBlocks + hitBlocks = wallsOnCirc p rad $ wallsNearPoint p w + damageBlocks wall w + = case wall ^? blHP of + Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 1)) + w + (_blIDs wall) + _ -> w + damCr cr | dist (_crPos cr) p < rad + _crRad cr + = over (crState . crDamage) + ((:) $ PushDam 1 (25 *.* safeNormalizeV (_crPos cr -.- p))) + cr + | otherwise = cr diff --git a/src/Dodge/WorldEvent/HitEffect.hs b/src/Dodge/WorldEvent/HitEffect.hs index ddcd9988d..498cadea0 100644 --- a/src/Dodge/WorldEvent/HitEffect.hs +++ b/src/Dodge/WorldEvent/HitEffect.hs @@ -56,3 +56,11 @@ penWalls crEff wlEff ffEff pt hitThings w = case hitThings of trl = _btTrail' pt wth = _btWidth' pt newP = head trl +.+ _btVel' pt + +doFlameDam :: Int -> Particle' -> Point2 -> Creature -> World -> World +doFlameDam amount pt p cr = over (creatures . ix (_crID cr) . crState . crDamage) + ((:) $ Flaming amount sp p ep) + where sp = _btPos' pt + ep = sp +.+ _btVel' pt + +noEff _ _ _ = id diff --git a/src/Dodge/WorldEvent/SpawnParticle.hs b/src/Dodge/WorldEvent/SpawnParticle.hs new file mode 100644 index 000000000..7de8c174e --- /dev/null +++ b/src/Dodge/WorldEvent/SpawnParticle.hs @@ -0,0 +1,339 @@ +module Dodge.WorldEvent.SpawnParticle + where +import Dodge.Data +import Dodge.Base +import Dodge.WorldEvent.HitEffect +import Dodge.WorldEvent.ThingsHit +import Dodge.WorldEvent.Cloud +import Dodge.WorldEvent.Flash +import Dodge.WorldEvent.HelperParticle +import Dodge.WorldEvent.Bullet +import Dodge.SoundLogic +import Dodge.RandomHelp +import Dodge.Debug + +import Picture +import Geometry + +import Control.Lens +import qualified Data.IntMap.Strict as IM +import System.Random +import Control.Monad.State +import Data.Function (on) +import Data.List +import Data.Maybe + +-- take out the flame particle from makeFlame +aFlameParticle :: Int -> Point2 -> Point2 -> Maybe Int -> Particle' +aFlameParticle t pos vel maycid = Pt' + { _ptDraw = drawFlame vel + , _ptUpdate' = moveFlame vel + , _btVel' = vel + , _btColor' = red + , _btPos' = pos + , _btPassThrough' = maycid + , _btWidth' = 4 + , _btTimer' = t + , _btHitEffect' = destroyOnImpact (doFlameDam 1) noEff noEff + } + +makeFlame :: Point2 -> Point2 -> Maybe Int -> World -> World +makeFlame pos vel maycid = over particles' (aFlameParticle 100 pos vel maycid : ) + +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 + +makeFlameletTimed :: Point2 -> Point2 -> Maybe Int -> Float -> Int -> World -> World +makeFlameletTimed pos vel maycid size time w + = set randGen g $ over particles' ((:) theFlamelet) w + where theFlamelet = + Pt' { _ptDraw = drawFlamelet rot + , _ptUpdate' = moveFlamelet + , _btVel' = vel + , _btColor' = red + , _btPos' = pos + , _btPassThrough' = maycid + , _btWidth' = size + , _btTimer' = time + , _btHitEffect' = destroyOnImpact (doFlameDam 1) noEff noEff + } + (rot ,g) = randomR (0,3) $ _randGen w + +drawFlamelet :: Float -> Particle' -> Picture +drawFlamelet rot pt = setLayer 1 $ pictures [pic , piu , pi2 , glow] + where + sp = _btPos' pt + vel = _btVel' pt + ep = sp +.+ vel + size = _btWidth' pt + siz2 = size + 0.2 + time = _btTimer' pt + glow = setDepth 0.336 $ uncurry translate ep + $ circleSolidCol (withAlpha 0 red) (withAlpha 0.05 red) 30 + piu = setDepth 0.334 $ uncurry translate ep + $ color (dark red) $ rotate (0 - (rot - 0.1 * fromIntegral time)) + $ scale s1 s1 + $ polygon $ rectNSWE (siz2) (-siz2) (-siz2) (siz2) + pi2 = setDepth 0.332 $ uncurry translate ep + $ color (mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time) + orange (dark red) + ) + $ rotate (0 - (rot + 0.2 * fromIntegral time)) + $ scale s2 s2 + $ polygon $ rectNSWE (siz2) (-siz2) (-siz2) (siz2) + pic = setDepth 0.33 $ uncurry translate ep + $ color (mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time) + white (dark red) + ) + $ rotate (0 - ( 0.1 * fromIntegral time + rot)) + $ scale sc sc + $ polygon [(-size,-size),(size,-size),(size,size),(-size,size)] + sc = (*) 2 $ log $ 1 + fromIntegral time / 20 + s1 = (*) 2 $ log $ 2 + fromIntegral time / 40 + s2 = 0.5 * (sc + s1) + thepicture = pictures [pic , piu , pi2 , glow] + +moveFlamelet :: World -> Particle' -> (World, Maybe Particle') +moveFlamelet w pt + | _btTimer' pt <= 0 = ( w, Nothing) + | otherwise = (damcrs, mvPt) + where + sp = _btPos' pt + vel = _btVel' pt + ep = sp +.+ vel + size = _btWidth' pt + mvPt = Just $ pt & btTimer' -~ 1 + & btPos' .~ ep + & btPassThrough' .~ Nothing + & btVel' .~ 0.8 *.* vel + damcrs = foldr ($) w $ map dodam $ filter closeCrs $ IM.elems $ _creatures w + closeCrs cr = dist ep (_crPos cr) < _crRad cr + size + dodam cr = over (creatures . ix (_crID cr) . crState . crDamage) + ((:) $ Flaming 3 sp ep ep) + +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) + +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 + +-- if the spark is created by another Particle', it cannot be directly added to +-- the list, hence the redirect through worldEvents +createSpark :: Int -> Int -> Point2 -> Float -> Maybe Int -> World -> World +createSpark time colid pos dir maycid w = over worldEvents + ((.) $ ( over particles' ((:) spark) +-- . flareAt' white 0.02 0.05 pos') + . sparkFlashAt pos') + ) w + where spark = Bul' { _ptDraw = drawBul + , _ptUpdate' = mvGenBullet' + , _btVel' = rotateV dir (5,0) + , _btColor' = numColor colid + , _btTrail' = [pos] + , _btPassThrough' = maycid + , _btWidth' = 1 + , _btTimer' = time + , _btHitEffect' = destroyOnImpact sparkEff noEff noEff + } + x = fst $ randomR (0,20) $ _randGen w + pos' = pos +.+ rotateV dir (x,0) + sparkEff bt p cr = over (creatures . ix (_crID cr) . crState . crDamage) + ((:) $ SparkDam 1 sp p ep) + where sp = head (_btTrail' bt) + ep = sp +.+ _btVel' bt + +drawBul :: Particle' -> Picture +drawBul pt = setLayer 1 . color white $ thickLine (take 2 $ _btTrail' pt) (_btWidth' pt)