diff --git a/Main.hs b/Main.hs
deleted file mode 100644
--- a/Main.hs
+++ /dev/null
@@ -1,171 +0,0 @@
-import Text.ParserCombinators.Parsec
--- import Text.PrettyPrint.HughesPJ hiding (char)
--- import qualified Text.PrettyPrint.HughesPJ as O
-
-
-import Data.Char
-import Control.Applicative hiding (many, (<|>))
-import Data.List
-import System.IO
-import System.Environment
-import Control.Monad
-
--- todo: parse strings inside haskell code
--- todo: output line directives.
-
-instance Applicative (GenParser Char st) where
-    (<*>) = ap
-    pure = return
-
-----------
-    
-type Doc = String -> String
-(<>) = (.)
-text s = (s ++)
-x <+> y =  x <> text " " <> y 
-oChar c = (c:)
-parens s = oChar '(' <> s <> oChar ')'
-braces s = oChar '{' <> s <> oChar '}'
-brackets s = oChar '[' <> s <> oChar ']'
-doubleQuotes s = oChar '"' <> s <> oChar '"'
-
-oEmpty = id
-int x = text $ show x
-hcat :: [Doc] -> Doc
-hcat = foldr (<>) oEmpty
-punctuate t = map (<> t)
-render x = x ""
-
-------------------------------------------
--- Output combinators
-    
-oPos :: SourcePos -> Doc
-oPos p = text "{-# LINE" <+> int (sourceLine p) <+> text (show (sourceName p)) <+> text "#-}"
-    
-oText :: String -> Doc
-oText x = text "textual" <+> text (show x)
-
-oMappend :: [Doc] -> Doc
-oMappend [] = text "(return ())"
-oMappend [x] = parens x
-oMappend l = text "do" <+> braces (text "rec" <+> braces (hcat (punctuate (text ";") binds)) <> text ";" <> ret)
-  where binds = init l
-        ret = last l
-             
-
-oBraces :: Doc -> Doc
-oBraces x = oText "{" <> text "*>" <> x <> text "<*" <>  oText "}"
-
-
-----------------------------------------------
--- Parsing combinators
-pChunk :: String -> Parser String
-pChunk stops = many1 (noneOf stops)
-
-pWPos :: Parser Doc 
-pWPos = do 
-  char '\n'
-  pos <- getPosition
-  return $ oPos pos <> text "\n"
-
-pTextChunk = (oText <$> pChunk "\n{}@")
-
-pHaskChunk = (text <$> many1 (noneOf "\n\"{}[]()@" <|> try (char '@' <* notFollowedBy (oneOf "[({\""))))
-
-pHaskLn = pWPos -- before each newline, tell GHC where we are.
-
-pTextLn = do
-    (oText "\n" <>) <$> pWPos 
-  -- add code to output a newline; and insert a newline in the code.
-  
-
-pQuote = do
-  try (string "@\"")
-  d <- pInText (string "@\"")
-  return $ parens d
-
-box x = [x]
-
-pString = do
-  char '"'
-  result <- many (string "\\\"" <|> pChunk ['"'])
-  char '"'
-  return $ doubleQuotes . hcat . map text $ result
-
--- | Parse some Haskell code with markup inside. 
-pHask = hcat <$> many ((brackets <$> pArg "[]") <|> 
-                       (braces   <$> pArg "{}") <|>
-                       (parens   <$> pArg "()") <|> pQuote <|> pString <|> pHaskChunk <|> pHaskLn)
-
--- | Parse a text argument to an element
-pTextArg :: Parser Doc
-pTextArg = do
-  char '{' 
-  result <- pInText (char '}')
-  return result
-
-
-pInText :: Parser a -> Parser Doc
-pInText end = oMappend <$> manyTill (pTextChunk <|> pTextLn <|> pElement <|> (oBraces <$> pTextArg)) (try end)
-
-pArg :: String -> Parser Doc
-pArg [open,close] = do 
-  char open
-  result <- pHask
-  char close
-  return result
-
-pArg1 [open,close] = do
-  r <- pArg [open,close]
-  return $ oChar open <> r <> oChar close
-
-isIdentChar x = isAlphaNum x || x == '\''
-
--- | Either @fctName or @result<-fctName
-pFctName :: Parser (Maybe Doc, Doc)
-pFctName = do 
-  x <- try (char '@' >> satisfy isIdentChar) -- this is to clash with @"
-  xs' <- many1 (satisfy isIdentChar)
-  let xs = x : xs'
-  ys <- option Nothing (Just <$> (try (string "<-") >> many1 (satisfy isIdentChar)))
-  return $ case ys of
-    Nothing -> (Nothing, text xs)
-    Just ys -> (Just (text xs), text ys)
-
-pFct = (Nothing,) <$> parens <$> 
-          (try (string "@{") *> pHask <* char '}')
-
-pElement :: Parser Doc
-pElement = do
-  (result,function) <- pFctName <|> pFct
-  args <- many (pArg "()" <|> pTextArg)
-  let binder = maybe oEmpty (<+> text "<-") result
-  return $ binder <> text "element" <+> parens (function <+> (hcat $ fmap parens args))
-{-
-pTop :: Parser Doc
-pTop = do
-  t <- pInText
-  return (text "import Text" $$
-          text "main =" <+> t)
--}
-{-
-main = do
-  p <- parseFromFile pTop "Text.ths"
-  case p of 
-    Left err -> hPutStrLn stderr $ show err
-    Right res -> putStrLn $ render res
-  -}
-
-main :: IO ()
-main = do
-  x : y : z : _ <- getArgs
-  putStrLn x
-  putStrLn y
-  putStrLn z
-  p <- parseFromFile pHask y
-  case p of 
-    Left err -> do
-           hPutStrLn stderr $ show err
-    Right res -> writeFile z $ 
-                    render res
-
diff --git a/Main3.hs b/Main3.hs
new file mode 100644
--- /dev/null
+++ b/Main3.hs
@@ -0,0 +1,188 @@
+{-# LANGUAGE TupleSections, FlexibleInstances, TransformListComp #-}
+import Text.ParserCombinators.Parsek.Position
+
+import Data.Char
+import Data.List
+import System.IO
+import System.Environment
+import Control.Monad
+import Data.DList hiding (map,foldr)
+import Data.Monoid
+import GHC.Exts (the,groupWith)
+import Config
+
+-- todo: parse haskell comments
+
+------------------
+-- Simple printing combinators, which do not add nor remove line breaks
+
+type Doc = DList Char
+
+text = fromList
+x <+> y =  x <> text " " <> y
+oChar = singleton
+parens s = oChar '(' <> s <> oChar ')'
+braces s = oChar '{' <> s <> oChar '}'
+brackets s = oChar '[' <> s <> oChar ']'
+doubleQuotes s = oChar '"' <> s <> oChar '"'
+
+int x = text $ show x
+hcat :: [Doc] -> Doc
+hcat = foldr (<>) mempty
+punctuate t = map (<> t)
+render :: Doc -> String
+render = toList
+
+------------------------------------------
+-- Output combinators
+
+oPos :: SourcePos -> Doc
+oPos EOF = mempty
+oPos p = text "{-# LINE" <+> int (sourceLine p) <+> text (show (sourceName p)) <+> text "#-}"
+
+oText :: String -> Doc
+oText x = text "textual" <+> text (show x)
+
+oMappend :: [Doc] -> Doc
+oMappend [] = text "(return ())"
+oMappend [x] = parens x
+oMappend l = text "do" <+> braces (text "rec" <+> braces (hcat (punctuate (text ";") binds)) <> text ";" <> ret)
+  where binds = init l
+        ret = last l
+
+----------------------------------------------
+-- Parsing helpers
+
+satisfy' :: (String -> Bool) -> Parser Char
+satisfy' p = do
+  l <- look
+  unless (p l) $
+    fail "Unexpected leading string"
+  anySymbol
+
+munch',munch1' :: (String -> Bool) -> Parser String
+munch' p = scan =<< look
+ where
+  scan (c:cs) | p (c:cs) = (:) <$> anySymbol <*> scan cs
+  scan _            = pure []
+
+munch1' p = (:) <$> satisfy' p <*> munch' p
+
+-- | A chunck not containing some strings
+pChunk' :: [String] -> Parser String
+pChunk' stops = munch1' (\l -> not $ any (`isPrefixOf` l) stops)
+
+
+-- | A chunk not containing some chars.
+pChunk :: [Char] -> Parser String
+pChunk stops = munch1 (not . (`elem` stops))
+
+----------------------------------------------
+-- Parsing combinators
+
+anyQuoteStrings :: [String]
+anyQuoteStrings = concatMap (\(x,y) -> [x,y]) quoteStrings
+
+pTextChunk = oText <$> pChunk' ("\n" : commentString : antiQuoteStrings ++ anyQuoteStrings) <?> "Text chunk"
+pHaskChunk = text <$> pChunk' (map box "\n\"[]()" ++ map fst quoteStrings) <?> "Haskell chunk"
+    -- we keep track of balancing
+
+pWPos :: Parser Doc
+pWPos = do
+  char '\n'
+  pos <- getPosition
+  return $ oPos pos <> text "\n"
+
+pHaskLn = pWPos -- before each newline, tell GHC where we are.
+pTextLn = (oText "\n" <>) <$> pWPos
+  -- add code to output a newline; and insert a newline in the code.
+
+box = (:[])
+
+pString :: Parser Doc
+pString = do
+  char '"'
+  result <- many (string "\\\"" <|> pChunk ['"'])
+  char '"'
+  return $ doubleQuotes . hcat . map text $ result
+
+-- | Parse some Haskell code with markup inside.
+pHask :: Parser Doc
+pHask =
+  (hcat <$> many ((brackets <$> pArg "[]") <|>
+                  (parens   <$> pArg "()") <|>
+                  (parens   <$> pTextArg ) <|> pString <|> pHaskChunk <|> pHaskLn))
+
+-- | Parse a text argument to an element
+pTextArg' :: String -> String -> Parser Doc
+pTextArg' open close = label "quoted text" $
+  string open *>
+  (oMappend <$> many (pElement <|> pTextChunk <|> pTextLn <|> pComment))
+  <* string close
+
+pTextArg :: Parser Doc
+pTextArg = choice $ map (uncurry pTextArg') quoteStrings
+
+pArg :: String -> Parser Doc
+pArg [open,close] = char open *> pHask <*  char close
+
+isIdentChar :: Char -> Bool
+isIdentChar x = isAlphaNum x || (x `elem` "\'_")
+
+pIdent :: Parser Doc
+pIdent = text <$> munch1 isIdentChar <?> "identifier"
+
+pArgument :: Parser Doc
+pArgument = (pArg "()" <|> (brackets <$> pArg "[]") <|> pTextArg <|> pString) <?> "argument"
+
+pElement :: Parser Doc
+pElement = label "Haskell element" $ do
+  choice $ map string $ antiQuoteStrings
+  var <- ((<+> text "<-") <$> (pIdent <* string "<-")) <<|> pure mempty
+  val <- ((:) <$> pIdent <*> manyGreedy pArgument) <|> (box <$> pArg "()")
+  return $ var <> text "element" <+> parens (hcat $ fmap parens val)
+
+commentString :: String
+commentString = "%%"
+
+pComment :: Parser Doc
+pComment = label "Comment" $ do
+  string commentString
+  munch (/= '\n')
+  string "\n"
+  return mempty
+
+main :: IO ()
+main = do
+  x : y : z : _ <- getArgs
+  putStrLn x
+  putStrLn y
+  putStrLn z
+  p <- parseFromFile (pHask <* endOfFile) completeResults y
+  case p of
+    Left e -> handleErr e
+    Right [res] -> writeFile z $ render res
+    Right _ -> hPutStrLn stderr "Amibiguous input!"
+
+handleErr e =
+   sequence_
+          [ hPutStrLn stderr (show $ maybePosToPos $ the pos) >>
+            hPutStrLn stderr ("  Expected:" ++ (intercalate " or " $ nub what))
+           | (exps,_why) <- e, (what,pos) <- exps, then group by pos using groupWith, then reverse ]
+
+instance Show (DList Char) where
+  show x = show $ render x
+
+
+-- Tests
+testHask = parse "<interactive>" pHask completeResults "arst « text @z<-fct[x](y) awft"
+testHask2 = parse "<interactive>" pHask completeResults "ars(t) « text @z<-fct[x](y) » awft"
+testText2 = parse "<interactive>" pTextArg completeResults "« text @fct(x »"
+testText3 = parse "<interactive>" pTextArg completeResults "« 1 @x 2 @y 3 @x 4 »"
+testElem = parse "<interactive>" pElement completeResults "@x<-fct(x « yop »)[y]"
+testChunk = parse "<interactive>" pHaskChunk completeResults "t"
+testArg = parse "<interactive>" (pArg "()") completeResults "()"
+
+terr e  = case e of
+    Left x -> handleErr x
+    Right [res] -> putStrLn $ render res
diff --git a/MarXup.hs b/MarXup.hs
new file mode 100644
--- /dev/null
+++ b/MarXup.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE TypeFamilies #-}
+
+module MarXup where
+
+class Element a where
+  type Target a
+  element :: a -> Target a
+
+class Textual f where
+    textual :: String -> f ()
diff --git a/MarXup/Beamer.hs b/MarXup/Beamer.hs
--- a/MarXup/Beamer.hs
+++ b/MarXup/Beamer.hs
@@ -4,26 +4,37 @@
 import Control.Applicative
 import Data.Monoid
 import MarXup.Tex
+import MarXup.Latex (itemize,enumerate,item,color)
+import Data.List (intercalate)
 
 usetheme = cmd "usetheme" . tex
 
 frame tit bod = env "frame" $ do
   cmd "frametitle" tit
   bod
-  
-pause :: TeX
-pause = cmd "pause"$  mempty
 
+framesubtitle = cmd "framesubtitle"
+itemiz xs = itemize $ mconcat $ fmap (item <>) xs
+enumerat xs = enumerate $ mconcat $ fmap (item <>) xs
+
 note = cmd "note"
 
-{-
-preamble :: Tex ()
-preamble = do 
-  usepackage [] "bbm"
-  usetheme "Malmoe"
-  
-  title $ tex "Elements of Parametricity and Computational Irrelevance" 
-  cmd' "author" ["JP Bernardy"] $ tex "Jean-Philippe Bernardy"
-  cmd "institute" $ tex "Chalmers University of Technology and University of Gothenburg"
-  cmd "date" $ cmd "today" mempty
--}
+hide = color "white"
+
+-----------------------------------
+-- Discouraged commands
+-- (it's usually better to generate the various frames using Haskell code)
+pause :: TeX
+pause = cmd0 "pause"
+
+frameCmd :: String -> [Int] -> TeX -> TeX
+frameCmd cmd frames body = do
+  tex $ "\\ " ++ cmd ++ "<"
+  tex $ intercalate "," $ map show frames
+  tex ">"
+  braces body
+
+only :: [Int] -> TeX -> TeX
+only = frameCmd "only"
+uncover :: [Int] -> TeX -> TeX
+uncover = frameCmd "uncover"
diff --git a/MarXup/DerivationTrees.hs b/MarXup/DerivationTrees.hs
--- a/MarXup/DerivationTrees.hs
+++ b/MarXup/DerivationTrees.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE DisambiguateRecordFields, NamedFieldPuns, RecordWildCards, PostfixOperators, LiberalTypeSynonyms, TypeOperators, OverloadedStrings #-}
+{-# LANGUAGE DisambiguateRecordFields, NamedFieldPuns, RecordWildCards, PostfixOperators, LiberalTypeSynonyms, TypeOperators, OverloadedStrings, PackageImports #-}
 
 module MarXup.DerivationTrees (
 -- * Basics
@@ -7,220 +7,222 @@
 
 -- * Derivation' building
 -- axiom, rule, etc, aborted, 
-emptyDrv, haltDrv, haltDrv', abortDrv, delayPre, 
+emptyDrv, haltDrv, haltDrv', delayPre,
 dummy, rule, Derivation, Premise, Rule(..), 
 
 -- * Links
-Alignment(..), LineStyle(..),defaultLink,Link(..),
-
--- * Figure building
-Figure(..),
+LineStyle,defaultLink,Link(..),
 
 -- * Engine
-derivationTree
+derivationTree, derivationTreeD
 
 ) where
 
 -- import DerivationTrees.Basics
 import Data.List
-import Data.Traversable hiding (mapM)
 import Control.Monad.Writer 
-import Control.Monad.State 
 import Control.Applicative 
-import System.IO.Unsafe
 import Data.LabeledTree
--- import Control.Applicative.State
-import Data.Monoid hiding ((<>))
+import Data.Monoid
+import MarXup (element)
 import MarXup.Tex hiding (label)
-import MarXup.MetaPost
-
+import MarXup.MultiRef
+import MarXup.Diagram as D
+import qualified Data.Tree as T
 ------------------
 --- Basics
 
-data LineStyle = None | Simple | Double | Dotted | Dashed | Waved | TeXDotted 
-  deriving (Enum,Show)
+type LineStyle = PathOptions -> PathOptions
 
-data Link = Link {label :: Tex (), linkStyle :: LineStyle, align :: Alignment, steps :: Int}  -- ^ Regular link
-          | Detached {label :: Tex ()}               -- ^ Detach the derivation as another figure
-          | Delayed {align :: Alignment} -- ^ automatic delaying
--- deriving Show
+data Link = Link {label :: Tex (), linkStyle :: LineStyle, steps :: Int}  -- ^ Regular link
+          | Delayed -- ^ automatic delaying
 
 defaultLink :: Link
-defaultLink = Link mempty Dotted CenterA 0
-
-data Alignment = LeftA | CenterA | RightA
-instance Show Alignment where    
-    show LeftA = "l"
-    show CenterA = "c"
-    show RightA = "r"
+defaultLink = Link mempty (denselyDotted . outline "black")  0
 
 
 -------------------
 
-data Rule tag = Rule {tag :: tag, ruleStyle :: LineStyle, delimiter :: Tex (), ruleLabel :: Tex (), conclusion :: Tex ()}
+data Rule = Rule {ruleStyle :: LineStyle, delimiter :: Tex (), ruleLabel :: Tex (), conclusion :: Tex ()}
 --  deriving Show
 
-{-
-instance Monoid t => Applicative (Writer t) where
-    pure = return
-    (<*>) = ap
--}
-
-type Premise = Link ::> Derivation' ()
-type Derivation' tag = Tree Link (Rule tag) 
-type Derivation = Derivation' ()
-
-data Figure tag = Figure {figureTag :: Label, contents :: Derivation' tag}
-
-------------------------------------------------------------
--- Phase 1: Detach
-
-type Detach x = x -> WriterT [Figure ()] Tex x
-
-detachP :: Detach Premise
-detachP (Detached{..} ::> d) = do
-  d'@(Node r ps) <- detachD d
-  figureTag <- lift $ newLabel 
-  tell [Figure {contents = Node r {delimiter = label} ps,..}]
-  return $ (defaultLink ::> haltDrv label d)
-detachP (l ::> d) = (l ::>) <$> detachD d
-
-detachD :: Detach Derivation
-detachD (Node n ps) = Node n <$> for ps detachP
-
-detachF :: Figure () -> WriterT [Figure ()] Tex ()
-detachF Figure{..} = do
-  contents <- detachD contents
-  tell [Figure{..}]
-
-detachTop :: [Figure ()] -> Tex [Figure ()]
-detachTop fs = do 
-  figs <- runWriterT $ for fs detachF
-  return $ snd $ figs
+type Premise = Link ::> Derivation
+type Derivation = Tree Link Rule
 
 --------------------------------------------------
--- Phase 2: Delay
-
-insertAt n x xs = take n xs ++ x : drop n xs
-
-rm idx [] = []
-rm 0 (x:xs) = xs
-rm n (x:xs) = x : rm (n-1) xs
+-- Delay
 
-depth (Detached{} ::> _) = 2
 depth (Link{steps} ::> Node _ ps) = 1 + steps + maximum (0 : map depth ps)
 
 isDelayed :: Premise -> Bool
 isDelayed (Delayed{} ::> _) = True
 isDelayed _ = False
 
-delayPre a s (Link {..} ::> j) = Link {steps = s, align = a, ..} ::> j
+delayPre s (Link {..} ::> j) = Link {steps = s, ..} ::> j
 
 delayD :: Derivation -> Derivation
 delayD (Node r ps0) = Node r (map delayP ps)
     where ps = fmap (fmap delayD) ps0
           ps' = filter (not . isDelayed) ps
-          delayP (Delayed{..} ::> d) = Link{..} ::> d
-             where steps = 1 + maximum (0 : map depth ps')
-                   label = mempty
-                   linkStyle = Dotted
+          delayP (Delayed{..} ::> d) = defaultLink {steps = 1 + maximum (0 : map depth ps')} ::> d
           delayP p = p
 
-delayF :: Figure () -> Figure ()
-delayF (Figure{..}) = Figure{contents = delayD contents,..}
+----------------------------------------------------------
+-- TeXify
+  
+-- | Render a derivation tree without using metapost drv package (links will not be rendered properly)
+derivationTree :: Derivation -> TeX
+derivationTree = stringizeTex
 
-delayTop = map delayF
+stringizeTex :: Derivation -> TeX
+stringizeTex (Node Rule {..} premises) = braces $ do
+  cmd0 "displaystyle" -- so that the text does not get smaller
+  cmdn "frac" [mconcat $
+               intersperse (cmd0 "quad")
+               [ stringizeTex v | _ ::> v <- premises]
+              ,conclusion]
+  braces $ do cmd0 "small"
+              ruleLabel
 
+----------------------------------------------------------
+-- Tikzify
 
+derivationTreeD :: Derivation -> Tex ()
+derivationTreeD d = element $ derivationTreeDiag $ delayD d
 
----------------------------------------------------------
--- Phase 3: Tag
+derivationTreeDiag :: Derivation -> Diagram ()
+derivationTreeDiag d = do
+  [h] <- newVars [ContVar] -- the height of a layer in the tree.
+  minimize h
+  h >== 1
+  tree@(T.Node (_,n,_) _) <- toDiagram h d
+  forM_ (T.levels tree) $ \ls ->
+    case ls of
+      [] -> return ()
+      (_:ls') -> forM_ (zip ls ls') $ \((_,_,l),(r,_,_)) ->
+        (l + Point 10 0) `westOf` r
+  let leftFringe = map head nonNilLevs
+      rightFringe = map last nonNilLevs
+      nonNilLevs = filter (not . null) $ T.levels tree
+  [leftMost,rightMost] <- newVars [ContVar,ContVar]
+  forM_ leftFringe $ \(p,_,_) ->
+    leftMost <== xpart p
+  forM_ rightFringe $ \(_,_,p) ->
+    xpart p <== rightMost
+  minimize $ 10 *- (rightMost - leftMost)
+  n # Center .=. Point 0 0
 
-type Tag x = x () -> Tex (x Int)
+toDiagPart :: Expr -> Premise -> Diagram (T.Tree (Point,Anchorage,Point))
+toDiagPart layerHeight (Link{..} ::> rul)
+  | steps == 0 = toDiagram layerHeight rul
+  | otherwise = do
+    above@(T.Node (_,concl,_) _) <- toDiagram layerHeight rul
+    ptObj <- vrule
+    let pt = ptObj # S
+    pt `eastOf` (concl # W)
+    pt `westOf` (concl # E)
+    xpart pt =~= xpart (concl # Center)
+    let top = ypart (concl # S)
+    ypart pt + (fromIntegral steps *- layerHeight) === top
+    using linkStyle $ path $ polyline [ptObj # Base,Point (xpart pt) top]
+    let embedPt 1 x = T.Node (concl # W,ptObj,concl # E) [x]
+        embedPt n x = T.Node (pt,ptObj,pt) [embedPt (n-1) x]
+    return $ embedPt steps above
 
-tagify :: Tag Rule
-tagify (Rule {..}) = do
-  tag <- newLabel
-  return $ Rule {..}
+-- | @chainBases distance objects@
+-- - Ensures that all the objects have the same baseline.
+-- - Separates the objects by the given distance
+-- - Returns an object encompassing the group, with a the baseline set correctly.
+-- - Returns the average distance between the objects
+   
+chainBases :: Expr -> [Anchorage] -> Diagram (Anchorage,Expr)
+chainBases _ [] = do
+  o <- box
+  return (o,0)
+chainBases spacing ls = do
+  grp <- box
+  forM_ [Base,N,S] $ \ anch -> do
+    D.align ypart $ map (# anch) (grp:ls)
+  dxs <- forM (zip ls (tail ls)) $ \(x,y) -> do
+    let dx = xdiff (x # E) (y # W)
+    dx >== spacing
+    return dx
+  D.align xpart [grp # W,head ls # W]
+  D.align xpart [grp # E,last ls # E]
+  return (grp,avg dxs)
 
-tagifyFig :: Tag Figure
-tagifyFig (Figure {..}) = Figure figureTag <$> traverse tagify contents
+-- | Make an horizontally flexible box of glue.
+mkHGlue :: Expr -> Expr -> Diagram Anchorage
+mkHGlue minimumWidth preferredWidth = do
+  g <- box
+  width g >== minimumWidth
+  width g =~= preferredWidth
+  return g
 
-tagifyTop :: [Figure ()] -> Tex [Figure Int]
-tagifyTop = mapM tagifyFig
+-- | Put object in a box of the same vertical extent, and baseline,
+-- but whose height can be bigger.
+relaxHeight o = do
+  b <- box
+  -- using (outline "green")$ traceBounds o
+  D.align xpart [b#W,o#W]
+  D.align xpart [b#E,o#E]
+  D.align ypart [b#Base,o#Base]
+  o `fitsVerticallyIn` b
+  return b
 
-----------------------------------------------------------
--- Phase 4: Texify
+toDiagram :: Expr -> Derivation -> Diagram (T.Tree (Point,Anchorage,Point))
+toDiagram layerHeight (Node Rule{..} premises) = do
+  ps <- mapM (toDiagPart layerHeight) premises
+  concl <- relaxHeight =<< extend 1.5 <$> texBox conclusion
+  -- using (outline "red")$ traceBounds concl
+  lab <- texBox ruleLabel
 
-mpQuote :: Tex () -> Tex ()
-mpQuote t = Tex "\"" >> t >> Tex "\""
+  -- Grouping
+  (psGrp,premisesDist) <- chainBases 10 [p | T.Node (_,p,_) _ <- ps]
+  -- using (outline "blue" . denselyDotted) $ traceBounds psGrp
+  height psGrp === layerHeight
 
-mkTuple :: [Tex ()] -> Tex ()
-mkTuple l = Tex " (" >> sequence_ (intersperse "," l) >> Tex ") "
+  -- Sepaartion rule
+  separ <- hrule
+  separ # N .=. psGrp # S
+  align ypart [concl # N,separ # S]
+  minimize $ width separ
+  psGrp `fitsHorizontallyIn` separ
+  concl `fitsHorizontallyIn` separ
 
-link (Link {..} ::> Node (Rule{tag}) _) 
-    | steps == 0 = sho tag
-    | otherwise = Tex "MVD " >> sho tag >> Tex " " >>
-                  mkTuple [sho steps,sho "",mpQuote label,sho align,sho (fromEnum linkStyle)]
+  -- rule label
+  lab # BaseW .=. separ # E + Point 3 (negate 1)
 
-type Stringize x = x Int -> Tex ()
 
-stringize :: Derivation' Label -> Tex ()
-stringize (Node Rule {tag = t, ..} premises) = do
-  traverse (traverse stringize) premises
-  Tex "jgm " >> reference t >> Tex " " >> mpQuote conclusion >> Tex ";\n"
-  Tex "Nfr " >> reference t >> mkTuple (map link premises) >> Tex " " >>
-                     mkTuple [mpQuote ruleLabel,mpQuote delimiter,mpQuote (Tex ""),sho (fromEnum ruleStyle)] >> Tex ";\n"
-
-stringizeFig :: Figure Label -> Tex () 
-stringizeFig (Figure {..}) = metapostFigure figureTag $ do
-  stringize contents
-  texLn "draw drv_tree;"
-  
-
-------------------------------------------
--- Pipeline
+  -- layout hints (not necessary for "correctness")
+  let xd = xdiff (separ # W) (psGrp # W)
+  xd   === xdiff (psGrp # E) (separ # E) 
+  relax 2 $ (2 *- xd) =~= premisesDist
+  -- centering of conclusion
+  xd' <- absoluteValue $ xdiff (separ # Center) (concl # Center)
+  relax 3 $ minimize xd'
 
-derivationTree :: [String] -> Derivation -> Tex Label
-derivationTree opts j = do 
-  f <- newLabel
-  a <- delayTop <$> detachTop [Figure f j]
-  bz <- tagifyTop a   
-  Metapost $ mapM stringizeFig bz
-  cmd' "includegraphics" opts (MPFigure f)
-  return f
+  -- draw the rule.
+  localPathOptions ruleStyle $ path $ polyline [separ # W,separ # E]
+  return $ T.Node (separ # W, concl, lab # E) ps
 
 -----------------------
 
-rule ruleLabel conclusion = Rule {tag = (), delimiter = mempty, ruleStyle = Simple, ..}
 
-dummy :: Rule ()
-dummy = (rule mempty mempty) {ruleStyle = None}
+rule ruleLabel conclusion = Rule {delimiter = mempty, ruleStyle = outline "black", ..}
+
+dummy :: Rule
+dummy = (rule mempty mempty) {ruleStyle = const defaultPathOptions}
 emptyDrv = Node dummy []
 
-abortDrv (Node Rule {..} _) = Node Rule {ruleStyle = Waved, ..} []
+-- abortDrv (Node Rule {..} _) = Node Rule {ruleStyle = Waved, ..} []
 
 -- | Used when the rest of the derivation is known.
 haltDrv' :: Tex () -> Derivation -> Derivation
-haltDrv' tex (Node r _) = Node r {ruleStyle = None} 
-     [defaultLink {linkStyle = TeXDotted, steps = 1, label = tex} ::> emptyDrv]
+haltDrv' tex (Node r _) = Node r {ruleStyle = noOutline}
+     [defaultLink {steps = 1, label = tex} ::> emptyDrv]
 
 -- | More compact variant
 haltDrv :: Tex () -> Derivation -> Derivation
-haltDrv t (Node r _) = Node r [defaultLink ::> Node dummy {conclusion = cmd "vdots" nil >> cmd "hspace" (Tex "2pt") >> t} []]
-
-
-{-------------------------
-brace :: TeX -> TeX
-brace (TeX x) = TeX $ '{' : x ++ ['}']
-paren (TeX x) = TeX $ '(' : x ++ [')']
-brack (TeX x) = TeX $ "[" ++ x ++ "]"
-
-tex :: String -> [TeX] -> TeX
-tex macro args = TeX ('\\' : macro) <> mconcat (map brace args)
-text x = tex "text" [TeX x]
-
-f ! x = brace f <> TeX "_" <> brace x
-
+haltDrv t (Node r _) = Node r [defaultLink ::> Node dummy {conclusion = cmd "vdots" nil >> cmd "hspace" (tex "2pt") >> t} []]
 
--}
diff --git a/MarXup/Diagram.hs b/MarXup/Diagram.hs
new file mode 100644
--- /dev/null
+++ b/MarXup/Diagram.hs
@@ -0,0 +1,7 @@
+module MarXup.Diagram (module D) where
+
+import MarXup.Diagram.Layout as D
+import MarXup.Diagram.Path as D
+import MarXup.Diagram.Point  as D
+import MarXup.Diagram.Object as D
+import MarXup.Diagram.Tikz as D
diff --git a/MarXup/Diagram/Graphviz.hs b/MarXup/Diagram/Graphviz.hs
new file mode 100644
--- /dev/null
+++ b/MarXup/Diagram/Graphviz.hs
@@ -0,0 +1,109 @@
+{-# LANGUAGE RecordWildCards #-}
+module MarXup.Diagram.Graphviz (graph) where
+
+import MarXup.Tex
+import MarXup.Diagram.Point as D
+import MarXup.Diagram.Object as D
+import MarXup.Diagram.Tikz as D
+import MarXup.Diagram.Layout
+import MarXup.Diagram.Path
+import Data.GraphViz as G
+import Data.GraphViz.Attributes.Complete as G
+import Data.GraphViz.Parsing as G
+import qualified Data.GraphViz.Types.Generalised as Gen
+import Data.GraphViz.Commands.IO as G
+-- import qualified Data.Text.Lazy.Internal as T
+import qualified Data.Text.Lazy as T
+import System.IO.Unsafe (unsafePerformIO)
+-- import Data.Traversable
+import Data.Foldable
+import Control.Lens (set)
+
+graph :: (PrintDotRepr g n, ParseDot n, PrintDot n) => GraphvizCommand -> g n -> Dia
+graph cmd gr = graphToDiagram $ layout cmd gr
+
+layout :: (PrintDotRepr g n, ParseDot n, PrintDot n) => GraphvizCommand -> g n -> Gen.DotGraph n
+layout command input = parseIt' $ unsafePerformIO $ graphvizWithHandle command input DotOutput hGetStrict 
+
+pos (Pos p) = Just p
+pos _= Nothing
+
+lpos (LPos p) = Just p
+lpos _= Nothing
+
+shapeA (Shape s) = Just s
+shapeA _ = Nothing
+
+widthA (Width s) = Just s
+widthA _ = Nothing
+
+labelA (Label l) = Just l
+labelA _ = Nothing
+
+arrowHeadA (ArrowHead a) = Just a
+arrowHeadA _ = Nothing
+
+readAttr :: Monad m => (Attribute -> Maybe a) -> [Attribute] -> (a -> m ()) -> m ()
+readAttr f as k = readAttr' f as k (return ())
+
+readAttr' :: (Attribute -> Maybe a) -> [Attribute] -> (a -> k) -> k -> k
+readAttr' f as k1 k2 = case [x | Just x <- map f as] of
+  (x:_) -> k1 x
+  _ -> k2
+
+
+pt' (G.Point x y _z _forced) = D.Point x y
+pt = unfreeze . pt'
+
+diaSpline (w:x:y:z:rest) = curveSegment w x y z:diaSpline (z:rest)
+diaSpline _ = []
+
+-- ToTip | CircleTip | NoTip | StealthTip | LatexTip | ReversedTip LineTip | BracketTip | ParensTip
+tipTop def (AType [(_,NoArrow)]) = NoTip
+tipTop def (AType [(_,Normal)]) = LatexTip
+tipTop def (AType [(_,DotArrow)]) = CircleTip
+tipTop def (AType [(_,Vee)]) = StealthTip
+tipTop def _ = def
+
+renderLab l p = do
+  l' <- labelObj $ tex $ T.unpack $ l
+  l' # D.Center .=. pt p
+
+graphToDiagram :: Gen.DotGraph n -> Dia
+graphToDiagram (Gen.DotGraph _strict _directed _grIdent stmts) = do
+  forM_ stmts $ \ stmt -> case stmt of
+    (Gen.DE (DotEdge _from _to attrs)) -> do
+      diaRaw $ "%Edge: " ++ show attrs ++ "\n"
+      let toTip = readAttr' arrowHeadA attrs (tipTop ToTip) ToTip
+      readAttr labelA attrs $ \(StrLabel l) ->
+        readAttr lpos attrs $ \p -> 
+        renderLab l p
+      readAttr pos attrs $ \(SplinePos splines) ->
+        forM_ splines $ \Spline{..} -> do
+          let mid = diaSpline $ map pt' splinePoints
+          let beg = case (startPoint,splinePoints) of
+                (Just p,q:_) -> [lineSegment (pt' p) (pt' q)]
+                _ -> []
+          let end = case (endPoint,reverse splinePoints) of
+                (Just p,q:_) -> [lineSegment (pt' q) (pt' p)]
+                _ -> []
+          using (set endTip toTip) $
+            draw $ frozenPath $ fromBeziers (beg ++ mid ++ end)
+
+    (Gen.DN (DotNode _nodeIdent attrs)) -> do
+      diaRaw $ "%Node: " ++ show attrs ++ "\n"
+      readAttr pos   attrs $ \(PointPos p) -> do
+        readAttr labelA attrs $ \l -> do
+          case l of
+            StrLabel l -> renderLab l p
+        readAttr widthA attrs $ \w ->
+         readAttr shapeA attrs $ \s ->
+          case s of
+            Circle -> do
+              draw $ path $ circle (pt p) (constant $ inch (w/2))
+            _ -> return ()
+    _ -> return ()
+
+inch x = 72 * x
+
+
diff --git a/MarXup/Diagram/Layout.hs b/MarXup/Diagram/Layout.hs
new file mode 100644
--- /dev/null
+++ b/MarXup/Diagram/Layout.hs
@@ -0,0 +1,203 @@
+{-# LANGUAGE TypeSynonymInstances, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, RecursiveDo, TypeFamilies, OverloadedStrings, RecordWildCards,UndecidableInstances, PackageImports, TemplateHaskell #-}
+
+module MarXup.Diagram.Layout (module MarXup.Diagram.Layout) where
+import Control.Monad.LPMonad
+import Prelude hiding (sum,mapM_,mapM,concatMap)
+import Control.Monad.RWS hiding (forM,forM_,mapM_,mapM)
+import Data.LinearProgram
+import Data.LinearProgram.Common as MarXup.Diagram.Layout (VarKind(..)) 
+import Data.LinearProgram.LinExpr
+import Data.Map (Map)
+import qualified Data.Map as M
+import Control.Lens hiding (element)
+import Data.String
+-- import MarXup
+import Data.Traversable
+import Data.Foldable
+import Control.Applicative
+import System.IO.Unsafe
+import MarXup.MultiRef
+import MarXup.Tex
+
+type LPState = LP Var Constant
+
+type Solution = Map Var Double
+type Constant = Double
+
+-- | Expressions are linear functions of the variables
+type Expr = LinExpr Var Constant
+
+newtype Decoration = Decoration String
+data LineTip = ToTip | CircleTip | NoTip | StealthTip | LatexTip | ReversedTip LineTip | BracketTip | ParensTip
+type Color = String
+data LineCap = ButtCap | RectCap | RoundCap
+data LineJoin = MiterJoin | RoundJoin | BevelJoin
+type DashPattern = [(Constant,Constant)]
+data PathOptions = PathOptions
+                     {_drawColor :: Maybe Color
+                     ,_fillColor :: Maybe Color
+                     ,_lineWidth :: Constant
+                     ,_startTip  :: LineTip
+                     ,_endTip    :: LineTip
+                     ,_lineCap   :: LineCap
+                     ,_lineJoin  :: LineJoin
+                     ,_dashPattern :: DashPattern
+                     ,_decoration :: Decoration
+                     }
+$(makeLenses ''PathOptions)
+
+data Env = Env {_diaSolution :: Solution
+               ,_diaTightness :: Constant -- ^ Multiplicator to minimize constraints
+               ,_diaPathOptions :: PathOptions}
+
+$(makeLenses ''Env)
+
+defaultPathOptions :: PathOptions
+defaultPathOptions = PathOptions
+  {_drawColor = Nothing
+  ,_fillColor = Nothing
+  ,_lineWidth = 0.4
+  ,_startTip  = NoTip
+  ,_endTip    = NoTip
+  ,_lineCap   = ButtCap
+  ,_lineJoin  = MiterJoin
+  ,_dashPattern = []
+  ,_decoration = Decoration ""
+  }
+
+newtype Diagram a = Dia (RWST Env () (Var,LPState) Multi a)
+  deriving (Monad, Applicative, Functor, MonadReader Env)
+
+type Dia = Diagram ()
+
+instance MonadState LPState Diagram where
+  get = Dia $ snd <$> get
+  put y = Dia $ do
+    (x,_) <- get
+    put (x,y)
+
+-------------
+-- Diagrams
+
+runDiagram :: Diagram a -> Multi a
+runDiagram (Dia diag) = do
+  rec (a,(_,problem),_) <- runRWST diag (Env solution 1 defaultPathOptions)
+                                        (Var 0,LP Min M.empty [] M.empty M.empty)
+      let solution = case unsafePerformIO $ glpSolveVars simplexDefaults problem of
+            (_retcode,Just (_objFunc,s)) -> s
+            (retcode,Nothing) -> error $ "ret code = " ++ show retcode
+  -- Raw Normal $ "%problem solved: " ++ show problem ++ "\n"
+  return a
+
+diaRawTex :: Tex a -> Diagram a
+diaRawTex (Tex t) = Dia $ lift t
+
+diaRaw :: String -> Dia
+diaRaw = diaRawTex . tex
+
+relax factor = local (over diaTightness (/ factor)) 
+
+instance Monoid (Diagram ()) where
+  mempty = return ()
+  mappend = (>>)
+
+instance IsString (Diagram ()) where
+  fromString = diaRawTex . tex
+
+--------------
+-- Variables
+varValue :: Var -> Diagram Double
+varValue v = M.findWithDefault 0 v <$> view diaSolution
+
+rawNewVar :: Diagram Var
+rawNewVar = Dia $ do
+      (Var x,y) <- get
+      put $ (Var (x+1),y)
+      return $ Var x
+
+newVars :: [VarKind] -> Diagram [Expr]
+newVars kinds = newVars' (zip kinds (repeat Free))
+
+newVars' :: [(VarKind,Bounds Constant)] -> Diagram [Expr]
+newVars' kinds = forM kinds $ \(k,b) -> do
+  v <- rawNewVar
+  setVarKind v k
+  setVarBounds v b
+  return $ variable v
+
+infix 4 <==,===,>==
+
+----------------
+-- Expressions
+instance Fractional Expr where
+  fromRational ratio = constant (fromRational ratio)
+
+instance Num Expr where
+  fromInteger x = LinExpr M.empty (fromInteger x)
+  negate = neg
+  (+) = (^+^)
+  (-) = (^-^)
+
+valueOf :: Expr -> Diagram Double
+valueOf (LinExpr m c) = do
+  vs <- forM (M.assocs m) $ \(v,scale) ->
+    (scale *) <$> varValue v
+  return $ sum $ c:vs
+
+variable :: Var -> Expr
+variable v = LinExpr (var v) 0
+
+constant :: Constant -> Expr
+constant c = LinExpr M.empty c
+
+(*-) :: Module Constant a => Constant -> a -> a
+(*-) = (*^)
+infixr 6 *-
+
+avg :: Module Constant a => [a] -> a
+avg xs = (1/fromIntegral (length xs)) *- gsum xs
+
+absoluteValue :: Expr -> Diagram Expr
+absoluteValue x = do
+  [t1,t2] <- newVars' [(ContVar,LBound 0),(ContVar,LBound 0)]
+  t1 - t2 === x
+  return $ t1 + t2
+
+satAll :: (Expr -> a -> Diagram b) -> [a] -> Diagram Expr
+satAll p xs = do
+  [m] <- newVars [ContVar]
+  mapM_ (p m) xs
+  return m
+
+maximVar, minimVar :: [Expr] -> Diagram Expr
+maximVar = satAll (>==)
+minimVar = satAll (<==)
+
+--------------
+-- Expression constraints
+(>==), (<==) :: Expr -> Expr -> Diagram ()
+e1 <== e2 = do
+  let LinExpr f c = e1 - e2
+  leqTo f (negate c)
+
+(>==) = flip (<==)
+
+(===) :: Expr -> Expr -> Diagram ()
+e1 === e2 = do
+  let LinExpr f c = e1 - e2
+  equalTo f (negate c)
+
+-- | minimize the distance between expressions
+(=~=) :: Expr -> Expr -> Diagram ()
+x =~= y = minimize =<< absoluteValue (x-y)
+
+-------------------------
+-- Expression objectives
+
+minimize,maximize :: Expr -> Diagram ()
+minimize (LinExpr x _) = do
+  tightness <- view diaTightness
+  addObjective (tightness *- x)
+maximize = minimize . negate
+
+
diff --git a/MarXup/Diagram/Object.hs b/MarXup/Diagram/Object.hs
new file mode 100644
--- /dev/null
+++ b/MarXup/Diagram/Object.hs
@@ -0,0 +1,266 @@
+{-# LANGUAGE DataKinds, KindSignatures, OverloadedStrings, EmptyDataDecls, MultiParamTypeClasses, FlexibleContexts, OverlappingInstances, TypeSynonymInstances, FlexibleInstances   #-}
+
+module MarXup.Diagram.Object where
+
+-- import MarXup
+import MarXup.Tex
+import MarXup.Diagram.Tikz
+import MarXup.Diagram.Path
+import MarXup.Diagram.Point
+import MarXup.Diagram.Layout
+import MarXup.MultiRef (BoxSpec(..))
+import Control.Monad
+import Control.Applicative
+-- import Data.Algebra
+-- import Data.List (intersperse)
+import Control.Lens (set)
+
+data Anchor = Center | N | NW | W | SW | S | SE | E | NE | BaseW | Base | BaseE
+  deriving Show
+
+-- | Box-shaped object. (a subtype)
+type Box = Object
+
+newtype Anchorage = Anchorage {boxAnchors :: Anchor -> Point}
+data Object = Object {objectOutline :: Path, objectAnchorage :: Anchorage}
+
+class Anchored a where
+  anchors :: a -> Anchor -> Point
+infix 8 #
+
+(#) :: Anchored a => a -> Anchor -> Point
+(#) = anchors
+
+instance Anchored Anchorage where
+  anchors = boxAnchors
+
+instance Anchored Object where
+  anchors = anchors . objectAnchorage
+
+instance Anchored Point where
+  anchors p _ = p
+
+-- | Horizontal distance between objects
+hdist :: Anchored a => a -> a -> Expr
+hdist x y = xpart (y # W - x # E)
+
+-- | Vertical distance between objects
+vdist :: Anchored a => a -> a -> Expr
+vdist x y = ypart (y # S - x # N)
+
+-- | Extend the box boundaries by the given delta
+extend :: Expr -> Anchorage -> Anchorage
+extend e o = Anchorage $ \a -> o # a + shiftInDir a e
+
+-- | Makes a shift of size 'd' in the given direction.
+shiftInDir :: Anchor -> Expr -> Point
+shiftInDir N d = 0 `Point` d
+shiftInDir S d = 0 `Point` negate d
+shiftInDir W d = negate d `Point` 0
+shiftInDir E d  = d `Point` 0
+shiftInDir NW d = negate d `Point` d
+shiftInDir SE d = d `Point` negate d
+shiftInDir SW d = negate d `Point` negate d
+shiftInDir NE d = d `Point` d
+shiftInDir _ _  = 0 `Point` 0
+
+-- | Make a label object. This is just some text surrounded by 4
+-- points of blank.
+mkLabel :: TeX -> Diagram Anchorage
+mkLabel texCode = extend 4 <$> texBox texCode
+
+labelObj :: TeX -> Diagram Box
+labelObj = rectangleShape <=< mkLabel
+
+-- | Label a point by a given TeX expression, at the given anchor.
+labelPt :: TeX -> Anchor -> Point -> Diagram Box
+labelPt labell anchor labeled  = do
+  t <- labelObj labell 
+  t # anchor .=. labeled
+  return t
+
+-- | A free point
+point :: Diagram Point
+point = do
+  [x,y] <- newVars (replicate 2 ContVar)
+  return $ Point x y
+
+-- | A point anchorage (similar to a box of zero width and height)
+pointBox :: Diagram Anchorage
+pointBox = do
+  p <- point
+  return $ Anchorage $ \a -> case a of _ -> p
+
+-- | A box. Anchors are aligned along a grid.
+box :: Diagram Anchorage
+box = do
+  [n,s,e,w,base,midx,midy] <- newVars (replicate 7 ContVar)
+  n >== base
+  base >== s
+  w <== e
+  
+  midx === avg [w,e]
+  midy === avg [n,s]
+  let pt = flip Point
+  return $ Anchorage $ \anch -> case anch of
+    NW     -> pt n    w
+    N      -> pt n    midx
+    NE     -> pt n    e  
+    E      -> pt midy e
+    SE     -> pt s    e
+    S      -> pt s    midx
+    SW     -> pt s    w
+    W      -> pt midy w
+    Center -> pt midy midx
+    Base   -> pt base midx
+    BaseE  -> pt base e
+    BaseW  -> pt base w
+
+-- | A box of zero width
+vrule :: Diagram Anchorage
+vrule = do
+  o <- box
+  align xpart [o # W, o #Center, o#E]
+  return o
+
+-- | A box of zero height
+hrule :: Diagram Anchorage
+hrule = do
+  o <- box
+  height o === 0
+  return o
+
+height o = ypart (o # N - o # S)
+width o = xpart (o # E - o # W)
+ascent o = ypart (o # N - o # Base)
+descent o = ypart (o # Base - o # S)
+
+-- fitsVerticallyIn :: Anchorage -> Anchorage -> Diagram ()
+o `fitsVerticallyIn` o' = do
+  let dyN = ypart $ o' # N - o # N
+      dyS = ypart $ o # S - o' # S
+  minimize dyN
+  dyN >== 0
+  minimize dyS
+  dyS >== 0
+
+-- fitsHorizontallyIn :: Anchorage -> Anchorage -> Diagram ()
+o `fitsHorizontallyIn` o' = do
+  let dyW = xpart $ o # W - o' # W
+      dyE = xpart $ o' # E - o # E
+  minimize dyW
+  dyW >== 0
+  minimize dyE
+  dyE >== 0
+
+a `fitsIn` b = do
+  a `fitsHorizontallyIn` b
+  a `fitsVerticallyIn` b
+
+circleShape :: Diagram Object
+circleShape = do
+  anch <- box
+  width anch === height anch
+  let radius = 0.5 *- width anch
+  let p = circle (anch # Center) radius
+  path p
+  return $ Object p anch
+--   let k1 :: Constant
+--       k1 = sqrt 2 / 2
+--       k = k1 *^ r
+--       p = circle center r
+--   return $ Object p $ Anchorage $ \a -> center + case a of
+--     N -> Point 0 r
+--     S -> Point 0 (-r)
+--     E -> Point r 0
+--     W -> Point (-r) 0
+--     Center -> Point 0 0
+--     NE -> Point k k
+
+rectangleShape :: Anchorage -> Diagram Object
+rectangleShape l = do
+  let p = polygon (map (l #) [NW,NE,SE,SW])
+  path p
+  return $ Object p l
+
+traceAnchorage :: Anchored a => Color -> a -> Diagram ()
+traceAnchorage c l = do
+  stroke c $ path $ polygon (map (l #) [NW,NE,SE,SW])
+  -- TODO: draw the baseline, etc.
+
+-- | Typeset a piece of text and return its bounding box.
+texBox :: TeX -> Diagram Anchorage
+texBox t = do
+  l <- box
+  -- traceAnchorage "red" l
+  BoxSpec wid h desc <- drawText (l # NW) t
+
+  width   l === constant wid
+  descent l === constant desc
+  height  l === constant (h + desc)
+  return l
+
+data Incidence = Incidence { incidencePoint, incidenceNormal :: Point }
+swap :: Incidence -> Incidence
+swap (Incidence p v) = Incidence p (negate v)
+
+-- | Traces a straight edge between two objects.
+-- The midpoint is returned, as well as a normal vector.
+edge :: Object -> Object -> Diagram Incidence
+edge source target = do
+  let points@[a,b] = [source # Center,target # Center]
+      link = polyline points
+      targetArea = objectOutline target
+      sourceArea = objectOutline source
+  l' <- freeze link
+  sa' <- freeze sourceArea
+  ta' <- freeze targetArea
+  frozenPath $ (l' `cutAfter` ta') `cutBefore` sa'
+  return $ Incidence (avg points) (rotate90 (b-a))
+
+(.<.) :: Point -> Point -> Diagram ()
+Point x1 y1 .<. Point x2 y2 = do
+  x1 <== x2
+  y1 <== y2
+
+-- | Forces the point to be inside the (bounding box) of the object.
+inside :: Point -> Box -> Diagram ()
+inside p o = do
+  (o # SW) .<. p
+  p .<. (o # NE)
+
+-- | @autoLabel label i@ Layouts the label at the given incidence
+-- point.
+autoLabel :: Box -> Incidence -> Diagram ()
+autoLabel lab (Incidence pt norm) = do
+  pt `inside` lab
+  minimize =<< orthoDist (lab#Center) (pt + norm)
+
+-- | @labeledEdge label source target@
+labeledEdge :: Object -> Object -> Box -> Diagram ()
+labeledEdge source target lab = autoLabel lab =<< edge source target
+
+
+
+-------------------
+-- Even higher-level primitives:
+
+
+--example:      spread hdist 30 ps
+
+spread f d (x:y:xs) = do
+  f x y === d
+  spread f d (y:xs)
+spread f _ _ = return ()
+
+node lab = do
+  l <- extend 4 <$> texBox lab
+  c <- draw $ circleShape
+  l `fitsIn` c
+  l # Center .=. c # Center
+  return c
+
+arrow :: Object -> Object -> Diagram Incidence
+arrow src trg = using (outline "black" . set endTip LatexTip) $ do
+  edge src trg
+
diff --git a/MarXup/Diagram/Path.hs b/MarXup/Diagram/Path.hs
new file mode 100644
--- /dev/null
+++ b/MarXup/Diagram/Path.hs
@@ -0,0 +1,156 @@
+{-# LANGUAGE TypeSynonymInstances, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, RecursiveDo, TypeFamilies, OverloadedStrings, RecordWildCards,UndecidableInstances, PackageImports, TemplateHaskell #-}
+
+module MarXup.Diagram.Path where
+
+import MarXup.Diagram.Layout
+import MarXup.Diagram.Point
+import Data.Traversable
+import Data.Foldable
+import Data.Algebra
+-- import Data.Traversable
+-- import Data.Foldable
+import Graphics.Typography.Geometry.Bezier
+import Graphics.Typography.Geometry.Bezier as MarXup.Diagram.Point (Curve) 
+import Control.Applicative
+import Data.List (sort,transpose)
+import Data.Maybe (listToMaybe)
+import Prelude hiding (sum,mapM_,mapM,concatMap,maximum,minimum)
+import qualified Data.Vector.Unboxed as V
+import Algebra.Polynomials.Bernstein (restriction,Bernsteinp(..))
+
+type Frozen x = x Constant
+type FrozenPoint = Frozen Point'
+type FrozenPath = Frozen Path'
+
+freeze :: Traversable t => t Expr -> Diagram (t Constant)
+freeze = traverse valueOf
+
+unfreeze :: Functor t => t Constant -> t Expr
+unfreeze = fmap constant
+
+toBeziers :: FrozenPath -> [Curve]
+toBeziers EmptyPath = []
+toBeziers (Path start ss) | not (null ss) &&
+                            isCycle (last ss) = toBeziers' start (init ss ++ [StraightTo start])
+                          | otherwise = toBeziers' start ss
+
+curveSegment (Point xa ya) (Point xb yb) (Point xc yc) (Point xd yd) = bezier3 xa ya xb yb xc yc xd yd
+lineSegment (Point xa ya) (Point xb yb) = line xa ya xb yb
+
+toBeziers' :: FrozenPoint -> [Frozen Segment] -> [Curve]
+toBeziers' _ [] = []
+toBeziers' start (StraightTo next:ss) = curveSegment start mid mid next : toBeziers' next ss
+  where mid = avg [start, next]
+toBeziers' p (CurveTo c d q:ss) = curveSegment p c d q : toBeziers' q ss
+
+fromBeziers :: [Curve] -> FrozenPath
+fromBeziers [] = EmptyPath
+fromBeziers (Bezier cx cy t0 t1:bs) = case map toPt $ V.foldr (:) [] cxy of
+      [p,c,d,q] -> Path p (CurveTo c d q:rest)
+      [p,q] -> Path p (StraightTo q:rest)
+  where [cx',cy'] = map (\c -> coefs $ restriction c t0 t1) [cx,cy]
+        cxy = V.zip cx' cy'
+        toPt (x,y) = Point x y
+        rest = pathSegments (fromBeziers bs)
+
+pathSegments :: Path' t -> [Segment t]
+pathSegments EmptyPath = []
+pathSegments (Path _ ss) = ss
+
+isCycle Cycle = True
+isCycle _  = False
+
+frozenPointElim (Point x y) f = f x y
+
+splitBezier (Bezier cx cy t0 t1) (u,v,_,_) = (Bezier cx cy t0 u, Bezier cx cy v t1)
+
+clipOne :: Curve -> [Curve] -> Maybe Curve
+clipOne b cutter = fmap firstPart $ listToMaybe $ sort $ concatMap (inter b) cutter
+  where firstPart t = fst $ splitBezier b t
+
+-- | @cutAfter path area@ cuts the path after its first intersection with the @area@.
+cutAfter', cutBefore' :: [Curve] -> [Curve] -> [Curve]
+cutAfter' [] _cutter = []
+cutAfter' (b:bs) cutter = case clipOne b cutter of
+  Nothing -> b:cutAfter' bs cutter
+  Just b' -> [b']
+
+revBernstein (Bernsteinp n c) = Bernsteinp n (V.reverse c)
+revBeziers :: [Curve] -> [Curve]
+revBeziers = reverse . map rev
+  where rev (Bezier cx cy t0 t1) = (Bezier (revBernstein cx) (revBernstein cy) (1-t1) (1-t0))
+
+cutBefore' path area = revBeziers $ cutAfter' (revBeziers path) area
+
+onBeziers :: ([Curve] -> [Curve] -> [Curve])
+             -> FrozenPath -> FrozenPath -> FrozenPath
+onBeziers op p' q' = fromBeziers $ op (toBeziers p') (toBeziers q')
+
+
+cutAfter :: FrozenPath -> FrozenPath -> FrozenPath
+cutAfter = onBeziers cutAfter'
+
+cutBefore :: FrozenPath -> FrozenPath -> FrozenPath
+cutBefore = onBeziers cutBefore'
+
+data Segment v = CurveTo (Point' v) (Point' v) (Point' v)
+                   | StraightTo (Point' v)
+                   | Cycle
+                   -- | Rounded (Maybe Constant)
+                   -- | HV point | VH point
+  deriving (Show,Eq)
+instance Functor Segment where
+  fmap = fmapDefault
+  
+instance Foldable Segment where
+  foldMap = foldMapDefault
+instance Traversable Segment where
+  traverse _ Cycle = pure Cycle
+  traverse f (StraightTo p) = StraightTo <$> traverse f p
+  traverse f (CurveTo c d q) = CurveTo <$> traverse f c <*> traverse f d <*> traverse f q
+  
+
+-----------------
+-- Paths
+
+type Path = Path' Expr
+
+data Path' a
+  = EmptyPath
+  | Path {startingPoint :: Point' a
+         ,segments :: [Segment a]}
+  deriving Show
+
+-- mapPoints :: (Point' a -> Point' b) -> Path' a -> Path' b
+instance Functor Path' where
+  fmap = fmapDefault
+
+instance Foldable Path' where
+  foldMap = foldMapDefault
+instance Traversable Path' where
+  traverse _ EmptyPath = pure EmptyPath
+  traverse f (Path s ss) = Path <$> traverse f s <*> traverse (traverse f) ss
+
+
+polyline :: [Point] -> Path
+polyline [] = EmptyPath
+polyline (x:xs) = Path x (map StraightTo xs)
+
+polygon :: [Point] -> Path
+polygon [] = EmptyPath
+polygon (x:xs) = Path x (map StraightTo xs ++ [Cycle])
+
+
+-- | Circle approximated with 4 cubic bezier curves
+circle :: Point -> Expr -> Path
+circle center r =      Path (pt r 0)
+                         [CurveTo (pt r k) (pt k r) (pt 0 r),
+                          CurveTo (pt (-k) r) (pt (-r) k) (pt (-r) 0),
+                          CurveTo (pt (-r) (-k)) (pt (-k) (-r)) (pt 0 (-r)),
+                          CurveTo (pt k (-r)) (pt r (-k)) (pt r 0),
+                          Cycle]
+ where k1 :: Constant
+       k1 = 4 * (sqrt 2 - 1) / 3
+       k = k1 *^ r
+       pt x y = center ^+^ (Point x y)
+
diff --git a/MarXup/Diagram/Point.hs b/MarXup/Diagram/Point.hs
new file mode 100644
--- /dev/null
+++ b/MarXup/Diagram/Point.hs
@@ -0,0 +1,96 @@
+{-# LANGUAGE TypeSynonymInstances, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, RecursiveDo, TypeFamilies, OverloadedStrings, RecordWildCards,UndecidableInstances, PackageImports, TemplateHaskell #-}
+
+module MarXup.Diagram.Point where
+
+import MarXup.Diagram.Layout
+import Data.Traversable
+import Data.Foldable
+import Data.Algebra
+import Control.Applicative
+import Data.List (transpose)
+import Prelude hiding (sum,mapM_,mapM,concatMap,maximum,minimum)
+
+infix 4 .=.
+----------------
+-- Points 
+-- | A point in 2d space
+data Point' a = Point {xpart :: a, ypart :: a}
+  deriving (Eq,Show)
+
+instance Traversable Point' where
+  traverse f (Point x y) = Point <$> f x <*> f y
+
+instance Foldable Point' where
+  foldMap = foldMapDefault
+
+instance Functor Point' where
+  fmap = fmapDefault
+
+  
+type Point = Point' Expr
+instance Group a => Num (Point' a) where
+  negate = neg
+  (+) = (^+^)
+  (-) = (^-^)
+
+instance Group v => Group (Point' v) where
+  zero = Point zero zero
+  Point x1 y1 ^+^ Point x2 y2 = Point (x1 ^+^ x2) (y1 ^+^ y2)
+  neg (Point x y) = Point (neg x) (neg y)
+
+instance Module Constant v => Module Constant (Point' v) where
+  k *^ Point x y = Point (k *^ x) (k *^ y)
+
+-- | Orthogonal norm of a vector
+orthonorm :: Point -> Diagram Expr
+orthonorm (Point x y) =
+  (+) <$> absoluteValue x <*> absoluteValue y
+
+-- | Orthogonal distance between points.
+orthoDist :: Point -> Point -> Diagram Expr
+orthoDist p q = orthonorm (q-p)
+
+-- | Rotate a vector 90 degres in the trigonometric direction.
+rotate90, rotate180 :: Point -> Point
+rotate90 (Point x y) = Point (negate y) x
+
+rotate180 = rotate90 . rotate90
+
+xdiff,ydiff :: Point -> Point -> Expr
+xdiff p q = xpart (q - p)
+ydiff p q = ypart (q - p)
+
+-----------------
+-- Point constraints
+
+(.=.),northOf,southOf,westOf,eastOf :: Point -> Point -> Diagram ()
+Point x1 y1 .=. Point x2 y2 = do
+  x1 === x2
+  y1 === y2
+
+northOf (Point _ y1) (Point _ y2) = y2 <== y1
+southOf = flip northOf
+westOf (Point x1 _) (Point x2 _) = x1 <== x2
+eastOf = flip westOf
+
+alignHoriz,alignVert :: [Point] -> Diagram ()
+alignHoriz = align ypart
+alignVert = align xpart
+
+align :: (a -> Expr) -> [a] -> Diagram ()
+align _ [] = return ()
+align f (p:ps) = forM_ ps $ \p' -> f p === f p'
+
+alignMatrix :: [[Point]] -> Dia
+alignMatrix ls = do
+  forM_ ls alignHoriz
+  forM_ (transpose ls) alignVert
+
+---------------------
+-- Point objectives
+
+southwards, northwards, westwards, eastwards :: Point -> Diagram ()
+southwards (Point _ y) = minimize y
+westwards (Point x _) = minimize x
+northwards = southwards . negate
+eastwards = westwards . negate
diff --git a/MarXup/Diagram/Tikz.hs b/MarXup/Diagram/Tikz.hs
new file mode 100644
--- /dev/null
+++ b/MarXup/Diagram/Tikz.hs
@@ -0,0 +1,172 @@
+{-# LANGUAGE TypeSynonymInstances, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, RecursiveDo, TypeFamilies, OverloadedStrings, RecordWildCards,UndecidableInstances, PackageImports, TemplateHaskell #-}
+
+module MarXup.Diagram.Tikz where
+
+import MarXup.Diagram.Layout
+import MarXup.Diagram.Point
+import MarXup.Diagram.Path
+import Control.Lens hiding (element)
+import Prelude hiding (sum,mapM_,mapM,concatMap)
+import Control.Applicative
+import Data.List (intercalate)
+import Data.String
+import MarXup
+import MarXup.MultiRef
+import MarXup.Tex
+import Numeric (showFFloat)
+import Data.Traversable
+import Data.Foldable
+import Data.Monoid
+import Control.Monad.Reader
+
+instance Element Expr where
+  type Target Expr = Dia
+  element x = do
+    v <- valueOf x
+    diaRaw $ showDistance v
+
+instance Element (Diagram ()) where
+  type Target (Diagram ()) = TeX
+  element d = do
+   texLn "" -- otherwise beamer does not understand where a tikzpicture ends (?!!)
+   braces $ do
+    cmd0 "normalsize"
+      -- otherwise the boxes use "normalsize", while tikz inherits
+      -- the smaller or bigger size from the current scope. Actually,
+      -- every text styling should be reset, but I don't know how to
+      -- do that.
+    env "tikzpicture" $
+      Tex $ runDiagram d
+
+--------------------
+-- Point rendering
+instance Element Point where
+  type Target Point = Diagram ()
+  element (Point x y) = "(" <> element x <> "," <> element y <> ")"
+
+diaDebug msg = diaRaw $ "\n%DBG:" ++ msg ++ "\n"
+
+instance (Element (Point' v),Monoid (Target (Point' v)), IsString (Target (Point' v))) => Element (Segment v) where
+  type Target (Segment v) = Target (Point' v)
+  element (StraightTo p) = "--" <> element p
+  element (CurveTo c d p) = "..controls" <> element c <> "and" <> element d <> ".." <> element p
+  element Cycle = "--cycle"
+  -- element (VH p) = "|-" <> element p
+  -- element (HV p) = "-|" <> element p
+  -- element (Rounded Nothing) = "[sharp corners]"
+  -- element (Rounded (Just r)) = "[" <> element (constant r) <> "]"
+
+instance Element Path where
+  type Target Path = Diagram ()
+  element = path
+
+path :: Path -> Dia
+path = frozenPath <=< freeze
+
+frozenPath :: FrozenPath  -> Dia
+frozenPath p  = do
+  options <- view diaPathOptions
+  diaRaw $ "\\path"
+    <> element options
+    <> case p of
+      EmptyPath -> ""
+      (Path start segs) -> element start ++ concatMap element segs
+  diaRaw ";\n"
+
+
+showDistance :: Constant -> String
+showDistance x = showFFloat (Just 4) x tikzUnit
+    where tikzUnit = "pt"
+
+instance Element FrozenPoint where
+  type Target FrozenPoint = String
+  element pt = frozenPointElim pt $ \x y -> "(" <> showDistance x <> "," <> showDistance y <> ")"
+
+
+-----------------
+-- Path Options
+
+localPathOptions :: (PathOptions -> PathOptions) -> Diagram a -> Diagram a
+localPathOptions f = local (over diaPathOptions f)
+
+instance Show LineTip where
+  show t = case t of
+    ToTip -> "to"
+    StealthTip -> "stealth"
+    CircleTip -> "o"
+    NoTip -> ""
+    LatexTip -> "latex"
+    ReversedTip x -> show x ++ " reversed"
+    BracketTip -> "["
+    ParensTip -> "("
+
+
+ultraThin, veryThin, thin, semiThick, thick, veryThick, ultraThick :: Constant
+ultraThin = 0.1
+veryThin = 0.2
+thin = 0.4
+semiThick = 0.6
+thick = 0.8
+veryThick = 1.2
+ultraThick = 1.6
+
+
+showDashPat :: DashPattern -> String
+showDashPat xs = intercalate " " ["on " <> showDistance on <>
+                                  " off " <> showDistance off | (on,off) <- xs]
+
+solid             o@PathOptions{..} = o { _dashPattern = [] }
+dotted            o@PathOptions{..} = o { _dashPattern = [(_lineWidth,2)] }
+denselyDotted     o@PathOptions{..} = o { _dashPattern = [(_lineWidth, 1)] }
+looselyDotted     o@PathOptions{..} = o { _dashPattern = [(_lineWidth, 4)] }
+dashed            o@PathOptions{..} = o { _dashPattern = [(3, 3)] }
+denselyDashed     o@PathOptions{..} = o { _dashPattern = [(3, 2)] }
+looselyDashed     o@PathOptions{..} = o { _dashPattern = [(3, 6)] }
+dashdotted        o@PathOptions{..} = o { _dashPattern = [(3, 2), (_lineWidth, 2)] }
+denselyDashdotted o@PathOptions{..} = o { _dashPattern = [(3, 1), (_lineWidth, 1)] }
+looselyDashdotted o@PathOptions{..} = o { _dashPattern = [(3, 4), (_lineWidth, 4)] }
+
+using = localPathOptions
+stroke color = using (outline color)
+draw = stroke "black"
+
+noOutline = set drawColor Nothing
+outline color = set drawColor (Just color)
+fill color = set fillColor (Just color)
+
+zigzagDecoration = set decoration (Decoration "zigzag")
+
+instance Element PathOptions where
+  type Target PathOptions = String
+  element PathOptions{..} = "["
+    <> show _startTip <> "-" <> show _endTip <> ","
+    <> col "draw" _drawColor
+    <> col "fill" _fillColor
+    <> "line width=" <> showDistance _lineWidth <> ","
+    <> "line cap=" <> (case _lineCap of
+                          RoundCap -> "round"
+                          RectCap -> "rect"
+                          ButtCap -> "butt") <> ","
+    <> "line join=" <> (case _lineJoin of
+                          RoundJoin -> "round"
+                          BevelJoin -> "bevel"
+                          MiterJoin -> "miter") <> ","
+    <> "dash pattern=" <> showDashPat _dashPattern
+    <> (case _decoration of
+           Decoration [] -> ""
+           Decoration d -> ",decorate,decoration=" ++ d)
+    <> "]"
+    where col attr = maybe "" (\c -> attr <> "=" <> c <> ",")
+
+----------
+-- Text
+
+drawText :: Point -> TeX -> Diagram BoxSpec
+drawText point t = do
+  diaRawTex $ tex $ "\\node[anchor=north west,inner sep=0] at "
+  element point
+  (_,box) <- diaRawTex $ inBox $ braces $ t
+  diaRawTex $ tex ";\n"
+  return box
+
+
diff --git a/MarXup/Latex.hs b/MarXup/Latex.hs
--- a/MarXup/Latex.hs
+++ b/MarXup/Latex.hs
@@ -1,23 +1,80 @@
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings, RecordWildCards #-}
 module MarXup.Latex where
 
-import Control.Applicative
+import MarXup
+import MarXup.Verbatim
+import Control.Monad (forM_)
 import MarXup.Tex
-import MarXup.MetaPost
-import Data.List (intersperse)
+import Data.List (intersperse,groupBy,elemIndex,nub)
 import Data.Monoid
+import Control.Applicative
+import Data.Function (on)
 
--- Separate the arguments with '\\'
-mkrows :: [TeX] -> TeX
-mkrows ls = sequence_ $ intersperse newline ls 
 
--- Separate the arguments with '&'
+-- | Separate the arguments with '\\'
+mkrows,mkcols :: [TeX] -> TeX
+mkrows ls = sequence_ $ intersperse newline ls
+
+-- | Separate the arguments with '&'
 mkcols = sequence_ . intersperse newcol
 
-vspace = cmd "vspace"
-hspace = cmd "hspace"
+vspace, hspace :: String -> TeX
+vspace = cmd "vspace" . textual
+hspace = cmd "hspace" . textual
+hfill = cmd0 "hfill"
+
+title :: TeX -> TeX
 title = cmd "title"
 
+
+data ClassFile = Plain | LNCS | SIGPlan | IEEE | EPTCS | Beamer
+  deriving Eq
+type AuthorInfoStyle = ClassFile
+
+data AuthorInfo = AuthorInfo {authorName :: String, authorEmail :: String, authorInst :: String}
+
+-- | author info in as triplets name, institution, email
+authorinfo :: AuthorInfoStyle -> [AuthorInfo] -> TeX
+authorinfo LNCS as = do
+  cmd "author" $ mconcat $ intersperse (cmd0 "and") $ map oneauthor as
+  cmd "institute" $ mconcat $ intersperse (cmd0 "and") $ map textual $ insts
+  where oneauthor AuthorInfo{..} = textual authorName <> (if length insts > 1 then cmd "inst" (textual $ show $ 1 + instIdx) else mempty)
+           where Just instIdx = elemIndex authorInst insts
+        insts = nub $ map authorInst as
+
+authorinfo SIGPlan as = forM_ (groupBy ((==) `on` authorInst) as) $ \ (g@((AuthorInfo _ _ institution):_)) -> do
+    let names = map authorName g
+        emails = mconcat $ intersperse (cmd0 "and") $ map (textual . authorEmail) g
+    cmdn "authorinfo" [mconcat $ intersperse (cmd0 "and") $ map textual names, textual institution, emails]
+    return ()
+authorinfo EPTCS as = mconcat $ intersperse and' $
+  flip map (groupBy ((==) `on` authorInst) as) $ \ (g@((AuthorInfo _ _ institution):_)) -> do
+    cmd "author" $ do
+      mconcat $ intersperse dquad $ map (textual . authorName) g
+      cmd "institute" $ textual institution
+      cmd "email" $ mconcat $ intersperse dquad $ map (textual . authorEmail) g
+    return ()
+  where dquad = cmd0 "quad" <> cmd0 "quad"
+        and' = cmd0 "and"
+authorinfo IEEE as = cmd "author" $ do
+  cmd "IEEEauthorblockN" $ mconcat $ intersperse (hspace "1cm") $ map (textual . authorName) as
+  tex "\n\n" -- for some reason the IEEE class wants a paragraph separation here.
+  cmd "IEEEauthorblockA" $ mkrows $ [textual inst,"email: " <> textual (mconcat $ intersperse " " $ map authorEmail as)]
+  where (AuthorInfo {authorInst = inst}:_) = as
+authorinfo _ {- Plain, EPTCS, Beamer -} as = cmd "author" $ mconcat $ intersperse (cmd0 "and") $ map oneauthor as
+  where oneauthor (AuthorInfo name _ institution) = textual name <> newline <> textual institution
+
+keywords :: ClassFile -> [String] -> TeX
+keywords LNCS ks = do
+  cmd "keywords" $ mconcat $ intersperse ", " $ map textual ks
+keywords IEEE ks = env "IEEEkeywords" $ do
+  mconcat $ intersperse ", " $ map textual ks
+keywords SIGPlan ks = do
+  cmd0 "keywords"
+  mconcat $ intersperse ", " $ map textual ks
+keywords _ _ = return ()
+
+
 newline = backslash <> backslash
 newcol = tex "&"
 newpara = texLines ["",""]
@@ -25,114 +82,154 @@
 maketitle :: Tex ()
 maketitle = cmd "maketitle" $ return ()
 
+ldots :: TeX
 ldots = cmd "ldots" (return ())
 
-section s = 
-  do cmd "section" s
-     label
-
-subsection s = 
-  do cmd "subsection" s
-     label
+-- | Sectioning
+section,subsection,paragraph :: TeX -> Tex SortedLabel
+section s = cmd "section" s >> label "Sec."
+subsection s = cmd "subsection" s >> label "Sec."
+subsubsection s = cmd "subsubsection" s >> label "Sec."
+paragraph s = cmd "paragraph" s >> label "Sec."
 
 color :: String -> Tex a -> Tex a
-color col bod = do 
+color col bod = do
   [_,x] <- cmdn' "textcolor" [] [tex col >> return undefined, bod]
   return x
 
 ----------------
 -- Preamble stuff
 
-usepackage opts name = cmd' "usepackage" opts (Tex name)
 
-stdPreamble = do 
-  usepackage [] "graphicx"
-  usepackage ["mathletters"] "ucs"
-  usepackage ["utf8x"] "inputenc"
+usepackage :: String -> [String] -> Tex ()
+usepackage name opts  = cmd' "usepackage" opts (tex name)
+
+stdPreamble :: TeX
+stdPreamble = do
+  usepackage "graphicx" []
+  usepackage "inputenc" ["utf8"]
   return ()
 
-latexDocument :: String -> [String] -> Tex a -> Tex a -> Tex ()
-latexDocument docClass options pre body = do
-   preamble
-   Metapost $ metaPostPreamble preamble
-   env "document" body
-   Metapost $ metaPostEpilogue
- where 
-   preamble = do
-     cmd' "documentclass" options (Tex docClass)
-     pre
+documentClass :: String -> [String] -> TeX
+documentClass docClass options = cmd' "documentclass" options (tex docClass)
 
 ----------
 -- Lists
 
-item :: Tex a -> Tex a
-item x = cmdn' "item" [] [] >> x
+item = cmd0 "item"
+enumerate = env "enumerate"
+itemize = env "itemize"
 
-enumerate :: [Tex a] -> Tex [a]
-enumerate [] = return [] -- latex does not like empty lists.
-enumerate xs = env "enumerate" $ 
-    mapM item xs
+------------------------
+-- Various environments
 
+tabular :: [String] -> String -> [[TeX]] -> TeX
+tabular opts format bod = do
+  env' "tabular" opts $ do
+    braces (tex format)
+    mkrows (map mkcols bod)
+  return ()
+
+center ::  Tex a -> Tex a
+center = env "center"
+
+figure_ :: TeX -> TeX -> Tex SortedLabel
+figure_ caption body = env "figure*" $ do
+  body
+  cmd "caption" caption
+  label "Fig."
+
+figure :: TeX -> TeX -> Tex SortedLabel
+figure caption body = env "figure" $ do
+  body
+  cmd "caption" caption
+  label "Fig."
+
 ----------
 -- Fonts
 
-sf, em :: Tex a -> Tex a
-sf = cmd "textsf"
-em = cmd "emph"
+data TextSize = Tiny | ScriptSize | FootnoteSize | Small | NormalSize | Large | Larger | Largerr | Huge | Huger
 
-----------
--- Math
+textSize :: TextSize -> Tex a -> Tex a
+textSize sz x = braces (cmd0 latexSize >> x)
+  where latexSize = case sz of
+          Tiny -> "tiny"
+          ScriptSize -> "scriptsize"
+          FootnoteSize -> "footnotesize"
+          Small -> "small"
+          NormalSize -> "normalsize"
+          Large -> "large"
+          Larger -> "Large"
+          Largerr -> "LARGE"
+          Huge -> "huge"
+          Huger -> "Huge"
 
-align  = env "align*" . mkrows . map mkcols 
 
--- | A block
-block :: [TeX] -> TeX
-block  bod = do
-  cmdn' "begin" [] [tex "array", tex "l"]
-  mkrows $ bod
-  cmdn' "end" [] [tex "array"]
-  return ()
 
-math = cmd "ensuremath"
-mbox = cmd "mbox"
+bold,sans, emph, smallcaps :: Tex a -> Tex a
+sans = cmd "textsf"
+emph = cmd "emph"
+bold = cmd "textbf"
 
-displayMath body = Tex "\\[" *> body <* Tex "\\]"
+smallcaps x = braces (cmd0 "sc" >> x)
 
+italic :: Tex a -> Tex a
+italic = cmd "textit"
+
+teletype :: Tex a -> Tex a
+teletype = cmd "texttt"
+
+-------------------------
+-- Scaling and rotating
+
+scalebox :: Double -> Tex a -> Tex a
+scalebox factor x = do
+  cmd "scalebox" $ tex $ show factor
+  braces x
+
+-----------
+-- Parens
+qu :: TeX -> TeX
+qu x = tex "``" <> x <> tex "''"
+
+paren,brack,brac,bigBrac,bigParen :: Tex a -> Tex a
 paren = parenthesize (tex "(") (tex ")")
 brack = parenthesize (tex "[") (tex "]")
 brac = parenthesize (backslash >> tex "{") (backslash >> tex "}")
-bigBraces = bigParenthesize (backslash >> tex "{") (backslash >> tex "}")
+bigBrac = bigParenthesize (backslash >> tex "{") (backslash >> tex "}")
+bigParen = bigParenthesize (tex "(") (tex ")")
 
+parenthesize,bigParenthesize :: TeX -> TeX -> Tex a -> Tex a
 bigParenthesize l r bod = do
-  Tex "\\left" >> l
+  tex "\\left" >> l
   x <- bod
-  Tex "\\right" >> r
+  tex "\\right" >> r
   return x
-  
+
 parenthesize l r bod = do
   l
   x <- bod
   r
   return x
 
+inferrule' :: TeX -> [TeX] -> TeX -> TeX
+inferrule' name xs y = cmdm "inferrule" [name] [mkrows xs,y] >> return ()
 
-mathsf = cmd "mathsf"
+inferrule :: [TeX] -> TeX -> TeX
+inferrule xs y = cmdn "inferrule" [mkrows xs,y] >> return ()
 
-instance Fractional TeX where
-    a / b = cmdn_ "frac" [a,b]
+----------------------
+-- Listings
 
-instance Floating TeX where
-    pi = cmd "pi" nil
-    exp x = "e^" <> braces x
-    sqrt = cmd "sqrt"
+listing :: [String] -> Verbatim () -> TeX
+listing opt (Verbatim s _) =
+    env' "lstlisting" opt (tex s)
 
-instance Num TeX where
-  fromInteger x = text $ show x
-  (+) = binop $ text "+"
-  (-) = binop $ text "-"
-  (*) = binop $ text "*"
-  negate x = "-" <> x
+lstinline :: [String] -> Verbatim () -> TeX
+lstinline opt (Verbatim s _) =
+    let sep = tex "$"
+        opt' = tex $ mconcat . intersperse ", "
+               $ "basicstyle=\\ttfamily" :  opt in
+    backslash <> "lstinline" <> brackets opt' <> sep <> tex s <> sep
 
-binop :: TeX -> TeX -> TeX -> TeX
-binop op a b = a <> op <> b
 
diff --git a/MarXup/Latex/Bib.hs b/MarXup/Latex/Bib.hs
new file mode 100644
--- /dev/null
+++ b/MarXup/Latex/Bib.hs
@@ -0,0 +1,19 @@
+module MarXup.Latex.Bib where
+import MarXup.Tex 
+
+-------------
+-- Bib
+
+
+bibliographystyle :: String -> TeX
+bibliographystyle x = cmd "bibliographystyle" $ tex x
+
+bibliography :: String -> TeX
+bibliography x = do
+  texLn "" -- some tools can detect bibliography command only if it stands on its own line.
+  cmd "bibliography" $ tex x
+  texLn ""
+
+citet,citep :: String -> TeX
+[citet,citep] = map (\c -> cmd c . tex) ["citet","citep"]
+
diff --git a/MarXup/Latex/Math.hs b/MarXup/Latex/Math.hs
new file mode 100644
--- /dev/null
+++ b/MarXup/Latex/Math.hs
@@ -0,0 +1,97 @@
+{-# LANGUAGE OverloadedStrings #-}
+module MarXup.Latex.Math where
+import Control.Applicative
+import MarXup.Latex
+import MarXup.Tex
+import MarXup
+import Data.Monoid
+import Data.Ratio
+import Control.Monad (unless)
+
+align  = env "align*" . mkrows . map mkcols
+
+array :: [String] -> String -> [[TeX]] -> TeX
+array opts format bod = ensureMath $ do
+  env' "array" opts $ do
+    braces (tex format)
+    mkrows (map mkcols bod)
+  return ()
+
+-- | A block
+block :: [TeX] -> TeX
+block  bod = do
+  env "array" $ do
+    braces (tex "l")
+    mkrows $ bod
+  return ()
+
+displayMath,ensureMath,mbox :: Tex a -> Tex a
+ensureMath = cmd "ensuremath"
+mbox = cmd "mbox"
+fbox :: TeX -> TeX
+fbox = cmd "fbox"
+superscript y = tex "^" <> braces y
+subscript x = tex "_" <> braces x
+
+displayMath = env "displaymath"
+
+mathsf :: Tex a -> Tex a
+mathsf = cmd "mathsf"
+
+mathpreamble :: ClassFile -> TeX
+mathpreamble sty = do
+  usepackage "graphicx" []
+  usepackage "amsmath"  []
+  unless (sty == LNCS) $ usepackage "amsthm"   []
+  usepackage "amssymb"  []   -- extra symbols such as □
+  usepackage "stmaryrd" [] -- has ⟦ and ⟧
+  usepackage "mathpartir" [] -- mathpar environment
+
+  unless (sty == LNCS || sty == Beamer) $ do
+    newtheorem "theorem" "Theorem"
+    newtheorem "corollary" "Corollary"
+    newtheorem "lemma" "Lemma"
+    newtheorem "definition" "Definition"
+    newtheorem "proposition" "Proposition"
+
+mathpar :: [[TeX]] -> TeX
+mathpar = env "mathpar" . mkrows . map mk . filter (not . null)
+ where mk = foldr1 (\x y -> x <> cmd0 "and" <> y)
+
+mathbox = mbox . ensureMath
+
+newtheorem :: String -> TeX -> TeX
+newtheorem ident txt = cmd "newtheorem" (tex ident) >> braces txt
+
+deflike :: String -> String -> TeX -> TeX -> Tex SortedLabel
+deflike reference nv name statement = env'' nv [] [name] $ do
+  statement
+  label reference
+
+thmlike :: String -> String -> TeX -> TeX -> TeX -> Tex SortedLabel
+thmlike reference nv name statement proof = do
+  x <- deflike reference nv name statement
+  env "proof" proof
+  return x
+
+theorem,lemma ::  TeX -> TeX -> TeX -> Tex SortedLabel
+theorem = thmlike "Thm." "theorem"
+lemma = thmlike "Lem." "lemma"
+
+definition,corollary :: TeX -> TeX -> Tex SortedLabel
+definition = deflike "Def." "definition"
+corollary = deflike "Cor." "corollary"
+proposition = deflike "Prop." "proposition"
+example = deflike "Ex." "example"
+
+-- Other stuff
+oxford :: Tex a -> Tex a
+oxford = bigParenthesize (textual "⟦") (textual "⟧")
+
+multiline' body = env "multline*" $ mkrows body
+
+frac x y = cmdn_ "frac" [x,y]
+
+centerVertically = ensureMath . cmd "vcenter" . cmd "hbox"
+
+qedhere = cmd0 "qedhere"
diff --git a/MarXup/Math.hs b/MarXup/Math.hs
new file mode 100644
--- /dev/null
+++ b/MarXup/Math.hs
@@ -0,0 +1,99 @@
+{-# LANGUAGE OverloadedStrings, TypeFamilies #-}
+module MarXup.Math where
+
+import Control.Applicative
+import MarXup.Latex
+import MarXup.Latex.Math
+import MarXup.Tex
+import MarXup
+import Data.Monoid
+import Data.Ratio
+import Data.String
+import Control.Monad (unless)
+
+instance Element Math where
+  type Target Math = TeX
+  element = inline
+
+instance IsString Math where
+  fromString = Con . fromString
+
+inline x = " " <> (cmd "ensuremath" . mRender 0 $ x) <> " "
+-- display = cmd "displaymath" . mRender 0
+display x = tex "$$" <> mRender 0 x <> tex "$$"
+
+text :: TeX -> Math
+text = Con . cmd "text"
+
+-- type MathShallow = Int -> Tex
+
+data Math = BinOp Int (TeX -> TeX -> TeX) Int Int Math Math
+          | UnOp Int (TeX -> TeX) Int Math
+          | Con TeX
+          | Math (Int -> TeX)
+          | Invisible (TeX -> TeX) Math
+
+parp p p' = if p' < p then bigParen else id
+
+mRender :: Int -> Math -> TeX
+mRender _ (Con x) = x
+mRender p (Math x) = x p
+mRender p (BinOp p' f pl pr l r) = parp p p' $ f (mRender pl l) (mRender pr r)
+mRender p (UnOp p' f px x) = parp p p' $ f (mRender px x)
+mRender p (Invisible f x) = f $ mRender p x
+
+ternaryOp :: Int -> (TeX -> TeX -> TeX -> TeX) -> Int -> Int -> Int -> Math -> Math -> Math -> Math
+ternaryOp p' f px py pz x y z = Math $ \p -> parp p p' $ f (mRender px x)(mRender py y)(mRender pz z)
+  
+binop :: Int -> TeX -> Math -> Math -> Math
+binop prec op = BinOp prec (\x y -> x <> op <> y) prec prec
+preop prec op = UnOp prec (\x -> x <> op) prec
+outop left right = UnOp 100 (parenthesize left right) 0
+fct x = UnOp 6 (x <>) 7
+
+--------------
+-- Operators
+
+(=:) = binop 0 "="
+
+instance Num Math where
+  (+) = binop 1 "+"
+  (-) = binop 1 "-"
+  (*) = binop 2 ""
+  abs = outop (cmd0 "mid") (cmd0 "mid")
+  signum = preop 10 $ cmd0 "delta"
+  fromInteger x = Con $ textual $ show x
+  negate = preop 1  "-"
+
+instance Fractional Math where
+    (/) = BinOp 10 (\a b -> cmdn_ "frac" [a,b]) 0 0
+    fromRational r = fromInteger (numerator r) / fromInteger (denominator r)
+
+instance Floating Math where
+    pi = Con $ cmd0 "pi"
+    exp = UnOp 20 (\x -> tex "e^" <> braces x) 0
+    sqrt = UnOp 10 (cmd "sqrt") 0
+    log = fct (cmd "mathnormal" "log")
+    sin = fct (cmd "mathnormal" "sin")
+    cos = fct (cmd "mathnormal" "cos")
+    asin = fct (cmd "mathnormal" "asin")
+    acos = fct (cmd "mathnormal" "acos")
+    atan = fct (cmd "mathnormal" "atan")
+    sinh = fct (cmd "mathnormal" "sinh")
+    cosh = fct (cmd "mathnormal" "cosh")
+    asinh = fct (cmd "mathnormal" "asinh")
+    acosh = fct (cmd "mathnormal" "acosh")
+    atanh = fct (cmd "mathnormal" "atanh")
+    (**) = (^^^) 
+
+ceiling, floor :: Math -> Math
+ceiling = outop "⌈" "⌉"
+floor = outop "⌊" "⌋"
+
+
+
+
+(^^^) = BinOp 5 (\x y -> braces x <> superscript y) 5 6
+($$$) = BinOp 5 (\x y -> braces x <> subscript y) 5 6
+
+
diff --git a/MarXup/MetaPost.hs b/MarXup/MetaPost.hs
deleted file mode 100644
--- a/MarXup/MetaPost.hs
+++ /dev/null
@@ -1,27 +0,0 @@
-
-module MarXup.MetaPost where
-
-import MarXup.Tex
-
-  
-metaPostPreamble :: Tex a -> Tex ()
-metaPostPreamble texPreamble =  do
-  texLines ["outputtemplate := \"%j-%c.mps\";",
-            "input drv;",
-            "verbatimtex %&latex",
-            ""]
-  texPreamble
-  texLines ["",
-            "\\begin{document}",
-            "etex;",
-            "prologues:=3;"]  
-  
-metaPostEpilogue = texLn "end"
-    
-
-metapostFigure :: Label -> Tex a -> Tex ()
-metapostFigure lab t = Metapost $ do
-  Tex "beginfig(" >> Refer lab >> Tex ")\n"
-  t
-  texLn "endfig;"
-
diff --git a/MarXup/MultiRef.hs b/MarXup/MultiRef.hs
new file mode 100644
--- /dev/null
+++ b/MarXup/MultiRef.hs
@@ -0,0 +1,50 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving, GADTs, PackageImports #-}
+
+module MarXup.MultiRef where
+
+import Control.Monad.Fix
+import "mtl" Control.Monad.RWS.Lazy
+import Control.Applicative
+import Control.Arrow (first)
+
+newtype Multi a = Multi {fromMulti :: RWS InterpretMode String (References,[BoxSpec]) a }
+  deriving (Functor, Monad, Applicative, MonadWriter String, MonadState (References,[BoxSpec]), MonadFix, MonadReader InterpretMode)
+
+-----------------------------------
+-- Basic datatype and semantics
+type Label = Int
+
+-- | Size of a box, in points. boxDepth is how far the baseline is
+-- from the bottom. boxHeight is how far the baseline is from the top.
+-- (These are TeX meanings)
+data BoxSpec = BoxSpec {boxWidth, boxHeight, boxDepth :: Double}
+             deriving (Show)
+
+nilBoxSpec :: BoxSpec
+nilBoxSpec = BoxSpec 0 0 0
+
+raw :: String -> Multi ()
+raw s = tell s
+
+getBoxSpec :: Multi BoxSpec
+getBoxSpec = do
+  (refs,bs) <- get
+  case bs of
+    [] -> error "display: ran out of boxes!"
+    (b:bs') -> do
+      put (refs,bs')
+      return b
+ 
+
+
+-- Reference management
+newLabel :: Multi Label -- create a new label
+newLabel = do x <- fst <$> get;  modify (first (+1)); return x
+
+type References = Int -- how many labels have been allocated
+emptyRefs :: References
+emptyRefs = 0
+
+type Mode = InterpretMode -> Bool
+data InterpretMode = OutsideBox | InsideBox | Regular deriving Eq
+
diff --git a/MarXup/PrettyPrint.hs b/MarXup/PrettyPrint.hs
new file mode 100644
--- /dev/null
+++ b/MarXup/PrettyPrint.hs
@@ -0,0 +1,442 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module MarXup.PrettyPrint where
+
+import Control.Applicative
+import Data.Monoid
+-- import MarXup.Latex ()
+import MarXup.Tex
+-- import MarXup.MultiRef (BoxSpec(..))
+
+import MarXup.PrettyPrint.Core
+import MarXup.PrettyPrint.Core as MarXup.PrettyPrint
+
+type Docu = Tex Doc
+
+text :: TeX -> Tex Doc
+text body = do
+  b <- justBox body
+  return $ Text $ TeX body b
+
+infixr 5 </>,<//>,<$$$>,<$$>
+infixr 6 <+>
+
+-- -- | The document @(list xs)@ comma separates the documents @xs@ and
+-- -- encloses them in square brackets. The documents are rendered
+-- -- horizontally if that fits the page. Otherwise they are aligned
+-- -- vertically. All comma separators are put in front of the elements.
+list :: [Doc] -> Tex Doc
+list            = enclosure "[" "]" ","
+
+-- -- | The document @(tupled xs)@ comma separates the documents @xs@ and
+-- -- encloses them in parenthesis. The documents are rendered
+-- -- horizontally if that fits the page. Otherwise they are aligned
+-- -- vertically. All comma separators are put in front of the elements.
+-- tupled :: [Doc] -> Doc
+-- tupled          = enclosure lparen   rparen  comma
+
+
+-- -- | The document @(semiBraces xs)@ separates the documents @xs@ with
+-- -- semi colons and encloses them in braces. The documents are rendered
+-- -- horizontally if that fits the page. Otherwise they are aligned
+-- -- vertically. All semi colons are put in front of the elements.
+-- semiBraces :: [Doc] -> Doc
+-- semiBraces      = enclosure lbrace   rbrace  semi
+
+-- | The document @(enclosure l r sep xs)@ concatenates the documents
+-- @xs@ separated by @sep@ and encloses the resulting document by @l@
+-- and @r@. The documents are rendered horizontally if that fits the
+-- page. Otherwise they are aligned vertically. All separators are put
+-- in front of the elements. For example, the combinator 'list' can be
+-- defined with @enclosure@:
+--
+-- > list xs = enclosure lbracket rbracket comma xs
+-- > test    = text "list" <+> (list (map int [10,200,3000]))
+--
+-- Which is layed out with a page width of 20 as:
+--
+-- @
+-- list [10,200,3000]
+-- @
+--
+-- But when the page width is 15, it is layed out as:
+--
+-- @
+-- list [10
+--      ,200
+--      ,3000]
+-- @
+encloseSep :: Doc -> Doc -> Doc -> [Doc] -> Doc
+encloseSep left right sep ds
+    = case ds of
+        []  -> left <> right
+        [d] -> left <> d <> right
+        _   -> align (cat (zipWith (<>) (left : repeat sep) ds) <> right)
+
+
+enclosure :: TeX -> TeX -> TeX -> [Doc] -> Tex Doc
+enclosure left right separ ds = do
+  l <- text left
+  r <- text right
+  s <- text separ
+  return $ encloseSep l r s ds
+
+-----------------------------------------------------------
+-- punctuate p [d1,d2,...,dn] => [d1 <> p,d2 <> p, ... ,dn]
+-----------------------------------------------------------
+
+
+-- | @(punctuate p xs)@ concatenates all documents in @xs@ with
+-- document @p@ except for the last document.
+--
+-- > someText = map text ["words","in","a","tuple"]
+-- > test     = parens (align (cat (punctuate comma someText)))
+--
+-- This is layed out on a page width of 20 as:
+--
+-- @
+-- (words,in,a,tuple)
+-- @
+--
+-- But when the page width is 15, it is layed out as:
+--
+-- @
+-- (words,
+--  in,
+--  a,
+--  tuple)
+-- @
+--
+-- (If you want put the commas in front of their elements instead of
+-- at the end, you should use 'tupled' or, in general, 'encloseSep'.)
+punctuate :: Doc -> [Doc] -> [Doc]
+punctuate p []      = []
+punctuate p [d]     = [d]
+punctuate p (d:ds)  = (d <> p) : punctuate p ds
+
+
+-----------------------------------------------------------
+-- high-level combinators
+-----------------------------------------------------------
+
+
+-- | The document @(sep xs)@ concatenates all documents @xs@ either
+-- horizontally with @(\<+\>)@, if it fits the page, or vertically with
+-- @(\<$\>)@.
+--
+-- > sep xs  = group (vsep xs)
+sep :: [Doc] -> Doc
+sep             = group . vsep
+
+-- | The document @(fillSep xs)@ concatenates documents @xs@
+-- horizontally with @(\<+\>)@ as long as its fits the page, than
+-- inserts a @line@ and continues doing that for all documents in
+-- @xs@.
+--
+-- > fillSep xs  = foldr (\<\/\>) empty xs
+fillSep :: [Doc] -> Doc
+fillSep         = foldDoc (</>)
+
+-- | The document @(hsep xs)@ concatenates all documents @xs@
+-- horizontally with @(\<+\>)@.
+hsep :: [Doc] -> Doc
+hsep            = foldDoc (<+>)
+
+
+-- | The document @(vsep xs)@ concatenates all documents @xs@
+-- vertically with @(\<$\>)@. If a 'group' undoes the line breaks
+-- inserted by @vsep@, all documents are separated with a space.
+--
+-- > someText = map text (words ("text to lay out"))
+-- >
+-- > test     = text "some" <+> vsep someText
+--
+-- This is layed out as:
+--
+-- @
+-- some text
+-- to
+-- lay
+-- out
+-- @
+--
+-- The 'align' combinator can be used to align the documents under
+-- their first element
+--
+-- > test     = text "some" <+> align (vsep someText)
+--
+-- Which is printed as:
+--
+-- @
+-- some text
+--      to
+--      lay
+--      out
+-- @
+vsep :: [Doc] -> Doc
+vsep            = foldDoc (<$$$>)
+
+-- | The document @(cat xs)@ concatenates all documents @xs@ either
+-- horizontally with @(\<\>)@, if it fits the page, or vertically with
+-- @(\<$$\>)@.
+--
+-- > cat xs  = group (vcat xs)
+cat :: [Doc] -> Doc
+cat             = group . vcat
+
+-- | The document @(fillCat xs)@ concatenates documents @xs@
+-- horizontally with @(\<\>)@ as long as its fits the page, than inserts
+-- a @linebreak@ and continues doing that for all documents in @xs@.
+--
+-- > fillCat xs  = foldr (\<\/\/\>) empty xs
+fillCat :: [Doc] -> Doc
+fillCat         = foldDoc (<//>)
+
+-- | The document @(hcat xs)@ concatenates all documents @xs@
+-- horizontally with @(\<\>)@.
+hcat :: [Doc] -> Doc
+hcat            = foldDoc (<>)
+
+-- | The document @(vcat xs)@ concatenates all documents @xs@
+-- vertically with @(\<$$\>)@. If a 'group' undoes the line breaks
+-- inserted by @vcat@, all documents are directly concatenated.
+vcat :: [Doc] -> Doc
+vcat            = foldDoc (<$$>)
+
+foldDoc :: (Doc -> Doc -> Doc) -> [Doc] -> Doc
+foldDoc f []       = mempty
+foldDoc f ds       = foldr1 f ds
+
+-- | The document @(x \<+\> y)@ concatenates document @x@ and @y@ with a
+-- @space@ in between.  (infixr 6)
+(<+>) :: Doc -> Doc -> Doc
+x <+> y         = x <> space <> y
+
+-- | The document @(x \<\/\> y)@ concatenates document @x@ and @y@ with a
+-- 'softline' in between. This effectively puts @x@ and @y@ either
+-- next to each other (with a @space@ in between) or underneath each
+-- other. (infixr 5)
+(</>) :: Doc -> Doc -> Doc
+x </> y         = x <> softline <> y
+
+-- | The document @(x \<\/\/\> y)@ concatenates document @x@ and @y@ with
+-- a 'softbreak' in between. This effectively puts @x@ and @y@ either
+-- right next to each other or underneath each other. (infixr 5)
+(<//>) :: Doc -> Doc -> Doc
+x <//> y        = x <> softbreak <> y
+
+-- | The document @(x \<$\> y)@ concatenates document @x@ and @y@ with a
+-- 'line' in between. (infixr 5)
+(<$$$>) :: Doc -> Doc -> Doc
+x <$$$> y         = x <> line <> y
+
+-- | The document @(x \<$$\> y)@ concatenates document @x@ and @y@ with
+-- a @linebreak@ in between. (infixr 5)
+(<$$>) :: Doc -> Doc -> Doc
+x <$$> y        = x <> linebreak <> y
+
+-- | The document @softline@ behaves like 'space' if the resulting
+-- output fits the page, otherwise it behaves like 'line'.
+--
+-- > softline = group line
+softline :: Doc
+softline        = group line
+
+-- | The document @softbreak@ behaves like 'empty' if the resulting
+-- output fits the page, otherwise it behaves like 'line'.
+--
+-- > softbreak  = group linebreak
+softbreak :: Doc
+softbreak       = group linebreak
+
+-- -- | Document @(squotes x)@ encloses document @x@ with single quotes
+-- -- \"'\".
+-- squotes :: Doc -> Doc
+-- squotes         = enclose squote squote
+
+-- -- | Document @(dquotes x)@ encloses document @x@ with double quotes
+-- -- '\"'.
+-- dquotes :: Doc -> Doc
+-- dquotes         = enclose dquote dquote
+
+-- -- | Document @(braces x)@ encloses document @x@ in braces, \"{\" and
+-- -- \"}\".
+-- braces :: Doc -> Doc
+-- braces          = enclose lbrace rbrace
+
+-- -- | Document @(parens x)@ encloses document @x@ in parenthesis, \"(\"
+-- -- and \")\".
+-- parens :: Doc -> Doc
+-- parens          = enclose lparen rparen
+
+-- -- | Document @(angles x)@ encloses document @x@ in angles, \"\<\" and
+-- -- \"\>\".
+-- angles :: Doc -> Doc
+-- angles          = enclose langle rangle
+
+-- -- | Document @(brackets x)@ encloses document @x@ in square brackets,
+-- -- \"[\" and \"]\".
+-- brackets :: Doc -> Doc
+-- brackets        = enclose lbracket rbracket
+
+-- | The document @(enclose l r x)@ encloses document @x@ between
+-- documents @l@ and @r@ using @(\<\>)@.
+--
+-- > enclose l r x   = l <> x <> r
+enclose :: Doc -> Doc -> Doc -> Doc
+enclose l r x   = l <> x <> r
+
+-----------------------------------------------------------
+-- semi primitive: fill and fillBreak
+-----------------------------------------------------------
+
+-- | The document @(fillBreak i x)@ first renders document @x@. It
+-- than appends @space@s until the width is equal to @i@. If the
+-- width of @x@ is already larger than @i@, the nesting level is
+-- increased by @i@ and a @line@ is appended. When we redefine @ptype@
+-- in the previous example to use @fillBreak@, we get a useful
+-- variation of the previous output:
+--
+-- > ptype (name,tp)
+-- >        = fillBreak 6 (text name) <+> text "::" <+> text tp
+--
+-- The output will now be:
+--
+-- @
+-- let empty  :: Doc
+--     nest   :: Double -> Doc -> Doc
+--     linebreak
+--            :: Doc
+-- @
+fillBreak :: Double -> Doc -> Doc
+fillBreak f x   = width x (\w ->
+                  if (w > f) then nest f linebreak
+                             else spacing (f - w))
+
+
+-- | The document @(fill i x)@ renders document @x@. It than appends
+-- @space@s until the width is equal to @i@. If the width of @x@ is
+-- already larger, nothing is appended. This combinator is quite
+-- useful in practice to output a list of bindings. The following
+-- example demonstrates this.
+--
+-- > types  = [("empty","Doc")
+-- >          ,("nest","Double -> Doc -> Doc")
+-- >          ,("linebreak","Doc")]
+-- >
+-- > ptype (name,tp)
+-- >        = fill 6 (text name) <+> text "::" <+> text tp
+-- >
+-- > test   = text "let" <+> align (vcat (map ptype types))
+--
+-- Which is layed out as:
+--
+-- @
+-- let empty  :: Doc
+--     nest   :: Double -> Doc -> Doc
+--     linebreak :: Doc
+-- @
+fill :: Double -> Doc -> Doc
+fill f d        = width d (\w ->
+                  if (w >= f) then mempty
+                              else spacing (f - w))
+
+width :: Doc -> (Double -> Doc) -> Doc
+width d f       = column (\k1 -> d <> column (\k2 -> f (k2 - k1)))
+
+
+-----------------------------------------------------------
+-- semi primitive: Alignment and indentation
+-----------------------------------------------------------
+
+-- | The document @(indent i x)@ indents document @x@ with @i@ spaces.
+--
+-- > test  = indent 4 (fillSep (map text
+-- >         (words "the indent combinator indents these words !")))
+--
+-- Which lays out with a page width of 20 as:
+--
+-- @
+--     the indent
+--     combinator
+--     indents these
+--     words !
+-- @
+indent :: Double -> Doc -> Doc
+indent i d      = hang i (spacing i <> d)
+
+-- | The hang combinator implements hanging indentation. The document
+-- @(hang i x)@ renders document @x@ with a nesting level set to the
+-- current column plus @i@. The following example uses hanging
+-- indentation for some text:
+--
+-- > test  = hang 4 (fillSep (map text
+-- >         (words "the hang combinator indents these words !")))
+--
+-- Which lays out on a page with a width of 20 characters as:
+--
+-- @
+-- the hang combinator
+--     indents these
+--     words !
+-- @
+--
+-- The @hang@ combinator is implemented as:
+--
+-- > hang i x  = align (nest i x)
+hang :: Double -> Doc -> Doc
+hang i d        = align (nest i d)
+
+-- | The document @(align x)@ renders document @x@ with the nesting
+-- level set to the current column. It is used for example to
+-- implement 'hang'.
+--
+-- As an example, we will put a document right above another one,
+-- regardless of the current nesting level:
+--
+-- > x $$ y  = align (x <$$$> y)
+--
+-- > test    = text "hi" <+> (text "nice" $$ text "world")
+--
+-- which will be layed out as:
+--
+-- @
+-- hi nice
+--    world
+-- @
+align :: Doc -> Doc
+align d         = column (\k ->
+                  nesting (\i -> nest (k - i) d))   --nesting might be negative :-)
+
+
+-- | The @line@ document advances to the next line and indents to the
+-- current nesting level. Document @line@ behaves like @(text \" \")@
+-- if the line break is undone by 'group'.
+line :: Doc
+line            = Line False
+
+-- | The @linebreak@ document advances to the next line and indents to
+-- the current nesting level. Document @linebreak@ behaves like
+-- 'empty' if the line break is undone by 'group'.
+linebreak :: Doc
+linebreak       = Line True
+
+-- | The document @(nest i x)@ renders document @x@ with the current
+-- indentation level increased by i (See also 'hang', 'align' and
+-- 'indent').
+--
+-- > nest 2 (text "hello" <$$$> text "world") <$$$> text "!"
+--
+-- outputs as:
+--
+-- @
+-- hello
+--   world
+-- !
+-- @
+nest :: Double -> Doc -> Doc
+nest i x        = Nest i x
+
+column, nesting :: (Double -> Doc) -> Doc
+column f        = Column f
+nesting f       = Nesting f
diff --git a/MarXup/PrettyPrint/Core.hs b/MarXup/PrettyPrint/Core.hs
new file mode 100644
--- /dev/null
+++ b/MarXup/PrettyPrint/Core.hs
@@ -0,0 +1,245 @@
+{-# LANGUAGE RecordWildCards #-}
+module MarXup.PrettyPrint.Core(Doc(..),pretty,group,flatten,space,spacing,BoxTex(..)) where
+
+import Data.Monoid
+import MarXup (textual)
+import MarXup.Latex
+import MarXup.Tex
+import MarXup.MultiRef 
+import MarXup.Diagram.Tikz (showDistance)
+import Data.Foldable (forM_)
+import Control.Applicative
+import Data.Function (on)
+import Data.List (partition,minimumBy,sort)
+import Data.Either (partitionEithers)
+
+data BoxTex = TeX TeX BoxSpec | Spacing Double
+
+
+data Doc        = Empty
+                | Text BoxTex
+                | Line !Bool            -- True <=> when undone by group, do not insert a space
+                | Cat Doc Doc
+                | Nest Double Doc
+                | Union Doc Doc           -- invariant: first lines of first doc longer than the first lines of the second doc
+                | Column  (Double -> Doc)
+                | Nesting (Double -> Doc)
+
+
+-- | Document "process"
+data SimpleDoc  = SEmpty
+                | SText BoxTex SimpleDoc
+                | SLine Double SimpleDoc -- Line, indented.
+
+toksToSimple [] = SEmpty
+toksToSimple (Ln d:ts) = SLine d $ toksToSimple ts
+toksToSimple (Tx s:ts) = SText s $ toksToSimple ts
+
+instance Monoid Doc where
+  mempty = Empty
+  mappend = Cat
+  
+group :: Doc -> Doc
+group x         = Union (flatten x) x
+
+flatten :: Doc -> Doc
+flatten (Cat x y)       = Cat (flatten x) (flatten y)
+flatten (Nest i x)      = Nest i (flatten x)
+flatten (Line noSpace)  = if noSpace then Empty else Text (Spacing 3.5)
+flatten (Union x _y)    = flatten x
+flatten (Column f)      = Column (flatten . f)
+flatten (Nesting f)     = Nesting (flatten . f)
+flatten other           = other                     --Empty,Char,Text
+
+
+
+space = spacing 3.5
+
+spacing = Text . Spacing
+-- d = Text (hspace (showDistance d),BoxSpec {boxWidth = d, boxHeight = 0, boxDepth = 0})
+
+
+len (TeX _ b)= boxWidth b
+len (Spacing x) = x
+hei (TeX _ x) = boxHeight x + boxDepth x
+hei (Spacing _) = 0
+
+-- | Does the first line of the document fit in the given width?
+fits w _x        | w < 0         = False
+fits _w SEmpty                   = True
+fits w (SText s x)            = fits (w - len s) x
+fits w (SLine i x)              = True
+
+
+data Docs   = Nil
+            | Cons !Double Doc Docs
+
+
+
+data Token = Ln Double | Tx BoxTex
+
+data Process = Process {overflow :: Double
+                       ,curIndent :: !Double -- current indentation
+                       ,numToks :: Int -- total number of non-space tokens produced
+                       ,tokens :: [Token] -- tokens produced, in reverse order
+                       ,rest :: !Docs -- rest of the input document to process
+                       }
+-- The ⟨filtering⟩ step takes all process states starting at the current
+-- line, and discards those that are dominated.  A process state
+-- dominates another one if it was able to produce more tokens while
+-- having less indentation. This is implemented by first sorting the
+-- process states by following 'measure', and then applying the
+-- 'filtering' function.
+
+measure =  \Process{..} -> (curIndent, negate numToks)
+instance Eq Process where
+  (==) = (==) `on` measure
+instance Ord Process where
+  compare = compare `on` measure
+
+filtering :: [Process] -> [Process]
+filtering (x:y:xs) | numToks x >= numToks y = filtering (x:xs)
+                   | otherwise = x:filtering (y:xs)
+filtering xs = xs
+
+renderAll :: Double -> Double -> Doc -> SimpleDoc
+renderAll rfrac w doc = toksToSimple $ reverse $ loop [Process 0 0 0 [] $ Cons 0 doc Nil]
+    where
+      loop ps = case dones of
+        ((_,done):_) -> done -- here we could attempt to do a better choice. Seems to be fine for now.
+        [] -> case conts of
+          (_:_) -> loop $ filtering $ sort $ conts -- See the comment ⟨filtering⟩ above
+          [] -> case conts'over of
+            (_:_) -> loop [minimumBy (compare `on` overflow) conts'over]
+            [] -> case dones'over of
+              ((_,done):_) -> done
+              [] -> [Tx $ TeX (textual "Pretty print: Panic") (BoxSpec 0 0 0)]
+
+        where
+          -- advance all processes by one line (if possible)
+          ps' = concatMap (\Process{..} -> rall numToks tokens curIndent curIndent rest) ps
+          -- Have some processes reached the end?
+          (dones0,conts0) = partitionEithers ps'
+          (conts,conts'over) = partition (\p -> overflow p <= 0) conts0
+          (dones,dones'over) = partition (\(o,_) -> o <= 0) dones0
+
+      -- r :: the ribbon width in characters
+      r  = max 0 (min w (w * rfrac))
+
+      -- Automatically inserted spacing does not count as doing more production.
+      count (Spacing _) = 0
+      count (TeX _ _) = 1
+
+      -- Compute the state(s) after reaching the end of line.
+      -- rall :: n = indentation of current line
+      --         k = current column
+      --        (ie. (k >= n) && (k - n == count of inserted characters)
+      rall :: Int -> [Token] -> Double -> Double -> Docs -> [Either (Double,[Token]) Process]
+      rall nts ts n k ds0 = case ds0 of
+         Nil ->  [Left $ (overflow,ts)] -- Done!
+         Cons i d ds -> case d of
+            Empty       -> rall nts ts n k ds
+            Text s      -> let k' = k+len s in seq k' (rall (nts+count s) (Tx s:ts) n k' ds)
+            Line _      -> [Right $ Process overflow i nts (Ln i:ts) ds] -- "yield" when the end of line is reached
+            Cat x y     -> rall nts ts n k (Cons i x (Cons i y ds))
+            Nest j x    -> let i' = i+j in seq i' (rall nts ts n k (Cons i' x ds))
+            Union x y   -> rall nts ts n k (Cons i x ds) ++ rall nts ts n k (Cons i y ds)
+            Column f    -> rall nts ts n k (Cons i (f k) ds)
+            Nesting f   -> rall nts ts n k (Cons i (f i) ds)
+        where overflow = negate $ min (w - k) (r - k + n)
+
+-- countLines :: SimpleDoc -> Int
+-- countLines = length . linify0
+
+-- measureWidth :: SimpleDoc -> Double
+-- measureWidth = maximum . map lineWidth . linify0
+--   where lineWidth (i,boxes) = i + sum (map len boxes)
+
+-- The original function implemented by Daan Leijen. Wadler derives a
+-- similar function in his paper ("A prettier printer"). Unfortunately
+-- it does not produce pretty layouts: the assumptions that enable the
+-- amount of greediness implemented here do not hold after adding the
+-- Column and Nesting combinators. So this function tends to generate
+-- layouts with a long first line and a cramped column of stuff.
+
+renderPretty :: Double -> Double -> Doc -> SimpleDoc
+renderPretty rfrac w doc
+    = best 0 0 (Cons 0 doc Nil)
+    where
+      -- r :: the ribbon width in characters
+      r  = max 0 (min w (w * rfrac))
+
+      -- best :: n = indentation of current line
+      --         k = current column
+      --        (ie. (k >= n) && (k - n == count of inserted characters)
+      best _n _k Nil      = SEmpty
+      best n k (Cons i d ds)
+        = case d of
+            Empty       -> best n k ds
+            Text s    -> let k' = k+len s in seq k' (SText s (best n k' ds))
+            Line _      -> SLine i (best i i ds)
+            Cat x y     -> best n k (Cons i x (Cons i y ds))
+            Nest j x    -> let i' = i+j in seq i' (best n k (Cons i' x ds))
+            Union x y   -> nicest n k (best n k (Cons i x ds))
+                                      (best n k (Cons i y ds))
+
+            Column f    -> best n k (Cons i (f k) ds)
+            Nesting f   -> best n k (Cons i (f i) ds)
+
+      --nicest :: r = ribbon width, w = page width,
+      --          n = indentation of current line, k = current column
+      --          x and y, the (simple) documents to chose from.
+      --          precondition: first lines of x are longer than the first lines of y.
+      nicest n k x y    | fits width x  = x
+                        | otherwise     = y
+                        where
+                          width = min (w - k) (r - k + n)
+
+linify0 :: SimpleDoc -> [(Double, [BoxTex])]
+linify0 d = linify d 0 []
+
+-- | Turn a simpledoc into a list of lines and indentation.
+linify :: SimpleDoc -> Double -> [BoxTex] -> [(Double,[BoxTex])]
+linify SEmpty i t = [(i,t)]
+linify (SText s x) i t = linify x i (t ++ [s])
+linify (SLine i' x) i t = (i,t):linify x i' mempty
+
+computeHeights :: BoxTex -> [(Double,[BoxTex])] -> [Double]
+computeHeights strut ls = scanl (\y (_i,boxes) -> y - maximum (map hei (strut:boxes))) 0 ls
+
+heights :: BoxTex -> [(Double,[BoxTex])] -> [(Double,(Double, [BoxTex]))]
+heights strut ls = zip (computeHeights strut ls) ls
+
+computeWidths :: Double -> [BoxTex] -> [Double]
+computeWidths = scanl (\x b -> len b + x)
+
+layout :: SimpleDoc -> Tex ()
+layout d = env "tikzpicture" $ do
+  strutBox <- justBox $ -- textual "qM" -- slightly too small ones
+                         cmd0 "strut" -- this gives slightly too big spaces sometimes
+  let strut = TeX mempty strutBox
+  forM_ (heights strut $ linify0 d) $ \(y,(i,boxes)) -> do
+    let mh = maximum (map hei (strut:boxes))
+    forM_ (zip boxes $ computeWidths i boxes) $ \(tx,x) -> do
+      case tx of
+        Spacing _ -> return ()
+        TeX t box -> do
+          let y' = y - (mh - boxHeight box)
+          tex $ "\\node[anchor=north west,inner sep=0] at (" ++ showDistance x ++ "," ++ showDistance y' ++ ")"
+          braces $ t
+          tex ";\n"
+
+pretty :: Double -> Double -> Doc -> TeX
+pretty rfrac w d = do
+  layout $ renderAll rfrac w d
+
+
+-- getBoxes :: Doc -> Tex Doc
+-- getBoxes Empty = pure Empty
+-- getBoxes (Cat d e) =  Cat <$> getBoxes d <*> getBoxes e
+-- getBoxes (Union d e) =  Union <$> getBoxes d <*> getBoxes e
+-- getBoxes (Tex (t,_)) = do
+--   b <- justBox t
+--   return (TEXT (t,b))
+-- getBoxes (NEST i d) = NEST i <$> getBoxes d
+-- getBoxes LINE = pure LINE
diff --git a/MarXup/Tex.hs b/MarXup/Tex.hs
--- a/MarXup/Tex.hs
+++ b/MarXup/Tex.hs
@@ -1,170 +1,258 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies,TypeSynonymInstances,FlexibleInstances, PackageImports #-}
 
 module MarXup.Tex where
 
-import Control.Monad.Fix
-import Control.Monad.RWS.Lazy
+import MarXup
+import "mtl" Control.Monad.Reader
+import "mtl" Control.Monad.RWS
 import Control.Applicative
-import Data.Either
 import GHC.Exts( IsString(..) )
-import System.FilePath
-import System.Environment
 import Data.List (intersperse)
+import MarXup.MultiRef
+import System.Process
+import System.Directory (doesFileExist)
 
+newtype Tex a = Tex {fromTex :: Multi a}
+  deriving (Monad, MonadFix, Applicative, Functor)
+
 ---------------------------------
--- Marchup interface
-textual = Tex  -- TODO: escape \, &, etc.
-text = textual 
+-- MarXup interface
+instance Textual Tex where
+    textual s = tex $ concatMap escape s
 
+kern :: String -> TeX
+kern x = braces $ tex $ "\\kern " ++ x
 
-element :: Tex a -> Tex a
-element = id
+escape '\\' = "\\ensuremath{\\backslash{}}"
+escape '~' = "\\ensuremath{\\sim{}}"
+escape '<' = "\\ensuremath{<}"
+escape '>' = "\\ensuremath{>}"
+escape c | c `elem` "#^_{}&$%" = '\\':c:[]
+escape c = [c]
 
------------------------------------
--- Basic datatype and semantics
-type Label = Int
+instance Element (Tex a) where
+  type Target (Tex a) = Tex a
+  element = id
 
-data Tex a where
-  Return :: a -> Tex a
-  Bind :: Tex a -> (a -> Tex b) -> Tex b
+texInMode ::  Mode -> String ->TeX
+texInMode mode s = whenMode mode $ Tex $ raw s
 
-  Tex :: String -> Tex () -- ^ raw TeX code
+tex :: String -> TeX
+tex = texInMode (`elem` [Regular,InsideBox])
 
-  -- Reference management
-  Label :: Tex Label
-  Refer :: Label -> Tex Label
-  MFix :: (a -> Tex a) -> Tex a 
+texComment :: String -> TeX
+texComment s =
+  forM_ (lines s) $ \line ->
+    tex $ "% " <> line <> "\n"
 
-  -- MetaPOST
-  Metapost :: Tex a -> Tex a -- the output should go in the metapost file
-  MPFigure :: Label -> Tex () -- inclusion of a metapost figure
-  
-tex = Tex
 type TeX = Tex ()
 
-newLabel = Label  
-reference = Refer
-
-instance MonadFix Tex where
-  mfix = MFix
+reference :: Label -> Tex ()
+reference l = tex (show l)
 
-instance Monad Tex where
-  (>>=) = Bind
-  return = Return
-  
-instance Applicative Tex where
-  (<*>) = ap
-  pure = Return
-  
-instance Functor Tex where
-  fmap = liftM
-  
-instance Monoid (Tex ()) where  
-  mempty = Tex ""
+instance Monoid (TeX) where
+  mempty = textual ""
   mappend = (>>)
-  
-instance IsString (Tex ()) where  
-  fromString = Tex
-  
-type References = Int -- how many labels have been allocated
-emptyRefs :: References
-emptyRefs = 0
-                  
-select :: Bool -> a -> Either a a
-select True x = Left x
-select False x = Right x
-            
 
-type TexAndMPost = [Either String String]
-
-newtype Displayer a = Displayer {fromDisplayer :: RWS () TexAndMPost References a }
-  deriving (Monad, MonadWriter TexAndMPost, MonadState References, MonadFix)
--- | Produces a list of strings (either for LaTeX or MetaPOST).
-display :: String -> Bool -> Tex a -> Displayer a 
-display fname mp t = case t of
-      (Tex s) -> tell' s
-      (Return a) -> return a
-      (Bind k f) -> rec k >>= (rec . f)
-      Label -> do x <- get;  put $ x + 1; return x
-      (Refer x) -> do tell [select mp $ show x]; return x
-      (MFix f) -> mfix (rec . f)
-      (Metapost x) -> display fname True x 
-      (MPFigure l) -> tell' $ fname ++ "-" ++ show l ++ ".mps"
-  where tell' :: String -> Displayer ()
-        tell' s = tell [select mp s]   
-        rec :: Tex a -> Displayer a
-        rec = display fname mp
-        
-sho :: Show a => a -> Tex ()
-sho = Tex . show
-                             
-render :: Tex a -> IO ()                   
-render t = do 
-  fname <- getProgName
-  let (_,xs) = evalRWS (fromDisplayer $ display fname False t) () emptyRefs 
-      (mp,tex) = partitionEithers xs
-  writeFile (fname <.> "tex") (concat tex)
-  writeFile (fname <.> "mp") (concat mp)
-                    
+instance IsString (TeX) where
+  fromString = textual
 
-texLn :: String -> Tex ()    
-texLn s = Tex s >> Tex "\n"
+texLn :: String -> TeX
+texLn s = tex s >> tex "\n"
 
 texLines :: [String] -> Tex ()
 texLines = mapM_ texLn
 
 genParen :: String -> Tex a -> Tex a
-genParen [l,r] x = Tex [l] *> x <* Tex [r]
+genParen [l,r] x = tex [l] *> x <* tex [r]
 
-braces :: Tex a -> Tex a
+braces,brackets :: Tex a -> Tex a
 braces = genParen "{}"
 brackets = genParen "[]"
 
-backslash = Tex ['\\']
+backslash :: TeX
+backslash = tex ['\\']
 
-nil = braces (Tex "")
+nil :: TeX
+nil = braces (tex "")
 
+-- | Command with no argument
+cmd0 :: String -> Tex ()
 cmd0 c = cmdn' c [] [] >> return ()
 
+-- | Command with one argument
+cmd :: String -> Tex a -> Tex a
 cmd c = cmd' c []
 
+-- | Command with options
+cmd' :: String -> [String] -> Tex b -> Tex b
 cmd' cmd options arg = do
   [x] <- cmdn' cmd options [arg]
   return x
 
+-- | Command with options and many arguments
 cmdn' :: String -> [String] -> [Tex a] -> Tex [a]
-cmdn' cmd options args = do 
-  backslash >> Tex cmd
+cmdn' cmd options args = do
+  backslash >> tex cmd
   when (not $ null options) $ brackets $ sequence_ $ map tex $ intersperse "," options
   res <- sequence $ map braces args
-  when (null args) $ Tex "{}" -- so that this does not get glued with the next thing.
+  when (null args) $ tex "{}" -- so that this does not get glued with the next thing.
   return res
 
+-- | Command with tex options and many arguments
 cmdm :: String -> [Tex a] -> [Tex a] -> Tex [a]
-cmdm cmd options args = do 
-  backslash >> Tex cmd
+cmdm cmd options args = do
+  backslash >> tex cmd
   when (not $ null options) $ sequence_ $ map brackets $ options
   res <- sequence $ map braces args
-  when (null args) $ Tex "{}" -- so that this does not get glued with the next thing.
+  when (null args) $ tex "{}" -- so that this does not get glued with the next thing.
   return res
 
 
-cmdn'_ :: String -> [String] -> [Tex a] -> Tex ()
+cmdn'_ :: String -> [String] -> [TeX] -> Tex ()
 cmdn'_ cmd options args = cmdn' cmd options args >> return ()
 
-cmdn cmd args = cmdn' cmd [] args
+-- | Command with n arguments
+cmdn :: String -> [Tex a] -> Tex [a]
+cmdn c args = cmdn' c [] args
+
+cmdn_ :: String -> [TeX] -> Tex ()
 cmdn_ cmd args = cmdn'_ cmd [] args
 
+-- | Environment
 env :: String -> Tex a -> Tex a
-env e body = do
-  cmd "begin" $ Tex e
+env x = env' x []
+
+-- | Environment with options
+env' :: String -> [String] -> Tex a -> Tex a
+env' e opts body = env'' e opts [] body
+
+-- | Environment with a tex option
+env'' :: String -> [String] -> [TeX] -> Tex a -> Tex a
+env'' e opts args body = do
+  cmd "begin" $ tex e
+  when (not $ null opts) $ brackets $ sequence_ $ map tex $ intersperse "," opts
+  mapM_ braces args
   x <- body
-  cmd "end" $ Tex e
+  cmd "end" $ tex e
   return x
 
-label = do
-  l <- Label
-  cmd "label" (Refer l)
+------------------
+-- Sorted labels
+
+data SortedLabel =  SortedLabel String Label
+
+label :: String -> Tex SortedLabel
+label s = do
+  l <- Tex newLabel
+  cmd "label" (reference l)
+  return $ SortedLabel s l
+
+xref :: SortedLabel -> TeX
+xref (SortedLabel _ l) = do
+  cmd "ref" (reference l)
+  return ()
+
+fxref :: SortedLabel -> TeX
+fxref l@(SortedLabel s _) = do
+  textual s
+  tex "~" -- non-breakable space here
+  xref l
+
+pageref :: SortedLabel -> TeX
+pageref (SortedLabel _ l) = do
+  cmd "pageref" (reference l)
+  return ()
   
-xref l = do
-  cmd "ref" (Refer l)
+instance Element SortedLabel where
+  type Target SortedLabel = TeX
+  element x = fxref x >> return ()
+
+-----------------
+-- Generate boxes
+
+outputAlsoInBoxMode :: Tex a -> Tex a
+outputAlsoInBoxMode (Tex a) = Tex $ local moveInBox $ a
+         where moveInBox m = case m of
+                 OutsideBox -> InsideBox
+                 _ -> m
+
+texAlways = texInMode (const True)
+
+inBoxComputMode :: String -> TeX
+inBoxComputMode = texInMode (`elem` [OutsideBox,InsideBox])
+
+whenMode :: Mode -> Tex () -> Tex ()
+whenMode mode act = do
+  interpretMode <- Tex ask
+  when (mode interpretMode) act
+
+inBox :: Tex a -> Tex (a, BoxSpec)
+inBox x = do
+  inBoxComputMode $ "\n\\savebox{\\marxupbox}{"
+  a <- outputAlsoInBoxMode x
+  inBoxComputMode $ 
+    "}"
+    ++ writeBox "wd"
+    ++ writeBox "ht"
+    ++ writeBox "dp"
+    ++ "\n"
+  b <- Tex getBoxSpec
+
+  return (a,b)
+  where writeBox l = "\\immediate\\write\\boxesfile{\\number\\"++ l ++"\\marxupbox}"
+
+
+justBox :: Tex a -> Tex BoxSpec
+justBox x = do
+  whenMode (`elem` [OutsideBox, InsideBox]) $ outputAlsoInBoxMode $ do
+    tex "\n\\savebox{\\marxupbox}{"
+    x
+    tex $ 
+      "}"
+      ++ writeBox "wd"
+      ++ writeBox "ht"
+      ++ writeBox "dp"
+      ++ "\n"
+  b <- Tex getBoxSpec
+
+  return b
+  where writeBox l = "\\immediate\\write\\boxesfile{\\number\\"++ l ++"\\marxupbox}"
+
+renderWithBoxes :: [BoxSpec] -> InterpretMode -> Tex a -> String
+renderWithBoxes bs mode (Tex t) = doc
+  where (_,_,doc) = runRWS (fromMulti $ t) mode (0,bs)
+
+renderSimple :: TeX -> String
+renderSimple = renderWithBoxes [] Regular
+  
+renderTex :: (Bool -> TeX) -> TeX -> IO String
+renderTex preamble body = do
+  let bxsTex = renderWithBoxes (repeat nilBoxSpec) OutsideBox (wholeDoc True)
+      boxesName = "mpboxes"
+      boxesTxt = boxesName ++ ".txt"
+      wholeDoc inBoxMode = do
+        outputAlsoInBoxMode (preamble inBoxMode)
+        inBoxComputMode $ "\\newwrite\\boxesfile"
+        texAlways "\\begin{document}"
+        inBoxComputMode $ "\\immediate\\openout\\boxesfile="++boxesTxt++"\n \\newsavebox{\\marxupbox}"
+        body
+        inBoxComputMode "\n\\immediate\\closeout\\boxesfile"
+        texAlways "\\end{document}"
+  writeFile (boxesName ++ ".tex") bxsTex
+  system $ "latex " ++ boxesName
+  boxes <- do
+    e <- doesFileExist boxesTxt
+    if e
+      then do
+        boxData <- map read . lines <$> readFile boxesTxt
+        return $ getBoxInfo boxData
+      else return []
+  putStrLn $ "Number of boxes found: " ++ show (length boxes)
+  return $ renderWithBoxes boxes Regular $ (wholeDoc False)
+
+getBoxInfo :: [Int] -> [BoxSpec]
+getBoxInfo [] = []
+getBoxInfo (width:height:depth:bs) = BoxSpec (scale width) (scale height) (scale depth):getBoxInfo bs
+  where scale x = fromIntegral x / 65536
+
diff --git a/MarXup/Verbatim.hs b/MarXup/Verbatim.hs
new file mode 100644
--- /dev/null
+++ b/MarXup/Verbatim.hs
@@ -0,0 +1,22 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies,TypeSynonymInstances,FlexibleInstances, PackageImports, DeriveFunctor #-}
+
+module MarXup.Verbatim where
+
+import MarXup
+import Control.Monad.Fix
+
+data Verbatim a = Verbatim {fromVerbatim::String, value::a}
+  deriving Functor
+
+instance Textual Verbatim where
+    textual s = Verbatim s ()
+
+instance Monad Verbatim where
+    return x = Verbatim "" x
+    (Verbatim s0 x) >>= f =
+        Verbatim (s0 ++ s1) y
+        where Verbatim s1 y = f x
+
+instance MonadFix Verbatim where
+    mfix f = let Verbatim _ x = f x in f x
+
diff --git a/examples/LaTeX.hs b/examples/LaTeX.hs
--- a/examples/LaTeX.hs
+++ b/examples/LaTeX.hs
@@ -1,63 +1,187 @@
-{-# OPTIONS_GHC -XTypeSynonymInstances -XOverloadedStrings -XDoRec -pgmF marxup -F #-}
+{-# OPTIONS_GHC -XTypeSynonymInstances -XOverloadedStrings -XRecursiveDo -pgmF marxup3 -F #-}
 
+import MarXup
 import MarXup.Latex
+import MarXup.Latex.Math
+import MarXup.Math
 import MarXup.Tex
 import MarXup.DerivationTrees
+import MarXup.PrettyPrint as PP hiding (width)
+import MarXup.PrettyPrint.Core as PC
 import Control.Applicative
+import Data.Monoid
+import Control.Monad (unless)
+import MarXup.Diagram
+import MarXup.Diagram.Graphviz
+import Control.Lens (set)
+import Data.GraphViz
+import Data.String
+import Data.Traversable
+import Data.GraphViz.Attributes.Complete
+  (Attribute(RankSep,Shape,Label,Margin,Width,Len,RankDir),
+   Shape(..),Label(StrLabel),DPoint(..),RankDir(..))
 
-preamble :: Tex ()
-preamble = do
-  usepackage ["mathletters"] "ucs"
-  usepackage ["utf8x"] "inputenc"
-  usepackage [] "graphicx"
+data SExp = Atom String | SX [SExp]
 
+prettyS :: SExp -> Tex Doc
+prettyS (Atom x) = PP.text (textual x)
+prettyS (SX xs) = do
+  xs' <- traverse prettyS xs
+  enclosure "(" ")" " " xs'
 
-someTree = derivationTree [] $ Node (rule (mbox "modus ponens") "A → B") []
+expr :: TeX
+expr = do
+    d <- prettyS six
+    paragraph "1000"
+    PC.pretty 1 1000 d
+    paragraph "100"
+    PC.pretty 1 200 d
+    paragraph "10"
+    PC.pretty 1 10 d
+  where
+  three = SX $ map Atom ["arstarsx","wftwfy","varstw","x","M"]
+  six = SX [ three , three , three ]
 
-(∶) = binop ":"
-γ = cmd "Gamma" nil
-(⊢) = binop $ cmd "vdash" nil
+preamble inMP = do
+  documentClass "article" []
+  usepackage "inputenc" ["utf8x"]
+  unless inMP $ usepackage "tikz" []
+  usepackage "graphicx" []
 
-x = Tex "x"
-y = Tex "y"
-a = Tex "a"
-b = Tex "b"
+-- arrow :: Object -> Object -> Diagram Incidence
+-- arrow src trg = using (outline "black" . set endTip ToTip) $ do
+--   edge src trg
 
-(≜) = binop "="
+autoLab s i = do
+  o <- labelObj s
+  autoLabel o i
 
-main = render $ latexDocument "article" ["11pt"] preamble $ @"
-@intro<-section{Intro}
+(▸) = flip (#)
 
+grDiag = graph Dot gr
+
+nod x = DotNode x [Margin (DVal 0),Width 0, Shape Circle, Label $ StrLabel $ fromString x]
+edg x y z = DotEdge x y [Label $ StrLabel z, Len 0.1]
+gr :: DotGraph String
+gr = DotGraph False True Nothing
+     (DotStmts [GraphAttrs [RankSep [0.1], RankDir FromLeft]] []
+      [nod "A", nod "B", nod "C", nod "D"]
+      [edg "A" "B" "1"
+      ,edg "A" "C" "2"
+      ,edg "B" "D" "3"
+      ,edg "D" "A" "4"])
+
+testDiagram = do
+  -- draw $ path $ circle (Point 0 0) 5
+  a   <- labelObj $ ensureMath $ "a"
+  b   <- labelObj $ ensureMath $ "b"
+  a'  <- draw $ circleShape -- labelObj $ ensureMath $ "c"
+  width a' === 15
+  b'  <- labelObj $ ensureMath $ "d"
+  a'' <- labelObj $ ensureMath $ "."
+  b'' <- labelObj $ ensureMath $ "."
+
+  -- c <- texObj $ ensureMath $ "c"
+  -- Center ▸ c === MP.center [E ▸ a'', E ▸ b''] + (20 +: 0)
+
+  let width = 70
+  vdist b a === 30
+  hdist a a' === width
+  hdist a' a'' === width
+  alignMatrix [[Center ▸ a, Center ▸ a',Center ▸ a'']
+              ,[Center ▸ b, Center ▸ b',Center ▸ b'']
+              ]
+  autoLab "bing" =<< arrow a a'
+  autoLab "bang" =<< arrow b b'
+  autoLab "oops" . swap =<< arrow a b
+  autoLab "pif" =<< arrow a' a''
+  autoLab "paf" =<< arrow b' b'' 
+
+  draw $ do
+    autoLab "equal" =<< edge a'' b''
+  return ()
+
+ax c = Rule {delimiter = mempty, ruleStyle = outline "black", ruleLabel = mempty, conclusion = c}
+
+someTree = derivationTreeD  $ Node (rule ("modus ponens") "B")
+    [defaultLink ::> Node (ax "X") []
+    ,defaultLink  {steps = 0} ::> Node (rule "" "A")
+     [defaultLink {steps = 0} ::> Node (rule (braces $ cmd0 "small" <> "mystery") "A1")
+       [defaultLink ::> Node (ax "Y") []
+       ,defaultLink ::> Node (rule "" "A2")
+         [defaultLink ::> Node (rule "" "A3")
+        [defaultLink ::> Node (ax "Z") []]]]]
+    ,defaultLink {steps = 3} ::> Node (rule "abs" "A --> B")
+     [defaultLink ::> Node (rule "" "B")
+      [defaultLink ::> Node (ax "A") []
+      ]
+     ]
+    ]
+
+(∶) = binop 2 ", "
+γ = Con $ cmd "Gamma" nil
+(⊢) = binop 1 (cmd0 "vdash")
+
+x = Con "x"
+y = Con "y"
+a = Con "a"
+b = Con "b"
+
+(≜) = binop 1 "="
+
+main = writeFile ("LaTeX.tex") =<< renderTex preamble «
+
+@intro<-section«Intro»
+
 At-syntax is used to call a Haskell function. The result can be bound.
-For example, the @sf{section} command returns a label that can be used
+For example, the @sans«section» command returns a label that can be used
 for references.
 
 This is section @xref(intro). Note that cross-references are checked
 at ``compile-time''. Forward references also work (see
 sec. @xref(concl)).
 
-@section{Markup}
+@section«Markup»
 
-Here comes @sf{some sans-serif text with @em{emphasis}!}
+Here comes @sans«some sans-serif text with @emph«emphasis»!»
 
 Note that arguments put in braces are markup.
 
-
-@section{Math}
+@section«Math»
 
 Arguments in parenthesis are Haskell. Combined with unicode syntax,
-this can make writing all sorts of mathy stuff rather pleasant. For
-example: @math(γ ⊢ x ∶ a).
+this can make writing all sorts  mathy stuff rather pleasant. For
+example: @(γ ⊢ x ∶ a).
 
 The operators are overloaded to work on text as well:
-@displayMath(b ≜ sqrt (a + (x/y)))
+@display(b ≜ sqrt (a * (b + (x/y))))
 
+There is also special support for derivation trees:
 
-@concl<-section{Conclusion}
+@section«Pretty Printer»
+@expr
 
+@section«Derivation Trees»
 
+Here is some derivation tree:
 
-Marχup is awesome.
+@someTree
 
-@"
+@section«Diagrams»
+
+One can also draw diagrams:
+@testDiagram
+
+@section«Graphviz»
+
+There is partial, rudimentary support for layout of graphs using graphviz.
+
+grDiag
+
+
+@concl<-section«Conclusion»
+
+Mar@ensureMath«@cmd0"chi"»up is awesome :p .
+
+»
 
diff --git a/marxup.cabal b/marxup.cabal
--- a/marxup.cabal
+++ b/marxup.cabal
@@ -1,5 +1,5 @@
 name:           marxup
-version:        1.0.2
+version:        3.0.0
 category:       Text
 synopsis:       Markup language preprocessor for Haskell
 description:
@@ -18,26 +18,62 @@
      examples/LaTeX.hs
 
 
-executable marxup
+-- executable marxup
+--   extensions: FlexibleInstances, TupleSections
+--   main-is: Main.hs
+--   build-depends: base>=4.2&&<=5
+--   build-depends: pretty==1.1.*
+--   build-depends: parsec>=3
+--   build-depends: dlist>=0.5
+
+executable marxup3
   extensions: FlexibleInstances, TupleSections
-  main-is: Main.hs
-  build-depends: base>=4.2&&<=5
+  main-is: Main3.hs
+  build-depends: configurator>=0.2&&<2
+  build-depends: base>=4.2&&<=58
   build-depends: pretty==1.1.*
-  build-depends: parsec==2.1.*
+  build-depends: parsek==1.*
+  build-depends: dlist>=0.7
   
 library
   extensions: FlexibleInstances, TypeSynonymInstances, GADTs
-  build-depends: base==4.*
---  build-depends: pandoc==1.5.*  (broken)
-  build-depends: mtl==2.1.*
-  build-depends: labeled-tree==1.*  
-  build-depends: filepath==1.3.*  
+  build-depends: base>=4.2&&<5
+--  build-depends: pandoc==1.5.*  (support broken)
+  build-depends: mtl>=2.1
+  build-depends: labeled-tree==1.*
+  build-depends: filepath==1.3.*
+  build-depends: containers>=0.4 &&<1
+  build-depends: process>=1.1
+  build-depends: glpk-hs>=0.3.4
+  build-depends: cubicbezier>=0.2
+  build-depends: lens>=3.10
+  build-depends: directory>=1.2
+  build-depends: typography-geometry
+  build-depends: polynomials-bernstein==1.*
+  build-depends: vector
+  build-depends: graphviz
+  build-depends: text
 
+  exposed-modules: MarXup
   exposed-modules: MarXup.Tex
-  exposed-modules: MarXup.MetaPost
   exposed-modules: MarXup.Latex
+  exposed-modules: MarXup.Latex.Math
+  exposed-modules: MarXup.Math
+  exposed-modules: MarXup.Latex.Bib
   exposed-modules: MarXup.Beamer
-  exposed-modules: MarXup.DerivationTrees  
+  exposed-modules: MarXup.DerivationTrees
   exposed-modules: MarXup.Text
+  exposed-modules: MarXup.Diagram
+  exposed-modules: MarXup.Diagram.Object
+  exposed-modules: MarXup.Diagram.Path
+  exposed-modules: MarXup.Diagram.Point
+  exposed-modules: MarXup.Diagram.Layout
+  exposed-modules: MarXup.Diagram.Tikz
+  exposed-modules: MarXup.Diagram.Graphviz
+  exposed-modules: MarXup.MultiRef
+  exposed-modules: MarXup.Verbatim
+  exposed-modules: MarXup.PrettyPrint.Core
+  exposed-modules: MarXup.PrettyPrint
+  
 --  exposed-modules: MarXup.Pandoc (broken)