From 956ee87168ec4f24073a288cdba581eb40a5386c Mon Sep 17 00:00:00 2001 From: justin Date: Tue, 7 Jun 2022 18:22:43 +0100 Subject: [PATCH] Improve forcefield visuals --- src/Dodge/Base/Collide.hs | 11 +++++++- src/Dodge/Data.hs | 3 ++- src/Dodge/Debug/Picture.hs | 3 ++- src/Dodge/Item/Equipment.hs | 3 ++- src/Dodge/Item/Weapon/LaserPath.hs | 3 ++- src/Dodge/Render.hs | 4 +-- src/Dodge/Render/Walls.hs | 40 +++++++++++++++++++++++------- src/Dodge/Update.hs | 3 +-- src/Dodge/Wall/ForceField.hs | 14 ++++++++++- src/FoldableHelp.hs | 11 ++++++++ 10 files changed, 76 insertions(+), 19 deletions(-) diff --git a/src/Dodge/Base/Collide.hs b/src/Dodge/Base/Collide.hs index dc2a4b4d0..fb43ebb5d 100644 --- a/src/Dodge/Base/Collide.hs +++ b/src/Dodge/Base/Collide.hs @@ -12,6 +12,8 @@ module Dodge.Base.Collide , isWalkable , canSee , hasLOSIndirect + , wlIsOpaque + , wlIsSeeThrough ) where import Dodge.Data import Dodge.Zone @@ -126,7 +128,14 @@ collidePointWalkable p1 p2 ws -- p3 = p1 +.+ d *.* safeNormalizeV (p2 -.- p1) wlIsOpaque :: Wall -> Bool -wlIsOpaque wl = _wlOpacity wl == Opaque +wlIsOpaque wl = case _wlOpacity wl of + Opaque -> True + _ -> False + +wlIsSeeThrough :: Wall -> Bool +wlIsSeeThrough wl = case _wlOpacity wl of + SeeThrough -> True + _ -> False --collidePointUpToIndirect -- :: Point2 -- ^start point diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index e26a402ec..52d199999 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -1042,8 +1042,8 @@ data Wall = Wall data Opacity = SeeThrough | SeeAbove + | DrawnWall {_opDraw :: Wall -> SPic} | Opaque - deriving (Eq,Ord,Show) data WallStructure = StandaloneWall | DoorPart { _wlStDoor :: Int } @@ -1585,6 +1585,7 @@ makeLenses ''Modification makeLenses ''Particle makeLenses ''Wall makeLenses ''WallStructure +makeLenses ''Opacity makeLenses ''PressPlate makeLenses ''Button makeLenses ''ActionPlan diff --git a/src/Dodge/Debug/Picture.hs b/src/Dodge/Debug/Picture.hs index 2cc9e24ec..d04f03eef 100644 --- a/src/Dodge/Debug/Picture.hs +++ b/src/Dodge/Debug/Picture.hs @@ -1,6 +1,7 @@ module Dodge.Debug.Picture where import Dodge.Data import Dodge.Base.Window +import Dodge.Base.Collide import Geometry import Picture @@ -46,7 +47,7 @@ pointOnScreen cfig w p = pointInPolygon p . reverse $ screenPolygon cfig w drawWallFace :: Configuration -> World -> Wall -> Picture drawWallFace cfig w wall - | isRHS sightFrom x y || _wlOpacity wall /= Opaque = blank + | isRHS sightFrom x y || not (wlIsOpaque wall) = blank | otherwise = setDepth (-1) . color (withAlpha 0 black) . polygon $ points where (x,y) = _wlLine wall diff --git a/src/Dodge/Item/Equipment.hs b/src/Dodge/Item/Equipment.hs index c0837c09b..74d0c1154 100644 --- a/src/Dodge/Item/Equipment.hs +++ b/src/Dodge/Item/Equipment.hs @@ -9,6 +9,7 @@ import Dodge.Default.Wall import Dodge.Creature.Test import Dodge.Creature.HandPos import Dodge.Wall +import Dodge.Wall.ForceField import Dodge.Magnet import Picture import Geometry @@ -80,7 +81,7 @@ wristArmour = defaultEquipment onEquipWristShield :: Item -> Creature -> World -> World onEquipWristShield itm cr w = w & creatures . ix (_crID cr) . crInv . ix (fromJust (_itInvPos itm)) . itUse . eqEq . eqParams .~ EquipID i - & walls . at i ?~ (shieldWall (_crID cr)) {_wlDraw = True,_wlID = i} + & walls . at i ?~ forceField {_wlID = i} & setWristShieldPos (itm & itUse . eqEq . eqParams .~ EquipID i) cr where i = IM.newKey (_walls w) diff --git a/src/Dodge/Item/Weapon/LaserPath.hs b/src/Dodge/Item/Weapon/LaserPath.hs index 068c565fe..56b04cd10 100644 --- a/src/Dodge/Item/Weapon/LaserPath.hs +++ b/src/Dodge/Item/Weapon/LaserPath.hs @@ -5,6 +5,7 @@ import Dodge.Data import Dodge.Wall.Reflect --import Dodge.Creature.HandPos import Dodge.WorldEvent +import Dodge.Base.Collide --import Dodge.Default --import Dodge.Item.Weapon.InventoryDisplay --import Dodge.Item.Weapon.TriggerType @@ -27,7 +28,7 @@ reflectLaserAlong phasev seenWl sp ep w = case find (notseen seenWl) Just (p,Right wl) | _wlReflect wl -> second (p:) $ reflectLaserAlong phasev (wl:seenWl) p (p +.+ 800 *.* unitVectorAtAngle (reflDirWall sp p wl)) w - | _wlOpacity wl == SeeThrough -> second (p:) $ reflectLaserAlong phasev (wl:seenWl) p + | wlIsSeeThrough wl -> second (p:) $ reflectLaserAlong phasev (wl:seenWl) p (refract sp ep wl p) w | otherwise -> (Just (p,Right wl), [p]) Just (p,obj) -> (Just (p,obj), [p]) diff --git a/src/Dodge/Render.hs b/src/Dodge/Render.hs index d00e2248b..e9a8604b2 100644 --- a/src/Dodge/Render.hs +++ b/src/Dodge/Render.hs @@ -38,7 +38,7 @@ doDrawing pdata u = do trans = _cameraCenter w wins@(V2 winx winy) = V2 (_windowX cfig) (_windowY cfig) resFact = resFactorNum $ cfig ^. graphics_resolution_factor - (wallPointsCol,windowPoints) = wallsAndWindows cfig w + (wallPointsCol,windowPoints,wallSPics) = wallsToDrawStreams cfig w lightPoints = lightsForGloom w viewFroms@(V2 vfx vfy) = _cameraViewFrom w viewFrom3d = Vector3 vfx vfy 20 @@ -50,7 +50,7 @@ doDrawing pdata u = do shapeCounts <- UMV.replicate 3 0 wlwiflCounts <- UMV.replicate 3 0 -- attempt to poke in parallel - let (ws,wp) = worldSPic cfig w + let (ws,wp) = wallSPics <> worldSPic cfig w MP.bindM3 (\ _ _ _ -> return ()) ( pokeBindFoldableLayer shadV layerCounts wp) ( pokeWallsWindowsFloor diff --git a/src/Dodge/Render/Walls.hs b/src/Dodge/Render/Walls.hs index d18f5f658..a49c7da33 100644 --- a/src/Dodge/Render/Walls.hs +++ b/src/Dodge/Render/Walls.hs @@ -1,20 +1,42 @@ module Dodge.Render.Walls - ( wallsAndWindows + ( wallsToDrawStreams ) where import Dodge.Data import Dodge.Zone +import Dodge.Base.Collide import Geometry +import ShapePicture -import Data.List -import qualified Data.IntMap.Strict as IM -wallsAndWindows +import Control.Lens +--import Data.Maybe +import qualified Control.Foldl as L +--import Data.List +--import qualified Data.IntMap.Strict as IM +wallsToDrawStreams :: Configuration -> World - -> ( [((Point2,Point2),Point4)] ,[((Point2,Point2),Point4)] ) -wallsAndWindows cfig w - = (map f wls, map f wins) + -> ( [((Point2,Point2),Point4)] ,[((Point2,Point2),Point4)], SPic ) +wallsToDrawStreams cfig w + = ( wls, wins,spic) where f wl = (_wlLine wl, _wlColor wl) - (wins,wls) = partition theTest . IM.elems . IM.filter _wlDraw $ wallsDoubleScreen cfig w - theTest wl = _wlOpacity wl /= Opaque + (wls, wins, spic) = L.fold ((,,) + <$> L.prefilter wlOpaqueDraw (L.premap f L.list) + <*> L.prefilter wlSeeThroughDraw (L.premap f L.list) + <*> L.premap getWallSPic L.mconcat + ) (wallsDoubleScreen cfig w) +wlOpaqueDraw :: Wall -> Bool +wlOpaqueDraw wl = wlIsOpaque wl && _wlDraw wl +wlSeeThroughDraw :: Wall -> Bool +wlSeeThroughDraw wl = wlIsSeeThrough wl && _wlDraw wl + +getWallSPic :: Wall -> SPic +getWallSPic wl = case wl ^? wlOpacity . opDraw of + Nothing -> mempty + Just f -> f wl + +-- (wins,wls) = partition theTest . IM.elems . IM.filter _wlDraw $ wallsDoubleScreen cfig w +-- theTest wl = case _wlOpacity wl of +-- Opaque -> False +-- _ -> True diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 78737e2a6..376dc0786 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -399,7 +399,7 @@ crCrSpring c1 c2 w {- Finds the visible walls from a point to another point. -} visibleWalls :: Point2 -> Point2 -> IM.IntMap Wall -> [Wall] visibleWalls p1 p2 ws - = takeUntil isOpaque + = takeUntil wlIsOpaque . map snd . sortOn (dist p1 . fromJust . fst) . filter (isJust . fst) @@ -407,7 +407,6 @@ visibleWalls p1 p2 ws $ IM.elems ws where f wl = (uncurry intersectSegSeg (_wlLine wl) p1 p2, wl) - isOpaque wl = _wlOpacity wl == Opaque updateDelayedEvents :: World -> World updateDelayedEvents w = let (neww,newde) = mapAccumR f w (_delayedEvents w) diff --git a/src/Dodge/Wall/ForceField.hs b/src/Dodge/Wall/ForceField.hs index 9b0365018..76466e2a3 100644 --- a/src/Dodge/Wall/ForceField.hs +++ b/src/Dodge/Wall/ForceField.hs @@ -2,11 +2,13 @@ module Dodge.Wall.ForceField where import Dodge.Data import Dodge.Default.Wall import Color +import Picture +import ShapePicture forceField :: Wall forceField = defaultWall {_wlColor = orange - ,_wlOpacity = SeeAbove + ,_wlOpacity = DrawnWall drawForceField ,_wlPathable = True ,_wlWalkable = True ,_wlFireThrough = True @@ -15,3 +17,13 @@ forceField = defaultWall ,_wlRotateTo = False ,_wlStructure = StandaloneWall } + +drawForceField :: Wall -> SPic +drawForceField wl = (mempty + , setLayer BloomLayer + . setDepth 20 + . color (_wlColor wl) + $ thickLine 5 [a,b] + ) + where + (a,b) = _wlLine wl diff --git a/src/FoldableHelp.hs b/src/FoldableHelp.hs index 4944f6597..933fc6263 100644 --- a/src/FoldableHelp.hs +++ b/src/FoldableHelp.hs @@ -5,6 +5,7 @@ module FoldableHelp , safeMinimumOnMaybeF , safeMinimumOnMaybeL , safeMinMaybeL + , filter3 , module Data.Foldable ) where @@ -62,6 +63,16 @@ safeMinimumOnMaybe f ys = fst <$> go Nothing ys _ -> go (Just (y,cmin)) xs go m _ = m +filter3 :: Foldable t + => (a -> Bool) + -> (a -> Bool) + -> (a -> Bool) + -> t a + -> ([a],[a],[a]) +filter3 t1 t2 t3 = L.fold $ (,,) + <$> L.prefilter t1 L.list + <*> L.prefilter t2 L.list + <*> L.prefilter t3 L.list --{- | Partial. -} --minimumOn :: Ord b => (a -> b) -> [a] -> a