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
| module Main (main) where
import Graphics.Gloss.Raster.Field
import Graphics.Gloss.Data.ViewPort
import Graphics.Gloss.Data.ViewState
import Graphics.Gloss.Interface.Pure.Game
import Data.Complex
import GHC.Float
data World = World {winSize :: (Int,Int), vs :: ViewState}
main = play displayMode background refreshs initWorld render handleEvent handleRefresh
where
n = 100
palette = makePalette n
initWorld = World (700, 600) viewStateInit
gen w = (palette !!) . mandelbrot n . rectifyView w
displayMode = InWindow "Ensemble de Mandelbrot" (winSize initWorld) (10, 10)
background = head $ palette
refreshs = 2
render w@(World (sizeX,sizeY) _) = makePicture sizeX sizeY 1 1 (gen w)
handleEvent evt w = case evt of
EventResize size -> w {winSize = size}
_ -> w {vs = updateViewStateWithEvent evt (vs w)}
handleRefresh t w = w
makePalette :: Int -> [Color]
makePalette n = white : colorsFromTo n1 white blue ++ colorsFromTo n2 blue orange ++ colorsFromTo n3 orange green ++ [black]
where
n' = n - 1
(n1,n2,n3) = (n' `div` 3, n' `div` 3, n' - n1 - n2)
colorsFromTo steps cfrom cto = map mix [1..steps]
where mix step = let p = fromIntegral step / fromIntegral steps
in mixColors (1-p) p cfrom cto
mandelbrot :: Int -> ((Double,Double) -> Int)
mandelbrot n (x,y) = go 0 0
where
go step z
| fairlyClose z && step < n = go (step + 1) (z*z + c)
| otherwise = step
c = x :+ y
fairlyClose (x:+y) = x*x+y*y < 4
----------------------------------------------
-- Fonctions utilitaires
----------------------------------------------
rectifyView :: World -> Point -> (Double,Double)
rectifyView (World (sizeX, sizeY) vs) = transAndScale (viewStateViewPort vs) . rectifyAspect
where
rectifyAspect (x,y) = (fromIntegral sizeX / fromIntegral sizeY * float2Double x, float2Double y)
transAndScale ViewPort {viewPortScale = zoom, viewPortTranslate = (vtx,vty)} (x,y) =
let z = 1/float2Double zoom in
(x*z - float2Double vtx/fromIntegral sizeX, y*z - float2Double vty/fromIntegral sizeY) |
Partager