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
|
module GraphicsPen(
Style(..),
Pen,
mkPen, withPen,
createPen, deletePen
) where
import GraphicsTypes
import GraphicsUtilities( bracket, bracket_ )
import qualified Win32
----------------------------------------------------------------
-- The interface
----------------------------------------------------------------
newtype Pen = Pen Win32.HPEN
data Style
= Solid
| Dash -- "-------"
| Dot -- "......."
| DashDot -- "_._._._"
| DashDotDot -- "_.._.._"
| Null
| InsideFrame
withPen :: Pen -> Picture -> Picture
mkPen :: Style -> Int -> RGB -> (Pen -> Picture) -> Picture
createPen :: Style -> Int -> RGB -> IO Pen
deletePen :: Pen -> IO ()
----------------------------------------------------------------
-- The implementation
----------------------------------------------------------------
style :: Style -> Win32.PenStyle
style Solid = Win32.pS_SOLID
style Dash = Win32.pS_DASH
style Dot = Win32.pS_DOT
style DashDot = Win32.pS_DASHDOT
style DashDotDot = Win32.pS_DASHDOTDOT
style Null = Win32.pS_NULL
style InsideFrame = Win32.pS_INSIDEFRAME
mkPen sty width c p = \ hdc ->
bracket (createPen sty width c) deletePen $ \ pen ->
p pen hdc
withPen (Pen pen) p = \ hdc ->
bracket_ (Win32.selectPen hdc pen) (Win32.selectPen hdc) (p hdc)
createPen sty width (RGB r g b) =
Win32.createPen (style sty) (fromInt width) (Win32.rgb r g b) >>= return . Pen
deletePen (Pen pen) =
Win32.deletePen pen
----------------------------------------------------------------
-- The end
----------------------------------------------------------------
|
