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
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
|
-----------------------------------------------------------------------------
-- |
-- Module : Graphics.HGL.Draw.Picture
-- Copyright : (c) Alastair Reid, 1999-2003
-- License : BSD-style (see the file libraries/base/LICENSE)
--
-- Maintainer : libraries@haskell.org
-- Stability : provisional
-- Portability : non-portable (requires concurrency)
--
-- Drawing various shapes.
--
-----------------------------------------------------------------------------
#include "HsHGLConfig.h"
module Graphics.HGL.Draw.Picture
( arc, ellipse, shearEllipse
, line, polyline, polygon
, polyBezier -- becomes error message and polyline in X11
) where
#if !X_DISPLAY_MISSING
import Graphics.HGL.X11.Types
import qualified Graphics.X11.Xlib as X
import System.IO.Unsafe(unsafePerformIO)
import System.IO(stderr, hPutStrLn)
#else
import Graphics.HGL.Win32.Types
import qualified Graphics.Win32 as Win32
#endif
import Graphics.HGL.Draw.Monad(Graphic)
import Graphics.HGL.Internals.Draw(mkDraw)
import Graphics.HGL.Units
----------------------------------------------------------------
-- The Interface (SOE, p50)
----------------------------------------------------------------
-- | A filled arc from an ellipse.
arc
:: Point -- ^ a corner of the rectangle bounding the ellipse.
-> Point -- ^ the opposite corner of the rectangle bounding the ellipse.
-> Angle -- ^ the start angle of the arc, measured counter-clockwise
-- from the horizontal.
-> Angle -- ^ the extent of the arc, measured counter-clockwise from
-- the start angle.
-> Graphic -- ^ a filled shape
-- | A filled ellipse that fits inside a rectangle defined by two
-- 'Point's on the window.
ellipse
:: Point -- ^ a corner of the rectangle bounding the ellipse.
-> Point -- ^ the opposite corner of the rectangle bounding the ellipse.
-> Graphic -- ^ a filled shape
-- | A filled sheared ellipse that fits inside a parallelogram defined
-- by three 'Point's on the window. This function is implemented using
-- polygons on both Win32 and X11.
shearEllipse
:: Point -- ^ a corner of the bounding parallelogram.
-> Point -- ^ another corner of the parallelogram, adjacent to the first.
-> Point -- ^ another corner of the parallelogram, adjacent to the first
-- and thus opposite to the second.
-> Graphic -- ^ a filled shape
-- | A filled polygon defined by a list of 'Point's.
polygon :: [Point] -> Graphic -- filled
-- | A line between two 'Point's.
line :: Point -> Point -> Graphic -- unfilled
-- | A series of lines through a list of 'Point's.
polyline :: [Point] -> Graphic -- unfilled
-- | A series of (unfilled) Bezier curves defined by a list of 3/n/+1
-- control 'Point's. This function is not supported on X11 (it yields
-- an error message and a 'polyline').
polyBezier :: [Point] -> Graphic -- unfilled
----------------------------------------------------------------
-- The Implementation
----------------------------------------------------------------
#if !X_DISPLAY_MISSING
arc (x0,y0) (x1,y1) s e = mkDraw (\ dc -> X.fillArc (disp dc) (drawable dc) (paintGC dc) x' y' w' h' s' e')
where
(x,w) = minAndDelta x0 x1
(y,h) = minAndDelta y0 y1
x' = fromIntegral x
y' = fromIntegral y
w' = fromIntegral w
h' = fromIntegral h
s' = round (s * 64)
e' = round (e * 64)
ellipse (x0,y0) (x1,y1) = mkDraw (\ dc -> X.fillArc (disp dc) (drawable dc) (brushGC dc) x' y' w' h' 0 threeSixty)
where
(x,w) = minAndDelta x0 x1
(y,h) = minAndDelta y0 y1
x' = fromIntegral x
y' = fromIntegral y
w' = fromIntegral w
h' = fromIntegral h
-- X measures angles in 64ths of a degree
threeSixty :: Int
threeSixty = 360*64
shearEllipse p0 p1 p2 = mkDraw (\ dc -> X.fillPolygon (disp dc) (drawable dc) (brushGC dc) pts X.convex X.coordModeOrigin)
where
X.Point x0 y0 = fromPoint p0
X.Point x1 y1 = fromPoint p1
X.Point x2 y2 = fromPoint p2
x = avg x1 x2 -- centre of parallelogram
y = avg y1 y2
dx1 = fromIntegral ((x1 - x0) `div` 2) -- distance to corners from centre
dy1 = fromIntegral ((y1 - y0) `div` 2)
dx2 = fromIntegral ((x2 - x0) `div` 2)
dy2 = fromIntegral ((y2 - y0) `div` 2)
pts = [ X.Point (x + round(c*dx1 + s*dx2)) (y + round(c*dy1 + s*dy2))
| (c,s) <- cos'n'sins
]
cos'n'sins :: [(Double,Double)]
cos'n'sins = [ (cos a, sin a) | a <- angles ]
angles :: [Angle]
angles = take 40 [0, pi/20 .. ]
line p0 p1 = mkDraw (\ dc -> X.drawLine (disp dc) (drawable dc) (paintGC dc) x0 y0 x1 y1)
where
X.Point x0 y0 = fromPoint p0
X.Point x1 y1 = fromPoint p1
polyline pts = mkDraw (\ dc -> X.drawLines (disp dc) (drawable dc) (paintGC dc) (map fromPoint pts) X.coordModeOrigin)
polygon pts = mkDraw (\ dc -> X.fillPolygon (disp dc) (drawable dc) (brushGC dc) (map fromPoint pts) X.complex X.coordModeOrigin)
polyBezier = unsafePerformIO $ do
hPutStrLn stderr "warning: polyBezier is unavailable in X11 -- using polyline instead"
return polyline
----------------------------------------------------------------
-- Utilities
----------------------------------------------------------------
-- delta is always +ve
minAndDelta :: Int -> Int -> (Int,Int)
minAndDelta a b
| a <= b = (a, b-a)
| otherwise = (b, a-b)
-- avg :: Int32 -> Int32 -> Int32
avg :: Integral a => a -> a -> a
avg a b = (a + b) `div` 2
#else /* X_DISPLAY_MISSING */
arc p0 p1 start end = mkDraw (\ hdc -> Win32.arc hdc x0 y0 x1 y1 xs ys xe ye)
where
(x0,y0) = fromPoint p0
(x1,y1) = fromPoint p1
x = (x0 + x1) `div` 2
y = (y0 + y1) `div` 2
start' = 2 * pi * start / 360
end' = 2 * pi * end / 360
xs = x + round (100 * cos start')
ys = y + round (100 * sin start')
xe = x + round (100 * cos end')
ye = y + round (100 * sin end')
ellipse p0 p1 = mkDraw (\ hdc -> Win32.ellipse hdc x0 y0 x1 y1)
where
(x0,y0) = fromPoint p0
(x1,y1) = fromPoint p1
shearEllipse p0 p1 p2 = mkDraw (\ hdc ->
Win32.transformedEllipse hdc (fromPoint p0) (fromPoint p1) (fromPoint p2))
line p0 p1 = mkDraw (\ hdc -> Win32.moveToEx hdc x0 y0 >> Win32.lineTo hdc x1 y1)
where
(x0,y0) = fromPoint p0
(x1,y1) = fromPoint p1
polyline pts = mkDraw (\ hdc -> Win32.polyline hdc (map fromPoint pts))
polygon pts = mkDraw (\ hdc -> Win32.polygon hdc (map fromPoint pts))
polyBezier pts = mkDraw (\ hdc -> Win32.polyBezier hdc (map fromPoint pts))
#endif /* X_DISPLAY_MISSING */
----------------------------------------------------------------
-- End
----------------------------------------------------------------
|
