Abstract out block placement

src/Dodge/Room/Airlock.hs

@@ -31,7 +31,7 @@ airlock0 = defaultRoom
                 $ \_ _ -> Just $ putDoubleDoor thewall (cond' btid) (V2 0 80) (V2 40 80) 2
         , invisibleWall $ rectNSWE 60 40 (-40) (-30)
         ,spanLightI (V2 (-2) 30) (V2 (-2) 70)
-        ,sps0 $ PutShape $ thinHighBar 75 (V2 40 50) (V2 (-1) 50)
+        ,sps0 $ putShape $ thinHighBar 75 (V2 40 50) (V2 (-1) 50)
         ]
     , _rmBound = [rectNSWE 75 15 0 40,switchcut]
     }

src/Dodge/Room/Foreground.hs

@@ -1,11 +1,12 @@
 --{-# LANGUAGE TupleSections #-}
 module Dodge.Room.Foreground where
+import Dodge.Data
 import Picture
 import Geometry
 import Shape
 import Quaternion
 
-import Dodge.Data.ForegroundShape
+--import Dodge.Data.ForegroundShape
 import Dodge.Default.Foreground
 import Data.List
 import Data.Maybe
@@ -115,6 +116,24 @@ girderVCapLR csize h d w x y = thinHighBar h (x -.- n) (x +.+ n)
   where
     n = csize *.* vNormal (normalizeV (x -.- y))
 
+putShape :: Shape -> PSType
+putShape sh = PutForeground $ defaultForeground
+    & fsPos .~ m
+    & fsRad .~ radBounds bnds
+    & fsSPic .~ noPic (uncurryV translateSHf (-m) $ sh)
+  where
+    bnds = shapeBounds sh
+    m = midBounds bnds
+
+shapeBounds :: Shape -> (Float,Float,Float,Float)
+shapeBounds sh = undefined
+
+midBounds :: (Float,Float,Float,Float) -> Point2
+midBounds (n,s,e,w) = V2 ((n + s)/2) ((e + w)/2)
+
+radBounds :: (Float, Float,Float,Float) -> Float
+radBounds (n,s,e,w) = max (n-s) (e-w) / 2
+
 girderV'
     :: Float -- ^ "cap" size
     -> Float -- ^ height
@@ -123,7 +142,7 @@ girderV'
     -> Point2 -> Point2 -> ForegroundShape
 girderV' csize h d w x y = defaultForeground
     & fsPos .~ m
-    & fsRad .~ dist m x'
+    & fsRad .~ dist m x
     & fsSPic .~ noPic sh
   where
     m = midPoint x y

src/Dodge/Room/LasTurret.hs

@@ -10,24 +10,15 @@ import Dodge.Room.Door
 import Dodge.Room.Corridor
 import Dodge.Room.Link
 import Dodge.Room.Ngon
---import Dodge.Room.Procedural
-import Dodge.Room.Foreground
---import Dodge.Room.RoadBlock
+--import Dodge.Room.Foreground
+import Dodge.Wire
 import Dodge.Placement.Instance
 import Dodge.Placement.Instance.Analyser
 import Dodge.Default.Room
 import Dodge.Item.Consumable
---import Dodge.Machine
---import Dodge.Item.Weapon.Utility
---import Dodge.LevelGen.Data
---import Geometry.Data
 import Geometry
---import Padding
-import Color
-import Shape
 import LensHelp
 import RandomHelp
---import Dodge.SoundLogic
 
 import qualified Data.Set as S
 import Data.Maybe
@@ -39,15 +30,15 @@ cenLasTur = roomNgon 8 200 & rmPmnts .~
     , mntLightLnkCond $ rprBool $ const . isInLnk
     ]
   where
-    covershape = reverse $ rectNSWE 10 (-10) (-20) 20
+    covershape = rectNSWE 10 (-10) (-20) 20
 
 lightSensInsideDoor :: Int -> Room -> Room
 lightSensInsideDoor outplid rm = rm 
