diff --git a/Graphics/Rendering/Hieroglyph/Cache.hs b/Graphics/Rendering/Hieroglyph/Cache.hs
--- a/Graphics/Rendering/Hieroglyph/Cache.hs
+++ b/Graphics/Rendering/Hieroglyph/Cache.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE NoMonomorphismRestriction #-}
 -----------------------------------------------------------------------------
 --
 -- Module      :  Graphics.UI.Hieroglyph.Cache
@@ -16,43 +17,111 @@
 
 import qualified Data.Map as Map
 import qualified Data.IntMap as IntMap
+import Debug.Trace
 
-data Cache k a = Cache { store :: Map.Map k a, times :: IntMap.IntMap k, now :: Int, maxsize :: Int, size :: Int, decimation :: Int }
+m ! k = case Map.lookup k m of Just v -> v; Nothing -> error $ "lookup failed for " ++ show k
 
-empty mxsz dec = Cache Map.empty IntMap.empty 0 mxsz 0 dec
+data Cache k a = Cache 
+    { store :: Map.Map k a
+    , times :: IntMap.IntMap k
+    , now :: Int
+    , maxsize :: Int
+    , size :: Int
+    , decimation :: Int } deriving Show
 
-get :: Ord k => k -> Cache k a -> (Cache k a,Maybe a)
+
+-- get :: Ord k => k -> Cache k a -> (Cache k a,Maybe a)
 get key cache = (cache',value)
     where value = Map.lookup key (store cache)
-          cache' = maybe (cache{ now = now cache + 1 }) (\_ -> cache{ now = now cache + 1, times = IntMap.insert (now cache) key (times cache) }) value
+          cache' = maybe (cache{ now = now cache + 1 }) 
+                         (\_ -> cache{ now = now cache + 1
+                                     , times = IntMap.insert (now cache) key . IntMap.filter (/=key) . times $ cache }) 
+                         value
 
-put :: Ord k => k -> a -> Cache k a -> Cache k a
+-- putList :: Ord k => Cache k a -> [(k,a)] -> Cache k a
+putList = foldr (\(a,b) m -> put a b m)
+
+-- put :: Ord k => k -> a -> Cache k a -> Cache k a
 put key value cache
-    | size cache < maxsize cache && (not $ Map.member key (store cache)) = cache { now = now cache + 1, times = IntMap.insert (now cache) key (times cache), store = Map.insert key value (store cache) , size = size cache + 1 }
-    | size cache < maxsize cache = cache { now = now cache + 1, times = IntMap.insert (now cache) key (times cache), store = Map.insert key value (store cache) }
-    | size cache >= maxsize cache && (Map.member key (store cache)) = cache { now = now cache + 1, times = IntMap.insert (now cache) key (times cache), store = Map.insert key value (store cache) }
-    | size cache >= maxsize cache = cache{ now = now cache + 1, times = IntMap.insert (now cache) key times', store = Map.insert key value store', size = size cache - decimation cache }
+    | size cache < maxsize cache && (not $ Map.member key (store cache)) = cache 
+        { now = now cache + 1
+        , times = IntMap.insert (now cache) key . times $ cache
+        , store = Map.insert key value (store cache) 
+        , size = size cache + 1 }
+    | size cache < maxsize cache = cache 
+        { now = now cache + 1
+        , times = IntMap.insert (now cache) key . IntMap.filter (/=key) . times $ cache
+        , store = Map.insert key value (store cache) }
+    | size cache >= maxsize cache && (Map.member key (store cache)) = cache 
+        { now = now cache + 1
+        , times = IntMap.insert (now cache) key . IntMap.filter (/=key) . times $ cache
+        , store = Map.insert key value (store cache) }
+    | size cache >= maxsize cache = cache 
+        { now = now cache + 1
+        , times = IntMap.insert (now cache) key times'
+        , store = Map.insert key value store'
+        , size = size cache - decimation cache }
     where times' = foldr IntMap.delete (times cache) lowtimes
           (lowtimes,lowtimekeys) = unzip . take (decimation cache) . IntMap.toAscList . times $ cache
           store' = foldr Map.delete (store cache) lowtimekeys
 
-put' :: Ord k => k -> a -> Cache k a -> ([a], Cache k a)
+--  put' :: Ord k => k -> a -> Cache k a -> ([a], Cache k a)
 put' key value cache
-    | size cache < maxsize cache && (not $ Map.member key (store cache)) = ([],cache { now = now cache + 1, times = IntMap.insert (now cache) key (times cache), store = Map.insert key value (store cache) , size = size cache + 1 })
-    | size cache < maxsize cache = ([],cache { now = now cache + 1, times = IntMap.insert (now cache) key (times cache), store = Map.insert key value (store cache) })
-    | size cache >= maxsize cache && (Map.member key (store cache)) = ([],cache { now = now cache + 1, times = IntMap.insert (now cache) key (times cache), store = Map.insert key value (store cache) })
-    | size cache >= maxsize cache = (freed, cache{ now = now cache + 1, times = IntMap.insert (now cache) key times', store = Map.insert key value store', size = size cache - decimation cache })
+    | size cache < maxsize cache && (not $ Map.member key (store cache)) = ([]   ,cache 
+        { now = now cache + 1
+        , times = IntMap.insert (now cache) key . times $ cache
+        , store = Map.insert key value (store cache) 
+        , size = size cache + 1 })
+    | size cache < maxsize cache = ([]   ,cache 
+        { now = now cache + 1
+        , times = IntMap.insert (now cache) key . IntMap.filter (/=key) . times $ cache
+        , store = Map.insert key value (store cache) })
+    | size cache >= maxsize cache && (Map.member key (store cache)) = ([]   ,cache 
+        { now = now cache + 1
+        , times = IntMap.insert (now cache) key . IntMap.filter (/=key) . times $ cache
+        , store = Map.insert key value (store cache) })
+    | size cache >= maxsize cache = (freed, cache 
+        { now = now cache + 1
+        , times = IntMap.insert (now cache) key times'
+        , store = Map.insert key value store'
+        , size = size cache - decimation cache })
     where times' = foldr IntMap.delete (times cache) lowtimes
           (lowtimes,lowtimekeys) = unzip . take (decimation cache) . IntMap.toAscList . times $ cache
           store' = foldr Map.delete (store cache) lowtimekeys
           freed = map (store cache Map.!) lowtimekeys
 
-free :: Ord k => Cache k a -> ((k,a),Cache k a)
-free cache = ((minkey,minval),cache')
-    where minkey = IntMap.findMin (times cache)
-          minval = store cache Map.! minkey
-          cache' = cache{ now = now cache + 1, times = IntMap.deleteMin (times cache), store = Map.delete minkey (store cache), size = (size cache) }
+free cache = 
+    case minval of
+        Nothing -> free cache{ times= IntMap.deleteMin (times cache) }
+        Just mv -> ((minkey,mv), cache')
+    where minkey = IntMap.findMin $ (times cache)
+          minval = Map.lookup minkey (store cache)
+          cache' = cache{ now = now cache + 1
+                        , times = IntMap.deleteMin (times cache)
+                        , store = Map.delete minkey (store cache)
+                        , size = size cache - 1 }
 
+    
+{-    
+-- free :: Ord k => Cache k a -> ((k,a),Cache k a)
+free cache = 
+    ( (minkey,minval)
+    , cache' )
+    where minkey = Map.findMin (times cache)
+          minval = store cache ! minkey
+          cache' = cache{ now = now cache + 1
+                        , times = Map.deleteMin (times cache)
+                        , store = Map.delete minkey (store cache)
+                        , size = size cache - 1 }
+-}
+
+
+empty mxsz dec = Cache Map.empty IntMap.empty 0 mxsz 0 dec
+
 member :: Ord k => k -> Cache k a -> Bool
 member key cache = Map.member key (store cache)
+
+keys = Map.keys . store
+elems = Map.elems . store
+isEmpty x = store x == Map.empty
 
diff --git a/Graphics/Rendering/Hieroglyph/Cairo.hs b/Graphics/Rendering/Hieroglyph/Cairo.hs
--- a/Graphics/Rendering/Hieroglyph/Cairo.hs
+++ b/Graphics/Rendering/Hieroglyph/Cairo.hs
@@ -1,13 +1,4 @@
--- | Cairo backend to Hieroglyph.  Future plans include making 'StateModifier' part
---   of the base distribution and making 'Frame' the basis for all backends to
---   Hieroglyph.  The real challenge will be making all implementations /look/ the
---   same.
---
---   Note in particular that pattern functionality and Pango layouts and font
---   rendering engines are not implemented yet.  This is both because these
---   features are fairly complicated, and because I haven't figured out yet
---   how I might make them portable to OpenGL using textures and FTGL.  if
---   someone wants to take this task on, I'd be pleased as punch.
+-- | Cairo backend to Hieroglyph.  
 --
 --      [@Author@] Jeff Heard
 --
diff --git a/Graphics/Rendering/Hieroglyph/OpenGL.hs b/Graphics/Rendering/Hieroglyph/OpenGL.hs
--- a/Graphics/Rendering/Hieroglyph/OpenGL.hs
+++ b/Graphics/Rendering/Hieroglyph/OpenGL.hs
@@ -13,7 +13,15 @@
 --
 -----------------------------------------------------------------------------
 
-module Graphics.Rendering.Hieroglyph.OpenGL where
+module Graphics.Rendering.Hieroglyph.OpenGL 
+    ( module Graphics.Rendering.Hieroglyph.OpenGL.Data
+    , mouseSelectionBehaviour
+    , boilerplateOpenGLMain
+    , renderOnExpose
+    , renderBehaviour
+    , selectionBehaviour
+    , initializeBus)
+where
 
 import qualified Graphics.Rendering.Hieroglyph.Cache as Cache
 import System.Exit
@@ -22,6 +30,7 @@
 import Control.Concurrent
 import Control.Applicative
 import Control.Monad.Trans
+import qualified System.Glib.MainLoop as Gtk
 import Data.List (partition)
 import qualified Data.Set as Set
 import Data.Maybe
@@ -46,401 +55,118 @@
 import qualified Data.ByteString as SB
 import Foreign.C
 import qualified App.EventBus as Buster
+import qualified App.Widgets.GtkMouseKeyboard as Buster
 import Data.Colour
 import Data.Colour.Names
 import Data.Colour.SRGB
 import qualified Text.PrettyPrint as Pretty
 import System.Mem.Weak
 
-data HieroglyphGLRuntime = HgGL {
-    freetextures :: [GL.TextureObject]
-  , freebuffers :: [GL.BufferObject]
-  , compiledgeometry :: Map.Map GLuint CompiledData
-  , namemap :: Map.Map GLuint String
-  , drawarea :: Gtk.GLDrawingArea
-  , window :: Gtk.Window
-  , context ::PangoContext
-  , imagecache :: Cache.Cache Primitive ([Double],GL.TextureObject)
-  }
-  | Geometry BaseVisual
+import Graphics.Rendering.Hieroglyph.OpenGL.Render
+import Graphics.Rendering.Hieroglyph.OpenGL.Data
+import Graphics.Rendering.Hieroglyph.OpenGL.Compile
 
-reverseMouseCoords b x y = do
-    let renderDataE = fromJust $ Buster.eventByQName "Hieroglyph" "Hieroglyph" "RenderData" b
-    (_,sy) <- Gtk.widgetGetSize . Gtk.castToWidget . drawarea . (\(Buster.EOther a) -> a) . head . Buster.eventdata $ renderDataE
-    return (Point x (fromIntegral sy-y))
+-- | Select based on mouse clicks
+mouseSelectionBehaviour :: Buster.Behaviour [Buster.EData HieroglyphGLRuntime]
+mouseSelectionBehaviour bus = Buster.pollFullyQualifiedEventWith bus "Mouse" "Hieroglyph.KeyboardMouseWidget" "SingleClick" $ \event -> do
+    --print "MouseSelectionBehaviour"
+    let (Buster.EAssocL alist) = head . Buster.eventdata $ event
+        (Buster.EDoubleL (x:y:_)) = fromJust $ "coords" `lookup` alist
+    --print "Leaving mouse selection behaviour"
+    Buster.listM $ Buster.produce "Hieroglyph" "Hieroglyph" "PleaseSelect" Buster.once [Buster.EDouble x, Buster.EDouble y]
 
-arcFn _ _ _ [] = []
-arcFn x y r (t:ts) = (x + r * cos t) : (y + r * sin t) : arcFn x y r ts
-arcVertices nvertices (Point cx cy) r t1 t2 = arcFn cx cy r $ [t1+t | t <- [0,(t2-t1)/nvertices..t2-t1]]
 
-interleave (x:xs) (y:ys) = x:y:interleave xs ys
-interleave [] _ = []
-interleave _ [] = []
 
-cubic a c0 c1 b ts = fmap interpolateCubic ts
-   where interpolateCubic t = interpolate p20 p21 t
-            where p20 = interpolate p10 p11 t
-                  p21 = interpolate p11 p12 t
-                  p10 = interpolate a c0 t
-                  p11 = interpolate c0 c1 t
-                  p12 = interpolate c1 b t
-         interpolate x0 x1 t = x0 + ((x1 - x0)*t)
+boilerplateOpenGLMain widgets behaviour = do
+    evBus <- newMVar Buster.emptyBus
+    forM_ widgets ($evBus)
+    b <- takeMVar evBus
+    putMVar evBus b
 
-splineVertices nvertices (Point ax ay) (Point c0x c0y) (Point c1x c1y) (Point bx by) = interleave xs ys
-    where xs = cubic ax c0x c1x bx [m / nvertices' | m <- [0 .. nvertices']]
-          ys = cubic ay c0y c1y by [m / nvertices' | m <- [0 .. nvertices']]
-          nvertices' = (fromIntegral nvertices) :: Double
+    let Just (Buster.EOther glarea) = fmap (head . Buster.eventdata) $ Buster.eventByQName "Hieroglyph" "Hieroglyph"  "RenderData" b
+        loop mv = do
+            Gtk.mainContextIteration Gtk.mainContextDefault True
+            Buster.busIteration mv behaviour
+            loop mv
 
