module Wumpus.Basic.Kernel.Base.GlyphMetrics
(
FontName
, CodePoint
, CharWidthTable
, MetricsOps(..)
, FontMetricsOps(..)
, GlyphMetrics
, emptyGlyphMetrics
, lookupFont
, insertFont
, monospace_metrics
) where
import Wumpus.Core
import qualified Data.Map as Map
import Data.Monoid
type FontName = String
type CodePoint = Int
type CharWidthTable u = CodePoint -> Vec2 u
data MetricsOps = MetricsOps
{ get_bounding_box :: forall u. FromPtSize u => PtSize -> BoundingBox u
, get_cw_table :: forall u. FromPtSize u => PtSize -> CharWidthTable u
, get_cap_height :: forall u. FromPtSize u => PtSize -> u
}
data FontMetricsOps = FontMetricsOps FontName MetricsOps
newtype GlyphMetrics = GlyphMetrics {
getGlyphMetrics :: Map.Map FontName MetricsOps }
instance Monoid GlyphMetrics where
mempty = emptyGlyphMetrics
a `mappend` b = GlyphMetrics $ getGlyphMetrics a `mappend` getGlyphMetrics b
emptyGlyphMetrics :: GlyphMetrics
emptyGlyphMetrics = GlyphMetrics $ Map.empty
lookupFont :: FontName -> GlyphMetrics -> Maybe MetricsOps
lookupFont name = Map.lookup name . getGlyphMetrics
insertFont :: FontMetricsOps -> GlyphMetrics -> GlyphMetrics
insertFont (FontMetricsOps name ops) =
GlyphMetrics . Map.insert name ops . getGlyphMetrics
monospace_metrics :: MetricsOps
monospace_metrics = MetricsOps
{ get_bounding_box = \sz -> BBox (lowerLeft sz) (upperRight sz)
, get_cw_table = \sz _ -> hvec (upscale sz width_vec)
, get_cap_height = \sz -> upscale sz cap_height
}
where
llx = (23) / 1000
lly = (250) / 1000
urx = 715 / 1000
ury = 805 / 1000
width_vec = 600 / 1000
cap_height = 562 / 1000
upscale sz d = fromPtSize $ sz * d
lowerLeft sz = P2 (upscale sz llx) (upscale sz lly)
upperRight sz = P2 (upscale sz urx) (upscale sz ury)