fixed the corners, swapped to cairo

README.md

@@ -1,9 +1,9 @@
 # image-triangles
 ### examples
 ![Sierra mountains original](examples/sierra.jpg)
-![Sierra mountains post-filter](examples/sierra-result.svg)
+![Sierra mountains post-filter](examples/sierra-result.avif)
 ![Dog original](examples/luna.jpeg)
-![Dog post-filter](examples/luna-result.svg)
+![Dog post-filter](examples/luna-result.avif)
 
 ### to run:
 
@@ -11,5 +11,5 @@ Install [cabal & ghc](https://www.haskell.org/ghcup/) if you don't have them.
 
 ```
 cabal update
-cabal run image-triangles -- --cornerCount 800 --input examples/sierra.jpg --output output.svg
+cabal run image-triangles -- --cornerCount 1000 --input examples/sierra.jpg --output output.avif
 ```

image-triangles.cabal

@@ -81,6 +81,7 @@ executable image-triangles
                      , vector-th-unbox
                      , colour
                      , diagrams-lib
+                     , diagrams-cairo
                      , diagrams-svg
                      , parallel
                      , repa
@@ -89,6 +90,7 @@ executable image-triangles
                      , containers
                      , optparse-generic
                      , splitmix
+                     , monad-parallel
 
 
   -- Directories containing source files.

src/Main.hs

@@ -14,6 +14,7 @@ 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
@@ -21,6 +22,7 @@ import qualified System.Environment as Env
 import qualified Data.Map as M
 import qualified Data.Set as S
 import Diagrams.Backend.SVG
+import Diagrams.Backend.Cairo
 import Triangles (getTriangleAverageRGB)
 import Options.Generic
 import qualified Data.Colour.SRGB as CL
@@ -28,6 +30,7 @@ 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
 
 data Options = Options {
                     numPoints :: Int,
@@ -52,13 +55,18 @@ 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 Cairo V2 Double Any
 genImage image gen cornerCount =
-  scaleY ((fromIntegral $ fst dimensions) / ((fromIntegral $ snd dimensions) :: Double))
-  . reflectY . mconcat
+  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
@@ -86,7 +94,11 @@ main = do
   CLIOptions{..} <- getRecord "image options"
   let (Options {gen = gen}) = defaultOpts
   gen' <- getStdGen
+  let gens :: [StdGen] = map fst . iterate (split . snd) . split $ gen'
   print gen'
   image <- Img.readImageRGB VU input
   let diagram = genImage image gen' cornerCount
-  renderSVG output (toDimensionVector image) diagram
+  let nums = zip gens $ map show [0..60]
+  let dimVector = toDimensionVector image
+  renderCairo output dimVector (genImage image gen' cornerCount)
+  -- MP.forM_ nums (\(gen'', x) -> renderCairo ("output/" ++ x  ++ "-" ++ output) dimVector (genImage image gen'' cornerCount))

src/Render.hs

@@ -10,7 +10,7 @@ import qualified Data.Set as S
 import qualified Data.Colour.Names as CN
 
 
-makeTriangle :: [Point V2 Double] -> Colour Double -> Diagram SVG
+-- makeTriangle :: [Point V2 Double] -> Colour Double -> Diagram SVG
 makeTriangle verts col = fromVertices verts
     # mapLoc closeLine
     # strokeLocLoop 

src/Triangles.hs

@@ -47,15 +47,14 @@ derivingUnbox "Pixel_"
     [| toSRGBTuple |]
     [| fromSRGBTuple |]
 
-
+-- from -0.05 to 1.05 so there aren't missing/elongated triangles at the edges
 randomPoints :: StdGen -> [(Double, Double)]
 randomPoints = map (bimap toZeroToOneTuple toZeroToOneTuple) . randomRs ((0 :: Word, 0 :: Word), (maxBound, maxBound))
   where
     toZeroToOneTuple :: Word -> Double
-    toZeroToOneTuple x = (fromIntegral x / (fromIntegral (maxBound :: Word)))
+    toZeroToOneTuple x = ((fromIntegral x / (fromIntegral (maxBound :: Word))) * 1.1) - 0.05
 
-combinations :: (Floating b, Foldable (Diff p), Affine p, Ord b, Ord (p b),
- NFData (p b)) => [p b] -> [(p b, p b)]
+combinations :: (Ord b, Floating b, NFData b) => [P2 b] -> [(P2 b, P2 b)]
 combinations xs =
   sortOn (abs . uncurry distanceA)
   . S.toList . S.fromList
@@ -66,7 +65,7 @@ combinations xs =
   where
     edgeLengthThreshold = 45
 
-toPlanarGraph :: (NFData n, Floating n, Ord n) => [Point V2 n] -> [(Point V2 n, Point V2 n)]
+-- toPlanarGraph :: (NFData n, Floating n, Ord n) => [Point V2 n] -> [(Point V2 n, Point V2 n)]
 toPlanarGraph points =
   removeIntersections . combinations $ points
   where