diff --git a/demo/Demo01.hs b/demo/Demo01.hs
--- a/demo/Demo01.hs
+++ b/demo/Demo01.hs
@@ -4,46 +4,41 @@
 
 module Demo01 where
 
-import Wumpus.MicroPrint
+import Wumpus.Microprint.Datatypes
+import Wumpus.Microprint.Render
+import Wumpus.Microprint.Tokenizer
 
 import Wumpus.Core                              -- package: wumpus-core
 import Wumpus.Basic.Colour.SVGColours           -- package: wumpus-basic
+import Wumpus.Basic.Graphic
 
-import Data.Maybe
 import System.Directory
 
 main :: IO ()
 main = do 
-    { createDirectoryIfMissing True "./out/"
-    ; micro1 <- filePic
-    ; let pic1 = fromMaybe errK $ renderMicroPrint cfg1 (prefix micro1)
-    ; writeEPS_latin1 "./out/mp01.eps" pic1
-    ; writeSVG_latin1 "./out/mp01.svg" pic1
-    }
-  where
-    prefix mp = setRGB moccasin >> mp
+    createDirectoryIfMissing True "./out/"
+    inp <- readFile "Demo01.hs"	  -- This file
+    let gtext = runTokenizer (haskellTokenizer moccasin green) inp
+    let pic1  = makePicture gtext
+    writeEPS_latin1 "./out/microprint01.eps" pic1
+    writeSVG_latin1 "./out/microprint01.svg" pic1
+    let pic2  = makeBordered gtext
+    writeEPS_latin1 "./out/microprint02.eps" pic2
+    writeSVG_latin1 "./out/microprint02.svg" pic2
 
-errK :: a
-errK = error "no picture"
 
-filePic :: IO (MicroPrint ())
-filePic = do
-  xs <- readFile "Demo01.hs"
-  return $ foldr (\a acc -> drawChar a >> acc) (return ()) xs
-
-drawChar :: Char -> MicroPrint ()
-drawChar '\n' = linebreak
-drawChar '\t' = space >> space >> space >> space
-drawChar ' '  = space
-drawChar _    = char
-
+makePicture :: GreekText -> DPicture
+makePicture gtext = liftToPictureU $ execDrawing (standardContext 14) $ 
+    render sctx strokelineF gtext
+  where
+    sctx = makeRenderScaling (\x -> fromIntegral $ 2*x) 
+                             (\y -> fromIntegral $ 3*y)
 
