From e30f7a05853fea7e2b7b37df885d075e3108df68 Mon Sep 17 00:00:00 2001
From: justin <justin.g.kruger@gmail.com>
Date: Wed, 15 Jun 2022 14:05:59 +0100
Subject: [PATCH] Add more rooms

---
 src/Dodge/Placement/Instance/LightSource.hs |  6 ++++
 src/Dodge/Room/Containing.hs                | 10 +++----
 src/Dodge/Room/Pillar.hs                    | 33 ++++++++++++++++-----
 src/Dodge/Room/Procedural.hs                |  3 --
 src/Geometry/Vector.hs                      |  3 ++
 5 files changed, 39 insertions(+), 16 deletions(-)

diff --git a/src/Dodge/Placement/Instance/LightSource.hs b/src/Dodge/Placement/Instance/LightSource.hs
index 5646edd42..6f2981be7 100644
--- a/src/Dodge/Placement/Instance/LightSource.hs
+++ b/src/Dodge/Placement/Instance/LightSource.hs
@@ -161,6 +161,12 @@ spanColLightI col h a b = ps0j (PutLS $ lsColPos col (V3 x y (h-5)))
   where
     V2 x y = 0.5 *.* (a +.+ b)
 
+spanColLightBlackI :: Point3 -> Float -> Point2 -> Point2 -> Placement
+spanColLightBlackI col h a b = ps0j (PutLS $ lsColPos col (V3 x y (h-5)))
+    $ sps0 $ PutShape $ colorSH black $ thinHighBar h a b
+  where
+    V2 x y = 0.5 *.* (a +.+ b)
+
 spanLightI :: Point2 -> Point2 -> Placement
 spanLightI = spanColLightI 0.75 50
 
diff --git a/src/Dodge/Room/Containing.hs b/src/Dodge/Room/Containing.hs
index cbd6feced..15083575a 100644
--- a/src/Dodge/Room/Containing.hs
+++ b/src/Dodge/Room/Containing.hs
@@ -21,11 +21,11 @@ roomsContaining crs its = tToBTree "roomsContaining" <$> roomsContaining' crs it
 roomsContaining' :: RandomGen g => [Creature] -> [Item] -> State g (Tree Room)
 roomsContaining' crs its = do
     endroom <- join $ takeOne
