Cleanup

src/Dodge/Update.hs

@@ -14,12 +14,12 @@ import Dodge.Update.Input.ScreenLayer
 import Dodge.Debug
 import Dodge.SmoothScroll
 import Color
-import Control.Applicative
+--import Control.Applicative
 import Data.List
 import qualified Data.Map.Strict as M
 import Data.Maybe
 import Dodge.Base
-import Dodge.Beam
+--import Dodge.Beam
 import Dodge.Bullet
 import Dodge.CrGroupUpdate
 import Dodge.Creature.Update
@@ -251,7 +251,7 @@ functionalUpdate w =
         . over uvWorld updateBullets
         . over uvWorld updateRadarBlips
         . over uvWorld updateFlares
-        . over uvWorld updateBeams
+--        . over uvWorld updateBeams
         . over uvWorld updateLasers
         . over uvWorld updateTeslaArcs
         . over uvWorld updateTractorBeams
@@ -458,61 +458,61 @@ updatePosEvents = updateObjCatMaybes posEvents updatePosEvent
 updateClouds :: World -> World
 updateClouds = updateObjCatMaybes clouds updateCloud
 
-updateBeams :: World -> World
-updateBeams w =
-    w
-        & cWorld . lWorld . newBeams .~ WorldBeams [] [] [] []
-        & cWorld . lWorld . beams .~ thebeams
-        & combineBeams thebeams
-  where
-    thebeams = w ^. cWorld . lWorld . newBeams
+--updateBeams :: World -> World
+--updateBeams w =
+--    w
+--        & cWorld . lWorld . newBeams .~ WorldBeams [] [] [] []
+--        & cWorld . lWorld . beams .~ thebeams
+--        & combineBeams thebeams
+--  where
+--    thebeams = w ^. cWorld . lWorld . newBeams
 
