justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Add aggressive light culling

Browse Source
This commit is contained in:
justin
2022-06-17 18:24:24 +01:00
parent 55341f7caf
commit cbfb417d21
26 changed files with 114 additions and 47 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Base.hs
+6
View File
@@ -233,6 +233,12 @@ collidePointWalls p1 p2
where
findPoint (x,y) p = fromMaybe p $ intersectSegSeg p1 p x y
collidePointWallsFilter :: (Wall -> Bool) -> Point2 -> Point2 -> IM.IntMap Wall -> Point2
collidePointWallsFilter t p1 p2
= foldr findPoint p2 . fmap _wlLine . IM.filter t
where
findPoint (x,y) p = fromMaybe p $ intersectSegSeg p1 p x y
-- | Looks for first collision of a circle with walls.
-- If found, gives point and reflection velocity, reflection damped in normal.
-- note that the "intersection" point is the center of the circle flush against the wall
src/Dodge/Base/Window.hs
+1 -1
View File
@@ -48,7 +48,7 @@ halfWidth w = _windowX w / 2
halfHeight w = _windowY w / 2
-- | A box of the size of the screen in screen centered coordinates
screenBox :: Configuration -> [Point2]
screenBox w = rectNSEW hh (-hh) hw (-hw)
screenBox w = reverse $ rectNSWE hh (-hh) (-hw) hw
where
hw = halfWidth w
hh = halfHeight w
src/Dodge/CullBox.hs
+23
View File
@@ -0,0 +1,23 @@
module Dodge.CullBox
(cullBox
) where
import Dodge.Data
import Dodge.GameRoom
import Dodge.Base
import Dodge.Zone
import Geometry
import Dodge.Update.Camera
import Shape
import Data.Maybe (mapMaybe)
cullBox :: Configuration -> World -> [Point2]
--cullBox cfig w = farWallPoints cp w
cullBox cfig w' = let (n,s,e,w) = farWallDistDirection (_cameraCenter w') cfig w'
in map ((+.+ _cameraCenter w') . rotateV (_cameraRot w') ) $ rectNSWE n (negate s) (negate w) e
-- --mapMaybe (fmap (fst . _wlLine . snd) . f) $ screenPolygon cfig w
-- where
-- grs = filter (pointInOrOnPolygon cp . _grBound) (_gameRooms w)
-- cp = _cameraCenter w
-- f p = collidePointWallsWall cp p $ wallsAlongLine cp p w
--
src/Dodge/Debug.hs
+1 -1
View File
@@ -47,7 +47,7 @@ pjTimerF time i = props . ix i . pjUpdate .~ (\_ -> pjTimerF (time - 1) i)
drawDDA :: IM.IntMap IS.IntSet -> Picture
drawDDA = setLayer BloomLayer . color (withAlpha 0.5 green) . IM.foldlWithKey' f blank
where
f pic x' ys' = concatMapPic (\y -> polygon (rectNSEW (y+50) y (x+50) x)) ys `appendPic` pic
f pic x' ys' = concatMapPic (\y -> polygon (reverse $ rectNSWE (y+50) y x (x+50))) ys `appendPic` pic
where
x = 50 * fromIntegral x'
ys = map ((50 *) . fromIntegral) $ IS.toList ys'
src/Dodge/Default.hs
+2 -2
View File
@@ -209,8 +209,8 @@ defaultDrawButton col bt =
)
where
buttonGeometry
| _btState bt == BtOff = rectNSEW 10 (-1) width (-width)
| otherwise = rectNSEW 2 (-1) width (-width)
| _btState bt == BtOff = reverse $ rectNSWE 10 (-1) (-width) width
| otherwise = reverse $ rectNSWE 2 (-1) (-width) width
width = 8
defaultTerminal :: Terminal
defaultTerminal = Terminal
src/Dodge/Item/Equipment.hs
+1 -1
View File
@@ -215,7 +215,7 @@ effectOnOffHeld f f' = ItInvEffectID
jetPack :: Item
jetPack = defaultEquipment
{ _itEquipPict = \_ _ -> (,) emptySH $ setDepth 20
$ pictures [color yellow $ polygon $ rectNSEW 5 (-5) (-3) (-11) ]
$ pictures [color yellow $ polygon $ reverse $ rectNSWE 5 (-5) (-11) (-3) ]
, _itEffect = NoItEffect
, _itID = Nothing
} & itUse . eqEq . eqSite .~ GoesOnBack
src/Dodge/Item/Weapon/BulletGun/Clip.hs
+2 -1
View File
@@ -11,7 +11,8 @@ makeSingleClipAt p it = case it ^? itConsumption . laLoaded of
_ -> translateSH p $ upperPrismPoly 1 $ square 1.5
makeTinClipAt :: Float -> Point3 -> Item -> Shape
makeTinClipAt r p it = translateSH p . overPosSH (rotate3z r) $ upperPrismPoly 1 $ rectNSEW 0 (-y) (-2) 2
makeTinClipAt r p it = translateSH p . overPosSH (rotate3z r) $ upperPrismPoly 1 $ reverse
$ rectNSWE 0 (-y) (-2) 2
where
y = fromIntegral y' * 0.3
y' = fromMaybe 0 $ it ^? itConsumption . laLoaded
src/Dodge/Item/Weapon/BulletGuns.hs
+2 -2
View File
@@ -136,7 +136,7 @@ bangCone = defaultGun
,_muzPos = 15
}
, _dimSPic = const $ noPic $ colorSH cyan $ upperPrismPoly 3 (rectXH 5 2)
<> upperPrismPoly 6 (rectNSEW 4 (-4) 15 5)
<> upperPrismPoly 6 (reverse $ rectNSWE 4 (-4) 5 15)
}
}
& itType . iyBase .~ BANGCONE
@@ -163,7 +163,7 @@ blunderbuss = bangCone
,_muzPos = 30
}
, _dimSPic = const $ noPic $ colorSH cyan $ upperPrismPoly 3 (rectXH 20 2)
<> upperPrismPoly 6 (rectNSEW 4 (-4) 30 20)
<> upperPrismPoly 6 (reverse $ rectNSWE 4 (-4) 20 30)
}
}
& itConsumption . laMax .~ 25
src/Dodge/LevelGen/Switch.hs
+6 -4
View File
@@ -37,8 +37,9 @@ drawSwitch col1 col2 bt
| otherwise = flick (negate (pi/4))
where
flick a = ( mconcat
[ colorSH col1 . upperPrismPoly 20 $ rectNSEW (-2) (-5) 10 (-10)
, colorSH col2 . translateSH (V3 0 (-2) 20) . rotateSH a . upperPrismPoly 2 $ rectNSEW 10 0 2 (-2)
[ colorSH col1 . upperPrismPoly 20 $ reverse $ rectNSWE (-2) (-5) (-10) 10
, colorSH col2 . translateSH (V3 0 (-2) 20) . rotateSH a . upperPrismPoly 2 $ reverse
$ rectNSWE 10 0 (-2) 2
]
, mempty)
@@ -48,8 +49,9 @@ drawSwitchWire col1 col2 bt
| otherwise = flick (negate (pi/4))
where
flick a = ( mconcat
[ colorSH col1 . translateSHz 10 . upperPrismPoly 10 $ rectNSEW (-2) (-5) 10 (-10)
, colorSH col2 . translateSH (V3 0 (-2) 15) . rotateSH a . upperPrismPoly 2 $ rectNSEW 10 0 2 (-2)
[ colorSH col1 . translateSHz 10 . upperPrismPoly 10 $ reverse $ rectNSWE (-2) (-5) (-10) 10
, colorSH col2 . translateSH (V3 0 (-2) 15) . rotateSH a . upperPrismPoly 2 . reverse
$ rectNSWE 10 0 (-2) 2
]
, mempty)
src/Dodge/Placement/Instance/LightSource/Cover.hs
+7 -7
View File
@@ -53,10 +53,10 @@ drawLampCover h pr
| not (_prToggle pr) = mempty
| otherwise = ( translateSHz (h-2.5) . uncurryV translateSHf (_prPos pr)
$ rotateSH (_pjRot pr) $ mconcat
[ translateSHz 1 . upperPrismPoly 1 $ rectNSEW 3 2 3 (-1)
, translateSHz 1 . upperPrismPoly 1 $ rectNSEW 3 (-1) 3 2
, translateSHz 2 . upperPrismPoly 1 $ rectNSEW 3 2 3 (-1)
, translateSHz 2 . upperPrismPoly 1 $ rectNSEW 3 (-1) 3 2
[ translateSHz 1 . upperPrismPoly 1 . reverse $ rectNSWE 3 2 (-1) 3
, translateSHz 1 . upperPrismPoly 1 . reverse $ rectNSWE 3 (-1) 2 3
, translateSHz 2 . upperPrismPoly 1 . reverse $ rectNSWE 3 2 (-1) 3
, translateSHz 2 . upperPrismPoly 1 . reverse $ rectNSWE 3 (-1) 2 3
, upperPrismPoly 1 [V2 2 2,V2 (-1) 2,V2 2 (-1)]
]
, mempty
@@ -66,8 +66,8 @@ drawDoubleLampCover :: Float -> Prop -> SPic
drawDoubleLampCover h pr =
( translateSHz (h-2.5) . uncurryV translateSHf (_prPos pr)
$ rotateSH (_pjRot pr) $ mconcat
[ upperPrismPoly 5 $ rectNSEW 6 5 6 (-6)
, upperPrismPoly 5 $ rectNSEW (-5) (-6) 6 (-6)
[ upperPrismPoly 5 $ reverse $ rectNSWE 6 5 (-6) 6
, upperPrismPoly 5 $ reverse $ rectNSWE (-5) (-6) (-6) 6
, upperPrismPoly 1 [V2 0 (-1),V2 6 5,V2 (-6) 5]
, upperPrismPoly 1 [V2 0 1 ,V2 (-6) (-5),V2 6 (-5)]
]
@@ -79,7 +79,7 @@ drawVerticalLampCover h pr =
( translateSHz h . uncurryV translateSHf (_prPos pr)
$ rotateSHx (_pjRot pr) $ mconcat
[
translateSHz (-3) . upperPrismPoly 1 $ rectNSEW 2 (-2) 5 (-5)
translateSHz (-3) . upperPrismPoly 1 $ reverse $ rectNSWE 2 (-2) (-5) 5
]
, mempty
)
src/Dodge/Placement/TopDecoration.hs
+1 -1
View File
@@ -28,7 +28,7 @@ fourEmbossDecoration :: Float -> Float -> Float -> Color -> Color -> Shape
fourEmbossDecoration w h z _ c = colorSH c $ foldMap f [(w,h),(-w,h),(w,-h),(-w,-h)]
where
f (a,b) = translateSH (V3 (a/2) (b/2) z) embossing
embossing = upperPrismPolyHalf 10 $ rectNSEW (h/2) (-h/2) (w/2) (-w/2)
embossing = upperPrismPolyHalf 10 $ reverse $ rectNSWE (h/2) (-h/2) (-w/2) (w/2)
plusDecoration :: Float -> Float -> Float -> Color -> Color -> Shape
plusDecoration w h z _ c = colorSH c $ thinHighBar z (V2 w 0) (V2 (-w) 0)
src/Dodge/Render.hs
+1 -1
View File
@@ -39,7 +39,7 @@ doDrawing pdata u = do
wins@(V2 winx winy) = V2 (_windowX cfig) (_windowY cfig)
resFact = resFactorNum $ cfig ^. graphics_resolution_factor
(wallPointsCol,windowPoints,wallSPics) = wallsToDrawStreams cfig w
lightPoints = lightsForGloom w
lightPoints = lightsForGloom cfig w
viewFroms@(V2 vfx vfy) = _cameraViewFrom w
viewFrom3d = Vector3 vfx vfy 20
shadV = _pictureShaders pdata
src/Dodge/Render/HUD.hs
+1 -1
View File
@@ -317,7 +317,7 @@ displayListEndCoords cfig ss = map (doWindowScale cfig) $ zipWith h ss $ map f [
mapOverlay :: Configuration -> World -> [Picture]
mapOverlay cfig w = (color (withAlpha 0.5 black) . polygon $ rectNSEW 1 (-1) (-1) 1) :
mapOverlay cfig w = (color (withAlpha 0.5 black) . polygon $ reverse $ rectNSWE 1 (-1) 1 (-1)) :
(mapMaybe (mapWall cfig w) . IM.elems $ _walls w)
mapWall :: Configuration -> World -> Wall -> Maybe Picture
src/Dodge/Render/Lights.hs
+9 -2
View File
@@ -2,17 +2,24 @@ module Dodge.Render.Lights
( lightsForGloom
) where
import Dodge.Data
import Dodge.CullBox
import Geometry
import Data.Maybe
import qualified Data.IntMap.Lazy as IM
lightsForGloom :: World -> [(Point3,Float,Point3)]
lightsForGloom w = mapMaybe getLS (IM.elems $ _lightSources w) ++ mapMaybe getTLS (_tempLightSources w)
lightsForGloom :: Configuration -> World -> [(Point3,Float,Point3)]
lightsForGloom cfig w = mapMaybe getLS (IM.elems $ _lightSources w)
++ mapMaybe getTLS (_tempLightSources w)
where
getLS = getlsparam . _lsParam
getTLS = getlsparam . _tlsParam
cbox = cullBox cfig w
getlsparam ls
| not (pointInPolygon lpos cbox) = Nothing
| dist (_cameraCenter w) (fst2 $ _lsPos ls) > _viewDistance w + _lsRad ls = Nothing
| otherwise = Just ( _lsPos ls, _lsRad ls^(2::Int) , _lsCol ls)
where
lpos = xyV3 $ _lsPos ls
rad = _lsRad ls
fst2 (V3 a b _) = V2 a b
src/Dodge/Render/ShapePicture.hs
+6 -3
View File
@@ -2,6 +2,7 @@ module Dodge.Render.ShapePicture
( worldSPic
) where
import Dodge.ShortShow
import Dodge.CullBox
import Dodge.Config.Data
import Dodge.Render.InfoBox
import Dodge.Debug.Picture
@@ -53,7 +54,7 @@ extraPics cfig w = pictures (_decorations w)
<> concatMapPic (dbArg _bmDraw) (_positronBeams $ _beams w)
<> concatMapPic (dbArg _bmDraw) (_electronBeams $ _beams w)
<> concatMapPic (dbArg _lsPict) (_lightSources w)
<> testPic w
<> testPic cfig w
<> _debugPicture w
<> concatMapPic clDraw (_clouds w )
<> concatMapPic ppDraw (_pressPlates w )
@@ -65,8 +66,10 @@ extraPics cfig w = pictures (_decorations w)
<> drawPathing cfig w
<> drawCrInfo cfig w
testPic :: World -> Picture
testPic _ = mempty
testPic :: Configuration -> World -> Picture
testPic cfig w = setLayer DebugLayer $ color green $ line $ (x:xs) ++ [x]
where
(x:xs) = cullBox cfig w
clDraw :: Cloud -> Picture
clDraw c = translate3 (_clPos c) (_clPict c c)
src/Dodge/Room/Airlock.hs
+1 -1
View File
@@ -78,7 +78,7 @@ airlockZ = defaultRoom
[pContID (PS (V2 90 115) pi) (PutButton $ makeSwitch col red id id)
$ \btid -> jspsJ (V2 0 60) 0 (PutDoor col (cond btid) outDoorps)
$ sPS (V2 180 60) 0 (PutDoor col (cond btid) inDoorps)
, sps0 $ PutWall (rectNSEW 70 50 120 60) defaultWall
, sps0 $ PutWall (reverse $ rectNSWE 70 50 60 120) defaultWall
, lighting
]
, _rmBound =
src/Dodge/Room/Corridor.hs
+2 -2
View File
@@ -45,8 +45,8 @@ keyholeCorridor :: Room
keyholeCorridor = corridor
{ _rmPath = []
, _rmPmnts =
[ midWall $ rectNSEW top bot 0 15
, midWall $ rectNSEW top bot 25 40]
[ midWall $ reverse $ rectNSWE top bot 15 0
, midWall $ reverse $ rectNSWE top bot 40 25]
}
where
top = 65
src/Dodge/Room/LasTurret.hs
+7 -7
View File
@@ -39,7 +39,7 @@ cenLasTur = roomNgon 8 200 & rmPmnts .~
, mntLightLnkCond $ rprBool $ const . isInLnk
]
where
covershape = rectNSEW 10 (-10) 20 (-20)
covershape = reverse $ rectNSWE 10 (-10) (-20) 20
lightSensInsideDoor :: Int -> Room -> Room
lightSensInsideDoor outplid rm = rm
@@ -68,7 +68,7 @@ lightSensByDoor outplid rm = rm
]
& rmOutPmnt .~ [OutPlacement (lasSensLightAboveDoor 20 (atFstLnkOutShiftBy sensorshift)) outplid]
where
covershape = rectNSEW 10 (-10) 20 (-20)
covershape = reverse $ rectNSWE 10 (-10) (-20) 20
sensorshift (p,a) = (p +.+ rotateV a (V2 60 (-20)), a)
keyCardRoomRunPast :: RandomGen g => Int -> Int -> State g (MetaTree Room String)
@@ -133,12 +133,12 @@ lasCenSensEdge n = do
lasTunnel :: RandomGen g => Float -> State g Room
lasTunnel y = do
extraPlmnts <- takeOne
[ [ midWall (rectNSEW 115 90 0 60)
, midWall (rectNSEW 65 40 (-40) 25)
[ [ midWall (reverse $ rectNSWE 115 90 0 60)
, midWall (reverse $ rectNSWE 65 40 (-40) 25)
]
, [ midWall (rectNSEW 125 100 0 25)
, midWall (rectNSEW 80 40 (-40) 0)
, midWall (rectNSEW 80 40 25 60)
, [ midWall (reverse $ rectNSWE 125 100 0 25)
, midWall (reverse $ rectNSWE 80 40 (-40) 0)
, midWall (reverse $ rectNSWE 80 40 25 60)
]
]
return defaultRoom
src/Dodge/Room/LongDoor.hs
+1 -1
View File
@@ -100,7 +100,7 @@ addButtonSlowDoor x h rm = do
["WARNING:"
,"LARGE BIOMASS DETECTED"
]
openDoorBound = rectNSEW (h + 5) (h - 5) (-x/2) (3*x/2)
openDoorBound = reverse $ rectNSWE (h + 5) (h - 5) (3*x/2) (-x/2)
belowH y = (sndV2 . fst) y < h - 40
aboveH y = (sndV2 . fst) y > h + 40
amountedlight dr xoff = Just . moveLSThen (getdoorpos (fromJust $ _plMID dr))
src/Dodge/Room/Procedural.hs
+4 -4
View File
@@ -249,10 +249,10 @@ centerVaultRoom w h d = return $ defaultRoom
, inLink (V2 0 (-h)) pi ]
, _rmPath = []
, _rmPmnts =
[sps0 $ PutWall (rectNSEW d (d - 30) d (d - 30)) defaultWall
,sps0 $ PutWall (rectNSEW d (d - 30) (-d) (30 - d)) defaultWall
,sps0 $ PutWall (rectNSEW (-d) (30 - d) d (d - 30)) defaultWall
,sps0 $ PutWall (rectNSEW (-d) (30 - d) (-d) (30 - d)) defaultWall
[sps0 $ PutWall (reverse $ rectNSWE d (d - 30) (d - 30) d ) defaultWall
,sps0 $ PutWall (reverse $ rectNSWE d (d - 30) (30 - d) (-d)) defaultWall
,sps0 $ PutWall (reverse $ rectNSWE (-d) (30 - d) (d - 30) d ) defaultWall
,sps0 $ PutWall (reverse $ rectNSWE (-d) (30 - d) (30 - d) (-d)) defaultWall
]
++ map (\a -> mntLS vShape (rotateV a $ V2 0 d) (rotate3z a $ V3 0 (d+30) 70))
[0,0.5*pi,pi,1.5*pi]
src/Dodge/Room/Teleport.hs
+1 -1
View File
@@ -35,7 +35,7 @@ telRoomLev _ = do
, _ppID = 0
, _ppText = "NEW LEVEL"
}
ppFootprint = rectNSEW 20 (-20) 20 (-20)
ppFootprint = reverse $ rectNSWE 20 (-20) (-20) 20
levelReset pp w
| dist (_crPos $ you w) (_ppPos pp) < 20 = makeExplosionAt (_ppPos pp) w
| otherwise = w
src/Dodge/Update/Camera.hs
+12 -1
View File
@@ -4,6 +4,7 @@ and the position that the character sees from: '_cameraViewFrom'. -}
module Dodge.Update.Camera
( updateCamera
, farWallPoints
, farWallDistDirection
) where
import Dodge.Data
import Dodge.Base
@@ -202,7 +203,17 @@ farWallDist p cfig w = (winFac /)
grs = filter (pointInOrOnPolygon p . _grBound) (_gameRooms w)
wos = wallsOnScreen cfig w
distFromEqmnt = foldr max 1 $ IM.mapMaybe (_eqViewDist . _eqEq. _itUse) $ getCrEquipment $ you w
farWallDistDirection :: Point2 -> Configuration -> World -> (Float,Float,Float,Float)
--farWallDist p cfig w = (winFac /) . min maxViewDistance $ ssfold (> maxViewDistance) findMax 1 vps
farWallDistDirection p cfig w = foldr m (0,0,0,0) $ map f vps
where
f q = g $ rotateV (negate $ _cameraRot w) $ collidePointWallsFilter wlIsOpaque p q wos -.- p
g (V2 x y) = (y, negate y, x, negate x)
m (a,b,c,d) (x,y,z,w') = (max a x, max b y, max c z, max d w')
vps = concatMap _grViewpoints grs ++ extendedViewPoints p grs
grs = filter (pointInOrOnPolygon p . _grBound) (_gameRooms w)
wos = wallsOnScreen cfig w
extendedViewPoints :: Point2 -> [GameRoom] -> [Point2]
extendedViewPoints p grs = map extend
src/Geometry/Polygon.hs
+2 -2
View File
@@ -12,8 +12,8 @@ import qualified Control.Foldl as L
rectNESW :: Float -> Float -> Float -> Float -> [Point2]
rectNESW !a !b !c !d = [V2 b a,V2 b c,V2 d c,V2 d a]
-- | Draw a clockwise rectangle based on maximal N S E W values.
rectNSEW :: Float -> Float -> Float -> Float -> [Point2]
rectNSEW !n !s !e !w = rectNESW n e s w
--rectNSEW :: Float -> Float -> Float -> Float -> [Point2]
--rectNSEW !n !s !e !w = rectNESW n e s w
-- | Draw an anticlockwise rectangle based on maximal N S W E values.
rectNSWE :: Float -> Float -> Float -> Float -> [Point2]
rectNSWE !n !s !w !e = [V2 w n, V2 w s, V2 e s, V2 e n]
src/Geometry/Vector.hs
+4
View File
@@ -175,3 +175,7 @@ yV2 (V2 _ y) = y
xyzV4 :: V4 a -> V3 a
{-# INLINE xyzV4 #-}
xyzV4 (V4 x y z _) = V3 x y z
xyV3 :: V3 a -> V2 a
{-# INLINE xyV3 #-}
xyV3 (V3 x y _) = V2 x y
src/Picture.hs
+1
View File
@@ -55,6 +55,7 @@ polygonWire :: [Point2] -> Picture
{-# INLINE polygonWire #-}
polygonWire ps = line (ps ++ [head ps])
-- need to check the winding!
polygon :: [Point2] -> Picture
{-# INLINE polygon #-}
polygon = map f . polyToTris