module Wumpus.Basic.Graphic.DrawingAttr
(
DrawingAttr(..)
, standardAttr
, strokeAttr
, fillAttr
, textAttr
, markHeight
, textDimensions
, thick
, ultrathick
, thin
, fontsize
, fontface
) where
import Wumpus.Basic.SafeFonts
import Wumpus.Basic.Colour.SVGColours
import Wumpus.Basic.Utils.Combinators
import Wumpus.Core
import Control.Applicative
data DrawingAttr = DrawingAttr
{ stroke_props :: StrokeAttr
, font_props :: FontAttr
, stroke_colour :: RGBi
, fill_colour :: RGBi
}
deriving (Eq,Show)
standardAttr :: FontSize -> DrawingAttr
standardAttr sz = DrawingAttr { stroke_props = default_stroke_attr
, font_props = FontAttr sz courier
, stroke_colour = black
, fill_colour = gold }
strokeAttr :: DrawingAttr -> (RGBi, StrokeAttr)
strokeAttr = liftA2 (,) stroke_colour stroke_props
fillAttr :: DrawingAttr -> RGBi
fillAttr = fill_colour
textAttr :: DrawingAttr -> (RGBi,FontAttr)
textAttr = liftA2 (,) stroke_colour font_props
markHeight :: FromPtSize u => DrawingAttr -> u
markHeight = fromPtSize . xcharHeight . font_size . font_props
textDimensions :: FromPtSize u => String -> DrawingAttr -> (u,u)
textDimensions str attr = (w,h)
where
sz = font_size $ font_props attr
w = fromPtSize $ textWidth sz (1 + length str)
h = fromPtSize $ textHeight sz
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 -> DrawingAttr -> DrawingAttr
setLineWidth d = star (\s i -> s { stroke_props = upd i} ) stroke_props
where
upd attrs = attrs { line_width = d }
thick :: DrawingAttr -> DrawingAttr
thick = setLineWidth thick_line
ultrathick :: DrawingAttr -> DrawingAttr
ultrathick = setLineWidth ultra_thick_line
thin :: DrawingAttr -> DrawingAttr
thin = setLineWidth thin_line
fontface :: FontFace -> DrawingAttr -> DrawingAttr
fontface ff = star (\s i -> s { font_props = upd i }) font_props
where
upd (FontAttr sz _) = FontAttr sz ff
fontsize :: Int -> DrawingAttr -> DrawingAttr
fontsize sz = star (\s i -> s { font_props = upd i }) font_props
where
upd (FontAttr _ ff) = FontAttr sz ff