-        [roomPillarsSquare
---        [ randomFourCornerRoomCrsIts crs its 
---        , tanksRoom crs its
---        , roomPillarsContaining crs its
---        , roomPillarsPassage <&> rmPmnts .++~ crsItmsUnused crs its
+        [ roomPillarsSquare <&> rmPmnts .++~ crsItmsUnused crs its
+        , randomFourCornerRoomCrsIts crs its 
+        , tanksRoom crs its
+        , roomPillarsContaining crs its
+        , roomPillarsPassage <&> rmPmnts .++~ crsItmsUnused crs its
         ]
     return (pure $ cleatOnward endroom)
 
diff --git a/src/Dodge/Room/Pillar.hs b/src/Dodge/Room/Pillar.hs
index 79c3af878..e4015a0db 100644
--- a/src/Dodge/Room/Pillar.hs
+++ b/src/Dodge/Room/Pillar.hs
@@ -1,4 +1,5 @@
 module Dodge.Room.Pillar where
+import Dodge.Placement.Instance.LightSource
 import Dodge.Data
 import Dodge.Cleat
 import Dodge.PlacementSpot
@@ -10,9 +11,10 @@ import Dodge.Room.Procedural
 import Dodge.Room.Link
 import Geometry
 import LensHelp
+import RandomHelp
 
-import Control.Monad.State
-import System.Random
+--import Control.Monad.State
+--import System.Random
 import qualified Data.Set as S
 
 blockPillar :: Float -> Float -> Placement
@@ -42,12 +44,27 @@ crossPillar w' h' = ps0jPushPS (aline (V2 (-w) 0) (V2 w 0))
 
 roomPillarsSquare :: RandomGen g => State g Room
 roomPillarsSquare = do
-    h <- state $ randomR (300,300)
-    w <- state $ randomR (300,400)
-    let rm = roomRectAutoLinks w h
-        nlew = _numLinkEW (_rmType rm)
-        nlns = _numLinkNS (_rmType rm)
-    return $ rm & rmPmnts .++~ concatMap (replicate nlew . makepill) [South,North]
+    let rm' = roomRectAutoLinks 300 300
+        nlew = _numLinkEW (_rmType rm')
+        nlns = _numLinkNS (_rmType rm')
+    addlights <- takeOne 
+        [ return . set rmPmnts [mntLS vShape 
+            (rotateVAround (V2 150 150) a (V2 30 30)) 
+            (onXY (rotateVAround (V2 150 150) a) $ V3 60 60 95) 
+                | a <- [0,pi/2,pi,3*pi/2] ]
+        , return . set rmPmnts [mntLS vShape 
+            (rotateVAround (V2 150 150) a (V2 150 0)) 
+            (onXY (rotateVAround (V2 150 150) a) $ V3 150 20 95) 
+                | a <- [0,pi/2,pi,3*pi/2] ]
+        , addGirderLights . set rmPmnts []
+        , return . (rmPmnts .++~ 
+                [ spanColLightBlackI 0.75 95 (V2 0 130) (V2 300 130)
+                , spanColLightBlackI 0.75 95 (V2 0 170) (V2 300 170)
+                ,mntLightLnkCond $ resetPLUse $ rprBool $ \rp _ -> isOutLnk rp
+                ] )
+        ]
+    rm <- addlights rm'
+    shuffleLinks $ rm & rmPmnts .++~ concatMap (replicate nlew . makepill) [South,North]
         ++ concatMap (replicate nlns . makepill) [East,West]
   where
     makepill edge = sps (rprBool $ \rp _ -> t edge rp) smallPillar
diff --git a/src/Dodge/Room/Procedural.hs b/src/Dodge/Room/Procedural.hs
index e5569d6f5..afa6f06de 100644
--- a/src/Dodge/Room/Procedural.hs
+++ b/src/Dodge/Room/Procedural.hs
@@ -72,7 +72,6 @@ roomRect x y xn yn = defaultRoom
         }
     }
   where 
-    roomposat onoffpath p = RoomPos p 0 (S.singleton onoffpath) NotLink 0
     yd = (y - 40) / fromIntegral yn
     xd = (x - 40) / fromIntegral xn
     somelnks poffset ps a = zip (map (+.+ poffset) ps) (repeat a)
@@ -96,8 +95,6 @@ roomRect x y xn yn = defaultRoom
         ]
     posps' = map (over _1 (+.+ V2 20 20)) $ gridPoints'' xd (xn+1) yd (xn+1)
     interposps' = map (over _1 (+.+ V2 (20 + xd/2) (20 + yd/2))) $ gridPoints'' xd xn yd yn
-    posps = map (+.+ V2 20 20) $ gridPoints xd (xn+1) yd (yn+1)
-    interposps = map (+.+ V2 (20 + xd/2) (20 + yd/2)) $ gridPoints xd xn yd yn
     makeoffpos (p,a) = RoomPos p 0 (S.singleton $ RoomPosOffPath $ makerpedges' a) NotLink 0
     makerpedges' (a,b) = S.fromList 
         [PathFromEdge South b
diff --git a/src/Geometry/Vector.hs b/src/Geometry/Vector.hs
index b394a76f3..27d43409c 100644
--- a/src/Geometry/Vector.hs
+++ b/src/Geometry/Vector.hs
@@ -90,6 +90,9 @@ rotateV r (V2 x y) = V2
     (x * cos r - y * sin r)
     (x * sin r + y * cos r)
 {-# INLINE rotateV #-}
+rotateVAround :: Point2 -> Float -> Point2 -> Point2
+rotateVAround p r q = rotateV r (q -.- p) +.+ p
+{-# INLINE rotateVAround #-}
 -- | Convert degrees to radians
 degToRad :: Float -> Float
 degToRad d = d * pi / 180