Make anti-clockwise what were clockwise shapes, cleanup flash module-ing

ghcidOutput

@@ -1 +1 @@
-All good (601 modules, at 00:25:15)
+All good (600 modules, at 00:59:03)

src/Dodge/Button/Draw.hs

@@ -19,9 +19,8 @@ drawSwitch col1 col2 bt
   where
     flick a = noPic
         ( mconcat
-            [ colorSH col1 . upperBox Small Typical 20 $ reverse $ rectNSWE (-2) (-5) (-10) 10
+            [ colorSH col1 . upperBox Small Typical 20 $ rectNSWE (-2) (-5) (-10) 10
             , colorSH col2 . translateSH (V3 0 (-2) 20) . rotateSH a . upperBox Small Typical 2 $
-                reverse $
                     rectNSWE 10 0 (-2) 2
             ]
         )
@@ -32,6 +31,6 @@ defaultDrawButton col bt = noPic
     )
   where
     buttonGeometry
-        | _btState bt == BtOff = reverse $ rectNSWE 10 (-1) (- width) width
+        | _btState bt == BtOff = rectNSWE 10 (-1) (- width) width
-        | otherwise = reverse $ rectNSWE 2 (-1) (- width) width
+        | otherwise = rectNSWE 2 (-1) (- width) width
     width = 8

src/Dodge/Data/LWorld.hs

@@ -112,8 +112,6 @@ data LWorld = LWorld
     , _sparks :: [Spark]
     , _radarBlips :: [RadarBlip]
     , _flares :: [Flare]
---    , _newBeams :: WorldBeams
---    , _beams :: WorldBeams
     , _teslaArcs :: [TeslaArc]
     , _shockwaves :: [Shockwave]
     , _lasers :: [LaserStart]

src/Dodge/EnergyBall/Draw.hs

@@ -47,7 +47,8 @@ drawFlamelet pt =
                 )
             . rotate (negate (rot - 0.1 * fromIntegral time))
             . scale s1 s1
-            $ polygon (rectNSWE siz2 (- siz2) (- siz2) siz2)
+            . polygon 
+            $ reverse (rectNSWE siz2 (- siz2) (- siz2) siz2)
     pi2 =
         setDepth (z + 25)
             . uncurryV translate ep
@@ -60,7 +61,8 @@ drawFlamelet pt =
                 )
             . rotate (negate (rot + 0.2 * fromIntegral time))
             . scale s2 s2
-            $ polygon (rectNSWE siz2 (- siz2) (- siz2) siz2)
+            . polygon 
+            $ (rectNSWE siz2 (- siz2) (- siz2) siz2)
     pic =
         setDepth (z + 20)
             . uncurryV translate ep

src/Dodge/Flare.hs

@@ -1,4 +1,7 @@
-module Dodge.Flare where
+module Dodge.Flare (
+    drawFlare,
+    updateFlare,
+) where
 
 import Dodge.Data.Flare
 import LensHelp

src/Dodge/HeldUse.hs

@@ -23,7 +23,6 @@ import Dodge.LightSource
 import Dodge.Projectile.Create
 import Dodge.SoundLogic
 import Dodge.Tesla.Arc
-import Dodge.WorldEvent.Flash
 import Geometry
 import LensHelp
 import ListHelp
@@ -162,6 +161,36 @@ makeMuzzleFlare mz itmtree cr = case mz ^. mzFlareType of
     pos = _crPos cr + rotateV (_crDir cr) (_mzPos mz + aimingWeaponZeroPos cr itm)
     dir = _crDir cr + _mzRot mz
 
