Work on windows

shader/floor/arrayPos.frag

@@ -19,4 +19,5 @@ void main()
     vec4 bn = vec4(texture(normalSampler,vTexPos) - 0.5);
     vec3 nmap1 = vec3(rotateV2(rot,bn.xy), bn.z);
     normal = vec4(-nmap1 ,0);
+    //normal = vec4(0,0,-1 ,0);
 }

src/Dodge/Block.hs

@@ -1,4 +1,4 @@
-module Dodge.Block (destroyBlock) where
+module Dodge.Block (destroyBlock,unshadowBlock) where
 
 import ListHelp
 import Dodge.Zoning.Pathing

src/Dodge/Creature/Lamp.hs

@@ -7,10 +7,7 @@ import Dodge.Data.Creature
 import Dodge.Default
 import Geometry.Data
 
-colorLamp ::
+colorLamp :: Point3 -> Float -> Creature
-    Point3 -> -- color of lamp
-    Float -> -- height of lamp
-    Creature
 colorLamp col h =
     defaultInanimate
         { _crHP = HP 100

src/Dodge/LightSource.hs

@@ -22,7 +22,7 @@ lsColPosID :: Point3 -> Point3 -> Int -> LightSource
 lsColPosID col p i = lsColPos col p & lsID .~ i
 
 lsColPos :: Point3 -> Point3 -> LightSource
-lsColPos col pos = lsColPosRad col pos 450
+lsColPos col pos = lsColPosRad col pos 250
 
 lsPosCol :: Point3 -> Point3 -> LightSource
 lsPosCol pos col = lsColPos col pos

src/Dodge/Material/Color.hs

@@ -10,7 +10,7 @@ materialColor = \case
     Wood -> dark yellow
     Dirt -> dark $ dark orange
     Stone -> greyN 0.5
-    Glass -> aquamarine
+    Glass -> azure
     Metal -> orange
     Crystal -> green
     Flesh -> red

src/Dodge/Material/Damage.hs

@@ -23,7 +23,7 @@ damMatSideEffect dm = \case
     Metal -> damageMetal dm
     Flesh -> damageFlesh dm
     Dirt -> damageDirt dm
-    --    Glass -> damageGlass dm
+    Glass -> damageGlass dm
     Crystal -> \ecw -> set _1 0 . defDamageMaterial dm ecw
     _ -> defDamageMaterial dm
 
@@ -151,6 +151,40 @@ damageDirt dm _ w =
     so = DamageHitSound (w ^. cWorld . lWorld . lClock)
     outTo x t = x -.- squashNormalizeV t
 
+damageGlass :: Damage -> ECW -> World -> (Int,World)
+damageGlass dm ecw w = case dm of
+        Lasering _ _ t -> f 0 $ id
+        Piercing _ p t -> 
+            f dmam $ makeSpark NormalSpark (outTo p t) (rdir p t)
+--                . makeDustAt Stone 200 (addZ 20 (outTo p t))
+                 . randsound p [smallGlass1S, smallGlass2S, smallGlass3S, smallGlass4S]
+        Blunt _ p t -> f dmam $ -- makeDustAt Stone 200 (addZ 20 (outTo p t))
+                 randsound p [smallGlass1S, smallGlass2S, smallGlass3S, smallGlass4S]
+        Shattering _ p t -> f dmam $ makeDustAt Glass 200 (addZ 20 (outTo p t))
+                . randsound p [smallGlass1S, smallGlass2S, smallGlass3S, smallGlass4S]
+        Crushing{} -> f dmam  id
+        Explosive _ p -> f dmam  -- the sound comes from the explosion center, which is not correct...
+            $ randsound p [smallGlass1S, smallGlass2S, smallGlass3S, smallGlass4S]
+        Sparking{} -> f 0  id
+        Flaming{} -> f 0  id
+        Electrical{} -> f 0  id
+        Poison{} -> f 0  id
+        Enterrement{} -> f 0  id
+        Flashing{} -> f 0  id
+  where
+    f x g = (x, g w)
+    dmam = dm ^. dmAmount
+    rdir p t = argV $ reflectIn v t
+      where
+        v = case ecw of
+            Right wl -> uncurry (-) $ _wlLine wl
+            Left cr -> vNormal (p - cr ^. crPos . _xy)
+    randsound p xs =
+        let (x, g) = runState (takeOne xs) $ _randGen w
+         in soundStart so p x Nothing . set randGen g
+    so = DamageHitSound (w ^. cWorld . lWorld . lClock)
+    outTo x t = x -.- squashNormalizeV t
+
 --damageGlass :: Damage -> Float -> World -> (World,Int)
 --damageGlass dm dir w = w & case _dmType dm of
 --    LASERING    -> a 0 $ id

src/Dodge/Placement/Instance/Block.hs

@@ -14,7 +14,6 @@ decoratedBlock decf mat col h ps = PutBlock bl wl $ reverse ps
     bl =
         defaultBlock
             & blDraw .~ (decf <> colorSH col (upperBox Medium Typical h ps))
---                BlockDraws [BlockDrawColHeightPoss col h ps, BlockDrawBlSh decf]
             & blHeight .~ h
     wl =
         defaultWall

src/Dodge/Placement/Instance/LightSource.hs

@@ -197,4 +197,4 @@ spanLightY l x y z =
 --putColorLamp col = PutCrit (colorLamp col 90)
 
 putLamp :: PSType
-putLamp = PutCrit (lamp 90)
+putLamp = PutCrit (lamp 50)

src/Dodge/Placement/Instance/Wall.hs

@@ -49,7 +49,7 @@ Places an breakable window between two points.
 Width 8, also extends out from each point by 8.
  -}
 windowLine :: Point2 -> Point2 -> Placement
