minitypeset-opengl-0.3.0.0: src/Graphics/Rendering/MiniTypeset/Delimiters.hs
-- | 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 [] = []
-}
--------------------------------------------------------------------------------