{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# OPTIONS -Wall #-} -------------------------------------------------------------------------------- -- | -- Module : Wumpus.Core.FontSize -- Copyright : (c) Stephen Tetley 2009-2011 -- License : BSD3 -- -- Maintainer : stephen.tetley@gmail.com -- Stability : unstable -- Portability : GHC -- -- Approximate glyph size calculations for Label\'s and their -- bounding boxes. -- -- Calculations are based on metrics derived from the Courier -- font. As Courier is a monospaced font, applying these metrics -- to other font families will usually produce over-estimates -- (bounding boxes will be longer than the true visual length -- of the text). Furthermore, even italic or bold Courier will -- have different metrics. -- -- This is a deficiency of Wumpus, and limits its text handling -- capabilities - for example, text cannot be reliably centered -- or right aligned as its true length is not known. However, more -- powerful alternatives would need access to the metrics embedded -- within font files. This would require a font loader and add -- significant implementation complexity. -- -------------------------------------------------------------------------------- module Wumpus.Core.FontSize ( -- * Type synonyms FontSize , CharCount , PtScale , ptSizeScale -- * Scaling values derived from Courier , mono_width , mono_cap_height , mono_x_height , mono_descender , mono_ascender , mono_left_margin , mono_right_margin -- * Courier metrics , charWidth , textWidth , capHeight , xcharHeight , totalCharHeight , ascenderHeight , descenderDepth -- * Size calculation , textBounds , textBoundsEsc , charCount ) where import Wumpus.Core.BoundingBox import Wumpus.Core.Geometry import Wumpus.Core.PtSize import Wumpus.Core.Text.Base type CharCount = Int type FontSize = Int -- | Wrapped Double representing 1\/1000 of the scale factor -- (Point size) of a font. AFM files encode all measurements -- as these units. -- newtype PtScale = PtScale { getPtScale :: Double } deriving (Eq,Ord,Num,Floating,Fractional,Real,RealFrac,RealFloat) instance Show PtScale where showsPrec p d = showsPrec p (getPtScale d) -- | 'ptSizeScale' : @ scale_factor -> pt_size -> PTSize @ -- -- Scale the point size by the scale factor. -- ptSizeScale :: PtScale -> PtSize -> PtSize ptSizeScale sc sz = sz * realToFrac sc -- NOTE - I\'ve largely tried to follow the terminoloy from -- Edward Tufte\'s /Visual Explantions/, page 99. -- -- | The ratio of width to point size of a letter in Courier. -- -- > mono_width = 0.6 -- mono_width :: PtScale mono_width = 0.600 -- | The ratio of cap height to point size of a letter in Courier. -- -- > mono_cap_height = 0.562 -- mono_cap_height :: PtScale mono_cap_height = 0.562 -- | The ratio of x height to point size of a letter in Courier. -- -- This is also known as the \"body height\". -- -- > mono_x_height = 0.426 -- mono_x_height :: PtScale mono_x_height = 0.426 -- | The ratio of descender depth to point size of a letter in -- Courier. -- -- > mono_descender = -0.157 -- mono_descender :: PtScale mono_descender = (-0.157) -- | The ratio of ascender to point size of a letter in Courier. -- -- > mono_ascender = 0.629 -- mono_ascender :: PtScale mono_ascender = 0.629 -- | The distance from baseline to max height as a ratio to point -- size for Courier. -- -- > mono_max_height = 0.805 -- mono_max_height :: PtScale mono_max_height = 0.805 -- | The distance from baseline to max depth as a ratio to point -- size for Courier. -- -- > max_depth = -0.250 -- mono_max_depth :: PtScale mono_max_depth = (-0.250) -- | The left margin for the bounding box of printed text as a -- ratio to point size for Courier. -- -- > mono_left_margin = -0.046 -- mono_left_margin :: PtScale mono_left_margin = (-0.046) -- | The right margin for the bounding box of printed text as a -- ratio to point size for Courier. -- -- > mono_right_margin = 0.050 -- mono_right_margin :: PtScale mono_right_margin = 0.050 -- | Approximate the width of a monospace character using -- metrics derived from the Courier font. -- charWidth :: FontSize -> PtSize charWidth = ptSizeScale mono_width . fromIntegral -- | 'textWidth' : @ font_size * char_count -> PtSize @ -- -- Text width at the supplied font_size. It is expected that the -- @char_ount@ has been calculated with the @charCount@ function. -- -- NOTE - this does not account for any left and right margins -- around the printed text. -- textWidth :: FontSize -> CharCount -> PtSize textWidth _ n | n <= 0 = 0 textWidth sz n = fromIntegral n * charWidth sz -- | Height of capitals e.g. \'A\' using metrics derived -- the Courier monospaced font. -- capHeight :: FontSize -> PtSize capHeight = fromIntegral -- | Height of the lower-case char \'x\' using metrics derived -- the Courier monospaced font. -- xcharHeight :: FontSize -> PtSize xcharHeight = ptSizeScale mono_x_height . fromIntegral -- | The total height span of the glyph bounding box for the -- Courier monospaced font. -- totalCharHeight :: FontSize -> PtSize totalCharHeight sz = let sz' = fromIntegral sz in ptSizeScale mono_max_height sz' + negate (ptSizeScale mono_max_depth sz') -- | Ascender height for font size @sz@ using metrics from the -- Courier monospaced font. -- ascenderHeight :: FontSize -> PtSize ascenderHeight = ptSizeScale mono_ascender . fromIntegral -- | Descender depth for font size @sz@ using metrics from the -- Courier monospaced font. -- descenderDepth :: FontSize -> PtSize descenderDepth = ptSizeScale mono_descender . fromIntegral -- | 'textBounds' : @ font_size * baseline_left * text -> BBox @ -- -- Find the bounding box for the character count at the -- supplied font-size. -- -- The supplied point represents the baseline left corner of the -- a regular upper-case letter (that is without descenders). -- The bounding box adds a margin around all sides of the text. -- -- The metrics used are derived from Courier - a monospaced font. -- For proportional fonts the calculated bounding box will -- usually be too long. -- textBounds :: (Num u, Ord u, FromPtSize u) => FontSize -> Point2 u -> String -> BoundingBox u textBounds sz pt ss = textBoundsBody sz pt (charCount ss) -- | 'textBoundsEsc' : @ font_size * baseline_left * escaped_text -> BBox @ -- -- Version of textBounds for already escaped text. -- textBoundsEsc :: (Num u, Ord u, FromPtSize u) => FontSize -> Point2 u -> EscapedText -> BoundingBox u textBoundsEsc sz pt esc = textBoundsBody sz pt (textLength esc) textBoundsBody :: (Num u, Ord u, FromPtSize u) => FontSize -> Point2 u -> Int -> BoundingBox u textBoundsBody sz (P2 x y) len = boundingBox ll ur where pt_sz = fromIntegral sz w = fromPtSize $ textWidth sz len left_m = fromPtSize $ ptSizeScale mono_left_margin pt_sz right_m = fromPtSize $ ptSizeScale mono_right_margin pt_sz max_depth = fromPtSize $ ptSizeScale mono_max_depth pt_sz max_height = fromPtSize $ ptSizeScale mono_max_height pt_sz ll = P2 (x + left_m) (y + max_depth) ur = P2 (x + w + right_m) (y + max_height) -- | 'charCount' : @ string -> CharCount @ -- -- Count the characters in the supplied string, escaping the -- string as necessary. -- -- Escapes count as one character - for instance, the length of -- this string: -- -- > abcd&#egrave;f -- -- ... is 6. -- charCount :: String -> CharCount charCount = outstep 0 where outstep n ('&':'#':xs) = instep n xs outstep n (_:xs) = outstep (n+1) xs outstep n [] = n instep n (';':xs) = outstep (n+1) xs instep n (_:xs) = instep n xs instep n [] = n -- Note - the last case of instep indicates a malformed string, -- but there is nothing that can be done. Promoting to Maybe or -- Either would complicated the interface and doesn\'t seem worth -- it.