-data CompiledData =
-    CompiledDots
-        { attributes :: Attributes
-        , vertices :: [Double]
-        , uid :: GLuint }
-  | CompiledArc
-        { attributes :: Attributes
-        , vertices :: [Double]
-        , uid :: GLuint }
-  | CompiledPath
-        { attributes :: Attributes
-        , vertices :: [Double]
-        , uid :: GLuint }
-  | CompiledRectangle
-        { attributes :: Attributes
-        , vertices :: [Double]
-        , uid :: GLuint }
-  | CompiledText
-        { attributes :: Attributes
-        , vertices :: [Double]
-        , texture :: GL.TextureObject
-        , texcoords :: [Double]
-        , uid :: GLuint }
-  | CompiledImage
-        { attributes :: Attributes
-        , vertices :: [Double]
-        , channels :: Int
-        , ww :: Double
-        , hh :: Double
-        , texture :: GL.TextureObject
-        , texcoords :: [Double]
-        , uid :: GLuint }
-  | Optimized
-        { attributes :: Attributes
-        , vbo :: GL.BufferObject
-        , tbo :: Maybe GL.BufferObject
-        , tobj :: Maybe GL.TextureObject
-        , uid :: GLuint
-        , startindex :: Int
-        , len :: Int }
+    let mk = Buster.bindMouseKeyboardWidget (Gtk.castToWidget (window glarea))
+    mk evBus
+    loop evBus
 
-texturedObjects (CompiledDots _ _ _) = False
-texturedObjects (CompiledArc _ _ _) = False
-texturedObjects (CompiledPath _ _ _) = False
-texturedObjects (CompiledRectangle _ _ _) = False
-texturedObjects (CompiledText _ _ _  _ _) = True
-texturedObjects (CompiledImage _ _ _  _ _ _  _ _) = True
-texturedObjects (Optimized _ _ _ (Just _) _ _ _) = True
-texturedObjects _ = False
 
-colourToTuple :: AlphaColour Double -> (Double,Double,Double,Double)
-colourToTuple c = (r,g,b,alpha)
-    where alpha = alphaChannel c
-          c' = (1/alpha) `darken` (c `Data.Colour.over` black)
-          RGB r g b = toSRGB c'
+-- | make Hieroglyph render on the main window exposure
+renderOnExpose :: Buster.Widget [Buster.EData HieroglyphGLRuntime]
+renderOnExpose busV = do
+    bus <- takeMVar busV
+    putMVar busV bus
+    let runtimeE = fromJust $ Buster.eventByQName "Hieroglyph" "Hieroglyph" "RenderData" bus
+        Buster.EOther runtime = head . Buster.eventdata $ runtimeE
+        drawing = primitives . catMaybes . map getGeo . concat . map Buster.eventdata $ drawingEs
+        drawingEs = Set.toList $ Buster.eventsByGroup "Visible" bus
 
-colourToGL :: AlphaColour Double -> GL.Color4 Double
-colourToGL = (\(r,g,b,a) -> GL.Color4 r g b a) . colourToTuple
+    runtime' <- render runtime drawing
+    Buster.Insertion revent' <- Buster.produce "Hieroglyph" "Hieroglyph" "RenderData" Buster.Persistent [Buster.EOther runtime']
+    takeMVar busV
+    let bus' = Buster.addEvent revent' bus
+    putMVar busV bus'
 