-windowLine a = sps0 . PutLineBlock defaultWindow 8 a
+windowLine a = sps0 . PutLineBlock defaultWindow 10 a
 
 {-
 Places an unbreakable window between two points.

src/Dodge/Render/ShapePicture.hs

@@ -86,7 +86,7 @@ barrelShape = noPic $ cylinderPoly Medium Important (map (addZ 20) ps) (map (add
 
 lampCrSPic :: Float -> SPic
 lampCrSPic h =
-    colorSH blue (upperBox Small Typical h $ rectWH 5 5)
+    colorSH blue (upperBox Small Undesired h $ rectWH 5 5)
         :!: setLayer BloomLayer (setDepth h . color white $ circleSolid 3)
 
 shiftDraw :: (a -> Point2) -> (a -> Float) -> (a -> a -> SPic) -> a -> SPic

src/Dodge/Room/Boss.hs

@@ -19,10 +19,7 @@ import RandomHelp
 import Control.Monad
 
 -- pathing needs to be done
-roomGlassOctogon ::
+roomGlassOctogon :: Float -> Room
-    -- | Size
-    Float ->
-    Room
 roomGlassOctogon x =
 --    createPathGrid $
         defaultRoom
@@ -48,7 +45,7 @@ roomGlassOctogon x =
             , _rmName = "glass8gon"
             }
   where
-    fx = 4 * x / 5
+    fx = 5 * x / 6
     lnks' = map (uncurry outLink) (init lnks) ++ [uncurry inLink $ last lnks]
     lnks =
         [ (V2 0 x, 0)

src/Dodge/Wall/Damage.hs

@@ -33,18 +33,32 @@ damageWall wlid dt w = fromMaybe (mempty,w) $ do
         MachinePart mcid -> (,) mempty 
             $ w' & cWorld . lWorld . machines . ix mcid . mcDamage .:~ dt
         BlockPart blid ->
-            w' & cWorld . lWorld . blocks . ix blid . blHP -~ dmam
+            w' & damageBlock (wl ^. wlMaterial) dmam blid -- cWorld . lWorld . blocks . ix blid . blHP -~ dmam
-                & maybeDestroyBlock blid
+--                & maybeDestroyBlock blid
         DoorPart drid _ ->
             w' & cWorld . lWorld . doors . ix drid . drHP -~ dmam
                 & maybeDestroyDoor drid
         _ -> (mempty, w')
 
 -- block destruction is convoluted...
-maybeDestroyBlock :: Int -> World -> (S.Set Int2, World)
+damageBlock :: Material -> Int -> Int -> World -> (S.Set Int2, World)
-maybeDestroyBlock blid w = case w ^? cWorld . lWorld . blocks . ix blid of
+damageBlock = \case
-    Just bl | _blHP bl < 1 -> destroyBlock bl w
+    Glass -> damageGlassBlock
-    _ -> (mempty, w)
+    _ -> maybeDestroyBlock
+
+damageGlassBlock :: Int -> Int -> World -> (S.Set Int2, World)
+damageGlassBlock x i w = fromMaybe (mempty,w) $ do
+    bl <- w ^? cWorld . lWorld . blocks . ix i
+    return $ case bl ^. blHP - x of
+        y | y > 0 -> (mempty, w
+            & flip (foldl' unshadowBlock) (_blShadows bl)
+            & cWorld . lWorld . blocks . ix i . blHP .~ 1)
+        _ -> destroyBlock bl w
+
+maybeDestroyBlock :: Int ->  Int -> World -> (S.Set Int2, World)
+maybeDestroyBlock x blid w = case w ^? cWorld . lWorld . blocks . ix blid of
+    Just bl | _blHP bl < x -> destroyBlock bl w
+    _ -> (mempty, w & cWorld . lWorld . blocks . ix blid . blHP -~ x)
 
 maybeDestroyDoor :: Int -> World -> (S.Set Int2, World)
 maybeDestroyDoor drid w = case w ^? cWorld . lWorld . doors . ix drid of

src/Render.hs

@@ -157,7 +157,6 @@ renderShadows isclouds cam cfig shadrendertype nWalls nSils nCaps positiontextur
     -- for each of the lights:
     -- 1. stencil out the shadows from this light's point of view
     -- 2. calculate lighting based on each fragment's position and normal
-    -- TODO stencil out square around light!
     glEnable GL_SCISSOR_TEST
     glDisable GL_CULL_FACE
     flip VFSM.mapM_ (VFSM.fromList lightPoints) $ \(V3 x y z, rad, V3 r g b) -> do
@@ -178,6 +177,7 @@ renderShadows isclouds cam cfig shadrendertype nWalls nSils nCaps positiontextur
         glStencilFunc GL_NOTEQUAL 128 255 
         glBindVertexArray $ pdata ^. dummyVAO
         --draw wall shadows
+        --these could possibly stencil out object shadows as well
         glUseProgram shadwall
         glDrawArrays GL_TRIANGLES 0 (nWalls * 18)
         case shadrendertype of
@@ -197,6 +197,8 @@ renderShadows isclouds cam cfig shadrendertype nWalls nSils nCaps positiontextur
         glColorMask GL_TRUE GL_TRUE GL_TRUE GL_FALSE
         glStencilFunc GL_EQUAL 0 255
         glUseProgram ltextShad
+        -- we could draw a specific quad based on the size of the light rather
+        -- than a full screen quad here
         glDrawArrays GL_TRIANGLES 0 6
     --cleanup: may not be necessary, depending on what comes after...
     glDisable GL_SCISSOR_TEST

src/Shape/Data.hs

@@ -31,6 +31,7 @@ data Importance = Essential
     | Typical
     | Unimportant
     | Superfluous
+    | Undesired
     deriving (Eq, Ord, Show, Read, Enum, Bounded) --Generic, Flat)
 
 data Surface = Surface