Cleanup

src/Dodge/Cloud/Draw.hs

@@ -1,18 +0,0 @@
-module Dodge.Cloud.Draw
-    where
-import Dodge.Data.Cloud
-import Picture
-
-drawCloud :: CloudDraw -> Cloud -> Picture
-drawCloud cd = case cd of
-    CloudColor radmult fadet col -> drawCloudWith radmult fadet col
---    DrawGasCloud col -> const . setLayer MidLayer . setDepth 30 $ color (withAlpha 0.05 col) 
---                                          $ circleSolid 20
-
-drawCloudWith :: Float -> Float -> Color -> Cloud -> Picture
-drawCloudWith radMult fadet col cl = setLayer MidLayer 
-    . setDepth 25
-    $ circleSolidCol (withAlpha 0 col) (withAlpha a col) (radMult * _clRad cl)
-  where 
-    a = min 1 $ fromIntegral (_clTimer cl) / fadet
-

src/Dodge/Draw.hs

@@ -7,7 +7,6 @@ module Dodge.Draw (
     module Dodge.Item.Draw,
     module Dodge.Bullet.Draw,
     module Dodge.Button.Draw,
-    module Dodge.Cloud.Draw,
     module Dodge.EnergyBall.Draw,
     module Dodge.Flame.Draw,
     module Dodge.Laser.Draw,
@@ -29,7 +28,6 @@ import Dodge.Item.Draw
 import Dodge.Block.Draw
 import Dodge.Bullet.Draw
 import Dodge.Button.Draw
-import Dodge.Cloud.Draw
 import Dodge.EnergyBall.Draw
 import Dodge.Flame.Draw
 import Dodge.Laser.Draw

src/Dodge/Event/Test.hs

@@ -11,7 +11,7 @@ testEvent :: World -> World
 testEvent w = w
         & cWorld . lWorld . worldEvents .~ SoundStart BackgroundSound (V2 0 0) foamSprayFadeOutS Nothing :
         --[MakeStartCloudAt (V3 (cx + x) (cy + y) 5) | x <- [-5, -4 .. 5], y <- [-5, -4 .. 5]]
-        [MakeStartCloudAt (V3 (cx + x) (cy + y) 5) | x <- [0], y <- [0]]
+        [MakeStartCloudAt (V3 (cx + x) (cy + y) 20) | x <- [0], y <- [0]]
   where
     V2 cx cy = w ^?! cWorld . lWorld . creatures . ix 0 . crPos
 

src/Dodge/Render.hs

@@ -282,16 +282,10 @@ doDrawing' win pdata u = do
             2
             ptr
         glEnable GL_BLEND
-        --glDisable GL_BLEND
-        -- the idea is to (roughly) get the average position
-        --glBlendFunci 1 GL_ONE_MINUS_DST_ALPHA GL_DST_ALPHA
-        -- or, if we order the clouds, just get the top pos
-        --glBlendFunci 1 GL_ONE GL_ZERO
+        -- we sum the positions weighted by alpha, and sum the alpha
         glBlendFuncSeparatei 1 GL_SRC_ALPHA GL_ONE GL_ONE GL_ONE
-        -- and to sum the normals (based on the alpha)
+        -- and sum the normals weighted by alpha
         glBlendFunci 2 GL_SRC_ALPHA GL_ONE
-        -- just get the top normal
-        -- glBlendFunci 2 GL_ONE GL_ZERO
         glUseProgram (pdata ^. cloudShader . shaderUINT)
         glBindVertexArray $ pdata ^. cloudShader . shaderVAO . vaoName
         glDrawElements

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