Cleanup

src/Dodge/Render/ShapePicture.hs

@@ -2,10 +2,6 @@ module Dodge.Render.ShapePicture (
     worldSPic,
 ) where
 
-import Picture.Arc
-import Dodge.Viewpoints
-import Dodge.Render.Label
-import Dodge.WorldEvent.ThingsHit
 import Control.Lens
 import Control.Monad (guard)
 import Data.Foldable
@@ -27,10 +23,12 @@ import Dodge.Path
 import Dodge.Picture.SizeInvariant
 import Dodge.RadarBlip
 import Dodge.Render.InfoBox
+import Dodge.Render.Label
 import Dodge.Render.List
 import Dodge.ShortShow
 import Dodge.SoundLogic.LoadSound
---import Dodge.Update.Camera
+import Dodge.Viewpoints
+import Dodge.WorldEvent.ThingsHit
 import Dodge.Zoning
 import Dodge.Zoning.Base
 import Geometry
@@ -72,13 +70,15 @@ aimDelaySweep cfig w = fromMaybe mempty $ do
 drawSweep :: Creature -> Configuration -> World -> Picture
 drawSweep cr cfig w = fromMaybe mempty $ do
     a <- safeArgV (mwp -.- p)
-    let a' | a - cdir > pi = cdir + 2* pi
-           | a - cdir < - pi = cdir - 2* pi
-           | otherwise = cdir
-    return $ winScale cfig
-        $ setLayer FixedCoordLayer
-        $ uncurryV translate (worldPosToScreen campos p) 
-        $ arcFull (a - rot) 10 white (a' - rot) 1 white (5 + dist mwp p * campos ^. camZoom) white
+    let a'
+            | a - cdir > pi = cdir + 2 * pi
+            | a - cdir < - pi = cdir - 2 * pi
+            | otherwise = cdir
+    return $
+        winScale cfig $
+            setLayer FixedCoordLayer $
+                uncurryV translate (worldPosToScreen campos p) $
+                    arcFull (a - rot) 10 white (a' - rot) 1 white (5 + dist mwp p * campos ^. camZoom) white
   where
     cdir = _crDir cr
     rot = campos ^. camRot
@@ -119,8 +119,6 @@ lampCrPic h =
   where
     f pos = Verx (pos -.-.- V3 2.5 2.5 0) blue [] BottomLayer polyNum
 
---DrawnCreature f -> f cr
---
 picAtCrPosNoRot1 :: Picture -> Creature -> SPic
 --{-# INLINE picAtCrPos #-}
 picAtCrPosNoRot1 thePic cr = (,) mempty $ uncurryV translate (_crPos cr) thePic
@@ -154,7 +152,6 @@ extraPics cfig w =
         <> concatMapPic drawShockwave (_shockwaves lw)
         <> concatMapPic drawLaser (_lasersToDraw lw)
         <> concatMapPic drawTeslaArc (_teslaArcs lw)
-        --    <> concatMapPic drawParticle (_particles    w)
         <> concatMapPic drawRadarSweep (_radarSweeps lw)
         <> concatMapPic drawFlame (_flames lw)
         <> concatMapPic drawEnergyBall (_energyBalls lw)
@@ -166,7 +163,6 @@ extraPics cfig w =
         <> concatMapPic (dbArg (drawBeam . _bmDraw)) (_electronBeams $ _beams lw)
         <> concatMapPic (dbArg (drawLightSource . _lsPict)) (_lightSources lw)
         <> testPic cfig w
-        <> concatMapPic clDraw (_clouds lw)
         <> concatMapPic ppDraw (_pressPlates lw)
         <> viewClipBounds cfig w
         <> debugDraw cfig w
@@ -216,13 +212,12 @@ debugDraw' cfig w bl = case bl of
 
 drawCollisionTest :: Configuration -> World -> Picture
 drawCollisionTest cfig w =
-    setLayer DebugLayer (color orange $ line [a,b])
-    <> foldMap (drawCross . fst) (crHit a b w) 
-    <> foldMap (drawCross . _crPos) (crsNearSeg a b w) 
---    <> foldMap (drawZoneCol green crZoneSize) (zoneOfSeg' crZoneSize a b)
-    <> foldMap (drawZoneCol green crZoneSize . zoneOfPoint crZoneSize) (xIntercepts crZoneSize a b)
-    <> foldMap (drawZoneCol yellow crZoneSize . zoneOfPoint crZoneSize) (yIntercepts' crZoneSize a b)
-    <> foldMap (drawLabCrossCol cfig cam blue) (xIntercepts crZoneSize a b)
+    setLayer DebugLayer (color orange $ line [a, b])
+        <> foldMap (drawCross . fst) (crHit a b w)
+        <> foldMap (drawCross . _crPos) (crsNearSeg a b w)
+        <> foldMap (drawZoneCol green crZoneSize . zoneOfPoint crZoneSize) (xIntercepts crZoneSize a b)
+        <> foldMap (drawZoneCol yellow crZoneSize . zoneOfPoint crZoneSize) (yIntercepts' crZoneSize a b)
+        <> foldMap (drawLabCrossCol cfig cam blue) (xIntercepts crZoneSize a b)
   where
     (a, b) = _lrLine (_input w)
     cam = w ^. cWorld . camPos
@@ -243,14 +238,6 @@ drawPathBetween w =
     sp = _lSelect (_input w)
     ep = _rSelect (_input w)
 
---drawNodesNearSelect :: World -> Picture
---drawNodesNearSelect w =
---    setLayer DebugLayer $
---        runIdentity (S.foldMap_ (drawZoneCol orange pnZoneSize) (zoneAroundPoint pnZoneSize sp))
---            <> color green (drawCross sp)
---  where
---    sp = _lSelect w
-
 drawWallsNearYou :: World -> Picture
 drawWallsNearYou w = fromMaybe mempty $ do
     p <- w ^? cWorld . lWorld . creatures . ix 0 . crPos
@@ -258,22 +245,24 @@ drawWallsNearYou w = fromMaybe mempty $ do
   where
     f wl = color violet $ thickLine 3 [a, b]
       where
-        (a,b) = _wlLine wl
+        (a, b) = _wlLine wl
+
 drawWallsNearCursor :: World -> Picture
-drawWallsNearCursor w = 
+drawWallsNearCursor w =
     setLayer DebugLayer $ foldMap f $ wlsNearPoint (mouseWorldPos (_input w) (_camPos $ _cWorld w)) w
   where
     f wl = color rose $ thickLine 3 [a, b]
       where
-        (a,b) = _wlLine wl
+        (a, b) = _wlLine wl
 
 drawInspectWalls :: World -> Picture
 drawInspectWalls w =
-    setLayer DebugLayer (color orange $ line [a,b]) <>
-    foldMap (drawInspectWall w) (
-        filter (isJust . uncurry (intersectSegSeg a b) . _wlLine) $
-            IM.elems $ w ^. cWorld . lWorld . walls
-    )
+    setLayer DebugLayer (color orange $ line [a, b])
+        <> foldMap
+            (drawInspectWall w)
+            ( filter (isJust . uncurry (intersectSegSeg a b) . _wlLine) $
+                IM.elems $ w ^. cWorld . lWorld . walls
+            )
   where
     (a, b) = _lLine (_input w)
 
@@ -323,7 +312,6 @@ drawFarWallDetect w =
                     ]
             )
         $ getViewpoints p (_cWorld w)
-        -- $ runIdentity $ S.toList_ $ streamViewpoints p w
   where
     p = w ^. cWorld . camPos . camViewFrom
 
@@ -337,22 +325,12 @@ drawZoneNearPointCursor w =
 drawDDATest :: World -> Picture
 drawDDATest w =
     foldMap (drawZoneCol orange 50) ps
-        --    runIdentity (S.foldMap_ (drawZoneCol orange 50) ps)
-        --        <> runIdentity (S.foldMap_ (drawZoneCol green 50) ps')
-        --        <> runIdentity (S.foldMap_ drawCross qs)
-        --        <> color blue (runIdentity (S.foldMap_ drawCross qs'))
         <> setLayer DebugLayer (color yellow (line [cvf, mwp]))
   where
     cvf = w ^. cWorld . camPos . camViewFrom
     mwp = mouseWorldPos (w ^. input) (w ^. cWorld . camPos)
-    --ps = ddaStreamX 50 cvf mwp
     ps = zoneOfSeg 50 cvf mwp
 
---ps' = ddaStreamY 50 (_cameraViewFrom (_cWorld w)) (mouseWorldPos w)
---qs = xIntercepts 50 (_cameraViewFrom (_cWorld w)) (mouseWorldPos w)
---qs' = yIntercepts 50 (_cameraViewFrom (_cWorld w)) (mouseWorldPos w)
-
-
 drawZoneCol :: Color -> Float -> V2 Int -> Picture
 drawZoneCol col s (V2 x y) = setLayer DebugLayer . color col $ thickLine 2 (p : ps ++ [p])
   where
@@ -370,27 +348,16 @@ drawWallSearchRays w = foldMap (f . fst) $ allVisibleWalls w
         setLayer DebugLayer $
             color yellow $
                 uncurryV translate p (circle 5)
-                    <> line [w ^. cWorld . camPos . camViewFrom , p]
+                    <> line [w ^. cWorld . camPos . camViewFrom, p]
 
 testPic :: Configuration -> World -> Picture
 testPic _ _ = mempty
---testPic cfig _ = setLayer FixedCoordLayer $ listPicturesAt 100 100 cfig $ map centerText
---    ["A"
---    ,"AA"
---    ,"AAA"
---    ,"AAAA"
---    ,"AAAAA"
---    ,"AAAAAA"
---    ]
 
 drawBoundingBox :: World -> Picture
 drawBoundingBox w = setLayer DebugLayer $ color green $ line $ (x : xs) ++ [x]
   where
     (x : xs) = w ^. cWorld . camPos . camBoundBox
 
-clDraw :: Cloud -> Picture
-clDraw c = translate3 (_clPos c) (drawCloud (_clPict c) c)
-
 ppDraw :: PressPlate -> Picture
 ppDraw c = uncurryV translate (_ppPos c) $ rotate (_ppRot c) (_ppPict c)
 
@@ -424,7 +391,7 @@ soundPic cfig w s = fixedSizePicClampArrow 50 50 thePic p cfig (w ^. cWorld)
 
 drawMousePosition :: Configuration -> World -> Picture
 drawMousePosition cfig w =
-    setLayer FixedCoordLayer 
+    setLayer FixedCoordLayer
         . winScale cfig
         . uncurryV translate p
         . scale 0.1 0.1