-fillStrokeAndClip state action = do
-    let (fr,fg,fb,fa) = colourToTuple . afillRGBA $ state
-        (sr,sg,sb,sa) = colourToTuple . astrokeRGBA $ state
-    when (afilled state) $ Cairo.setSourceRGBA fr fg fb fa >> action >> Cairo.fill
-    when (aoutlined state) $ Cairo.setSourceRGBA sr sg sb sa >> action >> Cairo.stroke
-    when (aclipped state) $ Cairo.clip
+-- | Make Hieroglyph send out expose events when it sees a (Hieroglyph,Hieroglyph,Rerender) event.
+renderBehaviour bus = Buster.consumeFullyQualifiedEventWith bus "Hieroglyph" "Hieroglyph"  "Rerender" $ \event -> do
+    let Buster.EOther renderdata = head . Buster.eventdata . fromJust $ Buster.eventByQName "Hieroglyph" "Hieroglyph" "RenderData" bus
+    (w,h) <- Gtk.widgetGetSize (window renderdata)
+    Gtk.widgetQueueDrawArea (window renderdata) 0 0 w h   
+    return $ []
 
 
-compile e a@(Dots _ _ _) = return $ compileDots e a
-compile e a@(Arc _ _ _  _ _ _  _) = return $ compileArc e a
-compile e a@(Path _ _ _  _ _ ) = return $ compilePath e a
-compile e a@(Rectangle _ _ _  _ _) = return $ compileRectangle e a
-compile e a@(Text _ _ _  _ _ _  _ _ _  _) = compileText e a
-compile e a@(Image _ _ _  _ _) = compileImage e a
+-- | a behaviour to render hieroglyph data to the selection buffer when it sees a (Hieroglyph,Hieroglyph,PleaseSelect) event.
+--   Produces (Selection,Hieroglyph,@objectname@) events.
+selectionBehaviour :: Buster.Behaviour [Buster.EData HieroglyphGLRuntime]
+selectionBehaviour bus =
+    case selectionRequested of
+        Just sreq -> do -- print "Selection requested"
+                        let [Buster.EDouble selx, Buster.EDouble sely] = Buster.eventdata sreq
+                        (p, GL.Size sx sy ) <- GL.get GL.viewport
+                        GL.depthFunc $= Just GL.Less
+                        GL.clear [GL.ColorBuffer, GL.DepthBuffer]
+                        GL.matrixMode $= GL.Projection
+                        GL.loadIdentity
+                        GL.pickMatrix (selx-2, (fromIntegral sy)-sely+2) (6,6) (p, GL.Size sx sy)
+                        GL.ortho 0 (fromIntegral sx) 0 (fromIntegral sy) 1 10247680
+                        (runtime', recs) <- GL.getHitRecords 5 $ renderObjects [1::Double,2..] (sort drawing) runtime
+                        selectionEvents <- forM (fromMaybe [] recs) $ \(GL.HitRecord x y names) ->
+                            let names' = (fromMaybe "" . ((flip Map.lookup) (namemap runtime')) . (\(GL.Name x) -> x)) <$> names in do
+                            --print names
+                            print names'
+                            Buster.produce "Selection" "Hieroglyph" (concat names') Buster.once
+                                [Buster.EDouble . realToFrac $ x
+                                , Buster.EDouble . realToFrac $ y
+                                , Buster.EStringL $ names']
 
-compileDots e (Dots ds attrs s) = (maybe e (\n -> e{ namemap=Map.insert (fromIntegral s) n (namemap e)}) (aname attrs), CompiledDots attrs (vdata ds) (fromIntegral s))
-    where vdata ((Point x y):vs) = x:y:vdata vs
-          vdata [] = []
+                        runtimeE' <- Buster.produce "Hieroglyph" "Hieroglyph" "RenderData" Buster.Persistent [Buster.EOther runtime']
+                        Buster.future bus . return $ [Buster.Deletion sreq , runtimeE'] ++ selectionEvents
 
-compileArc e (Arc (Point cx cy) r t1 t2 reverse attrs sg) =  (maybe e (\n -> e{ namemap=Map.insert (fromIntegral sg) n (namemap e)}) (aname attrs),a0)
-    where a0 = CompiledArc
-                    attrs
-                    (cx : cy : arcVertices 360
-                                 (Point cx cy)
-                                 r
-                                 (if reverse then t2 else t1)
-                                 (if reverse then t1 else t2))
-                    (fromIntegral sg)
+        Nothing -> Buster.future bus . return $ []
+    where runtimeE = fromJust $ Buster.eventByQName "Hieroglyph" "Hieroglyph" "RenderData" bus
+          Buster.EOther runtime = head . Buster.eventdata $ runtimeE
+          drawing = primitives . catMaybes . map getGeo . concat . map Buster.eventdata $ drawingEs
+          drawingEs = Set.toList $ Buster.eventsByGroup "Visible" bus
+          selectionRequested = Buster.eventByQName "Hieroglyph" "Hieroglyph" "PleaseSelect" bus
 
 
-compilePath e p = (maybe e (\n -> e{ namemap=Map.insert (fromIntegral (sig p)) n (namemap e) }) (aname . attribs $ p)  , CompiledPath (attribs p) (fillablePath p) (fromIntegral (sig p)))
-    where fillablePath p = pathOutline' (centroid (begin p:(ls2pt <$> segments p))) (Line (begin p): segments p)
-          pathOutline p = pathOutline' (begin p) (segments p)
-          pathOutline' (Point x0 y0) (Line (Point x1 y1) : ps) = [x0,y0,x1,y1] ++ pathOutline' (Point x1 y1) ps
-          pathOutline' (Point x0 y0) (EndPoint (Point x1 y1) : ps) = pathOutline' (Point x1 y1) ps
-          pathOutline' a (Spline c0 c1 b:ps) = splineVertices 256 a c0 c1 b ++ pathOutline' b ps
-          pathOutline' _ [] = []
 
-compileRectangle e (Rectangle (Point x y) w h attrs sg)  = (maybe e (\n -> e{ namemap=Map.insert (fromIntegral sg) n (namemap e) }) (aname attrs),CompiledRectangle attrs [x, y, x+w, y, x+w, y+h, x, y+h] (fromIntegral sg))
-
-dataFrom (SB.PS d _ _) = d
-
-nearestPowerOfTwo w h = (log2 $ wf, log2 $ hf)
-    where log2 x = logDouble x / logDouble 2
-          wf =  w
-          hf =  h
-
-compileText e txt
- | txt `Cache.member` (imagecache e) =
-    let (cache',Just (vertexdata, tex)) = Cache.get txt (imagecache e)
-        e0  = maybe e (\n -> e{ namemap=Map.insert (fromIntegral (sig txt)) n (namemap e) }) (aname . attribs $ txt)
-    in return (e0{ imagecache=cache' }, CompiledText (attribs txt) vertexdata tex [0,1,1,1,1,0,0,0] (fromIntegral (sig txt)))
- | otherwise = do
-    layout <- layoutEmpty (context e)
-    layoutSetMarkup layout . Pretty.render . str $ txt
-    layoutSetAlignment layout . align $ txt
-    layoutSetJustify layout . justify $ txt
-    layoutSetWidth layout . wrapwidth $ txt
-    layoutSetWrap layout . wrapmode $ txt
-    layoutSetIndent layout . indent $ txt
-    (PangoRectangle _ _ _ _, PangoRectangle x y w h) <- layoutGetExtents layout
-    let (po2w,po2h) = nearestPowerOfTwo w h
-        potw = 2 ^ ceiling po2w
-        poth = 2 ^ ceiling po2h
-        Point strx stry = bottomleft txt
-
-    -- print ("Power of two ", x,y,w,h, potw,poth)
-    textSurface <- Cairo.withImageSurface Cairo.FormatARGB32 potw poth $ \surf -> do
-        Cairo.renderWith surf $ do
-            Cairo.setOperator Cairo.OperatorSource
-            Cairo.setSourceRGBA 1 1 1 0
-            Cairo.rectangle 0 0 w h
-            Cairo.fill
-            Cairo.setOperator Cairo.OperatorOver
-            Cairo.updateContext (context e)
-            liftIO $ layoutContextChanged layout
-            Cairo.save
-            Cairo.translate (-x) (-y)
-            fillStrokeAndClip (attribs txt) $ Cairo.showLayout layout
-            Cairo.restore
-        -- Cairo.surfaceWriteToPNG surf "foo.png"
-        Cairo.imageSurfaceGetData surf
-
-    let ((_,(_,tex)),imagecache') = Cache.free (imagecache e)
-        freetextures' = tex:(freetextures e)
-        e0 = case freetextures e of
-                [] -> e{ freetextures = freetextures', imagecache = imagecache' }
-                ts -> e
-
-        e1 = maybe e0 (\n -> e0{ namemap=Map.insert (fromIntegral (sig txt)) n (namemap e0) }) (aname . attribs $ txt)
-
-    GL.textureBinding GL.Texture2D $= Just (head (freetextures e0))
-    GL.textureWrapMode GL.Texture2D GL.S $= (GL.Repeated, GL.Clamp)
-    GL.textureWrapMode GL.Texture2D GL.T $= (GL.Repeated, GL.Clamp)
-    GL.textureFilter GL.Texture2D $= ((GL.Linear', Nothing), GL.Linear')
-    GL.textureFunction $= GL.Decal
-    GL.texImage2D Nothing
-        GL.NoProxy
-        0
-        GL.RGBA'
-        (GL.TextureSize2D (fromIntegral potw) (fromIntegral poth))
-        0
-        (GL.PixelData GL.BGRA
-        GL.UnsignedByte
-        (unsafeForeignPtrToPtr (dataFrom textSurface)))
-
-    return ( e1{ freetextures=tail (freetextures e0)
-               , imagecache = Cache.put txt ([strx,stry
-                                             ,strx+fromIntegral potw
-                                             ,stry,strx+fromIntegral potw,stry+fromIntegral poth
-                                             ,strx,stry+fromIntegral poth]
-                                            ,(head (freetextures e0)))
-                                        (imagecache e0) }
-           , CompiledImage (attribs txt)
-                           [strx,stry
-                           ,strx+fromIntegral potw,stry
-                           ,strx+fromIntegral potw,stry+fromIntegral poth
-                           ,strx,stry+fromIntegral poth]
-                           3 0 0
-                           (head (freetextures e0))
-                           [0,1,1,1,1,0,0,0]
-                           (fromIntegral (sig txt)))
-
-compileImage e img = do
-    let (cache', cachehit) = Cache.get img (imagecache e)
-    case cachehit of
-        Just (vdata, tex) -> return (e{ imagecache=cache' }, CompiledImage (attribs img) vdata 0 0 0 tex [0,1,1,1,1,0,0,0] (fromIntegral (sig img)))
-        Nothing -> do
-            (w,h,potw,poth,channels,buffer) <- case dimensions img of
-                        (Left (Point x y)) -> Gtk.pixbufNewFromFile (filename img) >>= copydata
-                        (Right (Rect x y w h)) -> Gtk.pixbufNewFromFileAtScale (filename img) (round w) (round h) (preserveaspect img) >>= copydata
-            let ((_,(_,tex)),imagecache') = Cache.free (imagecache e)
-                freetextures' = tex:(freetextures e)
-                e0 = case freetextures e of
-                        [] -> e{ freetextures = freetextures', imagecache = imagecache' }
-                        ts -> e
-            GL.textureBinding GL.Texture2D $= Just (head (freetextures e0))
-            GL.textureWrapMode GL.Texture2D GL.S $= (GL.Repeated, GL.Clamp)
-            GL.textureWrapMode GL.Texture2D GL.T $= (GL.Repeated, GL.Clamp)
-            GL.textureFilter GL.Texture2D $= ((GL.Linear', Nothing), GL.Linear')
-            GL.textureFunction $= GL.Decal
-
-            GL.texImage2D Nothing
-                GL.NoProxy
-                0
-                (if channels == 4 then GL.RGBA' else GL.RGB')
-                (GL.TextureSize2D (fromIntegral potw) (fromIntegral poth))
-                0
-                (GL.PixelData (if channels == 4 then GL.RGBA else GL.RGB)
-                GL.UnsignedByte
-                (unsafeForeignPtrToPtr (dataFrom buffer)))
-            let vertexdata = case dimensions img of
-                                Left (Point x y) -> [x,y,x+fromIntegral w,y,x+fromIntegral w, y+fromIntegral h, x, y+fromIntegral h]
-                                Right (Rect x y w' h') -> [x,y,x+w',y,x+w',y+h',x,y+h']
-
-            let e1 = maybe e0 (\n -> e0{ namemap=Map.insert (fromIntegral (sig img)) n (namemap e0) }) (aname . attribs $ img)
-            return ( e1{ freetextures=tail (freetextures e1) }
-                   , CompiledImage (attribs img) vertexdata channels (fromIntegral w) (fromIntegral h) (head (freetextures e0)) [0,1,1,1,1,0,0,0] (fromIntegral (sig img)))
-
-
-renderCompiledGeometry (CompiledDots attrs vdata iid) = do
-    let verticesFrom (x:y:vs) = GL.Vertex2 x y : verticesFrom vs
-        verticesFrom [] = []
-    GL.color . colourToGL . afillRGBA $ attrs
-    GL.withName (GL.Name iid)  . GL.renderPrimitive GL.Points . mapM_ GL.vertex . verticesFrom $ vdata
-
-renderCompiledGeometry obj@(CompiledArc attrs vdata iid) =
-    (GL.textureBinding GL.Texture2D $= Nothing) >> renderObject obj
-
-renderCompiledGeometry obj@(CompiledPath _ _ _) =
-    (GL.textureBinding GL.Texture2D $= Nothing) >> renderObject obj
-
-renderCompiledGeometry obj@(CompiledRectangle attrs vdata iid) = do
-    GL.textureBinding GL.Texture2D $= Nothing
-    loadAttrs attrs
-    GL.color . colourToGL . afillRGBA . attributes $ obj
-    when (afilled attrs) . GL.withName (GL.Name iid) . GL.renderPrimitive GL.Quads . mapM_ GL.vertex $ verticesFrom vdata
-    GL.color . colourToGL . astrokeRGBA . attributes $ obj
-    when (aoutlined attrs) . GL.withName (GL.Name iid) . GL.renderPrimitive GL.LineStrip $ (mapM_ GL.vertex . verticesFrom $ vdata) >> (GL.vertex . head . verticesFrom $ vdata)
-  where verticesFrom (x:y:vs) = GL.Vertex2 x y : verticesFrom vs
-        verticesFrom [] = []
-
-renderCompiledGeometry obj@(CompiledText _ vdata tex txcs iid) = do
-    -- let (GL.TextureObject tid) = tex in print tid
-    GL.textureFunction $= GL.Replace
-    GL.color $ GL.Color4 1 1 1 (1::Double)
-    GL.texture GL.Texture2D $= GL.Enabled
-    GL.textureBinding GL.Texture2D $= Just tex
-    GL.texture GL.Texture2D $= GL.Enabled
-    GL.textureFunction $= GL.Replace
-
-    GL.withName (GL.Name iid)  . GL.renderPrimitive GL.Quads $ do
-        GL.texCoord $ GL.TexCoord2 (txcs !! 0) (txcs !! 1)
-        GL.vertex   $ GL.Vertex2 (vdata !! 0) (vdata !! 1)
-        GL.texCoord $ GL.TexCoord2 (txcs !! 2) (txcs !! 3)
-        GL.vertex   $ GL.Vertex2 (vdata !! 2) (vdata !! 3)
-        GL.texCoord $ GL.TexCoord2 (txcs !! 4) (txcs !! 5)
-        GL.vertex   $ GL.Vertex2 (vdata !! 4) (vdata !! 5)
-        GL.texCoord $ GL.TexCoord2 (txcs !! 6) (txcs !! 7)
-        GL.vertex   $ GL.Vertex2 (vdata !! 6) (vdata !! 7)
-        GL.flush
-
-
-renderCompiledGeometry obj@(CompiledImage _ vdata _ w h tex txcs iid) = do
-    -- let (GL.TextureObject tid) = tex in print tid
-    GL.textureFunction $= GL.Replace
-    GL.color $ GL.Color4 1 1 1 (1::Double)
-    GL.texture GL.Texture2D $= GL.Enabled
-    GL.textureBinding GL.Texture2D $= Just tex
-    GL.texture GL.Texture2D $= GL.Enabled
-    GL.textureFunction $= GL.Replace
-
-    GL.withName (GL.Name iid)  . GL.renderPrimitive GL.Quads $ do
-        GL.texCoord $ GL.TexCoord2 (txcs !! 0) (txcs !! 1)
-        GL.vertex   $ GL.Vertex2 (vdata !! 0) (vdata !! 1)
-        GL.texCoord $ GL.TexCoord2 (txcs !! 2) (txcs !! 3)
-        GL.vertex   $ GL.Vertex2 (vdata !! 2) (vdata !! 3)
-        GL.texCoord $ GL.TexCoord2 (txcs !! 4) (txcs !! 5)
-        GL.vertex   $ GL.Vertex2 (vdata !! 4) (vdata !! 5)
-        GL.texCoord $ GL.TexCoord2 (txcs !! 6) (txcs !! 7)
-        GL.vertex   $ GL.Vertex2 (vdata !! 6) (vdata !! 7)
-        GL.flush
-
-
-renderCompiledGeometry obj@(Optimized attrs vbo tbo tex iid startindex len) = do
-    GL.bindBuffer GL.ArrayBuffer $= Just vbo
-    GL.arrayPointer GL.VertexArray $= GL.VertexArrayDescriptor 2 GL.Double 0 nullPtr
-    maybe (return ())
-          (\t -> do GL.bindBuffer GL.ArrayBuffer $= Just t
-                    GL.arrayPointer GL.TextureCoordArray $= GL.VertexArrayDescriptor 2 GL.Double 0 nullPtr) tbo
-    GL.texture GL.Texture2D $= GL.Enabled
-    GL.textureBinding GL.Texture2D $= tex
-    GL.color . colourToGL . afillRGBA . attributes $ obj
-    when (afilled attrs) $ GL.drawArrays GL.TriangleFan (fromIntegral startindex) (fromIntegral len)
-    GL.color . colourToGL . astrokeRGBA . attributes $ obj
-    when (aoutlined attrs) $ GL.drawArrays GL.LineStrip (fromIntegral $ startindex+2) (fromIntegral len)
-
-renderObject obj
-    | afilled (attributes obj) = GL.preservingMatrix $ do
-                                    loadAttrs (attributes obj )
-                                    GL.color . colourToGL . afillRGBA . attributes $ obj
-                                    GL.withName (GL.Name (uid obj)) . GL.renderPrimitive GL.TriangleFan . mapM_ GL.vertex . verticesFrom $ vertices obj
-                                    GL.color . colourToGL . astrokeRGBA . attributes $ obj
-                                    when (aoutlined (attributes obj)) $ (GL.withName (GL.Name (uid obj)) . GL.renderPrimitive GL.LineStrip . mapM_ GL.vertex . verticesFrom . drop 2 $ vertices obj)
-    | otherwise                = GL.preservingMatrix $ do
-                                    loadAttrs (attributes obj)
-                                    GL.color . colourToGL . astrokeRGBA . attributes $ obj
-                                    GL.withName (GL.Name (uid obj)) . GL.renderPrimitive GL.LineStrip . mapM_ GL.vertex . verticesFrom . drop 2 $ vertices obj
-
-    where verticesFrom (x:y:vs) = GL.Vertex2 x y : verticesFrom vs
-          verticesFrom [] = []
-
---optimize !ptr i (CompiledPoints _ attrs vs iid) =
---optimize !ptr i (CompiledArc _ attrs vs iid) =
---optimize !ptr i (CompiledPath _ attrs vs iid) =
---optimize !ptr i (CompiledRectangle _ attrs vs iid) =
---optimize !ptr i (CompiledText _ attrs vs w h t iid) =
---optimize !ptr i (CompiledImage _ attrs vs c b w h t iid) =
---optimize !ptr i (Optimized attrs vbo tbo t iid) =
-
-
-loadAttrs attrs = GL.preservingMatrix $ do
-    GL.lineWidth $= (realToFrac . alinewidth $ attrs)
-    GL.matrixMode $= GL.Modelview 0
-    GL.loadIdentity
-    GL.translate $ GL.Vector3 (atranslatex attrs) (atranslatey attrs) 0
-    GL.scale (ascalex attrs) (ascaley attrs) 1
-    GL.rotate (arotation attrs) $ GL.Vector3 0 0 1
-    GL.lineSmooth $= GL.Enabled
-    GL.polygonSmooth $= GL.Enabled
-    -- TODO support line cap
-    -- TODO support line join
-    -- TODO support miter limit
-    -- TODO support trapezoidal tolerance
-    -- TODO support operator
-    -- TODO support antialias
-    -- TODO support dash/stipple
-    -- TODO support pattern fill rule
-
 -- | Widget for initializing the bus
 initializeBus :: String -> Int -> Int -> Buster.Widget [Buster.EData HieroglyphGLRuntime]
 initializeBus name w h bus = do
-    let numTextures = 400
-        numBufferObjects = 1
+    let numTextures = 512    
+        numBufferObjects = 256
+
     Gtk.unsafeInitGUIForThreadedRTS
     win <- Gtk.windowNew
     Gtk.windowSetTitle win name
     Gtk.widgetSetName win "Hieroglyph"
     Gtk.onDestroy win (exitWith ExitSuccess)
-    Gtk.initGL
-    config <- Gtk.glConfigNew [Gtk.GLModeRGBA, {- Gtk.GLModeMultiSample, -} Gtk.GLModeDouble, Gtk.GLModeAlpha]
+    Gtk.initGL >>= mapM_ putStrLn
+    config <- Gtk.glConfigNew [Gtk.GLModeRGBA, Gtk.GLModeMultiSample, Gtk.GLModeDouble, Gtk.GLModeDepth, Gtk.GLModeAlpha]
     area <- Gtk.glDrawingAreaNew config
 
     Gtk.onRealize area $ do
@@ -457,136 +183,8 @@
 
     context <- Gtk.cairoCreateContext Nothing
 
-    let edata = HgGL textures buffers Map.empty Map.empty area win context ( Cache.empty 1024768000 0)
+    let edata = HgGL textures (Cache.empty 1024768000 0) [] buffers (Cache.empty 1024768000 0) [] Map.empty area win context Map.empty
     Buster.produce' "Hieroglyph" "Hieroglyph" "RenderData" Buster.Persistent [Buster.EOther edata] bus
 
     Gtk.onExpose area (\_ -> renderOnExpose bus >> return True)
     return ()
-
--- | a behaviour to render hieroglyph data to the selection buffer when it sees a (Hieroglyph,Hieroglyph,PleaseSelect) event.
---   Produces (Selection,Hieroglyph,@objectname@) events.
-selectionBehaviour :: Buster.Behaviour [Buster.EData HieroglyphGLRuntime]
-selectionBehaviour bus =
-    case selectionRequested of
-        Just sreq -> do let [Buster.EDouble selx, Buster.EDouble sely] = Buster.eventdata sreq
-                        (p, GL.Size sx sy ) <- GL.get GL.viewport
-                        GL.matrixMode $= GL.Projection
-                        GL.loadIdentity
-                        GL.pickMatrix (selx-2, (fromIntegral sy)-sely+2) (6,6) (p, GL.Size sx sy)
-                        GL.ortho2D 0 (fromIntegral sx) 0 (fromIntegral sy)
-                        (runtime', recs) <- GL.getHitRecords 5 $ renderObjects (sort drawing) runtime
-                        selectionEvents <- forM (fromMaybe [] recs) $ \(GL.HitRecord x y names) ->
-                            let names' = (fromMaybe "" . ((flip Map.lookup) (namemap runtime')) . (\(GL.Name x) -> x)) <$> names in
-                            Buster.produce "Selection" "Hieroglyph" (concat names') Buster.once
-                                [Buster.EDouble . realToFrac $ x
-                                , Buster.EDouble . realToFrac $ y
-                                , Buster.EStringL $ names']
-
-                        runtimeE' <- Buster.produce "Hieroglyph" "Hieroglyph" "RenderData" Buster.Persistent [Buster.EOther runtime']
-                        Buster.future bus . return $ [Buster.Deletion sreq , runtimeE'] ++ selectionEvents
-
-        Nothing -> Buster.future bus . return $ []
-    where runtimeE = fromJust $ Buster.eventByQName "Hieroglyph" "Hieroglyph" "RenderData" bus
-          Buster.EOther runtime = head . Buster.eventdata $ runtimeE
-          drawing = primitives . map (\(Buster.EOther (Geometry x)) -> x) . concat . map Buster.eventdata $ drawingEs
-          drawingEs = Set.toList $ Buster.eventsByGroup "Visible" bus
-          selectionRequested = Buster.eventByQName "Hieroglyph" "Hieroglyph" "PleaseSelect" bus
-
--- | make Hieroglyph render on the main window exposure
-renderOnExpose :: Buster.Widget [Buster.EData HieroglyphGLRuntime]
-renderOnExpose busV = do
-    bus <- takeMVar busV
-    putMVar busV bus
-    let runtimeE = fromJust $ Buster.eventByQName "Hieroglyph" "Hieroglyph" "RenderData" bus
-        Buster.EOther runtime = head . Buster.eventdata $ runtimeE
-        drawing = primitives . map (\(Buster.EOther (Geometry x)) -> x) . concat . map Buster.eventdata $ drawingEs
-        drawingEs = Set.toList $ Buster.eventsByGroup "Visible" bus
-
-    -- print . map (aname . attribs) $ drawing
-
-    --putStrLn "Drawables:"
-    --mapM (print . Buster.showQName) drawingEs
-    -- putStrLn ""
-    -- print "expose event"
-    runtime' <- render  runtime drawing
-    Buster.Insertion revent' <- Buster.produce "Hieroglyph" "Hieroglyph" "RenderData" Buster.Persistent [Buster.EOther runtime]
-    takeMVar busV
-    let bus' = Buster.addEvent revent' bus
-    putMVar busV bus'
-
--- | Make Hieroglyph send out expose events when it sees a (Hieroglyph,Hieroglyph,Rerender) event.
-renderBehaviour bus = Buster.consumeFullyQualifiedEventWith bus "Hieroglyph" "Hieroglyph"  "Rerender" $ \event -> do
-    let Buster.EOther renderdata = head . Buster.eventdata . fromJust $ Buster.eventByQName "Hieroglyph" "Hieroglyph" "RenderData" bus
-    (w,h) <- Gtk.widgetGetSize (window renderdata)
-    Gtk.widgetQueueDrawArea (window renderdata) 0 0 w h
-    return []
-
-render runtime@(HgGL _ _ _ _ win _ _ _) geo = Gtk.withGLDrawingArea win $ \drawable -> do
-    GL.drawBuffer $= GL.BackBuffers
-    (GL.Position px py, GL.Size sx sy ) <- GL.get GL.viewport
-    GL.matrixMode $= GL.Projection
-    GL.loadIdentity
-    GL.ortho2D 0 (fromIntegral sx) 0 (fromIntegral sy)
-    GL.clearColor $= GL.Color4 1 1 1 1
-    GL.clear [GL.ColorBuffer]
-    GL.blend $= GL.Enabled
-    GL.blendFunc $= (GL.SrcAlpha, GL.OneMinusSrcAlpha)
-    GL.lineSmooth $= GL.Enabled
-    GL.polygonSmooth $= GL.Enabled
-    r' <- renderObjects (sort geo) runtime
-    Gtk.glDrawableSwapBuffers drawable
-    return r'
-
-renderObjects (o:os) !r = renderObj o r >>= renderObjects os
-renderObjects [] r = return r
-
-renderObj :: Primitive -> HieroglyphGLRuntime -> IO HieroglyphGLRuntime
-renderObj obj runtime = do
-        (runtime',cg0) <- compile runtime obj
-        renderCompiledGeometry cg0
-        return runtime'{ compiledgeometry = Map.insert (uid cg0) cg0 . compiledgeometry $ runtime'
-                       , namemap=Map.insert (uid cg0)
-                                            (fromMaybe "" . aname . attributes $ cg0)
-                                            (namemap runtime')
-                       }
-
-{-# INLINE copydata #-}
-copydata pbuf0 = do
-    w0 <- Gtk.pixbufGetWidth pbuf0
-    h0 <- Gtk.pixbufGetHeight pbuf0
-    let potw = log (fromIntegral w0) / log (fromIntegral 2)
-        poth = log (fromIntegral h0) / log (fromIntegral 2)
-        w = 2 ^ ceiling potw
-        h = 2 ^ ceiling poth
-    pbuf <- if w0 == w && h0 == h then return pbuf0 else Gtk.pixbufScaleSimple pbuf0 w h Gtk.InterpBilinear
-
-    channels <- Gtk.pixbufGetNChannels pbuf
-    bpc <- (`quot`8) <$> Gtk.pixbufGetBitsPerSample pbuf
-    pixels <- Gtk.pixbufGetPixels pbuf :: IO (Gtk.PixbufData Int Word8)
-    stride <- Gtk.pixbufGetRowstride pbuf
-    buf <- SB.create (w*h*channels*bpc) $ \ptr ->
-        forM_ [0::Int .. h - 1] $ \row -> let stsample = row*stride in
-            forM_ [0::Int .. w*channels*bpc-1] $ \sample0 -> let sample = stsample + sample0 in
-                A.readArray pixels sample >>= pokeByteOff ptr sample
-    return (w0,h0,w,h,channels,buf)
-
--- | Select based on mouse clicks
-mouseSelectionBehaviour :: Buster.Behaviour [Buster.EData HieroglyphGLRuntime]
-mouseSelectionBehaviour bus = Buster.pollFullyQualifiedEventWith bus "Mouse" "Hieroglyph.KeyboardMouseWidget" "SingleClick" $ \event -> do
-    let (Buster.EAssocL alist) = head . Buster.eventdata $ event
-        (Buster.EDoubleL (x:y:_)) = fromJust $ "coords" `lookup` alist
-    Buster.listM $ Buster.produce "Hieroglyph" "Hieroglyph" "PleaseSelect" Buster.once [Buster.EDouble x, Buster.EDouble y]
-
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/Graphics/Rendering/Hieroglyph/OpenGL/Compile.hs b/Graphics/Rendering/Hieroglyph/OpenGL/Compile.hs
new file mode 100644
--- /dev/null
+++ b/Graphics/Rendering/Hieroglyph/OpenGL/Compile.hs
@@ -0,0 +1,264 @@
+{-# LANGUAGE BangPatterns #-}
+-----------------------------------------------------------------------------
+--
+-- Module      :  Graphics.Rendering.Hieroglyph.OpenGL
+-- Copyright   :
+-- License     :  BSD3
+--
+-- Maintainer  :  J.R. Heard
+-- Stability   :
+-- Portability :
+--
+-- |
+--
+-----------------------------------------------------------------------------
+
+module Graphics.Rendering.Hieroglyph.OpenGL.Compile where
+
+import Graphics.Rendering.Hieroglyph.OpenGL.Data
+import qualified Graphics.Rendering.Hieroglyph.Cache as Cache
+import System.Exit
+import GHC.Float
+import Data.List
+import Control.Concurrent
+import Control.Applicative
+import Control.Monad.Trans
+import qualified System.Glib.MainLoop as Gtk
+import Data.List (partition)
+import qualified Data.Set as Set
+import Data.Maybe
+import Graphics.UI.Gtk.Cairo as Cairo
+import qualified Graphics.Rendering.Cairo as Cairo
+import qualified Data.Array.MArray as A
+import Control.Monad
+import Graphics.UI.Gtk.Pango.Context
+import Graphics.UI.Gtk.Pango.Layout
+import Foreign
+import qualified Data.Map as Map
+import qualified Graphics.UI.Gtk as Gtk
+import qualified Graphics.UI.Gtk.OpenGL as Gtk
+import qualified Graphics.UI.Gtk.OpenGL.Drawable as Gtk
+import qualified Graphics.UI.Gtk.Gdk.Events as Gtk
+import qualified Data.ByteString.Internal as SB
+import qualified Graphics.Rendering.Cairo as Cairo -- for rendering fonts
+import qualified Graphics.Rendering.OpenGL as GL
+import Graphics.Rendering.OpenGL(GLuint, Vertex2, ($=))
+import Graphics.Rendering.Hieroglyph.Primitives
+import Graphics.Rendering.Hieroglyph.Visual
+import qualified Data.ByteString as SB
+import Foreign.C
+import qualified App.EventBus as Buster
+import qualified App.Widgets.GtkMouseKeyboard as Buster
+import Data.Colour
+import Data.Colour.Names
+import Data.Colour.SRGB
+import qualified Text.PrettyPrint as Pretty
+import System.Mem.Weak
+arcFn _ _ _ [] = []
+arcFn x y r (t:ts) = (x + r * cos t) : (y + r * sin t) : arcFn x y r ts
+arcVertices nvertices (Point cx cy) r t1 t2 = arcFn cx cy r $ [t1+t | t <- [0,(t2-t1)/nvertices..t2-t1]]
+
+interleave (x:xs) (y:ys) = x:y:interleave xs ys
+interleave [] _ = []
+interleave _ [] = []
+
+cubic a c0 c1 b ts = fmap interpolateCubic ts
+   where interpolateCubic t = interpolate p20 p21 t
+            where p20 = interpolate p10 p11 t
+                  p21 = interpolate p11 p12 t
+                  p10 = interpolate a c0 t
+                  p11 = interpolate c0 c1 t
+                  p12 = interpolate c1 b t
+         interpolate x0 x1 t = x0 + ((x1 - x0)*t)
+
+splineVertices nvertices (Point ax ay) (Point c0x c0y) (Point c1x c1y) (Point bx by) = interleave xs ys
+    where xs = cubic ax c0x c1x bx [m / nvertices' | m <- [0 .. nvertices']]
+          ys = cubic ay c0y c1y by [m / nvertices' | m <- [0 .. nvertices']]
+          nvertices' = (fromIntegral nvertices) :: Double
+    
+compile e a@(Dots _ _ _) = return $ compileDots e a
+compile e a@(Arc _ _ _  _ _ _  _) = return $ compileArc e a
+compile e a@(Path _ _ _  _ _ ) = return $ compilePath e a
+compile e a@(Rectangle _ _ _  _ _) = return $ compileRectangle e a
+compile e a@(Text _ _ _  _ _ _  _ _ _  _) = compileText e a
+compile e a@(Image _ _ _  _ _) = compileImage e a
+
+compileDots e p@(Dots ds attrs s) = (maybe e (\n -> e{ namemap=Map.insert (fromIntegral s) n (namemap e)}) (aname attrs), CompiledDots p (vdata ds) (fromIntegral s))
+    where vdata ((Point x y):vs) = x:y:vdata vs
+          vdata [] = []
+
+compileArc e p@(Arc (Point cx cy) r t1 t2 reverse attrs sg) =  (maybe e (\n -> e{ namemap=Map.insert (fromIntegral sg) n (namemap e)}) (aname attrs),a0)
+    where a0 = CompiledArc
+                    p
+                    (cx : cy : arcVertices 180
+                                 (Point cx cy)
+                                 r
+                                 (if reverse then t2 else t1)
+                                 (if reverse then t1 else t2))
+                    (fromIntegral sg)
+
+compilePath e p =
+    (maybe e
+           (\n -> e{ namemap=Map.insert (fromIntegral (sig p)) n (namemap e) })
+           (aname . attribs $ p)
+    , CompiledPath p (fillablePath p) (fromIntegral (sig p)))
+
+    where fillablePath p = pathOutline' (centroid (begin p:(ls2pt <$> segments p))) (Line (begin p): segments p)
+          pathOutline p = pathOutline' (begin p) (segments p)
+          pathOutline' (Point x0 y0) (Line (Point x1 y1) : ps) = [x0,y0,x1,y1] ++ pathOutline' (Point x1 y1) ps
+          pathOutline' (Point x0 y0) (EndPoint (Point x1 y1) : ps) = pathOutline' (Point x1 y1) ps
+          pathOutline' a (Spline c0 c1 b:ps) = splineVertices 256 a c0 c1 b ++ pathOutline' b ps
+          pathOutline' _ [] = []
+
+compileRectangle e p@(Rectangle (Point x y) w h attrs sg)  =
+    (maybe e
+           (\n -> e{ namemap=Map.insert (fromIntegral sg) n (namemap e) })
+           (aname attrs)
+    , CompiledRectangle p x y w h (fromIntegral sg))
+
+dataFrom (SB.PS d _ _) = d
+
+nearestPowerOfTwo w h = (log2 $ wf, log2 $ hf)
+    where log2 x = logDouble x / logDouble 2
+          wf =  w
+          hf =  h
+          
+getFreeTexture e = if texture_whitelist e /= []
+    then return (e{ texture_whitelist = tail $ texture_whitelist e }, head (texture_whitelist e))
+    else (if Cache.isEmpty (texture_greylist e) 
+            then GL.genObjectNames 1 >>= (\obj -> return (e, head obj)) 
+            else return (e{ texture_greylist = c' }, t))                   
+    where ((_,t),c') = Cache.free . texture_greylist $ e
+         
+compileText e txt
+ | cachetxt txt `Cache.member` texture_greylist e = do
+    let Point x y = bottomleft txt
+        (c', Just tex) = Cache.get (cachetxt txt) (texture_greylist e)
+        (w,h) =  texdims e Map.! tex
+    return ( e{ texture_greylist = c' }, CompiledImage txt x y w h tex (fromIntegral (sig txt)))
+
+ | otherwise = do
+    (e', tex) <- getFreeTexture e          
+    
+    layout <- layoutEmpty (context e')
+    layoutSetMarkup layout . Pretty.render . str $ txt
+    layoutSetAlignment layout . align $ txt
+    layoutSetJustify layout . justify $ txt
+    layoutSetWidth layout . wrapwidth $ txt
+    layoutSetWrap layout . wrapmode $ txt
+    layoutSetIndent layout . indent $ txt
+    (PangoRectangle _ _ _ _, PangoRectangle ex ey ew eh) <- layoutGetExtents layout
+    let (po2w,po2h) = nearestPowerOfTwo ew eh
+        potw = 2 ^ (max 0 $ ceiling po2w)
+        poth = 2 ^ (max 0 $ ceiling po2h)
+        w = fromIntegral potw
+        h = fromIntegral poth
+        Point x y = bottomleft txt
+
+    textSurface <- Cairo.withImageSurface Cairo.FormatARGB32 potw poth $ \surf -> do
+        Cairo.renderWith surf $ do
+            Cairo.setOperator Cairo.OperatorSource
+            Cairo.setSourceRGBA 1 1 1 0
+            Cairo.rectangle 0 0 w h
+            Cairo.fill
+            Cairo.setOperator Cairo.OperatorOver
+            Cairo.updateContext (context e')
+            liftIO $ layoutContextChanged layout
+            Cairo.save
+            Cairo.translate (-ex) (-ey)
+            let (fr,fg,fb,fa) = colourToTuple . afillRGBA $ state
+                (sr,sg,sb,sa) = colourToTuple . astrokeRGBA $ state
+                state = attribs txt
+            when (afilled state) $ do 
+                Cairo.setSourceRGBA fr fg fb fa 
+                Cairo.showLayout layout 
+                Cairo.fill
+            when (aoutlined state) $ do
+                Cairo.setSourceRGBA sr sg sb sa
+                Cairo.showLayout layout 
+                Cairo.stroke
+            Cairo.restore
+        Cairo.imageSurfaceGetData surf
+
+    GL.textureBinding GL.Texture2D $= Just tex
+    GL.textureWrapMode GL.Texture2D GL.S $= (GL.Repeated, GL.Clamp)
+    GL.textureWrapMode GL.Texture2D GL.T $= (GL.Repeated, GL.Clamp)
+    GL.textureFilter GL.Texture2D $= ((GL.Linear', Nothing), GL.Linear')
+    GL.textureFunction $= GL.Decal
+    GL.texImage2D Nothing
+        GL.NoProxy
+        0
+        GL.RGBA'
+        (GL.TextureSize2D (fromIntegral potw) (fromIntegral poth))
+        0
+        (GL.PixelData GL.BGRA
+        GL.UnsignedByte
+        (unsafeForeignPtrToPtr (dataFrom textSurface)))
+
+    return ( e'{ texdims = Map.insert tex (w, h) (texdims e')
+               , texture_greylist = Cache.put (cachetxt txt) tex (texture_greylist e') 
+               }
+           , CompiledImage txt x y w h tex (fromIntegral (sig txt)))
+
+
+compileImage e img
+ | cacheimg img `Cache.member` texture_greylist e = do
+    let (c',Just tex) =  Cache.get (cacheimg img) (texture_greylist e)
+        (w,h) =  texdims e Map.! tex
+    return ( e{texture_greylist = c'} , CompiledImage img x y w h tex (fromIntegral (sig img)))
+
+ | otherwise = do
+    (w,h,potw,poth,channels,buffer) <- case dimensions img of
+        (Left (Point x y)) -> Gtk.pixbufNewFromFile (filename img) >>= copydata
+        (Right (Rect x y w h)) -> Gtk.pixbufNewFromFileAtScale (filename img) (round w) (round h) (preserveaspect img) >>= copydata
+
+    (e', tex) <- getFreeTexture e
+    
+    GL.textureBinding GL.Texture2D $= Just tex
+    GL.textureWrapMode GL.Texture2D GL.S $= (GL.Repeated, GL.Clamp)
+    GL.textureWrapMode GL.Texture2D GL.T $= (GL.Repeated, GL.Clamp)
+    GL.textureFilter GL.Texture2D $= ((GL.Linear', Nothing), GL.Linear')
+    GL.textureFunction $= GL.Decal
+
+    GL.texImage2D Nothing
+        GL.NoProxy
+        0
+        (if channels == 4 then GL.RGBA' else GL.RGB')
+        (GL.TextureSize2D (fromIntegral potw) (fromIntegral poth))
+        0
+        (GL.PixelData (if channels == 4 then GL.RGBA else GL.RGB)
+        GL.UnsignedByte
+        (unsafeForeignPtrToPtr (dataFrom buffer)))
+
+    let (w',h') = case dimensions img of
+                        Left _ -> (fromIntegral w, fromIntegral h)
+                        Right (Rect _ _ w0 h0) -> (w0,h0)
+
+    return ( e'{ texdims = Map.insert tex (w',h') (texdims e') 
+               , texture_greylist = Cache.put (cacheimg img) tex (texture_greylist e')
+               }
+           , CompiledImage img x y w' h' tex (fromIntegral (sig img)))
+    where (x, y) = case dimensions img of
+                    Left (Point x0 y0) -> (x0, y0)
+                    Right (Rect x0 y0 _ _) -> (x0,y0)
+
+{-# INLINE copydata #-}
+copydata pbuf0 = do
+    w0 <- Gtk.pixbufGetWidth pbuf0
+    h0 <- Gtk.pixbufGetHeight pbuf0
+    let potw = log (fromIntegral w0) / log (fromIntegral 2)
+        poth = log (fromIntegral h0) / log (fromIntegral 2)
+        w = 2 ^ (max 0 $ ceiling potw)
+        h = 2 ^ (max 0 $ ceiling poth)
+    pbuf <- if w0 == w && h0 == h then return pbuf0 else Gtk.pixbufScaleSimple pbuf0 w h Gtk.InterpBilinear
+
+    channels <- Gtk.pixbufGetNChannels pbuf
+    bpc <- (`quot`8) <$> Gtk.pixbufGetBitsPerSample pbuf
+    pixels <- Gtk.pixbufGetPixels pbuf :: IO (Gtk.PixbufData Int Word8)
+    stride <- Gtk.pixbufGetRowstride pbuf
+    buf <- SB.create (w*h*channels*bpc) $ \ptr ->
+        forM_ [0::Int .. h - 1] $ \row -> let stsample = row*stride in
+            forM_ [0::Int .. w*channels*bpc-1] $ \sample0 -> let sample = stsample + sample0 in
+                A.readArray pixels sample >>= pokeByteOff ptr sample
+    return (w0,h0,w,h,channels,buf)
+
diff --git a/Graphics/Rendering/Hieroglyph/OpenGL/Data.hs b/Graphics/Rendering/Hieroglyph/OpenGL/Data.hs
new file mode 100644
--- /dev/null
+++ b/Graphics/Rendering/Hieroglyph/OpenGL/Data.hs
@@ -0,0 +1,123 @@
+{-# LANGUAGE BangPatterns #-}
+-----------------------------------------------------------------------------
+--
+-- Module      :  Graphics.Rendering.Hieroglyph.OpenGL
+-- Copyright   :
+-- License     :  BSD3
+--
+-- Maintainer  :  J.R. Heard
+-- Stability   :
+-- Portability :
+--
+-- |
+--
+-----------------------------------------------------------------------------
+
+module Graphics.Rendering.Hieroglyph.OpenGL.Data where
+
+import qualified Graphics.Rendering.Hieroglyph.Cache as Cache
+import System.Exit
+import GHC.Float
+import Data.List
+import Control.Concurrent
+import Control.Applicative
+import Control.Monad.Trans
+import qualified System.Glib.MainLoop as Gtk
+import Data.List (partition)
+import qualified Data.Set as Set
+import Data.Maybe
+import Graphics.UI.Gtk.Cairo as Cairo
+import qualified Graphics.Rendering.Cairo as Cairo
+import qualified Data.Array.MArray as A
+import Control.Monad
+import Graphics.UI.Gtk.Pango.Context
+import Graphics.UI.Gtk.Pango.Layout
+import Foreign
+import qualified Data.Map as Map
+import qualified Graphics.UI.Gtk as Gtk
+import qualified Graphics.UI.Gtk.OpenGL as Gtk
+import qualified Graphics.UI.Gtk.OpenGL.Drawable as Gtk
+import qualified Graphics.UI.Gtk.Gdk.Events as Gtk
+import qualified Data.ByteString.Internal as SB
+import qualified Graphics.Rendering.Cairo as Cairo -- for rendering fonts
+import qualified Graphics.Rendering.OpenGL as GL
+import Graphics.Rendering.OpenGL(GLuint, Vertex2, ($=))
+import Graphics.Rendering.Hieroglyph.Primitives
+import Graphics.Rendering.Hieroglyph.Visual
+import qualified Data.ByteString as SB
+import Foreign.C
+import qualified App.EventBus as Buster
+import qualified App.Widgets.GtkMouseKeyboard as Buster
+import Data.Colour
+import Data.Colour.Names
+import Data.Colour.SRGB
+import qualified Text.PrettyPrint as Pretty
+import System.Mem.Weak
+
+data HieroglyphGLRuntime = HgGL {
+    texture_whitelist :: [GL.TextureObject]
+  , texture_greylist :: Cache.Cache String GL.TextureObject
+  , texture_blacklist :: [GL.TextureObject]
+
+  , buffer_whitelist :: [GL.BufferObject]
+  , buffer_greylist :: Cache.Cache Int GL.BufferObject
+  , buffer_blacklist :: [GL.BufferObject]
+
+  , namemap :: Map.Map GLuint String
+  , drawarea :: Gtk.GLDrawingArea
+  , window :: Gtk.Window
+  , context ::PangoContext
+  , texdims :: Map.Map GL.TextureObject (Double,Double)
+  }
+  | Geometry BaseVisual
+
+reverseMouseCoords b x y = do
+    let renderDataE = fromJust $ Buster.eventByQName "Hieroglyph" "Hieroglyph" "RenderData" b
+    (_,sy) <- Gtk.widgetGetSize . Gtk.castToWidget . drawarea . (\(Buster.EOther a) -> a) . head . Buster.eventdata $ renderDataE
+    return (Point x (fromIntegral sy-y))
+
+data CompiledData =
+    CompiledDots
+        { original :: Primitive
+        , vertices :: [Double]
+        , uid :: GLuint }
+  | CompiledArc
+        { original :: Primitive
+        , vertices :: [Double]
+        , uid :: GLuint }
+  | CompiledPath
+        { original :: Primitive
+        , vertices :: [Double]
+        , uid :: GLuint }
+  | CompiledRectangle
+        { original :: Primitive
+        , xx :: Double
+        , yy :: Double
+        , ww :: Double
+        , hh :: Double
+        , uid :: GLuint }
+  | CompiledImage
+        { original :: Primitive
+        , xx :: Double
+        , yy :: Double
+        , ww :: Double
+        , hh :: Double
+        , texture :: GL.TextureObject
+        , uid :: GLuint }
+
+
+texturedObjects (CompiledImage _ _ _  _ _ _  _) = True
+texturedObjects _ = False
+
+colourToTuple :: AlphaColour Double -> (Double,Double,Double,Double)
+colourToTuple c = (r,g,b,alpha)
+    where alpha = alphaChannel c
+          c' = if alpha > 0 then (1/alpha) `darken` (c `Data.Colour.over` black) else black
+          RGB r g b = toSRGB c'
+
+colourToGL :: AlphaColour Double -> GL.Color4 Double
+colourToGL = (\(r,g,b,a) -> GL.Color4 r g b a) . colourToTuple
+
+cacheimg img = show (filename img, {- show $ dimensions img,-} preserveaspect img)
+cachetxt txt = show (show . str $ txt,align txt,wrapwidth txt,wrapmode txt,justify txt,indent txt,spacing txt)
+
diff --git a/Graphics/Rendering/Hieroglyph/OpenGL/Render.hs b/Graphics/Rendering/Hieroglyph/OpenGL/Render.hs
new file mode 100644
--- /dev/null
+++ b/Graphics/Rendering/Hieroglyph/OpenGL/Render.hs
@@ -0,0 +1,202 @@
+{-# LANGUAGE BangPatterns #-}
+-----------------------------------------------------------------------------
+--
+-- Module      :  Graphics.Rendering.Hieroglyph.OpenGL
+-- Copyright   :
+-- License     :  BSD3
+--
+-- Maintainer  :  J.R. Heard
+-- Stability   :
+-- Portability :
+--
+-- |
+--
+-----------------------------------------------------------------------------
+
+module Graphics.Rendering.Hieroglyph.OpenGL.Render where
+
+import qualified Graphics.Rendering.Hieroglyph.Cache as Cache
+import System.Exit
+import GHC.Float
+import Data.List
+import Control.Concurrent
+import Control.Applicative
+import Control.Monad.Trans
+import qualified System.Glib.MainLoop as Gtk
+import Data.List (partition)
+import qualified Data.Set as Set
+import Data.Maybe
+import Graphics.UI.Gtk.Cairo as Cairo
+import qualified Graphics.Rendering.Cairo as Cairo
+import qualified Data.Array.MArray as A
+import Control.Monad
+import Graphics.UI.Gtk.Pango.Context
+import Graphics.UI.Gtk.Pango.Layout
+import Foreign
+import qualified Data.Map as Map
+import qualified Graphics.UI.Gtk as Gtk
+import qualified Graphics.UI.Gtk.OpenGL as Gtk
+import qualified Graphics.UI.Gtk.OpenGL.Drawable as Gtk
+import qualified Graphics.UI.Gtk.Gdk.Events as Gtk
+import qualified Data.ByteString.Internal as SB
+import qualified Graphics.Rendering.Cairo as Cairo -- for rendering fonts
+import qualified Graphics.Rendering.OpenGL as GL
+import Graphics.Rendering.OpenGL(GLuint, Vertex2, ($=))
+import Graphics.Rendering.Hieroglyph.Primitives
+import Graphics.Rendering.Hieroglyph.Visual
+import qualified Data.ByteString as SB
+import Foreign.C
+import qualified App.EventBus as Buster
+import qualified App.Widgets.GtkMouseKeyboard as Buster
+import Data.Colour
+import Data.Colour.Names
+import Data.Colour.SRGB
+import qualified Text.PrettyPrint as Pretty
+import System.Mem.Weak
+
+import Graphics.Rendering.Hieroglyph.OpenGL.Compile
+import Graphics.Rendering.Hieroglyph.OpenGL.Data
+
+renderCompiledGeometry z (CompiledDots prim vdata iid) = do
+    let verticesFrom (x:y:vs) = GL.Vertex3 x y z : verticesFrom vs
+        verticesFrom [] = []
+    loadAttrs . attribs $ prim
+    GL.color . colourToGL . afillRGBA . attribs $ prim
+    GL.withName (GL.Name iid)  . GL.renderPrimitive GL.Points . mapM_ GL.vertex . verticesFrom $ vdata
+
+renderCompiledGeometry z obj@(CompiledArc _ _ _) =
+    (GL.textureBinding GL.Texture2D $= Nothing) >> renderObject z obj
+
+renderCompiledGeometry z obj@(CompiledPath _ _ _) =
+    (GL.textureBinding GL.Texture2D $= Nothing) >> renderObject z obj
+
+renderCompiledGeometry z obj@(CompiledRectangle prim x y w h iid) = do
+    GL.textureBinding GL.Texture2D $= Nothing
+    loadAttrs attrs
+
+    GL.lineSmooth $= GL.Disabled
+    GL.polygonSmooth $= GL.Disabled
+    GL.color . colourToGL . afillRGBA $ attrs
+
+    when (afilled attrs) .
+        GL.withName (GL.Name iid) .
+        GL.renderPrimitive GL.Quads .
+        mapM_ GL.vertex
+        $ take 4 vertices
+
+    GL.color . colourToGL . astrokeRGBA $ attrs
+    GL.lineSmooth $= GL.Enabled
+    GL.polygonSmooth $= GL.Enabled
+
+    when (aoutlined attrs) .
+        GL.withName (GL.Name iid) .
+        GL.renderPrimitive GL.LineStrip .
+        mapM_ GL.vertex
+        $ vertices
+
+    where attrs = attribs prim
+          vertices = [GL.Vertex3 x     y        z
+                     ,GL.Vertex3 (x+w) y        z
+                     ,GL.Vertex3 (x+w) (y+h)    z
+                     ,GL.Vertex3 x      (y+h)   z
+                     ,GL.Vertex3 x      y       z]
+         
+          
+
+renderCompiledGeometry z obj@(CompiledImage original x y w h tex iid) = do
+    GL.textureFunction $= GL.Replace
+    GL.color $ GL.Color4 1 1 1 (1::Double)
+    GL.texture GL.Texture2D $= GL.Enabled
+    GL.textureBinding GL.Texture2D $= Just tex
+    GL.texture GL.Texture2D $= GL.Enabled
+    GL.textureFunction $= GL.Replace
+
+    GL.lineSmooth $= GL.Disabled
+    GL.polygonSmooth $= GL.Disabled
+
+    GL.withName (GL.Name iid)  . GL.renderPrimitive GL.Quads $ do
+        GL.texCoord $ GL.TexCoord2 0 (1::Double)
+        GL.vertex   $ GL.Vertex3 x y z
+        GL.texCoord $ GL.TexCoord2 1 (1::Double)
+        GL.vertex   $ GL.Vertex3 (x+w) y z
+        GL.texCoord $ GL.TexCoord2 1 (0::Double)
+        GL.vertex   $ GL.Vertex3 (x+w) (y+h) z
+        GL.texCoord $ GL.TexCoord2 0 (0::Double)
+        GL.vertex   $ GL.Vertex3 x (y+h) z
+        GL.flush
+
+    GL.lineSmooth $= GL.Enabled
+    GL.polygonSmooth $= GL.Enabled
+
+renderObject z obj
+    | afilled (attribs . original $ obj) = GL.preservingMatrix $ do
+    
+        GL.textureBinding GL.Texture2D $= Nothing
+        loadAttrs (attribs . original $  obj )
+        GL.color . colourToGL . afillRGBA . attribs . original $ obj
+        GL.withName (GL.Name (uid obj)) . GL.renderPrimitive GL.TriangleFan . mapM_ GL.vertex . verticesFrom $ vertices obj
+        GL.color . colourToGL . astrokeRGBA . attribs . original $ obj
+        when (aoutlined (attribs . original $  obj)) $ (GL.withName (GL.Name (uid obj)) . GL.renderPrimitive GL.LineStrip . mapM_ GL.vertex . verticesFrom . drop 2 $ vertices obj)
+    | otherwise                = GL.preservingMatrix $ do
+    
+        loadAttrs (attribs . original $  obj)
+        GL.color . colourToGL . astrokeRGBA . attribs . original $ obj
+        GL.withName (GL.Name (uid obj)) . GL.renderPrimitive GL.LineStrip . mapM_ GL.vertex . verticesFrom . drop 2 $ vertices obj
+
+    where verticesFrom (x:y:vs) = GL.Vertex3 x y z : verticesFrom vs
+          verticesFrom [] = []
+
+
+
+loadAttrs attrs = GL.preservingMatrix $ do
+    GL.lineWidth $= (realToFrac . alinewidth $ attrs)
+    GL.matrixMode $= GL.Modelview 0
+    GL.loadIdentity
+    GL.translate $ GL.Vector3 (atranslatex attrs) (atranslatey attrs) 0
+    GL.scale (ascalex attrs) (ascaley attrs) 1
+    GL.rotate (arotation attrs) $ GL.Vector3 0 0 1
+    GL.lineSmooth $= GL.Enabled
+    GL.polygonSmooth $= GL.Enabled
+    -- TODO support line cap
+    -- TODO support line join
+    -- TODO support miter limit
+    -- TODO support trapezoidal tolerance
+    -- TODO support operator
+    -- TODO support antialias
+    -- TODO support dash/stipple
+    -- TODO support pattern fill rule
+
+
+getGeo (Buster.EOther (Geometry x)) =  Just x
+getGeo _ = Nothing
+
+render runtime geo = Gtk.withGLDrawingArea (drawarea runtime) $ \drawable -> do
+    GL.drawBuffer $= GL.BackBuffers
+    (GL.Position px py, GL.Size sx sy ) <- GL.get GL.viewport
+    GL.matrixMode $= GL.Projection
+    GL.loadIdentity
+    GL.ortho 0 (fromIntegral sx) 0 (fromIntegral sy) 1 2
+    GL.clearColor $= GL.Color4 1 1 1 1
+    GL.clear [GL.ColorBuffer, GL.DepthBuffer]
+    GL.depthFunc $= Just GL.Less
+    GL.blend $= GL.Enabled
+    GL.blendFunc $= (GL.SrcAlpha, GL.OneMinusSrcAlpha)
+    GL.lineSmooth $= GL.Enabled
+    GL.polygonSmooth $= GL.Enabled
+    GL.pointSmooth $= GL.Enabled
+    r' <- renderObjects [1::Double,2..] (sort geo) runtime
+    Gtk.glDrawableSwapBuffers drawable
+    return r'{ texture_blacklist = [] }
+
+
+renderObjects (z:zs) (o:os) !r = renderObj ((-2) + z/(z+1)) o r >>= renderObjects zs os
+renderObjects _ [] r = return r
+
+renderObj :: Double -> Primitive -> HieroglyphGLRuntime -> IO HieroglyphGLRuntime
+renderObj z obj runtime = do
+        (runtime',cg0) <- compile runtime obj
+        renderCompiledGeometry z cg0
+        return runtime'{ namemap=Map.insert (uid cg0)
+                                            (fromMaybe "" . aname . attribs . original $ cg0)
+                                            (namemap runtime') }
+
diff --git a/Graphics/Rendering/Hieroglyph/Primitives.hs b/Graphics/Rendering/Hieroglyph/Primitives.hs
--- a/Graphics/Rendering/Hieroglyph/Primitives.hs
+++ b/Graphics/Rendering/Hieroglyph/Primitives.hs
@@ -444,6 +444,16 @@
 hidden :: Primitive -- ^ A hidden object.
 hidden = sign $ Hidden plain 0
 
-image :: Primitive -- ^ An image.  These are efficiently cached using weak references where possible
+image :: Primitive -- ^ An image.  These are efficiently cached where possible
 image = sign $ Image "" (Left origin) False plain 0
 
+textExtents context txt = unsafePerformIO $ do 
+    layout <- layoutEmpty context 
+    layoutSetMarkup layout . render . str $ txt
+    layoutSetAlignment layout . align $ txt
+    layoutSetJustify layout . justify $ txt
+    layoutSetWidth layout . wrapwidth $ txt
+    layoutSetWrap layout . wrapmode $ txt
+    layoutSetIndent layout . indent $ txt
+    (PangoRectangle _ _ _ _, PangoRectangle x y w h) <- layoutGetExtents layout
+    return (x,y,w,h)
diff --git a/Hieroglyph.cabal b/Hieroglyph.cabal
--- a/Hieroglyph.cabal
+++ b/Hieroglyph.cabal
@@ -1,15 +1,15 @@
 name: Hieroglyph
-version: 2.24
+version: 3
 cabal-version: >=1.2
 build-type: Simple
 license: BSD3
 license-file: LICENSE
 copyright:
 maintainer: J.R. Heard
-build-depends: IfElse -any, OpenGL -any, array -any, base -any,
+build-depends: IfElse -any, OpenGL -any, array -any, base <=5,
                buster >=2.0, bytestring -any, cairo -any, colour -any,
                containers -any, gtk -any, gtkglext -any, mtl -any, parallel -any,
-               pretty -any, random -any
+               pretty -any, random -any, glib -any, buster-gtk -any
 stability:
 homepage: http://vis.renci.org/jeff/hieroglyph
 package-url:
@@ -22,14 +22,17 @@
 tested-with:
 data-files:
 data-dir: ""
-extra-source-files:
+extra-source-files: 
 extra-tmp-files:
 exposed-modules: Graphics.Rendering.Hieroglyph
                  Graphics.Rendering.Hieroglyph.Cairo
                  Graphics.Rendering.Hieroglyph.OpenGL
-                 Graphics.Rendering.Hieroglyph.Cache
                  Graphics.Rendering.Hieroglyph.Primitives
                  Graphics.Rendering.Hieroglyph.Visual
+                 Graphics.Rendering.Hieroglyph.OpenGL.Data
+                 Graphics.Rendering.Hieroglyph.OpenGL.Render 
+                 Graphics.Rendering.Hieroglyph.OpenGL.Compile 
+                 Graphics.Rendering.Hieroglyph.Cache
 exposed: True
 buildable: True
 build-tools:
@@ -49,7 +52,7 @@
 other-modules:
 ghc-prof-options:
 ghc-shared-options:
-ghc-options:
+ghc-options: -O2 -fvia-C -optc-O3
 hugs-options:
 nhc98-options:
 jhc-options: