comparison modules/sdl.tp @ 291:38bbbf74b735

Initial work on event support in SDL module
author Michael Pavone <pavone@retrodev.com>
date Tue, 22 Jul 2014 23:35:08 -0700
parents b01d7c1b4edd
children 2b045d5b673b
comparison
equal deleted inserted replaced
290:38ca63e0a62e 291:38bbbf74b735
1 { 1 {
2 _constant <- macro: :name cname {
3 quote: (llMessage: name withVars: {
4 uintret <- obj_uint32 ptr
5 } andCode: {
6 uintret <- make_object: (addr_of: obj_uint32_meta) NULL 0
7 uintret num!: cname
8 uintret
9 })
10 }
11 _subsystems <- #{
12 _constant: timer SDL_INIT_TIMER
13 _constant: audio SDL_INIT_AUDIO
14 _constant: video SDL_INIT_VIDEO
15 _constant: joystick SDL_INIT_JOYSTICK
16 _constant: haptic SDL_INIT_HAPTIC
17 _constant: gameController SDL_INIT_GAMECONTROLLER
18 _constant: events SDL_INIT_EVENTS
19 _constant: everything SDL_INIT_EVERYTHING
20 }
21
22 _windowOpts <- #{
23 _constant: fullscreen SDL_WINDOW_FULLSCREEN
24 _constant: fullscreenDesktop SDL_WINDOW_FULLSCREEN_DESKTOP
25 _constant: opengl SDL_WINDOW_OPENGL
26 _constant: hidden SDL_WINDOW_HIDDEN
27 _constant: borderless SDL_WINDOW_BORDERLESS
28 _constant: minimized SDL_WINDOW_MINIMIZED
29 _constant: maximized SDL_WINDOW_MAXIMIZED
30 _constant: inputGrabbed SDL_WINDOW_INPUT_GRABBED
31 _constant: allowHighDPI SDL_WINDOW_ALLOW_HIGHDPI
32 }
33
34 _renderOpts <- #{
35 _constant: software SDL_RENDERER_SOFTWARE
36 _constant: accelerated SDL_RENDERER_ACCELERATED
37 _constant: presentVSYNC SDL_RENDERER_PRESENTVSYNC
38 _constant: targetTexture SDL_RENDERER_TARGETTEXTURE
39
40 }
41
42 _helper <- #{ 2 _helper <- #{
43 llMessage: createWindow withVars: { 3 llMessage: createWindow withVars: {
44 title <- string ptr 4 title <- string ptr
45 x <- obj_int32 ptr 5 x <- obj_int32 ptr
46 y <- obj_int32 ptr 6 y <- obj_int32 ptr
103 tex <- object ptr 63 tex <- object ptr
104 } andCode: :rendOpaque surfOpaque makeTexture { 64 } andCode: :rendOpaque surfOpaque makeTexture {
105 texOpaque <- make_object: (addr_of: cpointer_meta) NULL 0 65 texOpaque <- make_object: (addr_of: cpointer_meta) NULL 0
106 texOpaque val!: (SDL_CreateTextureFromSurface: (rendOpaque val) (surfOpaque val)) 66 texOpaque val!: (SDL_CreateTextureFromSurface: (rendOpaque val) (surfOpaque val))
107 if: (texOpaque val) { 67 if: (texOpaque val) {
108 tex <- ccall: makeTexture 1 (rendOpaque castTo: (object ptr)) (texOpaque castTo: (object ptr)) 68 tex <- ccall: makeTexture 2 (rendOpaque castTo: (object ptr)) (texOpaque castTo: (object ptr))
109 mcall: value 2 option tex 69 mcall: value 2 option tex
110 } else: { 70 } else: {
111 mcall: none 1 option 71 mcall: none 1 option
112 } 72 }
113 } 73 }
114 } 74
75 llMessage: pollEvent withVars: {
76 constructor <- lambda ptr
77 event <- SDL_Event
78 eventPtr <- cpointer ptr
79 eventType <- obj_uint32 ptr
80 timeStampO <- obj_uint32 ptr
81 } andCode: :constructor {
82 if: (SDL_PollEvent: (addr_of: event)) {
83 eventType <- make_object: (addr_of: obj_uint32_meta) NULL 0
84 timeStampO <- make_object: (addr_of: obj_uint32_meta) NULL 0
85 eventType num!: ((addr_of: event) type)
86 timeStampO num!: ((addr_of: ((addr_of: event) common)) timestamp)
87 eventPtr <- make_object: (addr_of: cpointer_meta) NULL 0
88 eventPtr val!: (addr_of: event)
89 mcall: value 2 option (ccall: constructor 3 (eventType castTo: (object ptr)) (
90 timeStampO castTo: (object ptr)) (eventPtr castTo: (object ptr)))
91 } else: {
92 mcall: none 1 option
93 }
94 }
95
96 llMessage: populateWindowEvent withVars: {
97 eventPtr <- cpointer ptr
98 empty <- object ptr
99 winEvent <- SDL_WindowEvent ptr
100 ou32 <- obj_uint32 ptr
101 ou8 <- obj_uint8 ptr
102 oi32 <- obj_int32 ptr
103 } andCode: :eventPtr empty {
104 winEvent <- eventPtr val
105 ou32 <- make_object: (addr_of: obj_uint32_meta) NULL 0
106 ou32 num!: (winEvent windowID)
107 mcall: windowID! 2 empty ou32
108 ou8 <- make_object: (addr_of: obj_uint8_meta) NULL 0
109 ou8 num!: (winEvent event)
110 mcall: event! 2 empty ou8
111 oi32 <- make_object: (addr_of: obj_int32_meta) NULL 0
112 oi32 num!: (winEvent data1)
113 mcall: data1! 2 empty oi32
114 oi32 <- make_object: (addr_of: obj_int32_meta) NULL 0
115 oi32 num!: (winEvent data2)
116 mcall: data2! 2 empty oi32
117 empty
118 }
119
120 llMessage: populateKeyEvent withVars: {
121 eventPtr <- cpointer ptr
122 empty <- object ptr
123 keyEvent <- SDL_KeyboardEvent ptr
124 ou32 <- obj_uint32 ptr
125 ou16 <- obj_uint32 ptr
126 ou8 <- obj_uint8 ptr
127 } andCode: :eventPtr empty {
128 keyEvent <- eventPtr val
129 ou32 <- make_object: (addr_of: obj_uint32_meta) NULL 0
130 ou32 num!: (keyEvent windowID)
131 mcall: windowID! 2 empty ou32
132 if: (keyEvent state) = SDL_PRESSED {
133 mcall: pressed?! 2 empty true
134 } else: {
135 mcall: pressed?! 2 empty false
136 }
137 ou8 <- make_object: (addr_of: obj_uint8_meta) NULL 0
138 ou8 num!: (keyEvent repeat)
139 mcall: repeat! 2 empty ou8
140 ou32 <- make_object: (addr_of: obj_uint32_meta) NULL 0
141 ou32 num!: ((addr_of: (keyEvent keysym)) scancode)
142 mcall: scanCode! 2 empty ou32
143 ou32 <- make_object: (addr_of: obj_uint32_meta) NULL 0
144 ou32 num!: ((addr_of: (keyEvent keysym)) sym)
145 mcall: keyCode! 2 empty ou32
146 ou16 <- make_object: (addr_of: obj_uint16_meta) NULL 0
147 ou16 num!: ((addr_of: (keyEvent keysym)) mod)
148 mcall: mod! 2 empty ou16
149 empty
150 }
151
152 llMessage: populateMouseButtonEvent withVars: {
153 eventPtr <- cpointer ptr
154 empty <- object ptr
155 mouseButEvent <- SDL_MouseButtonEvent ptr
156 ou32 <- obj_uint32 ptr
157 ou8 <- obj_uint8 ptr
158 oi32 <- obj_int32 ptr
159 } andCode: :eventPtr empty {
160 mouseButEvent <- eventPtr val
161 ou32 <- make_object: (addr_of: obj_uint32_meta) NULL 0
162 ou32 num!: (mouseButEvent windowID)
163 mcall: windowID! 2 empty ou32
164 ou32 <- make_object: (addr_of: obj_uint32_meta) NULL 0
165 ou32 num!: (mouseButEvent which)
166 mcall: mouseID! 2 empty ou32
167 ou8 <- make_object: (addr_of: obj_uint8_meta) NULL 0
168 ou8 num!: (mouseButEvent button)
169 mcall: button! 2 empty ou8
170 if: (mouseButEvent state) = SDL_PRESSED {
171 mcall: pressed?! 2 empty true
172 } else: {
173 mcall: pressed?! 2 empty false
174 }
175 ou8 <- make_object: (addr_of: obj_uint8_meta) NULL 0
176 ou8 num!: (mouseButEvent clicks)
177 mcall: clicks! 2 empty ou8
178 oi32 <- make_object: (addr_of: obj_int32_meta) NULL 0
179 oi32 num!: (mouseButEvent x)
180 mcall: x! 2 empty oi32
181 oi32 <- make_object: (addr_of: obj_int32_meta) NULL 0
182 oi32 num!: (mouseButEvent y)
183 mcall: y! 2 empty oi32
184 }
185 }
186
187 _constant <- macro: :name cname {
188 quote: (llMessage: name withVars: {
189 uintret <- obj_uint32 ptr
190 } andCode: {
191 uintret <- make_object: (addr_of: obj_uint32_meta) NULL 0
192 uintret num!: cname
193 uintret
194 })
195 }
196 _subsystems <- #{
197 _constant: timer SDL_INIT_TIMER
198 _constant: audio SDL_INIT_AUDIO
199 _constant: video SDL_INIT_VIDEO
200 _constant: joystick SDL_INIT_JOYSTICK
201 _constant: haptic SDL_INIT_HAPTIC
202 _constant: gameController SDL_INIT_GAMECONTROLLER
203 _constant: events SDL_INIT_EVENTS
204 _constant: everything SDL_INIT_EVERYTHING
205 }
206
207 _windowOpts <- #{
208 _constant: fullscreen SDL_WINDOW_FULLSCREEN
209 _constant: fullscreenDesktop SDL_WINDOW_FULLSCREEN_DESKTOP
210 _constant: opengl SDL_WINDOW_OPENGL
211 _constant: hidden SDL_WINDOW_HIDDEN
212 _constant: borderless SDL_WINDOW_BORDERLESS
213 _constant: minimized SDL_WINDOW_MINIMIZED
214 _constant: maximized SDL_WINDOW_MAXIMIZED
215 _constant: inputGrabbed SDL_WINDOW_INPUT_GRABBED
216 _constant: allowHighDPI SDL_WINDOW_ALLOW_HIGHDPI
217 }
218
219 _renderOpts <- #{
220 _constant: software SDL_RENDERER_SOFTWARE
221 _constant: accelerated SDL_RENDERER_ACCELERATED
222 _constant: presentVSYNC SDL_RENDERER_PRESENTVSYNC
223 _constant: targetTexture SDL_RENDERER_TARGETTEXTURE
224
225 }
226
227 _events <- #{
228 _constant: quit SDL_QUIT
229 _constant: window SDL_WINDOWEVENT
230 _constant: sysWM SDL_SYSWMEVENT
231 _constant: keyDown SDL_KEYDOWN
232 _constant: keyUp SDL_KEYUP
233 _constant: textEditing SDL_TEXTEDITING
234 _constant: textInput SDL_TEXTINPUT
235 _constant: mouseMotion SDL_MOUSEMOTION
236 _constant: mouseDown SDL_MOUSEBUTTONDOWN
237 _constant: mouseUp SDL_MOUSEBUTTONUP
238 _constant: mouseWheel SDL_MOUSEWHEEL
239 _constant: joyAxis SDL_JOYAXISMOTION
240 _constant: joyBall SDL_JOYBALLMOTION
241 _constant: joyHat SDL_JOYHATMOTION
242 _constant: joyDown SDL_JOYBUTTONDOWN
243 _constant: joyUp SDL_JOYBUTTONUP
244 _constant: joyDeviceAdded SDL_JOYDEVICEADDED
245 _constant: joyDeviceRemoved SDL_JOYDEVICEREMOVED
246 _constant: controllerAxis SDL_CONTROLLERAXISMOTION
247 _constant: controllerDown SDL_CONTROLLERBUTTONDOWN
248 _constant: controllerUp SDL_CONTROLLERBUTTONUP
249 _constant: controllerDeviceAdded SDL_CONTROLLERDEVICEADDED
250 _constant: controllerDeviceRemoved SDL_CONTROLLERDEVICEREMOVED
251 _constant: controllerDeviceRemapped SDL_CONTROLLERDEVICEREMAPPED
252 _constant: dropFile SDL_DROPFILE
253 //TODO: Add mobile/touch/gesture events
254 }
255
256 _eventConstructors <- dict hash
257 _eventConstructors set: (_events window) :typ tstamp eventPtr {
258 _helper populateWindowEvent: eventPtr #{
259 type <- typ
260 timeStamp <- tstamp
261 windowID <- 0u32
262 event <- 0u8
263 data1 <- 0
264 data2 <- 0
265 }
266 }
267 keyEvent <- :typ tstamp eventPtr {
268 _helper populateKeyEvent: eventPtr #{
269 type <- typ
270 timeStamp <- tstamp
271 windowID <- 0u32
272 pressed? <- false
273 repeat <- 0u8
274 scanCode <- 0
275 keyCode <- 0
276 mod <- 0u16
277 _constant: scanCodeMask SDLK_SCANCODE_MASK
278 keyChar <- {
279 if: (keyCode and (self scanCodeMask)) = 0 {
280 keyCode utf8
281 } else: {
282 ""
283 }
284 }
285 }
286 }
287 _eventConstructors set: (_events keyDown) keyEvent
288 _eventConstructors set: (_events keyUp) keyEvent
289
290 mouseButtonEvent <- :typ tstamp eventPtr {
291 _helper populateMouseButtonEvent: eventPtr #{
292 type <- typ
293 timeStamp <- tstamp
294 windowID <- 0u32
295 mouseID <- 0u32
296 button <- 0u8
297 pressed? <- false
298 clicks <- 0u8
299 x <- 0
300 y <- 0
301 }
302 }
303 _eventConstructors set: (_events mouseDown) mouseButtonEvent
304 _eventConstructors set: (_events mouseUp) mouseButtonEvent
115 305
116 _makeTexture <- :rendptr texptr { 306 _makeTexture <- :rendptr texptr {
117 #{ 307 #{
118 includeSystemHeader: "SDL.h" 308 includeSystemHeader: "SDL.h"
119 llProperty: renderer withType: (SDL_Renderer ptr) 309 llProperty: renderer withType: (SDL_Renderer ptr)
416 str data!: (GC_MALLOC: (str bytes) + 1) 606 str data!: (GC_MALLOC: (str bytes) + 1)
417 memcpy: (str data) rawstr (str bytes) + 1 607 memcpy: (str data) rawstr (str bytes) + 1
418 str 608 str
419 } 609 }
420 610
611 pollEvent <- {
612 _helper pollEvent: :typ tstamp eventPtr {
613 _eventConstructors ifget: typ :handler {
614 handler: typ tstamp eventPtr
615 } else: {
616 //fallback event
617 #{
618 type <- typ
619 timeStamp <- tstamp
620 }
621 }
622 }
623 }
624
421 subsystems <- { _subsystems } 625 subsystems <- { _subsystems }
422 windowOpts <- { _windowOpts } 626 windowOpts <- { _windowOpts }
627 eventTypes <- { _events }
423 } 628 }
424 } 629 }