module Wumpus.Basic.Graphic.DrawingContext
(
DrawingContext(..)
, standardContext
, thick
, ultrathick
, thin
, dashPattern
, unit_dash_pattern
, phase
, dphase
, doublegaps
, doubledashes
, fontsize
, fontface
, doublesize
, halfsize
, swapColours
, bothPrimary
, bothSecondary
, primaryColour
, secondaryColour
) where
import Wumpus.Basic.SafeFonts
import Wumpus.Basic.Colour.SVGColours
import Wumpus.Core
import Control.Applicative
data DrawingContext = DrawingContext
{ stroke_props :: StrokeAttr
, font_props :: FontAttr
, primary_colour :: RGBi
, secondary_colour :: RGBi
, line_spacing_factor :: Double
}
deriving (Eq,Show)
standardContext :: FontSize -> DrawingContext
standardContext sz =
DrawingContext { stroke_props = default_stroke_attr
, font_props = FontAttr sz courier
, primary_colour = black
, secondary_colour = light_gray
, line_spacing_factor = 1.2
}
updateStrokeProps :: (StrokeAttr -> StrokeAttr)
-> DrawingContext -> DrawingContext
updateStrokeProps fn = (\s i -> s { stroke_props = fn i }) <*> stroke_props
updateFontProps :: (FontAttr -> FontAttr)
-> DrawingContext -> DrawingContext
updateFontProps fn = (\s i -> s { font_props = fn i }) <*> font_props
thick_line :: Double
thick_line = 2.0
ultra_thick_line :: Double
ultra_thick_line = 4.0
thin_line :: Double
thin_line = 0.5
setLineWidth :: Double -> DrawingContext -> DrawingContext
setLineWidth d = updateStrokeProps (\s -> s { line_width = d })
thick :: DrawingContext -> DrawingContext
thick = setLineWidth thick_line
ultrathick :: DrawingContext -> DrawingContext
ultrathick = setLineWidth ultra_thick_line
thin :: DrawingContext -> DrawingContext
thin = setLineWidth thin_line
dashPattern :: DashPattern -> DrawingContext -> DrawingContext
dashPattern d = updateStrokeProps (\s -> s { dash_pattern = d })
unit_dash_pattern :: DashPattern
unit_dash_pattern = Dash 0 [(1,1)]
phase :: Int -> DashPattern -> DashPattern
phase _ Solid = Solid
phase i (Dash _ xs) = Dash i xs
dphase :: Int -> DashPattern -> DashPattern
dphase _ Solid = Solid
dphase d (Dash i xs) = Dash (i+d) xs
doublegaps :: DashPattern -> DashPattern
doublegaps Solid = Solid
doublegaps (Dash i xs) = Dash i (map fn xs)
where
fn (a,b) = (a,2*b)
doubledashes :: DashPattern -> DashPattern
doubledashes Solid = Solid
doubledashes (Dash i xs) = Dash i (map fn xs)
where
fn (a,b) = (a*2,b)
fontface :: FontFace -> DrawingContext -> DrawingContext
fontface ff = updateFontProps (\(FontAttr sz _) -> FontAttr sz ff)
fontsize :: Int -> DrawingContext -> DrawingContext
fontsize sz = updateFontProps (\(FontAttr _ ff) -> FontAttr sz ff)
doublesize :: DrawingContext -> DrawingContext
doublesize = (\s sz -> fontsize (sz*2) s) <*> (font_size . font_props)
halfsize :: DrawingContext -> DrawingContext
halfsize = (\s sz -> fontsize (sz `div` 2) s)
<*> (font_size . font_props)
swapColours :: DrawingContext -> DrawingContext
swapColours =
(\s a b -> s { primary_colour = b, secondary_colour = a })
<*> primary_colour <*> secondary_colour
bothPrimary :: DrawingContext -> DrawingContext
bothPrimary = (\s a -> s { secondary_colour = a }) <*> primary_colour
bothSecondary :: DrawingContext -> DrawingContext
bothSecondary = (\s a -> s { primary_colour = a }) <*> secondary_colour
primaryColour :: RGBi -> DrawingContext -> DrawingContext
primaryColour rgb = \s -> s { primary_colour = rgb }
secondaryColour :: RGBi -> DrawingContext -> DrawingContext
secondaryColour rgb = \s -> s { secondary_colour = rgb }