add & apply fourmolu and dead code removal

flake.nix

@@ -74,13 +74,13 @@
           programs.hlint.enable = true;
 
           # We use fourmolu
-          # programs.ormolu.package = pkgs.haskellPackages.fourmolu;
-          # settings.formatter.ormolu = {
-          #   options = [
-          #     "--ghc-opt"
-          #     "-XImportQualifiedPost"
-          #   ];
-          # };
+          programs.ormolu.package = pkgs.haskellPackages.fourmolu;
+          settings.formatter.ormolu = {
+            options = [
+              "--ghc-opt"
+              "-XImportQualifiedPost"
+            ];
+          };
         };
 
         # Default package & app.

src/Main.hs

@@ -1,50 +1,51 @@
 module Main where
 
-import qualified Triangles as Tri
+import qualified CircumCircle as CC
+import Control.Arrow
+import qualified Control.Monad as M
+import qualified Control.Monad.Parallel as MP
+import Control.Parallel.Strategies
+import qualified Data.Colour as C
+import qualified Data.Colour.Names as CN
+import Data.Colour.RGBSpace (uncurryRGB)
+import qualified Data.Colour.SRGB as CL
+import qualified Data.Colour.SRGB.Linear as CL
+import Data.List
+import qualified Data.Map as M
+import qualified Data.Maybe as My
+import qualified Data.Set as S
+import qualified Data.Vector.Unboxed as Vec
+import Debug.Trace
+import qualified Debug.Trace as DT
+import qualified Debug.Trace as T
+import qualified Diagrams as DP
+import Diagrams.Backend.SVG
+import Diagrams.Backend.SVG.CmdLine
+import Diagrams.Prelude
+import qualified Diagrams.Prelude as D
 import GHC.Generics
-import qualified Render    as Ren
 import Graphics.Image as Img hiding (map, zipWith)
+import qualified Graphics.Image.ColorSpace as G
+import qualified Graphics.Image.Interface as Int
+import Options.Generic
+import qualified Render as Ren
+import qualified System.Environment as Env
 import System.Random
 import System.Random.Internal
 import System.Random.SplitMix
-import qualified Graphics.Image.ColorSpace as G
-import qualified Data.Colour.SRGB.Linear as CL
-import Diagrams.Backend.SVG.CmdLine
-import Diagrams.Prelude
-import Debug.Trace
-import Data.List
-import Control.Parallel.Strategies
-import qualified Control.Monad as M
-import qualified Graphics.Image.Interface as Int
-import qualified Data.Vector.Unboxed as Vec
-import qualified Debug.Trace as DT
-import qualified System.Environment as Env
-import qualified Data.Map as M
-import qualified Data.Set as S
-import Diagrams.Backend.SVG
-import qualified Data.Colour.Names as CN
 import Triangles (getTriangleAverageRGB)
-import Options.Generic
-import qualified Data.Colour.SRGB as CL
-import qualified Data.Colour as C
-import qualified Data.Maybe as My
-import Control.Arrow
-import Data.Colour.RGBSpace (uncurryRGB)
-import qualified Control.Monad.Parallel as MP
-import qualified CircumCircle as CC
-import qualified Debug.Trace as T
-import qualified Diagrams as DP
-import qualified Diagrams.Prelude as D
+import qualified Triangles as Tri
 
