Add possible cosmetic pipes to tanks

src/Dodge/Placement/Instance/Pipe.hs

@@ -1,5 +1,12 @@
 module Dodge.Placement.Instance.Pipe where
 import Shape
+import Geometry
+import Quaternion
 
 verticalPipe :: Float -> Shape
-verticalPipe = flip upperPrismPoly $ polyCirc  4 5
+verticalPipe = flip upperPrismPoly $ polyCirc 2 5
+
+horPipe :: Float -> Point2 -> Point2 -> Shape
+horPipe h x y = translateSH (x `v2z` h) $ overPosSH (rotateToZ (V3 xd yd 0)) $ verticalPipe (dist x y)
+  where
+    V2 xd yd = x -.- y

src/Dodge/Placement/Instance/Tank.hs

@@ -26,7 +26,7 @@ tankShape baseshape facade col col'
     = sps0 $ PutBlock bl wl $ reverse baseshape
   where
     bl = defaultBlock
-        & blDraw .~ (\bl' -> (noPic $ uncurryV translateSHf (_blPos bl') $ rotateSH (_blRot bl') $ colorSH col (upperPrismPoly 31 $ reverse baseshape) <> facade col col'))
+        & blDraw .~ const (noPic $ colorSH col (upperPrismPoly 31 $ reverse baseshape) <> facade col col')
         & blDeath .~ const id
     wl = defaultWall 
         & wlDraw .~ False 

src/Dodge/Placement/PlaceSpot.hs

@@ -103,7 +103,7 @@ placeSpotID ps pt w = case pt of
     PutCoord    cp          -> plNewID   coordinates (doShift cp) w
     PutSlideDr  pth col f off  a   b spd 
                             -> plSlideDoor pth col f off (doShift a) (doShift b) spd w
-    PutBlock    bl wl  ps'  -> placeBlock (map doShift ps') (bl & blPos %~ doShift & blRot .~ rot)
+    PutBlock    bl wl  ps'  -> placeBlock (map doShift ps') (bl & blPos %~ doShift & blDir .~ rot)
                                     wl w
     PutLineBlock wl wdth dpth a b -> placeLineBlock wl wdth dpth (doShift a) (doShift b) w
     PutWall     qs  wl      -> (0,placeWallPoly (map doShift qs) wl w)

src/Dodge/Placement/PlaceSpot/Block.hs

@@ -85,7 +85,7 @@ placeLineBlock basePane blockWidth depth a b gw = ( 0
     insertBlock (i,p) = over blocks $ IM.insert (i+blid) Block 
         { _blID = i + blid, _blWallIDs = IS.fromList $ ksAtI i
         , _blHP = 1000, _blShadows = shadowsAt i
-        , _blRot = 0    -- THIS IS NOT SENSIBLE. TODO rethink block positioning
+        , _blDir = 0    -- THIS IS NOT SENSIBLE. TODO rethink block positioning
         , _blFootprint = cornersAt p -- TODO check winding (clockwise, anticlockwise)
         , _blPos = p, _blDraw = const mempty , _blDeath = makeBlockDebris}
     insertBlocks = flip (foldr insertBlock) $ zip is blockCenPs