module Wumpus.Basic.Kernel.Base.DrawingContext
(
DrawingContext(..)
, DrawingContextF
, standardContext
, metricsContext
, default_drawing_context
, DrawingCtxM(..)
, asksDC
, withFontMetrics
) where
import Wumpus.Basic.Kernel.Base.GlyphMetrics
import Wumpus.Core
import Wumpus.Core.Text.StandardEncoding
import Control.Applicative
import Data.Maybe
data DrawingContext = DrawingContext
{ glyph_tables :: GlyphMetrics
, fallback_metrics :: MetricsOps
, stroke_props :: StrokeAttr
, font_props :: FontAttr
, stroke_colour :: RGBi
, fill_colour :: RGBi
, line_spacing_factor :: Double
}
type DrawingContextF = DrawingContext -> DrawingContext
standardContext :: FontSize -> DrawingContext
standardContext sz =
DrawingContext { glyph_tables = emptyGlyphMetrics
, fallback_metrics = monospace_metrics
, stroke_props = default_stroke_attr
, font_props = FontAttr sz wumpus_courier
, stroke_colour = wumpus_black
, fill_colour = wumpus_light_gray
, line_spacing_factor = 1.2
}
metricsContext :: FontSize -> GlyphMetrics -> DrawingContext
metricsContext sz bgm =
DrawingContext { glyph_tables = bgm
, fallback_metrics = monospace_metrics
, stroke_props = default_stroke_attr
, font_props = FontAttr sz wumpus_courier
, stroke_colour = wumpus_black
, fill_colour = wumpus_light_gray
, line_spacing_factor = 1.2
}
wumpus_black :: RGBi
wumpus_black = RGBi 0 0 0
wumpus_light_gray :: RGBi
wumpus_light_gray = RGBi 200 200 200
wumpus_courier :: FontFace
wumpus_courier =
FontFace "Courier" "Courier New" SVG_REGULAR standard_encoding
default_drawing_context :: DrawingContext
default_drawing_context =
standardContext (font_size wumpus_default_font)
class (Applicative m, Monad m) => DrawingCtxM (m :: * -> *) where
askDC :: m DrawingContext
localize :: (DrawingContext -> DrawingContext) -> m a -> m a
asksDC :: DrawingCtxM m => (DrawingContext -> a) -> m a
asksDC f = askDC >>= (return . f)
withFontMetrics :: (MetricsOps -> PtSize -> u) -> DrawingContext -> u
withFontMetrics fn ctx@(DrawingContext { font_props = font_stats }) =
fn metric_set point_sz
where
ps_name = ps_font_name $ font_face font_stats
point_sz = fromIntegral $ font_size font_stats
metric_set = fromMaybe (fallback_metrics ctx) $
lookupFont ps_name (glyph_tables ctx)