+muzFlareAt :: Color -> Point3 -> Float -> World -> World
+muzFlareAt col tranv dir w =
+    w & randGen .~ g
+        & cWorld . lWorld . flares
+        .:~ MuzFlare
+            { _flarePoly =
+                map
+                    (rotateV dir)
+                    [ V2 0 0
+                    , V2 a (- b)
+                    , V2 c d
+                    ]
+            , _flareColor = col
+            , _flareTran3 = tranv
+            , _flareTime = 2
+            }
+  where
+    thestate = replicateM 4 $ state $ randomR (2,20)
+    (a : b : c : d : _, g) = runState thestate $ _randGen w -- randomRs (2, 20) (_randGen w)
+
+flareCircleAt :: Color -> Float -> Point3 -> World -> World
+flareCircleAt col alphax tranv =
+    cWorld . lWorld . flares
+        .:~ CircFlare
+            { _flareTime = 2
+            , _flareColor = col
+            , _flareAlpha = alphax
+            , _flareTran3 = tranv
+            }
+
 getLaserPhaseV :: LabelDoubleTree ComposeLinkType Item -> Float
 getLaserPhaseV = const 1
 

src/Dodge/Item/Draw/SPic.hs

@@ -44,12 +44,12 @@ itemSPic it = case it ^. itType of
 
 ammoMagSPic :: Item -> AmmoMagType -> SPic
 ammoMagSPic it = \case
-    TINMAG -> noPic $ upperPrismPolyTS 1 (rectNSWE 0 (- y) (-1) 1)
+    TINMAG -> noPic $ upperPrismPolyTS 1 (rectNSWE 0 (- (am * 5)) (-1) 1)
-    DRUMMAG -> noPic $ upperPrismPolyTS 1 (rectNSWE 0 (- y) (-1) 1)
+    DRUMMAG -> noPic $ upperPrismPolyTS 1 (rectNSWE 0 (- (am * 15)) (-1) 1)
     CHEMFUELPOUCH -> noPic $ colorSH yellow (upperPrismPolyST 3 $ polyCirc 3 5)
     BATTERY -> colorSH blue (upperBox Tiny Superfluous 1 (rectNSWE 0 (-2) (-2) 2))
         :!: setLayer BloomNoZWrite (setDepth 2 . color (mixColorsFrac green red am) $ circleSolid 2)
-    _ -> noPic $ upperPrismPolyTS 1 (reverse $ rectNSWE 0 (- y) (-1) 1)
+    _ -> noPic $ upperPrismPolyTS 1 (rectNSWE 0 (- y) (-1) 1)
   where
     y = fromIntegral y' * 0.3
     y' = fromMaybe 0 $ it ^? itUse . amagLoadStatus . iaLoaded
@@ -246,8 +246,8 @@ shatterGunSPic =
     -- TODO cylinderize
     noPic $
         colorSH blue $
-            upperPrismPolyST 5 (rectNESW xb 8 xa 0)
+            upperPrismPolyST 5 (rectNSWE xb xa 0 8)
-                <> upperPrismPolyST 5 (rectNESW (- xa) 8 (- xb) 0)
+                <> upperPrismPolyST 5 (rectNSWE (- xa) (- xb) 0 8)
   where
     xa = 1
     xb = 9
@@ -346,28 +346,17 @@ baseAMRShape :: Shape
 baseAMRShape = colorSH orange $ xCylinderST 3 30
 
 teslaGunPic :: SPic
-teslaGunPic =
+teslaGunPic = shatterGunSPic
-    noPic $
-        colorSH blue $
-            upperPrismPolyST 5 (rectNESW xb 8 xa 0)
-                <> upperPrismPolyST 5 (rectNESW (- xa) 8 (- xb) 0)
-  where
-    xa = 1
-    xb = 9
 
 lasGunPic :: Item -> SPic
 lasGunPic _ =
     colorSH
         blue
