diff --git a/TODO b/TODO
--- a/TODO
+++ b/TODO
@@ -6,7 +6,6 @@
   navigation
     configurable zoom mode: center on click vs expand about click
     continuous zoom mode while button is pressed
-    configurable zoom speed
     undo/history tree navigation
     log annotation and search
     log browser view with filtering
@@ -32,10 +31,7 @@
     re-use pixels from parent/child tiles in renderer
     don't compute known-interior tiles
   features
-    feature overlay in browser window
-    feature overlay save as svg (save image as png and embed it too?)
     scan whole image for atoms, subdivide for more
-    draw external rays in feature overlay
     draw internal rays in feature overlay
     feature database - try lookup before calculating, cache results
   algorithms
@@ -45,13 +41,8 @@
     non-slow angled internal address to external angle
   misc
     tiled rendering mode for huge images without seams
-    use custom icon for status dialog window
   scripting
-    haskell scripting with edsl/library for common tasks
-    command line flag to load a script at startup
-    interpreter REPL window
+    helper library for using GHCI via fifo to gruff exe
 
 internal
-  split MuAtom into separate modules
-  backport appropriate algorithms to 'ruff'
   source code documentation
diff --git a/gruff.cabal b/gruff.cabal
--- a/gruff.cabal
+++ b/gruff.cabal
@@ -1,5 +1,5 @@
 Name:                gruff
-Version:             0.2.1
+Version:             0.3
 Synopsis:            fractal explorer GUI using the ruff library
 Description:
     Mandelbrot Set fractal explorer using the ruff library.
@@ -8,10 +8,16 @@
     and multiple CPU cores recommended.  If you want to explore very deep
     zooms, you'll need hmpfr which currently requires GHC to be compiled
     with integer-simple instead of the default integer-gmp.  To install
-    without MPFR support, use @cabal install gruff -f-mpfr@.
+    with MPFR support, use @cabal install gruff -fmpfr@.  (Note that the
+    default setting for this flag has changed since the previous release.)
     .
-    This version is a bugfix release.  Changes since gruff-0.2:
+    gruff-0.3 includes a small library to allow external programs to
+    create diagrams and animations with gruff.  See the gruff-examples
+    package.  The interface has been remodelled to simplify it and add
+    informative feature overlays.
     .
+    gruff-0.2.1 was a bugfix release.  Changes since gruff-0.2:
+    .
       * Supersampling bugs are fixed (no more undocumented quantization
         leading to inconsistent appearance at different zoom levels).
     .
@@ -22,36 +28,39 @@
     .
     Features in this version include:
     .
-      * Interactive fractal browser display (left click to zoom in,
-        right click to zoom out, middle-click to center).
+      * Interactive fractal browser display with mouse controls:
+        .
+          * Left click to zoom in (press shift for bigger jumps).
+        .
+          * Right click to zoom out (press shift for bigger jumps).
+        .
+          * Middle click to center.
+        .
+          * Shift middle click to auto-focus.
+        .
+          * Control left click to label with period.
+        .
+          * Control right click to label with angled internal address (slow!).
     .
       * Session persistance (stored in @~\/.gruff\/state.gruff@ - states can
-        also be loaded from and saved to other files).
+        also be loaded from and saved to other files, including labels and
+        rays).  Note that the file format is incompatible with previous
+        releases of gruff.
     .
       * Tile cache (by default in @~\/.gruff\/cache@ - symlink it somewhere
         with a few GB of space if you plan on exploring a lot).
     .
-      * High-level feature finding using angled internal addresses
-        (enter an address, for example @1 2 3 1/3 10@, and hit return,
-        then click the adjacent Go button).
-    .
-      * Feature finding using period location (navigate to approximate
-        location of the desired feature, click the Scan button).
-    .
-      * Angled internal address calculation using reverse ray trace
-        (navigate to approximate feature location, click the Scan+ button).
-    .
-      * Uses MPFR where available for higher precision, allowing deeper
+      * Can use MPFR if desired for higher precision, allowing deeper
         zooms and locating high period nucleii.
     .
       * Limited amount of customizable colouring (colours for interior,
-        border, and exterior points).
+        border, and exterior points, as well as labels and rays).
     .
       * Supersampling for more detailed images (useful range is 1 to 16).
     .
-    Future features might include image saving, external ray and feature
-    information overlays, more feature finding and identification
-    algorithms, scripting support for rendering animations, ...
+      * Rudimentary scripting support (see the gruff-examples package).
+    .
+    Future versions will focus on enhancing the scripting support.
 
 License:             GPL-2
 License-file:        LICENSE
@@ -60,7 +69,7 @@
 Category:            Graphics
 
 Build-type:          Simple
-Cabal-version:       >=1.4
+Cabal-version:       >=1.8
 
 Data-dir:            data
 Data-files:          icon.png, merge.frag, minimal.frag
@@ -68,16 +77,24 @@
 
 Flag mpfr
   description: use MPFR for higher precision floating point
-  default: True
+  default: False
 
+Library
+  Hs-source-dirs:     src
+  Exposed-modules:    Fractal.GRUFF
+  Build-depends:      base >= 3 && < 5,
+                      ruff >= 0.3 && < 0.4
+  GHC-options:        -Wall
+
 Executable gruff
   Hs-source-dirs:     src
   Main-is:            gruff.hs
   Other-modules:      Browser
                       GLUTGtk
+                      Interact
                       Logger
-                      MuAtom
                       Number
+                      Progress
                       QuadTree
                       Shader
                       Snapshot
@@ -85,10 +102,12 @@
                       Tile
                       Utils
                       View
-  Build-depends:      base >= 4 && < 5,
+  Build-depends:      gruff == 0.3,
+                      base >= 4 && < 5,
                       containers >= 0 && < 1,
                       directory >= 1 && < 2,
                       filepath >= 1 && < 2,
+                      FTGL == 1.333,
                       gtk >= 0.11 && < 0.13,
                       gtkglext >= 0.11 && < 0.13,
                       old-locale >= 1 && < 2,
@@ -99,7 +118,7 @@
                       qd-vec >= 1 && < 2,
                       time >= 1 && < 2,
                       Vec >= 0.9 && < 1,
-                      ruff >= 0.2 && < 0.3,
+                      ruff >= 0.3 && < 0.4,
                       bytestring,
                       mtl
   if (flag(mpfr))
@@ -110,3 +129,12 @@
   CC-options:         -O3 -Wall -pedantic -Wextra
   GHC-options:        -O2 -Wall -threaded -rtsopts
   GHC-Prof-Options:   -prof -auto-all -caf-all
+
+source-repository head
+  type:     git
+  location: git://gitorious.org/ruff/gruff.git
+
+source-repository this
+  type:     git
+  location: git://gitorious.org/ruff/gruff.git
+  tag:      v0.3
diff --git a/src/Browser.hs b/src/Browser.hs
--- a/src/Browser.hs
+++ b/src/Browser.hs
@@ -1,6 +1,6 @@
 module Browser (Browser(..), browserNew, browserRenders) where
 
-import Prelude hiding (log)
+import Prelude hiding (log, lines)
 import Control.Concurrent
   ( forkIO, MVar, newEmptyMVar, newMVar, takeMVar, putMVar, tryTakeMVar, threadDelay )
 import Control.Monad (foldM, forever, forM_, replicateM, unless, when)
@@ -15,24 +15,28 @@
 import Foreign (Ptr, malloc, alloca, peek, poke, nullPtr)
 import Foreign.C (CFloat, CInt)
 import GHC.Conc (numCapabilities)
-import Graphics.Rendering.OpenGL hiding (viewport, Angle, Color, Point, Position, Size)
+import Graphics.Rendering.OpenGL hiding
+  ( viewport, Angle, Color, Point, Position, Size, S, R )
 import qualified Graphics.Rendering.OpenGL as GL
 import Graphics.Rendering.OpenGL.Raw
-  ( glTexImage2D, gl_TEXTURE_2D, gl_R32F, gl_RGBA, gl_LUMINANCE
+  ( glTexImage2D, gl_TEXTURE_2D, gl_LUMINANCE32F, gl_RGBA, gl_LUMINANCE
   , gl_FLOAT, gl_UNSIGNED_BYTE, gl_FALSE, glClampColor
   , gl_CLAMP_VERTEX_COLOR, gl_CLAMP_READ_COLOR, gl_CLAMP_FRAGMENT_COLOR
   , glGenFramebuffers, glBindFramebuffer, glFramebufferTexture2D
   , gl_FRAMEBUFFER, gl_COLOR_ATTACHMENT0, glGenerateMipmap
+  , gl_FRAMEBUFFER_COMPLETE, glCheckFramebufferStatus
   , glGetError
   )
-import Graphics.UI.Gtk hiding (get, Window, Viewport, Region, Size, Action, Image)
+import Graphics.UI.Gtk hiding
+  ( get, Window, Viewport, Region, Size, Action, Image, Label, labelText )
 import qualified Graphics.UI.Gtk as GTK
 
+import Graphics.Rendering.FTGL as FTGL
+
 import Fractal.RUFF.Types.Complex (Complex((:+)))
 
-import Number (R)
 import GLUTGtk
-  (  GLUTGtk, Size(Size), Key(MouseButton), KeyState(Down), Position(Position)
+  ( GLUTGtk, Size(Size), Key(MouseButton), KeyState(Down), Position(Position)
   , postRedisplay, widget, realizeCallback, reshapeCallback
   , displayCallback, keyboardMouseCallback
   )
@@ -43,20 +47,21 @@
 import qualified Logger as Log
 import Snapshot (writeSnapshot)
 import View
-  ( Image(..), Location(..), Window(..), Viewport(..)
+  ( Image(..), Window(..), Viewport(..), Label(..), Line(..)
   , BufferSize(..), bufferSize, tileSize, delta
-  , Colours(..), Colour(..), defColours
-  , pixelLocation, originQuad, visibleQuads
-  , defLocation, defWindow, defViewport
+  , Colours(..), Colour(..)
+  , pixelLocation, originQuad, visibleQuads, locationPixel
+  , defImage, defWindow
   )
+import Interact (MouseCallbacks, Mod(..), But(..))
+
 import Paths_gruff (getDataFileName)
 
 type TextureObject3 = (TextureObject, TextureObject, TextureObject)
 type QuadList = [(Complex Int, Quad)]
 data GruffImage = GruffImage
-  { location :: Location
-  , window :: Window
-  , viewport :: Viewport
+  { image :: Image
+  -- tile cache
   , tiles :: Map Quad TextureObject3
   , queue :: MVar [Tile]
   , jobs :: MVar [Quad]
@@ -66,7 +71,6 @@
   , gl :: GLUTGtk
   , cacheDir :: FilePath
   , log :: LogLevel -> String -> IO ()
-  , colours :: Colours
   , prog :: Program
   , combineProg :: Program
   , tsheet0 :: TextureObject
@@ -80,38 +84,45 @@
   -- callbacks
   , exitCallback :: Maybe (IO ())
   , reshapeCallback :: Maybe (Int -> Int -> IO ())
-  , mouseCallback :: Maybe (Complex R -> Double -> IO ())
+  , mouseCallback :: MouseCallbacks
   , doneCallback :: Maybe (IO ())
   , abortCallback :: Maybe (IO ())
   , doClear :: Bool
+  , font :: FTGL.Font
   }
 
 sheetSize :: GruffImage -> BufferSize
-sheetSize g = bufferSize (sheetOffset g) (window g)
+sheetSize g = bufferSize (sheetOffset g) (imageWindow (image g))
 
 zoomPhase :: GruffImage -> Double
-zoomPhase = delta . location
+zoomPhase = delta . imageLocation . image
 
 rotationA :: GruffImage -> Double
-rotationA = orient . viewport
+rotationA = orient . imageViewport . image
 
-sheetBlend :: GruffImage -> (Int, Double)
+sheetBlend :: GruffImage -> (Int, (Double, Double))
 sheetBlend g =
   let z = zoomPhase g
-      s = supersamples (window g)
+      s = supersamples (imageWindow (image g))
       b = logBase 4 (4 ** z * s)
       h = floor b
       d = fromIntegral h - b
-  in  (h, 1 - (1 - 4**d) / (4**(d+1) - 4**d))
+  in  (h, (d, 1 - (1 - 4**d) / (4**(d+1) - 4**d)))
 
 sheetOffset :: GruffImage -> Int
 sheetOffset = fst . sheetBlend
 
+{-
+sheetDelta :: GruffImage -> Double
+sheetDelta = fst . snd . sheetBlend
+-}
+
 blendFactor :: GruffImage -> Double
-blendFactor = snd . sheetBlend
+blendFactor = snd . snd . sheetBlend
 
 iDisplay :: IORef GruffImage -> IO ()
 iDisplay iR = do
+  checkError "display begin"
   s0 <- readIORef iR
   mtls <- tryTakeMVar (queue s0)
   case mtls of
@@ -119,8 +130,11 @@
       putMVar (queue s0) []
       forM_ tls $ \tile@(Tile q ns ds ts) -> do
         tde <- upload ds
+        checkError "upload ds"
         tit <- upload ns
+        checkError "upload ns"
         ttt <- upload ts
+        checkError "upload ts"
         freeTile tile
         atomicModifyIORef iR $ \s' ->
           ( s'{ tiles = M.insert q (tde, tit, ttt) (tiles s')
@@ -128,37 +142,61 @@
           , ())
     Nothing -> return ()
   s <- readIORef iR
-  log s Debug $ "displayCallback " ++ show (location s)
+  log s Debug $ "displayCallback " ++ show (imageLocation (image s))
   c <- atomicModifyIORef iR $ \s' -> (s'{ doClear = False }, doClear s')
   when c $ do
     clearSheet s False
+    checkError "clear sheet F"
     clearSheet s True
+    checkError "clear sheet T"
     atomicModifyIORef iR $ \s' -> (s'{ sheetCount0 = 0, sheetCount1 = 0 }, ())
   (todo0, upped0) <- renderSheet s False
+  checkError "render sheet F"
   (todo1, upped1) <- renderSheet s True
-  atomicModifyIORef iR $ \s' -> (s'{ viewQuads = (todo0, todo1), sheetCount0 = sheetCount0 s' + upped0 , sheetCount1 = sheetCount1 s' + upped1 }, ())
-  let w = width (window s)
-      h = height (window s)
+  checkError "render sheet T"
+  atomicModifyIORef iR $ \s' ->
+    ( s'{ viewQuads = (todo0, todo1)
+        , sheetCount0 = sheetCount0 s' + upped0
+        , sheetCount1 = sheetCount1 s' + upped1
+        }, () )
+  let w = width (imageWindow (image s))
+      h = height (imageWindow (image s))
   GL.viewport $=
     (GL.Position 0 0, GL.Size (fromIntegral w) (fromIntegral h))
