Cleanup and various bugfixes

src/Dodge/Layout.hs

@@ -149,23 +149,31 @@ wallsFromRooms =
   where
     f i (x,y) = (i, defaultWall {_wlLine = (x,y) , _wlID = i})
 
+-- TODO sort out shifting before or after etc
 gameRoomsFromRooms :: [Room] -> [GameRoom]
-gameRoomsFromRooms = map f
+gameRoomsFromRooms = map gameRoomFromRoom
+
+gameRoomFromRoom :: Room -> GameRoom
+gameRoomFromRoom rm = GameRoom
+    { _grViewpoints = _rmViewpoints rm ++ (map fst . foldl' (flip cutWalls) [] $ _rmPolys rm)
+--       ++ map fst (_rmLinks rm)
+    , _grViewpointsEx = mapMaybe unpos (_rmPos rm)
+    , _grBound = expandPolyCorners 50 . convexHullSafe . nubBy closePoints 
+        . concat $ _rmBound rm ++ _rmPolys rm
+    , _grDir   = getDir $ _rmPos rm
+    , _grLinkDirs = mapMaybe undir $ _rmPos rm
+    , _grName  = _rmName rm
+    }
   where
-    f rm = GameRoom
-        { _grViewpoints = _rmViewpoints rm ++ (map fst . foldl' (flip cutWalls) [] $ _rmPolys rm)
-            ++ map fst (_rmLinks rm)
-        , _grViewpointsEx = mapMaybe unpos (_rmPos rm)
-        , _grBound = expandPolyByFixed 100 . convexHullSafe . nubBy closePoints 
-            . concat $ _rmBound rm ++ _rmPolys rm
-        , _grDir   = getDir $ _rmPos rm
-        , _grName  = _rmName rm
-        }
-    closePoints x y = roundPoint2 x == roundPoint2 y
-    unpos (OutLink _ p _) = Just p
-    unpos (InLink  p _) = Just p
+    doshift = shiftPointBy (_rmShift rm)
+    unpos (OutLink _ p _) = Just $ doshift p
+    unpos (InLink    p _) = Just $ doshift p
     unpos _ = Nothing
-    getDir (InLink _ a:_) = a
+    undir (OutLink _ _ a) = Just $ 0.5*pi + a + snd (_rmShift rm)
+    undir (InLink    _ a) = Just $ 0.5*pi + a + snd (_rmShift rm)
+    undir _ = Nothing
+    closePoints x y = roundPoint2 x == roundPoint2 y
+    getDir (InLink _ a:_) = a -- + snd (_rmShift rm)
     getDir (_:xs) = getDir xs
     getDir _ = 0 -- fallback