Refactor, try to limit dependencies

src/Dodge/Room/Foreground.hs

@@ -1,60 +1,65 @@
---{-# LANGUAGE TupleSections #-}
-module Dodge.Room.Foreground 
-    ( thinHighBar
-    , putShape
-    , girder
-    , girderZ
-    , girderV
-    , girderV'
-    , barPP
-    , highDiagonalMesh
-    , highMesh
-    ) where
-import Dodge.Data
-import Picture
-import Geometry
-import Shape
-import Quaternion
-import Bound
+module Dodge.Room.Foreground (
+    thinHighBar,
+    putShape,
+    girder,
+    girderZ,
+    girderV,
+    girderV',
+    barPP,
+    highDiagonalMesh,
+    highMesh,
+) where
 
---import Dodge.Data.ForegroundShape
-import Dodge.Default.Foreground
+import Bound
+import Control.Lens
 import Data.List
 import Data.Maybe
-import Control.Lens
+import Dodge.Data.GenWorld
+import Dodge.Default.ForegroundShape
+import Geometry
+import Picture
+import Quaternion
+import Shape
 import ShapePicture
 import Streaming
 import qualified Streaming.Prelude as S
 
-highMesh
-    :: Point2 
-    -> Point2 
-    -> Float    -- ^ width
-    -> Picture
-highMesh pa pb w = highDiagonalMesh pa pb w 20
-    <> highDiagonalMesh (pa +.+ w *.* normalizeV (vNormal (pb -.- pa))) pa (dist pa pb) 20
+highMesh ::
+    Point2 ->
+    Point2 ->
+    -- | width
+    Float ->
+    Picture
+highMesh pa pb w =
+    highDiagonalMesh pa pb w 20
+        <> highDiagonalMesh (pa +.+ w *.* normalizeV (vNormal (pb -.- pa))) pa (dist pa pb) 20
 
-highDiagonalMesh
-    :: Point2 
-    -> Point2 
-    -> Float    -- ^ width
-    -> Float    -- ^ vertical distance between lines
-    -> Picture
-highDiagonalMesh pa pb w d = setDepth 100 $ pictures $
-    map (thickLine 2 . tflat2) (diagonalLinesRect pb pa w d (3*pi/4))
-    ++ 
-    map (thickLine 2 . tflat2) (diagonalLinesRect pb pc (negate h) d (pi/4))
+highDiagonalMesh ::
+    Point2 ->
+    Point2 ->
+    -- | width
+    Float ->
+    -- | vertical distance between lines
+    Float ->
+    Picture
+highDiagonalMesh pa pb w d =
+    setDepth 100 $
+        pictures $
+            map (thickLine 2 . tflat2) (diagonalLinesRect pb pa w d (3 * pi / 4))
+                ++ map (thickLine 2 . tflat2) (diagonalLinesRect pb pc (negate h) d (pi / 4))
   where
     pc = pb +.+ w *.* normalizeV (vNormal (pb -.- pa))
     h = dist pa pb
 
-diagonalLinesRect 
-    :: Point2 
-    -> Point2 
-    -> Float    -- ^ width
-    -> Float    -- ^ vertical distance between lines
-    -> Float
-    -> [(Point2,Point2)]
+diagonalLinesRect ::
+    Point2 ->
+    Point2 ->
+    -- | width
+    Float ->
+    -- | vertical distance between lines
+    Float ->
+    Float ->
+    [(Point2, Point2)]
 diagonalLinesRect pa pb w d ang = zip lhsPoints $ map findDiPoint lhsPoints
   where
     xVec = negate w *.* vNormal (normalizeV $ pb -.- pa)
@@ -62,11 +67,13 @@ diagonalLinesRect pa pb w d ang = zip lhsPoints $ map findDiPoint lhsPoints
     pax = pa +.+ xVec
     pbx = pb +.+ xVec
     lhsPoints = divideLineExact d (pa -.- yN) (pb +.+ yN)
-    findDiPoint p = head . sortOn (dist p) $ catMaybes 
-        [intersectLineLine' p (p +.+ diVec) pax pbx
-        ,intersectSegLine pa pax p (p +.+ diVec)
-        ,intersectSegLine pb pbx p (p +.+ diVec)
-        ]
+    findDiPoint p =
+        head . sortOn (dist p) $
+            catMaybes
+                [ intersectLineLine' p (p +.+ diVec) pax pbx
+                , intersectSegLine pa pax p (p +.+ diVec)
+                , intersectSegLine pb pbx p (p +.+ diVec)
+                ]
     yN = d * 0.5 *.* normalizeV (pa -.- pb)
 
 thinHighBar :: Float -> Point2 -> Point2 -> Shape
@@ -82,8 +89,12 @@ thinHighBar = highBar 3
 --thickHighBar = highBar 5
 
 highBar :: Float -> Float -> Point2 -> Point2 -> Shape
-highBar thickness h x y = translateSHz h $ colorSH orange $ upperPrismPoly thickness
-    [x +.+ n, y +.+ n, y -.- n, x -.- n]
+highBar thickness h x y =
+    translateSHz h $
+        colorSH orange $
+            upperPrismPoly
+                thickness
+                [x +.+ n, y +.+ n, y -.- n, x -.- n]
   where
     n = 0.5 * thickness *.* normalizeV (vNormal (y -.- x))
 
@@ -95,16 +106,23 @@ highBar thickness h x y = translateSHz h $ colorSH orange $ upperPrismPoly thick
 --    n2 = 1.25 *.* normalizeV (vNormal (y -.- x))
 --    n = 2.5 *.* normalizeV (vNormal (y -.- x))
 
-girderZ 
-    :: Float -- ^ height
-    -> Float -- ^ distance between cross bars
-    -> Float -- ^ width
-    -> Point2 -> Point2 -> Shape
-girderZ h d w x y = colorSH red $ mconcat $
-    [ thinHighBar h xt yt
-    , thinHighBar h xb yb
-    ]
-    <> zipWith (thinHighBar (h- 1)) ps qs
+girderZ ::
+    -- | height
+    Float ->
+    -- | distance between cross bars
+    Float ->
+    -- | width
+    Float ->
+    Point2 ->
+    Point2 ->
+    Shape
+girderZ h d w x y =
+    colorSH red $
+        mconcat $
+            [ thinHighBar h xt yt
+            , thinHighBar h xb yb
+            ]
+                <> zipWith (thinHighBar (h - 1)) ps qs
   where
     n = w *.* normalizeV (vNormal $ y -.- x)
     xb = x +.+ n
@@ -115,10 +133,12 @@ girderZ h d w x y = colorSH red $ mconcat $
     qs = tail $ divideLineExact d xt yt
 
 putShape :: Shape -> PSType
-putShape sh = PutForeground $ defaultForeground
-    & fsPos .~ m
-    & fsRad .~ radBounds bnds
-    & fsSPic .~ noPic (uncurryV translateSHf (-m) sh)
+putShape sh =
+    PutForeground $
+        defaultForeground
+            & fsPos .~ m
+            & fsRad .~ radBounds bnds
+            & fsSPic .~ noPic (uncurryV translateSHf (- m) sh)
   where
     bnds = shapeBounds sh
     m = midBounds bnds
@@ -126,43 +146,56 @@ putShape sh = PutForeground $ defaultForeground
 shapePoints :: Shape -> Stream (Of Point2) Identity ()
 shapePoints = S.each . concatMap (map (stripZ . _svPos) . _shVs)
 
-shapeBounds :: Shape -> (Float,Float,Float,Float)
-shapeBounds = fromMaybe (0,0,0,0) . boundPoints . shapePoints
+shapeBounds :: Shape -> (Float, Float, Float, Float)
+shapeBounds = fromMaybe (0, 0, 0, 0) . boundPoints . shapePoints
 
-midBounds :: (Float,Float,Float,Float) -> Point2
-midBounds (n,s,e,w) = V2 ((n + s)/2) ((e + w)/2)
+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
+radBounds :: (Float, Float, Float, Float) -> Float
+radBounds (n, s, e, w) = max (n - s) (e - w) / 2
 
-girderV'
-    :: Float -- ^ height
-    -> Float -- ^ distance between cross bars
-    -> Float -- ^ width
-    -> Point2 -> Point2 -> ForegroundShape
-girderV' h d w x y = defaultForeground
-    & fsPos .~ m
-    & fsRad .~ dist m x
-    & fsSPic .~ noPic sh
+girderV' ::
+    -- | height
+    Float ->
+    -- | distance between cross bars
+    Float ->
+    -- | width
+    Float ->
+    Point2 ->
+    Point2 ->
+    ForegroundShape
+girderV' h d w x y =
+    defaultForeground
+        & fsPos .~ m
+        & fsRad .~ dist m x
+        & fsSPic .~ noPic sh
   where
     m = midPoint x y
     x' = x - m
     y' = y - m
-    sh = thinHighBar h (x' -.- n) (x' +.+ n)
-        <> thinHighBar h (y' -.- n) (y' +.+ n)
-        <> girderV h d w x' y'
+    sh =
+        thinHighBar h (x' -.- n) (x' +.+ n)
+            <> thinHighBar h (y' -.- n) (y' +.+ n)
+            <> girderV h d w x' y'
     n = min (w + 10) 20 *.* vNormal (normalizeV (x' -.- y'))
 
-girderV 
-    :: Float -- ^ height
-    -> Float -- ^ distance between cross bars
-    -> Float -- ^ width
-    -> Point2 -> Point2 -> Shape
-girderV h d w x y = mconcat $
-    [ thinHighBar h xt yt
-    , thinHighBar h xb yb
-    ]
-    <> zipWith (thinHighBar (h- 1)) ps qs
+girderV ::
+    -- | height
+    Float ->
+    -- | distance between cross bars
+    Float ->
+    -- | width
+    Float ->
+    Point2 ->
+    Point2 ->
+    Shape
+girderV h d w x y =
+    mconcat $
+        [ thinHighBar h xt yt
+        , thinHighBar h xb yb
+        ]
+            <> zipWith (thinHighBar (h - 1)) ps qs
   where
     n = w *.* normalizeV (vNormal $ y -.- x)
     xb = x +.+ n
@@ -170,22 +203,28 @@ girderV h d w x y = mconcat $
     xt = x -.- n
     yt = y -.- n
     ps = evenDouble $ divideLineExact d xb yb
-    qs = head qs' : evenDouble(tail qs')
+    qs = head qs' : evenDouble (tail qs')
       where
         qs' = divideLineExact d xt yt
