File: SOE.hs

package info (click to toggle)
haskell-hgl 3.1-3
  • links: PTS
  • area: main
  • in suites: etch, etch-m68k
  • size: 432 kB
  • ctags: 12
  • sloc: haskell: 2,585; makefile: 60; sh: 22
file content (274 lines) | stat: -rw-r--r-- 8,343 bytes parent folder | download | duplicates (10)
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
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
-----------------------------------------------------------------------------
-- |
-- Module      :  Graphics.SOE
-- Copyright   :  (c) Alastair Reid, 1999-2003
-- License     :  BSD-style (see the file libraries/base/LICENSE)
--
-- Maintainer  :  libraries@haskell.org
-- Stability   :  stable
-- Portability :  non-portable (requires concurrency)
--
-- The graphics library used in /The Haskell School of Expression/,
-- by Paul Hudak, cf <http://www.haskell.org/soe/>.
--
-- /Notes:/
--
-- * This module is called @SOEGraphics@ in the book.  It is a cut
--   down version of "Graphics.HGL", with the interface frozen to match
--   the book.
--
-- * In chapters 13, 17 and 19 of the book, there are imports of modules
--   @Win32Misc@ and @Word@.  These should be omitted, as 'timeGetTime'
--   and 'word32ToInt' are provided by this module.
-----------------------------------------------------------------------------

module Graphics.SOE
	(
	-- * Getting started
	  runGraphics		-- p41

	-- * Windows
	, Title			-- p40
	, Size
	, Window
	, openWindow
	, getWindowSize		-- not in SOE, but Resize is
	, clearWindow		-- used on p127
	, drawInWindow		-- p41
	, drawInWindowNow	-- backward compatibility (p281)
	, setGraphic		-- p168
	, closeWindow		-- p41

	-- ** General windows
	, openWindowEx		-- p168

	, RedrawMode		-- SOE has (Graphic -> DrawFun)
	, drawGraphic		-- p168
	, drawBufferedGraphic

	-- * Drawing
	, Graphic		-- p41
	, emptyGraphic		-- p171
	, overGraphic
	, overGraphics		-- not in SOE, but an obvious extension

	-- ** Color
	, Color(..)		-- p43
	, withColor

	-- ** Drawing text
	, text			-- p41

	-- ** Drawing shapes
	, Point
	, ellipse		-- p43
	, shearEllipse
	, line
	, polygon
	, polyline
	, polyBezier -- warning: becomes error message and polyline in X11

	, Angle			-- not in SOE
	, arc			-- not in SOE, but handy for pie charts

	-- ** Regions
	, Region		-- p117
	, createRectangle
	, createEllipse
	, createPolygon
	, andRegion
	, orRegion
	, xorRegion
	, diffRegion
	, drawRegion

	-- * User interaction

	-- ** Keyboard events
	, getKey		-- p41

	-- ** Mouse events
	, getLBP		-- used on p127
	, getRBP		-- not in SOE, but obvious

	-- ** General events
	, Event(..)		-- p214
	, maybeGetWindowEvent	-- p248
	, getWindowEvent	-- not in SOE, but obvious

	-- * Time
	-- Timers that tick at regular intervals are set up by 'openWindowEx'.
	, Word32		-- p168
	, getWindowTick

	, timeGetTime		-- from Win32
	, word32ToInt		-- obsolete function from Data.Word

	) where

import Graphics.HGL
	hiding (getKey, getKeyEx, openWindowEx,
		Event(..), getWindowEvent, maybeGetWindowEvent)
import qualified Graphics.HGL as HGL
import Control.Monad(liftM)
import Data.Word(Word32)

----------------------------------------------------------------
-- Interface
----------------------------------------------------------------

-- | A rectangular region, with the given points as opposite corners.
createRectangle     :: Point -> Point -> Region

-- | A polygonal region defined by a list of 'Point's.
createPolygon       :: [Point] -> Region

-- | An elliptical region that fits in the rectangle with the given points
-- as opposite corners.
createEllipse       :: Point -> Point -> Region

-- | The union of two regions.
orRegion            :: Region -> Region -> Region

-- | The intersection of two regions.
andRegion           :: Region -> Region -> Region

-- | The part of the first region that is not also in the second.
diffRegion          :: Region -> Region -> Region

-- | Draw a 'Region' in the current color.
drawRegion          :: Region -> Graphic

-- | Another name for 'drawInWindow', retained for backwards compatibility.
drawInWindowNow     :: Window -> Graphic -> IO ()

----------------------------------------------------------------
-- Implementation
----------------------------------------------------------------

