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