-- | 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 []  = []

-}
--------------------------------------------------------------------------------