minitypeset-opengl 0.2.0.1 → 0.3.0.0

raw patch · 10 files changed

+888/−117 lines, 10 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• example/example-STIX.hs +15/−7
• minitypeset-opengl.cabal +2/−1
• src/Graphics/Rendering/MiniTypeset/Box.hs +124/−4
• src/Graphics/Rendering/MiniTypeset/Common.hs +56/−0
• src/Graphics/Rendering/MiniTypeset/Delimiters.hs +455/−0
• src/Graphics/Rendering/MiniTypeset/Document.hs +49/−52
• src/Graphics/Rendering/MiniTypeset/FontTexture.hs +11/−9
• src/Graphics/Rendering/MiniTypeset/Layout.hs +127/−31
• src/Graphics/Rendering/MiniTypeset/MultiFont.hs +22/−13
• src/Graphics/Rendering/MiniTypeset/Render.hs +27/−0

@@ -33,6 +33,11 @@ import UnicodeMath
 
 --------------------------------------------------------------------------------
+
+-- | Font height
+theHeight = Height 40
+
+--------------------------------------------------------------------------------
 -- * The \"document\" we want to render (normally you want to generate this)
 
 document :: Document String
@@ -41,11 +46,11 @@   $ vcatR
       [ block12
 --      , space
-      , hcatT [ vcat [ summation , over ] , (margin' 50 40 20 30 block3) ]
+      , hcatT [ vcat [ summation , hcatT [ over , space, fracs ] ] , (margin' 50 40 20 30 block3) ]
       , block4
       ]
 
-block12 = hcat [ block1 , Space , block2 ]
+block12 = hcat [ delimited Brace block1 , Space , block2 ]
 
 block1 = Identified "block1" 
        $ vcat  [line1a,line1b,line1c,line1d]
@@ -66,7 +71,7 @@ line1d = hcat
        [ "ut labore et "
        , Identified "dolore" $ boldItalic $ rgb 0 0 0.75 $ "dolore"
-       , " magna aliqua."
+       , " magn{a} aliqua."
        ]
 
 line2a = hcat [ "Ut enim ad " , Identified "bbox1" "minim" , " veniam," ]
@@ -97,6 +102,8 @@   , string $ drop 13 math_test
   ]
 
+fracs = blue $ hcat [ "1+", fraction (hcat [" xy+",fraction "z" "w"]) "pq" , space , choose "n" "k" , space , (choose' Square "m" "t") ]
+  
 subsup = vcat
   [ black "see if the gaps between lines..."
   , hcat [ supscript (char pp) "m"     , space 
@@ -117,9 +124,10 @@ 
 summation = vcat 
   [ "summation" 
-  , white $ hcat 
-      [ aboveBelow (char sum_) (char infty , "n=0") , "f(n)" , space , space
-      , below "lim" (string ['x',rightarrow,infty]) , " g(x)"  , space , space
+  , white $ Identified "zz" $ Delimited Paren  
+      [ hcat [         aboveBelow (char sum_) (char infty , "n=0") , "f(n)"  , space ] 
+      , hcat [ space , below "lim" (string ['x',rightarrow,infty]) , " g(x)" , space ]
+      , " xyz A"
       ]
   , "and limits"
   ]
@@ -210,7 +218,7 @@   mf <- readIORef theMultiFont
 
   -- create layout
-  lout <- createLayout mf (Height 40) document
+  lout <- createLayout mf theHeight document
 
   -- top-left corner of the rendered text
   let pos0 = Pos 16 16

@@ -1,5 +1,5 @@ Name:                minitypeset-opengl-Version:             0.2.0.1+Version:             0.3.0.0 Synopsis:            Layout and render text with TrueType fonts using OpenGL  Description:         This is a library to render text with OpenGL.                      TrueType (and OpenType) fonts are supported; glyph rendering@@ -38,6 +38,7 @@                        Graphics.Rendering.MiniTypeset.Common                        Graphics.Rendering.MiniTypeset.Document                        Graphics.Rendering.MiniTypeset.Layout+                       Graphics.Rendering.MiniTypeset.Delimiters                        Graphics.Rendering.MiniTypeset.MultiFont                        Graphics.Rendering.MiniTypeset.FontTexture                        Graphics.Rendering.MiniTypeset.Render

@@ -1,5 +1,5 @@ --- | Boxes are rectangular shapes used for layouting. They consisting of +-- | Boxes are rectangular shapes used for layouting. They are consisting of  -- several quads having a relative position to each other: -- -- * \"inner boxes\" are used for aligning several boxes together@@ -26,6 +26,8 @@  -------------------------------------------------------------------------------- +import Data.List+ -- Semigroup became a superclass of Monoid at base 4.11 -- there are also conflicts between Monoid and Semigroup :( #if MIN_VERSION_base(4,11,0)     @@ -81,6 +83,13 @@   x2 = max u2 p2   y2 = max v2 q2 +-- | Because it really should be a semigroup and not a monoid, it's important+-- that it's not implemented with foldl..+quadsLUB :: [Quad] -> Quad+quadsLUB []  = zeroQuad+quadsLUB [q] = q+quadsLUB qs  = foldl1 quadLUB qs+ ofsLUB :: (Pos,Quad) -> (Pos,Quad) -> Quad ofsLUB (ofs1,quad1) (ofs2,quad2) = quadLUB (translate ofs1 quad1) (translate ofs2 quad2) @@ -103,6 +112,7 @@ instance Monoid Quad where   mempty  = zeroQuad   mappend = quadLUB+  mconcat = quadsLUB  #endif @@ -127,9 +137,26 @@ boxInnerQuad :: Box -> Quad boxInnerQuad (Box inner outer bounding gap) = Quad (0,0) inner +boxInnerWidth, boxInnerHeight :: Box -> Double+boxInnerWidth  = fst . boxInnerSize+boxInnerHeight = snd . boxInnerSize+ emptyBox :: Box emptyBox = Box (0,0) zeroQuad zeroQuad zeroQuad +-- | Translates the quads relative to the inner quad.+shiftBox :: Pos -> Box -> Box+shiftBox ofs (Box sz outer bnd gap) = Box sz (translate ofs outer) (translate ofs bnd) (translate ofs gap)++boxSelectQuad :: WhichQuad -> Box -> Quad+boxSelectQuad which = case which of+  InnerQuad    -> boxInnerQuad+  OuterQuad    -> boxOuterQuad+  BoundingQuad -> boxBoundingQuad+  GapQuad      -> boxGapQuad++--------------------------------------------------------------------------------+ -- | Enumerating the four different quads in a 'Box' data WhichQuad   = InnerQuad@@ -140,20 +167,25 @@  -- | Replace the inner box by the given box. Since the inner box is used for -- alignment, this amounts to changing the alignment -realignBox :: WhichQuad -> Box -> Box+realignBox :: WhichQuad -> Box -> (Pos,Box) realignBox which box@(Box _ outer bounding gap) =    case which of-    InnerQuad     -> box+    InnerQuad     -> (Pos 0 0, box)     OuterQuad     -> realign outer     BoundingQuad  -> realign bounding     GapQuad       -> realign gap   where-    realign quad = Box (quadSize quad) (f outer) (f bounding) (f gap) where+    realign quad = (ofs, Box (quadSize quad) (f outer) (f bounding) (f gap)) where       ofs = negate (pairToPos $ quadTopLeft quad)       f :: Quad -> Quad       f = translate ofs +-- | Replace the outer and gap boxes by the bounding box+trimBox :: Box -> Box+trimBox box@(Box size _ bounding _) = Box size bounding bounding bounding+ --------------------------------------------------------------------------------+-- * Absolute boxes  -- | An absolute box data AbsBox = AbsBox@@ -177,6 +209,13 @@ absboxGapQuad :: AbsBox -> Quad absboxGapQuad (AbsBox ofs relbox) = translate ofs (boxGapQuad relbox) +absboxSelectQuad :: WhichQuad -> AbsBox -> Quad+absboxSelectQuad which = case which of+  InnerQuad    -> absboxInnerQuad+  OuterQuad    -> absboxOuterQuad+  BoundingQuad -> absboxBoundingQuad+  GapQuad      -> absboxGapQuad+ -------------------------------------------------------------------------------- -- * Concatenating boxes @@ -357,6 +396,87 @@   Box (w0,h0) outer0 bound0 gap0 = box0   Box (w1,h1) outer1 bound1 gap1 = box1   Box (w2,h2) outer2 bound2 gap2 = box2++--------------------------------------------------------------------------------+-- * Fraction++fractionBox :: Double -> Box -> Box -> (Box,(Pos,Pos))+fractionBox vmargin box1 box2 = (box,(pos1,pos2)) where++  box = Box (w,h) outer bound gap ++  w = max w1 w2+  h = h1  -- + h2      -- ???++  x1 = 0.5 * (w-w1)+  x2 = 0.5 * (w-w2)++  y1 = - quadB outer1 - vmargin+  y2 = - quadT outer2 + vmargin++  pos1 = Pos x1 y1+  pos2 = Pos x2 y2++  outer = ofsLUB (pos1,outer1) (pos2,outer2)+  bound = ofsLUB (pos1,bound1) (pos2,bound2)+  gap   = ofsLUB (pos1,  gap1) (pos2,  gap2)++  Box (w1,h1) outer1 bound1 gap1 = box1+  Box (w2,h2) outer2 bound2 gap2 = box2++--------------------------------------------------------------------------------+-- * delimiters++-- we have to vertically center the delimiters wrt. the bounding boxes +-- of the rest, and ignore them while computing the inner/outer boxes +-- (but include them for the bounding/gap boxes)+--+delimiterBox :: (Box,Box,Box) -> [Box] -> (Box,[Pos])+delimiterBox (left,mid,right) boxes = (box,posList) where+  h = maximum $ map boxInnerHeight boxes+  w = last gxs - quadWidth (boxGapQuad right) + boxInnerWidth right+  allb = left : intersperse mid boxes ++ right : [] +  gxs = scanl (+) (quadL $ boxGapQuad left) $ map (quadWidth . boxGapQuad) allb+  xs  = zipWith (-) gxs $ map (quadL . boxGapQuad) allb+  ys1 = [ h - boxInnerHeight b | b <- boxes ] +  xs1 = odds xs++  outers = zipWith3 (\x y b -> translate (Pos x y) (boxOuterQuad b)) xs1 ys1 boxes+  outer1 = quadsLUB outers+  ho = quadHeight outer1+  yt = quadT      outer1+  yc = yt + 0.5*ho+  yleft  = yc - 0.5 * quadHeight (boxBoundingQuad left )   -- delimiters are trimmed+  ymid   = yc - 0.5 * quadHeight (boxBoundingQuad mid  )+  yright = yc - 0.5 * quadHeight (boxBoundingQuad right)++  ys2  = yleft : replicate (length boxes - 1) ymid ++ yright : []+  ys   = interleave ys2 ys1+  posList = zipWith Pos xs ys+  aboxes  = zipWith AbsBox posList allb+  bnd = quadsLUB (map absboxBoundingQuad aboxes)+  gap = quadsLUB (map absboxGapQuad      aboxes)+  Quad (ox1,_) (ox2,_) = quadsLUB $ map absboxOuterQuad $      aboxes+  Quad (_,oy1) (_,oy2) = quadsLUB $ map absboxOuterQuad $ odds aboxes+  outer = Quad (ox1,oy1) (ox2,oy2)+  box = Box (w,h) outer bnd gap++--------------------------------------------------------------------------------++interleave :: [a] -> [a] -> [a]+interleave (x:xs) (y:ys) = x:y:interleave xs ys+interleave xs     []     = xs+interleave []     ys     = ys+ +odds :: [a] -> [a]+odds (x:y:rest) = y : odds rest+odds [x] = []+odds []  = []+ +evens :: [a] -> [a]+evens (x:y:rest) = x : evens rest+evens [x] = [x]+evens []  = []  -------------------------------------------------------------------------------- 

@@ -86,6 +86,62 @@ -}  --------------------------------------------------------------------------------+-- * Delimiters++data WhichDelim+  = LeftDelim+  | RightDelim+  deriving (Eq,Ord,Show) ++-- | A delimiter type+data Delimiter+  = Paren        -- ^ parentheses (can stretch)+  | Square       -- ^ square brackets (can stretch)+  | Brace        -- ^ curly braces (can stretch)+  | Angle        -- ^ angle brackets+  | Ceil         -- ^ ceiling+  | Floor        -- ^ floor+  | Top          -- ^ top corners+  | Bottom       -- ^ bottom corners+  | Guillemet    -- ^ guillemet or french quote+  | AngleQuote   -- ^ single quillemet or angle quote+  | VertSingle   -- ^ vertical line (can stretch)+  | VertDouble   -- ^ double vertical line  (can stretch)+  | Tortoise     -- ^ tortoise brackets+  deriving (Eq,Ord,Show)++delimiterChars :: Delimiter -> (Char,Char)+delimiterChars b = case b of+  Paren        -> ( '(' , ')' )+  Square       -> ( '[' , ']' )+  Brace        -> ( '{' , '}' )+  Angle        -> ( '\x2329' , '\x232a' )+  Ceil         -> ( '\x2308' , '\x2309' )+  Floor        -> ( '\x230a' , '\x230b' )+  Top          -> ( '\x231c' , '\x231d' )+  Bottom       -> ( '\x231e' , '\x231f' )+  AngleQuote   -> ( '\x2039' , '\x203a' )+  Guillemet    -> ( '\x00ab' , '\x00bb' )+  VertSingle   -> ( '\x2223' , '\x2223' )+  VertDouble   -> ( '\x2225' , '\x2225' )+  Tortoise     -> ( '\x27ec' , '\x27ed' )++{-+  , "[[" ~> '\x27e6'+  , "]]" ~> '\x27e7'+  , "{|" ~> '\x2983'+  , "|}" ~> '\x2984'+  , "((" ~> '\x2985'+  , "))" ~> '\x2986'+  , "(|" ~> '\x2987'+  , "|)" ~> '\x2988'+  , "<|" ~> '\x2989'+  , "|>" ~> '\x298a'+  , "[|" ~> '\x27ec'    -- tortoise shell bracket+  , "|]" ~> '\x27ed'    -- tortoise shell bracket+-}++-------------------------------------------------------------------------------- -- * Positions  -- | A position. We use screen-space coordinates here 

@@ -0,0 +1,455 @@+
+-- | Automatically stretching\/growing (\*when possible) delimiters.
+--
+-- No need to import this module directly.
+--
+-- NOTE: these stretching delimiters are composed from overlayed unicode glyphs.
+-- They are designed to work with the STIX fonts, other fonts may produce
+-- unacceptable results. Transparent rendering is broken too (though that could
+-- be fixed in principle).
+--
+-- TODO: 
+-- 
+-- * growing ceil\/floor
+--
+-- * \"compound\" brackets like @[[@, @{|@, etc
+--
+-- * fix subscripts and superscripts of big delimited things
+--
+-- * cleaner implementation
+--
+-- * maybe hardwire the required glyphs from STIX so that it works with any font?
+--
+-- * fix transparency
+--
+
+
+{-# LANGUAGE BangPatterns, Rank2Types #-}
+module Graphics.Rendering.MiniTypeset.Delimiters where
+
+--------------------------------------------------------------------------------
+
+import Data.Ord
+import Data.Char hiding ( Space )
+import Data.List 
+
+import Control.Monad
+
+import Graphics.Rendering.MiniTypeset.Common
+import Graphics.Rendering.MiniTypeset.Document
+import Graphics.Rendering.MiniTypeset.Box
+
+{-
+-- used when generating code
+import Text.Printf
+import qualified Data.Map as Map ; import Data.Map (Map)
+import Graphics.Rendering.MiniTypeset.Layout
+import Graphics.Rendering.MiniTypeset.MultiFont
+-}
+
+--------------------------------------------------------------------------------
+
+delimHangAbove =  0.125  :: Double
+delimHangBelow = -0.075  :: Double
+delimHMargin   =  0.075  :: Double
+delimVMargin   =  0.075  :: Double
+
+--------------------------------------------------------------------------------
+
+-- | A compound delimiter is built from overlayed Unicode glyphs.
+-- It can be either fixed (a single glyph; two glyphs next to each other), or adjustable
+-- (glyphs with adjustable overlap)
+
+data CompoundDelim 
+  = FixDelim   (forall a.           Document a)      -- ^ something whose size is fixed
+  | Adjustable (forall a. Double -> Document a)      -- ^ something whose size can be adjusted
+
+sizedCompoundDelim :: CompoundDelim -> Double -> Document a
+sizedCompoundDelim cd x = case cd of
+  FixDelim   d -> Realign BoundingQuad $ Trim $ UnsafeResize (1,x) d
+  Adjustable f -> Realign BoundingQuad $ Trim $ f x
+
+--------------------------------------------------------------------------------
+-- * Utility
+
+rescale :: (Double,Double) -> Double -> Double
+rescale (!a,!b) !x 
+  | x < a     = 0
+  | x < b     = (x-a)/(b-a)
+  | otherwise = 1
+
+rescaleTo :: (Double,Double) -> (Double,Double) -> Double -> Double
+rescaleTo (a,b) (c,d) !x = c + (d-c) * rescale (a,b) x
+
+fdivmod :: Double -> Double -> (Int,Double)
+fdivmod a b = (n,x) where
+  n = floor (a/b) 
+  x = (a - fromIntegral n * b) / b
+
+--------------------------------------------------------------------------------
+
+symmNegMargin :: Double -> Document a -> Document a 
+symmNegMargin y = AddMargin (Margin 0 0 (-y) (-y))
+
+topNegMargin :: Double -> Document a -> Document a 
+topNegMargin y = AddMargin (Margin 0 0 (-y) 0)
+
+botNegMargin :: Double -> Document a -> Document a 
+botNegMargin y = AddMargin (Margin 0 0 0 (-y))
+
+--------------------------------------------------------------------------------
+-- * Growing delimiters
+
+type DelimGrower a = Height -> WhichDelim -> Double -> Document a
+
+data DelimImpl
+  = GrowingDelim (forall a. DelimGrower a)
+  | FixedDelim   !(Char,Char)
+--  | NotImplDelim
+  
+delimiterImpl :: Delimiter -> DelimImpl
+delimiterImpl delim = case delim of
+  Paren      -> GrowingDelim  growParen
+  Brace      -> GrowingDelim  growBrace
+  Square     -> GrowingDelim  growBracket
+  VertSingle -> GrowingDelim  growVertical
+  VertDouble -> GrowingDelim  growDblVertical
+  otherwise  -> FixedDelim   (delimiterChars delim)
+
+finalDelim :: Height -> Delimiter -> Double -> WhichDelim -> Document a
+finalDelim = finalDelim' 0
+
+finalDelim' :: Double -> Height -> Delimiter -> Double -> WhichDelim -> Document a
+finalDelim' yofs height@(Height h) delim target_in_pixels which = final where
+  final = RePosition (Pos 0 vofs) $ AddMargin (Margin mh mh mv mv) $ trimmed
+  vofs  = yofs {- - fh * delimHangBelow -}     -- align on bottom!
+  mh  = fh * delimHMargin
+  mv  = fh * delimVMargin
+  trimmed = case delimiterImpl delim of
+    GrowingDelim grow    -> grow height which target
+    FixedDelim (lch,rch) -> UnsafeResize (1, min 3 target) $ 
+                            Realign BoundingQuad $ 
+                            Trim $ Symbol $ 
+                            case which of { LeftDelim  -> lch ; RightDelim -> rch }
+  fh = fromIntegral h :: Double
+  extra  = fh * (delimHangAbove - delimHangBelow)
+  target = (target_in_pixels + extra) / fh
+
+--------------------------------------------------------------------------------
+-- * Figuring out how to build a delimiter of the target size 
+
+-- | Note: target height is relative to the font height, but not including line gap!
+-- You have to take line gap into account yourself if necessary.
+growBrace :: Height -> WhichDelim -> Double -> Document a
+growBrace height which target
+  | y < 1.425  = sizedCompoundDelim (buildBrace height 0 which) (rescaleTo (0.648,2.758) (0.700,3.000) y)
+  | y < 3.204  = sizedCompoundDelim (buildBrace height 1 which) (rescaleTo (1.425,6.136) (0.700,3.000) y)
+  | y < 4.504  = sizedCompoundDelim (buildBrace height 2 which) (rescaleTo (3.204,4.464) (0.000,1.000) y)
+  | y < 6.424  = sizedCompoundDelim (buildBrace height 3 which) (rescaleTo (4.504,6.424) (0.000,1.000) y)
+  | y < 8.344  = sizedCompoundDelim (buildBrace height 4 which) (rescaleTo (6.424,8.344) (0.000,1.000) y)
+  | y < 10.264  = sizedCompoundDelim (buildBrace height 5 which) (rescaleTo (8.344,10.264) (0.000,1.000) y)
+  | y < 12.184  = sizedCompoundDelim (buildBrace height 6 which) (rescaleTo (10.264,12.184) (0.000,1.000) y)
+  | otherwise = let (n,x) = fdivmod (y - 12.184) 1.920
+                    fn = fromIntegral n 
+                in  sizedCompoundDelim (buildBrace height (n+7) which) (rescaleTo (0.000,1.000) (0.000,1.000) x)
+  where 
+    y = target + (-0.078)
+
+growParen :: Height -> WhichDelim -> Double -> Document a
+growParen height which target
+  | y < 2.047  = sizedCompoundDelim (buildParen height 0 which) (rescaleTo (0.645,2.750) (0.700,3.000) y)
+  | y < 1.761  = sizedCompoundDelim (buildParen height 1 which) (rescaleTo (2.047,2.527) (0.000,1.000) y)
+  | y < 2.701  = sizedCompoundDelim (buildParen height 2 which) (rescaleTo (1.761,7.613) (0.700,3.000) y)
+  | y < 3.695  = sizedCompoundDelim (buildParen height 3 which) (rescaleTo (2.701,3.761) (0.000,1.000) y)
+  | y < 4.909  = sizedCompoundDelim (buildParen height 4 which) (rescaleTo (3.695,4.975) (0.000,1.000) y)
+  | y < 6.122  = sizedCompoundDelim (buildParen height 5 which) (rescaleTo (4.909,6.189) (0.000,1.000) y)
+  | y < 7.336  = sizedCompoundDelim (buildParen height 6 which) (rescaleTo (6.122,7.403) (0.000,1.000) y)
+  | otherwise = let (n,x) = fdivmod (y - 7.336) 1.214
+                    fn = fromIntegral n 
+                in  sizedCompoundDelim (buildParen height (n+7) which) (rescaleTo (0.000,1.054) (0.000,1.000) x)
+  where 
+    y = target + (-0.082)
+
+growBracket :: Height -> WhichDelim -> Double -> Document a
+growBracket height which target
+  | y < 2.055  = sizedCompoundDelim (buildBracket height 0 which) (rescaleTo (0.648,2.758) (0.700,3.000) y)
+  | y < 2.555  = sizedCompoundDelim (buildBracket height 1 which) (rescaleTo (2.055,2.535) (0.000,1.000) y)
+  | y < 3.235  = sizedCompoundDelim (buildBracket height 2 which) (rescaleTo (2.555,3.515) (0.000,1.000) y)
+  | y < 4.315  = sizedCompoundDelim (buildBracket height 3 which) (rescaleTo (3.235,4.475) (0.000,1.000) y)
+  | y < 5.275  = sizedCompoundDelim (buildBracket height 4 which) (rescaleTo (4.315,5.435) (0.000,1.000) y)
+  | y < 6.235  = sizedCompoundDelim (buildBracket height 5 which) (rescaleTo (5.275,6.395) (0.000,1.000) y)
+  | y < 7.195  = sizedCompoundDelim (buildBracket height 6 which) (rescaleTo (6.235,7.355) (0.000,1.000) y)
+  | otherwise = let (n,x) = fdivmod (y - 7.195) 0.960
+                    fn = fromIntegral n 
+                in  sizedCompoundDelim (buildBracket height (n+7) which) (rescaleTo (0.000,1.167) (0.000,1.000) x)
+  where 
+    y = target + (-0.078)
+
+growVertical :: Height -> WhichDelim -> Double -> Document a
+growVertical height which target
+  | y < 1.455  = sizedCompoundDelim (buildVertical height 0 which) (rescaleTo (0.633,2.703) (0.700,3.000) y)
+  | y < 1.929  = sizedCompoundDelim (buildVertical height 1 which) (rescaleTo (1.455,1.785) (0.000,1.000) y)
+  | y < 2.792  = sizedCompoundDelim (buildVertical height 2 which) (rescaleTo (1.929,3.529) (0.000,1.000) y)
+  | y < 3.654  = sizedCompoundDelim (buildVertical height 3 which) (rescaleTo (2.792,4.392) (0.000,1.000) y)
+  | y < 4.516  = sizedCompoundDelim (buildVertical height 4 which) (rescaleTo (3.654,5.254) (0.000,1.000) y)
+  | y < 5.379  = sizedCompoundDelim (buildVertical height 5 which) (rescaleTo (4.516,6.116) (0.000,1.000) y)
+  | y < 6.241  = sizedCompoundDelim (buildVertical height 6 which) (rescaleTo (5.379,6.979) (0.000,1.000) y)
+  | otherwise = let (n,x) = fdivmod (y - 6.241) 0.862
+                    fn = fromIntegral n 
+                in  sizedCompoundDelim (buildVertical height (n+7) which) (rescaleTo (0.000,1.855) (0.000,1.000) x)
+  where 
+    y = target + (-0.098)
+
+growDblVertical :: Height -> WhichDelim -> Double -> Document a
+growDblVertical height which target
+  | y < 1.455  = sizedCompoundDelim (buildDblVertical height 0 which) (rescaleTo (0.633,2.703) (0.700,3.000) y)
+  | y < 1.929  = sizedCompoundDelim (buildDblVertical height 1 which) (rescaleTo (1.455,1.785) (0.000,1.000) y)
+  | y < 2.792  = sizedCompoundDelim (buildDblVertical height 2 which) (rescaleTo (1.929,3.529) (0.000,1.000) y)
+  | y < 3.654  = sizedCompoundDelim (buildDblVertical height 3 which) (rescaleTo (2.792,4.392) (0.000,1.000) y)
+  | y < 4.516  = sizedCompoundDelim (buildDblVertical height 4 which) (rescaleTo (3.654,5.254) (0.000,1.000) y)
+  | y < 5.379  = sizedCompoundDelim (buildDblVertical height 5 which) (rescaleTo (4.516,6.116) (0.000,1.000) y)
+  | y < 6.241  = sizedCompoundDelim (buildDblVertical height 6 which) (rescaleTo (5.379,6.979) (0.000,1.000) y)
+  | otherwise = let (n,x) = fdivmod (y - 6.241) 0.862
+                    fn = fromIntegral n 
+                in  sizedCompoundDelim (buildDblVertical height (n+7) which) (rescaleTo (0.000,1.855) (0.000,1.000) x)
+  where 
+    y = target + (-0.098)
+  
+--------------------------------------------------------------------------------
+-- * Delimiter builders
+
+type CompoundLevel = Int
+
+type DelimBuilder = Height -> CompoundLevel -> WhichDelim -> CompoundDelim
+
+buildBrace :: DelimBuilder
+buildBrace (Height h) n lr
+  | n == 0     = FixDelim $ one
+  | n == 1     = FixDelim $ vcat [ botNegMargin (0.01*fh) top2 , topNegMargin (0.01*fh) bot2 ]
+  | n == 2     = Adjustable $ \x -> 
+                   let y = 0.02 + (1-x)*0.63
+                   in  vcat [ top3 , symmNegMargin (y*fh) mid3 , bot3 ]  
+  | otherwise  = Adjustable $ \x -> 
+                   let y   = 0.02 + (1-x)*0.48
+                       adj = symmNegMargin (y   *fh) ext3
+                       fix = symmNegMargin (0.02*fh) ext3
+                   in  vcat (top3 : replicate (n-3) fix ++ adj : mid3 : adj : replicate (n-3) fix ++ bot3 : [])
+  where
+    fh = fromIntegral h :: Double
+    mk ch = Trim (char ch)
+
+    one  = mk $ case lr of { LeftDelim -> '{'       ; RightDelim -> '}'       }
+
+    top2 = mk $ case lr of { LeftDelim -> braceSection1 ; RightDelim -> braceSection2 }
+    bot2 = mk $ case lr of { LeftDelim -> braceSection2 ; RightDelim -> braceSection1 }
+
+    top3 = mk $ case lr of { LeftDelim -> lbraceTop ; RightDelim -> rbraceTop }
+    mid3 = mk $ case lr of { LeftDelim -> lbraceMid ; RightDelim -> rbraceMid }
+    bot3 = mk $ case lr of { LeftDelim -> lbraceBot ; RightDelim -> rbraceBot }
+    ext3 = mk $ lrBraceExt
+
+--------------------------------------------------------------------------------
+
+buildParen :: DelimBuilder
+buildParen (Height h) n lr
+  | n == 0     = FixDelim $ one
+  | n == 1     = Adjustable $ \x -> let y = 0.02 + (1-x)*0.48 in vcat [ top , topNegMargin (y*fh) bot ]
+  | n == 2     = FixDelim $ vcat [ top , topNegMargin (0.02*fh) bot ]   -- parens suck in this font
+  | n == 3     = Adjustable $ \x -> 
+                   let y   = 0.02 + (1-x)*0.53
+                       adj = symmNegMargin (y   *fh) ext
+                   in  vcat (top : adj : bot : [])
+  | otherwise  = Adjustable $ \x -> 
+                   let y   = 0.02 + (1-x)*0.32
+                       adj = symmNegMargin (y   *fh) ext
+                       fix = symmNegMargin (0.02*fh) ext
+                   in  vcat (top : adj : replicate (n-4) fix ++ adj : bot : [])
+  where
+    fh = fromIntegral h :: Double
+    mk ch = Trim (char ch)
+
+    one = mk $ case lr of { LeftDelim -> '('       ; RightDelim -> ')'       }
+    top = mk $ case lr of { LeftDelim -> lparenTop ; RightDelim -> rparenTop }
+    ext = mk $ case lr of { LeftDelim -> lparenExt ; RightDelim -> rparenExt }
+    bot = mk $ case lr of { LeftDelim -> lparenBot ; RightDelim -> rparenBot }
+
+--------------------------------------------------------------------------------
+
+buildBracket :: DelimBuilder
+buildBracket (Height h) n lr
+  | n == 0     = FixDelim $ one
+  | n == 1     = Adjustable $ \x -> let y = 0.02 + (1-x)*0.48 in vcat [ top , topNegMargin (y*fh) bot ]
+  | n == 2     = Adjustable $ \x -> 
+                   let y   = 0.02 + (1-x)*0.53
+                       adj = symmNegMargin (y   *fh) ext
+                   in  vcat (top : adj : bot : [])
+  | n == 3     = Adjustable $ \x -> 
+                   let y   = 0.02 + (1-x)*0.31
+                       adj = symmNegMargin (y   *fh) ext
+                   in  vcat (top : adj : adj : bot : [])
+  | otherwise  = Adjustable $ \x -> 
+                   let y   = 0.02 + (1-x)*0.28
+                       adj = symmNegMargin (y   *fh) ext
+                       fix = symmNegMargin (0.02*fh) ext
+                   in  vcat (top : adj : replicate (n-3) fix ++ adj : bot : [])
+  where
+    fh = fromIntegral h :: Double
+    mk ch = Trim (char ch)
+
+    one = mk $ case lr of { LeftDelim -> '['         ; RightDelim -> ']'         }
+    top = mk $ case lr of { LeftDelim -> lbracketTop ; RightDelim -> rbracketTop }
+    ext = mk $ case lr of { LeftDelim -> lbracketExt ; RightDelim -> rbracketExt }
+    bot = mk $ case lr of { LeftDelim -> lbracketBot ; RightDelim -> rbracketBot }
+
+--------------------------------------------------------------------------------
+
+buildVertical :: DelimBuilder
+buildVertical (Height h) n _lr_
+  | n == 0     = FixDelim $ one
+  | n == 1     = Adjustable $ \x -> let y = 0.02 + (1-x)*0.33 in vcat [ one , topNegMargin (y*fh) one ]
+  | otherwise  = Adjustable $ \x -> 
+                   let y   = 0.02 + (1-x)*0.40
+                       adj = symmNegMargin (y   *fh) one
+                       fix = symmNegMargin (0.02*fh) one
+                   in  vcat (one : adj : replicate (n-2) fix ++ adj : one : [])
+  where
+    fh = fromIntegral h :: Double
+    mk ch = Trim (char ch)
+
+    one = mk '\x2223'
+
+buildDblVertical :: DelimBuilder
+buildDblVertical (Height h) n _lr_
+  | n == 0     = FixDelim $ one
+  | n == 1     = Adjustable $ \x -> let y = 0.02 + (1-x)*0.33 in vcat [ one , topNegMargin (y*fh) one ]
+  | otherwise  = Adjustable $ \x -> 
+                   let y   = 0.02 + (1-x)*0.40
+                       adj = symmNegMargin (y   *fh) one
+                       fix = symmNegMargin (0.02*fh) one
+                   in  vcat (one : adj : replicate (n-2) fix ++ adj : one : [])
+  where
+    fh = fromIntegral h :: Double
+    mk ch = Trim (char ch)
+
+    one = mk '\x2225'
+ 
+--------------------------------------------------------------------------------
+-- * Unicode codepoint constants
+
+lparenTop = '\x239b' 
+lparenExt = '\x239c'
+lparenBot = '\x239d'
+
+rparenTop = '\x239e' 
+rparenExt = '\x239f'
+rparenBot = '\x23a0'
+
+lbracketTop = '\x23a1'
+lbracketExt = '\x23a2'
+lbracketBot = '\x23a3'
+
+rbracketTop = '\x23a4'
+rbracketExt = '\x23a5'
+rbracketBot = '\x23a6'
+
+lbraceTop = '\x23a7'
+lbraceMid = '\x23a8'
+lbraceBot = '\x23a9'
+
+lrBraceExt = '\x23aa'
+
+rbraceTop = '\x23ab'
+rbraceMid = '\x23ac'
+rbraceBot = '\x23ad'
+
+intTop = '\x2320'
+intExt = '\x23ae'
+intBot = '\x2321'
+
+braceSection1 = '\x23b0'
+braceSection2 = '\x23b1'
+
+--------------------------------------------------------------------------------
+{- /// CODE GENERATION ///
+
+measure :: Ord fontfile => MultiFont fontfile style -> Height -> Document String -> IO Double
+measure mf (Height h) doc0 = do
+  let doc = Identified ("measure" :: String) $ Trim doc0
+  lout <- createLayout mf (Height h) doc
+  usertable <- dryrunLayout lout (Pos 0 0)
+  let AbsBox _ box = (Map.!) usertable "measure"
+  let res = quadHeight $ boxBoundingQuad box
+  return (res / fromIntegral h)
+
+--------------------------------------------------------------------------------
+
+testDelimBuilder :: Ord fontfile => MultiFont fontfile style -> DelimBuilder -> IO ()
+testDelimBuilder mf builder = do
+  let h = Height 256
+  forM_ [0..5] $ \n -> do
+    putStrLn $ "level (n) = " ++ show n
+    let cdelim = builder h n LeftDelim
+    case cdelim of
+      FixDelim mkdoc -> do
+        putStr "Fixed      -> "
+        list <- forM [0.75,0.875..1.5] $ \x -> measure mf h (Trim $ UnsafeResize (1,x) mkdoc)
+        print list
+      Adjustable mkdoc -> do
+        putStr "Adjustable -> "
+        list <- forM [0,0.1..1] $ \x -> measure mf h (mkdoc x)
+        print list
+
+--------------------------------------------------------------------------------
+
+-- | Generate code for automatically sizing growable delimiters
+writeGrowingDelimFromMeasurement :: Ord fontfile => MultiFont fontfile style -> String -> DelimBuilder -> IO [String]
+writeGrowingDelimFromMeasurement mf what builder = do
+  let ht    = Height 256
+      which = LeftDelim
+  base <- case (builder ht 0 which) of { FixDelim doc -> measure mf ht doc }
+  let ofs = base - 1
+  let candi1 n = let cd = builder ht n LeftDelim in case cd of
+        FixDelim     doc -> [ ((n,x) , Trim (UnsafeResize (1,x) doc) ) | x <- [0.7,0.75..3.0] ]
+        Adjustable mkdoc -> [ ((n,x) , mkdoc x                       ) | x <- [0,0.025..1.0]  ]
+  let candidates = concat [ candi1 n | n<-[0..7] ]
+  hs <- forM candidates $ \((n,x),doc) -> measure mf ht doc
+  let sorted = sortBy (comparing fst) $ zip hs candidates 
+      groups = [ [ ((k,x),h) | (h,((k,x),doc)) <- sorted , k==n ] | n <- [0..7] ]
+      smallest = map head groups
+      largest  = map last groups
+   
+  let choices = 
+        [ "  | y < " ++ printf "%.3f" h2 ++ 
+          "  = sizedCompoundDelim (" ++ what ++ " height " ++ show k1a ++ " which) " ++ 
+          (printf "(rescaleTo (%.3f,%.3f) (%.3f,%.3f) y)" h1a h1b x1a x1b)
+        | ( ( ((k1a,x1a),h1a) , ((k2,x2),h2) ) , ((k1b,x1b),h1b) ) <- zip (pairs smallest) largest
+        ] 
+
+  let ( ( ((k1a,x1a),h1a) , ((k2a ,x2a ),h2a ) ) , ( ((k1b,x1b),h1b) , ((k2b,x2b),h2b) ) ) = last (zip (pairs smallest) (pairs largest))
+      extrap = 
+        [ "  | otherwise = let (n,x) = " ++ printf "fdivmod (y - %.3f) %.3f" h2a (h2a-h1a) 
+        , "                    fn = fromIntegral n "                
+        , "                in  sizedCompoundDelim (" ++ what ++ " height " ++ printf "(n+%d)" (k1a+1) ++ " which) " ++ 
+          (printf "(rescaleTo (%.3f,%.3f) (%.3f,%.3f) x)" ((h1a-h1a)/(h2a-h1a)) ((h1b-h1a)/(h2a-h1a)) x1a x1b)
+        ]
+
+  let ls =
+        [ "grow :: Height -> WhichDelim -> Double -> Document a"
+        , "grow height which target" 
+        ] 
+        ++ choices 
+        ++ extrap ++ 
+        [ "  where "
+        , "    y = target + " ++ printf "(%.3f)" ofs 
+        ]
+  putStrLn $ unlines ls
+  return ls
+
+
+pairs :: [a] -> [(a,a)]
+pairs (x:xs@(y:_)) = (x,y) : pairs xs
+pairs [x] = []
+pairs []  = []
+
+-}
+--------------------------------------------------------------------------------

@@ -2,10 +2,11 @@ -- | The document type, which expresses the intent of the user about -- what to render. ----- We support general layouting \/ formatting, and also construction+-- We support general layouting \/ formatting, and also constructions -- specific to mathematical documents (similar to LaTeX). ----- TODO: fractions, brackets, mathemetical accents, compound symbols+-- TODO: mathemetical accents, compound symbols, +--       user-defined styles, squiggly underlines, etc --  {-# LANGUAGE OverloadedStrings, BangPatterns #-}@@ -29,21 +30,26 @@ -- different parts of the rendered text. It must have an 'Ord' instance. -- data Document ident-  = Symbol       !Char                                     -- ^ a single character or symbol-  | String       !String                                   -- ^ a string -  | Space                                                  -- ^ a space character (do we need this to be separate?)-  | HorzCat      !VAlign              [Document ident]     -- ^ horizontal concatenation-  | VertCat      !HAlign              [Document ident]     -- ^ vertical concatenation-  | Overlay      !(HAlign,VAlign)     [Document ident]     -- ^ overlaying on the top of each other-  | SubSupScript !(SubSup ident)     !(Document ident)     -- ^ add subscript and\/or superscript-  | AboveBelow   !(AboveBelow ident) !(Document ident)     -- ^ above\/below (like in a summation or limit)-  | WithColor    !Col                !(Document ident)     -- ^ change color-  | WithStyle    !BasicStyle         !(Document ident)     -- ^ change font family-  | Decorated    !TextDecoration     !(Document ident)     -- ^ add text decoration-  | Identified   !ident              !(Document ident)     -- ^ user identifier so that the layout engine can return position information-  | AddMargin    !Margin             !(Document ident)     -- ^ an extra margin around the document-  | Realign      !WhichQuad          !(Document ident)     -- ^ change the alignment box-  | EmptyDoc                                               -- ^ the empty document+  = Symbol       !Char                                      -- ^ a single character or symbol+  | String       !String                                    -- ^ a string +  | Space                                                   -- ^ a space character (do we need this to be separate?)+  | HorzCat      !VAlign              [Document ident]      -- ^ horizontal concatenation+  | VertCat      !HAlign              [Document ident]      -- ^ vertical concatenation+  | Overlay      !(HAlign,VAlign)     [Document ident]      -- ^ overlaying on the top of each other+  | SubSupScript !(SubSup ident)     !(Document ident)      -- ^ add subscript and\/or superscript+  | Delimited    !Delimiter           [Document ident]      -- ^ automatically sized (when possible) delimiters+  | Fraction     !Bool !(Document ident) !(Document ident)  -- ^ fractions (the Bool signifies whether to draw the line)+  | AboveBelow   !(AboveBelow ident) !(Document ident)      -- ^ above\/below (like in a summation or limit)+  | WithColor    !Col                !(Document ident)      -- ^ change color+  | WithStyle    !BasicStyle         !(Document ident)      -- ^ change font family+  | Decorated    !TextDecoration     !(Document ident)      -- ^ add text decoration+  | AddMargin    !Margin             !(Document ident)      -- ^ an extra margin around the document fragment+  | Realign      !WhichQuad          !(Document ident)      -- ^ change the alignment box+  | Trim                             !(Document ident)      -- ^ trim the outer \& gap boxes to the bounding box+  | RePosition   !Pos                !(Document ident)      -- ^ offset (mostly for internal usage)+  | UnsafeResize !(Double,Double)    !(Document ident)      -- ^ temporary hack for internal usage, DO NOT USE IT! +  | Identified   !ident              !(Document ident)      -- ^ user identifier so that the layout engine can return position information+  | EmptyDoc                                                -- ^ the empty document   deriving (Eq,Ord,Show)  --------------------------------------------------------------------------------@@ -53,6 +59,7 @@   = Underline   | Overline   | StrikeThrough+--  | SquigglyUnderline   deriving (Eq,Ord,Show)  --------------------------------------------------------------------------------@@ -147,7 +154,7 @@ vcatR :: [Document a] -> Document a vcatR = VertCat AlignRight --- * Subscript and superscript+-- ** Subscript and superscript  subscript :: Document a -> Document a -> Document a subscript doc sub = SubSupScript (Subscript sub) doc@@ -158,7 +165,7 @@ subSup :: Document a -> (Document a, Document a) -> Document a subSup doc (sub,sup) = SubSupScript (SubAndSupscript sub sup) doc --- * Above and below+-- ** Above and below  -- | Used for \"big\" mathematical operators (like summation) above :: Document a -> Document a -> Document a@@ -170,14 +177,33 @@ aboveBelow :: Document a -> (Document a, Document a) -> Document a aboveBelow doc (ab,be) = AboveBelow (AboveAndBelow ab be) doc --- * Text decoration+-- ** Fractions and delimiters +fraction :: Document a -> Document a -> Document a+fraction = Fraction True++-- | \"n choose k\" notation+choose :: Document a -> Document a -> Document a+choose = choose' Paren++choose' :: Delimiter -> Document a -> Document a -> Document a+choose' delim above below = delimited delim (Fraction False above below)++delimited :: Delimiter -> Document a -> Document a+delimited delim doc = Delimited delim [doc]++-- | Puts a matched vertical line between the parts+delimiteds :: Delimiter -> [Document a] -> Document a+delimiteds delim docs = Delimited delim docs++-- ** Text decoration+ underline, overline, strike :: Document a -> Document a underline = Decorated Underline      overline  = Decorated Overline       strike    = Decorated StrikeThrough  --- * Font variations+-- ** Font variations  regular, bold, italic, boldItalic :: Document a -> Document a regular    = WithStyle Regular@@ -185,7 +211,7 @@ italic     = WithStyle Italic boldItalic = WithStyle BoldItalic --- * Colors+-- ** Colors  white, black, red, green, blue :: Document a -> Document a white = WithColor (Col 1 1 1)@@ -197,7 +223,7 @@ rgb :: Float -> Float -> Float -> Document a -> Document a rgb r g b = WithColor (Col r g b) --- * Margins+-- ** Margins  margin :: Double -> Document a -> Document a  margin x = AddMargin (Margin x x x x)@@ -210,34 +236,5 @@  margin' :: Double -> Double -> Double -> Double -> Document a -> Document a  margin' l r t b = AddMargin (Margin l r t b)------------------------------------------------------------------------------------- * Brackets (not implemented yet)--data Bracket-  = Paren-  | Square-  | Brace-  | Angle        -- 2329 / 232a-  | Ceil         -- 2308 / 2309-  | Floor        -- 230a / 230b-  | Top          -- 231c / 231d-  | Bottom       -- 231e / 231f-  | AngleQuote   -- 2039 / 203a-  | FrenchQuote  -- 00ab / 00bb-  deriving (Eq,Ord,Show)--bracketChars :: Bracket -> (Char,Char)-bracketChars b = case b of-  Paren        -> ( '(' , ')' )-  Square       -> ( '[' , ']' )-  Brace        -> ( '{' , '}' )-  Angle        -> ( '\x2329' , '\x232a' )-  Ceil         -> ( '\x2308' , '\x2309' )-  Floor        -> ( '\x230a' , '\x230b' )-  Top          -> ( '\x231c' , '\x231d' )-  Bottom       -> ( '\x231e' , '\x231f' )-  AngleQuote   -> ( '\x2039' , '\x203a' )-  FrenchQuote  -> ( '\x00ab' , '\x00bb' )  --------------------------------------------------------------------------------

@@ -126,7 +126,7 @@ data FontTexture = FontTexture
   { _ftexFont    :: !Font
   , _ftexName    :: !String
-  , _ftexHeight  :: !Float
+  , _ftexHeight  :: !(Float,Float)   -- x and y height
   , _ftexScaling :: !Scaling
   , _ftexVM      :: !(VerticalMetrics Float)
   , _ftexChars   :: !(UnicodeCache (Maybe BufLoc))
@@ -146,15 +146,17 @@ defaultTextureSize = (512,512) -- (128,128) -- (512,512) -- (1024,1024)
 
 newFontTexture :: Font -> Float -> String -> IO FontTexture
-newFontTexture font height name = newFontTexture' font height name defaultTextureSize 1
+newFontTexture font height name = newFontTexture' font (height,height) name defaultTextureSize 1
 
--- | Creates a new (empty) font texture
-newFontTexture' :: Font -> Float -> String -> (Int,Int) -> Double -> IO FontTexture
-newFontTexture' font height name size lgapfactor = do
+-- | Creates a new (empty) font texture. We allow different horizontal and vertical scaling,
+-- but both are measured in /pixel heights/ 
+newFontTexture' :: Font -> (Float,Float) -> String -> (Int,Int) -> Double -> IO FontTexture
+newFontTexture' font (xheight,yheight) name size lgapfactor = do
   uc  <- newUnicodeCache
   vmu <- getFontVerticalMetrics font
-  let s   = scaleForPixelHeight vmu height
-      vms = fmap (scaleU s) vmu
+  let sx  = scaleForPixelHeight vmu xheight
+      sy  = scaleForPixelHeight vmu yheight
+      vms = fmap (scaleU sy) vmu
 
 --  print vmu
 --  print vms
@@ -164,8 +166,8 @@   let ftex = FontTexture
         { _ftexFont    = font
         , _ftexName    = name
-        , _ftexHeight  = height
-        , _ftexScaling = (s,s)
+        , _ftexHeight  = (xheight,yheight)
+        , _ftexScaling = (sx,sy)
         , _ftexVM      = vms
         , _ftexChars   = uc
         , _ftexBufSize = size 

@@ -6,6 +6,8 @@ 
 --------------------------------------------------------------------------------
 
+import Data.List ( intersperse )
+
 import Control.Monad
 import Data.IORef
 
@@ -20,10 +22,13 @@ import Graphics.Rendering.MiniTypeset.Common
 import Graphics.Rendering.MiniTypeset.Box
 import Graphics.Rendering.MiniTypeset.Document
+import Graphics.Rendering.MiniTypeset.Delimiters
 import Graphics.Rendering.MiniTypeset.FontTexture
 import Graphics.Rendering.MiniTypeset.MultiFont
 import Graphics.Rendering.MiniTypeset.Render
 
+-- import qualified Unsafe.Coerce as Unsafe      -- debugging only!
+
 --------------------------------------------------------------------------------
 -- * Relative position and size constants (mathematical coordinate system!)
 
@@ -33,32 +38,61 @@ 
 underlinePos     = -0.10 :: Double      -- Underline relative position
 overlinePos      =  0.10 :: Double      -- Overline relative position
-strikeThroughPos = 0.48  :: Double      -- Strike-through relative position
+strikeThroughPos = 0.29  :: Double      -- Strike-through relative position
 horizLineWidth   = 0.045 :: Double      -- Text decoration line width
 
 abovePos  =  0.15 :: Double
 belowPos  = -0.15 :: Double
 
+fractionSize = 0.9        :: Double         -- first-level fraction size
+fracLinePos = 0.32 - 0.08 :: Double          -- vertical position of the fraction line
+fracYMargin = 0.08        :: Double
+
 --------------------------------------------------------------------------------
 -- * Subscript size indexing
 
 -- | 0 is the default size, 1 is smaller, 2 is even smaller, etc (each subscript 
-newtype SizeIndex
-  = SizeIndex Int
+data SizeIndex
+  = NormalSize             -- ^ normal text size
+  | FractionSize           -- ^ first-level fraction 
+  | ScriptSize1            -- ^ first-level subscript
+  | ScriptSize2            -- ^ second-level subscript
+  | ScriptSize3            -- ^ third-level subscript
+  | CustomSize !(Double,Double) !SizeIndex    -- ^ temporary hack
   deriving (Eq,Ord,Show) 
  
-succSizeIndex :: SizeIndex -> SizeIndex
-succSizeIndex (SizeIndex n) = SizeIndex (n+1)
+scriptSuccSizeIndex :: SizeIndex -> SizeIndex
+scriptSuccSizeIndex idx = case idx of
+  NormalSize    -> ScriptSize1        
+  FractionSize  -> ScriptSize1
+  ScriptSize1   -> ScriptSize2
+  ScriptSize2   -> ScriptSize3
+  ScriptSize3   -> ScriptSize3
+  CustomSize {} -> error "scriptSuccSizeIndex: Custom"
 
-calculateSizeHeight :: Height -> SizeIndex -> Int
-calculateSizeHeight (Height height) = go where
-  go (SizeIndex n)
-    | n == 0  = height
-    | n == 1  = round (fromIntegral height * subSupSize)
-    | n == 2  = round (fromIntegral height * subSupSize * subSupSize)
-    | n == 3  = round (fromIntegral height * subSupSize * subSupSize * 0.8)
-    | n >  3  = go (SizeIndex 3) 
+fracSuccSizeIndex :: SizeIndex -> SizeIndex
+fracSuccSizeIndex idx = case idx of
+  NormalSize    -> FractionSize       
+  FractionSize  -> ScriptSize1
+  ScriptSize1   -> ScriptSize2
+  ScriptSize2   -> ScriptSize3
+  ScriptSize3   -> ScriptSize3
+  CustomSize {} -> error "fracSuccSizeIndex: Custom"
 
+calculateSizeXHeight :: Height -> SizeIndex -> Int
+calculateSizeXHeight ht@(Height height) idx = case idx of
+  CustomSize (x,y) si -> round (fromIntegral (calculateSizeXHeight ht si) * x)
+  _                   -> calculateSizeYHeight (Height height) idx
+
+calculateSizeYHeight :: Height -> SizeIndex -> Int
+calculateSizeYHeight ht@(Height height) idx = case idx of
+  NormalSize    -> height
+  FractionSize  -> round (fromIntegral height * fractionSize)
+  ScriptSize1   -> round (fromIntegral height * subSupSize)
+  ScriptSize2   -> round (fromIntegral height * subSupSize * subSupSize)
+  ScriptSize3   -> round (fromIntegral height * subSupSize * subSupSize * 0.8)
+  CustomSize (x,y) si -> round (fromIntegral (calculateSizeYHeight ht si) * y)
+
 --------------------------------------------------------------------------------
 -- * The layout data type
 
@@ -78,6 +112,7 @@ data LayoutDecoration 
   = HorizLine 
       { _hlineCol       :: !Col 
+      , _hlineWhichQuad :: !WhichQuad    -- align to which quad
       , _hlineVAlign    :: !VAlign
       , _hlineVPos      :: !Double 
       , _hlineLineWidth :: !Double 
@@ -196,8 +231,8 @@ renderLayoutDecoration :: AbsBox -> LayoutDecoration -> IO ()
 renderLayoutDecoration absbox decor = case decor of
 
-  HorizLine col valign vpos lwidth -> do
-    let Quad (x1,y1) (x2,y2) = absboxBoundingQuad absbox
+  HorizLine col whichquad valign vpos lwidth -> do
+    let Quad (x1,y1) (x2,y2) = absboxSelectQuad whichquad absbox
     let y = case valign of
               AlignTop    -> y1 - vpos
               AlignBottom -> y2 - vpos 
@@ -233,7 +268,7 @@ 
 defaultCfg :: Cfg
 defaultCfg = Cfg
-  { _currentSize  = SizeIndex 0
+  { _currentSize  = NormalSize
   , _currentStyle = Regular
   , _currentColor = Col 0 0 0
   }
@@ -252,11 +287,12 @@ 
   initialCfg = defaultCfg 
 
-  sizeHeight :: SizeIndex -> Int
-  sizeHeight = calculateSizeHeight height
+  sizeXHeight, sizeYHeight :: SizeIndex -> Int
+  sizeXHeight = calculateSizeXHeight height
+  sizeYHeight = calculateSizeYHeight height
 
-  fsizeHeight :: SizeIndex -> Double
-  fsizeHeight = fromIntegral . sizeHeight
+  fsizeYHeight :: SizeIndex -> Double
+  fsizeYHeight = fromIntegral . sizeYHeight
 
   relativePlacement :: ([Box] -> (Box,[AbsBox])) -> Cfg -> [Document ident] -> IO (Box, Layout ident style)
   relativePlacement place !cfg docs  = case docs of
@@ -279,22 +315,22 @@ 
     Decorated decor doc -> do  
       (box,lout) <- go cfg doc 
-      let col    =              _currentColor cfg
-          ht     = fsizeHeight (_currentSize  cfg)
+      let col    =               _currentColor cfg
+          ht     = fsizeYHeight (_currentSize  cfg)
           lwidth = horizLineWidth * ht
           ldecor = case decor of
-            Underline     -> HorizLine col AlignBottom (underlinePos     * ht) lwidth
-            Overline      -> HorizLine col AlignTop    (overlinePos      * ht) lwidth
-            StrikeThrough -> HorizLine col AlignBottom (strikeThroughPos * ht) lwidth
+            Underline     -> HorizLine col BoundingQuad AlignBottom (underlinePos     * ht) lwidth
+            Overline      -> HorizLine col BoundingQuad AlignTop    (overlinePos      * ht) lwidth
+            StrikeThrough -> HorizLine col InnerQuad    AlignBottom (strikeThroughPos * ht) lwidth
       return (box, LoutDecor ldecor lout)
 
     SubSupScript subsup doc -> do
       let (doc1,doc2) = subSupDocs subsup
       (box0,lout0) <- go cfg  doc
-      let cfg' = cfg { _currentSize = succSizeIndex (_currentSize cfg) }
+      let cfg' = cfg { _currentSize = scriptSuccSizeIndex (_currentSize cfg) }
       (box1,lout1) <- go cfg' doc1 
       (box2,lout2) <- go cfg' doc2
-      let ht     = fsizeHeight (_currentSize  cfg)
+      let ht     = fsizeYHeight (_currentSize  cfg)
           ofs1   = - subPos * ht
           ofs2   = - supPos * ht
       let (box,(pos1,pos2)) = subSupScriptBox box0 (ofs1,box1) (ofs2,box2)
@@ -304,19 +340,70 @@     AboveBelow aboveBelow doc -> do
       let (doc1,doc2) = aboveBelowDocs aboveBelow
       (box0,lout0) <- go cfg  doc
-      let cfg' = cfg { _currentSize = succSizeIndex (_currentSize cfg) }
+      let cfg' = cfg { _currentSize = scriptSuccSizeIndex (_currentSize cfg) }
       (box1,lout1) <- go cfg' doc1 
       (box2,lout2) <- go cfg' doc2
-      let ht     = fsizeHeight (_currentSize  cfg)
+      let ht     = fsizeYHeight (_currentSize  cfg)
           ofs1   = Pos 0 (- abovePos * ht)
           ofs2   = Pos 0 (- belowPos * ht)
       let (box,(pos1,pos2)) = aboveBelowBox box0 (ofs1,box1) (ofs2,box2)
           lout = LoutGroup box [ lout0, translate pos1 lout1 , translate pos2 lout2 ]
       return (box,lout)
 
+    -- TODO: optimized this (docs are computed twice now!)
+    Delimited delim docs -> do
+      let h = sizeYHeight (_currentSize cfg)
+      (box0,_) <- go cfg (HorzCat AlignBottom docs)
+      let outer = boxOuterQuad box0
+          tgt  = quadHeight outer
+          vofs = 0 
+      -- print box0
+      let left  = finalDelim' vofs (Height h) delim      tgt LeftDelim
+          right = finalDelim' vofs (Height h) delim      tgt RightDelim
+          mid   = finalDelim' vofs (Height h) VertSingle tgt RightDelim
+
+      -- go cfg $ HorzCat AlignBottom $ left : intersperse mid docs ++ right : []
+
+      (bl,loutl) <- go cfg left
+      (bm,loutm) <- go cfg mid
+      (br,loutr) <- go cfg right
+      (boxes,louts) <- unzip <$> mapM (go cfg) docs 
+      let (box,poslist) = delimiterBox (bl,bm,br) boxes
+          lout = LoutGroup box 
+               $ zipWith translate poslist 
+               $ (loutl : intersperse loutm louts ++ loutr : []) 
+      return (box,lout)
+
     Realign which doc -> do
       (box , lout) <- go cfg doc 
-      let box' = realignBox which box 
+      let (ofs, box') = realignBox which box 
+      return (box', reboxLayout box' $ translateLayout ofs $ lout)
+
+    Fraction drawline doc1 doc2 -> do
+      let csiz = _currentSize cfg
+      let cfg' = cfg { _currentSize = fracSuccSizeIndex csiz }
+          mbtrim = case csiz of { NormalSize -> id ; _ -> Trim }
+      (box1,lout1) <- go cfg' $ mbtrim doc1 
+      (box2,lout2) <- go cfg' $ mbtrim doc2
+      let (w1,h1) = quadSize $ boxBoundingQuad box1 -- boxOuterQuad box1
+          (w2,h2) = quadSize $ boxBoundingQuad box2 -- boxOuterQuad box2
+          w  = max w1 w2 
+      let ht     = fsizeYHeight (_currentSize  cfg)
+          ymarg  = (ht * fracYMargin)
+      let (box,(pos1,pos2)) = fractionBox ymarg box1 box2
+          lout0 = LoutGroup box [ translate pos1 lout1 , translate pos2 lout2 ]
+      let col    =               _currentColor cfg
+          lwidth = horizLineWidth * ht
+      let yofs = - fracLinePos * ht
+          pos  = Pos 0 yofs
+      let lout = case drawline of
+            False -> lout0
+            True  -> LoutDecor (HorizLine col InnerQuad AlignBottom (0) lwidth) lout0
+      return (shiftBox pos box, translateLayout pos lout)
+               
+    Trim doc -> do
+      (box , lout) <- go cfg doc 
+      let box' = trimBox box
       return (box', reboxLayout box' lout)
 
     AddMargin margin doc -> do
@@ -326,6 +413,15 @@           box' = Box siz outer' bound gap'
       return (box' , reboxLayout box' lout)
 
+    RePosition pos doc -> do 
+      (box , lout) <- go cfg doc 
+      return (shiftBox pos box, translateLayout pos lout)
+
+    UnsafeResize (x,y) doc -> do
+      let sidx = _currentSize cfg
+          cfg' = cfg { _currentSize = CustomSize (x,y) sidx }
+      go cfg' doc
+
     Identified uid doc -> do
       (box, lout) <- go cfg doc
       return (box, LoutIdent uid lout)
@@ -333,7 +429,7 @@     Symbol char -> do
       let Cfg size style0 col = cfg
           style = styleMap style0
-      mfg@(MFG ftex bufloc) <- lkpMultiFont multifont (sizeHeight size) style char 
+      mfg@(MFG ftex bufloc) <- lkpMultiFont' multifont (sizeXHeight size, sizeYHeight size) style char 
       let relbox = mfgRelBox mfg
           lout = LoutGlyph (Pos 0 0) style col char mfg
       return (relbox, lout)

@@ -100,13 +100,17 @@   Nothing  -> Nothing
   Just sub -> IntMap.lookup j sub
 
-mfAddNewFontTex :: Ord fontfile => MultiFont fontfile style -> (fontfile,Int) -> IO ()
-mfAddNewFontTex mf (ffile,height) = do
+encodeXYHeight :: (Int,Int) -> Int
+encodeXYHeight (xheight,yheight) = yheight * 32768 + xheight
+
+mfAddNewFontTex :: Ord fontfile => MultiFont fontfile style -> (fontfile,(Int,Int)) -> IO ()
+mfAddNewFontTex mf (ffile,(xheight,yheight)) = do
   old_table <- readIORef (_mfFontTexs mf) 
   let fpath = (_ufcFontFiles $ _mfUserConfig mf) ffile
   font <- loadFontFile fpath
-  ftex <- newFontTexture' font (fromIntegral height) (takeFileName fpath) (stdFontTextureSize height) (mfLineGapFactor mf)
-  let new_table = mapInsert (IntMap.singleton height ftex) (IntMap.insert height ftex) ffile old_table
+  let idx = encodeXYHeight (xheight,yheight)
+  ftex <- newFontTexture' font (fromIntegral xheight, fromIntegral yheight) (takeFileName fpath) (stdFontTextureSize yheight) (mfLineGapFactor mf)
+  let new_table = mapInsert (IntMap.singleton idx ftex) (IntMap.insert idx ftex) ffile old_table
   writeIORef (_mfFontTexs mf) new_table
 
 --------------------------------------------------------------------------------
@@ -120,27 +124,32 @@ mfgLineGapFactor (MFG ftex _) = _ftexLGapFactor ftex
 
 {-
-mbLkpMultiFont :: Ord fontfile => MultiFont fontfile style -> Int -> style -> Char -> IO (Maybe MultiFontGlyph)
-mbLkpMultiFont multifont height style char = do
+mbLkpMultiFont' :: Ord fontfile => MultiFont fontfile style -> (Int,Int) -> style -> Char -> IO (Maybe MultiFontGlyph)
+mbLkpMultiFont' multifont xyheight style char = do
   table <- readIORef (_mfFontTexs multifont) 
   let fontfile = mfCharMap multifont style char
-  case mapIntLookup fontfile height table of
+  let idx = encodeXYHeight xyheight
+  case mapIntLookup fontfile idx table of
     Nothing -> do
-      mfAddNewFontTex multifont (fontfile,height) 
-      mbLkpMultiFont multifont height style char 
+      mfAddNewFontTex multifont (fontfile,xyheight) 
+      mbLkpMultiFont multifont idx style char 
     Just ftex -> do
       mbloc <- mbLookupFontTexture ftex char
       return $ liftM (\loc -> (MFG ftex loc)) mbloc
 -}
 
 lkpMultiFont :: Ord fontfile => MultiFont fontfile style -> Int -> style -> Char -> IO MultiFontGlyph
-lkpMultiFont multifont height style char = do
+lkpMultiFont multifont height style char = lkpMultiFont' multifont (height,height) style char
+
+lkpMultiFont' :: Ord fontfile => MultiFont fontfile style -> (Int,Int) -> style -> Char -> IO MultiFontGlyph
+lkpMultiFont' multifont xyheight style char = do
   table <- readIORef (_mfFontTexs multifont) 
   let fontfile = mfCharMap multifont style char
-  case mapIntLookup fontfile height table of
+  let idx = encodeXYHeight xyheight
+  case mapIntLookup fontfile idx table of
     Nothing -> do
-      mfAddNewFontTex multifont (fontfile,height) 
-      lkpMultiFont multifont height style char 
+      mfAddNewFontTex multifont (fontfile,xyheight) 
+      lkpMultiFont' multifont xyheight style char 
     Just ftex -> do
       loc <- lookupFontTexture ftex char
       return $ MFG ftex loc

@@ -62,6 +62,33 @@ renderBoundingBoxQuad = renderQuad . absboxBoundingQuad
 
 --------------------------------------------------------------------------------
+-- * Render box outlines
+
+renderQuadOutline :: Quad -> IO ()
+renderQuadOutline (Quad (x1,y1) (x2,y2)) = 
+  renderPrimitive LineLoop $ do
+    vertex (Vertex2 x1 y1)
+    vertex (Vertex2 x2 y1)
+    vertex (Vertex2 x2 y2)
+    vertex (Vertex2 x1 y2)
+
+-- | Renders the outer box as a quad
+renderOuterBoxOutline :: AbsBox -> IO ()
+renderOuterBoxOutline  = renderQuadOutline . absboxOuterQuad
+
+-- | Renders the inner box as a quad
+renderInnerBoxOutline  :: AbsBox -> IO ()
+renderInnerBoxOutline  = renderQuadOutline . absboxInnerQuad
+
+-- | Renders the gap quad (useful for debugging)
+renderGapBoxOutline :: AbsBox -> IO ()
+renderGapBoxOutline = renderQuadOutline . absboxGapQuad
+
+-- | Renders the bounding box quad (useful for debugging)
+renderBoundingBoxOutline :: AbsBox -> IO ()
+renderBoundingBoxOutline = renderQuadOutline . absboxBoundingQuad
+
+--------------------------------------------------------------------------------
 -- * Render lines
 
 -- TODO: finetune line rendering (retina display, antialising, position hinting based on width, etc...)