From cbfb417d21e8fc0a12e4e6f464a09b6027d97b42 Mon Sep 17 00:00:00 2001 From: justin Date: Fri, 17 Jun 2022 18:24:24 +0100 Subject: [PATCH] Add aggressive light culling --- appDodge/Main.hs | 11 ++++++++- src/Dodge/Base.hs | 6 +++++ src/Dodge/Base/Window.hs | 2 +- src/Dodge/CullBox.hs | 23 +++++++++++++++++++ src/Dodge/Debug.hs | 2 +- src/Dodge/Default.hs | 4 ++-- src/Dodge/Item/Equipment.hs | 2 +- src/Dodge/Item/Weapon/BulletGun/Clip.hs | 3 ++- src/Dodge/Item/Weapon/BulletGuns.hs | 4 ++-- src/Dodge/LevelGen/Switch.hs | 10 ++++---- .../Placement/Instance/LightSource/Cover.hs | 14 +++++------ src/Dodge/Placement/TopDecoration.hs | 2 +- src/Dodge/Render.hs | 2 +- src/Dodge/Render/HUD.hs | 2 +- src/Dodge/Render/Lights.hs | 11 +++++++-- src/Dodge/Render/ShapePicture.hs | 9 +++++--- src/Dodge/Room/Airlock.hs | 2 +- src/Dodge/Room/Corridor.hs | 4 ++-- src/Dodge/Room/LasTurret.hs | 14 +++++------ src/Dodge/Room/LongDoor.hs | 2 +- src/Dodge/Room/Procedural.hs | 8 +++---- src/Dodge/Room/Teleport.hs | 2 +- src/Dodge/Update/Camera.hs | 13 ++++++++++- src/Geometry/Polygon.hs | 4 ++-- src/Geometry/Vector.hs | 4 ++++ src/Picture.hs | 1 + 26 files changed, 114 insertions(+), 47 deletions(-) create mode 100644 src/Dodge/CullBox.hs diff --git a/appDodge/Main.hs b/appDodge/Main.hs index 3fbb7c0b1..4b0df7a2c 100644 --- a/appDodge/Main.hs +++ b/appDodge/Main.hs @@ -94,7 +94,7 @@ doSideEffects u = do (_pictureShaders $ _renderData preData) (setDepth (-1) . translate (-0.5) (-0.8) . scale 0.0005 0.0005 - . text $ "ms/frame " ++ show (endTicks - lastFrameTicks) + $ fpsText (endTicks - lastFrameTicks) ) return $ u' & preloadData . frameTimer .~ endTicks @@ -102,6 +102,15 @@ doSideEffects u = do & uvWorld . toPlaySounds .~ M.empty & uvWorld . sideEffects .~ return +fpsText :: (Show a, Ord a, Num a) => a -> Picture +fpsText x = color col $ text $ "ms/frame " ++ show x + where + col | x < 22 = blue + | x < 30 = green + | x < 40 = yellow + | x < 50 = orange + | otherwise = red + doPreload :: IO PreloadData doPreload = do rData <- preloadRender diff --git a/src/Dodge/Base.hs b/src/Dodge/Base.hs index 6e059d71a..57c51ae42 100644 --- a/src/Dodge/Base.hs +++ b/src/Dodge/Base.hs @@ -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 diff --git a/src/Dodge/Base/Window.hs b/src/Dodge/Base/Window.hs index 84ebb375e..7488ec25e 100644 --- a/src/Dodge/Base/Window.hs +++ b/src/Dodge/Base/Window.hs @@ -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 diff --git a/src/Dodge/CullBox.hs b/src/Dodge/CullBox.hs new file mode 100644 index 000000000..3418dcfbf --- /dev/null +++ b/src/Dodge/CullBox.hs @@ -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 +-- diff --git a/src/Dodge/Debug.hs b/src/Dodge/Debug.hs index 98bae2fc7..20e60d8ec 100644 --- a/src/Dodge/Debug.hs +++ b/src/Dodge/Debug.hs @@ -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' diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index 916a32f82..8b3bb4965 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -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 diff --git a/src/Dodge/Item/Equipment.hs b/src/Dodge/Item/Equipment.hs index d6fbfffe5..2e79ac1f3 100644 --- a/src/Dodge/Item/Equipment.hs +++ b/src/Dodge/Item/Equipment.hs @@ -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 diff --git a/src/Dodge/Item/Weapon/BulletGun/Clip.hs b/src/Dodge/Item/Weapon/BulletGun/Clip.hs index f3153a46f..f9a911cf4 100644 --- a/src/Dodge/Item/Weapon/BulletGun/Clip.hs +++ b/src/Dodge/Item/Weapon/BulletGun/Clip.hs @@ -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 diff --git a/src/Dodge/Item/Weapon/BulletGuns.hs b/src/Dodge/Item/Weapon/BulletGuns.hs index 7c12354e5..ce4973b88 100644 --- a/src/Dodge/Item/Weapon/BulletGuns.hs +++ b/src/Dodge/Item/Weapon/BulletGuns.hs @@ -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 diff --git a/src/Dodge/LevelGen/Switch.hs b/src/Dodge/LevelGen/Switch.hs index fa0101318..c342b5de5 100644 --- a/src/Dodge/LevelGen/Switch.hs +++ b/src/Dodge/LevelGen/Switch.hs @@ -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) diff --git a/src/Dodge/Placement/Instance/LightSource/Cover.hs b/src/Dodge/Placement/Instance/LightSource/Cover.hs index 9caeb552f..fe7b88418 100644 --- a/src/Dodge/Placement/Instance/LightSource/Cover.hs +++ b/src/Dodge/Placement/Instance/LightSource/Cover.hs @@ -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 ) diff --git a/src/Dodge/Placement/TopDecoration.hs b/src/Dodge/Placement/TopDecoration.hs index 17e1a9ca8..63f5eac4a 100644 --- a/src/Dodge/Placement/TopDecoration.hs +++ b/src/Dodge/Placement/TopDecoration.hs @@ -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) diff --git a/src/Dodge/Render.hs b/src/Dodge/Render.hs index a5091671e..7502ccc4f 100644 --- a/src/Dodge/Render.hs +++ b/src/Dodge/Render.hs @@ -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 diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index 480e89618..fc279b867 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -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 diff --git a/src/Dodge/Render/Lights.hs b/src/Dodge/Render/Lights.hs index 5a471d706..e18eaaf60 100644 --- a/src/Dodge/Render/Lights.hs +++ b/src/Dodge/Render/Lights.hs @@ -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 diff --git a/src/Dodge/Render/ShapePicture.hs b/src/Dodge/Render/ShapePicture.hs index 500bb8132..34832451a 100644 --- a/src/Dodge/Render/ShapePicture.hs +++ b/src/Dodge/Render/ShapePicture.hs @@ -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) diff --git a/src/Dodge/Room/Airlock.hs b/src/Dodge/Room/Airlock.hs index d1eaed70a..d45b4141b 100644 --- a/src/Dodge/Room/Airlock.hs +++ b/src/Dodge/Room/Airlock.hs @@ -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 = diff --git a/src/Dodge/Room/Corridor.hs b/src/Dodge/Room/Corridor.hs index 89db1c4cb..7cf700315 100644 --- a/src/Dodge/Room/Corridor.hs +++ b/src/Dodge/Room/Corridor.hs @@ -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 diff --git a/src/Dodge/Room/LasTurret.hs b/src/Dodge/Room/LasTurret.hs index c71ceed1a..85c539294 100644 --- a/src/Dodge/Room/LasTurret.hs +++ b/src/Dodge/Room/LasTurret.hs @@ -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 diff --git a/src/Dodge/Room/LongDoor.hs b/src/Dodge/Room/LongDoor.hs index c7c6d0d2a..f146cc07c 100644 --- a/src/Dodge/Room/LongDoor.hs +++ b/src/Dodge/Room/LongDoor.hs @@ -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)) diff --git a/src/Dodge/Room/Procedural.hs b/src/Dodge/Room/Procedural.hs index afa6f06de..e0e80f500 100644 --- a/src/Dodge/Room/Procedural.hs +++ b/src/Dodge/Room/Procedural.hs @@ -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] diff --git a/src/Dodge/Room/Teleport.hs b/src/Dodge/Room/Teleport.hs index 9efacaed6..7d2862ce1 100644 --- a/src/Dodge/Room/Teleport.hs +++ b/src/Dodge/Room/Teleport.hs @@ -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 diff --git a/src/Dodge/Update/Camera.hs b/src/Dodge/Update/Camera.hs index 38d51f0f8..92705fbcc 100644 --- a/src/Dodge/Update/Camera.hs +++ b/src/Dodge/Update/Camera.hs @@ -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 diff --git a/src/Geometry/Polygon.hs b/src/Geometry/Polygon.hs index e255448f0..4b7b02662 100644 --- a/src/Geometry/Polygon.hs +++ b/src/Geometry/Polygon.hs @@ -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] diff --git a/src/Geometry/Vector.hs b/src/Geometry/Vector.hs index 27d43409c..7445f9eb2 100644 --- a/src/Geometry/Vector.hs +++ b/src/Geometry/Vector.hs @@ -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 diff --git a/src/Picture.hs b/src/Picture.hs index 554b51f0d..f06d0fbc5 100644 --- a/src/Picture.hs +++ b/src/Picture.hs @@ -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