Refactor
This commit is contained in:
@@ -106,7 +106,6 @@ movementSideEff cr w
|
||||
66
|
||||
Nothing
|
||||
1
|
||||
-- $ smokeGen v
|
||||
$ set randGen g
|
||||
w
|
||||
_ -> w
|
||||
@@ -124,10 +123,6 @@ movementSideEff cr w
|
||||
|
||||
(v1:v2:v3:_) = fst $ runState ((sequence . repeat . randInCirc) 0.1) $ _randGen w
|
||||
(r1:r2:r3:_) = map ((*.*) 100) (v2:v3:v1:[])
|
||||
(t1:t2:t3:_) = randomRs ( 15,20) $ _randGen w
|
||||
(s1:s2:s3:_) = map (\s -> fromIntegral s * 0.1 - 1) (t3:t2:t1:[])
|
||||
smokeGen v = makeSmokeAt'' v1 s1 t1
|
||||
(r1 +.+ oldPos +.+ ((_crRad cr + 3) *.* vInverse (unitVectorAtAngle $ _crDir cr)))
|
||||
|
||||
crHasMoved = dist (_crPos cr) (_crOldPos cr) > 0.5
|
||||
takeStep x y | crHasMoved && x < 20 && x + y >= 20 = soundMultiFrom footor 22 3 0
|
||||
|
||||
@@ -464,10 +464,6 @@ data Particle' =
|
||||
, _btTimer' :: Int
|
||||
}
|
||||
|
||||
type HitEffect' = Particle' -> (Point2, (Either3 Creature Wall ForceField)) -> World -> World
|
||||
|
||||
type HitEffect'' = Particle' -> [(Point2, (Either3 Creature Wall ForceField))] -> World -> World
|
||||
|
||||
type HitEffect = Particle' -> [(Point2, (Either3 Creature Wall ForceField))] -> World
|
||||
-> (World,Maybe Particle')
|
||||
|
||||
|
||||
+19
-50
@@ -818,7 +818,6 @@ tractorBeamAt colID i pos dir = Projectile
|
||||
where d = unitVectorAtAngle dir
|
||||
p' = pos +.+ 400 *.* d
|
||||
|
||||
|
||||
aGasCloud :: Int -> World -> World
|
||||
aGasCloud cid w
|
||||
= -- soundFrom Flame fireSound 2 500
|
||||
@@ -871,7 +870,6 @@ aFlame a cid w
|
||||
_crPos cr +.+ ((_crRad cr + 2.9) *.* unitVectorAtAngle (_crDir cr))
|
||||
w1 = set randGen g w
|
||||
i = newProjectileKey w1
|
||||
-- vel = (_crPos cr -.- _crOldPos cr) +.+ 4 *.* unitVectorAtAngle dir
|
||||
vel = (_crPos cr -.- _crOldPos cr) +.+ 4 *.* unitVectorAtAngle dir
|
||||
insertFlame = makeFlame pos vel (Just cid) -- . makeFlame pos2 vel (Just cid)
|
||||
resetAngle = set (creatures . ix cid . crInv . ix (_crInvSel cr) . wpFire)
|
||||
@@ -892,24 +890,16 @@ makeFlame pos vel maycid = over particles' ((:) theFlame)
|
||||
}
|
||||
|
||||
moveFlame :: Point2 -> World -> Particle' -> (World, Maybe Particle')
|
||||
moveFlame rotd w pt =
|
||||
case _btTimer' pt of
|
||||
time | time <= 0 -> (smokeGen w, Nothing)
|
||||
| otherwise ->
|
||||
case thingsHitExceptCr (_btPassThrough' pt) sp ep w of
|
||||
-- ((p,(E3x1 cr)):_) -> (damcr cr p $ smokeGen damcrs, Nothing)
|
||||
((p,(E3x1 cr)):_)
|
||||
-> (soundFrom Flame fireSound 2 500
|
||||
$ over worldEvents ((.) $ flameGlareAt ep)
|
||||
damcrs
|
||||
, mvPt')
|
||||
(thing@(p,(E3x2 wl)):_) -> (fst $ hiteff [thing] damcrs, rfl wl p)
|
||||
_ -> (soundFrom Flame fireSound 2 500
|
||||
-- adding reflective glare is too intensive for this laptop
|
||||
$ over worldEvents ((.) $ flameGlareAt ep)
|
||||
damcrs
|
||||
, mvPt)
|
||||
where sp = _btPos' pt
|
||||
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, _ptPict' = thepic ep
|
||||
@@ -924,51 +914,36 @@ moveFlame rotd w pt =
|
||||
< _crRad cr + 10 - min 9 (max 0 (fromIntegral time - 80))
|
||||
+ 5 * angleCoeff (angleVV (ep -.- _crPos cr) rotd)
|
||||
angleCoeff x = abs $ 1 - (abs $ (x * 2 - pi) / (pi))
|
||||
damcr cr p = over (creatures . ix (_crID cr) . crState . crDamage)
|
||||
((:) $ Flaming (div time 10) sp p ep)
|
||||
hiteff = _btHitEffect' pt pt
|
||||
thepic p' = pictures $ reverse [ pic p' , piu p' , pi2 p' , glow p' ]
|
||||
pic p' = setLayer 1 $ onLayerL [levLayer UPtLayer,6] $ uncurry translate (prot3 p')
|
||||
pic p' = setLayer 1 . setDepth 0.2994 $ uncurry translate (prot3 p')
|
||||
$ rotate (pi * 0.5 + argV rotd)
|
||||
$ scale scaleChange 1
|
||||
-- $ color white
|
||||
-- $ circleSolid 5
|
||||
$ pictures $ reverse [color white $ circleSolid 4
|
||||
,color (withAlpha 0.5 white) $ circleSolid 5
|
||||
]
|
||||
-- $ rotate (radToDeg (fromIntegral time * 10))
|
||||
-- $ polygon [(-5,-2),(5,-2),(5,2),(-5,2)]
|
||||
pi2 p' = setLayer 1 $ onLayerL [levLayer UPtLayer,4] $ uncurry translate (prot p')
|
||||
-- $ rotate ( (fromIntegral time * 5))
|
||||
pi2 p' = setLayer 1
|
||||
. setDepth 0.2996
|
||||
. uncurry translate (prot p')
|
||||
$ rotate (pi * 0.5 + argV rotd)
|
||||
-- $ color (mixColors 0.5 0.5 orange white)
|
||||
-- $ polygon [(-6,-6),(6,-6),(6,6),(-6,6)]
|
||||
$ scale (scaleChange + 0.5) 1.5
|
||||
$ pictures $ reverse [color orange $ circleSolid 4.5
|
||||
,color (withAlpha 0.5 orange) $ circleSolid 5
|
||||
]
|
||||
-- $ color orange
|
||||
-- $ circleSolid 5
|
||||
prot p' = p' +.+ rotateV (fromIntegral time * 1) (0,1)
|
||||
prot2 p' = p' +.+ rotateV (negate $ fromIntegral time * 1) (0,1)
|
||||
prot3 p' = p' +.+ rotateV (2 + fromIntegral time * 0.1) (0,2)
|
||||
piu p' = setLayer 1 $ onLayerL [levLayer UPtLayer,2] $ uncurry translate (prot2 p')
|
||||
piu p' = setLayer 1 . setDepth 0.2998 $ uncurry translate (prot2 p')
|
||||
$ rotate (pi*0.5 + argV rotd)
|
||||
-- $ rotate ((fromIntegral time * (-10)))
|
||||
$ scale (scaleChange + 1) 2
|
||||
$ pictures $ reverse [color red $ circleSolid 4.5
|
||||
,color (withAlpha 0.5 red) $ circleSolid 5
|
||||
]
|
||||
-- $ color (dark red)
|
||||
-- $ circleSolid 5
|
||||
-- $ polygon [(-8,-8),(8,-8),(8,8),(-8,8) ]
|
||||
rfl wl p = Just $ pt {_btTimer' = time -1, _btPos' = pOut p
|
||||
, _btVel' = reflV wl, _ptPict' = thepic $ pOut p
|
||||
}
|
||||
glow p' = setLayer 1 $ onLayerL [levLayer UPtLayer,0] $ uncurry translate p'
|
||||
$ circleSolidCol (withAlpha 0 orange)
|
||||
(withAlpha 0.02 orange) -- (withAlpha 0 orange) 50
|
||||
50
|
||||
, _btVel' = reflV wl, _ptPict' = thepic $ pOut p
|
||||
}
|
||||
glow p' = setLayer 1 $ setDepth 0.3 $ uncurry translate p'
|
||||
$ circleSolidCol (withAlpha 0 orange) (withAlpha 0.02 orange) 50
|
||||
pOut p = p +.+ safeNormalizeV (sp -.- p)
|
||||
reflV wall = (0.3 *.* reflectIn (_wlLine wall !! 1 -.- _wlLine wall !! 0)
|
||||
vel )
|
||||
@@ -976,12 +951,6 @@ moveFlame rotd w pt =
|
||||
(0.2 *.* vel)
|
||||
scaleChange | time < 80 = 3
|
||||
| otherwise = 3 - (fromIntegral time - 80) * 0.2
|
||||
g = _randGen w
|
||||
-- tms = randomRs (15,20) g
|
||||
-- scs = randomRs (0.1,0.5) g
|
||||
(rs,g1) = runState ((sequence . take 5 . repeat . randInCirc) 20) $ _randGen w
|
||||
f sc tm r = makeColorSmokeAt (greyN 0.3) (0.5 *.* vel) sc tm (ep +.+ r)
|
||||
-- smokeGen w = set randGen g1 $ foldr ($) w (zipWith3 f scs tms rs)
|
||||
smokeGen = makeFlamerSmoke ep
|
||||
|
||||
|
||||
|
||||
@@ -97,19 +97,6 @@ updateSeenWalls w = foldr markSeen w wallsToUpdate
|
||||
setTestStringIO :: IO World -> IO World
|
||||
setTestStringIO = fmap (\ w -> set testString (show $ s w) w)
|
||||
where s w = (-.-) <$> (w ^? creatures . ix 0 . crPos) <*> (w ^? creatures . ix 0 . crOldPos)
|
||||
-- w --do numC <- Mix.numChannelsPlaying
|
||||
-- w' <- w
|
||||
-- let ycr = _creatures w' IM.! 0
|
||||
-- let st = _stance $ _crState ycr
|
||||
-- let vel = magV $ _crPos ycr -.- _crOldPos ycr
|
||||
-- let (x,y) = zoneOfPoint $ _crPos ycr
|
||||
-- --fmap (set testString $ show (map _wlLine $ IM.elems $ _wallsZone w' IM.! x IM.! y)) w
|
||||
-- fmap (set testString $ show $ last $ show $ pairsToIncidence' $ _pathGraph' w') w
|
||||
|
||||
-- update logic: creature old position set, creatures perform actions including movement,
|
||||
-- creatures collided with each other, camera updated, projectiles updated, creatures
|
||||
-- collided with walls
|
||||
|
||||
|
||||
checkEndGame :: World -> World
|
||||
checkEndGame w | _crHP (you w) < 1 = haltSound $ w {_menuState = GameOverMenu}
|
||||
|
||||
@@ -297,41 +297,6 @@ doFlameDam amount pt p cr = over (creatures . ix (_crID cr) . crState . crDamage
|
||||
where sp = _btPos' pt
|
||||
ep = sp +.+ _btVel' pt
|
||||
|
||||
makeSmokeAt'' :: Point2 -> Float -> Int -> Point2 -> World -> World
|
||||
makeSmokeAt'' vel scal time p w = over particles' ((:) smokeP) w
|
||||
where smokeP = Particle'
|
||||
--{ _ptPict' = onLayerL [levLayer PtLayer - 1] $ uncurry translate p $ color black $ circleSolid 1
|
||||
{ _ptPict' = onLayerL [levLayer PtLayer ] $ uncurry translate p $ color black $ circleSolid 1
|
||||
, _ptUpdate' = moveSmoke'' scal time p vel
|
||||
}
|
||||
|
||||
moveSmoke'' :: Float -> Int -> Point2 -> Point2 -> World -> Particle' -> (World, Maybe Particle')
|
||||
moveSmoke'' scal time p vel w pt
|
||||
| time > 0 = (w, Just $ pt { _ptPict' = pic
|
||||
, _ptUpdate' = moveSmoke'' scal (time-1) pNew vel
|
||||
})
|
||||
| time > -50 = (w, Just $ pt { _ptPict' = pi1
|
||||
, _ptUpdate' = moveSmoke'' scal (time-1) pNew vel
|
||||
})
|
||||
| otherwise = (w, Nothing)
|
||||
where pNew = p +.+ vel
|
||||
pic = onLayerL [levLayer PtLayer]
|
||||
--pic = onLayerL [levLayer PtLayer - 1]
|
||||
$ uncurry translate pNew
|
||||
$ color (greyN 0.5) $ circleSolid $ (21 - fromIntegral time) * scal
|
||||
pi1 = pictures $ reverse
|
||||
[(onLayerL [levLayer PtLayer]
|
||||
$ uncurry translate pNew
|
||||
$ color (withAlpha (0.3 * (1 + fromIntegral time /50)) (greyN 0.5))
|
||||
$ circleSolid $ 21 * scal)
|
||||
,
|
||||
--(onLayerL [levLayer BgLayer+1]
|
||||
(onLayerL [levLayer PtLayer]
|
||||
$ uncurry translate pNew
|
||||
$ color (withAlpha (1 + fromIntegral time /50) (greyN 0.5))
|
||||
$ circleSolid $ 21 * scal)
|
||||
]
|
||||
|
||||
makeColorSmokeAt :: Color -> Point2 -> Float -> Int -> Point2 -> World -> World
|
||||
makeColorSmokeAt col vel scal time p w = over projectiles (IM.insert n smP) w
|
||||
where n = newProjectileKey w
|
||||
|
||||
@@ -89,13 +89,6 @@ mvGenBullet' w bt
|
||||
$ set btTimer' (t-1) bt
|
||||
)
|
||||
| otherwise = hiteff bt (thingsHitExceptCr mcr p (p +.+ vel) w) w
|
||||
-- case thingsHitExceptCr mcr p (p +.+ vel) w of
|
||||
-- [] -> (w, Just $ set btPassThrough' Nothing
|
||||
-- $ set btTrail' (p +.+ vel :p:ps)
|
||||
-- $ set ptPict' (bulLine col wth (p +.+ vel:p:ps))
|
||||
-- $ set btTimer' (t-1) bt
|
||||
-- )
|
||||
-- hits -> hiteff bt hits w
|
||||
where mcr = _btPassThrough' bt
|
||||
col = _btColor' bt
|
||||
(p:ps) = _btTrail' bt
|
||||
|
||||
@@ -18,13 +18,13 @@ makeSmokeCloud pos w = w & clouds %~ IM.insert i theCloud
|
||||
, _clPos = pos
|
||||
, _clVel = (0,0)
|
||||
, _clPict = fadeOutPict (-0.5)
|
||||
, _clRad = 10
|
||||
, _clRad = 5
|
||||
, _clTimer = 200
|
||||
, _clEffect = const id
|
||||
}
|
||||
|
||||
fadeOutPict :: Float -> Cloud -> Picture
|
||||
fadeOutPict dpth cl = setLayer 2 . setDepth dpth . color (withAlpha a $ greyN 0.5) $ circleSolid (2 * _clRad cl)
|
||||
fadeOutPict dpth cl = setLayer 2 . setDepth dpth . color (withAlpha a $ greyN 0.5) $ circleSolid (4 * _clRad cl)
|
||||
where a = fromIntegral (_clTimer cl) / 200
|
||||
|
||||
makeFlamerSmoke :: Point2 -> World -> World
|
||||
|
||||
Reference in New Issue
Block a user