Work on windows

This commit is contained in:
2025-11-23 19:08:22 +00:00
parent 581d832569
commit 92e4552f66
14 changed files with 69 additions and 24 deletions
+1 -1
View File
@@ -1,4 +1,4 @@
module Dodge.Block (destroyBlock) where
module Dodge.Block (destroyBlock,unshadowBlock) where
import ListHelp
import Dodge.Zoning.Pathing
+1 -4
View File
@@ -7,10 +7,7 @@ import Dodge.Data.Creature
import Dodge.Default
import Geometry.Data
colorLamp ::
Point3 -> -- color of lamp
Float -> -- height of lamp
Creature
colorLamp :: Point3 -> Float -> Creature
colorLamp col h =
defaultInanimate
{ _crHP = HP 100
+1 -1
View File
@@ -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
+1 -1
View File
@@ -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
+35 -1
View File
@@ -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
-1
View File
@@ -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
+1 -1
View File
@@ -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)
+1 -1
View File
@@ -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.
+1 -1
View File
@@ -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
+2 -5
View File
@@ -19,10 +19,7 @@ import RandomHelp
import Control.Monad
-- pathing needs to be done
roomGlassOctogon ::
-- | Size
Float ->
Room
roomGlassOctogon :: 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)
+20 -6
View File
@@ -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
& maybeDestroyBlock blid
w' & damageBlock (wl ^. wlMaterial) dmam blid -- cWorld . lWorld . blocks . ix blid . blHP -~ dmam
-- & 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)
maybeDestroyBlock blid w = case w ^? cWorld . lWorld . blocks . ix blid of
Just bl | _blHP bl < 1 -> destroyBlock bl w
_ -> (mempty, w)
damageBlock :: Material -> Int -> Int -> World -> (S.Set Int2, World)
damageBlock = \case
Glass -> damageGlassBlock
_ -> 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
+3 -1
View File
@@ -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
+1
View File
@@ -31,6 +31,7 @@ data Importance = Essential
| Typical
| Unimportant
| Superfluous
| Undesired
deriving (Eq, Ord, Show, Read, Enum, Bounded) --Generic, Flat)
data Surface = Surface