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: #SdlMouse
41    instanceVariableNames: ''
42    classVariableNames: ''
43    poolDictionaries: ''
44    category: 'LibSDL-Core'! !
45
46CStruct subclass: #SdlCursor
47    declaration: #(
48        (#area (#ptr #CObject))
49        (#hotX #short)
50        (#hotY #short)
51        (#data (#ptr #CObject))
52        (#mask (#ptr #CObject))
53        (#save (#ptr #CObject))
54        (#wmCursor (#ptr #CObject)))
55    classVariableNames: ''
56    poolDictionaries: ''
57    category: 'LibSDL-Core'! !
58
59!SdlMouse class methodsFor: 'Constants'!
60
61sdlButtonLeft
62    ^1!
63
64sdlButtonMiddle
65    ^2!
66
67sdlButtonRight
68    ^3!
69
70sdlButtonWheelUp
71    ^4!
72
73sdlButtonWheelDown
74    ^5!
75
76sdlButtonLMask
77    ^16r01!
78
79sdlButtonMMask
80    ^16r02!
81
82sdlButtonRMask
83    ^16r04!
84
85!SdlMouse class methodsFor: 'C call-outs'!
86
87sdlGetMouseState: aCobject0 y: aCobject1
88    "I answer the current state of the mouse. The C function call
89    prototype:
90
91    extern DECLSPEC Uint8 SDLCALL SDL_GetMouseState(int *x, int *y);"
92    <cCall: 'SDL_GetMouseState' returning: #char
93        args: #( #cObject #cObject  )>!
94
95sdlGetRelativeMouseState: aCobject0 y: aCobject1
96    "I answer the current state of the mouse. The C function call
97    prototype:
98
99    extern DECLSPEC Uint8 SDLCALL SDL_GetRelativeMouseState(int *x, int *y);"
100    <cCall: 'SDL_GetRelativeMouseState' returning: #char
101        args: #( #cObject #cObject  )>!
102
103sdlWarpMouse: aInt0 y: aInt1
104    "I set the position of the mouse cursor. My C function call
105    prototype:
106
107    extern DECLSPEC void SDLCALL SDL_WarpMouse(Uint16 x, Uint16 y);"
108    <cCall: 'SDL_WarpMouse' returning: #void
109        args: #( #int #int )>!
110
111sdlCreateCursor: aCobject0 mask: aCobject1 w: aInt2 h: aInt3 hotX: aInt4 hotY: aInt5
112    "I create a cursor using the data and mask given to me. My C
113    function call prototype:
114
115    extern DECLSPEC SDL_Cursor * SDLCALL SDL_CreateCursor (Uint8 *data, Uint8 *mask, int w, int h, int hot_x, int hot_y);"
116    <cCall: 'SDL_CreateCursor' returning: #cObject
117        args: #( #cObject #cObject #int #int #int #int  )>!
118
119sdlSetCursor: aCobject0
120    "I set the currently active cursor to the one given to me. My C
121    function call prototype:
122
123    extern DECLSPEC void SDLCALL SDL_SetCursor(SDL_Cursor *cursor);"
124    <cCall: 'SDL_SetCursor' returning: #void
125        args: #( #cObject )>!
126
127sdlGetCursor
128    "I answer the currently active cursor. My C function call
129    prototype:
130
131    extern DECLSPEC SDL_Cursor * SDLCALL SDL_GetCursor(void);"
132    <cCall: 'SDL_GetCursor' returning: #cObject
133        args: #( )>!
134
135sdlFreeCursor: aCobject0
136    "I deallocate a cursor created with SDL_CreateCursor(). My C
137    function call prototype:
138
139    extern DECLSPEC void SDLCALL SDL_FreeCursor(SDL_Cursor *cursor);"
140    <cCall: 'SDL_FreeCursor' returning: #void
141        args: #( #cObject )>!
142
143sdlShowCursor: aInt0
144    "I toggle whether or not the cursor is shown on the screen. My C
145    function call prototype:
146
147    extern DECLSPEC int SDLCALL SDL_ShowCursor(int toggle);"
148    <cCall: 'SDL_ShowCursor' returning: #int
149        args: #( #int )>! !
150