diff --git a/Bindings.hs b/Bindings.hs
new file mode 100644
--- /dev/null
+++ b/Bindings.hs
@@ -0,0 +1,36 @@
+module Bindings
+  where
+
+import Graphics.UI.GLUT
+import Data.IORef
+import System.Exit
+
+import FracState
+import FracImg
+
+--TODO. Clean up by using Data.Accessor
+keyboardAct :: IORef Mandstate -> Key -> KeyState -> IO ()
+keyboardAct ms (SpecialKey KeyLeft) Down = do
+  modifyIORef ms (\m@Mandstate{xmid=x,range=r} -> m{xmid=x - 0.1*r})
+keyboardAct ms (SpecialKey KeyRight) Down = do
+  modifyIORef ms (\m@Mandstate{xmid=x,range=r} -> m{xmid=x + 0.1*r})
+keyboardAct ms (SpecialKey KeyUp) Down = do
+  modifyIORef ms (\m@Mandstate{ymid=y,range=r} -> m{ymid=y + 0.1*r})
+keyboardAct ms (SpecialKey KeyDown) Down = do
+  modifyIORef ms (\m@Mandstate{ymid=y,range=r} -> m{ymid=y - 0.1*r})
+keyboardAct ms (Char '+') Down = do
+  modifyIORef ms (\m@Mandstate{range=r} -> m{range=r/rangemul})
+keyboardAct ms (Char '-') Down = do
+  modifyIORef ms (\m@Mandstate{range=r} -> m{range=r*rangemul})
+keyboardAct ms (Char 'a') Down = do
+  modifyIORef ms (\m@Mandstate{colourmul=cm} -> m{colourmul=cm*cmul})
+keyboardAct ms (Char 's') Down = do
+  modifyIORef ms (\m@Mandstate{colourmul=cm} -> m{colourmul=cm/cmul})
+keyboardAct ms (Char 'p') Down = do
+  ms' <- readIORef ms
+  imagAt "frac.png" ms'
+keyboardAct ms (Char 'o') Down = do
+  ms' <- readIORef ms
+  print ms'
+keyboardAct _ (Char '\27') _ = exitWith ExitSuccess
+keyboardAct _ _ _ = return ()
diff --git a/FracComp.hs b/FracComp.hs
new file mode 100644
--- /dev/null
+++ b/FracComp.hs
@@ -0,0 +1,46 @@
+{-# LANGUAGE BangPatterns #-}
+module FracComp
+  where
+
+import Graphics.UI.GLUT
+import Data.Array.IO
+
+import FracState
+
+type Pix = IOUArray Int Double
+-- Number of iterations to escape
+mandPoint :: Int -> Double -> Double -> Double -> Double -> Double
+mandPoint !n !x !y cx cy | n > maxIter		= 0.0
+					     | (x2 + y2) > 4.0  = 1.0 - logBase 2 (0.5 * logBase 2 (x2 + y2)) + fromIntegral n
+					     | otherwise		= mandPoint (n+1) (x2 - y2 + cx) (2.0*x*y + cy) cx cy where
+	x2 = x*x  --This CSE saves a few cycles
+	y2 = y*y
+
+compPoints :: Double -> Double -> Double -> Sz -> Pix -> IO ()
+compPoints xm ym rng sz@(Sz width height) arr = go 0 0 where
+	go !x !y | y == height  = return () 
+			 | x == width   = go 0 (y+1)
+			 | otherwise = do 
+		writeArray arr k (mandPoint 0 0.0 0.0 cx cy)
+		go (x+1) y where
+			k = x + y*width
+			fi = fromIntegral
+			cx = rng * (fi x - fi w2) / fi w2 + xm :: Double
+			cy = rng * (fi y - fi h2) / fi h2 + ym :: Double
+			(w2, h2) = (width `div` 2, height `div` 2)
+
+-- Colour a vertex
+colourMand :: Double -> Double -> Color3 GLdouble
+colourMand 0.0 _ = fmap realToFrac $ Color3 0.0 0.0 0.0
+colourMand m cm = fmap realToFrac $ Color3 r g b where
+	r = 0.5 + 0.5 * cos (m * cm) 
+	g = 0.5 + 0.5 * cos ((m + 16.0) * cm)
+	b = 0.5 + 0.5 * cos ((m + 32.0) * cm)
+
+-----------------------------------------
+--QuickCheck Properties
+-----------------------------------------
+--TODO: Conjure up some more properties
+
+prop_reflection :: Double -> Double -> Bool
+prop_reflection x y = mandPoint 0 0.0 0.0 x y == mandPoint 0 0.0 0.0 x (-y)
diff --git a/FracImg.hs b/FracImg.hs
new file mode 100644
--- /dev/null
+++ b/FracImg.hs
@@ -0,0 +1,43 @@
+{-# 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
+-}
diff --git a/FracState.hs b/FracState.hs
new file mode 100644
--- /dev/null
+++ b/FracState.hs
@@ -0,0 +1,27 @@
+module FracState
+  where
+
+maxIter, maxWidth, maxHeight :: Int
+maxIter = 500
+(maxWidth, maxHeight) = (1200,1200)
+
+--Keep the indicies as a global list so they aren't recopmuted every rendering
+indicies :: [Int]
+indicies = [0 .. (maxWidth-1)*(maxHeight-1)]
+
+rangemul, cmul :: Double
+rangemul = 1.02
+cmul     = 1.3
+
+data Mandstate = Mandstate {
+  xmid :: Double,
+  ymid :: Double,
+  range :: Double,
+  colourmul :: Double } deriving (Eq, Show)
+
+data Sz = Sz Int Int deriving (Eq, Show)
+
+data Options = Options
+	{ size :: Sz,
+	  ms   :: Mandstate   
+	} deriving (Eq, Show)
diff --git a/Hfractal.hs b/Hfractal.hs
new file mode 100644
--- /dev/null
+++ b/Hfractal.hs
@@ -0,0 +1,105 @@
+{-# LANGUAGE BangPatterns #-}
+import Graphics.UI.GLUT
+import Data.IORef
+import Data.Array.IO hiding (range)
+import System.Console.GetOpt
+import System.Environment (getArgs)
+
+import Bindings
+import FracState
+import FracComp
+
+inializeScreen opts@Options{size=Sz w h} = do
+	(progname,_) <- getArgsAndInitialize
+	initialDisplayMode $= [DoubleBuffered]
+	lineSmooth  $= Enabled
+	blendFunc   $= (SrcAlpha, OneMinusSrcAlpha)
+	createWindow "HFractal"
+	windowSize $= Size (fromIntegral (w-2)) (fromIntegral (h-1))
+	--clearColor $= Color4 0 0 0 0
+	matrixMode $= Projection
+	ortho2D 0.0 (fromIntegral (w-1)) 0.0 (fromIntegral (h-1)) 
+	matrixMode $= Modelview 0
+
+setCallBacks opts@Options{size=s@(Sz w h), ms=state} = do
+	--Create the state and pixel array
+	ms <- newIORef state
+	pixarr <- newArray (0, w*h-1) 0.0 :: IO Pix
+	--Set the callbacks
+	reshapeCallback $= Just (reshape opts)
+	idleCallback $= Just idle
+	keyboardMouseCallback $= Just (keyboardMouse ms)
+	displayCallback $= display ms s pixarr
+
+----------------------------------------
+--Display Callback and related functions
+----------------------------------------
+
+display ms sz@(Sz w h) pixarr = do
+	clear [ColorBuffer]
+	loadIdentity
+	Mandstate{xmid=x, ymid=y, range=r, colourmul=cm} <- get ms
+	compPoints x y r sz pixarr
+	preservingMatrix $ do
+		renderPrimitive Points $ displayPix sz cm pixarr
+	swapBuffers
+
+displayPix :: Sz -> Double -> IOUArray Int Double -> IO ()
+displayPix sz@(Sz width height) cm pixarr = go 0 0 where
+	go !x !y | y == height = return ()
+	         | x == width  = go 0 (y+1)	
+			 | otherwise   = do
+		dk <- readArray pixarr (x + y*width)
+		color (colourMand dk cm)
+		vertex $ Vertex2 (fromIntegral x) (fromIntegral y :: GLfloat)
+		go (x+1) y
+
+-----------------------------------------
+--Other Callbacks
+-----------------------------------------
+
+idle ::  IO ()
+idle = do
+	postRedisplay Nothing
+
+reshape opts s'@(Size w h) = do
+	viewport $= (Position 0 0, s')
+	--setCallBacks opts{size=Sz (fromIntegral w) (fromIntegral h)} --Reset the callbacks so that the pixarr is recreated
+	postRedisplay Nothing
+
+keyboardMouse ms key state _ _ = do
+	keyboardAct ms key state
+
+-----------------------------------------
+--Option Parsing and Main loop
+----------------------------------------
+
+zeroState, state1 :: Mandstate
+zeroState = Mandstate {xmid = 0.0, ymid = 0.0, range = 2.0, colourmul = 0.05}
+state1    = Mandstate {xmid = 0.001643721971153, ymid = 0.822467633298876, range = 0.05, colourmul = 0.0625}
+state = state1
+
+defOpts = Options {size=Sz 400 400, ms=state}
+
+--TODO: Tidy up the option parser with Data.Accessor(.Template)
+options :: [OptDescr (Options -> Options)]
+options = [ 
+	Option ['w'] ["width"] (ReqArg (\x opt -> opt {size = sx (size opt) (r x)} ) "WIDTH") "Set width of rendering window", 
+	Option ['h'] ["height"] (ReqArg (\y opt -> opt {size = sy (size opt) (r y)} ) "HEIGHT") "Set height of rendering window"] where 
+	--Options ['x'] ["x-mid"] (NoArg (\x opt -> opt { ms {xmid = read x} }))
+	sx (Sz x y) x' = (Sz x' y)
+	sy (Sz x y) y' = (Sz x y')
+	r = read
+
+getOpts :: [String] -> IO Options
+getOpts argv = case getOpt Permute options argv of
+	(o, [], []) -> return $ foldl (flip ($)) defOpts o
+	(_, _, errs) -> ioError (userError (concat errs ++ usageInfo header options))
+	where header = "Usage: hfractal [OPTION...]"
+
+main :: IO()
+main = do
+	opts <- getOpts =<< getArgs
+	inializeScreen opts 
+	setCallBacks opts
+	mainLoop
diff --git a/README b/README
new file mode 100644
--- /dev/null
+++ b/README
@@ -0,0 +1,7 @@
+OpenGL Fractal renderer. Currently only renders the Mandelbrot set, but can (and will) be easily extened to other fractals.
+
+Controls:
+Arrow keys   -    Movement
++/-          -    Zoom in/out
+a/s          -    Alter colouring gradient
+p            -    Print a hi-res image of the current location in the working direction
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/hfractal.cabal b/hfractal.cabal
new file mode 100644
--- /dev/null
+++ b/hfractal.cabal
@@ -0,0 +1,16 @@
+name:                hfractal
+version:             0.1.0
+cabal-version:		 >= 1.2
+synopsis:            OpenGL fractal renderer
+category:            Graphics
+license:             BSD3
+author:              Chris Holdsworth
+maintainer:          chrisholdsworth@gmail.com
+build-type:          Simple
+extra-source-files:  README
+
+Executable hfractal
+    main-is:            Hfractal.hs
+    build-depends:      base >=4 && <= 4.1, array, data-accessor, data-accessor-template, gd, OpenGL, GLUT
+    other-Modules:      FracComp, FracState, FracImg, Bindings
+    ghc-options:        -O2