File: Joystick.hsc

package info (click to toggle)
haskell-sdl 0.6.4-2
  • links: PTS, VCS
  • area: main
  • in suites: jessie, jessie-kfreebsd
  • size: 376 kB
  • ctags: 3
  • sloc: haskell: 200; ansic: 18; makefile: 13
file content (180 lines) | stat: -rw-r--r-- 6,663 bytes parent folder | download | duplicates (2)
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
#include "SDL.h"
#ifdef main
#undef main
#endif
-----------------------------------------------------------------------------
-- |
-- Module      :  Graphics.UI.SDL.Joystick
-- Copyright   :  (c) David Himmelstrup 2005
-- License     :  BSD-like
--
-- Maintainer  :  lemmih@gmail.com
-- Stability   :  provisional
-- Portability :  portable
--
-----------------------------------------------------------------------------
module Graphics.UI.SDL.Joystick
    ( countAvailable
    , tryName
    , name
    , tryOpen
    , open
    , opened
    , index
    , axesAvailable
    , ballsAvailable
    , hatsAvailable
    , buttonsAvailable
    , update
    , getAxis
    , getHat
    , getButton
    , getBall
    , close
    ) where

import Foreign (Int16, Word8, Ptr, FunPtr, Storable(peek),
                finalizeForeignPtr, toBool, maybePeek, alloca, withForeignPtr, newForeignPtr)
import Foreign.C (peekCString, CString)
import System.IO.Unsafe (unsafePerformIO)

import Graphics.UI.SDL.General (unwrapMaybe)
import Graphics.UI.SDL.Utilities (fromBitmask)
import Graphics.UI.SDL.Types (Hat, Joystick, JoystickStruct)

type JoystickIndex = Int

--int SDL_NumJoysticks(void);
-- | Counts the number of joysticks attached to the system.
foreign import ccall unsafe "SDL_NumJoysticks" countAvailable :: IO Int

-- const char *SDL_JoystickName(int index);
foreign import ccall unsafe "SDL_JoystickName" sdlJoystickName :: JoystickIndex -> IO CString
-- | Gets joystick name. Returns @Nothing@ on error.
tryName :: JoystickIndex -> IO (Maybe String)
tryName idx = sdlJoystickName idx >>= maybePeek peekCString

-- | Gets joystick name. Throws an exception on error.
name :: JoystickIndex -> IO String
name = unwrapMaybe "SDL_JoystickName" . tryName

-- SDL_Joystick *SDL_JoystickOpen(int index);
foreign import ccall unsafe "SDL_JoystickOpen" sdlJoystickOpen :: JoystickIndex -> IO (Ptr JoystickStruct)
-- | Opens a joystick for use. Returns @Nothing@ on error.
tryOpen :: JoystickIndex -> IO (Maybe Joystick)
tryOpen idx = sdlJoystickOpen idx >>= maybePeek mkFinalizedJoystick

-- | Opens a joystick for use. Throws an exception on error.
open :: JoystickIndex -> IO Joystick
open = unwrapMaybe "SDL_JoystickOpen" . tryOpen

-- int SDL_JoystickOpened(int index);
foreign import ccall unsafe "SDL_JoystickOpened" sdlJoystickOpened :: JoystickIndex -> IO Int

-- | Determines if a joystick has been opened.
opened :: JoystickIndex -> IO Bool
opened = fmap toBool . sdlJoystickOpened

-- int SDL_JoystickIndex(SDL_Joystick *joystick);
foreign import ccall unsafe "SDL_JoystickIndex" sdlJoystickIndex :: Ptr JoystickStruct -> JoystickIndex
-- | Gets the index of an @Joystick@.
index :: Joystick -> JoystickIndex
index joystick
    = unsafePerformIO $
      withForeignPtr joystick $
      return . sdlJoystickIndex

-- int SDL_JoystickNumAxes(SDL_Joystick *joystick);
foreign import ccall unsafe "SDL_JoystickNumAxes" sdlJoystickNumAxes :: Ptr JoystickStruct -> Int
-- | Gets the number of joystick axes.
axesAvailable :: Joystick -> Int
axesAvailable joystick
    = unsafePerformIO $
      withForeignPtr joystick $
      return . sdlJoystickNumAxes

