wumpus-drawing-0.2.0: src/Wumpus/Drawing/Text/LRText.hs
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS -Wall #-}
--------------------------------------------------------------------------------
-- |
-- Module : Wumpus.Drawing.Text.LRText
-- Copyright : (c) Stephen Tetley 2011
-- License : BSD3
--
-- Maintainer : stephen.tetley@gmail.com
-- Stability : unstable
-- Portability : GHC
--
-- Left-to-right measured text that supports radial inclination.
-- Caveat - rendering at any degree other than the horizontal may
-- not look good in PostScript or SVG.
--
-- Note - LRText does not use the 'text_margin' setting from the
-- 'DrawingContext'.
--
-- \*\* WARNING \*\* - the API for this module needs some polish.
--
--
--------------------------------------------------------------------------------
module Wumpus.Drawing.Text.LRText
(
singleLine
, escSingleLine
, rsingleLine
, rescSingleLine
, multiAlignLeft
, multiAlignCenter
, multiAlignRight
, textAlignCenter
, textAlignLeft
, textAlignRight
) where
import Wumpus.Drawing.Chains
import Wumpus.Drawing.Text.Base
import Wumpus.Basic.Kernel -- package: wumpus-basic
import Wumpus.Core -- package: wumpus-core
import Data.AffineSpace -- package: vector-space
import Data.VectorSpace
--
-- Note - margins are not added to the text. This seems to be the
-- right thing to do in the case of rotated text, where the ortho
-- projection of the rectangle already can add spacing between
-- the RectPos and the actual text.
--
-------------------
-- | One line of multiline text
--
data OnelineText u = OnelineText
{ text_content :: EscapedText
, oneline_adv :: AdvanceVec u
}
-- Design note - using a LocThetaImage could be used instead, but
-- as the angle of inclination is interior to the final type the
-- it is used explicitly.
--
type OnelineDrawF u =
Radian -> AdvanceVec u -> OnelineText u -> LocImage u (BoundingBox u)
singleLine :: (Real u, Floating u, FromPtSize u)
=> String -> PosImage u (BoundingBox u)
singleLine ss = onelineDraw onelineACenter 0 (escapeString ss)
escSingleLine :: (Real u, Floating u, FromPtSize u)
=> EscapedText -> PosImage u (BoundingBox u)
escSingleLine = onelineDraw onelineACenter 0
rsingleLine :: (Real u, Floating u, FromPtSize u)
=> Radian -> String -> PosImage u (BoundingBox u)
rsingleLine theta ss = onelineDraw onelineACenter theta (escapeString ss)
rescSingleLine :: (Real u, Floating u, FromPtSize u)
=> Radian -> EscapedText -> PosImage u (BoundingBox u)
rescSingleLine = onelineDraw onelineACenter
multiAlignLeft :: (Real u, Floating u, FromPtSize u)
=> Radian -> String -> PosImage u (BoundingBox u)
multiAlignLeft theta ss =
drawMultiline onelineALeft theta (map escapeString $ lines ss)
multiAlignCenter :: (Real u, Floating u, FromPtSize u)
=> Radian -> String -> PosImage u (BoundingBox u)
multiAlignCenter theta ss =
drawMultiline onelineACenter theta (map escapeString $ lines ss)
multiAlignRight :: (Real u, Floating u, FromPtSize u)
=> Radian -> String -> PosImage u (BoundingBox u)
multiAlignRight theta ss =
drawMultiline onelineARight theta (map escapeString $ lines ss)
textAlignLeft :: (Real u, Floating u, FromPtSize u)
=> String -> LocImage u (BoundingBox u)
textAlignLeft ss = multiAlignLeft 0 ss `startPos` CENTER
textAlignCenter :: (Real u, Floating u, FromPtSize u)
=> String -> LocImage u (BoundingBox u)
textAlignCenter ss = multiAlignCenter 0 ss `startPos` CENTER
textAlignRight :: (Real u, Floating u, FromPtSize u)
=> String -> LocImage u (BoundingBox u)
textAlignRight ss = multiAlignRight 0 ss `startPos` CENTER
-- Note - inclination is not part of the ContextFunction...
drawMultiline :: (Real u, Floating u, FromPtSize u)
=> OnelineDrawF u -> Radian -> [EscapedText]
-> PosImage u (BoundingBox u)
drawMultiline _ _ [] = lift1R2 emptyBoundedLocGraphic
drawMultiline drawF theta [x] = onelineDraw drawF theta x
drawMultiline drawF theta xs = promoteR2 $ \start rpos ->
linesToInterims xs >>= \(max_adv, ones) ->
rotObjectPos theta line_count (advanceH max_adv) >>= \opos ->
let chn = centerSpinePoints line_count theta
gs = map (drawF theta max_adv) ones
gf = unchainZip emptyBoundedLocGraphic gs chn
posG = makePosImage opos gf
in atStartPos posG start rpos
where
line_count = length xs
onelineDraw :: (Real u, Floating u, FromPtSize u)
=> OnelineDrawF u -> Radian -> EscapedText -> PosImage u (BoundingBox u)
onelineDraw drawF theta esc = promoteR2 $ \start rpos ->
onelineEscText esc >>= \otext ->
rotObjectPos theta 1 (advanceH $ oneline_adv otext) >>= \opos ->
let max_adv = oneline_adv otext
gf = drawF theta max_adv otext
posG = makePosImage opos gf
in atStartPos posG start rpos
-- | LR text needs the objectPos under rotation.
--
rotObjectPos :: (Real u, Floating u, FromPtSize u)
=> Radian -> Int -> u -> DrawingInfo (ObjectPos u)
rotObjectPos theta line_count max_w =
fmap (orthoObjectPos theta) $ textObjectPos line_count max_w
-- | Note - this returns the answer in center form, regardless
-- of whether the input was in center form.
--
-- So it is probably not a general enough function for the
-- PosImage library.
--
orthoObjectPos :: (Real u, Floating u)
=> Radian -> ObjectPos u -> ObjectPos u
orthoObjectPos theta (ObjectPos xmin xmaj ymin ymaj) =
ObjectPos bbox_hw bbox_hw bbox_hh bbox_hh
where
input_hw = 0.5 * (xmin + xmaj)
input_hh = 0.5 * (ymin + ymaj)
bbox0 = BBox (P2 (-input_hw) (-input_hh)) (P2 input_hw input_hh)
bbox1 = retraceBoundary (rotateAbout theta zeroPt) bbox0
bbox_hw = 0.5 * (boundaryWidth bbox1)
bbox_hh = 0.5 * (boundaryHeight bbox1)
-- | Draw left-aligned text. Effictively this is:
--
-- > Leftwards for the half the max vector
-- >
-- > Down to the baseline from the center.
--
onelineALeft :: (Real u, Floating u, FromPtSize u)
=> OnelineDrawF u
onelineALeft theta max_adv otext = promoteR1 $ \ctr ->
centerToBaseline >>= \down ->
atRot (orthoBB max_adv) ctr theta >>= \bbox ->
let pt = move down theta ctr
in replaceAns bbox $ atRot (rescapedline $ text_content otext) pt theta
where
vec1 = negateV $ 0.5 *^ max_adv
move down = \ang -> thetaSouthwards down ang . displaceOrtho vec1 ang
-- | Draw center-aligned text. Effictively this is:
--
-- > Leftwards for the half the width vector
-- >
-- > Down to the baseline from the center.
--
onelineACenter :: (Real u, Floating u, FromPtSize u)
=> OnelineDrawF u
onelineACenter theta max_adv otext = promoteR1 $ \ctr ->
centerToBaseline >>= \down ->
atRot (orthoBB max_adv) ctr theta >>= \bbox ->
let pt = move down theta ctr
in replaceAns bbox $ atRot (rescapedline $ text_content otext) pt theta
where
vec1 = negateV $ 0.5 *^ oneline_adv otext
move down = \ang -> thetaSouthwards down ang . displaceOrtho vec1 ang
-- | Draw right-aligned text. Effictively this is:
--
-- > Rightwards for the half the max vector
-- >
-- > Leftwards for the width vector
-- >
-- > Down to the baseline from the center.
--
onelineARight :: (Real u, Floating u, FromPtSize u)
=> OnelineDrawF u
onelineARight theta max_adv otext = promoteR1 $ \ctr ->
centerToBaseline >>= \down ->
atRot (orthoBB max_adv) ctr theta >>= \bbox ->
let pt = move down theta ctr
in replaceAns bbox $ atRot (rescapedline $ text_content otext) pt theta
where
vec1 = (0.5 *^ max_adv) ^-^ oneline_adv otext
move down = \ang -> thetaSouthwards down ang . displaceOrtho vec1 ang
-- Note - for multiline text, the bounding box (of one line) is
-- always the same size regardless of the alignment of the textlines.
--
orthoBB :: (Real u, Floating u, FromPtSize u)
=> AdvanceVec u -> LocThetaDrawingInfo u (BoundingBox u)
orthoBB (V2 w _) = promoteR2 $ \ctr theta ->
glyphVerticalSpan >>= \h ->
let bl = ctr .-^ V2 (0.5 * w) (0.5 * h)
bb1 = boundingBox bl (bl .+^ V2 w h)
bb2 = retraceBoundary (rotateAbout theta ctr) bb1
in return bb2
--------------------------------------------------------------------------------
-- This isn't worth the complexity to get down to one traversal...
-- | Turn the input list of lines of 'EscapedText' into
-- 'OnelineText' and return the result list twinned with the
-- largest 'AdvanceVec'.
--
linesToInterims :: (FromPtSize u, Ord u)
=> [EscapedText] -> DrawingInfo (AdvanceVec u, [OnelineText u])
linesToInterims = fmap post . mapM onelineEscText
where
post xs = let vmax = foldr fn (hvec 0) xs in (vmax,xs)
fn (OnelineText _ av) vmax = avMaxWidth av vmax
avMaxWidth :: Ord u => AdvanceVec u -> AdvanceVec u -> AdvanceVec u
avMaxWidth a@(V2 w1 _) b@(V2 w2 _) = if w2 > w1 then b else a
onelineEscText :: FromPtSize u => EscapedText -> DrawingInfo (OnelineText u)
onelineEscText esc = fmap (OnelineText esc) $ textVector esc