-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathForkIOMandelbrot-2min40.hs
63 lines (50 loc) · 2.64 KB
/
ForkIOMandelbrot-2min40.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
--File: ForkIOMandelbrot.hs
--Author: Justin Dawson ([email protected])
-- This config takes over 2 minutes to run and has
-- a serious issue with Garbage collection (10x mem copied
-- when compared to the original)
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Graphics.Blank
import qualified Data.Vector.Unboxed as V
import Data.Complex
import qualified Data.Text as Text
import Control.Concurrent
import Control.Monad
mySquareList xs = forM_ xs (\(x,y,color) -> mySquare x y color)
mySquare x y color = do
save()
translate((x*300)+800,(y*300)+500)
fillStyle color
fillRect(0,0,2,2)
restore()
redYellow = ["F00","F10","F20","F30","F40","F50","F60","F70","F80","F90","FA0","FB0"]
blackGreen = ["000","010","020","030","040","050","060","070","080","090","0A0","0B0"]
blueGreen = ["0F0","0E1","0D2","0C3","0B4","0A5","096","087","078","069","05A","04B"]
yellowBlue = ["FF0","EE1","DD2","CC3","BB4","AA5","996","887","778","669","55A","44B"]
yellowRedBlue = ["FF0","FE0","FC0","FA0","F84","A75","096","087","078","069","05A","04B"]
blackGreenBlue = ["000","0A0","0A0","0C0","0F0","0C5","0A6","087","078","069","05A","04B"]
--intToHex n = (['0'..'9'] ++ ['A'..'F']) !! ((n `div` 16) )
--intToHex n = (['A','A','B','B','C','C','D','D','E','E','F','F']) !! (if (n `div` 12) > 12 then 11 else (n`div`12) )
intToHex n = blackGreen !! (if (n `div` 12) >= 12 then 11 else (n`div`12) )
mandelbrot:: Double -> Double -> (Double, Double,Text.Text)
mandelbrot x y = let val = x :+ y
zs = take 255 $ iterate (\z -> z^2 +val) 0
iter = length $ takeWhile (\intermediate -> magnitude intermediate < 2 ) $ zs
in (x,y,Text.pack ("#"++(intToHex iter)))
main :: IO ()
main = blankCanvas 3000 { events = ["mousedown"] } $ \ context -> do
let (w,h) = (width context, height context)
print ("got size " :: String, (w,h))
let v1 = [(x,y)| y<-[1,0.995 .. 0], x <-[-2, -1.995 .. -0.75]]
let v2 = [(x,y)| y<-[1,0.995 .. 0], x <-[-0.75, -0.745 .. 0.5]]
let v3 = [(x,y)| y<-[0,-0.005 .. -1], x <-[-2, -1.995 .. -0.75]]
let v4 = [(x,y)| y<-[0,-0.005 .. -1], x <-[-0.75, -0.745 .. 0.5]]
let vs = [v1,v2,v3,v4]
-- let res = map (\(x,y)->mandelbrot x y) $ v3
sequence $ map (forkIO . (\v-> let res = map (\(x,y)-> mandelbrot x y) v
in send context $ mySquareList res)) vs
return ()
-- send context $ do
-- sequence_ $ map (\((x,y),color)-> mySquare x y (Text.pack ("#"++(replicate 3 (intToHex color))) )) res
-- mySquare 10 10 "#F00"