diff --git a/Bindings.hs b/Bindings.hs
--- a/Bindings.hs
+++ b/Bindings.hs
@@ -5,6 +5,7 @@
 import Data.IORef
 import System.Exit
 import Data.Accessor
+import Data.Accessor.Basic (T)
 import Control.Concurrent
 
 import FracState
diff --git a/FracColour.hs b/FracColour.hs
new file mode 100644
--- /dev/null
+++ b/FracColour.hs
@@ -0,0 +1,51 @@
+module FracColour 
+	where
+
+import Graphics.UI.GLUT hiding (blend)--(Color3, GLdouble)
+import Data.Colour as C
+import Data.Colour.SRGB
+import Data.List as L
+import Data.IntMap as IM
+import Data.Maybe
+import Data.Colour.Names
+import Graphics.GD
+
+-- Create a pallette of colours with which is a map from escape iterations to colours
+createPallete :: Int -> [(Int, Colour Double)] -> IntMap (Colour Double)
+createPallete maxIter points | length points < 2 || maximum (L.map fst points) > maxIter 
+                                                 || minimum (L.map fst points) < 0 = error "Invalid pallete reference points"
+							 | otherwise  = fromList (interpolate $ sortBy (\x y -> fst x `compare` fst y) points)
+
+interpolate :: [(Int, Colour Double)] -> [(Int, Colour Double)]
+interpolate [(_,_)] = []
+interpolate ((n1,c1):(n2,c2):xs) = [(n1 + i, C.blend (fromIntegral i / delta) c1 c2) | i <- [0 .. (n2 - n1 - 1)]] ++ (interpolate ((n2,c2):xs)) where
+	delta = fromIntegral (n2 - n1)
+
+colourPoint' :: IntMap (Colour Double) -> Double -> Colour Double
+colourPoint' colpal n = {-# SCC "blend" #-} C.blend (n-fromIntegral n1) (fromJust c1) (fromJust c2) where --Will it blend?
+	n1 = {-# SCC "floor" #-} truncate n
+	n2 = n1 + 1
+	(c1, c2) = {-# SCC "lookups" #-} (IM.lookup n1 colpal, IM.lookup n2 colpal)
+
+pallete = createPallete 5002 [(0,red), (1200, white), (1600, yellow), (2000, blend 0.3 white orange), (2500,darken 0.2 orange), (3200, blend 0.7 orange black), (4400, white), (5002, red)]
+
+{-
+colourPoint :: Double -> Double -> Color3 GLdouble
+colourPoint 0.0 _ = fmap realToFrac $ Color3 0.0 0.0 0.0
+colourPoint n _ = let c = toSRGB $ colourPoint' pallete n in
+	{-# SCC "conversions" #-} fmap realToFrac $ Color3 (channelRed c) (channelGreen c) (channelBlue c)
+-}
+
+colourGD :: Double -> Double -> Graphics.GD.Color
+colourGD 0.0 _ = rgb 0 0 0
+colourGD n _ = let c = toSRGB24 $ colourPoint' pallete n in
+	rgb (fromIntegral $ channelRed c) (fromIntegral $ channelGreen c) (fromIntegral $ channelBlue c)
+
+-- Colour a vertex based on the number of iterations it took to escape
+colourPoint :: Double -> Double -> Color3 GLdouble
+colourPoint 0.0 _ = fmap realToFrac $ Color3 0.0 0.0 0.0
+colourPoint 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)
+
diff --git a/FracComp.hs b/FracComp.hs
--- a/FracComp.hs
+++ b/FracComp.hs
@@ -12,7 +12,7 @@
 
 type Pix = IOUArray Int Double
 
--- Number of iterations to escape
+-- Number of iterations to escape the mandelbrot set
 mandPoint :: Int -> Double -> Double -> Double -> Double -> Int -> Double
 mandPoint !n !x !y cx cy mi | n > mi		   = 0.0
 					        | (x2 + y2) > 4.0  = 1.0 - logBase 2 (0.5 * logBase 2 (x2 + y2)) + fromIntegral n
@@ -20,13 +20,15 @@
 	!x2 = x*x  --This CSE saves a few cycles
 	!y2 = y*y
 
--- 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)
+{-
+-- Number of iterations to escape the burning ship fractal
+burnPoint :: Int -> Double -> Double -> Double -> Double -> Int -> Double
+burnPoint !n !x !y cx cy mi | n > mi		   = 0.0
+					        | (x2 + y2) > 4.0  = 1.0 - logBase 2 (0.5 * logBase 2 (x2 + y2)) + fromIntegral n
+					        | otherwise		   = burnPoint (n+1) (x2 - y2 + cx) (-2.0 * abs (x*y) + cy) cx cy mi where
+	!x2 = x*x 
+	!y2 = y*y
+-}
 
 children :: MVar [MVar ()]
 children = unsafePerformIO (newMVar [])
@@ -51,7 +53,7 @@
 	forkIO (io `finally` putMVar mvar ())
 
 
-mandPointSampled !x !y !xrng !yrng !mi ss = if (any (== 0.0) points) then 0.0 else average points where
+mandPointSampled !x !y !xrng !yrng !mi ss = average points where
 	points = [ mandPoint 0 0.0 0.0 (x + dx) (y + dy) mi | 
 			   dx <- ((take ss) . iterate (+xrng)) 0.0, 
 			   dy <- ((take ss) . iterate (+yrng)) 0.0]
diff --git a/FracImg.hs b/FracImg.hs
--- a/FracImg.hs
+++ b/FracImg.hs
@@ -4,6 +4,7 @@
 
 import FracComp
 import FracState
+import FracColour
 
 import Graphics.GD
 import Data.Array.IO hiding (range)
@@ -26,7 +27,7 @@
 			 | x == w = go 0 (y+1)
 			 | otherwise = do
 		p <- readArray pixarr (x + y*w)
-		(antiAliased $ setPixel (x,y)) (convColour $ colourMand p cm) im
+		(antiAliased $ setPixel (x,y)) (convColour $ colourPoint p cm) im
 		go (x+1) y
 
 imagAt ::  FilePath -> Mandstate -> IO ()
diff --git a/Hfractal.hs b/Hfractal.hs
--- a/Hfractal.hs
+++ b/Hfractal.hs
@@ -8,6 +8,7 @@
 
 import Bindings
 import FracState
+import FracColour
 import FracComp
 
 inializeScreen opts@(Options (Sz w h) _) = do
@@ -53,7 +54,7 @@
 	         | x == width  = go 0 (y+1)	
 			 | otherwise   = do
 		dk <- readArray pixarr (x + y*width)
-		color (colourMand dk cm)
+		color (colourPoint dk cm)
 		vertex $ Vertex2 (fromIntegral x) (fromIntegral y :: GLfloat)
 		go (x+1) y
 
@@ -84,18 +85,18 @@
 state0	  = Mandstate (-0.14076572210832694) 0.8510989379408804 1.0 0.05 500
 state1    = Mandstate 0.001643721971153 0.822467633298876 0.05 0.0625 500
 state2    = Mandstate 0.35473015182773904 9.541013313560959e-2 0.0002 0.0625 500
-state     = state0
+state     = state1
 
 defOpts = Options (Sz 400 400) state
 
 options :: [OptDescr (Options -> Options)]
 options = [ 
-	Option ['w'] ["width"] (ReqArg (\w -> size^:wi^=(read w))  "Window width") "Set width of rendering window", 
-	Option ['h'] ["height"] (ReqArg (\h -> size^:hi^=(read h)) "Window height") "Set height of rendering window",
-	Option ['x'] ["x-mid"] (ReqArg (\x -> ms^:xmid^=(read x)) "Real(z)") "Set the real part of the initial z (double)",
-	Option ['y'] ["y-mid"] (ReqArg (\y -> ms^:ymid^=(read y)) "Imag(z)") "Set the imaginary part of the inital z (double)",
-	Option ['i'] ["maxiter"] (ReqArg (\i -> ms^:maxiter^=(read i)) "Max iterations") "Maximum iterations until escape (int)",
-	Option ['z'] ["zoom"] (ReqArg (\z -> ms^:range^=(read z)) "Zoom") "Level of zoom (double)"]
+	Option ['w'] ["width"] (ReqArg (\w -> size^:wi^=read w)  "Window width") "Set width of rendering window", 
+	Option ['h'] ["height"] (ReqArg (\h -> size^:hi^=read h) "Window height") "Set height of rendering window",
+	Option ['x'] ["x-mid"] (ReqArg (\x -> ms^:xmid^=read x) "Real(z)") "Set the real part of the initial z (double)",
+	Option ['y'] ["y-mid"] (ReqArg (\y -> ms^:ymid^=read y) "Imag(z)") "Set the imaginary part of the inital z (double)",
+	Option ['i'] ["maxiter"] (ReqArg (\i -> ms^:maxiter^=read i) "Max iterations") "Maximum iterations until escape (int)",
+	Option ['z'] ["zoom"] (ReqArg (\z -> ms^:range^=read z) "Zoom") "Level of zoom (double)"]
 
 getOpts :: [String] -> IO Options
 getOpts argv = case getOpt Permute options argv of