+  checkError "clear V"
   loadIdentity
+  checkError "clear I"
   ortho2D 0 (fromIntegral w) 0 (fromIntegral h)
+  checkError "clear O"
   clearColor $= Color4 0.5 0.5 0.5 1
+  checkError "clear CC"
   clear [ColorBuffer]
+  checkError "clear C"
   currentProgram $= Just (combineProg s)
+  checkError "shader 1"
   lsheet0 <- get $ uniformLocation (combineProg s) "sheet0"
+  checkError "shader 2a"
   lsheet1 <- get $ uniformLocation (combineProg s) "sheet1"
+  checkError "shader 2b"
   lblend  <- get $ uniformLocation (combineProg s) "blend"
+  checkError "shader 2c"
   uniform lsheet0 $= TexCoord1 (0 :: GLint)
+  checkError "shader 3a"
   uniform lsheet1 $= TexCoord1 (1 :: GLint)
+  checkError "shader 3b"
   uniform lblend $= TexCoord1 (realToFrac (blendFactor s) :: GLfloat)
+  checkError "shader 3c"
   activeTexture $= TextureUnit 0
+  checkError "shader 4"
   textureBinding Texture2D $= Just (tsheet0 s)
+  checkError "shader 5"
   activeTexture $= TextureUnit 1
+  checkError "shader 6"
   textureBinding Texture2D $= Just (tsheet1 s)
+  checkError "shader 7"
   let t x0 y0 = texCoord $ TexCoord2 (0.5 + x' :: GLdouble) (0.5 + y' :: GLdouble)
         where
-          p = realToFrac . sqrt . aspect . viewport $ s
+          p = realToFrac . sqrt . aspect . imageViewport . image $ s
           x = k * x0 * p
           y = k * y0 / p
           a = - rotationA s
@@ -175,10 +213,43 @@
     t (-1) (-1) >> v 0 0
     t 1 (-1) >> v w 0
     t 1 1 >> v w h
+  checkError "quad"
   textureBinding Texture2D $= Nothing
+  checkError "shader 8"
   activeTexture $= TextureUnit 0
+  checkError "shader 9"
   textureBinding Texture2D $= Nothing
+  checkError "shader A"
   currentProgram $= Nothing
+  checkError "shader B"
+
+  -- save state
+  m <- get matrixMode
+  matrixMode $= Modelview 0
+  colour0 <- get currentColor
+  -- pixel mapping
+  let i = image s
+      locP = locationPixel (imageWindow i) (imageViewport i) (imageLocation i)
+      locL (a, b) = [locP a, locP b]
+  -- draw lines
+  forM_ (imageLines i) $ \l -> do
+    let ps = concatMap locL (lineSegments l)
+        Colour r g b = lineColour l
+    currentColor $= Color4 (realToFrac r) (realToFrac g) (realToFrac b) 1
+    renderPrimitive Lines $ forM_ ps $ \(x, y) -> do
+      vertex $ Vertex2 (realToFrac x) (fromIntegral h - realToFrac y :: GLdouble)
+  -- draw labels
+  forM_ (imageLabels i) $ \l -> do
+    let (x, y) = locP (labelCoords l)
+        Colour r g b = labelColour l
+    currentColor $= Color4 (realToFrac r) (realToFrac g) (realToFrac b) 1
+    translate (Vector3 (realToFrac x) (fromIntegral h - realToFrac y) (0 :: GLdouble))
+    renderFont (font s) (labelText l) All
+    translate (Vector3 (-realToFrac x) (realToFrac y - fromIntegral h) (0 :: GLdouble))
+  -- restore state
+  currentColor $= colour0
+  matrixMode $= m
+
   s'' <- readIORef iR
   when (sheetCount0 s'' + sheetCount1 s'' >= sheetCountTarget s'') $ do
     case doneCallback s of
@@ -187,29 +258,40 @@
         atomicModifyIORef iR $ \s' -> (s'{ doneCallback = Nothing, abortCallback = Nothing }, ())
         act
   prune iR
-  err <- glGetError
-  when (err /= 0) $ print ("error: " ++ show err)
+  checkError "display end"
 
 clearSheet :: GruffImage -> Bool -> IO ()
 clearSheet s b = do
+  checkError "clearSheet begin"
   let tw' = texels $ sheetSize s
       th' = tw'
       tw = if b then tw' * 2 else tw'
       th = if b then th' * 2 else th'
       tsheet = (if b then tsheet1 else tsheet0) s
   bindFBO (fbo s) tsheet
+  checkError "clearSheet fbo bind"
   GL.viewport $=
     (GL.Position 0 0, GL.Size (fromIntegral tw) (fromIntegral th))
+  checkError "clearSheet V"
   loadIdentity
+  checkError "clearSheet I"
   clearColor $= Color4 0 0 1 1
+  checkError "clearSheet CC"
   clear [ColorBuffer]
+  checkError "clearSheet C"
   unbindFBO
+  checkError "clearSheet fbo unbind"
   textureBinding Texture2D $= Just tsheet
+  checkError "clearSheet tex bind"
   glGenerateMipmap gl_TEXTURE_2D
+  checkError "clearSheet tex mipmap"
   textureBinding Texture2D $= Nothing
+  checkError "clearSheet tex unbind"
+  checkError "clear end"
 
 renderSheet :: GruffImage -> Bool -> IO ([(Complex Int, Quad)], Int)
 renderSheet s b = do
+  checkError "renderSheet begin"
   let tw' = texels $ sheetSize s
       th' = tw'
       tw = if b then tw' * 2 else tw'
@@ -218,38 +300,63 @@
       vquads = (if b then snd else fst) (viewQuads s)
   if null vquads then return ([], 0) else do
     bindFBO (fbo s) tsheet
+    checkError "renderSheet fbo bind"
     GL.viewport $=
       (GL.Position 0 0, GL.Size (fromIntegral tw) (fromIntegral th))
+    checkError "renderSheet V"
     loadIdentity
+    checkError "renderSheet I"
     ortho2D 0 (fromIntegral tw) 0 (fromIntegral th)
+    checkError "renderSheet O"
     currentProgram $= Just (prog s)
+    checkError "renderSheet shader 1"
     lde <- get $ uniformLocation (prog s) "de"
+    checkError "renderSheet shader u1"
     lit <- get $ uniformLocation (prog s) "it"
+    checkError "renderSheet shader u2"
     ltt <- get $ uniformLocation (prog s) "tt"
+    checkError "renderSheet shader u3"
     lint <- get $ uniformLocation (prog s) "interior"
+    checkError "renderSheet shader u4"
     lbrd <- get $ uniformLocation (prog s) "border"
+    checkError "renderSheet shader u5"
     lext <- get $ uniformLocation (prog s) "exterior"
+    checkError "renderSheet shader u6"
     uniform lde $= TexCoord1 (0 :: GLint)
+    checkError "renderSheet shader t1"
     uniform lit $= TexCoord1 (1 :: GLint)
+    checkError "renderSheet shader t2"
     uniform ltt $= TexCoord1 (2 :: GLint)
-    let (ci, cb, ce) = fromColours $ colours s
+    checkError "renderSheet shader t3"
+    let (ci, cb, ce) = fromColours . imageColours . image $ s
     uniform lint $= ci
+    checkError "renderSheet shader s1"
     uniform lbrd $= cb
+    checkError "renderSheet shader s2"
     uniform lext $= ce
+    checkError "renderSheet shader s3"
     todo <- foldM (\a t -> do a' <- drawQuad (tiles s) t ; return (a' ++ a)) [] vquads
+    checkError "renderSheet drawQuads"
     currentProgram $= Nothing
+    checkError "renderSheet shader 2"
     unbindFBO
+    checkError "renderSheet fbo unbind"
     let upped = length vquads - length todo
     when (upped > 0) $ do
       textureBinding Texture2D $= Just tsheet
+      checkError "renderSheet tex bind"
       glGenerateMipmap gl_TEXTURE_2D
+      checkError "renderSheet tex mipmap"
       textureBinding Texture2D $= Nothing
+      checkError "renderSheet tex unbind"
+    checkError "renderSheet end"
     return (todo, upped)
 
 drawQuad :: Map Quad TextureObject3 -> (Complex Int, Quad) -> IO [(Complex Int, Quad)]
 drawQuad m ijq@(i :+ j, q) = case q `M.lookup` m of
   Nothing -> return [ijq]
   Just (tde, tit, ttt) -> do
+    checkError "drawQuad begin"
     let t x y = texCoord $ TexCoord2 (x :: GLdouble) (y :: GLdouble)
         v x y = vertex $ Vertex2 (x :: GLdouble) (y :: GLdouble)
         x0 = fromIntegral i
@@ -257,30 +364,45 @@
         x1 = x0 + fromIntegral tileSize
         y1 = y0 + fromIntegral tileSize
     activeTexture $= TextureUnit 0
+    checkError "drawQuad tex 0"
     textureBinding Texture2D $= Just tde
+    checkError "drawQuad tex 0b"
     activeTexture $= TextureUnit 1
+    checkError "drawQuad tex 1"
     textureBinding Texture2D $= Just tit
+    checkError "drawQuad tex 1b"
     activeTexture $= TextureUnit 2
+    checkError "drawQuad tex 2"
     textureBinding Texture2D $= Just ttt
+    checkError "drawQuad tex 2b"
     renderPrimitive Quads $ do
       color $ Color3 1 1 (1::GLdouble)
       t 0 1 >> v x0 y1
       t 0 0 >> v x0 y0
       t 1 0 >> v x1 y0
       t 1 1 >> v x1 y1
+    checkError "drawQuad render"
     textureBinding Texture2D $= Nothing
+    checkError "drawQuad tex 3b"
     activeTexture $= TextureUnit 1
+    checkError "drawQuad tex 3"
     textureBinding Texture2D $= Nothing
+    checkError "drawQuad tex 4b"
     activeTexture $= TextureUnit 0
+    checkError "drawQuad tex 4"
     textureBinding Texture2D $= Nothing
+    checkError "drawQuad tex 5b"
     return []
 
 iReshape :: IORef GruffImage -> Maybe Double -> Size -> IO ()
 iReshape iR ms size'@(Size w h) = do
   s' <- readIORef iR
   log s' Debug $ "reshapeCallback " ++ show size'
