Fix bug in detecting which room you are in

shader/lighting/texture.frag

@@ -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;
+    float x = 1 - dist / lumRad.a ;
-    //vec3 c = pow (1 - min(1, dot(dField,dField)) , 2) * lumRad.rgb ;
+    vec3 c = (x * x * x) * lumRad.rgb ;
-    vec3 c = (1 - dist / lumRad.a) * lumRad.rgb ;
     fColor = vec4(c,0);
 }

src/Dodge/Data.hs

@@ -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

@@ -4,10 +4,11 @@ import Dodge.Room.Data
 
 defaultRoom :: Room
 defaultRoom = Room
-    { _rmPolys = []
+    { _rmPolys  = []
-    , _rmLinks = []
+    , _rmLinks  = []
-    , _rmPath = []
+    , _rmPath   = []
-    , _rmPS = []
+    , _rmPS     = []
-    , _rmBound = []
+    , _rmBound  = []
-    , _rmFloor = []
+    , _rmFloor  = []
+    , _rmName   = "defaultRoom"
     }

src/Dodge/Default/World.hs

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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 $ 
+drawLocations w = pictures $ 
-    renderListAt 0 0 locs wrld
+    renderListAt 0 0 w locs
-    : zipWith bConnect (displayListEndCoords wrld locTexts) locPoss
+    : zipWith bConnect (displayListEndCoords w locTexts) locPoss
-    ++ mapOverlay wrld
+    ++ mapOverlay w
-    ++ [mainListCursor white iPos wrld]
+    ++ [mainListCursor white iPos w]
   where
-    iPos = _selLocation wrld
+    iPos = _selLocation w
-    locs = map (\(_,s) -> (s,white)) . IM.elems . _seenLocations $ wrld
+    locs = map (\(_,s) -> (s,white)) . IM.elems . _seenLocations $ w
-    locPoss = map (cartePosToScreen wrld . ($ wrld) . fst) . IM.elems . _seenLocations $ wrld
+    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

@@ -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

@@ -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

@@ -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)]
+    , _rmPath   :: [(Point2, Point2)]
-    , _rmPS :: [Placement]
+    , _rmPS     :: [Placement]
-    , _rmBound :: [ [Point2] ]
+    , _rmBound  :: [ [Point2] ]
-    , _rmFloor :: [Tile]
+    , _rmFloor  :: [Tile]
+    , _rmName   :: String
     }
 makeLenses ''Room

src/Dodge/Room/LongDoor.hs

@@ -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

@@ -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.Monoid
-import Data.Semigroup
+--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
--- | Find the furthest viewable distance from a given point in the world
+----{-# INLINE farWallDist #-}
-farWallDist :: Point2 -> World -> Float
+--farWallDist cpos w 
---{-# INLINE farWallDist #-}
+--    = getMin 
-farWallDist cpos w 
+--    . uncurry (<>) 
-    = getMin 
+--    $ bimap (toScale hw) (toScale hh) 
-    . uncurry (<>) 
+--    $ sconcat 
-    $ bimap (toScale hw) (toScale hh) 
+--    $ NEL.map distsMaybeTo viewTestValues
-    $ sconcat 
+--  where
-    $ NEL.map distsMaybeTo viewTestValues
+--    wos = wallsOnScreen w
-  where
+--    camRot = _cameraRot w
-    wos = wallsOnScreen w
+--    hw = halfWidth w
-    camRot = _cameraRot w
+--    hh = halfHeight w
-    hw = halfWidth w
+--    toScale x = Min . (x /) . (+ 50) . maybe maxViewDistance getMax . getAp
-    hh = halfHeight w
+--    distsMaybeTo x = (valueAtWidth x,valueAtHeight x)
-    toScale x = Min . (x /) . (+ 50) . maybe maxViewDistance getMax . getAp
+--    valueAtHeight h  = cpiv (cpos +.+ x) <> cpiv (cpos -.- x)
-    distsMaybeTo x = (valueAtWidth x,valueAtHeight x)
+--      where
-    valueAtHeight h  = cpiv (cpos +.+ x) <> cpiv (cpos -.- x)
+--        x = rotateV camRot $ V2 maxViewDistance h
-      where
+--        cpiv p = Ap $ Max . horSize <$> collidePointIndirect cpos p wos
-        x = rotateV camRot $ V2 maxViewDistance h
+--        horSize = abs . dotV rv . (-.- cpos)
-        cpiv p = Ap $ Max . horSize <$> collidePointIndirect cpos p wos
+--        rv = rotateV camRot (V2 1 0)
-        horSize = abs . dotV rv . (-.- cpos)
+--    valueAtWidth h  = cpih (cpos +.+ x) <> cpih (cpos -.- x)
-        rv = rotateV camRot (V2 1 0)
+--      where
-    valueAtWidth h  = cpih (cpos +.+ x) <> cpih (cpos -.- x)
+--        x = rotateV camRot $ V2 h maxViewDistance
-      where
+--        cpih p = Ap $ Max . verSize <$> collidePointIndirect cpos p wos
-        x = rotateV camRot $ V2 h maxViewDistance
+--        verSize = abs . dotV rh . (-.- cpos)
-        cpih p = Ap $ Max . verSize <$> collidePointIndirect cpos p wos
+--        rh = rotateV camRot (V2 0 1)
-        verSize = abs . dotV rh . (-.- cpos)
+--viewTestValues :: NEL.NonEmpty Float
-        rh = rotateV camRot (V2 0 1)
+--viewTestValues = NEL.fromList [-maxViewDistance,negate $ 0.75*maxViewDistance..maxViewDistance]
-
-viewTestValues :: NEL.NonEmpty Float
-viewTestValues = NEL.fromList [-maxViewDistance,negate $ 0.75*maxViewDistance..maxViewDistance]
 
 maxViewDistance :: Float
 maxViewDistance = 800

src/Geometry.hs

@@ -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 _ = []