I had a go at exercise 10.4 "Write a program to drag and drop pictures...". The
program seemed to work - I could drag and drop although the results weren't
particularly elegant but after dragging a picture for about 10 seconds I got
User error: Error raised in function CreateEllipticRgn
Trying to run the program again gave the same error immediately.
Hugs was unable to point me at where the problem was occurring.
Picture> :i CreateEllipticRgn
Unknown reference `CreateEllipticRgn'
Picture> :f CreateEllipticRgn
ERROR: No current definition for name "CreateEllipticRgn"
Does anyone have any ideas what's happening? I've attached the offending module below.
I can supply Draw and Region if required.
Dominic.
==================================================================================================
module Picture (Picture (Region, Over, EmptyPic),
Color (Black, Blue, Green, Cyan,
Red, Magenta, Yellow, White),
regionToGRegion, shapeToGRegion,
drawRegionInWindow, drawPic, draw, spaceClose,
module Region
) where
import Draw
import Region
import SOEGraphics hiding (Region)
import qualified SOEGraphics as G (Region)
data Picture = Region Color Region
| Picture `Over` Picture
| EmptyPic
deriving Show
type Vector = (Float,Float)
xWin2 = xWin `div` 2
yWin2 = yWin `div` 2
drawPic :: Window -> Picture -> IO ()
drawPic w (Region c r) = drawRegionInWindow w c r
drawPic w (p1 `Over` p2) = do drawPic w p2; drawPic w p1
drawPic w EmptyPic = return ()
drawRegionInWindow :: Window -> Color -> Region -> IO ()
drawRegionInWindow w c r =
drawInWindow w (withColor c (drawRegion (regionToGRegion r)))
regionToGRegion :: Region -> G.Region
regionToGRegion r = regToGReg (0,0) (1,1) r
regToGReg :: Vector -> Vector -> Region -> G.Region
regToGReg loc sca Empty =
createRectangle (0,0) (0,0)
regToGReg loc sca (Shape s) =
shapeToGRegion loc sca s
regToGReg loc (sx,sy) (Scale (u,v) r) =
regToGReg loc (sx*u,sy*v) r
regToGReg (lx,ly) (sx,sy) (Translate (u,v) r) =
regToGReg (lx+sx*u,ly+v*sy) (sx,sy) r
regToGReg loc sca (r1 `Union` r2) =
primGReg loc sca r1 r2 orRegion
regToGReg loc sca (r1 `Intersect` r2) =
primGReg loc sca r1 r2 andRegion
regToGReg loc sca (Complement r) =
primGReg loc sca winRect r diffRegion
winRect ::Region
winRect = Shape (Rectangle (pixelToInch xWin)
(pixelToInch yWin))
primGReg loc sca r1 r2 op =
let gr1 = regToGReg loc sca r1
gr2 = regToGReg loc sca r2
in op gr1 gr2
shapeToGRegion :: Vector -> Vector -> Shape -> G.Region
shapeToGRegion (lx,ly) (sx,sy) s =
case s of
Rectangle s1 s2 ->
createRectangle (trans (-s1/2,-s2/2))
(trans (s1/2,s2/2))
Ellipse r1 r2 ->
createEllipse (trans (-r1,-r2))
(trans (r1,r2))
Polygon vs ->
createPolygon (map trans vs)
RtTriangle s1 s2 ->
createPolygon (map trans [(0,0),(s1,0),(0,s2)])
where trans :: Vertex -> Point
trans (x,y) =
(xWin2+inchToPixel(lx+x*sx),
yWin2-inchToPixel(ly+y*sy))
draw :: String -> Picture -> IO ()
draw s p =
runGraphics $
do w <- openWindow s (xWin,yWin)
drawPic w p
spaceClose w
picToList :: Picture -> [(Color,Region)]
picToList EmptyPic = []
picToList (Region c r) = [(c,r)]
picToList (p1 `Over` p2) = picToList p1 ++ picToList p2
adjust :: [(Color,Region)] -> Coordinate ->
(Maybe (Color,Region),[(Color,Region)])
adjust regs p =
case (break (\(_,r) -> r `containsR` p) regs) of
(top,hit:rest) -> (Just hit, top++rest)
(_,[]) -> (Nothing,regs)
moveTop :: [(Color,Region)] -> Coordinate -> [(Color,Region)]
moveTop [] p = []
moveTop ((cTop,rTop):rest) (x,y) = (cTop,Translate (x,y) rTop):rest
loop :: Window -> [(Color,Region)] -> IO ()
loop w regs =
do clearWindow w
sequence_ [drawRegionInWindow w c r | (c,r) <- reverse regs]
(x,y) <- getLBP w
let c = (pixelToInch (x-xWin2),pixelToInch (yWin2-y)) in
case (adjust regs c) of
(Nothing,_) -> closeWindow w
(Just hit, newRegs) -> loop1 w (hit:newRegs) c
loop1 :: Window -> [(Color,Region)] -> Coordinate -> IO ()
loop1 w regs (x,y)=
do e <- getWindowEvent w
case e of
MouseMove{pt = (x',y')}
-> do clearWindow w
sequence_ [drawRegionInWindow w c r | (c,r) <- reverse newRegs]
loop1 w newRegs (pixelToInch (x'-xWin2),pixelToInch (yWin2-y'))
where newRegs = moveTop regs ((pixelToInch (x'-xWin2))-x,
(pixelToInch (yWin2-y'))-y)
Button{pt=p,isLeft=l,isDown=d}
| l == True && d == False
-> loop w regs
_ -> loop1 w regs (x,y)
draw2 :: String -> Picture -> IO ()
draw2 s p =
runGraphics $
do w <- openWindow s (xWin,yWin)
loop w (picToList p)
r1 = Shape (Rectangle 3 2)
r2 = Shape (Ellipse 1 1.5)
reg1 = r1 `Intersect` Complement r2
pic1 = Region Blue r1
pic2 = Region Red r2
pic3 = Region Yellow (Translate (1,1) reg1)
pic4 = pic1 `Over` pic2 `Over` pic3
main = draw2 "" pic4
-------------------------------------------------------------------------------------------------
21st century air travel http://www.britishairways.com