-cfg1 :: MicroPrintConfig
-cfg1 = MicroPrintConfig 
-       { char_height    = 12.0
-       , char_width     = 8.0
-       , line_spacing   = 3.0
-       , drawWordF      = borderedF
-       }
+makeBordered :: GreekText -> DPicture
+makeBordered gtext = liftToPictureU $ execDrawing (standardContext 14) $ 
+    render sctx borderedF gtext
+  where
+    sctx = makeRenderScaling (\x -> fromIntegral $ 6*x) 
+                             (\y -> fromIntegral $ 8*y)
  
 
diff --git a/src/Wumpus/MicroPrint.hs b/src/Wumpus/MicroPrint.hs
deleted file mode 100644
--- a/src/Wumpus/MicroPrint.hs
+++ /dev/null
@@ -1,62 +0,0 @@
-{-# OPTIONS -Wall #-}
-
---------------------------------------------------------------------------------
--- |
--- Module      :  Wumpus.MicroPrint
--- Copyright   :  (c) Stephen Tetley 2010
--- License     :  BSD3
---
--- Maintainer  :  stephen.tetley@gmail.com
--- Stability   :  unstable
--- Portability :  GHC
---
--- MicroPrints
---
---------------------------------------------------------------------------------
-
-module Wumpus.MicroPrint
-  (
-
-  -- * Re-export all MicroPrint.Render        
-    module Wumpus.MicroPrint.Render
-
-  -- * Top level rendering functions
-  , renderMicroPrint
-  , renderMicroPrintU
-
-  -- * Re-export some from MicroPrint.DrawMonad
-  , MicroPrint
-  , Tile(..)
-  , Height
-  , linebreak
-  , setRGB
-  , char
-  , space
-
-  ) where
-
-
-import Wumpus.MicroPrint.DrawMonad
-import Wumpus.MicroPrint.Render
-
-import Wumpus.Core                              -- package: wumpus-core
-
-import Data.Maybe
-
-
--- | Build a picture from a MicroPrint.
---
--- This function returns Nothing if the picture is empty.
--- 
-renderMicroPrint :: MicroPrintConfig -> MicroPrint a -> Maybe DPicture
-renderMicroPrint cfg mf = drawMicroPrint cfg $ execMicroPrint mf
-
-
--- | Build a picture from a MicroPrint - /unsafe/ version.
---
--- This function throws a runtime error if the picture is empty.
--- 
-renderMicroPrintU :: MicroPrintConfig -> MicroPrint a -> DPicture
-renderMicroPrintU cfg mf = fromMaybe errK $ renderMicroPrint cfg mf
-  where
-    errK = error "renderMicroPrintU - empty picture."
diff --git a/src/Wumpus/MicroPrint/DrawMonad.hs b/src/Wumpus/MicroPrint/DrawMonad.hs
deleted file mode 100644
--- a/src/Wumpus/MicroPrint/DrawMonad.hs
+++ /dev/null
@@ -1,134 +0,0 @@
-{-# OPTIONS -Wall #-}
-
---------------------------------------------------------------------------------
--- |
--- Module      :  Wumpus.MicroPrint.DrawMonad
--- Copyright   :  (c) Stephen Tetley 2010
--- License     :  BSD3
---
--- Maintainer  :  stephen.tetley@gmail.com
--- Stability   :  unstable
--- Portability :  GHC
---
--- MicroPrints drawing monad - drawing here is analogous to a 
--- /teletype/ drawing characters, spaces and linebreaks one at a 
--- time.
---
---------------------------------------------------------------------------------
-
-module Wumpus.MicroPrint.DrawMonad
-  (
-
-    MicroPrint
-  , runMicroPrint
-  , execMicroPrint
-
-  , Tile(..)
-  , Height
-  , linebreak
-  , setRGB
-  , char
-  , space
-
-  ) where
-
-import Wumpus.Core
-import Wumpus.Core.Colour ( black )
-
-import Wumpus.Basic.Utils.HList
-
-import Control.Monad
-
-data Tile = LineBreak | Space Int | Word RGBi Int
-
--- Interim version without colour annotation...
-data TileState = Start | S0 Int | W0 Int
-
-
-
-type Text       = H Tile
-type Trace      = Text
-type Height     = Int
-type State      = (TileState, RGBi, Height)
-
--- | Build a /microprint/ within a monad...
---
--- Drawings are made in a /teletype/ fashion emitting a character,
--- space or line-break at each step.
---
-newtype MicroPrint a = MicroPrint { 
-          getMicroPrint :: Trace -> State -> (a,Trace,State) }
-
-instance Functor MicroPrint where
-  fmap f m = MicroPrint $ \w s -> 
-                let (a,w',s') = getMicroPrint m w s in (f a,w',s')
-
-instance Monad MicroPrint where
-  return a = MicroPrint $ \w s -> (a,w,s)
-  m >>= k  = MicroPrint $ \w s -> let (a,w',s') = getMicroPrint m w s 
-                                  in (getMicroPrint . k) a w' s'
-
-
-runMicroPrint :: MicroPrint a -> (a,[Tile],Height)
-runMicroPrint m = post $ getMicroPrint m emptyH (Start,black,1)
-  where
-    post (a,f,(W0 n, rgb, h)) = (a, toListH $ f `snocH` (Word rgb n), h)
-    post (a,f,(_, _, h))      = (a, f [], h)
-
-execMicroPrint :: MicroPrint a -> ([Tile],Height)
-execMicroPrint = post . runMicroPrint
-  where post (_,xs,h) = (xs,h)
-
-enqueueTile :: MicroPrint ()
-enqueueTile = MicroPrint $ \w (opt,rgb,h) -> 
-    let tileF = step rgb opt in ((), tileF w, (Start, rgb,h))
-  where
-    step _   Start  = id
-    step _   (S0 n) = (\f -> f `snocH` (Space n))
-    step rgb (W0 n) = (\f -> f `snocH` (Word rgb n))
-
-
--- | Emit a linebreak in the output.
---
-linebreak :: MicroPrint ()
-linebreak = enqueueTile >> next
-  where
-    next = MicroPrint $ 
-             \w (opt,rgb,h) -> ((),w `snocH` LineBreak, (opt,rgb,h+1))
-
-
--- | Change the current drawing colour.
---
--- Note - it is permissible to change colour mid-word, but this 
--- is the same as having a no-space break.
---
-setRGB :: RGBi -> MicroPrint ()
-setRGB rgb = enqueueTile >> next
-  where
-    -- tip will always be Start here...
-    next = MicroPrint $ \w (tip,_,h) -> ((),w,(tip,rgb,h))
-
-
--- | Draw a character - note in the microprint, characters will 
--- be concatenated together to make a word.
---
-char :: MicroPrint ()
-char = MicroPrint $ \w (tip,rgb,h) ->
-    let (f,tip') = addChar tip in ((),f w,(tip',rgb,h))
-  where
-    addChar Start  = (id, W0 1)
-    addChar (W0 n) = (id, W0 $ n+1)
-    addChar (S0 n) = (\f -> f `snocH` (Space n), W0 1)
-
--- | Draw a space.
---
-space :: MicroPrint ()
-space = MicroPrint $ \w (tip,rgb,h) ->
-    let (f,tip') = addSpace tip rgb in ((),f w,(tip',rgb,h))
-  where
-    addSpace Start  _   = (id, S0 1)
-    addSpace (W0 n) rgb = (\f -> f `snocH` (Word rgb n), S0 1)
-    addSpace (S0 n) _   = (id, S0 $ n+1)
-
- 
-
diff --git a/src/Wumpus/MicroPrint/Render.hs b/src/Wumpus/MicroPrint/Render.hs
deleted file mode 100644
--- a/src/Wumpus/MicroPrint/Render.hs
+++ /dev/null
@@ -1,175 +0,0 @@
-{-# LANGUAGE TypeFamilies               #-}
-{-# LANGUAGE MultiParamTypeClasses      #-}
-{-# LANGUAGE TypeSynonymInstances       #-}
-{-# OPTIONS -Wall #-}
-
---------------------------------------------------------------------------------
--- |
--- Module      :  Wumpus.MicroPrint.Render
--- Copyright   :  (c) Stephen Tetley 2010
--- License     :  BSD3
---
--- Maintainer  :  stephen.tetley@gmail.com
--- Stability   :  unstable
--- Portability :  GHC
---
--- Render
---
---------------------------------------------------------------------------------
-
-module Wumpus.MicroPrint.Render
-  (
-
-    DrawWordF  
-  , MicroPrintConfig(..)
-  , greekF
-  , borderedF
-
-  , drawMicroPrint
-
-  ) where
-
-import Wumpus.Core
-import Wumpus.Basic.Graphic
-import Wumpus.Basic.Monads.TurtleMonad
-
-import Wumpus.MicroPrint.DrawMonad ( Tile(..), Height ) 
-
-import Data.AffineSpace                 -- package: vector-space
-
-import Control.Applicative
-import Control.Monad
-import Data.List
-
-
--- | 'DrawWordF' :
--- @ (num_chars, char_unit_width) * (full_width, full_height) -> rgb -> DGraphicF @
---
--- The libraries currently provides two styles - 'greekF' and
--- 'borderedF'.
---
-type DrawWordF = (Int,Double) -> (Double,Double) -> RGBi -> DLocGraphic
-
-
--- | Style properties for micro-print drawing.
---
-data MicroPrintConfig = MicroPrintConfig 
-       { char_height    :: Double
-       , char_width     :: Double
-       , line_spacing   :: Double 
-       , drawWordF      :: DrawWordF
-       }
-
--- | Draw the word as a single coloured rectangle.
---
-greekF :: DrawWordF
-greekF _ (w,h) rgb = 
-    localLG (secondaryColour rgb) (filledRectangle w h) 
-
-
--- | Draw the word as a coloured rectangle, with a border grid.
---
-borderedF :: DrawWordF
-borderedF (i,uw) (w,h) rgb = concatAt srect seps
-  where
-    srect :: DLocGraphic
-    srect = localLG (secondaryColour rgb) (borderedRectangle w h)
-
-    seps  :: [DLocGraphic]
-    seps  = unfoldr phi (1,uw) 
-    
-    phi (n,hshift) | n >= i    = Nothing
-                   | otherwise = let fn = \pt -> vline h (pt .+^ hvec hshift)
-                                 in  Just (fn,(n+1,hshift+uw))
-
-
--- At some point this needs a rethink...
---
-concatAt :: DLocGraphic -> [DLocGraphic] -> DLocGraphic 
-concatAt x [] = x
-concatAt x xs = foldl' lgappend x xs
-
-vline :: (Num u, Ord u) => u -> LocGraphic u
-vline h = \pt -> openStroke $ path pt [lineTo $ pt .+^ vvec h]
-    
-
-newtype RenderMonad a = RM { 
-          getRM :: MicroPrintConfig -> TurtleDrawing Double a }
-
-
-type instance MonUnit RenderMonad = Double
-
-instance Functor RenderMonad where
-  fmap f ma = RM $ \cfg -> fmap f $ getRM ma cfg
-
-instance Monad RenderMonad where
-  return a = RM $ \_   -> return a
-  m >>= k  = RM $ \cfg -> getRM m cfg >>= \a -> (getRM . k) a cfg
-
-instance Applicative RenderMonad where
-  pure  = return
-  (<*>) = ap
-
-instance TraceM RenderMonad where
-  trace  h = RM $ \_ -> trace h
-
-instance DrawingCtxM RenderMonad where
-  askCtx          = RM $ \ _ -> askCtx
-  localCtx ctx ma = RM $ \cfg -> localCtx ctx (getRM ma cfg)
-
-ask :: RenderMonad MicroPrintConfig
-ask = RM $ \cfg -> return cfg
-
-asks :: (MicroPrintConfig -> a) -> RenderMonad a
-asks f = f <$> ask
-
-instance TurtleM RenderMonad where
-  getLoc        = RM $ \_ -> getLoc
-  setLoc c      = RM $ \_ -> setLoc c
-  getOrigin     = RM $ \_ -> getOrigin
-  setOrigin o   = RM $ \_ -> setOrigin o
-
-
-drawMicroPrint :: MicroPrintConfig -> ([Tile],Height) -> Maybe DPicture
-drawMicroPrint cfg (xs,h) = 
-    let (_,hf) = runRender cfg (moveUpN h >> interpret xs) in liftToPictureMb hf
-
-runRender :: MicroPrintConfig -> RenderMonad a -> (a, HPrim Double)
-runRender cfg m = 
-    runTurtleDrawing (regularConfig 1) (0,0) (standardContext 14) 
-         $ (getRM m) cfg
-
-interpret :: [Tile] -> RenderMonad ()
-interpret = mapM_ interp1
-
-interp1 :: Tile -> RenderMonad ()
-interp1 LineBreak     = nextLine
-interp1 (Space    i)  = moveRightN i
-interp1 (Word rgb i)  = do
-    w  <- scaleWidth i 
-    h  <- asks char_height
-    uw <- asks char_width
-    pt <- scaleCurrentCoord
-    dF <- asks drawWordF
-    draw $ (dF (i,uw) (w,h) rgb) `at` pt
-    moveRightN i
-   
-moveRightN   :: Int -> RenderMonad ()
-moveRightN i = setsLoc_ $ \(x,y) -> (x+i,y)
-
-moveUpN      :: Int -> RenderMonad ()
-moveUpN i    = setsLoc_ $ \(x,y) -> (x,y+i)
-
-scaleCurrentCoord :: RenderMonad DPoint2
-scaleCurrentCoord = 
-    fn <$> getLoc <*> asks char_width <*> asks char_height <*> asks line_spacing
-  where
-    fn (x,y) cw ch sp = P2 (cw * fromIntegral x) ((ch+sp) * fromIntegral y)
-
-scaleWidth :: Int -> RenderMonad Double
-scaleWidth i = (\cw -> cw * fromIntegral i) <$> asks char_width
-
-
---------------------------------------------------------------------------------
-
-
diff --git a/src/Wumpus/MicroPrint/VersionNumber.hs b/src/Wumpus/MicroPrint/VersionNumber.hs
deleted file mode 100644
--- a/src/Wumpus/MicroPrint/VersionNumber.hs
+++ /dev/null
@@ -1,28 +0,0 @@
-{-# OPTIONS -Wall #-}
-
---------------------------------------------------------------------------------
--- |
--- Module      :  Wumpus.MicroPrint.VersionNumber
--- Copyright   :  (c) Stephen Tetley 2010
--- License     :  BSD3
---
--- Maintainer  :  stephen.tetley@gmail.com
--- Stability   :  unstable
--- Portability :  GHC
---
--- Version number
---
---------------------------------------------------------------------------------
-
-module Wumpus.MicroPrint.VersionNumber
-  ( 
-    wumpus_microprint_version
-
-  ) where
-
--- | Version number
---
--- > (0,8,0)
---
-wumpus_microprint_version :: (Int,Int,Int)
-wumpus_microprint_version = (0,8,0)
diff --git a/src/Wumpus/Microprint.hs b/src/Wumpus/Microprint.hs
new file mode 100644
--- /dev/null
+++ b/src/Wumpus/Microprint.hs
@@ -0,0 +1,71 @@
+{-# OPTIONS -Wall #-}
+
+--------------------------------------------------------------------------------
+-- |
+-- Module      :  Wumpus.Microprint
+-- Copyright   :  (c) Stephen Tetley 2010
+-- License     :  BSD3
+--
+-- Maintainer  :  stephen.tetley@gmail.com
+-- Stability   :  unstable
+-- Portability :  GHC
+--
+-- MicroPrints
+--
+-- \*\* WARNING \*\* - This module is out-of-date and is due a 
+-- rethink. Teletype is no longer the recommended drawing style.
+--
+--------------------------------------------------------------------------------
+
+module Wumpus.Microprint
+  (
+
+  -- * Re-export all Microprint.Render        
+    module Wumpus.Microprint.Render
+
+  -- * Top level rendering functions
+  , renderTeletype
+  , renderTeletypeU
+
+  -- * Re-export some from MicroPrint.DrawMonad
+  , Teletype
+  , Tile(..)
+  , Height
+  , linebreak
+  , setRGB
+  , char
+  , space
+
+  ) where
+
+
+import Wumpus.Microprint.Teletype
+import Wumpus.Microprint.Render
+
+import Wumpus.Core                              -- package: wumpus-core
+import Wumpus.Basic.Graphic			-- package: wumpus-basic
+
+import Data.Maybe
+
+
+
+-- | Build a picture from a Teletype drawing.
+--
+-- This function returns Nothing if the picture is empty.
+-- 
+renderTeletype :: RenderScalingCtx -> DrawWordF -> Teletype a -> Maybe DPicture
+renderTeletype ctx fn mf = 
+    liftToPictureMb $ execDrawing (standardContext 14) 
+                    $ render ctx fn $ execTeletype mf
+
+
+-- | Build a picture from a Teletype - /unsafe/ version.
+--
+-- This function throws a runtime error if the picture is empty.
+-- 
+renderTeletypeU :: RenderScalingCtx -> DrawWordF -> Teletype a -> DPicture
+renderTeletypeU ctx fn mf = fromMaybe errK $ renderTeletype ctx fn mf
+  where
+    errK = error "renderTeletypeU - empty picture."
+
+ 
diff --git a/src/Wumpus/Microprint/Datatypes.hs b/src/Wumpus/Microprint/Datatypes.hs
new file mode 100644
--- /dev/null
+++ b/src/Wumpus/Microprint/Datatypes.hs
@@ -0,0 +1,49 @@
+{-# OPTIONS -Wall #-}
+
+--------------------------------------------------------------------------------
+-- |
+-- Module      :  Wumpus.Microprint.Datatypes
+-- Copyright   :  (c) Stephen Tetley 2010
+-- License     :  BSD3
+--
+-- Maintainer  :  stephen.tetley@gmail.com
+-- Stability   :  unstable
+-- Portability :  GHC
+--
+-- Base datatypes.
+--
+--------------------------------------------------------------------------------
+
+module Wumpus.Microprint.Datatypes
+  (
+
+  -- * Datatypes  
+ 
+    Tile(..)
+  , Height
+  , GreekText
+
+  ) where
+
+import Wumpus.Core
+
+
+
+
+data Tile = Space Int | Word RGBi Int
+  deriving (Eq,Ord,Show)
+
+type Height = Int
+
+
+-- Note probably better if used a list of lines instead
+--
+-- > [[Title]] 
+--
+-- and did not have line break in the Tile datatype.
+--
+type GreekText = (Height,[[Tile]])
+
+
+ 
+
diff --git a/src/Wumpus/Microprint/Render.hs b/src/Wumpus/Microprint/Render.hs
new file mode 100644
--- /dev/null
+++ b/src/Wumpus/Microprint/Render.hs
@@ -0,0 +1,99 @@
+{-# OPTIONS -Wall #-}
+
+--------------------------------------------------------------------------------
+-- |
+-- Module      :  Wumpus.Microprint.Render
+-- Copyright   :  (c) Stephen Tetley 2010
+-- License     :  BSD3
+--
+-- Maintainer  :  stephen.tetley@gmail.com
+-- Stability   :  unstable
+-- Portability :  GHC
+--
+-- Render
+--
+--------------------------------------------------------------------------------
+
+module Wumpus.Microprint.Render
+  (
+    RenderScalingCtx
+  , makeRenderScaling
+  , DrawWordF  
+  , greekF
+  , strokelineF
+  , borderedF
+
+  , render
+
+  ) where
+
+import Wumpus.Basic.Graphic.ScalingContext
+
+import Wumpus.Microprint.Datatypes 
+
+import Wumpus.Core		     	        -- package: wumpus-core
+import Wumpus.Basic.Graphic			-- package: wumpus-basic
+
+import Data.AffineSpace				-- package: vector-space
+
+import Data.Monoid
+
+--------------------------------------------------------------------------------
+
+type RenderScalingCtx = ScalingContext Int Int Double
+type RenderScalingT m a = ScalingT Int Int Double m a
+
+makeRenderScaling :: (Int -> Double) -> (Int -> Double) -> ScalingContext Int Int Double
+makeRenderScaling fx fy = 
+    ScalingContext { scale_in_x = fx, scale_in_y = fy }
+
+
+-- | 'DrawWordF' :
+--
+-- > colour * scaled_width * scaled_height -> char_count -> DLocGraphic
+--
+type DrawWordF = RGBi -> Double -> Double -> Int -> DLocGraphic
+
+
+-- | Just a filled rectangle.
+--
+greekF :: DrawWordF
+greekF rgb w h _ = localLG (secondaryColour rgb) (filledRectangle w h)
+
+
+borderedF :: DrawWordF
+borderedF rgb w h i = background `lgappend` ticks
+  where
+    background  = localLG (secondaryColour rgb) (borderedRectangle w h)
+    v1          = hvec $ w / fromIntegral i
+    ticks pt    = mconcat $ map (straightLine (vvec h)) 
+    	                  $ take (i-1) $ iterate (.+^ v1) (pt .+^ v1)
+
+ 
+-- | A stroked line.
+--
+strokelineF :: DrawWordF
+strokelineF rgb w _ _ = localLG (primaryColour rgb) (straightLine (hvec w))
+
+
+render :: RenderScalingCtx -> DrawWordF -> GreekText -> Drawing Double ()
+render ctx wordDraw (hmax,xs) = 
+    runScalingT ctx $ mstep hmax xs
+  where
+    mstep h (s:ss) = renderLine wordDraw h s >> mstep (h-1) ss 
+    mstep _ _      = return ()
+
+renderLine :: DrawWordF -> Int -> [Tile] 
+	   -> RenderScalingT (Drawing Double) ()
+renderLine fn h ts = mstep 0 ts
+  where
+    mstep x (Word rgb n:xs) = draw1 fn rgb n (x,h) >> mstep (x+n) xs
+    mstep x (Space n:xs)    = mstep (x+n) xs  
+    mstep _ []              = return ()
+
+draw1 :: DrawWordF -> RGBi -> Int -> (Int,Int) 
+      -> RenderScalingT (Drawing Double) () 
+draw1 fn rgb n (x,y)  = 
+    scalePt x y >>= \pt -> scaleX n >>= \w -> unitY >>= \h ->  
+    draw $ fn rgb w h n `at` pt
+
diff --git a/src/Wumpus/Microprint/Teletype.hs b/src/Wumpus/Microprint/Teletype.hs
new file mode 100644
--- /dev/null
+++ b/src/Wumpus/Microprint/Teletype.hs
@@ -0,0 +1,139 @@
+{-# OPTIONS -Wall #-}
+
+--------------------------------------------------------------------------------
+-- |
+-- Module      :  Wumpus.Microprint.Teletype
+-- Copyright   :  (c) Stephen Tetley 2010
+-- License     :  BSD3
+--
+-- Maintainer  :  stephen.tetley@gmail.com
+-- Stability   :  unstable
+-- Portability :  GHC
+--
+-- A drawing monad where drawing is analogous to a /teletype/ 
+-- printing characters, spaces and linebreaks one at a time.
+--
+--------------------------------------------------------------------------------
+
+module Wumpus.Microprint.Teletype
+  (
+
+    Teletype
+  , runTeletype
+  , execTeletype
+
+  , Tile(..)
+  , Height
+  , linebreak
+  , setRGB
+  , char
+  , space
+
+  ) where
+
+import Wumpus.Microprint.Datatypes
+
+import Wumpus.Core				-- package: wumpus-core
+import Wumpus.Core.Colour ( black )
+
+import Wumpus.Basic.Utils.HList			-- package: wumpus-basic
+
+import Control.Applicative
+import Control.Monad
+
+
+-- Interim version without colour annotation...
+--
+-- Note could start with Space S0 - as spaces aren\'t printed (S0 0) is not a problem 
+-- 
+data TileTip = Sp Int | Wo Int
+  deriving (Eq,Show)
+
+
+type Trace      = (H [Tile], H Tile)
+type State      = (RGBi, Height, TileTip)
+
+-- | Build a /microprint/ within a monad...
+--
+-- Drawings are made in a /teletype/ fashion emitting a character,
+-- space or lineMicroprint-break at each step.
+--
+newtype Teletype a = Teletype { 
+          getTeletype :: Trace -> State -> (a,Trace,State) }
+
+instance Functor Teletype where
+  fmap f m = Teletype $ \w s -> 
+                let (a,w',s') = getTeletype m w s in (f a,w',s')
+
+instance Applicative Teletype where
+  pure a    = Teletype $ \w s -> (a,w,s)
+  mf <*> ma = Teletype $ \w s -> let (f,w1,s1) = getTeletype mf w  s
+     	      	       	      	     (a,w2,s2) = getTeletype ma w1 s1
+				  in (f a,w2,s2)
+
+instance Monad Teletype where
+  return a = Teletype $ \w s -> (a,w,s)
+  m >>= k  = Teletype $ \w s -> let (a,w1,s1) = getTeletype m w s 
+                                 in (getTeletype . k) a w1 s1
+
+
+runTeletype :: Teletype a -> (a,GreekText)
+runTeletype m = post $ getTeletype m (emptyH,emptyH) (black,1,Sp 0)
+  where
+    post (a, (u,v), (rgb,h,tip)) = let v1 = snocTip v rgb tip
+                                   in (a,(h,finalizeTrace (u,v1)))
+
+
+finalizeTrace :: Trace -> [[Tile]]
+finalizeTrace (a,b) = toListH $ a `snocH` (toListH b)	
+
+execTeletype :: Teletype a -> GreekText
+execTeletype = snd . runTeletype
+
+
+snocTip :: H Tile -> RGBi -> TileTip -> H Tile
+snocTip a _   (Sp n)  | n > 0 = a `snocH` (Space n)
+snocTip a rgb (Wo n)  | n > 0 = a `snocH` (Word rgb n)
+snocTip a _   _               = a 
+
+
+
+-- | Emit a linebreak in the output.
+--
+linebreak :: Teletype ()
+linebreak = Teletype $ \(a,b) (rgb, h, tip) -> 
+    let b1 = snocTip b rgb tip 
+        ac = (a `snocH` toListH b1, emptyH)
+    in ((), ac, (rgb, h+1, Sp 0))
+
+
+-- | Change the current drawing colour.
+--
+-- Note - it is permissible to change colour mid-word, but this 
+-- is the same as having a no-space break and forms a new word.
+--
+setRGB :: RGBi -> Teletype ()
+setRGB rgb = Teletype $ \(a,b) (old,h,tip) -> 
+    ((), (a, snocTip b old tip), (rgb,h,Sp 0))
+
+
+-- | Draw a character - note in the microprint, characters will 
+-- be concatenated together to make a word.
+--
+char :: Teletype ()
+char = Teletype $ \(a,b) (rgb,h,tip) ->
+    case tip of 
+      Sp _ -> ((), (a, snocTip b rgb tip), (rgb,h,Wo 1))
+      Wo n -> ((), (a,b), (rgb,h,Wo $ n+1))
+  
+
+-- | Draw a space.
+--
+space :: Teletype ()
+space = Teletype $ \(a,b) (rgb,h,tip) ->
+    case tip of
+      Sp n -> ((), (a,b), (rgb,h,Sp $ n+1))
+      Wo _ -> ((), (a, snocTip b rgb tip), (rgb,h,Sp 1))
+
+ 
+
diff --git a/src/Wumpus/Microprint/Tokenizer.hs b/src/Wumpus/Microprint/Tokenizer.hs
new file mode 100644
--- /dev/null
+++ b/src/Wumpus/Microprint/Tokenizer.hs
@@ -0,0 +1,155 @@
+{-# OPTIONS -Wall #-}
+
+--------------------------------------------------------------------------------
+-- |
+-- Module      :  Wumpus.Microprint.Tokenizer
+-- Copyright   :  (c) Stephen Tetley 2010
+-- License     :  BSD3
+--
+-- Maintainer  :  stephen.tetley@gmail.com
+-- Stability   :  unstable
+-- Portability :  GHC
+--
+-- Simple tokenizing builder.
+--
+--------------------------------------------------------------------------------
+
+module Wumpus.Microprint.Tokenizer
+  ( 
+    TokenizerConfig(..)
+  , haskellTokenizer
+  , runTokenizer 
+
+  ) where
+
+
+import Wumpus.Microprint.Datatypes
+
+import Wumpus.Basic.Utils.HList			-- package: wumpus-basic
+import Wumpus.Core				-- package: wumpus-core
+
+import Control.Applicative
+import Control.Monad
+import Data.Char ( isSpace )
+import Data.List
+
+data TokenizerConfig = TokenizerConfig
+      { standard_colour		:: RGBi
+      , sgl_comment_start 	:: String   -- note - can be a prefix of a word 
+      , comment_start	  	:: String
+      , comment_end		:: String
+      , comment_colour		:: RGBi
+      }
+
+
+haskellTokenizer :: RGBi -> RGBi -> TokenizerConfig
+haskellTokenizer std_rgb comment_rgb = TokenizerConfig 
+      { standard_colour		= std_rgb
+      , sgl_comment_start 	= "--"  
+      , comment_start	  	= "{-"
+      , comment_end		= "-}"
+      , comment_colour		= comment_rgb
+      }
+ 
+
+data TokState = CommentML | CommentSL | Normal
+  deriving (Eq,Ord,Show)
+
+data St = St TokState (H Tile)
+
+newtype Lexer a  = Lexer { getLexer :: TokenizerConfig -> St -> (a,St) }
+
+instance Functor Lexer where
+  fmap f m = Lexer $ \r s -> let (a,s1) = getLexer m r s in (f a, s1)
+
+instance Applicative Lexer where
+  pure a    = Lexer $ \_ s -> (a,s)
+  mf <*> ma = Lexer $ \r s -> let (f,s1) = getLexer mf r s 
+     	      	      	    	  (a,s2) = getLexer ma r s1
+			      in (f a, s2)
+
+instance Monad Lexer where
+  return a = Lexer $ \_ s -> (a,s)
+  m >>= k  = Lexer $ \r s -> let (a,s1) = getLexer m r s
+    	     	     	      in (getLexer . k) a r s1
+
+
+tellSpaces :: Int -> Lexer ()
+tellSpaces i = Lexer $ \_ (St ts ac) -> 
+    let ac1 = snocH ac (Space i) in ((), St ts ac1) 
+
+
+tellChars :: Int -> RGBi -> Lexer ()
+tellChars i rgb = Lexer $ \_ (St ts ac) -> 
+    let ac1 = snocH ac (Word rgb i) in ((), St ts ac1)
+
+askColour :: Lexer RGBi
+askColour = Lexer $ \r s@(St ts _) -> 
+    case ts of
+      Normal -> (standard_colour r, s)
+      _      -> (comment_colour r,  s)
+
+
+asksTC :: (TokenizerConfig -> a) -> Lexer a
+asksTC fn = Lexer $ \r s -> (fn r, s) 
+
+setTokState :: TokState -> Lexer ()
+setTokState st = Lexer $ \_ (St _ ac) -> ((),St st ac)  
+
+getTokState :: Lexer TokState 
+getTokState = Lexer $ \_ s@(St st _) -> (st,s)
+
+runTokenizer :: TokenizerConfig -> String -> GreekText
+runTokenizer cfg input = step Normal $ lines input
+  where
+    step _  []      = (0,[])
+    step st (s:ss)  = let (st1,l1) = lexLine cfg st s
+    	 	   	  (h,rest) = step st1 ss
+                      in (h+1,l1:rest) 
+
+lexLine :: TokenizerConfig -> TokState -> String -> (TokState,[Tile])
+lexLine cfg st ss = 
+    let (_,St st1 hf) = runLexer cfg st ss in (st1, toListH hf) 
+  
+
+runLexer :: TokenizerConfig -> TokState -> String -> ((),St)
+runLexer cfg ts ss = getLexer (lexer ss) cfg (St (normalize ts) emptyH) 
+  where
+    normalize CommentSL = Normal
+    normalize a         = a
+
+lexer :: String -> Lexer ()
+lexer (' ':xs)      = spaces 1 xs
+lexer ('\t':xs)     = spaces 8 xs
+lexer xs            = word xs
+
+
+spaces :: Int -> String -> Lexer ()
+spaces n (' ':xs)   = spaces (n+1) xs
+spaces n ('\t':xs)  = spaces (n+8) xs
+spaces n xs         = tellSpaces n >> word xs
+
+word :: String -> Lexer ()
+word []	= return ()
+word xs	= let (pre,rest) = break isSpace xs in do
+    st <- getTokState
+    when (st==Normal)  (testPrefix pre)
+    rgb <- askColour
+    tellChars (length pre) rgb
+    when (st==CommentML) (testSuffix pre)
+    spaces 0 rest
+
+testPrefix :: String -> Lexer ()
+testPrefix ss = 
+    asksTC sgl_comment_start >>= \a -> 
+    if isPrefixOf a ss then setTokState CommentSL
+      else asksTC comment_start >>= \b ->
+           if isPrefixOf b ss then setTokState CommentML
+	      		      else return ()
+
+testSuffix :: String -> Lexer ()
+testSuffix ss = 
+    asksTC comment_end >>= \a ->
+    if isSuffixOf a ss then setTokState Normal
+                       else return ()
+      
diff --git a/src/Wumpus/Microprint/VersionNumber.hs b/src/Wumpus/Microprint/VersionNumber.hs
new file mode 100644
--- /dev/null
+++ b/src/Wumpus/Microprint/VersionNumber.hs
@@ -0,0 +1,28 @@
+{-# OPTIONS -Wall #-}
+
+--------------------------------------------------------------------------------
+-- |
+-- Module      :  Wumpus.Microprint.VersionNumber
+-- Copyright   :  (c) Stephen Tetley 2010
+-- License     :  BSD3
+--
+-- Maintainer  :  stephen.tetley@gmail.com
+-- Stability   :  unstable
+-- Portability :  GHC
+--
+-- Version number
+--
+--------------------------------------------------------------------------------
+
+module Wumpus.Microprint.VersionNumber
+  ( 
+    wumpus_microprint_version
+
+  ) where
+
+-- | Version number
+--
+-- > (0,9,0)
+--
+wumpus_microprint_version :: (Int,Int,Int)
+wumpus_microprint_version = (0,9,0)
diff --git a/wumpus-microprint.cabal b/wumpus-microprint.cabal
--- a/wumpus-microprint.cabal
+++ b/wumpus-microprint.cabal
@@ -1,5 +1,5 @@
 name:             wumpus-microprint
-version:          0.8.0
+version:          0.9.0
 license:          BSD3
 license-file:     LICENSE
 copyright:        Stephen Tetley <stephen.tetley@gmail.com>
@@ -12,19 +12,26 @@
   A library to produce /microprints/ [1] sometimes known as 
   \"greek-text\". 
   .
-  Note this library only provides the graphically half of the 
-  functionality needed to make microprints. There is no support 
-  for tokenizing input files, and at the moment it is really 
-  just a test bed for Wumpus.
+  A rudimentary tokenizer is provided, but it is largely 
+  untested. 
   .
-  Currently pictures are made within a monad providing /teletype/ 
-  style operations. Other methods of drawing are possible, but 
-  are yet to be implemented.
+  Version 0.9.0 adds some new functionality, but the API is
+  undercooked and is unsuitable for real use. The API will improve 
+  as Wumpus-Basic improves...
   .
+  .
   \[1\] <http://scg.unibe.ch/archive/papers/Robb05b-microprintsESUG.pdf>
   .
   Changelog:
   .
+  0.8.0 to 0.9.0:
+  .
+  * Made internal modules visible rather than hidden and changed 
+    the module path to be @Wumpus.Microprint@ (lower-case p) 
+    rather then @Wumpus.MicroPrint@ (upper-case P).
+  .
+  * Added a more efficient builder than the Teletype.
+  .
   0.7.0 to 0.8.0:
   .
   * Internal changes to work with latest @Wumpus-Basic@.
@@ -43,17 +50,19 @@
   hs-source-dirs:     src
   build-depends:      base              <  5, 
                       vector-space      >= 0.6,
-                      wumpus-core       == 0.33.0,
-                      wumpus-basic      == 0.8.0
+                      wumpus-core       == 0.34.0,
+                      wumpus-basic      == 0.9.0
 
   
   exposed-modules:
-    Wumpus.MicroPrint,
-    Wumpus.MicroPrint.VersionNumber
+    Wumpus.Microprint,
+    Wumpus.Microprint.Datatypes,
+    Wumpus.Microprint.Teletype,
+    Wumpus.Microprint.Render,
+    Wumpus.Microprint.Tokenizer,
+    Wumpus.Microprint.VersionNumber
 
   other-modules:
-    Wumpus.MicroPrint.DrawMonad,
-    Wumpus.MicroPrint.Render
 
   extensions: