Cleanup

shader/cloud/basic.frag

@@ -18,18 +18,10 @@ void main()
     if (d > 1) {discard;}
     //fCol = vCol;
     fCol = vec4(vCol.xyz,vCol.w*(1-d));
-    //float rad = vCenterSize.w;
+    //float rad = vCenterSize.w*0.5;
-    float rad = vCenterSize.w*0.5;
+    float rad = vCenterSize.w;
     float h = (1-d) * rad;
     fPos = vec4(vPosID.xy, vPosID.z + h, vCol.w*(1-d));
-    float h1 = float (1 - 0.01*fPos.z);
+    vec3 fn1 = fPos.z*normalize(vec3(vCenterSize.xyz - fPos.xyz));
-    //vec3 fn1 = fPos.z*(1-d)*normalize(vec3(vCenterSize.xyz - fPos.xyz));
-    //vec3 fn1 = fPos.z*normalize(vec3(vCenterSize.xyz - fPos.xyz));
-    //vec3 fn1 = vec3(vCenterSize.xyz - fPos.xyz);
-    //vec3 fn1 = fPos.z*(1-d)*normalize(vec3(vCenterSize.xyz - (fPos.xyz + vec3(0,0,0.5*h))));
-    vec3 fn1 = fPos.z*normalize(vec3(vCenterSize.xyz - (fPos.xyz + vec3(0,0,0.5*h))));
-    //fNorm = vec4(0.5*fn1.xy,fn1.z, 0.5);
-    //fNorm = vec4(fn1.xyz, fCol.w);
     fNorm = vec4(fn1,fPos.w);
-    //fNorm = vec4(0,0,1, 1);
 }

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
+        -- we sum the positions weighted by alpha, and sum the alpha
-        -- 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
         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
+    let a'
+            | a - cdir > pi = cdir + 2 * pi
             | a - cdir < - pi = cdir - 2 * pi
             | otherwise = cdir
-    return $ winScale cfig
+    return $
-        $ setLayer FixedCoordLayer
+        winScale cfig $
-        $ uncurryV translate (worldPosToScreen campos p) 
+            setLayer FixedCoordLayer $
-        $ arcFull (a - rot) 10 white (a' - rot) 1 white (5 + dist mwp p * campos ^. camZoom) white
+                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
@@ -219,7 +215,6 @@ 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)
@@ -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
@@ -259,6 +246,7 @@ drawWallsNearYou w = fromMaybe mempty $ do
     f wl = color violet $ thickLine 3 [a, b]
       where
         (a, b) = _wlLine wl
+
 drawWallsNearCursor :: World -> Picture
 drawWallsNearCursor w =
     setLayer DebugLayer $ foldMap f $ wlsNearPoint (mouseWorldPos (_input w) (_camPos $ _cWorld w)) w
@@ -269,9 +257,10 @@ drawWallsNearCursor w =
 
 drawInspectWalls :: World -> Picture
 drawInspectWalls w =
-    setLayer DebugLayer (color orange $ line [a,b]) <>
+    setLayer DebugLayer (color orange $ line [a, b])
-    foldMap (drawInspectWall w) (
+        <> foldMap
-        filter (isJust . uncurry (intersectSegSeg a b) . _wlLine) $
+            (drawInspectWall w)
+            ( filter (isJust . uncurry (intersectSegSeg a b) . _wlLine) $
                 IM.elems $ w ^. cWorld . lWorld . walls
             )
   where
@@ -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
@@ -374,23 +352,12 @@ drawWallSearchRays w = foldMap (f . fst) $ allVisibleWalls w
 
 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)