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

Fix bug in detecting which room you are in

Browse Source
This commit is contained in:
justin
2021-09-03 01:22:46 +01:00
parent c69af7a5f4
commit 1bbeb926a5
14 changed files with 121 additions and 93 deletions
Download Patch File Download Diff File Expand all files Collapse all files
shader/lighting/texture.frag
+2 -3
View File
@@ -9,8 +9,7 @@ void main()
vec3 distVec = texture(screenTexture,vTexPos).xyz - lightPos;
float dist = dot(distVec,distVec);
if (dist > lumRad.a) {discard;}
//vec3 dField = distVec / lumRad.a;
//vec3 c = pow (1 - min(1, dot(dField,dField)) , 2) * lumRad.rgb ;
vec3 c = (1 - dist / lumRad.a) * lumRad.rgb ;
float x = 1 - dist / lumRad.a ;
vec3 c = (x * x * x) * lumRad.rgb ;
fColor = vec4(c,0);
}
src/Dodge/Data.hs
+1 -1
View File
@@ -71,7 +71,7 @@ data World = World
, _floorTiles :: [(Point3,Point3)]
, _randGen :: StdGen
, _mousePos :: !Point2
, _testString :: String
, _testString :: World -> [String]
, _yourID :: !Int
, _worldEvents :: World -> World
, _pressPlates :: IM.IntMap PressPlate
src/Dodge/Default/Room.hs
+7 -6
View File
@@ -4,10 +4,11 @@ import Dodge.Room.Data
defaultRoom :: Room
defaultRoom = Room
{ _rmPolys = []
, _rmLinks = []
, _rmPath = []
, _rmPS = []
, _rmBound = []
, _rmFloor = []
{ _rmPolys = []
, _rmLinks = []
, _rmPath = []
, _rmPS = []
, _rmBound = []
, _rmFloor = []
, _rmName = "defaultRoom"
}
src/Dodge/Default/World.hs
+1 -1
View File
@@ -42,7 +42,7 @@ defaultWorld = World
, _floorTiles = []
, _randGen = mkStdGen 2
, _mousePos = V2 0 0
, _testString = []
, _testString = const []
, _yourID = 0
, _worldEvents = id
, _pressPlates = IM.empty
src/Dodge/GameRoom.hs
+3
View File
@@ -1,3 +1,4 @@
{-# LANGUAGE StrictData #-}
{- | GameRooms contain information about given positions in the world
-}
module Dodge.GameRoom
@@ -7,4 +8,6 @@ import Geometry
data GameRoom = GameRoom
{ _grViewpoints :: [Point2]
, _grBound :: [Point2]
, _grDir :: Float -- ^ gives direction of room
, _grName :: String
}
src/Dodge/Initialisation.hs
+12 -1
View File
@@ -11,11 +11,14 @@ import Dodge.WorldEvent.Cloud
import Dodge.SoundLogic
import Dodge.SoundLogic.Synonyms
import Geometry.Data
import Dodge.GameRoom
import Geometry
import System.Random
import qualified Data.Set as S
import qualified Data.IntMap.Strict as IM
import qualified Data.Map as M
import Data.List (sortOn)
firstWorld :: IO World
firstWorld = do
@@ -37,7 +40,7 @@ initialWorld = defaultWorld
, _floorItems = IM.empty
, _randGen = mkStdGen 2
, _mousePos = V2 0 0
, _testString = []
, _testString = testStringInit
, _yourID = 0
, _worldEvents = soundOncePos foamSprayFadeOutSound (V2 0 0) . foldr ((.) . makeStartCloudAt) id
[V3 x y 5 | x <- [-5,-3..5] , y <- [-5,-3..5]]
@@ -49,3 +52,11 @@ initialWorld = defaultWorld
, _menuLayers = [TerminalMessage 300 rezText']
, _worldState = M.empty
}
testStringInit :: World -> [String]
testStringInit w = (show . _crPos $ _creatures w IM.! 0)
: (map show . _grBound . last $ sortOn _grName grs)
++ closeRooms
where
closeRooms = map _grName $ filter (pointInOrOnPolygon p . _grBound) grs
grs = _gameRooms w
p = _cameraViewFrom w
src/Dodge/Layout.hs
+3 -1
View File
@@ -131,7 +131,9 @@ gameRoomsFromRooms = map f
f rm = GameRoom
{ _grViewpoints = (map fst . foldl' (flip cutWalls) [] $ _rmPolys rm)
++ map fst (_rmLinks rm)
, _grBound = expandPolyByFixed 100 $ convexHullSafe $ concat $ _rmBound rm ++ _rmPolys rm
, _grBound = expandPolyByFixed 100 $ orderPolygon $ convexHullSafe $ concat $ _rmBound rm ++ _rmPolys rm
, _grDir = snd . last $ _rmLinks rm
, _grName = _rmName rm
}
floorsFromRooms :: [Room] -> [(Point3,Point3)]
src/Dodge/Render/HUD.hs
+12 -36
View File
@@ -8,6 +8,7 @@ import Dodge.Base
import Dodge.Base.Window
import Dodge.Inventory
import Dodge.Render.Connectors
import Dodge.Render.List
import Picture
import Geometry
import Padding
@@ -22,7 +23,7 @@ import SDL (MouseButton (..))
hudDrawings :: World -> Picture
hudDrawings w = pictures
[ winScale w . dShadCol white $ displayHP 0 w
, winScale w . translate (-390) 20 . scale 0.05 0.05 . dShadCol white $ text (_testString w)
, renderListAt (halfWidth w) 0 w $ map (,white) (_testString w w)
, selectionText
]
where
@@ -31,9 +32,6 @@ hudDrawings w = pictures
then drawLocations w
else drawInventory w
winScale :: World -> Picture -> Picture
{-# INLINE winScale #-}
winScale w = scale (2 / getWindowX w) (2 / getWindowY w)
drawInventory :: World -> Picture
drawInventory w = displayInv 0 w `appendPic` subInventoryDisplay w
@@ -100,7 +98,7 @@ pjTweakString pj = _pjDisplayParam pj $ _pjIntParam pj
displayMidList :: World -> [String] -> String -> Picture
displayMidList w strs s =
invHead w s
`appendPic` renderListAt 150 (-60) (map (,white) strs) w
`appendPic` renderListAt 150 (-60) w (map (,white) strs)
invHead :: World -> String -> Picture
invHead w s = winScale w . translate (-130) (halfHeight w - 40) . dShadCol white . scale 0.4 0.4 $ text s
@@ -116,9 +114,6 @@ renderItemMapAt tx ty scols w =
--renderPairListAt tx ty scols w =
-- concatMapPic (winScale w) $ map (uncurry $ listPairAt tx ty w) scols
renderListAt :: Float -> Float -> [(String,Color)] -> World -> Picture
renderListAt tx ty scols w =
concatMapPic (winScale w) $ zipWith (listPairAt tx ty w) [0..] scols
displayInv :: Int -> World -> Picture
displayInv n w = renderItemMapAt 0 0 items w
@@ -130,15 +125,15 @@ displayInv n w = renderItemMapAt 0 0 items w
--itemStringCol itm = (_itInvDisplay itm itm, _itInvColor itm)
drawLocations :: World -> Picture
drawLocations wrld = pictures $
renderListAt 0 0 locs wrld
: zipWith bConnect (displayListEndCoords wrld locTexts) locPoss
++ mapOverlay wrld
++ [mainListCursor white iPos wrld]
drawLocations w = pictures $
renderListAt 0 0 w locs
: zipWith bConnect (displayListEndCoords w locTexts) locPoss
++ mapOverlay w
++ [mainListCursor white iPos w]
where
iPos = _selLocation wrld
locs = map (\(_,s) -> (s,white)) . IM.elems . _seenLocations $ wrld
locPoss = map (cartePosToScreen wrld . ($ wrld) . fst) . IM.elems . _seenLocations $ wrld
iPos = _selLocation w
locs = map (\(_,s) -> (s,white)) . IM.elems . _seenLocations $ w
locPoss = map (cartePosToScreen w . ($ w) . fst) . IM.elems . _seenLocations $ w
locTexts = map fst locs
displayListEndCoords :: World -> [String] -> [Point2]
@@ -169,7 +164,7 @@ mapWall w wl =
closeObjectTexts :: World -> Picture
closeObjectTexts w = pictures $
renderListAt pushout (negate 20 * fromIntegral invPos)
(map colAndText $ _closeActiveObjects w) w
w (map colAndText $ _closeActiveObjects w)
: maybeToList maybeLine
where
colAndText (Left x) = ( _itName $ _flIt x, _itInvColor $ _flIt x)
@@ -193,12 +188,6 @@ closeObjectTexts w = pictures $
let p = V2 (textWidth + 15 + pushout - halfWidth w)
( halfHeight w - 20* (fromIntegral invPos +1) + 2.5)
return . winScale w . color col $ lConnect p itScreenPos
{- | Colour picture and add black drop shadow. -}
dShadCol :: Color -> Picture -> Picture
dShadCol c p = pictures
[ color black $ translate 1.2 (-1.2) p
, color c p
]
mainListCursor :: Color -> Int -> World -> Picture
mainListCursor c = openCursorAt 120 c 5 0
@@ -229,19 +218,6 @@ listItemAt' xoff yoff w yint item = winScale w . translate (xoff + 15 - halfWidt
-- -> Picture
--{-# INLINE listItemAt #-}
--listItemAt xoff yoff w yint = listPairAt xoff yoff w yint . itemStringCol
listPairAt
:: Float -- ^ x offset
-> Float -- ^ y offset
-> World
-> Int -- ^ y offset (discrete)
-> (String,Color) -- ^ The text item
-> Picture
{-# INLINE listPairAt #-}
listPairAt xoff yoff w yint (s,col)
= translate (xoff + 15 - halfWidth w) (yoff + halfHeight w - (20 * (fromIntegral yint+1)))
. scale 0.1 0.1
. dShadCol col
$ text s
openCursorAt
:: Float -- ^ Width
src/Dodge/Render/List.hs
+32
View File
@@ -0,0 +1,32 @@
module Dodge.Render.List
where
import Dodge.Data
import Dodge.Base.Window
import Picture
renderListAt :: Float -> Float -> World -> [(String,Color)] -> Picture
renderListAt tx ty w =
concatMapPic (winScale w) . zipWith (listPairAt tx ty w) [0..]
listPairAt
:: Float -- ^ x offset
-> Float -- ^ y offset
-> World
-> Int -- ^ y offset (discrete)
-> (String,Color) -- ^ The text item
-> Picture
{-# INLINE listPairAt #-}
listPairAt xoff yoff w yint (s,col)
= translate (xoff + 15 - halfWidth w) (yoff + halfHeight w - (20 * (fromIntegral yint+1)))
. scale 0.1 0.1
. dShadCol col
$ text s
{- | Colour picture and add black drop shadow. -}
dShadCol :: Color -> Picture -> Picture
dShadCol c p = pictures
[ color black $ translate 1.2 (-1.2) p
, color c p
]
winScale :: World -> Picture -> Picture
{-# INLINE winScale #-}
winScale w = scale (2 / getWindowX w) (2 / getWindowY w)
src/Dodge/Render/Picture.hs
+4
View File
@@ -1,3 +1,4 @@
{-# LANGUAGE TupleSections #-}
module Dodge.Render.Picture
where
import Dodge.Data
@@ -7,7 +8,9 @@ import Dodge.Base.Zone
import Dodge.Picture
import Dodge.Picture.Layer
import Dodge.Render.HUD
--import Dodge.Render.List
import Dodge.Render.MenuScreen
--import Dodge.GameRoom
--import Dodge.Debug
import Geometry
--import Geometry.Zone
@@ -60,6 +63,7 @@ customMouseCursor w =
testPic :: World -> Picture
testPic _ = blank
--setLayer 1 $ renderListAt 50 0 w $ map ((,white) . _grName) $ _gameRooms w
-- [ setDepth (-1) . translate 0 0.8
-- . scale 0.001 0.001 . text . show $ _crMvDir $ you w
src/Dodge/Room/Data.hs
+6 -4
View File
@@ -8,6 +8,7 @@ module Dodge.Room.Data
, rmPS
, rmBound
, rmFloor
, rmName
) where
import Dodge.LevelGen.Data
--import Geometry
@@ -27,9 +28,10 @@ assigning no bounds will allow rooms to overlap.
data Room = Room
{ _rmPolys :: [ [Point2] ]
, _rmLinks :: [(Point2,Float)]
, _rmPath :: [(Point2, Point2)]
, _rmPS :: [Placement]
, _rmBound :: [ [Point2] ]
, _rmFloor :: [Tile]
, _rmPath :: [(Point2, Point2)]
, _rmPS :: [Placement]
, _rmBound :: [ [Point2] ]
, _rmFloor :: [Tile]
, _rmName :: String
}
makeLenses ''Room
src/Dodge/Room/LongDoor.hs
+1
View File
@@ -48,6 +48,7 @@ twinSlowDoorRoom drID w h x = defaultRoom
(over worldState (M.insert (DoorNumOpen drID) True))
]
, _rmBound = ps
, _rmName = "twinSlowDoorRoom"
}
where
ps =
src/Dodge/Update/Camera.hs
+36 -39
View File
@@ -14,18 +14,18 @@ import Dodge.Base.Collide
import Dodge.Config.KeyConfig
import Dodge.Item.Attachment.Data
import Geometry
import Geometry.ConvexPoly
--import Geometry.ConvexPoly
import Dodge.GameRoom
import qualified Data.List.NonEmpty as NEL
--import qualified Data.List.NonEmpty as NEL
import Control.Lens
--import Control.Applicative
import Data.Maybe
import qualified Data.Set as S
import qualified Data.IntMap.Strict as IM
import qualified SDL
import Data.Monoid
import Data.Semigroup
--import Data.Monoid
--import Data.Semigroup
import qualified Control.Foldl as L
{- Update the screen camera rotation and position, including any in rold scope/remote camera modifiers;
update where your avatar's view is from. -}
@@ -164,49 +164,46 @@ autoZoomCam w = over cameraZoom changeZoom w
theScopeZoom = fromMaybe 1 $ yourItem w ^? itAttachment . scopeZoom
farWallDist' :: Point2 -> World -> Float
farWallDist' p w = (winFac /) $ fromMaybe 800 $ L.fold L.maximum vdists
farWallDist' p w = (winFac /) $ fromMaybe maxViewDistance $ L.fold L.maximum vdists
where
hw = halfWidth w
hh = halfHeight w
winFac = min hw hh
vdists = map (flip (collideDirectionIndirect 800 p) wos)
vdists = map (flip (collideDirectionIndirect maxViewDistance p) wos)
vps
vps = concatMap _grViewpoints grs
grs = filter (pointInOrOnPolygon p . _grBound) (_gameRooms w)
wos = wallsOnScreen w
-- | Find the furthest viewable distance from a given point in the world
farWallDist :: Point2 -> World -> Float
--{-# INLINE farWallDist #-}
farWallDist cpos w
= getMin
. uncurry (<>)
$ bimap (toScale hw) (toScale hh)
$ sconcat
$ NEL.map distsMaybeTo viewTestValues
where
wos = wallsOnScreen w
camRot = _cameraRot w
hw = halfWidth w
hh = halfHeight w
toScale x = Min . (x /) . (+ 50) . maybe maxViewDistance getMax . getAp
distsMaybeTo x = (valueAtWidth x,valueAtHeight x)
valueAtHeight h = cpiv (cpos +.+ x) <> cpiv (cpos -.- x)
where
x = rotateV camRot $ V2 maxViewDistance h
cpiv p = Ap $ Max . horSize <$> collidePointIndirect cpos p wos
horSize = abs . dotV rv . (-.- cpos)
rv = rotateV camRot (V2 1 0)
valueAtWidth h = cpih (cpos +.+ x) <> cpih (cpos -.- x)
where
x = rotateV camRot $ V2 h maxViewDistance
cpih p = Ap $ Max . verSize <$> collidePointIndirect cpos p wos
verSize = abs . dotV rh . (-.- cpos)
rh = rotateV camRot (V2 0 1)
viewTestValues :: NEL.NonEmpty Float
viewTestValues = NEL.fromList [-maxViewDistance,negate $ 0.75*maxViewDistance..maxViewDistance]
---- | Find the furthest viewable distance from a given point in the world
--farWallDist :: Point2 -> World -> Float
----{-# INLINE farWallDist #-}
--farWallDist cpos w
-- = getMin
-- . uncurry (<>)
-- $ bimap (toScale hw) (toScale hh)
-- $ sconcat
-- $ NEL.map distsMaybeTo viewTestValues
-- where
-- wos = wallsOnScreen w
-- camRot = _cameraRot w
-- hw = halfWidth w
-- hh = halfHeight w
-- toScale x = Min . (x /) . (+ 50) . maybe maxViewDistance getMax . getAp
-- distsMaybeTo x = (valueAtWidth x,valueAtHeight x)
-- valueAtHeight h = cpiv (cpos +.+ x) <> cpiv (cpos -.- x)
-- where
-- x = rotateV camRot $ V2 maxViewDistance h
-- cpiv p = Ap $ Max . horSize <$> collidePointIndirect cpos p wos
-- horSize = abs . dotV rv . (-.- cpos)
-- rv = rotateV camRot (V2 1 0)
-- valueAtWidth h = cpih (cpos +.+ x) <> cpih (cpos -.- x)
-- where
-- x = rotateV camRot $ V2 h maxViewDistance
-- cpih p = Ap $ Max . verSize <$> collidePointIndirect cpos p wos
-- verSize = abs . dotV rh . (-.- cpos)
-- rh = rotateV camRot (V2 0 1)
--viewTestValues :: NEL.NonEmpty Float
--viewTestValues = NEL.fromList [-maxViewDistance,negate $ 0.75*maxViewDistance..maxViewDistance]
maxViewDistance :: Float
maxViewDistance = 800
src/Geometry.hs
+1 -1
View File
@@ -133,7 +133,7 @@ convexHull :: [Point2] -> [Point2]
convexHull (x:y:z:xs) = grahamScan $ orderAroundFirst $ sortOn (\(V2 a b) -> (b,a)) (x:y:z:xs)
convexHull _ = error "Tried to create the convex hull of two or fewer points"
-- | Creates the convex hull of a set of points.
-- Need to verify whether or not this is ordered
-- it appears that the output may NOT be ordered
convexHullSafe :: [Point2] -> [Point2]
convexHullSafe (x:y:z:xs) = grahamScan $ orderAroundFirst $ sortOn (\(V2 a b) -> (b,a)) (x:y:z:xs)
convexHullSafe _ = []