module DrawInPixmap where
--import Geometry
import XDraw

-- convenient abbreviations for drawing in pixmaps:
pmDrawLine :: PixmapId -> GCId -> Line -> FRequest
pmDrawLine PixmapId
pm GCId
gc Line
l = Drawable -> GCId -> DrawCommand -> FRequest
draw (PixmapId -> Drawable
Pixmap PixmapId
pm) GCId
gc (Line -> DrawCommand
DrawLine Line
l)
pmDrawLines :: PixmapId -> GCId -> CoordMode -> [Point] -> FRequest
pmDrawLines PixmapId
pm GCId
gc CoordMode
mode [Point]
ps = Drawable -> GCId -> DrawCommand -> FRequest
draw (PixmapId -> Drawable
Pixmap PixmapId
pm) GCId
gc (CoordMode -> [Point] -> DrawCommand
DrawLines CoordMode
mode [Point]
ps)
pmDrawImageString :: PixmapId -> GCId -> Point -> String -> FRequest
pmDrawImageString PixmapId
pm GCId
gc Point
p String
s = Drawable -> GCId -> DrawCommand -> FRequest
draw (PixmapId -> Drawable
Pixmap PixmapId
pm) GCId
gc (Point -> String -> DrawCommand
DrawImageString Point
p String
s)
pmDrawString :: PixmapId -> GCId -> Point -> String -> FRequest
pmDrawString PixmapId
pm GCId
gc Point
p String
s = Drawable -> GCId -> DrawCommand -> FRequest
draw (PixmapId -> Drawable
Pixmap PixmapId
pm) GCId
gc (Point -> String -> DrawCommand
DrawString Point
p String
s)
pmDrawImageString16 :: PixmapId -> GCId -> Point -> String -> FRequest
pmDrawImageString16 PixmapId
pm GCId
gc Point
p String
s = Drawable -> GCId -> DrawCommand -> FRequest
draw (PixmapId -> Drawable
Pixmap PixmapId
pm) GCId
gc (Point -> String -> DrawCommand
DrawImageString16 Point
p String
s)
pmDrawString16 :: PixmapId -> GCId -> Point -> String -> FRequest
pmDrawString16 PixmapId
pm GCId
gc Point
p String
s = Drawable -> GCId -> DrawCommand -> FRequest
draw (PixmapId -> Drawable
Pixmap PixmapId
pm) GCId
gc (Point -> String -> DrawCommand
DrawString16 Point
p String
s)
pmDrawImageStringPS :: PixmapId -> GCId -> Point -> PackedString -> FRequest
pmDrawImageStringPS PixmapId
pm GCId
gc Point
p PackedString
s = Drawable -> GCId -> DrawCommand -> FRequest
draw (PixmapId -> Drawable
Pixmap PixmapId
pm) GCId
gc (Point -> PackedString -> DrawCommand
DrawImageStringPS Point
p PackedString
s)
pmDrawStringPS :: PixmapId -> GCId -> Point -> PackedString -> FRequest
pmDrawStringPS PixmapId
pm GCId
gc Point
p PackedString
s = Drawable -> GCId -> DrawCommand -> FRequest
draw (PixmapId -> Drawable
Pixmap PixmapId
pm) GCId
gc (Point -> PackedString -> DrawCommand
DrawStringPS Point
p PackedString
s)
pmDrawRectangle :: PixmapId -> GCId -> Rect -> FRequest
pmDrawRectangle PixmapId
pm GCId
gc Rect
r = Drawable -> GCId -> DrawCommand -> FRequest
draw (PixmapId -> Drawable
Pixmap PixmapId
pm) GCId
gc (Rect -> DrawCommand
DrawRectangle Rect
r)
pmFillRectangle :: PixmapId -> GCId -> Rect -> FRequest
pmFillRectangle PixmapId
pm GCId
gc Rect
r = Drawable -> GCId -> DrawCommand -> FRequest
draw (PixmapId -> Drawable
Pixmap PixmapId
pm) GCId
gc (Rect -> DrawCommand
FillRectangle Rect
r)
pmFillPolygon :: PixmapId -> GCId -> Shape -> CoordMode -> [Point] -> FRequest
pmFillPolygon PixmapId
pm GCId
gc Shape
shape CoordMode
mode [Point]
ps =
   Drawable -> GCId -> DrawCommand -> FRequest
draw (PixmapId -> Drawable
Pixmap PixmapId
pm) GCId
gc (Shape -> CoordMode -> [Point] -> DrawCommand
FillPolygon Shape
shape CoordMode
mode [Point]
ps)
pmDrawArc :: PixmapId -> GCId -> Rect -> Int -> Int -> FRequest
pmDrawArc PixmapId
pm GCId
gc Rect
r Int
a1 Int
a2 = Drawable -> GCId -> DrawCommand -> FRequest
draw (PixmapId -> Drawable
Pixmap PixmapId
pm) GCId
gc (Rect -> Int -> Int -> DrawCommand
DrawArc Rect
r Int
a1 Int
a2)
pmFillArc :: PixmapId -> GCId -> Rect -> Int -> Int -> FRequest
pmFillArc PixmapId
pm GCId
gc Rect
r Int
a1 Int
a2 = Drawable -> GCId -> DrawCommand -> FRequest
draw (PixmapId -> Drawable
Pixmap PixmapId
pm) GCId
gc (Rect -> Int -> Int -> DrawCommand
FillArc Rect
r Int
a1 Int
a2)
pmCopyArea :: PixmapId -> GCId -> Drawable -> Rect -> Point -> FRequest
pmCopyArea PixmapId
dst GCId
gc Drawable
src Rect
r Point
p = Drawable -> GCId -> DrawCommand -> FRequest
draw (PixmapId -> Drawable
Pixmap PixmapId
dst) GCId
gc (Drawable -> Rect -> Point -> DrawCommand
CopyArea Drawable
src Rect
r Point
p)
pmCopyPlane :: PixmapId -> GCId -> Drawable -> Rect -> Point -> Int -> FRequest
pmCopyPlane PixmapId
dst GCId
gc Drawable
src Rect
r Point
p Int
i = Drawable -> GCId -> DrawCommand -> FRequest
draw (PixmapId -> Drawable
Pixmap PixmapId
dst) GCId
gc (Drawable -> Rect -> Point -> Int -> DrawCommand
CopyPlane Drawable
src Rect
r Point
p Int
i)
pmDrawPoint :: PixmapId -> GCId -> Point -> FRequest
pmDrawPoint PixmapId
dst GCId
gc Point
p = Drawable -> GCId -> DrawCommand -> FRequest
draw (PixmapId -> Drawable
Pixmap PixmapId
dst) GCId
gc (Point -> DrawCommand
DrawPoint Point
p)
pmCreatePutImage :: PixmapId -> GCId -> Rect -> ImageFormat -> [Pixel] -> FRequest
pmCreatePutImage PixmapId
dst GCId
gc Rect
r ImageFormat
s [Pixel]
d = Drawable -> GCId -> DrawCommand -> FRequest
draw (PixmapId -> Drawable
Pixmap PixmapId
dst) GCId
gc (Rect -> ImageFormat -> [Pixel] -> DrawCommand
CreatePutImage Rect
r ImageFormat
s [Pixel]
d)