Cleanup

src/Dodge/Beam.hs

@@ -1,70 +1,63 @@
-module Dodge.Beam where
+module Dodge.Beam 
+    () where
 
-import Data.Maybe
-import Dodge.Data.World
-import Dodge.Flame
-import Dodge.Item.Location
-import Dodge.Tesla.Arc
-import Geometry
-import LensHelp
-import Picture
+--import Data.Maybe
+--import Dodge.Data.World
+--import Dodge.Flame
+--import Dodge.Item.Location
+--import Dodge.Tesla.Arc
+--import Geometry
+--import LensHelp
+--import Picture
 
-doBeamCombine ::
-    BeamCombineType ->
-    (Point2, (Point2, Point2, Beam), (Point2, Point2, Beam)) ->
-    World ->
-    World
-doBeamCombine bct = case bct of
-    FlameBeamCombine -> flameBeamCombine
-    LasBeamCombine -> lasBeamCombine
-    TeslaBeamCombine -> teslaBeamCombine
-    SplitBeamCombine -> splitBeamCombine
-    NoBeamCombine -> const id
 
-flameBeamCombine ::
-    (Point2, (Point2, Point2, Beam), (Point2, Point2, Beam)) ->
-    World ->
-    World
-flameBeamCombine (p, (a, b, _), (x, y, _)) =
-    makeFlame p (2 *.* normalizeV (normalizeV (b -.- a) +.+ normalizeV (y -.- x)))
+--doBeamCombine ::
+--    BeamCombineType ->
+--    (Point2, (Point2, Point2, Beam), (Point2, Point2, Beam)) ->
+--    World ->
+--    World
+--doBeamCombine bct = case bct of
+--    FlameBeamCombine -> flameBeamCombine
+--    LasBeamCombine -> lasBeamCombine
+--    TeslaBeamCombine -> teslaBeamCombine
+--    SplitBeamCombine -> splitBeamCombine
+--    NoBeamCombine -> const id
+--
+--flameBeamCombine ::
+--    (Point2, (Point2, Point2, Beam), (Point2, Point2, Beam)) ->
+--    World ->
+--    World
+--flameBeamCombine (p, (a, b, _), (x, y, _)) =
+--    makeFlame p (2 *.* normalizeV (normalizeV (b -.- a) +.+ normalizeV (y -.- x)))
+--
+--lasBeamCombine ::
+--    (Point2, (Point2, Point2, Beam), (Point2, Point2, Beam)) ->
+--    World ->
+--    World
+--lasBeamCombine (p, (a, b, _), (x, y, _)) =
+--    cWorld . lWorld . lasers .:~ lasRayAt yellow 11 1 p (argV (normalizeV (b -.- a) +.+ normalizeV (y -.- x)))
+--
+--splitBeamCombine ::
+--    (Point2, (Point2, Point2, Beam), (Point2, Point2, Beam)) ->
+--    World ->
+--    World
+--splitBeamCombine (p, (a, b, _), (x, y, _)) =
+--    (cWorld . lWorld . lasers .:~ lasRayAt yellow 11 1 p (dir + 0.5 * pi))
+--        . (cWorld . lWorld . lasers .:~ lasRayAt yellow 11 1 p (dir -0.5 * pi))
+--  where
+--    dir = argV (normalizeV (b -.- a) +.+ normalizeV (y -.- x))
+--
+--teslaBeamCombine ::
+--    (Point2, (Point2, Point2, Beam), (Point2, Point2, Beam)) ->
+--    World ->
+--    World
+--teslaBeamCombine (p, (a, b, bm), (x, y, _)) w =
+--    w' & pointerToItemLocation (w ^?! cWorld . lWorld . itemLocations . ix itid) . itParams . subParams ?~ ip
+--  where
+--    itid = fromJust $ _bmOrigin bm
+--    dir = argV (normalizeV (b -.- a) +.+ normalizeV (y -.- x))
+--    (w', ip) = makeTeslaArc (fromJust . _subParams $ _itParams it) p dir w
+--    it = case getItem itid w of
+--        Nothing -> error "tried to get item use teslaBeamCombine that doesn't exist"
+--        Just itm -> itm
 
-lasBeamCombine ::
-    (Point2, (Point2, Point2, Beam), (Point2, Point2, Beam)) ->
-    World ->
-    World
-lasBeamCombine (p, (a, b, _), (x, y, _)) =
-    cWorld . lWorld . lasers .:~ lasRayAt yellow 11 1 p (argV (normalizeV (b -.- a) +.+ normalizeV (y -.- x)))
-
-splitBeamCombine ::
-    (Point2, (Point2, Point2, Beam), (Point2, Point2, Beam)) ->
-    World ->
-    World
-splitBeamCombine (p, (a, b, _), (x, y, _)) =
-    (cWorld . lWorld . lasers .:~ lasRayAt yellow 11 1 p (dir + 0.5 * pi))
-        . (cWorld . lWorld . lasers .:~ lasRayAt yellow 11 1 p (dir -0.5 * pi))
-  where
-    dir = argV (normalizeV (b -.- a) +.+ normalizeV (y -.- x))
-
-teslaBeamCombine ::
-    (Point2, (Point2, Point2, Beam), (Point2, Point2, Beam)) ->
-    World ->
-    World
-teslaBeamCombine (p, (a, b, bm), (x, y, _)) w =
-    w' & pointerToItemLocation (w ^?! cWorld . lWorld . itemLocations . ix itid) . itParams . subParams ?~ ip
-  where
-    itid = fromJust $ _bmOrigin bm
-    dir = argV (normalizeV (b -.- a) +.+ normalizeV (y -.- x))
-    (w', ip) = makeTeslaArc (fromJust . _subParams $ _itParams it) p dir w
-    it = case getItem itid w of
-        Nothing -> error "tried to get item use teslaBeamCombine that doesn't exist"
-        Just itm -> itm
-
-lasRayAt :: Color -> Int -> Float -> Point2 -> Float -> LaserStart
-lasRayAt col dam phasev pos dir =
-    LaserStart
-        { _lpType = DamageLaser dam
-        , _lpPhaseV = phasev
-        , _lpPos = pos
-        , _lpDir = dir
-        , _lpColor = col
-        }

src/Dodge/Data/Item/Params.hs

@@ -10,8 +10,7 @@ import Control.Lens
 import Data.Aeson
 import Data.Aeson.TH
 import Dodge.Data.ArcStep
-import Dodge.Data.Beam
-import Geometry.Data
+--import Dodge.Data.Beam
 
 data ItemParams
     = NoParams
@@ -28,17 +27,16 @@ data ItemParams
         , _lasCycle :: Int
         , _lasDamage :: Int
         }
-    | DualBeam
-        { _phaseV :: Float
-        , _lasColor :: Color
-        , _lasColor2 :: Color
-        , _lasCycle :: Int
-        , _lasDamage :: Int
-        , _lasBeam :: BeamType
-        , _subParams :: Maybe ItemParams
-        , _dbGap :: Float
-        }
-    | Attracting {_attractionPower :: Point2}
+--    | DualBeam
+--        { _phaseV :: Float
+--        , _lasColor :: Color
+--        , _lasColor2 :: Color
+--        , _lasCycle :: Int
+--        , _lasDamage :: Int
+--        , _lasBeam :: BeamType
+--        , _subParams :: Maybe ItemParams
+--        , _dbGap :: Float
+--        }
     | Arcing
         { _currentArc :: Maybe [ArcStep]
         , _arcSize :: Float

src/Dodge/Data/LWorld.hs

@@ -112,8 +112,8 @@ data LWorld = LWorld
     , _sparks :: [Spark]
     , _radarBlips :: [RadarBlip]
     , _flares :: [Flare]
-    , _newBeams :: WorldBeams
-    , _beams :: WorldBeams
+--    , _newBeams :: WorldBeams
+--    , _beams :: WorldBeams
     , _teslaArcs :: [TeslaArc]
     , _shockwaves :: [Shockwave]
     , _lasers :: [LaserStart]
@@ -147,18 +147,18 @@ data LWorld = LWorld
     , _lTestString :: [String]
     , _lTestInt :: Int
     }
-data WorldBeams = WorldBeams
-    { _blockingBeams :: [Beam]
-    , _lightBeams :: [Beam]
-    , _positronBeams :: [Beam]
-    , _electronBeams :: [Beam]
-    }
+--data WorldBeams = WorldBeams
+--    { _blockingBeams :: [Beam]
+--    , _lightBeams :: [Beam]
+--    , _positronBeams :: [Beam]
+--    , _electronBeams :: [Beam]
+--    }
 
 makeLenses ''LWorld
-makeLenses ''WorldBeams
+--makeLenses ''WorldBeams
 concat
     <$> mapM
         (deriveJSON defaultOptions)
-        [ ''WorldBeams
-        , ''LWorld
+        [-- ''WorldBeams
+         ''LWorld
         ]

src/Dodge/Default/World.hs

@@ -110,8 +110,8 @@ defaultLWorld =
         , _energyBalls = []
         , _radarBlips = []
         , _flares = []
-        , _newBeams = WorldBeams [] [] [] []
-        , _beams = WorldBeams [] [] [] []
+--        , _newBeams = WorldBeams [] [] [] []
+--        , _beams = WorldBeams [] [] [] []
         , _teslaArcs = []
         , _shockwaves = []
         , _lasers = []

src/Dodge/HeldUse.hs

@@ -5,6 +5,7 @@ module Dodge.HeldUse
     )
     where
 
+import Color.Data
 import Dodge.Base.Coordinate
 import Dodge.Base.Collide
 import Dodge.Inventory.Lock
@@ -24,7 +25,7 @@ import Data.Maybe
 import Dodge.Creature.HandPos
 import Dodge.Data.World
 import Dodge.Gas
-import Dodge.Item.Weapon.BatteryGuns
+--import Dodge.Item.Weapon.BatteryGuns
 --import Dodge.Item.Weapon.Launcher
 import Dodge.Item.Weapon.Radar
 import Dodge.Item.Weapon.Shatter
@@ -187,9 +188,9 @@ useLoadedAmmo _ _ (cme,w) (_,Nothing) = (cme, w)
 useLoadedAmmo itmtree cr (cme,w) (mzid,Just (mz,x,magtree)) = (,) (cme & cmeSound .~ True) $ 
         removeAmmoFromMag x mid cr . makeMuzzleFlare mz itm cr $ case _mzEffect mz of
     MuzzleShootBullet -> shootBullet itmtree cr (mz,x,magtree) w
-    MuzzleLaser -> shootLaser' itm cr mz w
+    MuzzleLaser -> shootLaser itm cr mz w
     MuzzleTesla -> shootTeslaArc itm cr mz w
-    MuzzleTractor -> shootTractorBeam itm cr w
+    MuzzleTractor -> shootTractorBeam cr w
     MuzzleLauncher -> createProjectile magtree mz itmtree cr w 
     MuzzleNozzle {} -> useGasParams mid mz itm cr $ walkNozzle mzid mz itm cr w
     MuzzleShatter -> shootShatter itm cr w
@@ -219,15 +220,15 @@ walkNozzle mzid mz itm cr w = fromMaybe w $ do
     wa = min maxa $ max (negate maxa) (_nzCurrentWalkAngle nz + walkamount)
     
 
-shootTractorBeam :: Item -> Creature -> World -> World
-shootTractorBeam itm cr w = w & cWorld . lWorld . tractorBeams .:~ tractorBeamAt spos outpos dir power
+shootTractorBeam :: Creature -> World -> World
+shootTractorBeam cr w = w & cWorld . lWorld . tractorBeams .:~ tractorBeamAt spos outpos dir power
   where
     cpos = _crPos cr
     spos = cpos +.+ (_crRad cr + 10) *.* unitVectorAtAngle dir
     xpos = cpos +.+ 400 *.* unitVectorAtAngle dir
     dir = _crDir cr
     outpos = fst $ collidePointWallsFilter (const True) cpos xpos w
-    power = _attractionPower . _itParams $ itm
+    power = 1
 
 tractorBeamAt :: Point2 -> Point2 -> Float -> Point2 -> TractorBeam
 tractorBeamAt pos outpos dir power =
@@ -240,23 +241,33 @@ tractorBeamAt pos outpos dir power =
   where
     d = unitVectorAtAngle dir * power
 
-shootLaser' :: Item -> Creature -> Muzzle -> World -> World
-shootLaser' itm cr mz w = w 
+shootLaser :: Item -> Creature -> Muzzle -> World -> World
+shootLaser itm cr mz w = w 
     & randGen .~ g
-    &
-    cWorld . lWorld . lasers
-        .:~ lasRayAt
-            (_lasColor $ _itParams itm)
-            (_lasDamage $ _itParams itm)
-            (_phaseV $ _itParams itm)
-            pos
-            dir
+    & cWorld . lWorld . lasers
+        .:~ LaserStart
+            { _lpType = DamageLaser . _lasDamage $ _itParams itm
+            , _lpPhaseV = _phaseV $ _itParams itm
+            , _lpPos = pos
+            , _lpDir = dir
+            , _lpColor = _lasColor $ _itParams itm
+            }
   where
     pos = _crPos cr + rotateV (_crDir cr) (_mzPos mz + aimingWeaponZeroPos cr itm)
     (a,g) = randomR (-inacc,inacc) $ _randGen w
     inacc = _mzInaccuracy mz
     dir = _crDir cr + _mzRot mz + a
 
+lasRayAt :: Color -> Int -> Float -> Point2 -> Float -> LaserStart
+lasRayAt col dam phasev pos dir =
+    LaserStart
+        { _lpType = DamageLaser dam
+        , _lpPhaseV = phasev
+        , _lpPos = pos
+        , _lpDir = dir
+        , _lpColor = col
+        }
+
 removeAmmoFromMag :: Int -> Maybe Int -> Creature -> World -> World
 removeAmmoFromMag x mid cr = fromMaybe id $ do
     magid <- mid

src/Dodge/Item/Held/BatteryGuns.hs

@@ -73,7 +73,6 @@ lasGun =
 tractorGun :: Item
 tractorGun =
     lasGun
-        & itParams .~ Attracting{_attractionPower = 1}
         & itUse . heldDelay .~ NoDelay
         & itUse . heldAim . aimWeight .~ 6
         & itUse . heldAim . aimRange .~ 1

src/Dodge/Item/Weapon.hs

@@ -5,11 +5,11 @@ module Dodge.Item.Weapon (
     module Dodge.Item.Weapon.Spawn,
     module Dodge.Item.Weapon.Radar,
     module Dodge.Item.Weapon.Utility,
-    module Dodge.Item.Weapon.BatteryGuns,
+--    module Dodge.Item.Weapon.BatteryGuns,
     module Dodge.Item.Weapon.Drone,
 ) where
 
-import Dodge.Item.Weapon.BatteryGuns
+--import Dodge.Item.Weapon.BatteryGuns
 import Dodge.Item.Weapon.Drone
 import Dodge.Item.Weapon.ExtraEffect
 import Dodge.Item.Weapon.Radar

src/Dodge/Item/Weapon/BatteryGuns.hs

@@ -1,26 +1,19 @@
 module Dodge.Item.Weapon.BatteryGuns (
-    lasRayAt,
-    flameBeamCombine,
-    teslaBeamCombine,
-    splitBeamCombine,
-    --    shootTeslaArc,
-    shootLaser,
-    --circleLaser,
-    --shootDualLaser,
+--    lasRayAt,
+--    flameBeamCombine,
+--    teslaBeamCombine,
+--    splitBeamCombine,
+--    --    shootTeslaArc,
+--    shootLaser,
+--    --circleLaser,
+--    --shootDualLaser,
 --    aTractorBeam,
 ) where
 
---import Dodge.Base
-import Dodge.Beam
---import Dodge.Creature.HandPos
-import Dodge.Data.World
---import Dodge.Item.Weapon.LaserPath
---import Geometry
---import qualified IntMapHelp as IM
-import LensHelp
---import Picture
-
---import Control.Monad.State
+--import Geometry.Data
+--import Color.Data
+--import Dodge.Data.World
+--import LensHelp
 
 
 --lasWidePulse :: Item
@@ -74,15 +67,15 @@ import LensHelp
 --        x' = _lasCycle $ _itParams it
 
 
-shootLaser :: Item -> Creature -> World -> World
-shootLaser it cr =
-    cWorld . lWorld . lasers
-        .:~ lasRayAt
-            (_lasColor $ _itParams it)
-            (_lasDamage $ _itParams it)
-            (_phaseV $ _itParams it)
-            (_crPos cr)
-            (_crDir cr)
+--shootLaser :: Item -> Creature -> World -> World
+--shootLaser it cr =
+--    cWorld . lWorld . lasers
+--        .:~ lasRayAt
+--            (_lasColor $ _itParams it)
+--            (_lasDamage $ _itParams it)
+--            (_phaseV $ _itParams it)
+--            (_crPos cr)
+--            (_crDir cr)
 
 ---- this has the feel of a left click item
 --circleLaser :: Item -> Creature -> World -> World

src/Dodge/Render/HUD.hs

@@ -253,9 +253,9 @@ displayTerminal tid cfig w = fromMaybe mempty $ do
         | otherwise = []
 
 lnkMidPosInvSelsCol :: Configuration -> World -> Int -> Color -> [Int] -> Picture
-lnkMidPosInvSelsCol cfig w i col = foldMap f
+lnkMidPosInvSelsCol cfig w i col = fromMaybe mempty . foldMap f
   where
-    f j = fromMaybe mempty $ do
+    f j = do
         sss <- w ^? hud . hudElement . diSections
         combinesss <- w ^? hud . hudElement . subInventory . ciSections
         lp <- selNumPos cfig (invDisplayParams w) sss 0 j
@@ -281,11 +281,6 @@ invHead cfig =
 --    h :: String -> Point2 -> Point2
 --    h s (V2 x y) = V2 (x + 9 * fromIntegral (length s)) y
 
---selectedCloseObjectLink :: Configuration -> World -> Picture
---selectedCloseObjectLink cfig w = mempty
-
--- | Pictures of popup text for items close to your position.
-
 --closeObjectTexts :: Configuration -> World -> Picture
 --closeObjectTexts cfig w = pictures $
 --    renderListAt pushout (negate 20 * fromIntegral invPos) cfig (map colAndText $ _closeObjects w)

src/Dodge/Render/ShapePicture.hs

@@ -143,8 +143,8 @@ extraPics cfig u =
         <> foldMap drawBul (_bullets lw)
         <> foldMap drawBlip (_radarBlips lw)
         <> foldMap drawFlare (_flares lw)
-        <> foldMap (dbArg (drawBeam . _bmDraw)) (_positronBeams $ _beams lw)
-        <> foldMap (dbArg (drawBeam . _bmDraw)) (_electronBeams $ _beams lw)
+--        <> foldMap (dbArg (drawBeam . _bmDraw)) (_positronBeams $ _beams lw)
+--        <> foldMap (dbArg (drawBeam . _bmDraw)) (_electronBeams $ _beams lw)
         <> foldMap (dbArg (drawLightSource . _lsPict)) (_lightSources lw)
         <> testPic cfig w
         <> foldMap ppDraw (_pressPlates lw)

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