From 74a4267393dd71b44c73c921d1026e09204929a6 Mon Sep 17 00:00:00 2001 From: justin Date: Sun, 31 Oct 2021 15:03:05 +0000 Subject: [PATCH] Cleanup --- src/Dodge/Data.hs | 12 +--- src/Dodge/Default/World.hs | 1 - src/Dodge/Initialisation.hs | 1 - src/Dodge/Item/Weapon/Bezier.hs | 2 +- src/Dodge/Item/Weapon/Bullet.hs | 6 +- src/Dodge/Item/Weapon/Laser.hs | 17 ++--- src/Dodge/Particle/Bullet/HitEffect.hs | 2 - src/Dodge/Render/Picture.hs | 34 --------- src/Dodge/Update/Camera.hs | 98 +++++++++++--------------- src/Dodge/Update/UsingInput.hs | 9 ++- src/Dodge/WorldEvent.hs | 2 +- src/Dodge/WorldEvent/HitEffect.hs | 25 +++---- src/Dodge/WorldEvent/SpawnParticle.hs | 14 ++-- src/Dodge/WorldEvent/ThingsHit.hs | 29 ++++---- 14 files changed, 85 insertions(+), 167 deletions(-) diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 73fa241dc..bea6a9ebf 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -59,7 +59,6 @@ data World = World , _doors :: IM.IntMap Door , _blocks :: IM.IntMap Block , _wallsZone :: Zone (IM.IntMap Wall) - , _forceFields :: IM.IntMap ForceField , _floorItems :: IM.IntMap FloorItem , _floorTiles :: [(Point3,Point3)] , _randGen :: StdGen @@ -453,7 +452,7 @@ data Particle , _btTimer' :: Int } type HitEffect = Particle - -> [(Point2, Either3 Creature Wall ForceField)] + -> [(Point2, Either Creature Wall)] -> World -> (World,Maybe Particle) @@ -572,13 +571,6 @@ data Wall = Wall } -- | Strict maybe data Maybe' a = Just' a | Nothing' -data ForceField = FF - { _ffLine :: [Point2] , _ffID :: Int - , _ffColor :: Color - , _ffDeflect :: Maybe (StdGen -> Point2 -> ForceField -> (Point2,StdGen)) - , _ffState :: FFState - } -newtype FFState = FFDestroyable { _ffsHP :: Int } data ActionPlan = Inanimate @@ -757,8 +749,6 @@ makeLenses ''PjParam makeLenses ''Prop makeLenses ''Particle makeLenses ''Wall -makeLenses ''ForceField -makeLenses ''FFState makeLenses ''PressPlate makeLenses ''Button makeLenses ''ActionPlan diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index f49cb6f43..151c8c689 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -38,7 +38,6 @@ defaultWorld = World , _blocks = IM.empty , _doors = IM.empty , _wallsZone = Zone IM.empty - , _forceFields = IM.empty , _floorItems = IM.empty , _floorTiles = [] , _randGen = mkStdGen 2 diff --git a/src/Dodge/Initialisation.hs b/src/Dodge/Initialisation.hs index 4b28d4ce8..c58198cc4 100644 --- a/src/Dodge/Initialisation.hs +++ b/src/Dodge/Initialisation.hs @@ -42,7 +42,6 @@ initialWorld = defaultWorld , _creatures = IM.fromList [(0,startCr)] , _props = IM.empty , _walls = IM.empty - , _forceFields = IM.empty , _floorItems = IM.empty , _randGen = mkStdGen 2 , _mousePos = V2 0 0 diff --git a/src/Dodge/Item/Weapon/Bezier.hs b/src/Dodge/Item/Weapon/Bezier.hs index c5a93d93b..9ef4ef3e3 100644 --- a/src/Dodge/Item/Weapon/Bezier.hs +++ b/src/Dodge/Item/Weapon/Bezier.hs @@ -61,7 +61,7 @@ shootBezier targetp cr w = w & particles %~ (theBullet :) startp (controlp +.+ randPos) (targetp +.+ randPos') - (destroyOnImpact bulHitCr bulHitWall bulHitFF') + (destroyOnImpact bulHitCr bulHitWall) 5 controlp = mouseWorldPos w cid = _crID cr diff --git a/src/Dodge/Item/Weapon/Bullet.hs b/src/Dodge/Item/Weapon/Bullet.hs index 680aba281..c50d799ad 100644 --- a/src/Dodge/Item/Weapon/Bullet.hs +++ b/src/Dodge/Item/Weapon/Bullet.hs @@ -8,21 +8,21 @@ import Geometry.Data basicBullet :: Ammo basicBullet = BulletAmmo { _amString = "BULLET" - , _amBulEff = destroyOnImpact bulHitCr bulHitWall bulHitFF' + , _amBulEff = destroyOnImpact bulHitCr bulHitWall , _amBulWth = 2 , _amBulVel = V2 50 0 } ltBullet :: Ammo ltBullet = BulletAmmo { _amString = "LTBULLET" - , _amBulEff = destroyOnImpact bulHitCr bulHitWall bulHitFF' + , _amBulEff = destroyOnImpact bulHitCr bulHitWall , _amBulWth = 2 , _amBulVel = V2 40 0 } hvBullet :: Ammo hvBullet = BulletAmmo { _amString = "HVBULLET" - , _amBulEff = penWalls hvBulHitCr hvBulHitWall' bulHitFF' + , _amBulEff = penWalls hvBulHitCr hvBulHitWall' , _amBulWth = 6 , _amBulVel = V2 80 0 } diff --git a/src/Dodge/Item/Weapon/Laser.hs b/src/Dodge/Item/Weapon/Laser.hs index e2bb55fca..4c4ff1af6 100644 --- a/src/Dodge/Item/Weapon/Laser.hs +++ b/src/Dodge/Item/Weapon/Laser.hs @@ -60,11 +60,11 @@ moveLaser phaseV pos dir w pt xp = pos +.+ 800 *.* unitVectorAtAngle dir (a,g) = randomR (-0.7,0.7) $ _randGen w reflectDir wall = a + argV (reflectIn (uncurry (-.-) (_wlLine wall)) (xp -.- pos)) - f :: [Wall] -> Point2 -> Point2 -> (Maybe (Point2,Either3 Creature Wall ForceField),[Point2]) + f :: [Wall] -> Point2 -> Point2 -> (Maybe (Point2,Either Creature Wall),[Point2]) f seenWs x y = case find (h' seenWs) $ thingsHitExceptCrLongLine Nothing x y w of - Just (p,E3x2 wl) + Just (p,Right wl) | _wlIsSeeThrough wl -> f' p $ f (wl:seenWs) p (h x y wl p) - | otherwise -> (Just (p,E3x2 wl), [p]) + | otherwise -> (Just (p,Right wl), [p]) Just (p,obj) -> (Just (p,obj), [p]) Nothing -> (Nothing, [y]) f' p (x,ps') = (x,p:ps') @@ -92,25 +92,20 @@ moveLaser phaseV pos dir w pt reflectInternal = 1 < abs (phaseV * sin angleInc') reflectExternal = 1 < abs (sin angleInc / phaseV) - h' ws (_,E3x2 wl) = not $ any (\w' -> _wlID w' == _wlID wl) ws + h' ws (_,Right wl) = not $ any (\w' -> _wlID w' == _wlID wl) ws h' _ _ = True (thHit, ps) = f [] pos xp hitEffect = case thHit of - Just (p,E3x1 cr) + Just (p,Left cr) -> over (creatures . ix (_crID cr) . crState . crDamage) ((:) $ Lasering 19 pos p xp) - Just (p,E3x2 wl) -> createSparkCol 8 (V4 20 (-5) 0 1) (p +.+ safeNormalizeV (pos -.- p)) + Just (p,Right wl) -> createSparkCol 8 (V4 20 (-5) 0 1) (p +.+ safeNormalizeV (pos -.- p)) (reflectDir wl) _ -> id pic = setLayer 1 $ pictures [ setDepth 19 . color (brightX 0 0.5 yellow) $ lineOfThickness 20 (pos:ps) , setDepth 19.5 . color (brightX 10 1 yellow) $ lineOfThickness 3 (pos:ps) ] - -- $ pictures - --[ fadeLine pos (head ps) 0.2 40 yellow - --, setLayer 1 $ color (withAlpha 0.9 white) $ vThickLine (pos:ps) - --, setLayer 1 $ color (withAlpha 0.5 yellow) $ vvThickLine (pos:ps) - --] fadeLine :: Point2 -> Point2 -> Float -> Float -> Color -> Picture fadeLine sp ep alph width col = setLayer 1 $ polygonCol diff --git a/src/Dodge/Particle/Bullet/HitEffect.hs b/src/Dodge/Particle/Bullet/HitEffect.hs index 420844a43..36d5efe0e 100644 --- a/src/Dodge/Particle/Bullet/HitEffect.hs +++ b/src/Dodge/Particle/Bullet/HitEffect.hs @@ -208,5 +208,3 @@ hvBulHitWall' bt p x w = damageBlocksBy 5 x $ set randGen g $ foldr ($) w (spar ts = randomRs (4,8) $ _randGen w sparks pos vel = zipWith3 (\t c d -> createSparkCol t c pos (argV vel + d)) ts cs ds -bulHitFF' :: Particle -> Point2 -> ForceField -> World -> World -bulHitFF' _ _ _ = id diff --git a/src/Dodge/Render/Picture.hs b/src/Dodge/Render/Picture.hs index b3bbdedad..810193222 100644 --- a/src/Dodge/Render/Picture.hs +++ b/src/Dodge/Render/Picture.hs @@ -8,7 +8,6 @@ import Dodge.Base import Dodge.Base.Window import Dodge.Zone import Dodge.Graph -import Dodge.Picture import Dodge.Picture.SizeInvariant import Dodge.Picture.Layer import Dodge.Render.HUD @@ -211,39 +210,6 @@ extendConeToScreenEdge w c (x,y) = orderPolygon $ wallScreenIntersect ++ [x,y] + rectangleSolid :: Float -> Float -> Picture rectangleSolid x y = polygon $ map toV2 [(x,y),(x,-y),(-x,-y),(-x,y)] - -ffToDraw :: World -> [ForceField] -ffToDraw _ = [] --- filter (lineOnScreen w . _ffLine) $ --- IM.elems $ over ffLine (map ( -.- _cameraCenter w)) <$> --- _forceFields w - -drawFF :: ForceField -> Picture -drawFF FF{_ffLine = l, _ffColor = col} = pictures - [color white $ line l - , color col $ lineOfThickness 6 l - ] - -drawFFShadow :: World -> ForceField -> [Picture] -drawFFShadow w ff - | youOnFF = [] - | otherwise = map (rotate ( _cameraRot w) . pane) [0,0.05..0.25] - where - x = rotateV (-_cameraRot w) x' - y = rotateV (-_cameraRot w) y' - yp = _crPos $ you w - (x1:y1:_) = _ffLine ff - (x':y':_) | isRHS x1 y1 yp = [y1,x1] - | otherwise = [x1,y1] - col = _ffColor ff - ypShift = yp -.- _cameraCenter w - youOnFF = circOnSeg x' y' ypShift (_crRad $ you w) - pane j = color (withAlpha 0.1 col) - $ polygon - [ x - , x +.+ ((0.1 + j) *.* (x -.- ypShift)) - , y +.+ ((0.1 + j) *.* (y -.- ypShift)) - , y] wallsAndWindows :: World -> ( [((Point2,Point2),Point4)] ,[((Point2,Point2),Point4)] ) diff --git a/src/Dodge/Update/Camera.hs b/src/Dodge/Update/Camera.hs index 9c863dcbf..0361ee1d7 100644 --- a/src/Dodge/Update/Camera.hs +++ b/src/Dodge/Update/Camera.hs @@ -56,41 +56,35 @@ moveCamera w = w updateScopeZoom :: World -> World updateScopeZoom w - | SDL.ButtonRight `S.member` _mouseButtons w = case w ^? scppoint of + | SDL.ButtonRight `S.member` _mouseButtons w + = case w ^? creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0)) + . itAttachment . scopeZoomChange of Just x - | x > 9 -> zoomInLongGun $ zoomInLongGun - $ w & creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0)) - . itAttachment . scopeZoomChange -~ 2 - | x > 0 -> zoomInLongGun - $ w & creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0)) - . itAttachment . scopeZoomChange -~ 1 - | x < -9 -> zoomOutLongGun $ zoomOutLongGun - $ w & creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0)) - . itAttachment . scopeZoomChange +~ 2 - | x < 0 -> zoomOutLongGun $ zoomOutLongGun - $ w & creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0)) - . itAttachment . scopeZoomChange +~ 1 + | x > 9 -> zoomInLongGun $ zoomInLongGun $ w + | x > 0 -> zoomInLongGun $ w + | x < -9 -> zoomOutLongGun $ zoomOutLongGun $ w + | x < 0 -> zoomOutLongGun $ w | otherwise -> w _ -> w | otherwise = w & creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0)) . itAttachment %~ updateScope where - scppoint = creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0)) - . itAttachment . scopeZoomChange updateScope (ItScope _ _ _ bl) = ItScope (V2 0 0) 0 1 bl updateScope otherAtt = otherAtt zoomSpeed :: Float zoomSpeed = 39/40 - +-- TODO unify zoom in and out, use scroll speed zoomInLongGun :: World -> World zoomInLongGun w | currentZoom < 8 = over (wpPointer . itAttachment . scopePos) - (\p -> p +.+ (4-(4*zoomSpeed)) / currentZoom *.* mousep) + (\p -> p +.+ (4-(4*zoomSpeed)) / currentZoom *.* mousep) $ over (wpPointer . itAttachment . scopeZoom) (/ zoomSpeed) + $ decreaseScopeZoomChange w - | otherwise = w + | otherwise = decreaseScopeZoomChange w where + decreaseScopeZoomChange = wpPointer . itAttachment . scopeZoomChange -~ 1 wpPointer = creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0)) wp = _crInv (_creatures w IM.! 0) IM.! _crInvSel (_creatures w IM.! 0) Just currentZoom = wp ^? itAttachment . scopeZoom @@ -98,40 +92,36 @@ zoomInLongGun w zoomOutLongGun :: World -> World zoomOutLongGun w - | currentZoom > 0.5 = over (wpPointer . itAttachment . scopeZoom) (* zoomSpeed) w - | otherwise = w + | currentZoom > 0.5 = over (wpPointer . itAttachment . scopeZoom) (* zoomSpeed) + $ increaseScopeZoomChange w + | otherwise = increaseScopeZoomChange w where + increaseScopeZoomChange = wpPointer . itAttachment . scopeZoomChange +~ 1 wpPointer = creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0)) wp = _crInv (_creatures w IM.! 0) IM.! _crInvSel (_creatures w IM.! 0) Just currentZoom = wp ^? itAttachment . scopeZoom rotCam :: World -> World -rotCam = rotateCameraL - . rotateCameraR - . zoomCamIn . zoomCamOut - . autoZoomCam +rotCam = rotateCameraKey . autoZoomCam -rotateCameraL :: World -> World -rotateCameraL w - | rotateCameraPlusKey (_keyConfig w) `S.member` _keys w - = w & cameraRot +~ 0.015 - & creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0)) - . itAttachment . scopePos %~ rotateV 0.015 +rotateCameraBy :: Float -> World -> World +rotateCameraBy x w = w + & cameraRot +~ x + & creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0)) + . itAttachment . scopePos %~ rotateV x + +rotateCameraKey :: World -> World +rotateCameraKey w + | keyl && keyr = w + | keyl = rotateCameraBy 0.015 w + | keyr = rotateCameraBy (-0.015) w | otherwise = w -rotateCameraR :: World -> World -rotateCameraR w | rotateCameraMinusKey (_keyConfig w) `S.member` _keys w - = w & cameraRot -~ 0.015 - & creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0)) - . itAttachment . scopePos %~ rotateV (-0.015) - | otherwise = w -zoomCamIn :: World -> World -zoomCamIn w | zoomInKey (_keyConfig w) `S.member` _keys w - = w {_cameraZoom = _cameraZoom w + 0.01} - | otherwise = w -zoomCamOut :: World -> World -zoomCamOut w | zoomOutKey (_keyConfig w) `S.member` _keys w - = w {_cameraZoom = max (_cameraZoom w - 0.01) 0.01} - | otherwise = w + where + keyl = rotateCameraPlusKey (_keyConfig w) `S.member` _keys w + keyr = rotateCameraMinusKey (_keyConfig w) `S.member` _keys w + +zoomCamBy :: Float -> World -> World +zoomCamBy x w = w {_cameraZoom = max (_cameraZoom w + x) 0.01} zoomFromItem :: ItZoom @@ -145,7 +135,12 @@ zoomNoItem zoomNoItem = min 20 . max 0.2 {- Automatically sets the zoom of the camera according to the surrounding walls. -} autoZoomCam :: World -> World -autoZoomCam w = over cameraZoom changeZoom w +autoZoomCam w + | zoomInKey (_keyConfig w) `S.member` _keys w + = zoomCamBy 0.01 w + | zoomOutKey (_keyConfig w) `S.member` _keys w + = zoomCamBy (-0.01) w + | otherwise = w & cameraZoom %~ changeZoom where camPos = _cameraViewFrom w wallZoom = farWallDist camPos w @@ -185,18 +180,5 @@ farWallPoints p w = concatMap _grViewpoints grs ++ linkvps extend :: Point2 -> Point2 extend outp = p +.+ maxViewDistance *.* safeNormalizeV (outp -.- p) ---farWallDist :: Point2 -> World -> Float ---farWallDist p w = (winFac /) $ fromMaybe maxViewDistance --- $ L.fold (L.premap (dist p) L.maximum) vdists --- where --- hw = halfWidth w --- hh = halfHeight w --- winFac = min hw hh --- vdists :: [Point2] --- vdists = map (flip (collidePointUpToIndirect p) wos) vps --- vps = concatMap _grViewpoints grs --- grs = filter (pointInOrOnPolygon p . _grBound) (_gameRooms w) --- wos = wallsOnScreen w - maxViewDistance :: Float maxViewDistance = 800 diff --git a/src/Dodge/Update/UsingInput.hs b/src/Dodge/Update/UsingInput.hs index 8e0e0577a..c07479ed2 100644 --- a/src/Dodge/Update/UsingInput.hs +++ b/src/Dodge/Update/UsingInput.hs @@ -1,8 +1,8 @@ -{- -Functions that affect the world according to what pressed buttons are stored in a Set. +{- Functions that affect the world according to what pressed buttons are stored in a Set. -} module Dodge.Update.UsingInput - where + ( updateUsingInput + ) where import Dodge.Data import Dodge.Item.Data import Dodge.Creature.Impulse.UseItem @@ -13,8 +13,7 @@ import qualified Data.Set as S import Control.Lens updateUsingInput :: World -> World -updateUsingInput w = - if _carteDisplay w +updateUsingInput w = if _carteDisplay w then updatePressedButtonsCarte (_mouseButtons w) w else updatePressedButtons (_mouseButtons w) w diff --git a/src/Dodge/WorldEvent.hs b/src/Dodge/WorldEvent.hs index 8f8a7ccd0..5dda7ee7e 100644 --- a/src/Dodge/WorldEvent.hs +++ b/src/Dodge/WorldEvent.hs @@ -40,7 +40,7 @@ createBarrelSpark pos dir maycid time colid w , _btPassThrough' = maycid , _btWidth' = 1 , _btTimer' = time - , _btHitEffect' = destroyOnImpact sparkEff noEff noEff + , _btHitEffect' = destroyOnImpact sparkEff noEff } x = fst $ randomR (0,20) $ _randGen w pos' = pos +.+ rotateV dir (V2 x 0) diff --git a/src/Dodge/WorldEvent/HitEffect.hs b/src/Dodge/WorldEvent/HitEffect.hs index 1cc91a8ca..83032ad01 100644 --- a/src/Dodge/WorldEvent/HitEffect.hs +++ b/src/Dodge/WorldEvent/HitEffect.hs @@ -15,7 +15,6 @@ import Control.Lens type HitCreatureEffect = Particle -> Point2 -> Creature -> World -> World type HitWallEffect = Particle -> Point2 -> Wall -> World -> World -type HitForceFieldEffect = Particle -> Point2 -> ForceField -> World -> World --passThroughAll -- :: HitCreatureEffect @@ -36,16 +35,14 @@ type HitForceFieldEffect = Particle -> Point2 -> ForceField -> World -> World destroyOnImpact :: HitCreatureEffect -> HitWallEffect - -> HitForceFieldEffect -> Particle - -> [(Point2, Either3 Creature Wall ForceField)] + -> [(Point2, Either Creature Wall)] -> World -> (World, Maybe Particle) -destroyOnImpact crEff wlEff ffEff pt hitThings w = case hitThings of +destroyOnImpact crEff wlEff pt hitThings w = case hitThings of [] -> ( w, mvPt pt) - ((p,E3x1 cr):_) -> (crEff pt p cr w, destroyAt p pt) - ((p,E3x2 wl):_) -> (wlEff pt p wl w, destroyAt p pt) - ((p,E3x3 ff):_) -> (ffEff pt p ff w, destroyAt p pt) + ((p,Left cr):_) -> (crEff pt p cr w, destroyAt p pt) + ((p,Right wl):_) -> (wlEff pt p wl w, destroyAt p pt) mvPt :: Particle -> Maybe Particle mvPt pt = Just $ pt @@ -63,18 +60,16 @@ destroyAt hitp pt = Just $ pt penWalls :: HitCreatureEffect -> HitWallEffect - -> HitForceFieldEffect -> Particle - -> [(Point2, Either3 Creature Wall ForceField)] + -> [(Point2, Either Creature Wall)] -> World -> (World, Maybe Particle) -penWalls crEff wlEff ffEff pt hitThings w = case hitThings of +penWalls crEff wlEff pt hitThings w = case hitThings of [] -> ( w, mvPt pt) - ((p,E3x1 cr):_) -> (crEff pt p cr w, destroyAt p pt) - ((p,E3x3 ff):_) -> (ffEff pt p ff w, destroyAt p pt) - ((p,E3x2 wl):hs) | isJust (wl ^? wlBlockID) - -> first (wlEff pt p wl) $ penWalls crEff wlEff ffEff pt hs w - ((p,E3x2 wl):_) -> (wlEff pt p wl w, destroyAt p pt) + ((p,Left cr):_) -> (crEff pt p cr w, destroyAt p pt) + ((p,Right wl):hs) | isJust (wl ^? wlBlockID) + -> first (wlEff pt p wl) $ penWalls crEff wlEff pt hs w + ((p,Right wl):_) -> (wlEff pt p wl w, destroyAt p pt) doFlameDam :: Int -> Particle -> Point2 -> Creature -> World -> World doFlameDam amount pt p cr = creatures . ix (_crID cr) . crState . crDamage %~ diff --git a/src/Dodge/WorldEvent/SpawnParticle.hs b/src/Dodge/WorldEvent/SpawnParticle.hs index 92c09c52c..26b88be47 100644 --- a/src/Dodge/WorldEvent/SpawnParticle.hs +++ b/src/Dodge/WorldEvent/SpawnParticle.hs @@ -55,7 +55,7 @@ aFlameParticle t pos vel maycid = PtZ , _btPassThrough' = maycid , _btWidth' = 4 , _btTimer' = t - , _btHitEffect' = destroyOnImpact (doFlameDam 1) noEff noEff + , _btHitEffect' = destroyOnImpact (doFlameDam 1) noEff , _ptZ = 20 } drawFlame @@ -98,8 +98,8 @@ moveFlame moveFlame rotd w pt | time <= 0 = (makeFlamerSmokeAt (addZ 20 ep) w, Nothing) | otherwise = case thingsHitExceptCr (_btPassThrough' pt) sp ep w of - ((_,E3x1 _):_) -> (doSound damcrs , mvPt 0.7) - (thing@(p,E3x2 wl):_) -> (doSound . fst $ hiteff [thing] damcrs , rfl wl p) + ((_,Left _):_) -> (doSound damcrs , mvPt 0.7) + (thing@(p,Right wl):_) -> (doSound . fst $ hiteff [thing] damcrs , rfl wl p) _ -> (flameFlicker pt $ doSound damcrs , mvPt 0.98) where time = _btTimer' pt @@ -112,7 +112,7 @@ moveFlame rotd w pt , _btPos' = ep , _btPassThrough' = Nothing , _btVel' = speed *.* vel } - damcrs = foldr (\cr -> fst . hiteff [(ep,E3x1 cr)]) w + damcrs = foldr (\cr -> fst . hiteff [(ep,Left cr)]) w $ IM.filter closeCrs $ _creatures w closeCrs cr = dist ep (_crPos cr) < _crRad cr + 10 - min 9 (max 0 (fromIntegral time - 80)) @@ -150,7 +150,7 @@ makeFlameletTimed (V2 x y) z vel maycid size time w = w , _btPassThrough' = maycid , _btWidth' = size , _btTimer' = time - , _btHitEffect' = destroyOnImpact (doFlameDam 1) noEff noEff + , _btHitEffect' = destroyOnImpact (doFlameDam 1) noEff , _ptZ = z } (rot ,g) = randomR (0,3) $ _randGen w @@ -205,7 +205,7 @@ Applies movement and attaches damage to nearby creatures. -} moveFlamelet :: World -> Particle -> (World, Maybe Particle) moveFlamelet w pt | _btTimer' pt <= 0 = ( w, Nothing) - | otherwise = (flameFlicker pt $ damcrs, mvPt) + | otherwise = (flameFlicker pt damcrs, mvPt) where sp = _btPos' pt vel = _btVel' pt @@ -389,7 +389,7 @@ createSparkCol time col pos dir = worldEvents %~ ( over particles (spark :) . ) , _btPassThrough' = Nothing , _btWidth' = 1 , _btTimer' = time - , _btHitEffect' = destroyOnImpact sparkEff noEff noEff + , _btHitEffect' = destroyOnImpact sparkEff noEff } sparkEff bt p cr = creatures . ix (_crID cr) . crState . crDamage %~ ( SparkDam 1 sp p ep : ) diff --git a/src/Dodge/WorldEvent/ThingsHit.hs b/src/Dodge/WorldEvent/ThingsHit.hs index 22c4481ea..c3cf6eb4f 100644 --- a/src/Dodge/WorldEvent/ThingsHit.hs +++ b/src/Dodge/WorldEvent/ThingsHit.hs @@ -11,7 +11,6 @@ module Dodge.WorldEvent.ThingsHit import Dodge.Data import Dodge.Base import Dodge.Zone ---import Dodge.Zone.Data import Geometry import qualified Data.IntMap.Strict as IM @@ -22,27 +21,25 @@ thingsHit :: Point2 -- ^ Line start point -> Point2 -- ^ Line end point -> World - -> [(Point2, Either3 Creature Wall ForceField)] + -> [(Point2, Either Creature Wall)] thingsHit sp ep w | sp == ep = [] - | otherwise = sortOn (dist sp . fst) (crs ++ wls ++ ffs) + | otherwise = sortOn (dist sp . fst) (crs ++ wls) where hitCrs = IM.elems $ IM.filter (\cr -> circOnSeg sp ep (_crPos cr) (_crRad cr)) $ _creatures w -- $ creaturesAlongLine sp ep w crPs = map (\cr -> ssaTriPoint ep (_crPos cr) sp (_crRad cr)) hitCrs - crs = zip crPs (map E3x1 hitCrs) + crs = zip crPs (map Left hitCrs) hitWls = wallsOnLine sp ep (IM.unions [f b $ f a $ _znObjects $ _wallsZone w | a<-[x-1,x,x+1] , b<-[y-1,y,y+1]]) (x,y) = zoneOfPoint (0.5 *.* (sp +.+ ep)) f i m = case IM.lookup i m of Just val -> val _ -> IM.empty - wls = zip (map (fromJust . hitPoint) hitWls) (map E3x2 hitWls) + wls = zip (map (fromJust . hitPoint) hitWls) (map Right hitWls) hitPoint w' = uncurry (intersectSegSeg sp ep) (_wlLine w') - hitFFs = mapMaybe (collidePointFF sp ep (_randGen w)) (IM.elems $ _forceFields w) - ffs = map (\(p,(_,i)) -> (p, E3x3 $ _forceFields w IM.! i)) hitFFs {- List objects that appear on a line. Can filter out a creature. -} thingsHitExceptCr @@ -50,11 +47,11 @@ thingsHitExceptCr -> Point2 -- ^ Line start point -> Point2 -- ^ Line end point -> World - -> [(Point2, Either3 Creature Wall ForceField)] + -> [(Point2, Either Creature Wall)] thingsHitExceptCr Nothing sp ep = thingsHit sp ep thingsHitExceptCr (Just cid) sp ep = filter crNotCid . thingsHit sp ep where - crNotCid (_,E3x1 cr) = _crID cr /= cid + crNotCid (_,Left cr) = _crID cr /= cid crNotCid _ = True thingsHitExceptCrLongLine @@ -62,26 +59,24 @@ thingsHitExceptCrLongLine -> Point2 -> Point2 -> World - -> [(Point2, Either3 Creature Wall ForceField)] + -> [(Point2, Either Creature Wall)] 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 (_,Left cr) = _crID cr /= cid crNotCid _ = True -thingsHitLongLine :: Point2 -> Point2 -> World -> [(Point2, Either3 Creature Wall ForceField)] +thingsHitLongLine :: Point2 -> Point2 -> World -> [(Point2, Either Creature Wall)] thingsHitLongLine sp ep w | sp == ep = [] - | otherwise = sortOn (dist sp . fst) (crs ++ wls ++ ffs) + | otherwise = sortOn (dist sp . fst) (crs ++ wls) where - crs = zip crPs (map E3x1 hitCrs) + crs = zip crPs (map Left hitCrs) hitCrs = IM.elems . IM.filter (\cr -> circOnSeg sp ep (_crPos cr) (_crRad cr)) $ _creatures w -- $ creaturesAlongLine sp ep w crPs = map (\cr -> ssaTriPoint ep (_crPos cr) sp (_crRad cr)) hitCrs - wls = zip (map (fromJust . hitPoint) hitWls) (map E3x2 hitWls) + wls = zip (map (fromJust . hitPoint) hitWls) (map Right hitWls) hitWls = wallsOnLine sp ep $ wallsAlongLine sp ep w hitPoint wl = uncurry (intersectSegSeg sp ep) (_wlLine wl) - hitFFs = mapMaybe (collidePointFF sp ep (_randGen w)) (IM.elems $ _forceFields w) - ffs = map (\(p,(_,i)) -> (p, E3x3 $ _forceFields w IM.! i)) hitFFs