-- int SDL_JoystickNumBalls(SDL_Joystick *joystick);
foreign import ccall unsafe "SDL_JoystickNumBalls" sdlJoystickNumBalls :: Ptr JoystickStruct -> Int
-- | Gets the number of joystick trackballs.
ballsAvailable :: Joystick -> Int
ballsAvailable joystick
    = unsafePerformIO $
      withForeignPtr joystick $
      return . sdlJoystickNumBalls

-- int SDL_JoystickNumHats(SDL_Joystick *joystick);
foreign import ccall unsafe "SDL_JoystickNumHats" sdlJoystickNumHats :: Ptr JoystickStruct -> Int
-- | Gets the number of joystick hats.
hatsAvailable :: Joystick -> Int
hatsAvailable joystick
    = unsafePerformIO $
      withForeignPtr joystick $
      return . sdlJoystickNumHats

-- int SDL_JoystickNumButtons(SDL_Joystick *joystick);
foreign import ccall unsafe "SDL_JoystickNumButtons" sdlJoystickNumButtons :: Ptr JoystickStruct -> Int
-- | Gets the number of joystick buttons.
buttonsAvailable :: Joystick -> Int
buttonsAvailable joystick
    = unsafePerformIO $
      withForeignPtr joystick $
      return . sdlJoystickNumButtons

-- void SDL_JoystickUpdate(void);
-- | Updates the state of all joysticks.
foreign import ccall unsafe "SDL_JoystickUpdate" update :: IO ()

-- Sint16 SDL_JoystickGetAxis(SDL_Joystick *joystick, int axis);
foreign import ccall unsafe "SDL_JoystickGetAxis" joystickGetAxis :: Ptr JoystickStruct -> Int -> IO Int16
-- | Gets the current state of an axis.
getAxis :: Joystick -> Word8 -> IO Int16
getAxis joystick axis
    = withForeignPtr joystick $ \ptr ->
      joystickGetAxis ptr (fromIntegral axis)

-- Uint8 SDL_JoystickGetHat(SDL_Joystick *joystick, int hat);
foreign import ccall unsafe "SDL_JoystickGetHat" joystickGetHat :: Ptr JoystickStruct -> Int -> IO Word8
-- | Gets the current state of a joystick hat.
getHat :: Joystick -> Word8 -> IO [Hat]
getHat joystick axis
    = withForeignPtr joystick $ \ptr ->
      fmap (fromBitmask.fromIntegral) (joystickGetHat ptr (fromIntegral axis))

-- Uint8 SDL_JoystickGetButton(SDL_Joystick *joystick, int button);
foreign import ccall unsafe "SDL_JoystickGetButton" joystickGetButton :: Ptr JoystickStruct -> Int -> IO Word8
-- | Gets the current state of a given button on a given joystick.
getButton :: Joystick -> Word8 -> IO Bool
getButton joystick button
    = withForeignPtr joystick $ \ptr ->
      fmap toBool (joystickGetButton ptr (fromIntegral button))

-- int SDL_JoystickGetBall(SDL_Joystick *joystick, int ball, int *dx, int *dy);
foreign import ccall unsafe "SDL_JoystickGetBall" joystickGetBall
    :: Ptr JoystickStruct -> Int -> Ptr Int -> Ptr Int -> IO Int
-- | Gets relative trackball motion.
getBall :: Joystick -> Word8 -> IO (Maybe (Int16,Int16))
getBall joystick ball
    = withForeignPtr joystick $ \ptr ->
      alloca $ \xrelPtr ->
      alloca $ \yrelPtr ->
      do ret <- joystickGetBall ptr (fromIntegral ball) xrelPtr yrelPtr
         case ret of
           0 -> do [xrel,yrel] <- mapM (fmap fromIntegral . peek) [xrelPtr,yrelPtr]
                   return $! Just (xrel,yrel)
           _ -> return Nothing

-- | Force finalization of a previous opened @Joystick@. Only supported with GHC.
close :: Joystick -> IO ()
close =
#if defined(__GLASGOW_HASKELL__)
  finalizeForeignPtr
#else
  const (return ())
#endif

-- void SDL_JoystickClose(SDL_Joystick *joystick);
foreign import ccall unsafe "&SDL_JoystickClose" sdlCloseJoystickFinal :: FunPtr (Ptr JoystickStruct -> IO ())

mkFinalizedJoystick :: Ptr JoystickStruct -> IO Joystick
mkFinalizedJoystick = newForeignPtr sdlCloseJoystickFinal