module Wumpus.Basic.Graphic.Query
(
textAttr
, withTextAttr
, strokeAttr
, withStrokeAttr
, fillAttr
, withFillAttr
, borderedAttr
, withBorderedAttr
, lineWidth
, fontSize
, markHeight
, lineSpacing
, monoCharWidth
, monoSpacerWidth
, monoTextWidth
, monoTextLength
, monoTextHeight
, monoNumeralHeight
, monoLowerxHeight
, monoDescenderDepth
, monoTextDimensions
, monoVecToCenter
) where
import Wumpus.Basic.Graphic.BaseTypes
import Wumpus.Basic.Graphic.DrawingContext
import Wumpus.Core
import Control.Applicative
textAttr :: DrawingF (RGBi,FontAttr)
textAttr = (,) <$> asksDF primary_colour <*> asksDF font_props
withTextAttr :: (RGBi -> FontAttr -> a) -> DrawingF a
withTextAttr fn = fn <$> asksDF primary_colour <*> asksDF font_props
strokeAttr :: DrawingF (RGBi, StrokeAttr)
strokeAttr = (,) <$> asksDF primary_colour <*> asksDF stroke_props
withStrokeAttr :: (RGBi -> StrokeAttr -> a) -> DrawingF a
withStrokeAttr fn = fn <$> asksDF primary_colour <*> asksDF stroke_props
fillAttr :: DrawingF RGBi
fillAttr = asksDF secondary_colour
withFillAttr :: (RGBi -> a) -> DrawingF a
withFillAttr fn = fn <$> asksDF secondary_colour
borderedAttr :: DrawingF (RGBi, StrokeAttr, RGBi)
borderedAttr = (,,) <$> asksDF secondary_colour <*> asksDF stroke_props
<*> asksDF primary_colour
withBorderedAttr :: (RGBi -> StrokeAttr -> RGBi -> a) -> DrawingF a
withBorderedAttr fn =
fn <$> asksDF secondary_colour <*> asksDF stroke_props
<*> asksDF primary_colour
lineWidth :: DrawingF Double
lineWidth = line_width <$> asksDF stroke_props
fontSize :: DrawingF Int
fontSize = font_size <$> asksDF font_props
lineSpacing :: Fractional u => DrawingF u
lineSpacing =
(\sz factor -> realToFrac $ factor * fromIntegral sz)
<$> asksDF (font_size . font_props) <*> asksDF line_spacing_factor
markHeight :: FromPtSize u => DrawingF u
markHeight = (fromPtSize . xcharHeight . font_size) <$> asksDF font_props
withFontSize :: (FontSize -> u) -> DrawingF u
withFontSize fn = fn . font_size <$> asksDF font_props
monoCharWidth :: FromPtSize u => DrawingF u
monoCharWidth = withFontSize (fromPtSize . charWidth)
monoSpacerWidth :: FromPtSize u => DrawingF u
monoSpacerWidth = withFontSize (fromPtSize . spacerWidth)
monoTextWidth :: FromPtSize u => Int -> DrawingF u
monoTextWidth n = withFontSize $ \sz -> fromPtSize $ textWidth sz n
monoTextLength :: FromPtSize u => String -> DrawingF u
monoTextLength ss = monoTextWidth $ charCount ss
monoTextHeight :: FromPtSize u => DrawingF u
monoTextHeight = withFontSize (fromPtSize . textHeight)
monoNumeralHeight :: FromPtSize u => DrawingF u
monoNumeralHeight = withFontSize (fromPtSize . numeralHeight)
monoLowerxHeight :: FromPtSize u => DrawingF u
monoLowerxHeight = withFontSize (fromPtSize . xcharHeight)
monoDescenderDepth :: FromPtSize u => DrawingF u
monoDescenderDepth = withFontSize (fromPtSize . descenderDepth)
monoTextDimensions :: (Num u, Ord u, FromPtSize u) => String -> DrawingF (u,u)
monoTextDimensions ss =
(\sz -> post $ textBounds sz zeroPt ss)
<$> asksDF (font_size . font_props)
where
post bb = (boundaryWidth bb, boundaryHeight bb)
monoVecToCenter :: (Fractional u, Ord u, FromPtSize u)
=> String -> DrawingF (Vec2 u)
monoVecToCenter ss = (\(w,h) dy -> vec (0.5*w) (0.5*h dy))
<$> monoTextDimensions ss <*> monoDescenderDepth