{-# 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 , AfmUnit , afmUnit , afmValue -- * 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.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 AfmUnit = AfmUnit { getAfmUnit :: Double } deriving (Eq,Ord,Num,Floating,Fractional,Real,RealFrac,RealFloat) instance Show AfmUnit where showsPrec p d = showsPrec p (getAfmUnit d) instance Tolerance AfmUnit where eq_tolerance = 0.001 length_tolerance = 0.1 -- | Flipped version of 'afmValue'. -- afmValueSZ :: AfmUnit -> FontSize -> Double afmValueSZ = flip afmValue -- | Compute the size of a measurement in PostScript points -- scaling the Afm unit size by the point size of the font. -- afmValue :: FontSize -> AfmUnit -> Double afmValue sz u = realToFrac u * (fromIntegral sz) / 1000 -- | Compute the size of a measurement in Afm units scaled by the -- point size of the font. -- afmUnit :: FontSize -> Double -> AfmUnit afmUnit sz u = 1000.0 * (realToFrac u) / (fromIntegral sz) -- 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 = 600 -- mono_width :: AfmUnit mono_width = 600 -- | The ratio of cap height to point size of a letter in Courier. -- -- > mono_cap_height = 562 -- mono_cap_height :: AfmUnit mono_cap_height = 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 = 426 -- mono_x_height :: AfmUnit mono_x_height = 426 -- | The ratio of descender depth to point size of a letter in -- Courier. -- -- > mono_descender = -157 -- mono_descender :: AfmUnit mono_descender = (-157) -- | The ratio of ascender to point size of a letter in Courier. -- -- > mono_ascender = 629 -- mono_ascender :: AfmUnit mono_ascender = 629 -- | The distance from baseline to max height as a ratio to point -- size for Courier. -- -- > mono_max_height = 805 -- mono_max_height :: AfmUnit mono_max_height = 805 -- | The distance from baseline to max depth as a ratio to point -- size for Courier. -- -- > max_depth = -250 -- mono_max_depth :: AfmUnit mono_max_depth = (-250) -- | The left margin for the bounding box of printed text as a -- ratio to point size for Courier. -- -- > mono_left_margin = -46 -- mono_left_margin :: AfmUnit mono_left_margin = (-46) -- | The right margin for the bounding box of printed text as a -- ratio to point size for Courier. -- -- > mono_right_margin = 50 -- mono_right_margin :: AfmUnit mono_right_margin = 50 -- | Approximate the width of a monospace character using -- metrics derived from the Courier font. -- charWidth :: FontSize -> Double charWidth = afmValueSZ mono_width -- | '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 -> Double 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 -> Double capHeight = fromIntegral -- | Height of the lower-case char \'x\' using metrics derived -- the Courier monospaced font. -- xcharHeight :: FontSize -> Double xcharHeight = afmValueSZ mono_x_height -- | The total height span of the glyph bounding box for the -- Courier monospaced font. -- totalCharHeight :: FontSize -> Double totalCharHeight sz = afmValueSZ mono_max_height sz + negate (afmValueSZ mono_max_depth sz) -- | Ascender height for font size @sz@ using metrics from the -- Courier monospaced font. -- ascenderHeight :: FontSize -> Double ascenderHeight = afmValueSZ mono_ascender -- | Descender depth for font size @sz@ using metrics from the -- Courier monospaced font. -- descenderDepth :: FontSize -> Double descenderDepth = afmValueSZ mono_descender -- | '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 :: FontSize -> DPoint2 -> String -> BoundingBox Double 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 :: FontSize -> DPoint2 -> EscapedText -> BoundingBox Double textBoundsEsc sz pt esc = textBoundsBody sz pt (textLength esc) textBoundsBody :: FontSize -> DPoint2 -> Int -> BoundingBox Double textBoundsBody sz (P2 x y) len = boundingBox ll ur where w = textWidth sz len left_m = afmValueSZ mono_left_margin sz right_m = afmValueSZ mono_right_margin sz max_depth = afmValueSZ mono_max_depth sz max_height = afmValueSZ mono_max_height 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.