-
Notifications
You must be signed in to change notification settings - Fork 0
/
voronoi.hs
76 lines (57 loc) · 2.54 KB
/
voronoi.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
import System.Exit (exitSuccess, exitFailure)
import Data.List
import Data.Function
import Codec.Picture
import System.Random
main :: IO ()
main = do
let srcPath = "mona.png"
eitherImg <- readImage srcPath
case eitherImg of
Left errorMsg -> do
putStrLn errorMsg
exitFailure
Right image -> do
putStrLn "Loaded successfully!"
let standard = convertRGB8 image;
let imgW = imgWidth standard;
let imgH = imgHeight standard;
let randomGen = (mkStdGen 3)
let numSeeds = 500
let seeds = zip (take numSeeds $ randomRs (0, imgW-1) randomGen) (take numSeeds $ randomRs (0, imgH-1) randomGen)
putStrLn "Generating Image..."
-- savePngImage "meme.png" (ImageRGB8 standard)
writePng "out.png" (generateImage (renderAlgorithm standard seeds) imgW imgH)
putStrLn "Done"
exitSuccess
getPixelR (PixelRGB8 r _ _) = r
getPixelG (PixelRGB8 _ g _) = g
getPixelB (PixelRGB8 _ _ b) = b
imgWidth (Image w h dat) = w
imgHeight (Image w h dat) = h
imgData (Image w h dat) = dat
offsetsByRadius radius = [(x, y) | x <- [(-radius)..radius], y <- [(-radius)..radius]]
pointsSurrounding radius x y maxX maxY = [(x + fst(a), y + snd(a)) | a <- offsetsByRadius radius, x + fst(a) >= 0, x + fst(a) <= maxX, y + snd(a) >= 0, y + snd(a) <= maxY]
pixelsSurrounding image radius x y maxX maxY =
[pixelAt image (fst point) (snd point) | point <- pointsSurrounding radius x y maxX maxY]
averagePixel :: [PixelRGB8] -> PixelRGB8
averagePixel pixels = PixelRGB8
(fromIntegral r)
(fromIntegral g)
(fromIntegral b)
where
r = (sum [getPixelR pixel | pixel <- pixels])
g = (sum [getPixelG pixel | pixel <- pixels])
b = (sum [getPixelB pixel | pixel <- pixels])
renderAlgorithm :: Image PixelRGB8 -> [(Int, Int)] -> Int -> Int -> PixelRGB8
renderAlgorithm original seeds x y = PixelRGB8
(fromIntegral $ getPixelR pixel)
(fromIntegral $ getPixelG pixel)
(fromIntegral $ getPixelB pixel)
where
best = closestSeed (x,y) seeds
dist = distSquared best (x, y)
-- pixel = pixelAt original (fst best) (snd best)
pixel = averagePixel (pixelsSurrounding original 0 (fst best) (snd best) (imgWidth original) (imgHeight original))
distSquared (x1, y1) (x2, y2) = (x1-x2)^2 + (y1-y2)^2
closestSeed p = minimumBy (compare `on` distSquared p)