-- | an extended version of 'openWindow'.
openWindowEx :: Title		-- ^ the title of the window
             -> Maybe Point	-- ^ the initial position of the window
             -> Maybe Size	-- ^ the initial size of the window
             -> RedrawMode	-- ^ how to display a graphic on the window
             -> Maybe Word32	-- ^ optionally attach a timer to the window,
				-- with the specified time (in milliseconds)
				-- between ticks.
             -> IO Window
openWindowEx a b (Just c) d e =
  HGL.openWindowEx a b c d (fmap fromIntegral e)
openWindowEx a b Nothing d e =
  HGL.openWindowEx a b (300,300) d (fmap fromIntegral e)

createRectangle = rectangleRegion
createEllipse   = ellipseRegion
createPolygon   = polygonRegion
orRegion        = unionRegion
andRegion       = intersectRegion
diffRegion      = subtractRegion
drawRegion      = regionToGraphic

-- backwards compatibility:

-- | Draw directly to the window
-- (slightly faster than 'drawBufferedGraphic', but more prone to flicker).
drawGraphic         :: RedrawMode
drawGraphic          = Unbuffered

-- | Use a /double buffer/ to reduce flicker and thus improve the look
-- of animations.
drawBufferedGraphic :: RedrawMode
drawBufferedGraphic  = DoubleBuffered

-- should have a different way to specify background color
-- drawBufferedGraphicBC :: RGB -> RedrawMode

drawInWindowNow = drawInWindow

-- | The current time of day (in milliseconds).
timeGetTime         :: IO Word32
timeGetTime = liftM integerToWord32 getTime

integerToWord32 :: Integer -> Word32
#ifdef __GLASGOW_HASKELL__
integerToWord32 = fromInteger	-- conversion to Word32 doesn't overflow
#else
integerToWord32 n = fromInteger (n `mod` (toInteger (maxBound::Word32) + 1))
#endif

-- | An obsolete special case of 'fromIntegral'.
word32ToInt         :: Word32 -> Int
word32ToInt = fromIntegral

----------------------------------------------------------------
-- Event, getKey, and maybeGetWindowEvent compatibility
----------------------------------------------------------------

{-
 The SOE sources are set in stone, so this module provides the interface
 SOE expects, even if the Graphics library moves on (cf. Event.Key).
-}

-- Deprecated SOE compatibility.

-- | Wait until a key is pressed and released,
-- and return the corresponding character.
getKey :: Window -> IO Char
getKey w = do { getKeyEx w True; getKeyEx w False }

-- | Wait until a key is pressed (if the second argument is 'True')
-- or released (otherwise), and return the corresponding character.
-- (not in SOE)
getKeyEx :: Window -> Bool -> IO Char
getKeyEx w down = loop
 where
  loop = do
        e <- HGL.getWindowEvent w
        case e of
          HGL.Key { HGL.keysym = k, HGL.isDown = isDown }
            |  isDown == down && isCharKey k
            -> return (keyToChar k)
          _ -> loop

-- | Wait for the next event in the window.
getWindowEvent :: Window -> IO Event
getWindowEvent w = liftM toSOEEvent (HGL.getWindowEvent w)

-- | Return a pending eventin the window, if any.
maybeGetWindowEvent :: Window -> IO (Maybe Event)
maybeGetWindowEvent w = liftM (fmap toSOEEvent) (HGL.maybeGetWindowEvent w)

-- tiresome, but necessary.
toSOEEvent :: HGL.Event -> Event
toSOEEvent (HGL.Char x)       = Key x True
toSOEEvent (HGL.Key k isDown) = Key (keyToChar k) isDown
toSOEEvent (HGL.Button pt left down) = Button pt left down
toSOEEvent (HGL.MouseMove p)  = MouseMove p
toSOEEvent (HGL.Resize)       = Resize
toSOEEvent (HGL.Closed)       = Closed

-- | User interface events
data Event
  = Key
    { char :: Char	-- ^ character corresponding to the key
    , isDown :: Bool	-- ^ if 'True', the key was pressed;
			-- otherwise it was released
    }			-- ^ occurs when a key was pressed or released.
  | Button
    { pt :: Point	-- ^ the position of the mouse cursor
    , isLeft :: Bool	-- ^ if 'True', it was the left button
    , isDown :: Bool	-- ^ if 'True', the button was pressed;
			-- otherwise it was released
    }			-- ^ occurs when a mouse button is pressed or released.
  | MouseMove
    { pt :: Point	-- ^ the position of the mouse cursor
    }			-- ^ occurs when the mouse is moved inside the window.
  | Resize		-- ^ occurs when the window is resized.
			-- The new window size can be discovered using
			-- 'getWindowSize'.
  | Closed		-- ^ occurs when the window is closed.
 deriving Show

----------------------------------------------------------------
-- End
----------------------------------------------------------------