diff --git a/src/Dodge/CreatureState.hs b/src/Dodge/CreatureState.hs index 40e47ac6e..8b07f9bab 100644 --- a/src/Dodge/CreatureState.hs +++ b/src/Dodge/CreatureState.hs @@ -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 diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index e03ff91f5..ad36ecbde 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -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') diff --git a/src/Dodge/Item/Weapon.hs b/src/Dodge/Item/Weapon.hs index 8b696248a..8449521fc 100644 --- a/src/Dodge/Item/Weapon.hs +++ b/src/Dodge/Item/Weapon.hs @@ -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 diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 8d07fa518..036a694a7 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -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} diff --git a/src/Dodge/WorldEvent.hs b/src/Dodge/WorldEvent.hs index 4bbb7eb60..1a813b975 100644 --- a/src/Dodge/WorldEvent.hs +++ b/src/Dodge/WorldEvent.hs @@ -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 diff --git a/src/Dodge/WorldEvent/Bullet.hs b/src/Dodge/WorldEvent/Bullet.hs index 0668f52eb..e46f0029a 100644 --- a/src/Dodge/WorldEvent/Bullet.hs +++ b/src/Dodge/WorldEvent/Bullet.hs @@ -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 diff --git a/src/Dodge/WorldEvent/Cloud.hs b/src/Dodge/WorldEvent/Cloud.hs index 1de6e78cf..aa2b2001f 100644 --- a/src/Dodge/WorldEvent/Cloud.hs +++ b/src/Dodge/WorldEvent/Cloud.hs @@ -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