Cleanup

2023-03-21 16:04:56 +00:00
parent d5fbc06332
commit 9570becd1b
6 changed files with 36 additions and 103 deletions
@@ -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*(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);
+    vec3 fn1 = fPos.z*normalize(vec3(vCenterSize.xyz - fPos.xyz));
    fNorm = vec4(fn1,fPos.w);
-    //fNorm = vec4(0,0,1, 1);
 }
@@ -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
-
@@ -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
@@ -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

@@ -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
@@ -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