-combineBeams :: WorldBeams -> World -> World
-combineBeams wbeams w =
-    w''
-        & cWorld . lWorld . beams . positronBeams .~ pbeams
-        & cWorld . lWorld . beams . electronBeams .~ ebeams
-  where
-    (w', pbeams) = mapAccumR (combineBeamBeams (_electronBeams wbeams)) w $ _positronBeams wbeams
-    (w'', ebeams) = mapAccumR (combineBeamBeams (_positronBeams wbeams)) w' $ _electronBeams wbeams
+--combineBeams :: WorldBeams -> World -> World
+--combineBeams wbeams w =
+--    w''
+--        & cWorld . lWorld . beams . positronBeams .~ pbeams
+--        & cWorld . lWorld . beams . electronBeams .~ ebeams
+--  where
+--    (w', pbeams) = mapAccumR (combineBeamBeams (_electronBeams wbeams)) w $ _positronBeams wbeams
+--    (w'', ebeams) = mapAccumR (combineBeamBeams (_positronBeams wbeams)) w' $ _electronBeams wbeams
 
-combineBeamBeams :: [Beam] -> World -> Beam -> (World, Beam)
-combineBeamBeams bms w bm = case intersectBeamBeams bm bms of
-    (ps, Nothing) -> (w, bm & bmFirstPoints .~ ps)
-    (ps, Just a) -> (doBeamCombine (_beamCombine (_bmType bm)) a w, bm & bmFirstPoints .~ ps)
+--combineBeamBeams :: [Beam] -> World -> Beam -> (World, Beam)
+--combineBeamBeams bms w bm = case intersectBeamBeams bm bms of
+--    (ps, Nothing) -> (w, bm & bmFirstPoints .~ ps)
+--    (ps, Just a) -> (doBeamCombine (_beamCombine (_bmType bm)) a w, bm & bmFirstPoints .~ ps)
 
--- intersect a beam with a list of beams.
--- returns the (reversed) travel of the beam up to maybe an intersection point
-intersectBeamBeams ::
-    Beam ->
-    [Beam] ->
-    ([Point2], Maybe (Point2, (Point2, Point2, Beam), (Point2, Point2, Beam)))
-intersectBeamBeams bm bms = f [] $ _bmPoints bm
-  where
-    f ps (x : y : ys) = case intersectSegBeams x y bms of
-        Just (z, a) -> (z : x : ps, Just (z, (x, y, bm), a))
-        Nothing -> f (x : ps) (y : ys)
-    f ps [x] = (x : ps, Nothing)
-    f _ _ = error "made an empty beam"
+---- intersect a beam with a list of beams.
+---- returns the (reversed) travel of the beam up to maybe an intersection point
+--intersectBeamBeams ::
+--    Beam ->
+--    [Beam] ->
+--    ([Point2], Maybe (Point2, (Point2, Point2, Beam), (Point2, Point2, Beam)))
+--intersectBeamBeams bm bms = f [] $ _bmPoints bm
+--  where
+--    f ps (x : y : ys) = case intersectSegBeams x y bms of
+--        Just (z, a) -> (z : x : ps, Just (z, (x, y, bm), a))
+--        Nothing -> f (x : ps) (y : ys)
+--    f ps [x] = (x : ps, Nothing)
+--    f _ _ = error "made an empty beam"
+--
+--intersectSegBeams :: Point2 -> Point2 -> [Beam] -> Maybe (Point2, (Point2, Point2, Beam))
+--intersectSegBeams sp ep (bm : bms) = case intersectSegBeam sp ep bm of
+--    Nothing -> intersectSegBeams sp ep bms
+--    --Just a@(z,_) -> maybe (Just a) Just $ intersectSegBeams sp z bms
+--    Just a@(z, _) -> intersectSegBeams sp z bms <|> Just a
+--intersectSegBeams _ _ _ = Nothing
+--
+--intersectSegBeam :: Point2 -> Point2 -> Beam -> Maybe (Point2, (Point2, Point2, Beam))
+--intersectSegBeam sp ep bm = case intersectSegSegs' sp ep (_bmPoints bm) of
+--    Nothing -> Nothing
+--    Just (z, x, y) -> Just (z, (x, y, bm))
 
-intersectSegBeams :: Point2 -> Point2 -> [Beam] -> Maybe (Point2, (Point2, Point2, Beam))
-intersectSegBeams sp ep (bm : bms) = case intersectSegBeam sp ep bm of
-    Nothing -> intersectSegBeams sp ep bms
-    --Just a@(z,_) -> maybe (Just a) Just $ intersectSegBeams sp z bms
-    Just a@(z, _) -> intersectSegBeams sp z bms <|> Just a
-intersectSegBeams _ _ _ = Nothing
-
-intersectSegBeam :: Point2 -> Point2 -> Beam -> Maybe (Point2, (Point2, Point2, Beam))
-intersectSegBeam sp ep bm = case intersectSegSegs' sp ep (_bmPoints bm) of
-    Nothing -> Nothing
-    Just (z, x, y) -> Just (z, (x, y, bm))
-
-intersectSegSegs' :: Point2 -> Point2 -> [Point2] -> Maybe (Point2, Point2, Point2)
-intersectSegSegs' sp ep (x : y : ys) = case intersectSegSeg sp ep x y of
-    --Just z  -> maybe (Just (z,x,y)) Just $ intersectSegSegs' sp z (y:ys)
-    Just z -> intersectSegSegs' sp z (y : ys) <|> Just (z, x, y)
-    Nothing -> intersectSegSegs' sp ep (y : ys)
-intersectSegSegs' _ _ _ = Nothing
+--intersectSegSegs' :: Point2 -> Point2 -> [Point2] -> Maybe (Point2, Point2, Point2)
+--intersectSegSegs' sp ep (x : y : ys) = case intersectSegSeg sp ep x y of
+--    --Just z  -> maybe (Just (z,x,y)) Just $ intersectSegSegs' sp z (y:ys)
+--    Just z -> intersectSegSegs' sp z (y : ys) <|> Just (z, x, y)
+--    Nothing -> intersectSegSegs' sp ep (y : ys)
+--intersectSegSegs' _ _ _ = Nothing
 
 --intersectSegSegs :: Point2 -> Point2 -> [Point2] -> Maybe Point2
 --intersectSegSegs sp ep (x:y:ys) = case intersectSegSeg sp ep x y of