diff --git a/ChangeLog.md b/ChangeLog.md deleted file mode 100644 index 3347b51..0000000 --- a/ChangeLog.md +++ /dev/null @@ -1,3 +0,0 @@ -# Changelog for image-triangles - -## Unreleased changes diff --git a/LICENSE b/LICENSE index d800924..b1143b3 100644 --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright Jack Wines (c) 2018 +Copyright (c) 2018, Jack Wines All rights reserved. diff --git a/image-triangles.cabal b/image-triangles.cabal index 32fe41f..68683f2 100644 --- a/image-triangles.cabal +++ b/image-triangles.cabal @@ -57,10 +57,11 @@ executable image-triangles other-extensions: TupleSections -- Other library packages from which modules are imported. - build-depends: base, random, hip, colour, diagrams-lib, diagrams-svg + build-depends: base, random, hip, colour, diagrams-lib, diagrams-svg, parallel -- Directories containing source files. hs-source-dirs: src -- Base language which the package is written in. default-language: Haskell2010 + ghc-options: -threaded -O3 diff --git a/project.nix b/project.nix index f710a50..629e66a 100644 --- a/project.nix +++ b/project.nix @@ -1,5 +1,5 @@ { mkDerivation, base, colour, diagrams-lib, diagrams-svg, hip -, random, stdenv +, parallel, random, stdenv }: mkDerivation { pname = "image-triangles"; @@ -8,7 +8,7 @@ mkDerivation { isLibrary = false; isExecutable = true; executableHaskellDepends = [ - base colour diagrams-lib diagrams-svg hip random + base colour diagrams-lib diagrams-svg hip parallel random ]; license = stdenv.lib.licenses.bsd3; } diff --git a/sierra.jpg b/sierra.jpg index 4239dae..dbfeef9 100644 Binary files a/sierra.jpg and b/sierra.jpg differ diff --git a/src/Main.hs b/src/Main.hs index 9335a10..c370d0f 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -8,24 +8,22 @@ import qualified Graphics.Image.ColorSpace as G import qualified Data.Colour.SRGB as C import Diagrams.Backend.SVG.CmdLine import Diagrams.Prelude - +import Data.List +import Control.Parallel.Strategies genList = map mkStdGen . randoms -singleTriangle image gen = reflectY . Ren.makeTriangle (Ren.toPointList dims t) $ col + +renderTri image t = reflectY . Ren.makeTriangle (Ren.toPointList dims t) $ col where - t = Tri.getRandomTriangle gen image - col = Tri.getTriangleAverageRGB image $ t dims = (cols image, rows image) + col = Tri.getTriangleAverageRGB image $ t main :: IO () main = do image <- readImageRGB VU "sierra.jpg" gen <- getStdGen - print gen - let t = Tri.getRandomTriangle gen image - let col = Tri.getTriangleAverageRGB image t - print col let dims = (cols image, rows image) - mainWith . mconcat . take 50 . map (singleTriangle image) . genList $ gen + let triangleList = sortOn Tri.area . withStrategy (parListChunk 50 rseq) . take 50 . map (Tri.getRandomTriangle image) . genList $ gen + mainWith . mconcat . map (renderTri image) $ triangleList diff --git a/src/Render.hs b/src/Render.hs index e96b82f..1493b2d 100644 --- a/src/Render.hs +++ b/src/Render.hs @@ -9,7 +9,12 @@ import Diagrams.Backend.SVG.CmdLine makeTriangle :: [Point V2 Double] -> Colour Double -> Diagram SVG -makeTriangle verts col = fromVertices verts # mapLoc closeLine # strokeLocLoop #fc col # lw 0 # opacity 0.2 +makeTriangle verts col = fromVertices verts + # mapLoc closeLine + # strokeLocLoop + # fc col + # lw 0 + # opacity 0.2 -- tupleFromIntegral :: (Int, Int) -> (Int, Int) -> (Double, Double) diff --git a/src/Triangles.hs b/src/Triangles.hs index 4d0b192..bda4de5 100644 --- a/src/Triangles.hs +++ b/src/Triangles.hs @@ -14,16 +14,27 @@ import System.Random import qualified Data.Colour.SRGB as C import qualified Data.Colour as C import qualified Graphics.Image.ColorSpace as G +import Data.List type Image_ = Image VU RGB Double type Pixel_ = Pixel RGB Double type Point = (Int, Int) type Triangle = (Point, Point, Point) +area :: Triangle -> Double +area (p1, p2, p3) = ccArea . swapForCounterClockwise . sortOn fst $ [p1, p2, p3] + where + swapForCounterClockwise [a, b, c] = if snd a < snd b + then [a, b, c] + else [b, a, c] + ccArea [(x1, y1), (x2, y2), (x3, y3)] = + (fromIntegral (x1 * y2 + x2 * y3 + x3 * y1 + - x1 * y3 - x2 * y1 - x3 - y2)) / 2.0 + getRandomPixel :: StdGen -> Image_ -> (Int, Int) getRandomPixel gen image = - ( getCoord gen . rows $ image - , getCoord gen' . cols $ image) + ( getCoord gen . pred . rows $ image + , getCoord gen' . pred . cols $ image) where getCoord :: StdGen -> Int -> Int getCoord gen = fst . (flip randomR) gen . (1,) @@ -32,8 +43,8 @@ getRandomPixel gen image = first3 (a : b : c : _) = (a, b, c) -getRandomTriangle :: StdGen -> Image_ -> Triangle -getRandomTriangle gen image = +getRandomTriangle :: Image_ -> StdGen -> Triangle +getRandomTriangle image gen = first3 . map (\x -> getRandomPixel x image) . iterate (snd . next) $ gen diff --git a/test/Spec.hs b/test/Spec.hs deleted file mode 100644 index cd4753f..0000000 --- a/test/Spec.hs +++ /dev/null @@ -1,2 +0,0 @@ -main :: IO () -main = putStrLn "Test suite not yet implemented"