-        ( upperBoxST 4 (rectNESW 3 30 1 0)
+        ( upperBoxST 4 (rectNSWE 3 1 0 30)
-            <> upperBoxSU 4 (rectNESW (-1) 30 (-3) 0)
+            <> upperBoxSU 4 (rectNSWE (-1) (-3) 0 30)
-            <> upperBoxSU 1 (rectNESW 3 30 (-3) 0)
+            <> upperBoxSU 1 (rectNSWE 3 (-3) 0 30)
         )
-        :!: (setLayer BloomNoZWrite . color col . setDepth 1.1 . polygon $ rectNESW 1 30 (-1) 0)
+        :!: mempty
-  where
-    --amFrac = fractionLoadedAmmo it
-    amFrac = 0.5
-    col = brightX 2 1.5 $ mixColors amFrac (1 - amFrac) green red
 
 --dualBeamPic :: Item -> SPic
 --dualBeamPic it =

src/Dodge/Lampoid.hs

@@ -4,7 +4,6 @@ import Dodge.Creature.State
 import Dodge.Data.World
 import Dodge.LightSource
 import Dodge.Material.Sound
-import Dodge.WorldEvent.Flash
 import Dodge.WorldEvent.Sound
 import Geometry
 import qualified IntMapHelp as IM
@@ -19,7 +18,7 @@ updateLampoid cr w = case cr ^?! crType . lampLSID of
     Just i
         | _crHP cr < 0 ->
             w
-                & explosionFlashAt cpos
+                & cWorld . lWorld . tempLightSources .:~ tlsTimeRadFunPos 20 150 (TLSFade 1 10) (addZ 20 cpos)
                 & originsIDsAt [MaterialSound Glass n | n <- [0, 1, 2]] (destroyMatS Glass) cpos
                 & cWorld . lWorld . lightSources . at i .~ Nothing
                 & cWorld . lWorld . creatures . at cid .~ Nothing

src/Dodge/LevelGen/Switch.hs

@@ -31,8 +31,8 @@ drawSwitchWire col1 col2 bt
     | otherwise = flick (negate (pi/4))
   where
     flick a = noPic ( mconcat
-        [ colorSH col1 . translateSHz 10 . upperBox Small Typical 10 $ reverse $ rectNSWE (-2) (-5) (-10) 10
+        [ colorSH col1 . translateSHz 10 . upperBox Small Typical 10 $ rectNSWE (-2) (-5) (-10) 10
-        , colorSH col2 . translateSH (V3 0 (-2) 15) . rotateSH a . upperBox Small Typical 2 . reverse 
+        , colorSH col2 . translateSH (V3 0 (-2) 15) . rotateSH a . upperBox Small Typical 2
             $ rectNSWE 10 0 (-2) 2
         ]   
         )

src/Dodge/Placement/PlaceSpot/Block.hs

@@ -69,7 +69,7 @@ plLineBlock basePane blwidth a b gw =
     blockCenPs = snd $ evenOddSplit psOnLine
     numBlocks = length blockCenPs
     is = [0 .. numBlocks - 1]
-    cornerPoints = reverse $ rectWH halfBlockWidth depth -- goes clockwise around the block
+    cornerPoints = rectWH halfBlockWidth depth -- goes clockwise around the block
     cornersAt p = fmap ((p +.+) . rotateV (argV (b -.- a))) cornerPoints
     linesAt p = loopPairs $ cornersAt p
     wlid = IM.newKey $ gw ^. cWorld . lWorld . walls

src/Dodge/Placement/PlaceSpot/Block.hs.orig

@@ -68,7 +68,7 @@ plLineBlock basePane blwidth a b gw = ( 0
     blockCenPs = snd $ evenOddSplit psOnLine
     numBlocks = length blockCenPs
     is = [0.. numBlocks - 1]
-    cornerPoints = reverse $ rectWH halfBlockWidth depth -- goes clockwise around the block
+    cornerPoints = rectWH halfBlockWidth depth -- goes clockwise around the block
     cornersAt p = fmap ( (p +.+) . rotateV (argV (b -.- a)) ) cornerPoints
     linesAt p = loopPairs $ cornersAt p
     wlid = IM.newKey $ _walls gw

src/Dodge/Placement/TopDecoration.hs

@@ -30,7 +30,7 @@ fourEmbossDecoration :: Float -> Float -> Float -> Color -> Color -> Shape
 fourEmbossDecoration w h z _ c = colorSH c $ foldMap f [(w, h), (- w, h), (w, - h), (- w, - h)]
   where
     f (a, b) = translateSH (V3 (a / 2) (b / 2) z) embossing
-    embossing = upperBoxHalf Large Typical 10 $ reverse $ rectNSWE (h / 2) (- h / 2) (- w / 2) (w / 2)
+    embossing = upperBoxHalf Large Typical 10 $ rectNSWE (h / 2) (- h / 2) (- w / 2) (w / 2)
 
 plusDecoration :: Float -> Float -> Float -> Color -> Color -> Shape
 plusDecoration w h z _ c =

src/Dodge/Prop/Draw.hs

@@ -54,16 +54,14 @@ drawLampCover h pr = noPic
                 ]
     )
   where
-    aface ztran s w = translateSHz ztran . upperPrismPoly Small Essential 1
+    aface ztran s w = translateSHz ztran . upperPrismPoly Small Essential 1 $ rectNSWE 3 s w 3
-        . reverse $ rectNSWE 3 s w 3
 
 drawVerticalLampCover :: Float -> Prop -> SPic
 drawVerticalLampCover h pr = noPic
-    ( translateSHz h . uncurryV translateSHxy (_prPos pr) $
+    ( translateSHz h . uncurryV translateSHxy (_prPos pr) .
-        rotateSHx (_prRot pr) $
+        rotateSHx (_prRot pr) .
-            mconcat
+                 translateSHz (-3) . upperPrismPoly Small Essential 1 $ rectNSWE 2 (-2) (-5) 5
-                [ translateSHz (-3) . upperPrismPoly Small Essential 1 $ reverse $ rectNSWE 2 (-2) (-5) 5
+                
-                ]
     )
 
 drawMovingShape :: Prop -> SPic -> SPic
@@ -85,8 +83,8 @@ drawDoubleLampCover h pr = noPic
     ( translateSHz (h -2.5) . uncurryV translateSHxy (_prPos pr) $
         rotateSH (_prRot pr) $
             mconcat
-                [ upperPrismPoly Small Essential 5 $ reverse $ rectNSWE 6 5 (-6) 6
+                [ upperPrismPoly Small Essential 5 $ rectNSWE 6 5 (-6) 6
-                , upperPrismPoly Small Essential 5 $ reverse $ rectNSWE (-5) (-6) (-6) 6
+                , upperPrismPoly Small Essential 5 $ rectNSWE (-5) (-6) (-6) 6
                 , upperPrismPoly Small Essential 1 [V2 0 (-1), V2 6 5, V2 (-6) 5]
                 , upperPrismPoly Small Essential 1 [V2 0 1, V2 (-6) (-5), V2 6 (-5)]
                 ]

src/Dodge/WorldEvent.hs

@@ -1,11 +1,9 @@
 module Dodge.WorldEvent
-    ( module Dodge.WorldEvent.Flash
+    ( module Dodge.WorldEvent.ThingsHit
-    , module Dodge.WorldEvent.ThingsHit
     , module Dodge.WorldEvent.Cloud
     , module Dodge.WorldEvent.Explosion
     , module Dodge.WorldEvent.SpawnParticle
     ) where
-import Dodge.WorldEvent.Flash
 import Dodge.WorldEvent.ThingsHit
 import Dodge.WorldEvent.Cloud
 import Dodge.WorldEvent.Explosion

src/Dodge/WorldEvent/Flash.hs

@@ -1,57 +0,0 @@
-{- | Flashes.
-projected naming conventions: three base types of light:
-glare : Draws color onto surfaces (not done)
-flare : coloured light drawn in space, fixed shapes
-light : removal of shadows (onto surfaces)
-duration (subject to modification):
-flash   : short, abrupt changes in alpha
-glow    : continuous, potentially long, fading, slow changes in alpha
-flicker : potentially long, moving, abrupt changes in alpha
--}
-module Dodge.WorldEvent.Flash (
-    explosionFlashAt,
-    muzFlareAt,
-    flareCircleAt,
-) where
-
-import Dodge.Data.World
-import Dodge.LightSource
-import Control.Monad
-import Geometry
-import LensHelp
-import Picture
-import System.Random
-import Control.Monad.Trans.State.Strict
-
-muzFlareAt :: Color -> Point3 -> Float -> World -> World
-muzFlareAt col tranv dir w =
-    w & randGen .~ g
-        & cWorld . lWorld . flares
-        .:~ MuzFlare
-            { _flarePoly =
-                map
-                    (rotateV dir)
-                    [ V2 0 0
-                    , V2 a (- b)
-                    , V2 c d
-                    ]
-            , _flareColor = col
-            , _flareTran3 = tranv
-            , _flareTime = 2
-            }
-  where
-    thestate = replicateM 4 $ state $ randomR (2,20)
-    (a : b : c : d : _, g) = runState thestate $ _randGen w -- randomRs (2, 20) (_randGen w)
-
-flareCircleAt :: Color -> Float -> Point3 -> World -> World
-flareCircleAt col alphax tranv =
-    cWorld . lWorld . flares
-        .:~ CircFlare
-            { _flareTime = 2
-            , _flareColor = col
-            , _flareAlpha = alphax
-            , _flareTran3 = tranv
-            }
-
-explosionFlashAt :: Point2 -> World -> World
-explosionFlashAt p = cWorld . lWorld . tempLightSources .:~ tlsTimeRadFunPos 20 150 (TLSFade 1 10) (addZ 20 p)

src/Geometry/Polygon.hs

@@ -1,37 +1,36 @@
 {-# LANGUAGE BangPatterns #-}
+
 module Geometry.Polygon where
+
+import qualified Control.Foldl as L
+import Data.Maybe
 import Geometry.Data
 import Geometry.LHS
 import Geometry.Vector
 import ListHelp
 
-import Data.Maybe
---import Data.List
-import qualified Control.Foldl as L
-
--- | Draw an anticlockwise rectangle based on maximal N E S W values.
-rectNESW :: Float -> Float -> Float -> Float -> [Point2]
-rectNESW !a !b !c !d = [V2 b a,V2 b c,V2 d c,V2 d a]
 -- | Draw an anticlockwise rectangle based on maximal N S W E values.
 rectNSWE :: Float -> Float -> Float -> Float -> [Point2]
 rectNSWE !n !s !w !e = [V2 w n, V2 w s, V2 e s, V2 e n]
+
 -- | Draw an anticlockwise rectangle around the origin with given height and width
 rectWH :: Float -> Float -> [Point2]
-rectWH w h = rectNSWE h (-h) (-w) w
+rectWH w h = rectNSWE h (- h) (- w) w
 
 isotriBWH :: Point2 -> Float -> Float -> [Point2]
-isotriBWH (V2 x y) w h = [V2 (x-w) y, V2 (x+w) y, V2 x (y+h)]
+isotriBWH (V2 x y) w h = [V2 (x - w) y, V2 (x + w) y, V2 x (y + h)]
 
 -- trapezion
 trapezionBWHW :: Point2 -> Float -> Float -> Float -> [Point2]
 trapezionBWHW (V2 x y) w1 h w2 =
-    [ V2 (x-w1) y
+    [ V2 (x - w1) y
-    , V2 (x+w1) y
+    , V2 (x + w1) y
-    , V2 (x+w2) (y+h)
+    , V2 (x + w2) (y + h)
-    , V2 (x-w2) (y+h)]
+    , V2 (x - w2) (y + h)
+    ]
 
 rectXH :: Float -> Float -> [Point2]
-rectXH x h = rectNSWE h (-h) 0 x
+rectXH x h = rectNSWE h (- h) 0 x
 
 rectXY :: Float -> Float -> [Point2]
 rectXY x y = rectNSWE y 0 0 x
@@ -43,80 +42,93 @@ mirrorXAxis :: [Point2] -> [Point2]
 mirrorXAxis ps = orderPolygon $ ps ++ mapMaybe f ps
   where
     f (V2 _ 0) = Nothing
-    f (V2 x y) = Just $ V2 x (-y)
+    f (V2 x y) = Just $ V2 x (- y)
 
--- | Test whether a point is in a polygon or on the polygon border.
+{- | Test whether a point is in a polygon or on the polygon border.
--- Supposes the points in the
+ Supposes the points in the
--- polygon are listed in anticlockwise order.
+ polygon are listed in anticlockwise order.
+-}
 pointInOrOnPolygon :: Point2 -> [Point2] -> Bool
-pointInOrOnPolygon !p (x:xs) = all (\l -> not (uncurry isRHS l p)) $ zip (x:xs) (xs ++ [x])
+pointInOrOnPolygon !p (x : xs) = all (\l -> not (uncurry isRHS l p)) $ zip (x : xs) (xs ++ [x])
 pointInOrOnPolygon _ _ = undefined
--- | Test whether a point is strictly inside a polygon.
+
--- Supposes the points in the polygon are listed in anticlockwise order.
+{- | Test whether a point is strictly inside a polygon.
+ Supposes the points in the polygon are listed in anticlockwise order.
+-}
 pointInPolygon :: Point2 -> [Point2] -> Bool
-pointInPolygon !p (x:xs) = all (\l -> uncurry isLHS l p) $ zip (x:xs) (xs ++ [x])
+pointInPolygon !p (x : xs) = all (\l -> uncurry isLHS l p) $ zip (x : xs) (xs ++ [x])
 pointInPolygon _ [] = False
 
-orderPolygonAround 
+orderPolygonAround ::
-    :: Point2 -- ^ point to order around
+    -- | point to order around
-    -> [Point2]
+    Point2 ->
-    -> [Point2]
+    [Point2] ->
+    [Point2]
 orderPolygonAround _ [] = []
 orderPolygonAround cen ps = sortOn (\p -> argV (p -.- cen)) ps
 
 orderAroundFirstReverse :: [Point2] -> [Point2]
 orderAroundFirstReverse [] = []
-orderAroundFirstReverse (a:as) = a : reverse (orderPolygonAround a as)
+orderAroundFirstReverse (a : as) = a : reverse (orderPolygonAround a as)
 
 orderAroundFirst :: [Point2] -> [Point2]
 orderAroundFirst [] = []
-orderAroundFirst (a:as) = a : orderPolygonAround a as
+orderAroundFirst (a : as) = a : orderPolygonAround a as
+
 -- | Reorder points to be anticlockwise around their center.
 orderPolygon :: [Point2] -> [Point2]
 orderPolygon [] = []
 --orderPolygon ps = orderPolygonAround (1/ fromIntegral (length ps) *.* foldr1 (+.+) ps) ps
 orderPolygon ps = orderPolygonAround (centroid ps) ps
--- | Adds a point to a convex polygon.
+
--- If the point is inside, returns the original.
+{- | Adds a point to a convex polygon.
--- Points ordered anticlockwise, input not checked.
+ If the point is inside, returns the original.
+ Points ordered anticlockwise, input not checked.
+-}
 addPointPolygon :: Point2 -> [Point2] -> [Point2]
 addPointPolygon p ps
     | pointInOrOnPolygon p ps = ps
     | otherwise = orderPolygon $ p : ps
--- | Creates the convex hull of a set of points.
+
--- Need to verify whether or not this is ordered
+{- | Creates the convex hull of a set of points.
+ Need to verify whether or not this is ordered
+-}
 convexHull :: [Point2] -> [Point2]
-convexHull (x:y:z:xs) = grahamScan $ orderAroundFirst $ sortOn (\(V2 a b) -> (b,a)) (x:y:z:xs)
+convexHull (x : y : z : xs) = grahamScan $ orderAroundFirst $ sortOn (\(V2 a b) -> (b, a)) (x : y : z : xs)
 convexHull _ = error "Tried to create the convex hull of two or fewer points"
--- | Creates the convex hull of a set of points.
+
--- assumes no repetition of points: try nubbing!
+{- | Creates the convex hull of a set of points.
+ assumes no repetition of points: try nubbing!
+-}
 convexHullSafe :: [Point2] -> [Point2]
 --convexHullSafe (x:y:z:xs) = grahamScan $ orderAroundFirst $ sortOn (\(V2 a b) -> (b,a)) (x:y:z:xs)
-convexHullSafe (x:y:z:xs) = grahamScan $ orderAroundFirst $ sortOn (\(V2 a b) -> (b,a)) (x:y:z:xs)
+convexHullSafe (x : y : z : xs) = grahamScan $ orderAroundFirst $ sortOn (\(V2 a b) -> (b, a)) (x : y : z : xs)
 convexHullSafe _ = []
 
 grahamScan :: [Point2] -> [Point2]
 grahamScan = foldr push []
   where
-    push point stack = grahamEliminate (point:stack)
+    push point stack = grahamEliminate (point : stack)
--- | Remove second element if top three elements are not counterclockwise.
+
--- Repeat if necessary. See 
+{- | Remove second element if top three elements are not counterclockwise.
--- https://codereview.stackexchange.com/questions/206019/graham-scan-algorithm-in-haskell
+ Repeat if necessary. See
+ https://codereview.stackexchange.com/questions/206019/graham-scan-algorithm-in-haskell
+-}
 grahamEliminate :: [Point2] -> [Point2]
-grahamEliminate (x:y:z:xs)
+grahamEliminate (x : y : z : xs)
-    | not $ isLHS x y z = grahamEliminate (x:z:xs)
+    | not $ isLHS x y z = grahamEliminate (x : z : xs)
 grahamEliminate xs = xs
 
 centroid :: Foldable t => t Point2 -> Point2
 centroid = L.fold $ (/) <$> L.Fold (+.+) (V2 0 0) id <*> L.genericLength
 
-centroidNum :: (Fractional a ,Foldable t) => t a -> a
+centroidNum :: (Fractional a, Foldable t) => t a -> a
 centroidNum = L.fold $ (/) <$> L.Fold (+) 0 id <*> L.genericLength
 
 shrinkPolyOnEdges :: Float -> [Point2] -> [Point2]
-shrinkPolyOnEdges x (p:q:ps) = map (shrinkVert x) . slideWindow 3 $ (p:q:ps) ++ [p,q]
+shrinkPolyOnEdges x (p : q : ps) = map (shrinkVert x) . slideWindow 3 $ (p : q : ps) ++ [p, q]
 shrinkPolyOnEdges _ _ = error "too few vertices in polygon"
 
 shrinkVert :: Float -> [Point2] -> Point2
-shrinkVert d [x,y,z] = x +.+ (d *.* normalizeV (x -.- y)) +.+ (d *.* normalizeV (z -.- y))
+shrinkVert d [x, y, z] = x +.+ (d *.* normalizeV (x -.- y)) +.+ (d *.* normalizeV (z -.- y))
 shrinkVert _ _ = error "wrong number of vertices"

src/Shape.hs

@@ -55,6 +55,7 @@ polyCircx n = map (vNormaly . addZ 0) . polyCirc n
 -- length of polys must be the same
 -- points should be correctly ordered so that
 -- polys form a prism-like object with quad faces between them
+-- each layer of points must be arranged anticlockwise
 prismPoly ::
     Size ->
     Importance ->
@@ -123,6 +124,7 @@ upperPrismPoly ::
     Size ->
     Importance ->
     Float ->
+    -- | Should be anticlockwise
     [Point2] ->
     Shape
 {-# INLINE upperPrismPoly #-}