diff --git a/hfractal.cabal b/hfractal.cabal
--- a/hfractal.cabal
+++ b/hfractal.cabal
@@ -1,5 +1,5 @@
 name:                hfractal
-version:             0.3.1
+version:             0.3.2.1
 cabal-version:		 >= 1.2
 synopsis:            OpenGL fractal renderer
 description:	     An OpenGL fractal browser with multicore support and the capability to output high quality png images.
@@ -14,6 +14,6 @@
 
 Executable hfractal
     main-is:            Hfractal.hs
-    build-depends:      base >=3 && <5, array, gd < 3000.3.0 && >= 3000.2.0, data-accessor >=0.2 && <=0.3, data-accessor-template >=0.2 && <=0.3, OpenGL >= 2.3 && < 2.4, GLUT
-    other-Modules:      FracComp, FracState, FracImg, Bindings
-    ghc-options:        -O2 -threaded
+    build-depends:      base >=3 && <5, array, gd < 3000.3.0 && >= 3000.2.0, data-accessor >=0.2 && <=0.3, data-accessor-template >=0.2 && <=0.3, OpenGL >= 2.3 && < 2.4.0.0, OpenGLRaw < 1.1.0.0, GLUT >= 2.2.1.0 && < 2.2.2.0, colour >=2.3.1, containers >= 0.2
+    other-Modules:      FracComp, FracColour, FracImg, FracState, Bindings
+    ghc-options:        -O2 -threaded -fvia-C -optc-O3 -optc-ffast-math