129 lines
4.7 KiB
Haskell
129 lines
4.7 KiB
Haskell
module Main where
|
|
|
|
import qualified Triangles as Tri
|
|
import GHC.Generics
|
|
import qualified Render as Ren
|
|
import Graphics.Image as Img hiding (map, zipWith)
|
|
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
|
|
|
|
data Options = Options {
|
|
numPoints :: Int,
|
|
gen :: Maybe StdGen
|
|
}
|
|
|
|
-- -- modify this to your liking
|
|
defaultOpts = Options {
|
|
numPoints = 10,
|
|
gen = Nothing
|
|
}
|
|
|
|
-- CL.rgb might be the wrong fn...
|
|
tosRGB' :: (Ord b, Floating b) => Pixel G.RGB b -> CL.Colour b
|
|
tosRGB' (G.PixelRGB r g b) = CL.rgb r g b
|
|
|
|
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
|
|
|
|
|
|
|
|
-- genImage' :: Image VU G.RGB Double -> StdGen -> Int -> QDiagram Cairo V2 Double Any
|
|
genImage' image gen cornerCount = -- image gen cornerCount =
|
|
scaleY widthHeightRatio
|
|
. reflectY
|
|
. rectEnvelope (mkP2 0 0) (1 ^& 1)
|
|
. position
|
|
. map (\shape -> (head shape, ) . showOrigin
|
|
. fillColor (Tri.getShapeAverageRGB img' dimensions . map (scalePointToImage dimensions) $ shape)
|
|
. strokeLoop . closeLine . fromVertices $ shape)
|
|
-- . withStrategy (parListChunk 1000 rdeepseq)
|
|
$ voroni
|
|
where
|
|
widthHeightRatio = (fromIntegral $ fst dimensions) / ((fromIntegral $ snd dimensions) :: Double)
|
|
|
|
triColor tri = getTriangleAverageRGB img' dimensions <$> (if S.size scaled == 3 then Just scaled else Nothing)
|
|
where
|
|
scaled = S.map (scalePointToImage dimensions) tri
|
|
|
|
img' = convImage image
|
|
dimensions = Img.dims image
|
|
voroni = take 40 . Tri.findVoroniDiagram . withStrategy (parListChunk 1000 rdeepseq) . Tri.toPlanarGraph . take cornerCount . map p2 $ corners ++ Tri.randomPoints gen
|
|
|
|
deriving instance Generic (CL.RGB a)
|
|
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
|
|
|
|
instance ParseRecord CLIOptions
|
|
|
|
main :: IO ()
|
|
main = do
|
|
CLIOptions{..} <- getRecord "image options"
|
|
let (Options {gen = gen}) = defaultOpts
|
|
gen' <- pure . mkStdGen $ 2345 -- getStdGen
|
|
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 dimVector = toDimensionVector image
|
|
renderSVG output dimVector (genImage' image gen' cornerCount)
|
|
-- MP.forM_ nums (\(gen'', x) -> renderCairo ("output/" ++ x ++ "-" ++ output) dimVector (genImage image gen'' cornerCount))
|