From 02adb0a915c6a39d5bc4add0b65c1393833e4bce Mon Sep 17 00:00:00 2001
From: justin <justin.g.kruger@gmail.com>
Date: Sat, 19 Mar 2022 23:12:53 +0000
Subject: [PATCH] Tweak automatic girder placement

---
 src/Dodge/Room/Foreground.hs    | 23 +++++++++++++++++++++++
 src/Dodge/Room/Modify/Girder.hs |  6 +++---
 2 files changed, 26 insertions(+), 3 deletions(-)

diff --git a/src/Dodge/Room/Foreground.hs b/src/Dodge/Room/Foreground.hs
index 457d11307..de02ff095 100644
--- a/src/Dodge/Room/Foreground.hs
+++ b/src/Dodge/Room/Foreground.hs
@@ -88,6 +88,29 @@ girderZ h d w x y = colorSH red $ mconcat $
     ps = divideLineExact d xb yb
     qs = tail $ divideLineExact d xt yt
 
+girderVCapL
+    :: Float -- ^ "cap" size
+    -> Float -- ^ height
+    -> Float -- ^ distance between cross bars
+    -> Float -- ^ width
+    -> Point2 -> Point2 -> Shape
+girderVCapL csize h d w x y = thinHighBar h (x -.- n) (x +.+ n)
+    <> girderV h d w x y
+  where
+    n = csize *.* vNormal (normalizeV (x -.- y))
+
+girderVCapLR
+    :: Float -- ^ "cap" size
+    -> Float -- ^ height
+    -> Float -- ^ distance between cross bars
+    -> Float -- ^ width
+    -> Point2 -> Point2 -> Shape
+girderVCapLR csize h d w x y = thinHighBar h (x -.- n) (x +.+ n)
+    <> thinHighBar h (y -.- n) (y +.+ n)
+    <> girderV h d w x y
+  where
+    n = csize *.* vNormal (normalizeV (x -.- y))
+
 girderV 
     :: Float -- ^ height
     -> Float -- ^ distance between cross bars
diff --git a/src/Dodge/Room/Modify/Girder.hs b/src/Dodge/Room/Modify/Girder.hs
index 0db325ce5..c1a98da31 100644
--- a/src/Dodge/Room/Modify/Girder.hs
+++ b/src/Dodge/Room/Modify/Girder.hs
@@ -109,13 +109,13 @@ addGirderLights rm = do
         midw = wiToFloat rm midi
         extragirderpos = nub $ map (\(wi,hi) -> (wi - midi, hi)) lpis
         extragirders = mapMaybe (\(i,hi) -> case i of
-            x | x < 0 -> Just $ girderV 96 20 10 (V2 (midw - 10) (hiToFloat rm hi)) 
+            x | x < 0 -> Just $ girderVCapL 20 96 20 10 (V2 (midw - 10) (hiToFloat rm hi)) 
                                                 (V2 0 (hiToFloat rm hi))
-            x | x > 0 -> Just $ girderV 96 20 10 (V2 (midw + 10) (hiToFloat rm hi)) 
+            x | x > 0 -> Just $ girderVCapL 20 96 20 10 (V2 (midw + 10) (hiToFloat rm hi)) 
                                                 (V2 w (hiToFloat rm hi))
             _ -> Nothing
             ) extragirderpos
     return $ rm & rmPmnts .++~ 
-        (sps0 (PutShape $ colorSH black $ girderV 96 20 10 (V2 midw 0) (V2 midw h))
+        (sps0 (PutShape $ colorSH black $ girderVCapLR 20 96 20 10 (V2 midw 0) (V2 midw h))
         : map (\p -> sps (PS p 0) (PutLS $ lsColPos 0.75 (V3 0 0 90))) lps
         ) ++ map (sps0 . PutShape . colorSH black) extragirders