1"======================================================================
2|
3|   SDL declarations
4|
5|
6 ======================================================================"
7
8
9"======================================================================
10|
11| Copyright 2006, 2008 Free Software Foundation, Inc.
12| Written by Brad Watson
13|
14| This file is part of the GNU Smalltalk class library.
15|
16| The GNU Smalltalk class library is free software; you can redistribute it
17| and/or modify it under the terms of the GNU Lesser General Public License
18| as published by the Free Software Foundation; either version 2.1, or (at
19| your option) any later version.
20|
21| The GNU Smalltalk class library is distributed in the hope that it will be
22| useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
23| MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser
24| General Public License for more details.
25|
26| You should have received a copy of the GNU Lesser General Public License
27| along with the GNU Smalltalk class library; see the file COPYING.LIB.
28| If not, write to the Free Software Foundation, 59 Temple Place - Suite
29| 330, Boston, MA 02110-1301, USA.
30|
31 ======================================================================"
32
33
34"======================================================================
35|
36|   Notes: implemented without callbacks.
37|
38 ======================================================================"
39
40Object subclass: #SdlJoystick
41    instanceVariableNames: ''
42    classVariableNames: ''
43    poolDictionaries: ''
44    category: 'LibSDL-Core'! !
45
46!SdlJoystick class methodsFor: 'Constants'!
47
48sdlHatCentered
49    ^16r00!
50
51sdlHatUp
52    ^16r01!
53
54sdlHatRight
55    ^16r02!
56
57sdlHatDown
58    ^16r04!
59
60sdlHatLeft
61    ^16r08!
62
63sdlHatRightUp
64    ^16r03!
65
66sdlHatRightDown
67    ^16r06!
68
69sdlHatLeftUp
70    ^16r09!
71
72sdlHatLeftDown
73    ^16r0c!
74
75!SdlJoystick class methodsFor: 'C call-outs'!
76
77sdlNumJoysticks
78    "I answer the number of joysticks attached to the system. My C
79    function prototype:
80
81    extern DECLSPEC int SDLCALL SDL_NumJoysticks(void);"
82    <cCall: 'SDL_NumJoysticks' returning: #int
83        args: #( )>!
84
85sdlJoystickName: aInt0
86    "I answer the name of a joystick. My C function call prototype:
87
88    extern DECLSPEC const char * SDLCALL SDL_JoystickName(int device_index);"
89    <cCall: 'SDL_JoystickName' returning: #string
90        args: #( #int )>!
91
92sdlJoystickOpen: aInt0
93    "I open the the system joystick instance given to me. My C
94    function call prototype:
95
96    extern DECLSPEC SDL_Joystick * SDLCALL SDL_JoystickOpen(int device_index);"
97    <cCall: 'SDL_JoystickOpen' returning: #cObject
98        args: #( #int  )>!
99
100sdlJoystickOpened: aInt0
101    "I answer whether or not the system joystick instance given to me
102    is open. My C function call prototype:
103
104    extern DECLSPEC int SDLCALL SDL_JoystickOpened(int device_index);"
105    <cCall: 'SDL_JoystickOpened' returning: #int
106        args: #( #int )>!
107
108sdlJoystickIndex: aCobject0
109    "I answer the device index of an opened joystick. My C function
110    call prototype:
111
112    extern DECLSPEC int SDLCALL SDL_JoystickIndex(SDL_Joystick *joystick);"
113    <cCall: 'SDL_JoystickIndex' returning: #int
114        args: #( #cObject )>!
115
116sdlJoystickNumAxes: cObject
117    "I answer the number of general axis controls on a joystick. My C
118    function call prototype:
119
120    extern DECLSPEC int SDLCALL SDL_JoystickNumAxes(SDL_Joystick *joystick);"
121    <cCall: 'SDL_JoystickNumAxes' returning: #int
122        args: #( #cObject )>!
123
124sdlJoystickNumBalls: aCobject0
125    "I answer the number of balls on a joystick. My C function call
126    prototype:
127
128    extern DECLSPEC int SDLCALL SDL_JoystickNumBalls(SDL_Joystick *joystick);"
129    <cCall: 'SDL_JoystickNumBalls' returning: #int
130        args: #( #cObject )>!
131
132sdlJoystickNumHats: aCobject0
133    "I answer the number of hats on a joystick. My C function call
134    prototype:
135
136    extern DECLSPEC int SDLCALL SDL_JoystickNumHats(SDL_Joystick *joystick);"
137    <cCall: 'SDL_JoystickNumHats' returning: #int
138        args: #( #cObject )>!
139
140sdlJoystickNumButtons: aCobject0
141    "I answer the number of buttonss on a joystick. My C function call
142    prototype:
143
144    extern DECLSPEC int SDLCALL SDL_JoystickNumButtons(SDL_Joystick *joystick);"
145    <cCall: 'SDL_JoystickNumButtons' returning: #int
146        args: #( #cObject )>!
147
148sdlJoystickUpdate
149    "I update the current state of the open joysticks. My C function
150    call prototype:
151
152    extern DECLSPEC void SDLCALL SDL_JoystickUpdate(void);"
153    <cCall: 'SDL_JoystickUpdate' returning: #void
154        args: #( #void)>!
155
156sdlJoystickEventState: aInt0
157    "I enable or disable joystick event polling. My C function call
158    prototype:
159
160    extern DECLSPEC int SDLCALL SDL_JoystickEventState(int state);"
161    <cCall: 'SDL_JoystickEventState' returning: #int
162        args: #( #int )>!
163
164sdlJoystickGetAxis: aCobject0 axis: aInt1
165    "I answer the current state of an axis control on a joystick. My C function call prototype:
166
167    extern DECLSPEC Sint16 SDLCALL SDL_JoystickGetAxis(SDL_Joystick *joystick, int axis);"
168    <cCall: 'SDL_JoystickGetAxis' returning: #int
169        args: #( #cObject #int  )>!
170
171sdlJoystickGetHat: aCobject0 hat: aInt1
172    "I answer the current state of the hat on a joystick. My C function call prototype:
173
174    extern DECLSPEC Uint8 SDLCALL SDL_JoystickGetHat(SDL_Joystick *joystick, int hat);"
175    <cCall: 'SDL_JoystickGetHat' returning: #char
176        args: #( #cObject #int  )>!
177
178sdlJoystickGetBall: aCobject0 ball: aInt1 dx: aCobject2 dy: aCobject3
179    "I answer the ball axis change since the last poll. My C function call prototype:
180
181    extern DECLSPEC int SDLCALL SDL_JoystickGetBall(SDL_Joystick *joystick, int ball, int *dx, int *dy);"
182    <cCall: 'SDL_JoystickGetBall' returning: #int
183        args: #( #cObject #int #cObject #cObject )>!
184
185sdlJoystickGetButton: aCobject0 button: aInt1
186    "I answer the current state of a button on a joystick. My C function call prototype:
187
188    extern DECLSPEC Uint8 SDLCALL SDL_JoystickGetButton(SDL_Joystick *joystick, int button);"
189    <cCall: 'SDL_JoystickGetButton' returning: #char
190        args: #( #cObject #int  )>!
191
192sdlJoystickClose: aCobject0
193   "I close a previously opened joystick. My C function call prototype:
194
195    extern DECLSPEC void SDLCALL SDL_JoystickClose(SDL_Joystick *joystick);"
196    <cCall: 'SDL_JoystickClose' returning: #void
197        args: #( #cObject )>! !
198