{-# 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
delimHangAbove = 0.125 :: Double
delimHangBelow = -0.075 :: Double
delimHMargin = 0.075 :: Double
delimVMargin = 0.075 :: Double
data CompoundDelim
= FixDelim (forall a. Document a)
| Adjustable (forall a. Double -> Document a)
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
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))
type DelimGrower a = Height -> WhichDelim -> Double -> Document a
data DelimImpl
= GrowingDelim (forall a. DelimGrower a)
| FixedDelim !(Char,Char)
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
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
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)
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 ]
| 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'
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'