1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
|
-------------------------------------------------------------------------------
--- $Id: CairoDrawing.hs#3 2009/07/18 22:48:30 REDMOND\\satnams $
--- $Source: //depot/satnams/haskell/ThreadScope/CairoDrawing.hs $
-------------------------------------------------------------------------------
module GUI.Timeline.CairoDrawing
where
import Graphics.Rendering.Cairo
import qualified Graphics.Rendering.Cairo as C
import Control.Monad
-------------------------------------------------------------------------------
{-# INLINE draw_line #-}
draw_line :: (Integral a, Integral b, Integral c, Integral d) =>
(a, b) -> (c, d) -> Render ()
draw_line (x0, y0) (x1, y1)
= do move_to (x0, y0)
lineTo (fromIntegral x1) (fromIntegral y1)
stroke
{-# INLINE move_to #-}
move_to :: (Integral a, Integral b) => (a, b) -> Render ()
move_to (x, y)
= moveTo (fromIntegral x) (fromIntegral y)
{-# INLINE rel_line_to #-}
rel_line_to :: (Integral a, Integral b) => (a, b) -> Render ()
rel_line_to (x, y)
= relLineTo (fromIntegral x) (fromIntegral y)
-------------------------------------------------------------------------------
{-# INLINE draw_rectangle #-}
draw_rectangle :: (Integral x, Integral y, Integral w, Integral h)
=> x -> y -> w -> h
-> Render ()
draw_rectangle x y w h = do
rectangle (fromIntegral x) (fromIntegral y) (fromIntegral w) (fromIntegral h)
C.fill
-------------------------------------------------------------------------------
{-# INLINE draw_outlined_rectangle #-}
draw_outlined_rectangle :: (Integral x, Integral y, Integral w, Integral h)
=> x -> y -> w -> h
-> Render ()
draw_outlined_rectangle x y w h = do
rectangle (fromIntegral x) (fromIntegral y) (fromIntegral w) (fromIntegral h)
fillPreserve
setLineWidth 1
setSourceRGBA 0 0 0 0.7
stroke
-------------------------------------------------------------------------------
{-# INLINE draw_rectangle_opt #-}
draw_rectangle_opt :: (Integral x, Integral y, Integral w, Integral h)
=> Bool -> x -> y -> w -> h
-> Render ()
draw_rectangle_opt opt x y w h
= draw_rectangle_opt' opt (fromIntegral x) (fromIntegral y)
(fromIntegral w) (fromIntegral h)
draw_rectangle_opt' :: Bool -> Double -> Double -> Double -> Double
-> Render ()
draw_rectangle_opt' opt x y w h
= do rectangle x y (1.0 `max` w) h
C.fill
when opt $ do
setLineWidth 1
setSourceRGBA 0 0 0 0.7
rectangle x y w h
stroke
-------------------------------------------------------------------------------
{-# INLINE draw_rectangle_outline #-}
draw_rectangle_outline :: (Integral x, Integral y, Integral w, Integral h)
=> x -> y -> w -> h
-> Render ()
draw_rectangle_outline x y w h = do
setLineWidth 2
rectangle (fromIntegral x) (fromIntegral y) (fromIntegral w) (fromIntegral h)
stroke
-------------------------------------------------------------------------------
clearWhite :: Render ()
clearWhite = do
save
setOperator OperatorSource
setSourceRGBA 0xffff 0xffff 0xffff 0xffff
paint
restore
|
