hfractal-0.1.0: FracImg.hs

{-# LANGUAGE BangPatterns #-}
module FracImg
	where

import FracComp
import FracState

import Graphics.GD
import Data.Array.IO hiding (range)
import System.IO
import Graphics.Rendering.OpenGL

w = 1600
h = 1600
filepath = "." :: FilePath

convColour :: Color3 GLdouble -> Graphics.GD.Color
convColour (Color3 r g b) = rgb (f r) (f g) (f b) where
	f = (floor . (* 256))

--pixel ::  Image -> Double -> (Int, Double) -> IO ()
pixelWrite im (Sz w h) cm pixarr = go 0 0 where
	go !x !y | y == h = return ()
			 | x == w = go 0 (y+1)
			 | otherwise = do
		p <- readArray pixarr (x + y*w)
		setPixel (x,y) (convColour $ colourMand p cm) im
		go (x+1) y

imagAt ::  FilePath -> Mandstate -> IO ()
imagAt fp Mandstate{xmid=xm, ymid=ym, range=rng, colourmul=cm} = do
	pixarr <- newArray (0, w*h-1) 0.0 :: IO Pix
	im <- newImage (w, h)
	compPoints xm ym rng (Sz w h) pixarr
	pixelWrite im (Sz w h) cm pixarr 
	savePngFile fp im

{-
imgrange :: Double-> Double-> Double-> Double-> Double-> Int-> [Char]-> IO ()
imgrange xm ym cm initrange scale num rootfp = mapM_ (\(fn, r) -> imagAt fn xm ym cm r) $ zip fns ranges where
	fns = map (\s -> rootfp ++ show (100000 + s) ++ ".png") [1..num]
	ranges = take num $ iterate (/scale) initrange
-}