-  let ss = case ms of Nothing -> supersamples (window s') ; Just r -> r
-  atomicModifyIORef iR $ \s -> (s{ window = (window s){ width = w, height = h, supersamples = ss }, viewport = (viewport s){ aspect = fromIntegral w / fromIntegral h } }, ())
+  let ss = case ms of Nothing -> supersamples (imageWindow (image s')) ; Just r -> r
+  atomicModifyIORef iR $ \s -> (s{ image = (image s)
+    { imageWindow = (imageWindow (image s)){ width = w, height = h, supersamples = ss }
+    , imageViewport = (imageViewport (image s)){ aspect = fromIntegral w / fromIntegral h }
+    } }, ())
   s'' <- readIORef iR
   unless (sheetSize s' == sheetSize s'') (reallocateBuffers iR)
   case Browser.reshapeCallback s' of
@@ -288,43 +410,29 @@
     Just act -> act w h
 
 iMouse :: IORef GruffImage -> Key -> KeyState -> [Modifier] -> Position -> IO ()
-iMouse sR (MouseButton LeftButton  ) Down _ p@(Position x y) = do
-  s <- readIORef sR
-  log s Debug $ "leftMouse " ++ show p
-  case mouseCallback s of
-    Nothing -> return ()
-    Just act -> do
-      let o = fromPixel s x y
-          cx :+ cy = center (location s)
-          c = fromRational cx :+ fromRational cy
-          r = radius (location s)
-          r' = 0.9 * r
-          c' = 0.9 * c + 0.1 * o
-      act c' r'
-iMouse sR (MouseButton MiddleButton) Down _ p@(Position x y) = do
-  s <- readIORef sR
-  log s Debug $ "middleMouse " ++ show p
-  case mouseCallback s of
-    Nothing -> return ()
-    Just act -> act (fromPixel s x y) (radius (location s))
-iMouse sR (MouseButton RightButton ) Down _ p@(Position x y) = do
+iMouse sR (MouseButton but) Down mods p@(Position x y) | but `elem` buts = do
+  let shift = Shift   `elem` mods
+      ctrl  = Control `elem` mods
+      m | shift && ctrl = SC
+        | ctrl          = C
+        | shift         = S
+        | otherwise     = U
+      b = case but of
+        LeftButton   -> L
+        MiddleButton -> M
+        RightButton  -> R
+        _ -> error "weasels!!!!111one"
   s <- readIORef sR
-  log s Debug $ "rightMouse " ++ show p
-  case mouseCallback s of
+  log s Debug $ "mouse " ++ show (b, m) ++ " " ++ show p
+  case (b, m) `M.lookup` mouseCallback s of
     Nothing -> return ()
-    Just act -> do
-      let o = fromPixel s x y
-          cx :+ cy = center (location s)
-          c = fromRational cx :+ fromRational cy
-          r = radius (location s)
-          r' = 1.1 * r
-          c' = 1.1 * c - 0.1 * o
-      act c' r'
+    Just cb -> do
+      let i = image s
+          c = pixelLocation (imageWindow i) (imageViewport i) (imageLocation i) x y
+      cb c i
+  where buts = [LeftButton, MiddleButton, RightButton]
 iMouse _ _ _ _ _ = return ()
 
-fromPixel :: GruffImage -> Double -> Double -> Complex R
-fromPixel g x y = let r:+i = pixelLocation (window g) (viewport g) (location g) x y in fromRational r :+ fromRational i
-
 quadDistance :: Quad -> Quad -> Double
 quadDistance q0 q1 =
   let Quad{ quadLevel = l0, quadWest = r0, quadNorth = i0 } = q0
@@ -345,13 +453,14 @@
   s0 <- readIORef sR
   let cacheSize = M.size (tiles s0)
   when (cacheSize > cacheSizeMax s0) $ do
+    checkError "prune begin"
     log s0 Debug . concat $
       [ "pruning texture cache "
       , show cacheSize, " > ", show (cacheSizeMax s0)
       , " --> ", show (cacheSizeMin s0)
       ]
     bad <- atomicModifyIORef sR $ \s -> 
-      let Just q0 = originQuad (location s) (sheetSize s)
+      let Just q0 = originQuad (imageLocation (image s)) (sheetSize s)
           score = quadDistance q0
           o = comparing (score . fst)
           (good, bad)
@@ -359,23 +468,29 @@
       in  (s{ tiles = M.fromList good }, bad)
     let t (_, (t1, t2, t3)) = [t1, t2, t3]
     deleteObjectNames $ concatMap t bad
+    checkError "prune end"
 
 update :: IORef GruffImage -> IO ()
 update sR = do
   s' <- readIORef sR
   log s' Debug $ "updateCallback "
   todo' <- atomicModifyIORef sR $ \s ->
-    let vq@(qs0, qs1) = fromMaybe ([],[]) $ visibleQuads (window s) (viewport s) (location s) (sheetOffset s)
+    let i = image s
+        vq@(qs0, qs1) = fromMaybe ([],[]) $
+          visibleQuads (imageWindow i) (imageViewport i) (imageLocation i) (sheetOffset s)
         qs = qs0 ++ qs1
         todo = S.filter (`M.notMember` tiles s) (S.fromList (map snd qs))
     in  (s{ viewQuads = vq, sheetCountTarget = length qs }, todo)
   -- cancel in-progress jobs that aren't still needed
   _ <- takeMVar (jobs s')
-  p <- atomicModifyIORef sR $ \s -> (s{ progress = M.filter (`S.member` todo') (progress s) }, progress s)
-  mapM_ (`poke` 1) . filter (\w -> case M.lookup w p of Nothing -> False ; Just q -> q `S.notMember` todo') . workers $ s'
+  p <- atomicModifyIORef sR $ \s ->
+    (s{ progress = M.filter (`S.member` todo') (progress s) }, progress s)
+  mapM_ (`poke` 1) . filter (\w -> case M.lookup w p of
+    Nothing -> False
+    Just q -> q `S.notMember` todo') . workers $ s'
   -- set new jobs
   s <- readIORef sR
-  let Just q0 = originQuad (location s) (sheetSize s)
+  let Just q0 = originQuad (imageLocation (image s)) (sheetSize s)
       score = quadDistance q0
   putMVar (jobs s') . sortBy (comparing score) . S.toList $ todo' \\ S.fromList (M.elems p)
 
@@ -428,17 +543,27 @@
 
 upload :: Ptr CFloat -> IO TextureObject
 upload p = do
+  checkError "upload begin"
   [tex] <- genObjectNames 1
+  checkError "upload 1"
   texture Texture2D $= Enabled
+  checkError "upload 2"
   textureBinding Texture2D $= Just tex
-  glTexImage2D gl_TEXTURE_2D 0 (fromIntegral gl_R32F)
+  checkError "upload 3"
+  glTexImage2D gl_TEXTURE_2D 0 (fromIntegral gl_LUMINANCE32F)
     (fromIntegral tileSize) (fromIntegral tileSize) 0
       gl_LUMINANCE gl_FLOAT p
+  checkError "upload 4"
   textureFilter Texture2D $= ((Nearest, Nothing), Nearest)
-  textureWrapMode Texture2D S $= (Repeated, ClampToEdge)
-  textureWrapMode Texture2D T $= (Repeated, ClampToEdge)
+  checkError "upload 5"
+  textureWrapMode Texture2D GL.S $= (Repeated, ClampToEdge)
+  checkError "upload 6"
+  textureWrapMode Texture2D GL.T $= (Repeated, ClampToEdge)
+  checkError "upload 7"
   textureBinding Texture2D $= Nothing
+  checkError "upload 7"
   texture Texture2D $= Disabled
+  checkError "upload end"
   return tex
 
 msPerFrame :: Int
@@ -452,8 +577,7 @@
   , browserSaveImage :: FilePath -> IO ()
   , browserSetExitCallback :: IO () -> IO ()
   , browserSetReshapeCallback :: (Int -> Int -> IO ()) -> IO ()
-  , browserSetMouseCallback :: (Complex R -> Double -> IO ()) -> IO ()
---  , browserResize :: Int -> Int -> Double -> IO ()
+  , browserSetMouseCallback :: MouseCallbacks -> IO ()
   }
 
 browserRenders :: Browser -> [(Image, FilePath)] -> IO ()
@@ -475,7 +599,8 @@
   let defW = width  defWindow
       defH = height defWindow
   windowSetDefaultSize iw defW defH
-  windowSetGeometryHints iw (Nothing `asTypeOf` Just iw)  (Just (160, 120)) (Just (2048, 1536)) Nothing Nothing Nothing
+  windowSetGeometryHints iw (Nothing `asTypeOf` Just iw)
+    (Just (160, 120)) (Just (4096, 4096)) Nothing Nothing Nothing
   set iw
     [ containerBorderWidth := 0
     , containerChild := widget gl'
@@ -486,14 +611,11 @@
   jobs' <- newMVar []
   iR <- newIORef GruffImage
       -- image parameters
-    { location = defLocation
-    , viewport = defViewport
-    , window = defWindow
-    , colours = defColours
+    { image = defImage
       -- callbacks
     , exitCallback = Nothing
     , Browser.reshapeCallback = Nothing
-    , mouseCallback = Nothing
+    , mouseCallback = M.empty
     , doneCallback = Nothing
     , abortCallback = Nothing
       -- job queue
@@ -517,6 +639,7 @@
     , cacheSizeMin = 1000
     , cacheSizeMax = 1500
     , doClear = False
+    , font = error "font"
     }
   realizeCallback gl' $= iRealize iR
   GLUTGtk.reshapeCallback gl' $= iReshape iR Nothing
@@ -540,14 +663,10 @@
         s <- readIORef iR
         let wr = width  (imageWindow img)
             hr = height (imageWindow img)
-        unless (width (window s) == wr && height (window s) == hr) $ do
+        unless (width  (imageWindow (image s)) == wr &&
+                height (imageWindow (image s)) == hr) $ do
           windowResize iw wr hr
-        atomicModifyIORef iR $ \s' -> (s'
-          { window = imageWindow img
-          , viewport = imageViewport img
-          , location = imageLocation img
-          , colours = imageColours img
-          }, ())
+        atomicModifyIORef iR $ \s' -> (s'{ image = img }, ())
         s' <- readIORef iR
         unless (sheetSize s == sheetSize s') (reallocateBuffers iR)
         atomicModifyIORef iR $ \i -> (i
@@ -558,14 +677,15 @@
         update iR
       browserSaveImage' fname = do
         s <- readIORef iR
-        writeSnapshot fname (GL.Position 0 0) (GL.Size (fromIntegral (width (window s))) (fromIntegral (height (window s))))
+        writeSnapshot fname (GL.Position 0 0)
+          (GL.Size (fromIntegral (width (imageWindow (image s))))
+                   (fromIntegral (height (imageWindow (image s)))))
       browserSetExitCallback' act = atomicModifyIORef iR $ \i ->
         ( i{ exitCallback = Just act }, () )
       browserSetReshapeCallback' act = atomicModifyIORef iR $ \i ->
         ( i{ Browser.reshapeCallback = Just act }, () )
       browserSetMouseCallback' act = atomicModifyIORef iR $ \i ->
-        ( i{ mouseCallback = Just act }, () )
---      browserResize' w h s = windowResize iw w h >> iReshape iR (Just s) (Size w h)
+        ( i{ mouseCallback = act }, () )
   keyboardMouseCallback gl' $= iMouse iR
   _ <- timeoutAdd (timer iR >> return True) msPerFrame
   _ <- iw `onDestroy` atExit
@@ -578,7 +698,6 @@
     , browserSetExitCallback = browserSetExitCallback'
     , browserSetReshapeCallback = browserSetReshapeCallback'
     , browserSetMouseCallback = browserSetMouseCallback'
---    , browserResize = browserResize'
     }
 
 fromColours :: Colours -> (Color3 GLfloat, Color3 GLfloat, Color3 GLfloat)
@@ -593,18 +712,31 @@
 
 iRealize :: IORef GruffImage -> IO ()
 iRealize iR = do
+  checkError "realize begin"
   s <- readIORef iR
   log s Debug "realizeCallback"
   drawBuffer $= BackBuffers
+  checkError "realize db"
   glClampColor gl_CLAMP_VERTEX_COLOR gl_FALSE
+  checkError "realize clv"
   glClampColor gl_CLAMP_READ_COLOR gl_FALSE
+  checkError "realize clr"
   glClampColor gl_CLAMP_FRAGMENT_COLOR gl_FALSE
+  checkError "realize clf"
   f <- getDataFileName "minimal.frag"
   prog' <- shader Nothing (Just f)
+  checkError "realize s1"
   f' <- getDataFileName "merge.frag"
   combineProg' <- shader Nothing (Just f')
+  checkError "realize s2"
   fbo' <- newFBO
+  checkError "realize fbo"
   [tsheet0', tsheet1'] <- genObjectNames 2
+  checkError "realize sheets"
+  -- FIXME hardcoded font path
+  font' <- createTextureFont "/usr/share/fonts/truetype/ttf-dejavu/DejaVuSansMono-Bold.ttf"
+  -- FIXME destroyFont (font s) at exit
+  _ <- setFontFaceSize font' 16 72
   ps <- replicateM numCapabilities $ do
     p <- malloc
     _ <- forkIO (worker iR p)
@@ -619,37 +751,65 @@
     , sheetCount0 = 0
     , sheetCount1 = 0
     , sheetCountTarget = maxBound
+    , font = font'
     }, ())
   reallocateBuffers iR
+  checkError "realize end"
 
 reallocateBuffers :: IORef GruffImage -> IO ()
 reallocateBuffers iR = do
+  checkError "reallocate begin"
   s <- readIORef iR
   let tw' = texels $ sheetSize s
       th' = tw'
       ts = [tsheet0 s, tsheet1 s]
   forM_ (ts `zip` [(tw', th'), (tw' * 2, th' * 2)]) $ \(t, (tw, th)) -> do
     texture Texture2D $= Enabled
+    checkError "reallocate 1"
     textureBinding Texture2D $= Just t
+    checkError "reallocate 2"
     glTexImage2D gl_TEXTURE_2D 0 (fromIntegral gl_RGBA)
       (fromIntegral tw) (fromIntegral th) 0 gl_RGBA gl_UNSIGNED_BYTE
       nullPtr
+    checkError "reallocate 3"
     textureFilter Texture2D $= ((Linear', Just Linear'), Linear')
-    textureWrapMode Texture2D S $= (Repeated, ClampToEdge)
-    textureWrapMode Texture2D T $= (Repeated, ClampToEdge)
+    checkError "reallocate 4"
+    textureWrapMode Texture2D GL.S $= (Repeated, ClampToEdge)
+    checkError "reallocate 5"
+    textureWrapMode Texture2D GL.T $= (Repeated, ClampToEdge)
+    checkError "reallocate 6"
     textureBinding Texture2D $= Nothing
+    checkError "reallocate 7"
     texture Texture2D $= Disabled
-  atomicModifyIORef iR $ \s' -> (s'{ sheetCount0 = 0, sheetCount1 = 0, sheetCountTarget = maxBound }, ())
+    checkError "reallocate 8"
+  atomicModifyIORef iR $ \s' ->
+    (s'{ sheetCount0 = 0, sheetCount1 = 0, sheetCountTarget = maxBound }, ())
+  checkError "reallocate end"
 
 newFBO :: IO GLuint
 newFBO = alloca $ \p -> glGenFramebuffers 1 p >> peek p
 
 bindFBO :: GLuint -> TextureObject -> IO ()
 bindFBO f (TextureObject t) = do
+  checkError "bindFBO begin"
   glBindFramebuffer gl_FRAMEBUFFER f
+  checkError "bindFBO 1"
   glFramebufferTexture2D gl_FRAMEBUFFER gl_COLOR_ATTACHMENT0 gl_TEXTURE_2D t 0
+  checkError "bindFBO 2"
+  err <- glCheckFramebufferStatus gl_FRAMEBUFFER
+  when (err /= gl_FRAMEBUFFER_COMPLETE) $
+    putStrLn ("OpenGL framebuffer error: " ++ show err)
+  checkError "bindFBO end"
 
 unbindFBO :: IO ()
 unbindFBO = do
+  checkError "unbindFBO begin"
   glFramebufferTexture2D gl_FRAMEBUFFER gl_COLOR_ATTACHMENT0 gl_TEXTURE_2D 0 0
+  checkError "unbindFBO 1"
   glBindFramebuffer gl_FRAMEBUFFER 0
+  checkError "unbindFBO end"
+
+checkError :: String -> IO ()
+checkError s = do
+  err <- glGetError
+  when (err /= 0) $ putStrLn ("OpenGL error (" ++ s ++ "): " ++ show err)
diff --git a/src/Fractal/GRUFF.hs b/src/Fractal/GRUFF.hs
new file mode 100644
--- /dev/null
+++ b/src/Fractal/GRUFF.hs
@@ -0,0 +1,154 @@
+{- |
+Module      :  Fractal.GRUFF
+Copyright   :  (c) Claude Heiland-Allen 2011
+License     :  GPL-2
+
+Maintainer  :  claudiusmaximus@goto10.org
+Stability   :  unstable
+Portability :  portable
+
+Support library for rendering animations of the Mandelbrot Set fractal
+using the gruff executable.
+
+An example program might have a structure similar to:
+
+  > import Fractal.GRUFF
+  >
+  > animation :: Animation
+  > animation = ...
+  >
+  > main :: IO ()
+  > main = defaultMain animation
+
+with its output fed to the gruff executable.
+
+See also:
+
+  * the @ruff@ package for feature location algorithms; and
+    
+  * the @gruff-examples@ package for concrete examples.
+
+-}
+module Fractal.GRUFF where
+
+import System.IO (hFlush, stdout)
+
+import Fractal.RUFF.Types.Complex (Complex((:+)))
+
+-- | Animation specification
+type Animation = [(Image, FilePath)]
+
+-- | Image specification.
+data Image = Image
+  { imageWindow   :: !Window
+  , imageViewport :: !Viewport
+  , imageLocation :: !Location
+  , imageColours  :: !Colours
+  , imageLabels   :: [Label]
+  , imageLines    :: [Line]
+  }
+  deriving (Read, Show, Eq)
+
+-- | Window specification.
+data Window = Window
+  { width  :: !Int
+  , height :: !Int
+  , supersamples :: !Double
+  }
+  deriving (Read, Show, Eq)
+
+-- | Viewport specification
+data Viewport = Viewport
+  { aspect :: !Double -- width / height
+  , orient :: !Double -- in radians
+  }
+  deriving (Read, Show, Eq)
+
+-- | Location specification (center of view).
+data Location = Location
+  { center :: !(Complex Rational)
+  , radius :: !Double -- accurate enough for 1000 2x zoom levels
+  }
+  deriving (Read, Show, Eq)
+
+-- | Colour specification.
+data Colours = Colours
+  { colourInterior :: !Colour
+  , colourBoundary :: !Colour
+  , colourExterior :: !Colour
+  }
+  deriving (Read, Show, Eq)
+
+-- | RGB colour data (each channel between 0 and 1).
+data Colour = Colour !Double !Double !Double
+  deriving (Read, Show, Eq)
+
+-- | Labels can be added to points in the complex plane.
+data Label = Label
+  { labelCoords :: !(Complex Rational)
+  , labelColour :: !Colour
+  , labelText   :: String
+  }
+  deriving (Read, Show, Eq)
+
+-- | Append a label to an image.
+labelAppend :: Complex Rational -> Colour -> String -> Image -> Image
+labelAppend c v t i = i{ imageLabels = imageLabels i ++ [Label{ labelCoords = c, labelColour = v, labelText = t }] }
+
+-- | Prepend a label to an image.
+labelPrepend :: Complex Rational -> Colour -> String -> Image -> Image
+labelPrepend c v t i = i{ imageLabels = [Label{ labelCoords = c, labelColour = v, labelText = t }] ++ imageLabels i }
+
+-- ! Line segments.
+data Line = Line
+  { lineSegments :: [(Complex Rational, Complex Rational)]
+  , lineColour :: !Colour
+  }
+  deriving (Read, Show, Eq)
+
+-- | Transform a point from screen coordinates.
+fromScreenCoords :: (Fractional r, Real r) => Window -> Viewport -> Location -> Complex Double -> Complex r
+fromScreenCoords w v l = \(x :+ y) ->
+  let x1 = (2 * x - w') / w' * p
+      y1 = (h' - 2 * y) / h' / p
+      x2 =  co * x1 + si * y1
+      y2 = -si * x1 + co * y1
+      x3 = r * toRational x2
+      y3 = r * toRational y2
+      x4 :+ y4 = (x3 :+ y3) + c
+  in  fromRational x4 :+ fromRational y4
+  where
+    p = sqrt (aspect v)
+    w' = fromIntegral (width  w)
+    h' = fromIntegral (height w)
+    a = - orient v
+    co = cos a
+    si = sin a
+    r = toRational $ radius l
+    c = center l
+
+-- | Transform a point to screen coordinates.
+toScreenCoords :: Real r => Window -> Viewport -> Location -> Complex r -> Complex Double
+toScreenCoords w v l = \(x' :+ y') ->
+  let x = (x1 / p * w' + w') /   2
+      y = (y1 * p * h' - h') / (-2)
+      x1 =  co * x2 + si * y2
+      y1 = -si * x2 + co * y2
+      x2 = fromRational (x3 / r)
+      y2 = fromRational (y3 / r)
+      x3 :+ y3 = (toRational x' :+ toRational y') - c
+  in  x :+ y
+  where
+    p = sqrt (aspect v)
+    w' = fromIntegral (width  w)
+    h' = fromIntegral (height w)
+    a = orient v
+    co = cos a
+    si = sin a
+    r = toRational (radius l)
+    c = center l
+
+-- | Serialize an animation to stdout.
+defaultMain :: Animation -> IO ()
+defaultMain a = do
+  mapM_ (\f -> print f >> hFlush stdout) a
diff --git a/src/GLUTGtk.hs b/src/GLUTGtk.hs
--- a/src/GLUTGtk.hs
+++ b/src/GLUTGtk.hs
@@ -20,7 +20,7 @@
 data KeyState = Down | Up
   deriving (Eq, Ord, Show)
 
-data Key = Char Char | MouseButton MouseButton
+data Key = MouseButton MouseButton
   deriving (Eq, Show)
 
 data GLUTGtk = GLUTGtk
diff --git a/src/Interact.hs b/src/Interact.hs
new file mode 100644
--- /dev/null
+++ b/src/Interact.hs
@@ -0,0 +1,91 @@
+module Interact
+  ( mouseCallbacks
+  , MouseCallbacks
+  , MouseCallback
+  , Click
+  , But(..)
+  , Mod(..)
+  ) where
+
+import Data.Map (Map, fromList)
+
+import Fractal.RUFF.Mandelbrot.Address
+import Fractal.RUFF.Mandelbrot.Atom
+import Fractal.RUFF.Types.Complex
+
+import Fractal.GRUFF
+
+import Progress
+
+type MouseCallbacks = Map Click MouseCallback
+
+type Click = (But, Mod)
+
+data But = L | M | R      deriving (Eq, Ord, Show)
+data Mod = U | S | C | SC deriving (Eq, Ord, Show)
+
+type MouseCallback = Complex Rational -> Image -> IO ()
+
+type MouseHandler = Progress -> Complex Rational -> Image -> Cont Image
+
+mouseCallbacks :: IO Colour -> Progress -> (Maybe Image -> IO ()) -> MouseCallbacks
+mouseCallbacks gc p next = fromList
+  [ ( (L, U), w $ mouseZoom 0.9   )
+  , ( (R, U), w $ mouseZoom 1.1   )
+  , ( (M, U), w $ mouseCenter     )
+  , ( (L, S), w $ mouseZoom 0.1   )
+  , ( (R, S), w $ mouseZoom 10    )
+  , ( (M, S), w $ mouseLocateGo   )
+  , ( (L, C), w $ mousePeriod  gc )
+  , ( (R, C), w $ mouseAddress gc )
+  ]
+  where w cb c i = cb p c i next
+
+mouseCenter :: MouseHandler
+mouseCenter _ c i next = do
+  next . Just $ i{ imageLocation = (imageLocation i){ center = c } }
+
+mouseZoom :: Double -> MouseHandler
+mouseZoom f _ c i next = do
+  let o = center (imageLocation i)
+      r = radius (imageLocation i)
+      f' = toRational f :+ 0
+      r' = f * r
+      o' = f' * o + (1 - f') * c
+  next . Just $ i{ imageLocation = (imageLocation i){ center = o', radius = r' } }
+
+mouseLocateGo :: MouseHandler
+mouseLocateGo p c i next = do
+  let r0 = radius (imageLocation i) / 32
+  progressLocate p c r0 $ \mmu -> case mmu of
+    Nothing -> next Nothing
+    Just mu -> do
+      let n = muNucleus mu
+          r = muSize    mu * 16
+          a = muOrient  mu - pi/2
+      next . Just $ i{ imageLocation = (imageLocation i){ center = n, radius = r }, imageViewport = (imageViewport i){ orient = a } }
+
+mousePeriod :: IO Colour -> MouseHandler
+mousePeriod gv p c i next = do
+  let r = radius (imageLocation i) / 32
+  progressLocate p c r $ \mmu -> case mmu of
+    Nothing -> next Nothing
+    Just mu -> do
+      let n = muNucleus mu
+          t = show (muPeriod mu)
+      v <- gv
+      next . Just $ labelAppend n v t i
+
+mouseAddress :: IO Colour -> MouseHandler
+mouseAddress gv p c i next = do
+  let r = radius (imageLocation i) / 32
+  progressLocate p c r $ \mmu -> case mmu of
+    Nothing -> next Nothing
+    Just mu -> do
+      progressAddress p mu $ \mad -> case mad of
+        Nothing -> next Nothing
+        Just ad -> do
+          let n = muNucleus mu
+              t = prettyAngledInternalAddress ad
+          v <- gv
+          next . Just $ labelAppend n v t i
diff --git a/src/MuAtom.hs b/src/MuAtom.hs
deleted file mode 100644
--- a/src/MuAtom.hs
+++ /dev/null
@@ -1,171 +0,0 @@
-{-# LANGUAGE BangPatterns #-}
-module MuAtom(MuAtom(..), MuProgress(..), muFromAddress, MuProgress'(..), muToAddress, MuProgress''(..), muLocate) where
-
-import Control.Arrow ((***))
-import Data.Ratio ((%))
-import Data.Vec (NearZero, nearZero)
-
-import Fractal.RUFF.Mandelbrot.Address (AngledInternalAddress, Angle, splitAddress, addressPeriod, externalAngles, angledInternalAddress)
-import Fractal.RUFF.Mandelbrot.Nucleus (findNucleus, findBond, findPeriod)
-import Fractal.RUFF.Mandelbrot.Ray (externalRay, externalRayOut)
-import Fractal.RUFF.Types.Complex (Complex, magnitude, magnitude2, phase, mkPolar)
-
-import Number (R)
-
-data MuAtom = MuAtom
-  { muNucleus :: !(Complex R)
-  , muSize    :: !Double
-  , muOrient  :: !Double
-  , muPeriod  :: !Integer
-  }
-  deriving (Read, Show, Eq)
-
-data MuProgress
-  = MuSplitTodo
-  | MuSplitDone AngledInternalAddress [Angle]
-  | MuAnglesTodo
-  | MuAnglesDone !Rational !Rational
-  | MuRayTodo
-  | MuRay !Integer
-  | MuRayDone !(Complex R)
-  | MuNucleusTodo
-  | MuNucleus !Integer
-  | MuNucleusDone !(Complex R)
-  | MuBondTodo
-  | MuBond !Integer
-  | MuBondDone !(Complex R)
-  | MuSuccess !MuAtom
-  | MuFailed
-  deriving (Read, Show, Eq)
-
-muFromAddress :: AngledInternalAddress -> [MuProgress]
-muFromAddress addr = MuSplitTodo :
-  let (!iaddr, !caddr) = splitAddress addr
-      !p = addressPeriod iaddr
-  in  MuSplitDone iaddr caddr : MuAnglesTodo : case externalAngles iaddr of
-    Nothing -> [MuFailed]
-    Just (!lo, !hi) -> MuAnglesDone lo hi : MuRayTodo :
-      let sharpness = 8
-          er = 65536
-          accuracy = 1e-10
-          ok w = magnitude2 w < 2 * er ^ (2::Int) -- NaN -> False
-          rayl = externalRay accuracy sharpness er lo
-          rayh = externalRay accuracy sharpness er hi
-          ray' = takeWhile (uncurry (&&) . (ok *** ok) . snd) $ [ 1 .. ] `zip` (rayl `zip` rayh)
-          rgo []  _ = [MuFailed]
-          rgo [_] _ = [MuFailed]
-          rgo ((i, (xl, xh)):m@((_, (yl, yh)):_)) f
-            | i < fromIntegral sharpness * (p + 16) = MuRay i : rgo m f
-            | dl + dh > dx + dy = MuRay i : rgo m f
-            | otherwise = MuRayDone x : f x
-            where
-              x  = 0.5 * (xl + xh)
-              dl = magnitude2 (xl - yl)
-              dh = magnitude2 (xh - yh)
-              dx = magnitude2 (xl - xh)
-              dy = magnitude2 (yl - yh)
-      in  rgo ray' $ \rayend -> MuNucleusTodo :
-        let nuc = findNucleus p rayend
-            nuc' = takeWhile (ok . snd) $ [ 1 .. ] `zip` nuc
-            ngo []  _ = [MuFailed]
-            ngo [_] _ = [MuFailed]
-            ngo ((i, x):m@((_, y):_)) f
-              | not (nearZero (x - y)) = MuNucleus i : ngo m f
-              | otherwise = MuNucleusDone x : f x
-        in  ngo nuc' $ \nucleus -> MuBondTodo :
-          let bnd = findBond p nucleus 0.5
-              bnd' = takeWhile (ok . snd) $ [ 1.. ] `zip` bnd
-              bgo []  _ = [MuFailed]
-              bgo [_] _ = [MuFailed]
-              bgo ((i, x):m@((_, y):_)) f
-                | not (nearZero (x - y)) = MuBond i : bgo m f
-                | otherwise = MuBondDone x : f x
-          in  bgo bnd' $ \bond ->
-            let delta  = bond - nucleus
-                size   = realToFrac $ magnitude delta / 0.75
-                orient = realToFrac $ phase delta
-                atom   = MuAtom{ muNucleus = nucleus, muSize = size, muOrient = orient, muPeriod = p }
-            in  if 10 > size && size > 0 then [MuSuccess atom] else [MuFailed]
-
-data MuProgress'
-  = MuCuspTodo
-  | MuCuspDone !(Complex R)
-  | MuDwellTodo
-  | MuDwell !Integer
-  | MuDwellDone !Integer
-  | MuRayOutTodo
-  | MuRayOut !Double
-  | MuRayOutDone !(Complex R)
-  | MuExternalTodo
-  | MuExternalDone !Rational
-  | MuAddressTodo
-  | MuSuccess' AngledInternalAddress
-  | MuFailed'
-  deriving (Read, Show, Eq)
-
-muToAddress :: MuAtom -> [MuProgress']
-muToAddress mu = MuCuspTodo :
-  let cusp = muNucleus mu - mkPolar (realToFrac (muSize mu)) (realToFrac ((muOrient mu)))
-      er = 65536
-      er2 = er * er
-  in  MuCuspDone cusp : MuDwellTodo :
-    let dgo z n f = MuDwell n : if magnitude2 z > er2 then f n else dgo (z * z + cusp) (n + 1) f
-    in  dgo 0 0 $ \n -> MuDwellDone n : MuRayOutTodo :
-      let rgo ((i,!_):izs@(_:_)) f = MuRayOut (fromIntegral i / (fromIntegral sharpness * fromIntegral n)) : rgo izs f
-          rgo [(_,!z)] f | magnitude2 z > er2 = MuRayOutDone z : f z
-          rgo _ _ = [MuFailed']
-          accuracy = 1e-16
-          sharpness = 16
-          epsilon0 = realToFrac (muSize mu) * accuracy
-      in  rgo ([(1 :: Integer) ..] `zip` externalRayOut (fromIntegral n + 100) epsilon0 accuracy sharpness er cusp) $ \rend -> MuExternalTodo :
-        let den = 2 ^ muPeriod mu - 1
-            num' = fromIntegral den * warp (phase rend / (2 * pi))
-            num = round num'
-            warp t
-              | t > 0 = t
-              | otherwise = t + 1
-            angle = num % den
-        in  MuExternalDone angle : MuAddressTodo : case angledInternalAddress angle of
-              Nothing -> [MuFailed']
-              Just addr -> if addressPeriod addr /= muPeriod mu then [MuFailed'] else [MuSuccess' addr]
-
-data MuProgress''
-  = MuScanTodo
-  | MuScan
-  | MuScanDone !Integer
-  | MuNucleusTodo'
-  | MuNucleus' !Integer
-  | MuNucleusDone' !(Complex R)
-  | MuBondTodo'
-  | MuBond' !Integer
-  | MuBondDone' !(Complex R)
-  | MuSuccess'' !MuAtom
-  | MuFailed''
-  deriving (Read, Show, Eq)
-
-muLocate :: Complex R -> Double -> [MuProgress'']
-muLocate c r = MuScanTodo : MuScan : case findPeriod 10000000 (realToFrac r) c of
-  Nothing -> [MuFailed'']
-  Just p -> MuScanDone p : MuNucleusTodo' :
-    let ok w = magnitude2 w < 16 -- NaN -> False
-        nuc = findNucleus p c
-        nuc' = takeWhile (ok . snd) $ [ 1 .. ] `zip` nuc
-        ngo []  _ = [MuFailed'']
-        ngo [_] _ = [MuFailed'']
-        ngo ((i, x):m@((_, y):_)) f
-          | not (nearZero (x - y)) = MuNucleus' i : ngo m f
-          | otherwise = MuNucleusDone' x : f x
-    in  ngo nuc' $ \nucleus -> MuBondTodo' :
-      let bnd = findBond p nucleus 0.5
-          bnd' = takeWhile (ok . snd) $ [ 1.. ] `zip` bnd
-          bgo []  _ = [MuFailed'']
-          bgo [_] _ = [MuFailed'']
-          bgo ((i, x):m@((_, y):_)) f
-            | not (nearZero (x - y)) = MuBond' i : bgo m f
-            | otherwise = MuBondDone' x : f x
-      in  bgo bnd' $ \bond ->
-        let delta  = bond - nucleus
-            size   = realToFrac $ magnitude delta / 0.75
-            orient = realToFrac $ phase delta
-            atom   = MuAtom{ muNucleus = nucleus, muSize = size, muOrient = orient, muPeriod = p }
-        in  if 10 > size && size > 0 then [MuSuccess'' atom] else [MuFailed'']
diff --git a/src/Number.hs b/src/Number.hs
--- a/src/Number.hs
+++ b/src/Number.hs
@@ -3,11 +3,11 @@
 
 import Data.Bits (bit)
 import Data.Ratio ((%))
-import Data.Vec (NearZero(nearZero))
-import Fractal.RUFF.Types.Complex (Complex((:+)))
+import Data.Vec (NearZero)
 
 #ifdef HAVE_MPFR
 
+import Data.Vec (nearZero)
 import Control.Monad (guard)
 import Data.Ratio (numerator, denominator)
 import Numeric (readSigned)
@@ -16,7 +16,7 @@
 
 #else
 
-import Numeric.QD (QuadDouble(QuadDouble))
+import Numeric.QD (QuadDouble)
 import Numeric.QD.Vec ()
 
 #endif
@@ -72,6 +72,3 @@
 toRational' :: RealFrac a => Int -> a -> Rational
 toRational' l a = round (a * fromInteger b) % b
   where b = bit (l + 16)
-
-instance NearZero r => NearZero (Complex r) where
-  nearZero (r:+i) = nearZero r && nearZero i
diff --git a/src/Progress.hs b/src/Progress.hs
new file mode 100644
--- /dev/null
+++ b/src/Progress.hs
@@ -0,0 +1,109 @@
+module Progress (Progress(..), progressNew, Cont) where
+
+import Control.Monad (forM_, when)
+
+import Graphics.UI.Gtk (Pixbuf)
+
+import Fractal.RUFF.Mandelbrot.Address
+import Fractal.RUFF.Mandelbrot.Atom
+import Fractal.RUFF.Types.Complex
+
+import Number (R)
+import StatusDialog
+
+-- | A continuation gets passed the result.
+type Cont a = (Maybe a -> IO ()) -> IO ()
+
+-- | Cancellable actions with status updates.
+data Progress = Progress
+  { progressLocate  :: Complex Rational -> Double -> Cont (MuAtom Rational)
+  , progressAtom    :: AngledInternalAddress -> Cont (MuAtom Rational)
+  , progressAddress :: MuAtom Rational -> Cont AngledInternalAddress
+  }
+
+-- | Create a new Progress with a status dialog.
+progressNew :: Pixbuf -> IO Progress
+progressNew icon = do
+  -- FIXME this is a horrible hack to avoid race conditions when re-using the same status dialog
+  sd1 <- statusDialogNew icon
+  sd2 <- statusDialogNew icon
+  sd3 <- statusDialogNew icon
+  return Progress
+    { progressLocate  = progressLocate'  sd1
+    , progressAtom    = progressAtom'    sd2
+    , progressAddress = progressAddress' sd3
+    }
+
+-- | Much like Fractal.RUFF.Mandelbrot.Atom.locate_
+progressLocate' :: StatusDialog -> Complex Rational -> Double -> Cont (MuAtom Rational)
+progressLocate' sd (re :+ im) r next = do
+  statusDialog sd "gruff status" $ \progress' -> do
+    let c = fromRational re :+ fromRational im :: Complex R
+    forM_ (locate c r) $ \mp -> case mp of
+      LocateScanTodo       -> progress' "Scanning for period..."
+      LocateScan           -> progress' "Scanning for period..."
+      LocateScanDone p     -> progress'$"Scanning for period... " ++ show p
+      LocateNucleusTodo    -> progress' "Computing nucleus..."
+      LocateNucleus i      -> when (i `mod` 20 == 0) . progress'$"Computing nucleus... " ++ show i
+      LocateNucleusDone _  -> progress' "Computing nucleus... done"
+      LocateBondTodo       -> progress' "Computing bond..."
+      LocateBond i         -> when (i `mod` 20 == 0) . progress'$"Computing bond... " ++ show i
+      LocateBondDone _     -> progress' "Computing bond... done"
+      LocateSuccess mu     -> do
+        progress' "Success!"
+        let (re' :+ im') = muNucleus mu
+        next $ Just mu{ muNucleus = toRational re' :+ toRational im' }
+      LocateFailed         -> do
+        progress' "Failed!"
+        next $ Nothing
+
+-- | Much like Fractal.RUFF.Mandelbrot.Atom.findAddress_
+progressAddress' :: StatusDialog -> MuAtom Rational -> Cont AngledInternalAddress
+progressAddress' sd mu next = do
+  statusDialog sd "gruff status" $ \progress' -> do
+    let re :+ im = muNucleus mu
+        c = fromRational re :+ fromRational im :: Complex R
+    forM_ (findAddress mu{ muNucleus = c }) $ \mp' -> case mp' of
+      AddressCuspTodo       -> progress' "Computing cusp..."
+      AddressCuspDone _     -> progress' "Computing cusp... done"
+      AddressDwellTodo      -> progress' "Computing dwell..."
+      AddressDwell i        -> when (i `mod` 100 == 0) . progress'$"Computing dwell... " ++ show i
+      AddressDwellDone _    -> progress' "Computing dwell... done"
+      AddressRayOutTodo     -> progress' "Tracing rays..."
+      AddressRayOut i       -> progress'$"Tracing rays... " ++ show (round $ i * 100 :: Int) ++ "%"
+      AddressRayOutDone _   -> progress' "Tracing rays... done"
+      AddressExternalTodo   -> progress' "Computing angle..."
+      AddressExternalDone _ -> progress' "Computing angle... done"
+      AddressAddressTodo    -> progress' "Finding address..."
+      AddressSuccess a      -> do
+        progress' "Success!"
+        next $ Just a
+      AddressFailed         -> do
+        progress' "Failed!"
+        next $ Nothing
+
+-- | Much like Fractal.RUFF.Mandelbrot.Atom.findAtom_
+progressAtom' :: StatusDialog -> AngledInternalAddress -> Cont (MuAtom Rational)
+progressAtom' sd addr next = do
+  statusDialog sd "gruff status" $ \progress' -> do
+    forM_ (findAtom addr) $ \mp -> case mp of
+      AtomSplitTodo      -> progress' "Splitting address..."
+      AtomSplitDone _ _  -> progress' "Splitting address... done"
+      AtomAnglesTodo     -> progress' "Computing angles..."
+      AtomAnglesDone _ _ -> progress' "Computing angles... done"
+      AtomRayTodo        -> progress' "Tracing rays..."
+      AtomRay n          -> when (n `mod` 20 == 0) . progress'$"Tracing rays... " ++ show n
+      AtomRayDone _      -> progress' "Tracing rays... done"
+      AtomNucleusTodo    -> progress' "Computing nucleus..."
+      AtomNucleus n      -> when (n `mod` 20 == 0) . progress'$"Computing nucleus... " ++ show n
+      AtomNucleusDone _  -> progress' "Computing nucleus... done"
+      AtomBondTodo       -> progress' "Computing bond..."
+      AtomBond n         -> when (n `mod` 20 == 0) . progress'$"Computing bond... " ++ show n
+      AtomBondDone _     -> progress' "Computing bond... done"
+      AtomSuccess mu     -> do
+        progress' "Success!"
+        let (re' :+ im') = muNucleus mu :: Complex R
+        next $ Just mu{ muNucleus = toRational re' :+ toRational im' }
+      AtomFailed         -> do
+        progress' "Failed!"
+        next $ Nothing
diff --git a/src/Snapshot.hs b/src/Snapshot.hs
--- a/src/Snapshot.hs
+++ b/src/Snapshot.hs
@@ -14,7 +14,7 @@
 import qualified Data.ByteString.Internal as BSI
 import qualified Data.ByteString as BS
 
--- save a screenshot to a handle as binary PPM
+-- save a screenshot as binary PPM
 snapshotWith :: (BS.ByteString -> IO b) -> Position -> Size -> IO b
 snapshotWith f p0 vp@(Size vw vh) = do
   let fi q = fromIntegral q
diff --git a/src/StatusDialog.hs b/src/StatusDialog.hs
--- a/src/StatusDialog.hs
+++ b/src/StatusDialog.hs
@@ -6,9 +6,10 @@
 type Status = (String -> IO ()) -> IO ()
 data StatusDialog = StatusDialog{ statusDialog :: String -> Status -> IO () }
 
-statusDialogNew :: IO StatusDialog
-statusDialogNew = do
+statusDialogNew :: Pixbuf -> IO StatusDialog
+statusDialogNew icon = do
   window <- windowNew
+  set window [ windowIcon := Just icon ]
   windowSetModal window True
   windowSetDefaultSize window 320 200
   b <- vBoxNew False 2
@@ -17,7 +18,7 @@
   boxPackStartDefaults b label
   boxPackStartDefaults b cancel
   set window [ containerChild := b ]
-  return StatusDialog{ statusDialog = \title task -> do
+  return StatusDialog{ statusDialog = \title task -> postGUIAsync $ do
     windowSetTitle window title
     labelSetText label ""
     widgetSetSensitivity cancel True
diff --git a/src/Tile.hs b/src/Tile.hs
--- a/src/Tile.hs
+++ b/src/Tile.hs
@@ -30,7 +30,12 @@
 rootSquare :: Square
 rootSquare = Square{ squareSize = 8, squareWest = -4, squareNorth = -4 }
 
-data Tile = Tile Quad (Ptr CFloat) (Ptr CFloat) (Ptr CFloat)
+data Tile = Tile
+  { tileQuad :: Quad
+  , tileIter :: Ptr CFloat
+  , tileDist :: Ptr CFloat
+  , tileAngle :: Ptr CFloat
+  }
 
 mallocTile :: Quad -> IO Tile
 mallocTile cs = do
diff --git a/src/View.hs b/src/View.hs
--- a/src/View.hs
+++ b/src/View.hs
@@ -3,9 +3,10 @@
   , Viewport(..), rotate, defViewport
   , Window(..), windowSize, defWindow
   , Colours(..), defColours, Colour(..)
+  , Label(..), Line(..)
   , Image(..), defImage
   , BufferSize(..), bufferSize
-  , pixelLocation, delta, tileSize
+  , pixelLocation, delta, tileSize, locationPixel
   , visibleQuads, originQuad
   ) where
 
@@ -15,67 +16,31 @@
 
 import Fractal.RUFF.Types.Complex (Complex((:+)))
 
+import Fractal.GRUFF
+
 import QuadTree (Quad(..), Child(..), child)
 
-data Location = Location
-  { center :: !(Complex Rational)
-  , radius :: !Double -- accurate enough for 1000 2x zoom levels
-  }
-  deriving (Read, Show, Eq)
+pixelLocation :: Window -> Viewport -> Location -> Double -> Double -> Complex Rational
+pixelLocation w v l = let f = fromScreenCoords w v l in \x y -> f (x :+ y)
 
+locationPixel :: Window -> Viewport -> Location -> Complex Rational -> (Double, Double)
+locationPixel w v l = let f = toScreenCoords w v l in \c -> let (x :+ y) = f c in (x, y)
+
 zoom :: Double -> Location -> Location
 zoom f l = l{ radius = radius l * f}
 
 translate :: Complex Rational -> Location -> Location
 translate u l = l{ center = center l + u }
 
-data Viewport = Viewport
-  { aspect :: !Double -- width / height
-  , orient :: !Double -- in radians
-  }
-  deriving (Read, Show, Eq)
-
 rotate :: Double -> Viewport -> Viewport
 rotate a v = v{ orient = orient v + a }
 
-data Window = Window
-  { width  :: !Int
-  , height :: !Int
-  , supersamples :: !Double
-  }
-  deriving (Read, Show, Eq)
-
 windowSize :: Window -> Int
 windowSize w = ceiling . sqrt . (fromIntegral :: Int -> Double) . diagonal2 $ w
 
 diagonal2 :: Window -> Int
 diagonal2 w = width w * width w + height w * height w
 
-{-
-resolution :: Window -> Double
-resolution w = sqrt $ supersamples w * fromIntegral (diagonal2 w)
--}
-
-pixelLocation :: Window -> Viewport -> Location -> Double -> Double -> Complex Rational
-pixelLocation w v l x y =
-  let x' :+ y' = pixelLocation' w v l x y
-  in  center l + (toRational x' :+ toRational y')
-
-pixelLocation' :: Window -> Viewport -> Location -> Double -> Double -> Complex Double
-pixelLocation' w v l x y =
-  let p = sqrt (aspect v)
-      w' = fromIntegral (width  w)
-      h' = fromIntegral (height w)
-      x1 = (2 * x - w') / w' * p
-      y1 = (h' - 2 * y) / h' / p
-      a = - orient v
-      co = cos a
-      si = sin a
-      x2 =  co * x1 + si * y1
-      y2 = -si * x1 + co * y1
-      r = radius l
-  in  (r * x2) :+ (r * y2)
-
 data BufferSize = BufferSize
   { texels :: !Int -- power of two
   }
@@ -173,32 +138,16 @@
   let qs1 = concatMap childQuads qs0
   return ( filter (visible False) qs0 , filter (visible True) qs1 )
 
-data Image = Image
-  { imageWindow   :: !Window
-  , imageViewport :: !Viewport
-  , imageLocation :: !Location
-  , imageColours  :: !Colours
-  }
-  deriving (Read, Show, Eq)
-
 defImage :: Image
 defImage = Image
   { imageWindow = defWindow
   , imageViewport = defViewport
   , imageLocation = defLocation
   , imageColours = defColours
+  , imageLabels = []
+  , imageLines = []
   }
 
-data Colours = Colours
-  { colourInterior :: !Colour
-  , colourBoundary :: !Colour
-  , colourExterior :: !Colour
-  }
-  deriving (Read, Show, Eq)
-
-data Colour = Colour !Double !Double !Double
-  deriving (Read, Show, Eq)
-
 defColours :: Colours
 defColours = Colours
   { colourInterior = Colour 1 0 0
@@ -207,7 +156,7 @@
   }
 
 defLocation :: Location
-defLocation = Location{ center = 0, radius = 4 }
+defLocation = Location{ center = 0, radius = 2 }
 
 defWindow :: Window
 defWindow = Window{ width = 512, height = 288, supersamples = 1 }
diff --git a/src/gruff.hs b/src/gruff.hs
--- a/src/gruff.hs
+++ b/src/gruff.hs
@@ -1,29 +1,30 @@
-{-# LANGUAGE StandaloneDeriving #-}
 module Main (main) where
 
 import Prelude hiding (catch, log)
---import Control.Concurrent (forkIO)
-import Control.Monad (forM_, liftM3, when)
+import Control.Concurrent (forkIO)
+import Control.Monad (forM_)
 import Data.IORef (IORef, newIORef, readIORef, atomicModifyIORef, writeIORef)
-import Data.Maybe (isJust, fromMaybe) --  , mapMaybe)
+import Data.Maybe (mapMaybe)
 import Graphics.UI.Gtk hiding (get, Region, Size, Window, Viewport)
 import qualified Graphics.UI.Gtk as GTK
 import Graphics.UI.Gtk.OpenGL (initGL)
 import System.Directory (getAppUserDataDirectory, createDirectoryIfMissing)
 import System.FilePath ((</>))
 
-import Fractal.RUFF.Mandelbrot.Address (AngledInternalAddress, Angle, parseAngledInternalAddress, prettyAngledInternalAddress)
 import Fractal.RUFF.Types.Complex (Complex((:+)), realPart, imagPart)
 
 import Paths_gruff (getDataFileName)
 import Number (R)
-import Browser (Browser(..), browserNew) --  , browserRenders)
-import MuAtom (MuAtom(..), MuProgress(..), muFromAddress, MuProgress'(..), muToAddress, MuProgress''(..), muLocate)
-import View (Image(..), Location(..), Viewport(..), Window(..), Colours(..), Colour(..), defWindow, defViewport) --  , defColours)
+import Browser (Browser(..), browserNew, browserRenders)
+import Progress (progressNew)
+import Interact (mouseCallbacks)
+import View
+  ( Image(..), Location(..), Viewport(..), Window(..)
+  , Colours(..), Colour(..), defImage, defLocation
+  )
 import GLUTGtk (glut, Size(Size), postRedisplay)
 import Logger (logger, LogLevel(Debug))
 import qualified Logger as Log
-import StatusDialog (StatusDialog, statusDialog, statusDialogNew)
 import Utils (safeRead, catchIO)
 
 exit :: (LogLevel -> String -> IO ()) -> FilePath -> Gruff -> IO ()
@@ -33,17 +34,13 @@
   mainQuit
 
 data GruffGUI = GruffGUI
-  { dStatus                 :: StatusDialog
   -- buttons
-  , bHome
+  { bHome
   , bLoad
   , bSave
   , bStop
-  , bAddressToCoordinates
-  , bPeriodScan
-  , bPeriodScanPlus         :: Button
+  , bClear                  :: Button
   -- entries
-  , eAddress
   , eRealM, eRealE
   , eImagM, eImagE
   , eSizeM, eSizeE
@@ -78,8 +75,11 @@
   browser <- browserNew gl' icon lg cacheDir'
   let iw = browserWindow browser
   sg <- sizeGroupNew SizeGroupHorizontal
+
   let spacing = 2
+
       entryNewWithMnemonic m = entryNewWithMnemonic' m 30
+
       entryNewWithMnemonic' m wc = do
         e <- entryNew
         entrySetWidthChars e wc
@@ -90,6 +90,7 @@
         boxPackStart h l PackNatural 0
         boxPackStartDefaults h e
         return (e, h)
+
       entryNewExponent = do
         e <- entryNew
         entrySetWidthChars e 4
@@ -98,6 +99,7 @@
         boxPackStart h l PackNatural 0
         boxPackStart h e PackNatural 0
         return (e, h)
+
       frameNewWithContents box t r ws = do
         f <- frameNew
         frameSetLabel f t
@@ -106,25 +108,13 @@
         forM_ ws $ boxPackStartDefaults v
         set f [ containerChild := v ]
         return f
-      frameNewWithContents' _ _ _ [] = error "frameNewWithContents': []"
-      frameNewWithContents' box t r (w:ws) = do
-        f <- frameNew
-        frameSetLabel f t
-        frameSetLabelAlign f (if r then 1 else 0) 0.5
-        v <- box False spacing
-        boxPackStart v w PackGrow 0
-        forM_ ws $ \w' -> boxPackStart v w' PackNatural 0
-        set f [ containerChild := v ]
-        return f
-  dStatus'                  <- statusDialogNew
-  b01@bHome'                <- buttonNewWithLabel "Home"
-  b02@bLoad'                <- buttonNewWithLabel "Load"
-  b03@bSave'                <- buttonNewWithLabel "Save"
-  b04@bStop'                <- buttonNewWithLabel "Stop"
-  b7@bAddressToCoordinates' <- buttonNewWithLabel "Go"
-  b8@bPeriodScan'           <- buttonNewWithLabel "Scan"
-  b9@bPeriodScanPlus'       <- buttonNewWithLabel "Scan+"
-  (eAddress', fa1) <- entryNewWithMnemonic "_Address"
+
+  b01@bHome'  <- buttonNewWithLabel "Home"
+  b02@bLoad'  <- buttonNewWithLabel "Load"
+  b03@bSave'  <- buttonNewWithLabel "Save"
+  b04@bStop'  <- buttonNewWithLabel "Stop"
+  b05@bClear' <- buttonNewWithLabel "Clear"
+
   (eRealM', fc1m) <- entryNewWithMnemonic "_Real"
   (eRealE', fc1e) <- entryNewExponent
   (eImagM', fc2m) <- entryNewWithMnemonic "_Imag"
@@ -135,13 +125,19 @@
   (eWidth', fvW)   <- entryNewWithMnemonic' "_Width"     5
   (eHeight', fvH)  <- entryNewWithMnemonic' "_Height"    5
   (eSamples', fvS) <- entryNewWithMnemonic' "_Samples"   3
+
   cInterior' <- colorButtonNewWithColor red
   cBorder'   <- colorButtonNewWithColor black
   cExterior' <- colorButtonNewWithColor white
-  fb <- frameNewWithContents  vBoxNew "Actions" False [b01, b02, b03, b04, b8, b9]
-  fa <- frameNewWithContents' hBoxNew "Angled Internal Address" True [toWidget fa1, toWidget b7]
-  fh <- frameNewWithContents  hBoxNew "Colours" True [cInterior', cBorder', cExterior']
+
+  labelColourR <- newIORef (fromColor blue)
+  cLabels'   <- colorButtonNewWithColor blue
+  _ <- cLabels' `onColorSet` (colorButtonGetColor cLabels' >>= writeIORef labelColourR . fromColor)
+
+  fb <- frameNewWithContents  vBoxNew "Actions" False [b01, b02, b03, b04, b05]
+  fh <- frameNewWithContents  hBoxNew "Colours" True [cInterior', cBorder', cExterior', cLabels']
   fv <- frameNewWithContents  hBoxNew "Viewport" True [fvR, fvW, fvH, fvS]
+
   let packMantissaExponent m e = do
         h <- hBoxNew False spacing
         boxPackStartDefaults h m
@@ -152,27 +148,26 @@
   fc3 <- packMantissaExponent fc3m fc3e
   fc <- frameNewWithContents vBoxNew "Coordinates" True [fc1, fc2, fc3]
   v <- vBoxNew False spacing
-  mapM_ (\w -> boxPackStart v w PackNatural 0) [fc, fv, fa, fh]
+  mapM_ (\w -> boxPackStart v w PackNatural 0) [fc, fv, {- fa, -} fh]
   h <- hBoxNew False spacing
   boxPackStart h fb PackNatural 0
   boxPackStartDefaults h v
+
   ww <- windowNew
   set ww [ windowIcon := Just icon, windowTitle := "gruff control" ]
+
   containerAdd ww h
   mg <- aDoLoad stateFile
   gR <- newIORef $ case mg of
     Nothing -> initialGruff
     Just g -> g
+
   let g0 = GruffGUI
-            { dStatus               = dStatus'
-            , bHome                 = bHome'
+            { bHome                 = bHome'
             , bLoad                 = bLoad'
             , bSave                 = bSave'
             , bStop                 = bStop'
-            , bAddressToCoordinates = bAddressToCoordinates'
-            , bPeriodScan           = bPeriodScan'
-            , bPeriodScanPlus       = bPeriodScanPlus'
-            , eAddress              = eAddress'
+            , bClear                = bClear'
             , eRealM                = eRealM'
             , eRealE                = eRealE'
             , eImagM                = eImagM'
@@ -195,27 +190,15 @@
       butI b a = do
         _ <- b g0 `onClicked` (wrapA g0 gR a >> upI)
         return ()
-      butJ b a = do
-        _ <- b g0 `onClicked` (wrapA' g0 gR a upI)
-        return ()
+
       butO b a = do
         _ <- b g0 `onClicked` a
         return ()
-      ent e a = do
-        _ <- e g0 `onEntryActivate` (entryGetText (e g0) >>= wrapE g0 gR a)
-        return ()
+
       entI e a = do
         _ <- e g0 `onEntryActivate` (entryGetText (e g0) >>= wrapE g0 gR a >> upI)
         return ()
-{-
-      entI' e a = do
-        _ <- e g0 `onEntryActivate` (do
-          entryGetText (e g0) >>= wrapE g0 gR a
-          g <- readIORef gR
-          browserResize browser (width (gWindow g)) (height (gWindow g)) (supersamples (gWindow g))
-          upI)
-        return ()
--}
+
       colI cbi cbb cbe a = forM_ [cbi, cbb, cbe] $ \c -> do
         _ <- c g0 `onColorSet` (do
           ci <- colorButtonGetColor (cbi g0)
@@ -224,6 +207,7 @@
           _ <- a ci cb ce gR
           upI)
         return ()
+
       entME m e a = do
         let a' = do
                   ms <- entryGetText (m g0)
@@ -234,44 +218,40 @@
         _ <- m g0 `onEntryActivate` a'
         _ <- e g0 `onEntryActivate` a'
         return ()
+
+      upI :: IO ()
       upI = do
         g <- readIORef gR
-        browserRender browser Image
-          { imageColours = let (c1, c2, c3) = gColours g in Colours (fromColor c1) (fromColor c2) (fromColor c3)
-          , imageLocation = Location
-              { center = toRational (fromMaybe 0 (gReal g)) :+ toRational (fromMaybe 0 (gImag g))
-              , radius = fromMaybe 0 (gSize g)
-              }
-          , imageViewport = (gViewport g){ orient = fromMaybe 0 (gRota g) }
-          , imageWindow = gWindow g
-          } (return ()) (return ())
+        browserRender browser g (return ()) (return ())
         postRedisplay gl'
-      aUpdate (re :+ im) z = do
-        atomicModifyIORef gR $ \g ->
-          ( g{ gReal = Just re, gImag = Just im, gSize = Just z }, () )
-        g <- readIORef gR
-        uReal g0 g
-        uImag g0 g
-        uSize g0 g
-        uRota g0 g
+
+      aUpdate :: Maybe View.Image -> IO ()
+      aUpdate Nothing = return ()
+      aUpdate (Just i) = do
+        writeIORef gR i
+        uReal g0 i
+        uImag g0 i
+        uSize g0 i
+        uRota g0 i
         upI
+
+      aReshape :: Int -> Int -> IO ()
       aReshape w' h' = do
         atomicModifyIORef gR $ \g ->
-          ( g { gWindow = (gWindow g){ width = w', height = h' }
-              , gViewport = (gViewport g){ aspect = fromIntegral w' / fromIntegral h' }
+          ( g { imageWindow = (imageWindow g){ width = w', height = h' }
+              , imageViewport = (imageViewport g){ aspect = fromIntegral w' / fromIntegral h' }
               }
           , () )
         g <- readIORef gR
         uEverything g0 g
---        upI
+        upI
+
   butI bHome aHome
   butI bLoad aLoad
   but  bSave aSave
   butO bStop (browserAbort browser)
-  butJ bAddressToCoordinates aAddressToCoordinates
-  butJ bPeriodScan           (aPeriodScan False)
-  butJ bPeriodScanPlus       (aPeriodScan True)
-  ent  eAddress              aAddress
+  butI bClear aClear
+
   entME eRealM eRealE aReal
   entME eImagM eImagE aImag
   entME eSizeM eSizeE aSize
@@ -279,100 +259,57 @@
   entI eWidth aWidth
   entI eHeight aHeight
   entI eSamples aSamples
-{-
-  entI' eWidth aWidth
-  entI' eHeight aHeight
-  entI' eSamples aSamples
--}
   colI cInterior cBorder cExterior aColours
   let aExit' = (exit (Log.log lg) stateFile =<< readIORef gR)
   browserSetExitCallback browser aExit'
-  browserSetMouseCallback browser aUpdate
+
+  progress <- progressNew icon
+  let mcbs = mouseCallbacks (readIORef labelColourR) progress aUpdate
+  browserSetMouseCallback browser mcbs
+
   browserSetReshapeCallback browser aReshape
   _ <- ww `onDestroy` aExit'
   g <- readIORef gR
   uEverything g0 g
   upI
-  refreshGUI g0 g
   widgetShowAll iw
   widgetShowAll ww
---  _ <- forkIO $ script browser
+  _ <- forkIO $ script browser
   mainGUI
 
-data Gruff = Gruff
-  { gAddress    :: Maybe AngledInternalAddress
-  , gIsland     :: Maybe AngledInternalAddress
-  , gChild      :: Maybe [Angle]
-  , gLowerAngle :: Maybe Angle
-  , gUpperAngle :: Maybe Angle
-  , gReal       :: Maybe R
-  , gImag       :: Maybe R
-  , gSize       :: Maybe Double
-  } | Gruff2
-  { gAddress    :: Maybe AngledInternalAddress
-  , gReal       :: Maybe R
-  , gImag       :: Maybe R
-  , gSize       :: Maybe Double
-  , gRota       :: Maybe Double
-  , gColours    :: (Color, Color, Color)
-  , gWindow     :: Window
-  , gViewport   :: Viewport
-  }
-  deriving (Read, Show)
-deriving instance Read Color
+type Gruff = View.Image
 
 initialGruff :: Gruff
-initialGruff = Gruff2
-  { gAddress    = parseAngledInternalAddress "1"
-  , gReal       = Just 0
-  , gImag       = Just 0
-  , gSize       = Just 2
-  , gRota       = Just 0
-  , gColours    = (red, black, white)
-  , gWindow     = defWindow
-  , gViewport   = defViewport
-  }
-
-refreshGUI :: GruffGUI -> Gruff -> IO ()
-refreshGUI g0 g = do
-  can bAddressToCoordinates $ j gAddress
-  can bPeriodScan           $ True
-  where
-    can w = widgetSetSensitive (w g0)
-    j a = isJust (a g)
+initialGruff = defImage
 
 -- button actions
 
 type A = GruffGUI -> Gruff -> IO Gruff
-type A' = GruffGUI -> Gruff -> (Gruff -> IO ()) -> IO ()
 
 wrapA :: GruffGUI -> IORef Gruff -> A -> IO ()
 wrapA g0 gR a = do
   g <- readIORef gR
   g' <- a g0 g
   writeIORef gR $! g'
-  refreshGUI g0 g'
 
-wrapA' :: GruffGUI -> IORef Gruff -> A' -> IO () -> IO ()
-wrapA' g0 gR a upI = do
-  g <- readIORef gR
-  a g0 g $ \g' -> postGUISync $ do
-    writeIORef gR $! g'
-    upI
-    refreshGUI g0 g'
-
 aHome :: A
 aHome g0 g = do
-  let g' = initialGruff{ gColours = gColours g, gWindow = gWindow g, gViewport = gViewport g }
+  let g' = g{ imageLocation = defLocation, imageViewport = (imageViewport g){ orient = 0 } }
   uEverything g0 g'
   return g'
 
+aClear :: A
+aClear g0 g = do
+  let g' = g{ imageLabels = [], imageLines = [] }
+  uEverything g0 g'
+  return g'
+
 aDoLoad :: FilePath -> IO (Maybe Gruff)
 aDoLoad ff = (do
     gr <- safeRead `fmap` readFile ff
-    return $ case gr of
-      Just (Gruff a _ _ _ _ b c d) -> Just (Gruff2 a b c d (Just 0) (red, black, white) defWindow defViewport)
-      g -> g
+    case gr of
+      g@(Just _) -> return g
+      _ -> putStrLn "file format not supported, sorry" >> return Nothing
   ) `catchIO` const (return Nothing)
 
 aLoad :: A
@@ -412,112 +349,23 @@
   widgetDestroy fc
   return g
 
-aPeriodScan :: Bool -> A'
-aPeriodScan plus g0 g gn = do
-  statusDialog (dStatus g0) "gruff status" $ \progress -> case liftM3 (,,) (gReal g) (gImag g) (gSize g) of
-    Nothing -> progress "nothing to do" >> gn g
-    Just (re, im, r) -> do
-      forM_ (muLocate (re:+im) r) $ \mp -> case mp of
-        MuScanTodo       -> progress "Scanning for period..."
-        MuScan           -> progress "Scanning for period..."
-        MuScanDone p     -> progress$"Scanning for period... " ++ show p
-        MuNucleusTodo'   -> progress "Computing nucleus..."
-        MuNucleus' i     -> when (i `mod` 20 == 0) . progress$"Computing nucleus... " ++ show i
-        MuNucleusDone' _ -> progress "Computing nucleus... done"
-        MuBondTodo'      -> progress "Computing bond..."
-        MuBond' i        -> when (i `mod` 20 == 0) . progress$"Computing bond... " ++ show i
-        MuBondDone' _    -> progress "Computing bond... done"
-        MuSuccess'' mu -> do
-          let g' = g{ gReal = Just . realPart . muNucleus $ mu
-                    , gImag = Just . imagPart . muNucleus $ mu
-                    , gSize = Just . (* 16) . muSize $ mu
-                    , gRota = Just . subtract (pi/2) . muOrient $ mu
-                    }
-          progress "Found!"
-          postGUISync $ do
-            uReal g0 g'
-            uImag g0 g'
-            uSize g0 g'
-            uRota g0 g'
-          if plus
-            then
-              forM_ (muToAddress mu) $ \mp' -> case mp' of
-                MuCuspTodo       -> progress "Computing cusp..."
-                MuCuspDone _     -> progress "Computing cusp... done"
-                MuDwellTodo      -> progress "Computing dwell..."
-                MuDwell i        -> when (i `mod` 100 == 0) . progress$"Computing dwell... " ++ show i
-                MuDwellDone _    -> progress "Computing dwell... done"
-                MuRayOutTodo     -> progress "Tracing rays..."
-                MuRayOut i       -> progress$"Tracing rays... " ++ show (round $ i * 100 :: Int) ++ "%"
-                MuRayOutDone _   -> progress "Tracing rays... done"
-                MuExternalTodo   -> progress "Computing angle..."
-                MuExternalDone _ -> progress "Computing angle... done"
-                MuAddressTodo    -> progress "Finding address..."
-                MuSuccess' a     -> do
-                  let g'' = g'{ gAddress = Just a }
-                  progress "Complete!"
-                  postGUISync $ do
-                    uAddress g0 g''
-                  gn g''
-                MuFailed'         -> progress "Failed!" >> gn g'
-            else
-              gn g'
-        MuFailed''       -> progress "Failed!" >> gn g
-
-aAddressToCoordinates :: A'
-aAddressToCoordinates g0 g gn = do
-  statusDialog (dStatus g0) "gruff status" $ \progress -> case gAddress g of
-    Nothing -> progress "nothing to do" >> gn g
-    Just addr -> do
-      forM_ (muFromAddress addr) $ \mp -> do
-        case mp of
-          MuSplitTodo      -> progress "Splitting address..."
-          MuSplitDone _ _  -> progress "Splitting address... done"
-          MuAnglesTodo     -> progress "Computing angles..."
-          MuAnglesDone _ _ -> progress "Computing angles... done"
-          MuRayTodo        -> progress "Tracing rays..."
-          MuRay n          -> when (n `mod` 20 == 0) . progress$"Tracing rays... " ++ show n
-          MuRayDone _      -> progress "Tracing rays... done"
-          MuNucleusTodo    -> progress "Computing nucleus..."
-          MuNucleus n      -> when (n `mod` 20 == 0) . progress$"Computing nucleus... " ++ show n
-          MuNucleusDone _  -> progress "Computing nucleus... done"
-          MuBondTodo       -> progress "Computing bond..."
-          MuBond n         -> when (n `mod` 20 == 0) . progress$"Computing bond... " ++ show n
-          MuBondDone _     -> progress "Computing bond... done"
-          MuSuccess mu     -> do
-            let g' = g{ gReal = Just . realPart . muNucleus $ mu
-                      , gImag = Just . imagPart . muNucleus $ mu
-                      , gSize = Just . (* 16) . muSize $ mu
-                      , gRota = Just . subtract (pi/2) . muOrient $ mu
-                      }
-            progress "Done!"
-            postGUISync $ do
-              uReal g0 g'
-              uImag g0 g'
-              uSize g0 g'
-              uRota g0 g'
-            gn g'
-          MuFailed         -> progress "Failed!" >> gn g
-
 -- entry update
 
 type U = GruffGUI -> Gruff -> IO ()
 
-uEverything, uAddress, uReal, uImag, uSize, uRota, uColours, uWidth, uHeight, uSamples :: U
-uEverything g0 g = forM_ [uAddress, uReal, uImag, uSize, uRota, uColours, uWidth, uHeight, uSamples] $ \u -> u g0 g
-uAddress g0 g = entrySetText (eAddress g0) (maybe "" prettyAngledInternalAddress (gAddress g))
-uReal g0 g = uMantissaExponent (eRealM g0) (eRealE g0) (maybe "" show (gReal g))
-uImag g0 g = uMantissaExponent (eImagM g0) (eImagE g0) (maybe "" show (gImag g))
-uSize g0 g = uMantissaExponent (eSizeM g0) (eSizeE g0) (maybe "" show (gSize g))
-uRota g0 g = entrySetText (eRota g0) (maybe "" show (gRota g))
+uEverything, uReal, uImag, uSize, uRota, uColours, uWidth, uHeight, uSamples :: U
+uEverything g0 g = forM_ [uReal, uImag, uSize, uRota, uColours, uWidth, uHeight, uSamples] $ \u -> u g0 g
+uReal g0 g = uMantissaExponent (eRealM g0) (eRealE g0) (show . (fromRational :: Rational -> R) . realPart . center . imageLocation $ g)
+uImag g0 g = uMantissaExponent (eImagM g0) (eImagE g0) (show . (fromRational :: Rational -> R) . imagPart . center . imageLocation $ g)
+uSize g0 g = uMantissaExponent (eSizeM g0) (eSizeE g0) (show . radius . imageLocation $ g)
+uRota g0 g = entrySetText (eRota g0) (show . orient . imageViewport $ g)
 uColours g0 g = do
-  let (ci, cb, ce) = gColours g
-  colorButtonSetColor (cInterior g0) ci
-  colorButtonSetColor (cBorder   g0) cb
-  colorButtonSetColor (cExterior g0) ce
-uWidth   g0 g = entrySetText (eWidth   g0) (show . width . gWindow $ g)
-uHeight  g0 g = entrySetText (eHeight  g0) (show . height . gWindow $ g)
-uSamples g0 g = entrySetText (eSamples g0) (show . supersamples . gWindow $ g)
+  colorButtonSetColor (cInterior g0) (fromColour . colourInterior . imageColours $ g)
+  colorButtonSetColor (cBorder   g0) (fromColour . colourBoundary . imageColours $ g)
+  colorButtonSetColor (cExterior g0) (fromColour . colourExterior . imageColours $ g)
+uWidth   g0 g = entrySetText (eWidth   g0) (show . width  . imageWindow $ g)
+uHeight  g0 g = entrySetText (eHeight  g0) (show . height . imageWindow $ g)
+uSamples g0 g = entrySetText (eSamples g0) (show . supersamples . imageWindow $ g)
 
 uMantissaExponent :: (EntryClass a, EntryClass b) => a -> b -> String -> IO ()
 uMantissaExponent m e s = do
@@ -530,130 +378,60 @@
 type E = Gruff -> String -> Gruff
 
 wrapE :: GruffGUI -> IORef Gruff -> E -> String -> IO ()
-wrapE g0 gR e s = do
+wrapE _g0 gR e s = do
   g <- readIORef gR
   let g' = e g s
   writeIORef gR $! g'
-  refreshGUI g0 g'
 
-aAddress, aReal, aImag, aSize, aRota, aWidth, aHeight, aSamples :: E
-aAddress g s = g{ gAddress = parseAngledInternalAddress s }
-aReal    g s = g{ gReal    = safeRead s }
-aImag    g s = g{ gImag    = safeRead s }
-aSize    g s = g{ gSize    = safeRead s }
-aRota    g s = g{ gRota    = safeRead s }
+aReal, aImag, aSize, aRota, aWidth, aHeight, aSamples :: E
+aReal    g s = let _ :+ i = center (imageLocation g) in case safeRead s :: Maybe R of
+  Nothing -> g
+  Just r -> g{ imageLocation = (imageLocation g){ center = toRational r :+ i } }
+aImag    g s = let r :+ _ = center (imageLocation g) in case safeRead s :: Maybe R of
+  Nothing -> g
+  Just i -> g{ imageLocation = (imageLocation g){ center = r :+ toRational i } }
+aSize    g s = case safeRead s :: Maybe Double of
+  Nothing -> g
+  Just r -> g{ imageLocation = (imageLocation g){ radius = r } }
+aRota    g s =  case safeRead s :: Maybe Double of
+  Nothing -> g
+  Just a -> g{ imageViewport = (imageViewport g){ orient = a } }
 aWidth   g s = case safeRead s of
   Nothing -> g
-  Just r -> g{ gWindow  = (gWindow g){ width = r } }
+  Just r -> (\g' -> g'{ imageViewport = (imageViewport g'){ aspect = (fromIntegral . width . imageWindow) g' / (fromIntegral . height . imageWindow) g' } }) (g{ imageWindow  = (imageWindow g){ width  = r } })
 aHeight  g s = case safeRead s of
   Nothing -> g
-  Just r -> g{ gWindow  = (gWindow g){ height = r } }
+  Just r -> (\g' -> g'{ imageViewport = (imageViewport g'){ aspect = (fromIntegral . width . imageWindow) g' / (fromIntegral . height . imageWindow) g' } }) (g{ imageWindow  = (imageWindow g){ height = r } })
 aSamples g s = case safeRead s of
   Nothing -> g
-  Just r -> g{ gWindow  = (gWindow g){ supersamples = r } }
+  Just r -> g{ imageWindow = (imageWindow g){ supersamples = r } }
 
 aColours :: Color -> Color -> Color -> IORef Gruff -> IO ()
-aColours i b e gR = atomicModifyIORef gR $ \g -> (g{ gColours = (i, b, e) }, ())
+aColours i b e gR = atomicModifyIORef gR $ \g -> (g{ imageColours = Colours{ colourInterior = fromColor i, colourBoundary = fromColor b, colourExterior = fromColor e} }, ())
 
 minSize :: Size
 minSize = Size 160 100
 
-red, black, white :: Color
+red, black, white, blue :: Color
 red = Color 65535 0 0
 black = Color 0 0 0
 white = Color 65535 65535 65535
+blue = Color 0 0 65535
 
 fromColor :: Color -> Colour
 fromColor (Color r g b) = Colour (fromIntegral r / 65535) (fromIntegral g / 65535) (fromIntegral b / 65535)
 
-{-
-strings :: [String]
-strings =  [ "1 1/3 " ++ (unwords . map show . scanl (+) 3) (replicate m 1 ++ replicate (n - m) 2) | m <- [0 .. n - 1] ]
-        ++ [ "1 1/3 " ++ (unwords . map show . scanl (+) 3) (replicate m 2 ++ replicate (n - m) 1) | m <- [0 .. n - 1] ]
-  where n = 21 -- 15
+fromColour :: Colour -> Color
+fromColour (Colour r g b) = Color (round $ r * 65535) (round $ g * 65535) (round $ b * 65535)
 
 script :: Browser -> IO ()
-script b = browserRenders b images'
-
-filename :: String -> Int -> String
-filename s n = (reverse . take 4 . (++ "0000") . reverse . show) n ++ "__" ++ map filechar s ++ ".ppm"
-  where filechar ' ' = '_'
-        filechar '/' = '-'
-        filechar  c  =  c
+script b = do
+  c <- getContents
+  case mapMaybe readMay (lines c) of
+    [] -> return ()
+    images@(_:_) -> browserRenders b images
 
-findMu :: AngledInternalAddress -> Maybe MuAtom
-findMu a = case last (muFromAddress a) of
-  MuSuccess m -> Just m
+readMay :: Read a => String -> Maybe a
+readMay s = case reads s of
+  [(a, "")] -> Just a
   _ -> Nothing
-
-scene :: (String, Int) -> Maybe (View.Image, String)
-scene (s, n) = do
-  a <- parseAngledInternalAddress s
-  m <- findMu a
-  let cx :+ cy = muNucleus m
-      f = filename s n
-      i = Image
-            { imageLocation = Location{ center = toRational cx :+ toRational cy, radius = muSize m * 8 } -- 6
-            , imageViewport = viewportDVD{ orient = muOrient m - pi / 2 }
-            , imageWindow = windowDVD
-            , imageColours = defColours
-            }
-  return (i, f)
-
-windowDVD :: View.Window
-windowDVD = Window{ width = 1080, height = 576, supersamples = 2 }
-
-viewportDVD :: View.Viewport
-viewportDVD = Viewport{ aspect = 1080/576, orient = 0 }
-
-images :: [(View.Image, String)]
-images = mapMaybe scene (score `zip` [0..])
-
-kick, snare :: Int -> [String]
-kick n = [ "1 2 " ++ (unwords . map show . take m . scanl (+) (3 :: Int) . repeat) 1 | m <- [n, n - 1 .. 1] ]
-snare n = [ "1 2 " ++ (unwords . map show . take (2 * m) . filter (\x -> x `mod` 3 /= 0)) [(3 :: Int) ..] | m <- [n, n - 1 .. 1] ]
-
-score :: [String]
-score = concat
-  [ kick 21
-  , snare 32
-  , kick 20
-  , snare 11
-  , kick 8
-  , kick 8
-  , kick 5
-  , snare 32
-  , kick 20
-  , snare 11
-  ]
-
-images' :: [(View.Image, String)]
-images' = {-drop 49 . -} map frame . take 1200 $ [0 ..]
-
-frame :: Int -> (View.Image, String)
-frame n = (img, (reverse . take 4 . (++ "0000") . reverse . show) n ++ ".ppm")
-  where
-    t = fromIntegral n / 25
-    r = 4 * 2 ** negate t
-    a = c0a * t / 48
-    img = Image
-      { imageLocation = Location{ center = c0x :+ c0y, radius = r }
-      , imageViewport = viewportHD{ orient = a }
-      , imageWindow = windowHD
-      , imageColours = defColours
-      }
-
-windowHD :: View.Window
-windowHD = Window{ width = 1920, height = 1080, supersamples = 5 }
-
-viewportHD :: View.Viewport
-viewportHD = Viewport{ aspect = 1920/1080, orient = 0 }
-
-c0x, c0y :: Rational
-c0x = -1.249654501250026535305564290406342641357245044812024384076696041016544263255410210573644817965421364058466642283047810126900443791060999959661828661014819271180654290498245641835647321878524004347784493127325654028742057010462138345395182421783064045422740334072967042829523926305969086019115635907387177
-c0y =  2.62964442060409470886060596680625049122647005543488791701840256388323764840498489578760240122036234473238581692886963706321452429283848754125169118310897168288049653283033547961422702057918968158064636527854942947851448063883186797623535011066501329732840334929404268157442692714476422929470502521447535e-2
-
-c0a :: Double
-c0a = -2.651738023427396
-
--}