Allow to log position of placement spot

src/Dodge/Room/Warning.hs

@@ -1,15 +1,19 @@
 --{-# LANGUAGE TupleSections #-}
-module Dodge.Room.Warning (warningRooms,addDoorToggleTerminal
-    , addDoorAtNthLinkToggleTerminal) where
+module Dodge.Room.Warning (
+    warningRooms,
+    addDoorToggleTerminal,
+    addDoorAtNthLinkToggleTerminal,
+) where
 
-import Control.Monad
-import Dodge.Default.Terminal
-import Dodge.Data.BlBl
 import Color
+import Control.Monad
 import qualified Data.Map.Strict as M
 import Data.Maybe
+import qualified Data.Set as S
 import Dodge.Cleat
+import Dodge.Data.BlBl
 import Dodge.Data.GenWorld
+import Dodge.Default.Terminal
 import Dodge.Placement.Instance
 import Dodge.PlacementSpot
 import Dodge.Room.Door
@@ -34,32 +38,37 @@ addDoorToggleTerminal :: [TerminalLine] -> Int -> Room -> Room
 addDoorToggleTerminal = addDoorAtNthLinkToggleTerminal 0
 
 addDoorAtNthLinkToggleTerminal :: Int -> [TerminalLine] -> Int -> Room -> Room
-addDoorAtNthLinkToggleTerminal j xs i = (rmName .++~ "doorToggle-")
---        . (rmOutPmnt . at i ?~ outplace)
+addDoorAtNthLinkToggleTerminal j xs i =
+    (rmName .++~ "doorToggle-")
+        --        . (rmOutPmnt . at i ?~ outplace)
         . (rmPmnts .:~ outplace)
   where
     outplace =
         extTrigLitPos
-            (atNthLnkOutShiftBy j  (\(p, a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a)))
-            ( Just . set plSpot (rprShift (moveToSideNthOutLink j))
+            (atNthLnkOutShiftBy j (\(p, a) -> ((p +.+ rotateV a (V2 18.5 (-2.5)), a), S.singleton UsedPosLow)))
+            ( Just . set plSpot (rprShift (moveToSideNthOutLink (S.singleton UsedPosLow) j))
                 . putMessageTerminal terminalColor
                 . termMessages
-            ) & plExternalID ?~ i
+            )
+            & plExternalID
+            ?~ i
     termMessages trpl =
         lineOutputTerminal xs --(makeColorTermLine red "WARNING" : makeTermPara str)
-            & tmToggles .~ M.fromList
+            & tmToggles
+                .~ M.fromList
                     [("DOOR", TerminalToggle (fromJust $ _plMID trpl) (BlConst True))]
 
-
 addWarningTerminal :: String -> Int -> Room -> Room
-addWarningTerminal str = addDoorToggleTerminal 
-    (makeColorTermLine red "WARNING" : makeTermPara str)
+addWarningTerminal str =
+    addDoorToggleTerminal
+        (makeColorTermLine red "WARNING" : makeTermPara str)
 
 lineOutputTerminal :: [TerminalLine] -> Terminal
 lineOutputTerminal tls = defaultTerminal & tmBootLines .~ textInputBlurb tls
 
-moveToSideNthOutLink :: Int -> RoomPos -> Room -> Maybe (Point2, Float)
-moveToSideNthOutLink i rp rm = do
+moveToSideNthOutLink :: S.Set UsedPos
+    -> Int -> RoomPos -> Room -> Maybe ((Point2, Float), S.Set UsedPos)
+moveToSideNthOutLink xs i rp rm = do
     j <- rp ^? rpLinkStatus . rplsChildNum
     guard $ i == j
     let rppos = _rpPos rp
@@ -67,11 +76,12 @@ moveToSideNthOutLink i rp rm = do
         inpos = rppos +.+ rotateV rpdir (V2 0 (-12.5))
         rtpos = inpos +.+ rotateV rpdir (V2 30 0)
         ltpos = inpos +.+ rotateV rpdir (V2 (-30) 0)
-    return $ if any (isJust . intersectSegPolyFirst inpos ltpos) (_rmPolys rm)
+    return $
+        if any (isJust . intersectSegPolyFirst inpos ltpos) (_rmPolys rm)
             then -- the above test may not work properly if the room polys are
             -- complicated, it should really use created walls...
-                 (rtpos, rpdir)
-            else  (ltpos, rpdir)
+                ((rtpos, rpdir), xs)
+            else ((ltpos, rpdir), xs)
 
 --moveToSideFirstOutLink :: RoomPos -> Room -> Maybe (Point2, Float)
 --moveToSideFirstOutLink rp rm = do