{-# 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