-    evenDouble (a:_:xs) = a:a:evenDouble xs
+    evenDouble (a : _ : xs) = a : a : evenDouble xs
     evenDouble xs = xs
 
-girder
-    :: Float -- ^ height
-    -> Float -- ^ distance between cross bars
-    -> Float -- ^ width
-    -> Point2 -> Point2 -> Shape
-girder h d w x y = mconcat $
-    [ thinHighBar h xt yt
-    , thinHighBar h xb yb
-    ]
-    <> zipWith (thinHighBar (h- 1)) ps qs
+girder ::
+    -- | height
+    Float ->
+    -- | distance between cross bars
+    Float ->
+    -- | width
+    Float ->
+    Point2 ->
+    Point2 ->
+    Shape
+girder h d w x y =
+    mconcat $
+        [ thinHighBar h xt yt
+        , thinHighBar h xb yb
+        ]
+            <> zipWith (thinHighBar (h - 1)) ps qs
   where
     n = w *.* normalizeV (vNormal $ y -.- x)
     xb = x +.+ n
@@ -196,11 +235,12 @@ girder h d w x y = mconcat $
     qs = divideLineExact d xt yt
 
 barPP :: Float -> Point3 -> Point3 -> Shape
-barPP w a b 
+barPP w a b
     | a == b = mempty
-    | otherwise = prismPoly
-        (map ((+.+.+ a) . rotateToZ z1 . addZ 0) $ polyCirc 2 w)
-        (map ((+.+.+ b) . rotateToZ z1 . addZ 0) $ polyCirc 2 w)
+    | otherwise =
+        prismPoly
+            (map ((+.+.+ a) . rotateToZ z1 . addZ 0) $ polyCirc 2 w)
+            (map ((+.+.+ b) . rotateToZ z1 . addZ 0) $ polyCirc 2 w)
   where
     z1 = b -.-.- a
 
@@ -210,11 +250,11 @@ barPP w a b
 --    (map ((+.+.+ b) . rotateToZ z1 . addZ 0) $ polyCirc 4 w)
 --  where
 --    z1 = b -.-.- a
-    
+
 --tankTopPipe :: Shape
---tankTopPipe = colorSH orange $ 
+--tankTopPipe = colorSH orange $
 --    upperPrismPoly 31 (polyCirc 4 20)
---    <> prismPoly 
+--    <> prismPoly
 --        (map (addZ 41) $ polyCirc 4 5)
 --        (map (addZ 31) $ polyCirc 4 20)
 ----    <> pipePP 5 (V3 0 0 51) (V3 0 0 41)