From f939535657d3a115c0b75d503409cf95d43acf36 Mon Sep 17 00:00:00 2001 From: jgk Date: Mon, 15 Mar 2021 19:36:33 +0100 Subject: [PATCH] Narrow down non-termination to thingsHit[LongLine] --- src/Dodge/Item/Weapon.hs | 13 ++++- src/Dodge/Item/Weapon/Bullet.hs | 10 ++-- src/Dodge/WorldActions.hs | 100 ++------------------------------ 3 files changed, 24 insertions(+), 99 deletions(-) diff --git a/src/Dodge/Item/Weapon.hs b/src/Dodge/Item/Weapon.hs index 679882139..c8be7ead4 100644 --- a/src/Dodge/Item/Weapon.hs +++ b/src/Dodge/Item/Weapon.hs @@ -337,7 +337,7 @@ launcher = defaultGun } bezierGun = defaultGun { _itName = "B-GUN" - , _wpFire = bezierTarget + , _wpFire = bezierControl' } remoteLauncher = defaultGun @@ -1407,6 +1407,8 @@ grenadePic x = pictures [ color (dark $ dark green) $ circleSolid 5 $ scale 0.05 0.05 $ color green $ text $ show $ 1 + quot x 20 ] +bezTest cid w = mkBezierBul (0,11) (0,20) (0,20) cid w + bezierTarget :: Int -> World -> World bezierTarget cid w = setTarget w where @@ -1424,6 +1426,15 @@ bezierControl targetp cid w = resetGun $ shootWithSound 0 (mkBezierBul startp co startp = _crPos cr +.+ rotateV dir (_crRad cr + 1,0) resetGun = set (creatures . ix cid . crInv . ix j . wpFire) $ bezierTarget +bezierControl' :: Int -> World -> World +bezierControl' cid w = shootWithSound 0 (mkBezierBul startp controlp controlp) cid w + where + j = _crInvSel $ _creatures w IM.! cid + controlp = _crPos cr +.+ (20,20) + cr = _creatures w IM.! cid + dir = _crDir cr + startp = _crPos cr +.+ (11,11) + mkBezierBul :: Point2 -> Point2 -> Point2 -> Int -> World -> World mkBezierBul startp controlp targetp cid w = over particles' (bbul :) w where diff --git a/src/Dodge/Item/Weapon/Bullet.hs b/src/Dodge/Item/Weapon/Bullet.hs index 4e6fe439b..383260871 100644 --- a/src/Dodge/Item/Weapon/Bullet.hs +++ b/src/Dodge/Item/Weapon/Bullet.hs @@ -22,15 +22,14 @@ bulHitCr' :: Particle' -> Point2 -> Creature -> World -> World bulHitCr' bt p cr w = let sp = head $ _btTrail' bt ep = sp +.+ _btVel' bt - -- mvDams = [TorqueDam 1 d1 , PushDam 1 $ 2 *.* (ep -.- sp) ] - mvDams = [ PushDam 1 $ 2 *.* (ep -.- sp) ] + mvDams = [ PushDam 1 $ 2 *.* bulVel ] addDamage = over (creatures . ix cid . crState . crDamage) (\dams -> (Piercing 100 sp p ep : mvDams) ++ dams) addDamageArmoured = over (creatures . ix cid . crState . crDamage) (\dams -> mvDams ++ dams) hitSound = soundMultiFrom [CrHitSound 0] 15 10 0 flashEff = over worldEvents ((.) $ flareAt red p) - bulVel = ep -.- sp + bulVel = _btVel' bt ck cid = (+.+) (crKnockBack cid *.* bulVel) crKnockBack cid = (/) 1 $ (+) 2 $ _crMass $ _creatures w IM.! cid hasArmour cr = any (\it -> it ^? itIdentity == Just FrontArmour) $ _crInv cr @@ -38,7 +37,10 @@ bulHitCr' bt p cr w = sID = newParticleKey w (d1,g) = randomR (-0.7,0.7) $ _randGen w (colID,_) = randomR (0,11) $ _randGen w - hitEffect = addDamage . hitSound . flashEff $ w + hitEffect = addDamage + . hitSound + . flashEff + $ w in case hasArmour cr of --shit this is ugly, to refactor True -> if hitBack then hitEffect diff --git a/src/Dodge/WorldActions.hs b/src/Dodge/WorldActions.hs index 0a313758e..a6ae192fb 100644 --- a/src/Dodge/WorldActions.hs +++ b/src/Dodge/WorldActions.hs @@ -1,10 +1,16 @@ module Dodge.WorldActions ( module Dodge.WorldActions , module Dodge.WorldActions.Bullet + , module Dodge.WorldActions.Flash + , module Dodge.WorldActions.ThingsHit + , module Dodge.WorldActions.HelperParticle ) where import Dodge.WorldActions.Bullet +import Dodge.WorldActions.Flash +import Dodge.WorldActions.ThingsHit +import Dodge.WorldActions.HelperParticle import Dodge.Data import Dodge.Base @@ -230,13 +236,6 @@ createBarrelSpark time colid pos dir maycid w = over worldEvents where sp = head (_btTrail' bt) ep = sp +.+ _btVel' bt -flareAt :: Color -> Point2 -> World -> World -flareAt c p = flareAt' c 0.02 0.5 p - -flareAt' :: Color -> Float -> Float -> Point2 -> World -> World -flareAt' col alphax alphay p - = over particles' ((:) (flashColAt col alphax p)) - . lowLightColAt col alphay p tLightFade :: Int -> Float -> (Int -> Float) -> Point2 -> TempLightSource @@ -290,16 +289,6 @@ flashRadAt rad col alphax (x,y) = , _ptUpdate' = ptTimer' 1 } -flashColAt :: Color -> Float -> Point2 -> Particle' -flashColAt col alphax (x,y) = - Particle' - { _ptPict' = pictures $ - map (\i -> onLayerL [levLayer PtLayer] - $ color (withAlpha alphax col) $ translate x y $ circleSolid i - ) - [20,25,30,35,40,45,50] - , _ptUpdate' = ptTimer' 1 - } lowLightWidthAt :: Float -> Float -> Color -> Float -> Int -> Float -> Point2 -> World -> World lowLightWidthAt len wdth col alphay rays rad p w = foldr (lowLightWidthHit len wdth col alphay p) w ps where ps = map ((+.+) p) $ nRaysRad rays rad @@ -308,29 +297,11 @@ lowLightRadAt :: Color -> Float -> Int -> Float -> Point2 -> World -> World lowLightRadAt col alphay rays rad p w = foldr (lowLightColHit col alphay p) w ps where ps = map ((+.+) p) $ nRaysRad rays rad -lowLightColAt :: Color -> Float -> Point2 -> World -> World -lowLightColAt col alphay p w = foldr (lowLightColHit col alphay p) w ps - where ps = map ((+.+) p) $ nRaysRad 20 30 lowLightDirected :: Color -> Float -> Point2 -> Point2 -> [Float] -> World -> World lowLightDirected col alpha a b angles w = foldr (\angle w' -> lowLightColHit col alpha a (a +.+ rotateV angle b) w') w angles -lowLightColHit :: Color -> Float -> Point2 -> Point2 -> World -> World -lowLightColHit col alphay a b w - = case thingsHitLongLine a b w of - ((p, E3x2 wall):_) - -> over particles' ((:) (wallGlareCol col alphay p wall)) w - ((p, E3x1 cr):_) - -> over afterParticles' ((:) (crGlareCol col alphay p cr)) w - _ -> w - -wallGlareCol :: Color -> Float -> Point2 -> Wall -> Particle' -wallGlareCol col alphay p wl = wallGlareWidth 10 5 col alphay p wl - -crGlareCol :: Color -> Float -> Point2 -> Creature -> Particle' -crGlareCol col alphay p cr = crGlareWidth 5 col alphay p cr - lowLightWidthHit :: Float -> Float -> Color -> Float -> Point2 -> Point2 -> World -> World lowLightWidthHit len wdth col alphay a b w = case thingsHitLongLine a b w of @@ -340,34 +311,6 @@ lowLightWidthHit len wdth col alphay a b w -> over afterParticles' ((:) (crGlareWidth wdth col alphay p cr)) w _ -> w -wallGlareWidth :: Float -> Float -> Color -> Float -> Point2 -> Wall -> Particle' -wallGlareWidth len wdth col alphay p wl = - Particle' - { _ptPict' = onLayerL [levLayer GloomLayer + 2] $ l - , _ptUpdate' = ptTimer' 1 - } - where l = color (withAlpha alphay col) $ lineOfThickness wdth $ [p +.+ x, p -.- x] - x = len *.* ( normalizeV $ a -.- b) - (a:b:_) = _wlLine wl - -crGlareWidth :: Float -> Color -> Float -> Point2 -> Creature -> Particle' -crGlareWidth wdth col alphay p cr = - Particle' - { _ptPict' = onLayerL [levLayer GloomLayer + 2] $ l cp - , _ptUpdate' = \w pt -> (w, Just $ pt {_ptPict' = onLayerL [levLayer GloomLayer + 2] $ upp cid w - ,_ptUpdate' = ptTimer' 0 - } - ) - } - where l x = uncurry translate x - $ rotate (-0.25*pi + argV (p -.- x)) - $ color (withAlpha alphay col) - $ thickArc 0 (pi/2) (_crRad cr) wdth - cp = _crPos cr - cid = _crID cr - upp cid' w' = case w' ^? creatures . ix cid . crPos of - Just y -> l y - _ -> blank muzFlareAt :: Point2 -> World -> World muzFlareAt p = over particles' ((:) (muzzleFlareAt p)) @@ -383,9 +326,6 @@ muzzleFlareAt (x,y) = , _ptUpdate' = ptTimer' 1 } -ptTimer' :: Int -> World -> Particle' -> (World, Maybe Particle') -ptTimer' 0 w pt = (w, Nothing) -ptTimer' n w pt = (w, Just $ pt {_ptUpdate' = ptTimer' (n-1)}) lowLightAt :: Point2 -> World -> World lowLightAt p w = lowLightWidthAt 10 5 white 0.5 20 30 p w @@ -434,34 +374,6 @@ threeEff' crEff wlEff ffEff pt thing w = case thing of -thingsHitExceptCrLongLine :: Maybe Int -> Point2 -> Point2 -> World - -> [(Point2, (Either3 Creature Wall ForceField))] -thingsHitExceptCrLongLine Nothing sp ep = thingsHitLongLine sp ep -thingsHitExceptCrLongLine (Just cid) sp ep = filter crNotCid . thingsHitLongLine sp ep - where crNotCid (_,(E3x1 cr)) = _crID cr /= cid - crNotCid _ = True - -thingsHitLongLine :: Point2 -> Point2 -> World -> [(Point2, (Either3 Creature Wall ForceField))] ---thingsHitLongLine sp ep w = crs ++ walls -thingsHitLongLine sp ep w = sortBy (compare `on` dist sp . fst) (crs ++ walls ++ ffs) - where hitCrs = IM.elems $ IM.filter (\cr -> circOnLine sp ep (_crPos cr) (_crRad cr)) - -- $ _creatures w - $ creaturesAlongLine sp ep w - crPs = map (\cr -> ssaTriPoint ep (_crPos cr) sp (_crRad cr)) hitCrs - --crPs = map _crPos hitCrs - crs = zip crPs (map E3x1 hitCrs) - -- hitWls = wallsOnLine sp ep (f y $ f x $ _wallsZone w) - hitWls = wallsOnLine sp ep $ wallsAlongLine sp ep w - --hitWls = wallsOnLine sp ep $ _walls w - f i m = case IM.lookup i m of Just val -> val - _ -> IM.empty - --walls = zip (map (fromJust . hitPoint) hitWls) (map E3x2 hitWls) - walls = zip (map (fromJust . hitPoint) hitWls) (map E3x2 hitWls) - hitPoint w = intersectSegSeg' sp ep (_wlLine w !! 0) (_wlLine w !! 1) --- hitPoint w = intersectSegSeg' sp ep (_wlLine w !! 0) (_wlLine w !! 1) - hitFFs = mapMaybe (collidePointFF sp ep (_randGen w)) (IM.elems $ _forceFields w) - ffs = map (\(p,(_,i)) -> (p, E3x3 $ _forceFields w IM.! i)) hitFFs - cr = _creatures w IM.! 0 makeFlameletTimed :: Point2 -> Point2 -> Int -> Maybe Int -> Float -> Int -> World -> World makeFlameletTimed pos vel levelInt maycid size time w