module Graphics.UI.WX.Draw
(
Drawn, pen, penKind, penWidth, penCap, penJoin, penColor
, Brushed, brush, brushKind, brushColor
, DC, Bitmap
, circle, arc, ellipse, ellipticArc
, line, polyline, polygon
, drawPoint, drawRect, roundedRect
, drawText, rotatedText, drawBitmap, drawImage
, dcWith, dcClear
) where
import Graphics.UI.WXCore
import Graphics.UI.WX.Types
import Graphics.UI.WX.Attributes
import Graphics.UI.WX.Layout
import Graphics.UI.WX.Classes
import Graphics.UI.WX.Window
class Drawn w where
pen :: Attr w PenStyle
penKind :: Attr w PenKind
penWidth :: Attr w Int
penCap :: Attr w CapStyle
penJoin :: Attr w JoinStyle
penColor :: Attr w Color
class Brushed w where
brush :: Attr w BrushStyle
brushKind :: Attr w BrushKind
brushColor :: Attr w Color
instance Drawn (DC a) where
pen
= newAttr "pen" dcGetPenStyle dcSetPenStyle
penKind
= mapAttr _penKind (\pstyle x -> pstyle{ _penKind = x }) pen
penWidth
= mapAttr _penWidth (\pstyle x -> pstyle{ _penWidth = x }) pen
penCap
= mapAttr _penCap (\pstyle x -> pstyle{ _penCap = x }) pen
penJoin
= mapAttr _penJoin (\pstyle x -> pstyle{ _penJoin = x }) pen
penColor
= mapAttr _penColor (\pstyle color -> pstyle{ _penColor = color }) pen
instance Brushed (DC a) where
brush
= newAttr "brush" dcGetBrushStyle dcSetBrushStyle
brushKind
= mapAttr _brushKind (\bstyle x -> bstyle{ _brushKind = x }) brush
brushColor
= mapAttr _brushColor (\bstyle color -> bstyle{ _brushColor = color }) brush
instance Literate (DC a) where
font
= newAttr "font" dcGetFontStyle dcSetFontStyle
textColor
= newAttr "textcolor" dcGetTextForeground dcSetTextForeground
textBgcolor
= newAttr "textbgcolor" dcGetTextBackground dcSetTextForeground
instance Colored (DC a) where
color
= newAttr "color" (\dc -> get dc penColor) (\dc c -> set dc [penColor := c, textColor := c])
bgcolor
= newAttr "bgcolor" (\dc -> get dc brushColor) (\dc c -> set dc [brushColor := c, textBgcolor := c])
dcWith :: DC a -> [Prop (DC a)] -> IO b -> IO b
dcWith dc props io
| null props = io
| otherwise = dcEncapsulate dc (do set dc props; io)
circle :: DC a -> Point -> Int -> [Prop (DC a)] -> IO ()
circle dc center radius props
= dcWith dc props (dcDrawCircle dc center radius)
arc :: DC a -> Point -> Int -> Double -> Double -> [Prop (DC a)] -> IO ()
arc dc center radius start end props
= ellipticArc dc bounds start end props
where
bounds
= rect (pt (pointX center radius) (pointY center radius)) (sz (2*radius) (2*radius))
ellipse :: DC a -> Rect -> [Prop (DC a)] -> IO ()
ellipse dc rect props
= dcWith dc props (dcDrawEllipse dc rect)
ellipticArc :: DC a -> Rect -> Double -> Double -> [Prop (DC a)] -> IO ()
ellipticArc dc rect start end props
= dcWith dc props (dcDrawEllipticArc dc rect start end)
line :: DC a -> Point -> Point -> [Prop (DC a)] -> IO ()
line dc start end props
= dcWith dc props (dcDrawLine dc start end)
polyline :: DC a -> [Point] -> [Prop (DC a)] -> IO ()
polyline dc points props
= dcWith dc props (drawLines dc points)
polygon :: DC a -> [Point] -> [Prop (DC a)] -> IO ()
polygon dc points props
= dcWith dc props (drawPolygon dc points)
drawPoint :: DC a -> Point -> [Prop (DC a)] -> IO ()
drawPoint dc center props
= dcWith dc props (dcDrawPoint dc center)
drawRect :: DC a -> Rect -> [Prop (DC a)] -> IO ()
drawRect dc rect props
= dcWith dc props (dcDrawRectangle dc rect)
roundedRect :: DC a -> Rect -> Double -> [Prop (DC a)] -> IO ()
roundedRect dc rect radius props
= dcWith dc props (dcDrawRoundedRectangle dc rect radius)
drawText :: DC a -> String -> Point -> [Prop (DC a)] -> IO ()
drawText dc text point props
= dcWith dc props (dcDrawText dc text point)
rotatedText :: DC a -> String -> Point -> Double -> [Prop (DC a)] -> IO ()
rotatedText dc text point angle props
= dcWith dc props (dcDrawRotatedText dc text point angle)
drawBitmap :: DC a -> Bitmap () -> Point -> Bool -> [Prop (DC a)] -> IO ()
drawBitmap dc bitmap point transparent props
= if bitmap == nullBitmap || objectIsNull bitmap
then return ()
else do ok <- bitmapIsOk bitmap
if not ok
then return ()
else dcWith dc props (dcDrawBitmap dc bitmap point transparent)
drawImage :: DC a -> Image b -> Point -> [Prop (DC a)] -> IO ()
drawImage dc image pt props
= do bm <- bitmapCreateFromImage image (1)
drawBitmap dc bm pt False props
bitmapDelete bm