module Wumpus.Drawing.Text.Base.Common
(
posTextWithMargins
, advtext
, textVector
, textOrientationZero
, charVector
, charOrientationZero
, hkernVector
, hkernOrientationZero
) where
import Wumpus.Basic.Kernel
import Wumpus.Core
import Wumpus.Core.Text.GlyphIndices
import Data.VectorSpace
import Control.Applicative
import Data.Char
import qualified Data.Map as Map
import Data.Maybe
posTextWithMargins :: (Fractional u, InterpretUnit u)
=> PosObject u -> BoundedLocRectGraphic u
posTextWithMargins obj =
textMargin >>= \(xsep,ysep) ->
let body = extendPosObject xsep xsep ysep ysep obj
in runPosObjectR2 body
advtext :: InterpretUnit u => EscapedText -> AdvGraphic u
advtext esc = textVector esc >>= body
where
body v = pushR1 (replaceAns v) $ escTextLine esc
textVector :: (DrawingCtxM m, InterpretUnit u)
=> EscapedText -> m (AdvanceVec u)
textVector esc =
cwLookupTable >>= \table ->
pointSize >>= \sz ->
let cs = destrEscapedText id esc
in return $ foldr (step sz table) (vec 0 0) cs
where
step sz table ch v = (v ^+^) $ charWidth sz table ch
charVector :: (DrawingCtxM m, InterpretUnit u)
=> EscapedChar -> m (AdvanceVec u)
charVector ch =
(\table sz -> charWidth sz table ch) <$> cwLookupTable <*> pointSize
textOrientationZero :: (DrawingCtxM m, InterpretUnit u )
=> EscapedText -> m (Orientation u)
textOrientationZero esc = textVector esc >>= bllOrientationZero
charOrientationZero :: (DrawingCtxM m, InterpretUnit u)
=> EscapedChar -> m (Orientation u)
charOrientationZero ch = charVector ch >>= bllOrientationZero
bllOrientationZero :: (DrawingCtxM m, InterpretUnit u )
=> AdvanceVec u -> m (Orientation u)
bllOrientationZero (V2 w _) =
(\ymin ymaj -> Orientation 0 w ymin ymaj)
<$> fmap abs descender <*> capHeight
hkernVector :: (DrawingCtxM m, InterpretUnit u)
=> [KernChar u] -> m (AdvanceVec u)
hkernVector = go 0
where
go w [] = return $ V2 w 0
go w [(dx,ch)] = fmap (addWidth $ w + dx) (charVector ch)
go w ((dx,_ ):xs) = go (w + dx) xs
addWidth w (V2 x y) = V2 (w+x) y
hkernOrientationZero :: (DrawingCtxM m, InterpretUnit u )
=> [KernChar u] -> m (Orientation u)
hkernOrientationZero xs = hkernVector xs >>= bllOrientationZero
charWidth :: InterpretUnit u
=> FontSize -> CharWidthLookup -> EscapedChar -> AdvanceVec u
charWidth sz fn (CharLiteral c) = fmap (dinterp sz) $ fn $ ord c
charWidth sz fn (CharEscInt i) = fmap (dinterp sz) $ fn i
charWidth sz fn (CharEscName s) = fmap (dinterp sz) $ fn ix
where
ix = fromMaybe (1) $ Map.lookup s ps_glyph_indices