-data Options = Options {
-                    numPoints :: Int,
-                    gen :: Maybe StdGen
+data Options = Options
+  { numPoints :: Int
+  , gen :: Maybe StdGen
   }
 
 -- -- modify this to your liking
-defaultOpts  = Options {
-                    numPoints = 10,
-                    gen = Nothing
+defaultOpts =
+  Options
+    { numPoints = 10
+    , gen = Nothing
     }
 
 -- CL.rgb might be the wrong fn...
@@ -56,51 +57,27 @@ convImage = Vec.map tosRGB' . Int.toVector
 corners :: [(Double, Double)]
 corners = (,) <$> [0, 1] <*> [0, 1]
 
--- scalePointToImage :: (Int, Int) -> Point V2 Double -> Point V2 Int
--- scalePointToImage (ymax, xmax) p = round <$> (p2 (fromIntegral xmax, fromIntegral ymax) * p)
-
--- genImage :: Image VU G.RGB Double -> StdGen -> Int -> QDiagram B V2 Double Any
--- genImage image gen cornerCount =
---   scaleY widthHeightRatio
---   . reflectY
---   . rectEnvelope (mkP2 0 0) (1 ^& 1)
---   . mconcat
---   . map (uncurry Ren.placeTri . second (uncurryRGB CL.rgb))
---   . withStrategy (parListChunk 1000 rdeepseq)
---   $ My.mapMaybe (\tri ->  (tri,) . CL.toRGB <$> triColor tri) triangles
---   where
---     widthHeightRatio = (fromIntegral $ fst dimensions) / ((fromIntegral $ snd dimensions) :: Double)
-
---     img' = convImage image
---     dimensions = Img.dims image
---     triangles = S.toList . Tri.findTriangles . withStrategy (parListChunk 1000 rdeepseq) . Tri.toPlanarGraph . take cornerCount . map p2 $ corners ++ Tri.randomPoints gen
-
---     triColor tri = getTriangleAverageRGB img' dimensions <$> (if S.size scaled == 3 then Just scaled else Nothing)
---       where
---         scaled = S.map (scalePointToImage dimensions) tri
-
-
 shapeCircumference = Data.List.sum . map D.norm . loopOffsets . fromVertices
 
 genImage' :: Image VU G.RGB Double -> StdGen -> Int -> QDiagram SVG V2 Double Any
-genImage' image gen cornerCount =  -- image gen cornerCount =
+genImage' image gen cornerCount =
   scaleY widthHeightRatio
     . reflectY
     . rectEnvelope (mkP2 0 0) (1 ^& 1)
     -- . atop visualizeGraph
     . mconcat
     . map drawVoroniRegion
-  -- . concatMap (\(center, shape) -> (zip shape (repeat $ circle 0.002)))
     . sortOn shapeCircumference
     . withStrategy (parListChunk 50 rdeepseq)
     . map (uncurry Tri.voroniDiagramCorners)
     $ voroni
  where
-
-    drawVoroniRegion shape = lw 0
-                    . fillColor (Tri.voroniRegionAverageColor img' dimensions shape )
-                    . strokeLocLoop . fromVertices $ shape
-
+  drawVoroniRegion shape =
+    lw 0
+      . fillColor (Tri.voroniRegionAverageColor img' dimensions shape)
+      . strokeLocLoop
+      . fromVertices
+      $ shape
 
   widthHeightRatio = (fromIntegral $ fst dimensions) / ((fromIntegral $ snd dimensions) :: Double)
 
@@ -110,14 +87,18 @@ genImage' image gen cornerCount =  -- image gen cornerCount =
   singleVoroni = last voroni
 
   visualizeGraph :: QDiagram SVG V2 Double Any
-    visualizeGraph = lc red . lw 1 . position
+  visualizeGraph =
+    lc red
+      . lw 1
+      . position
       . map (\(x0, x1) -> (x0,) . strokeLine $ (x0 ~~ x1))
       . Tri.toPlanarGraph
       $ corners'
 
-    voroni = -- take 14 . drop 24 .
-      Tri.findVoroniDiagram -- . withStrategy (parListChunk 1000 rdeepseq)
-      . Tri.toPlanarGraph $ corners'
+  voroni =
+    Tri.findVoroniDiagram
+      . Tri.toPlanarGraph
+      $ corners'
 
   corners' = take cornerCount . map p2 $ corners ++ Tri.randomPoints gen
 
@@ -127,24 +108,23 @@ deriving instance NFData a => NFData (CL.RGB a)
 toDimensionVector :: (Int.BaseArray arr cs e, Fractional n) => Image arr cs e -> SizeSpec V2 n
 toDimensionVector image = Diagrams.Prelude.dims $ p2 (fromIntegral $ cols image, fromIntegral $ rows image) .-. p2 (0.0, 0.0)
 
-data CLIOptions = CLIOptions {
-  input :: FilePath,
-  output :: FilePath,
-  cornerCount :: Int
-                       } deriving Generic
+data CLIOptions = CLIOptions
+  { input :: FilePath
+  , output :: FilePath
+  , cornerCount :: Int
+  }
+  deriving (Generic)
 
 instance ParseRecord CLIOptions
 
 main :: IO ()
 main = do
   CLIOptions{..} <- getRecord "image options"
-  let (Options {gen = gen}) = defaultOpts
+  let (Options{gen = gen}) = defaultOpts
   gen' <- getStdGen -- pure . mkStdGen $ 2344
   let gens :: [StdGen] = map fst . iterate (split . snd) . split $ gen'
   print gen'
   image <- Img.readImageRGB VU input
-  -- let diagram = genImage image gen' cornerCount
-  let nums = zip gens $ map show [0..60]
+  let nums = zip gens $ map show [0 .. 60]
   let dimVector = toDimensionVector image
   renderSVG output dimVector (genImage' image gen' cornerCount)
-  -- MP.forM_ nums (\(gen'', x) -> renderCairo ("output/" ++ x  ++ "-" ++ output) dimVector (genImage image gen'' cornerCount))

src/Triangles.hs

@@ -1,12 +1,3 @@
-{-# LANGUAGE TupleSections, TypeFamilies, MultiParamTypeClasses, TemplateHaskell, TypeSynonymInstances, FlexibleInstances #-}
-{-# LANGUAGE InstanceSigs #-}
--- module Triangles
--- ( getRandomPixel
--- , getRandomTriangle
--- , getPointsInTriangle
--- , getTriangleAverageRGB
--- ) where
-
 module Triangles where
 
 import System.Random
@@ -37,11 +28,9 @@ import Debug.Trace (traceShow)
 import qualified Data.Colour.Names as C
 import qualified Debug.Trace as D
 import Diagrams.TwoD.Segment.Bernstein (listToBernstein)
--- import qualified Linear.Affine as L
+
 type Image_ = Vec.Vector Pixel_
 type Pixel_ = Colour Double
--- type Point = (Double, Double)
--- type Triangle = (Point, Point, Point)
 
 toSRGBTuple :: Pixel_ -> (Double, Double, Double)
 toSRGBTuple = srgb' . C.toRGB
@@ -95,14 +84,6 @@ toPlanarGraph points =
 toLocatedTrail :: TrailLike a => Point (V a) (N a) -> Point (V a) (N a) -> Located a
 toLocatedTrail p1 p2 = fromVertices [p1, p2] `at` p1
 
--- data VoroniRegion = VoroniRegion {
---   center :: P2 Double,
---   neighbors :: [P2 Double]
---                                  }
-
--- voroniDiagramCorners :: Point V2 Double -> [Point V2 Double] -> [Point V2 Double]
--- voroniDiagramCorners :: Point (V c) (N c) -> [Point V2 Double] -> c
--- voroniDiagramCorners :: forall t. (N t ~ Double, V t ~ V2, TrailLike t) => Point V2 Double -> [Point V2 Double] -> t
 withinShape :: RealFloat v => Point V2 v -> [Point V2 v] -> Point V2 v -> Bool
 withinShape pointInShape verticies candidate = all ((< quarterTurn) . fmap abs . uncurry signedAngleBetweenDirs) $ zip (shapeDirections pointInShape) (shapeDirections candidate)
   where
@@ -111,18 +92,13 @@ withinShape pointInShape verticies candidate = all ((< quarterTurn) . fmap abs .
 
 sortOnAngle center = sortOn (normalizeAngle . signedAngleBetweenDirs xDir . dirBetween center)
 
--- voroniDiagramCorners :: forall n . (Floating n, Real n, Show n) => Point V2 n -> [P2 n] -> [P2 n]
 voroniDiagramCorners center midpoints -- = midpoints
   = sortOnAngle center . filter isValidMidpoint . concat $ [intersectPointsT l0 l1 | l0 <- tangentTrails, l1 <- tangentTrails]
   where
 
     lessThanQuarterTurn candidate = candidate <= (10001 / 40000) @@ turn || candidate >= (29999 / 40000) @@ turn
-      -- where
-      --   candidate' = (candidate ^. turn)  - (fromIntegral . floor $ (candidate ^. turn))
-    -- candidateVertecies = sortOn (normalizeAngle . signedAngleBetweenDirs xDir . dirBetween center) . concat $ [ intersectPointsT (tangentTrail x) (tangentTrail y)  | x <- midpoints, y <- midpoints ]
 
     tangentTrails = map tangentTrail midpoints
-    -- validMidpoints = sortOn (normalizeAngle . signedAngleBetweenDirs xDir . dirBetween center) . filter isValidMidpoint $ midpoints
 
     appendHead (x:xs) = xs ++ [x]
 
@@ -138,8 +114,6 @@ voroniDiagramCorners center midpoints -- = midpoints
           fromDirection . rotateBy (1 / 4) $ dirBetween midpoint center
 
 
--- findVoroniDiagram :: (Ord (v n), Additive v, Fractional n) => [(Point v n, Point v n)] -> [[Point v n]]
--- findVoroniDiagram :: (Ord n, Ord (v n), Metric v, Floating n, R1 v, Real n, r) => [(Point v n, Point v n)] -> [[Point v n]]
 findVoroniDiagram :: RealFloat n => [(Point V2 n, Point V2 n)] -> [(Point V2 n, [Point V2 n])]
 findVoroniDiagram edges =
   M.toList
@@ -149,20 +123,8 @@ findVoroniDiagram edges =
   where
     adjacencyMap = adjacencyMapOf edges
 
-    -- I'm not sure this part works
     pointBetween p0 p1 = p0 .+^ ((p1 .-. p0) ^/ 2)
 
--- filterNotInVoroniRegion :: RealFloat n => Point V2 n -> [Point V2 n] -> [Point V2 n] -> [Point V2 n]
--- filterNotInVoroniRegion center midpoints = id -- filter allowed
---   where
---     allowed point
---       = all ((< 0.25) . abs . (^. turn))
---       . zipWith signedAngleBetweenDirs midpointAngles
---       . map (dirBetween point) $ midpoints
-
---     midpointAngles = map (dirBetween center) midpoints
-
-
 findTriangles :: Ord b => [(b, b)] -> S.Set (S.Set b)
 findTriangles edges = S.unions . S.map threeCyclesOf . M.keysSet $ adjacencyMap
   where
@@ -211,32 +173,6 @@ voroniRegionAverageColor image (x', y') verticies
 
     scaleToUnitCoords :: P2 Int -> P2 Double
     scaleToUnitCoords p = p2 ((fromIntegral x' / (fromIntegral $ p ^. _x)), fromIntegral y' / (fromIntegral $ p ^. _y))
-  -- = blendEqually
-  -- . mapMaybe (index' . unp2)
-  -- . filter withinShape'
-  -- $ candidatePoints
-  -- where
-
-  --   withinShape' :: P2 Int -> Bool
-  --   withinShape' = withinShape center verticies . scaleToUnitCoords
-
-  --   candidatePoints = [p2 (x, y) | x <- [minX .. maxX], y <- [minY .. maxY]]
-
-  --   maxX = fst . unp2 $ maximumBy (compare `F.on` fst . unp2) verticies'
-  --   minX = fst . unp2 $ minimumBy (compare `F.on` fst . unp2) verticies'
-  --   maxY = snd . unp2 $ maximumBy (compare `F.on` snd . unp2) verticies'
-  --   minY = snd . unp2 $ minimumBy (compare `F.on` snd . unp2) verticies'
-
-  --   verticies' = map scaleToImageCoords verticies
-
-  --   index' :: (Int, Int) -> Maybe Pixel_
-  --   index' (y, x)
-  --       | y >= y' = Nothing
-  --       | x >= x' = Nothing
-  --       | y < 0   = Nothing
-  --       | x < 0   = Nothing
-  --       | otherwise = image Vec.!? ((y * x') + x)
-
 
 getColorsInTriangle :: Image_ -> (Int, Int) -> S.Set (P2 Int)  -> [C.Colour Double]
 getColorsInTriangle image (x', y') triangle = pixels