[HOpenGL] mouseFunc vs. UserInput
Andre W B Furtado
awfurtado@uol.com.br
Tue, 28 May 2002 01:48:45 -0300
This is a multi-part message in MIME format.
------=_NextPart_000_000A_01C205E9.CD8109E0
Content-Type: text/plain;
charset="iso-8859-1"
Content-Transfer-Encoding: 7bit
> Andre W B Furtado wrote:
> > With the mouseFunc callback, it is very easy to recognize if the user
has
> > clicked in a point that belongs to a square: [...]
> > I'm trying to do the same using module UserInput.hs. [...]
Sven Panne wrote:
> First of all, I've never imagined that anybody would actually have a
deeper
> look at examples/misc... :-)
Actually, I think module UserInput is the best solution for FunGEn to deal
with input events...
> My suggestion is to [...] Does this help?
I used a similar though: I modified the Key data. Now the KeyMouse is:
KeyMouse MouseButton MouseRegion
Where MouseRegion is:
data MouseRegion
= Point Int Int
| RectangleArea (Int,Int) (Int,Int) Orientation
| CircleArea (Int,Int) Float Orientation
| PolygonArea [(Int,Int)] Orientation
| Anywhere
and
data Orientation
= Inside
| Outside
Now it is possible to check if the used has clicked inside/outside a
pre-defined region, such as a circle, a rectangle or other convex polygon.
If no specific region is desired, "Anywhere" can be used. Finally, it is
also possible to check if the point clicked is an exact point in the screen
(using "Point x y").
I'm sending this UserInput upgrade attached. Perhaps Sven would like to add
it to the next release of HOpenGL? :)
Cheers,
-- Andre
------=_NextPart_000_000A_01C205E9.CD8109E0
Content-Type: application/octet-stream;
name="UserInput.hs"
Content-Transfer-Encoding: quoted-printable
Content-Disposition: attachment;
filename="UserInput.hs"
{-
GLUT-based keyboard/mouse handling
Sven Panne 2000. mailto:Sven.Panne@informatik.uni-muenchen.de
obs.: the keyMouse and related events were a bit modified by Andre W =
B Furtado 2002 (mailto: awbf@cin.ufpe.br)
-}
module UserInput (
Key(KeyNormal,KeySpecial,KeyMouse), KeyEvent(..), KeyBinder, =
StillDownHandler, initUserInput,
MouseRegion(..), Orientation(..)
) where
import IOExts(IORef, newIORef, readIORef, modifyIORef)
import List(delete)
import GLUT
-------------------------------------------------------------------------=
--
data Key
=3D KeyNormal Char
| KeySpecial SpecialKey
| KeyMouse MouseButton MouseRegion
| KeyMouseAux MouseButton WindowPosition -- not exported, internal =
use only!
deriving Eq
data MouseRegion
=3D Point Int Int -- point (x,y)
| RectangleArea (Int,Int) (Int,Int) Orientation -- top left =
corner / bottom right corner / orientation
| CircleArea (Int,Int) Float Orientation -- circle centre / =
radius / orientation
| PolygonArea [(Int,Int)] Orientation -- point list (CCW =
order!) / orientation
| Anywhere -- always matches
deriving Eq
data Orientation
=3D Inside
| Outside
deriving Eq
data KeyEvent =3D Press | StillDown | Release deriving Eq
-------------------------------------------------------------------------=
--
type KeyTable =3D IORef [Key]
newKeyTable :: IO KeyTable
newKeyTable =3D newIORef []
getKeys :: KeyTable -> IO [Key]
getKeys =3D readIORef
insertIntoKeyTable :: KeyTable -> Key -> IO ()
insertIntoKeyTable keyTab key =3D modifyIORef keyTab (key:)
deleteFromKeyTable :: KeyTable -> Key -> IO ()
deleteFromKeyTable keyTab key =3D modifyIORef keyTab (delete key)
-------------------------------------------------------------------------=
--
type KeyBinder =3D Key -> KeyEvent -> Maybe (IO ()) -> IO ()
-- TODO: Improve type
type BindingTable =3D IORef [((Key,KeyEvent), IO ())]
newBindingTable :: IO BindingTable
newBindingTable =3D newIORef []
bindKey :: BindingTable -> KeyBinder
bindKey bindingTable key event Nothing =3D
modifyIORef bindingTable (\t -> [ e | e@(b,a) <- t, b /=3D (key, =
event)])
bindKey bindingTable key event (Just action) =3D do
bindKey bindingTable key event Nothing
modifyIORef bindingTable (((key, event), action) :)
execAction :: BindingTable -> Key -> KeyEvent -> IO ()
execAction bindingTable (KeyMouseAux button wp) event =3D
readIORef bindingTable >>=3D lookupMouse (button, wp, event)
execAction bindingTable key event =3D
readIORef bindingTable >>=3D (maybe (return ()) id . lookup (key, =
event))
lookupMouse :: (MouseButton,WindowPosition,KeyEvent) -> =
[((Key,KeyEvent), IO ())] -> IO()
lookupMouse _ [] =3D return ()
lookupMouse (button,wp,event) ((((KeyMouse mouseButton mouseRegion), =
mouseEvent),action):inputs)
| (button =3D=3D mouseButton && event =3D=3D mouseEvent && wp =
`match` mouseRegion) =3D action >> lookupMouse (button,wp,event) inputs
| otherwise =3D lookupMouse (button,wp,event) inputs
lookupMouse mouseInput (_:inputs) =3D lookupMouse mouseInput inputs
match :: WindowPosition -> MouseRegion -> Bool
match (WindowPosition x y) (Point pX pY) =3D (x =3D=3D pX) && (y =3D=3D =
pY)
match (WindowPosition x y) (RectangleArea (x1,y1) (x2,y2) Inside) =3D =
(x >=3D x1) && (x <=3D x2) && (y >=3D y1) && (y <=3D y2)
match (WindowPosition x y) (RectangleArea (x1,y1) (x2,y2) Outside) =3D =
(x < x1) || (x > x2) || (y < y1) || (y > y2)
match (WindowPosition x y) (CircleArea (cX,cY) radius Inside) =3D =
fromIntegral (dX*dX + dY*dY) <=3D radius * radius
where =
dX =3D (cX - x)
=
dY =3D (cY - y)
match (WindowPosition x y) (CircleArea (cX,cY) radius Outside) =3D =
fromIntegral (dX*dX + dY*dY) > radius * radius
where =
dX =3D (cX - x)
=
dY =3D (cY - y)
match (WindowPosition x y) (PolygonArea pointList Inside) =3D pnpoly =
((last pointList):pointList) x y
match (WindowPosition x y) (PolygonArea pointList Outside) =3D not $ =
pnpoly ((last pointList):pointList) x y
match _ Anywhere =3D True
-- checks if a point is inside a polygon
pnpoly :: [(Int,Int)] -> Int -> Int -> Bool
pnpoly [] _ _ =3D error "UserInput.pnpoly error: the impossible has =
happened!"
pnpoly (_:[]) _ _ =3D True
pnpoly ((x0,y0):(x1,y1):ps) x y =3D ((y - y0)*(x1 - x0) - (x - x0)*(y1 - =
y0) >=3D 0) && pnpoly ((x1,y1):ps) x y
-------------------------------------------------------------------------=
--
type StillDownHandler =3D IO ()
stillDown :: BindingTable -> KeyTable -> StillDownHandler
stillDown bindingTable pressedKeys =3D
getKeys pressedKeys >>=3D mapM_ (\k -> execAction bindingTable k =
StillDown)
-------------------------------------------------------------------------=
--
initUserInput :: IO (KeyBinder, StillDownHandler)
initUserInput =3D do
-- Using "setKeyRepeat KeyRepeatOff" would be a little bit more
-- efficient, but has two disadvantages: It is not yet implemented
-- for M$ and it changes the global state of X11.
ignoreKeyRepeat True
bindingTable <- newBindingTable
pressedKeys <- newKeyTable
let keyPress k =3D do insertIntoKeyTable pressedKeys k
execAction bindingTable k Press
keyRelease k =3D do deleteFromKeyTable pressedKeys k
execAction bindingTable k Release
keyboardFunc (Just (\k _ -> keyPress (KeyNormal k)))
keyboardUpFunc (Just (\k _ -> keyRelease (KeyNormal k)))
specialFunc (Just (\k _ -> keyPress (KeySpecial k)))
specialUpFunc (Just (\k _ -> keyRelease (KeySpecial k)))
mouseFunc (Just (\k ud wp -> case ud of
Down -> keyPress (KeyMouseAux k wp)
Up -> keyRelease (KeyMouseAux k wp)))
return (bindKey bindingTable, stillDown bindingTable pressedKeys)
------=_NextPart_000_000A_01C205E9.CD8109E0--