111 lines
4 KiB
Haskell
111 lines
4 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 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 Triangles (getTriangleAverageRGB)
|
|
import Options.Generic
|
|
import qualified Data.Colour.SRGB as CL
|
|
import qualified Data.Maybe as My
|
|
|
|
data Options = Options {
|
|
numPoints :: Int,
|
|
gen :: Maybe StdGen
|
|
}
|
|
|
|
-- -- modify this to your liking
|
|
defaultOpts = Options {
|
|
numPoints = 10,
|
|
gen = Nothing
|
|
}
|
|
|
|
genList :: StdGen -> [StdGen]
|
|
genList = map snd . iterate (split . fst) . split
|
|
|
|
-- 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
|
|
|
|
-- -- progress goes from 0 to 1 the farther we get along the process
|
|
-- -- note, 0 represents the topmost triangle
|
|
-- renderTri :: Vec.Vector (Colour Double) -> (Int, Int) -> StdGen -> Double -> QDiagram SVG V2 Double Any
|
|
-- renderTri image dimensions gen progress = Ren.makeTriangle (Ren.toPointList dimensions triangle) color opacity'
|
|
-- where
|
|
|
|
-- triangle = Tri.getRandomTriangle image dimensions (Just area) gen
|
|
|
|
-- color = Tri.getTriangleAverageRGB image triangle dimensions
|
|
|
|
-- -- the following should be considered triangle shaders
|
|
-- -- modify them to your liking, their outputs are expected to be in [0, 1]
|
|
-- -- TODO: move these into a separate module
|
|
-- -- opacity' = 0.4
|
|
-- opacity' = 0.3 + ((1 - progress) * 0.5)
|
|
|
|
-- area = max ((progress ** 2) * 0.2) 0.02
|
|
|
|
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)
|
|
|
|
-- derive Generic (RGB Double)
|
|
|
|
-- genImage :: String -> IO (Diagram B)
|
|
-- genImage :: FilePath -> IO (QDiagram SVG V2 Double Any)
|
|
genImage image gen cornerCount = scaleY ((fromIntegral $ fst dimensions) / ((fromIntegral $ snd dimensions) :: Double)) . reflectY . mconcat $ My.mapMaybe (\tri -> Ren.placeTri tri <$> triColor tri) triangles
|
|
where
|
|
img' = convImage image
|
|
dimensions = (rows image, cols image)
|
|
triangles = S.toList . Tri.findTriangles . 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
|
|
|
|
-- let progressList = withStrategy (parListChunk 500 rdeepseq) . map (/ (fromIntegral numTriangles)) $ [0.0 .. (fromIntegral numTriangles)]
|
|
-- return $ center . reflectY . mconcat $ zipWith (renderTri img' dimensions) (genList gen'') progressList
|
|
|
|
|
|
toDimensionVector image = Diagrams.Prelude.dims $ p2 (fromIntegral $ cols image, fromIntegral $ rows image) .-. p2 (0.0, 0.0)
|
|
|
|
name = "examples/sierra.jpg"
|
|
|
|
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 gen' = StdGen {unStdGen = (seedSMGen 6839483548670845148 15931131216394744615)}
|
|
print gen'
|
|
image <- Img.readImageRGB VU input
|
|
let diagram = genImage image gen' cornerCount
|
|
renderSVG output (toDimensionVector image) diagram
|