Fix bug in detecting which room you are in

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

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