Narrow down non-termination to thingsHit[LongLine]
This commit is contained in:
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user