-    & rmPmnts .:~ psPt atFstLnkOut 
-        (PutShape $ colorSH yellow $
-        thinHighBar 0 (V2 20 (-1)) (V2 20 (-100))
-        <> thinHighBar 0 (V2 0 (-100)) (V2 20 (-100))
-        <> barPP 1.5 (V3 20 (-1) 0) (V3 20 (-1) 80))
+    & rmPmnts .++~ 
+        [ psPt atFstLnkOut (PutForeground $ floorWire (V2 20 0) (V2 20 (-100)))
+        , psPt atFstLnkOut (PutForeground $ floorWire (V2 0 (-100)) (V2 20 (-100)))
+        , psPt atFstLnkOut (PutForeground $ verticalWire (V2 20 0) 0 80)
+        ]
     & rmOutPmnt .~ [OutPlacement (lasSensLightAboveDoor 10 (atFstLnkOutShiftInward 100)) outplid]
 
 lasSensLightAboveDoor :: Float -> PlacementSpot -> Placement
@@ -61,14 +52,13 @@ lasSensLightAboveDoor wth ps = extTrigLitPos
 lightSensByDoor :: Int -> Room -> Room
 lightSensByDoor outplid rm = rm
     & rmPmnts .++~ 
-        [ psPt atFstLnkOut $ PutShape $ colorSH yellow 
-            $ barPP 1.5 (V3 20 (-1) 0) (V3 20 (-1) 80)
+        [ psPt atFstLnkOut $ PutForeground $ verticalWire (V2 20 0) 0 80
         , heightWallPS (atNthLnkOutShiftInward 1 100) 30 covershape
         , heightWallPS (atFstLnkOutShiftInward 100)   30 covershape
         ]
     & rmOutPmnt .~ [OutPlacement (lasSensLightAboveDoor 20 (atFstLnkOutShiftBy sensorshift)) outplid]
   where
-    covershape = reverse $ rectNSWE 10 (-10) (-20) 20
+    covershape = rectNSWE 10 (-10) (-20) 20
     sensorshift (p,a) = (p +.+ rotateV a (V2 60 (-20)), a)
 
 keyCardRoomRunPast :: RandomGen g => Int -> Int -> State g (MetaTree Room String)
@@ -90,8 +80,7 @@ healthAnalyserByDoor = analyserByDoor (RequireHealth 1100)
 analyserByDoor :: ProximityRequirement -> Int -> Room -> Room
 analyserByDoor proxreq outplid rm = rm 
     & rmPmnts .++~ 
-        [ psPt atFstLnkOut $ PutShape $ colorSH yellow 
-            $ barPP 1.5 (V3 20 (-1) 0) (V3 20 (-1) 80)
+        [ psPt atFstLnkOut $ PutForeground $ verticalWire (V2 20 0) 0 80
         ]
     & rmOutPmnt .~ 
         [OutPlacement 

src/Dodge/Room/SensorDoor.hs

@@ -8,6 +8,7 @@ import Dodge.Placement.Instance.Terminal
 import Dodge.Terminal
 import Dodge.Data
 import Dodge.Tree
+import Dodge.Wire
 --import Dodge.RoomLink
 import Dodge.Room.Door
 import Dodge.Room.Ngon
@@ -80,11 +81,9 @@ sensInsideDoor :: DamageType -> Int -> Room -> Room
 sensInsideDoor senseType outplid rm = rm
     & rmName .++~ take 4 (show senseType)
     & rmPmnts .++~ 
-        [ psPt atFstLnkOut 
-            (PutShape $ colorSH yellow $
-            thinHighBar 0 (V2 20 (-1)) (V2 20 (-100))
-            <> thinHighBar 0 (V2 0 (-100)) (V2 20 (-100))
-            <> barPP 1.5 (V3 20 (-1) 0) (V3 20 (-1) 80))
+        [ psPt atFstLnkOut . PutForeground $ floorWire (V2 20 0) (V2 20 (-100))
+        , psPt atFstLnkOut . PutForeground $ floorWire (V2 0 (-100)) (V2 20 (-100))
+        , psPt atFstLnkOut . PutForeground $ verticalWire (V2 20 0) 0 80
         , putTerminal terminalColor (basicTerminal & tmScrollCommands .:~ damageCodeCommand)
             & plSpot .~ rprBoolShift isUnusedLnk (shiftInBy 10)
         ]