diff --git a/README.md b/README.md
index 5167203..4dd9e11 100644
--- a/README.md
+++ b/README.md
@@ -1,9 +1,9 @@
# image-triangles
### examples
-
+
-
+
### 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
```
diff --git a/examples/luna-result.svg b/examples/luna-result.svg
deleted file mode 100644
index 400ec40..0000000
--- a/examples/luna-result.svg
+++ /dev/null
@@ -1,3 +0,0 @@
-
-
\ No newline at end of file
diff --git a/examples/sierra-result.svg b/examples/sierra-result.svg
deleted file mode 100644
index 0a6176b..0000000
--- a/examples/sierra-result.svg
+++ /dev/null
@@ -1,3 +0,0 @@
-
-
\ No newline at end of file
diff --git a/image-triangles.cabal b/image-triangles.cabal
index 77335f2..1a18a68 100644
--- a/image-triangles.cabal
+++ b/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.
diff --git a/src/Main.hs b/src/Main.hs
index 40e2521..9a20b7d 100644
--- a/src/Main.hs
+++ b/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))
diff --git a/src/Render.hs b/src/Render.hs
index e83d134..35960fa 100644
--- a/src/Render.hs
+++ b/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
diff --git a/src/Triangles.hs b/src/Triangles.hs
index 21eade9..18d3225 100644
--- a/src/Triangles.hs
+++ b/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
@@ -109,7 +108,7 @@ blendEqually colors = C.affineCombo (zip (repeat fraction) colors) $ C.black
where
fraction = 1.0 / (fromIntegral . length $ colors)
-getTriangleAverageRGB :: Image_ -> (Int, Int)-> S.Set (P2 Int) -> C.Colour Double
+getTriangleAverageRGB :: Image_ -> (Int, Int) -> S.Set (P2 Int) -> C.Colour Double
getTriangleAverageRGB image (y', x') triangle = blendEqually pixels
where