changeset 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 38ca63e0a62e
children f73ebc146af9
files modules/sdl.tp samples/sdl.tp
diffstat 2 files changed, 283 insertions(+), 50 deletions(-) [+]
line wrap: on
line diff
--- a/modules/sdl.tp	Tue Jul 22 23:33:12 2014 -0700
+++ b/modules/sdl.tp	Tue Jul 22 23:35:08 2014 -0700
@@ -1,44 +1,4 @@
 {
-	_constant <- macro: :name cname {
-		quote: (llMessage: name withVars: {
-			uintret <- obj_uint32 ptr
-		} andCode: {
-			uintret <- make_object: (addr_of: obj_uint32_meta) NULL 0
-			uintret num!: cname
-			uintret
-		})
-	}
-	_subsystems <- #{
-		_constant: timer SDL_INIT_TIMER
-		_constant: audio SDL_INIT_AUDIO
-		_constant: video SDL_INIT_VIDEO
-		_constant: joystick SDL_INIT_JOYSTICK
-		_constant: haptic SDL_INIT_HAPTIC
-		_constant: gameController SDL_INIT_GAMECONTROLLER
-		_constant: events SDL_INIT_EVENTS
-		_constant: everything SDL_INIT_EVERYTHING
-	}
-
-	_windowOpts <- #{
-		_constant: fullscreen SDL_WINDOW_FULLSCREEN
-		_constant: fullscreenDesktop SDL_WINDOW_FULLSCREEN_DESKTOP
-		_constant: opengl SDL_WINDOW_OPENGL
-		_constant: hidden SDL_WINDOW_HIDDEN
-		_constant: borderless SDL_WINDOW_BORDERLESS
-		_constant: minimized SDL_WINDOW_MINIMIZED
-		_constant: maximized SDL_WINDOW_MAXIMIZED
-		_constant: inputGrabbed SDL_WINDOW_INPUT_GRABBED
-		_constant: allowHighDPI SDL_WINDOW_ALLOW_HIGHDPI
-	}
-
-	_renderOpts <- #{
-		_constant: software SDL_RENDERER_SOFTWARE
-		_constant: accelerated SDL_RENDERER_ACCELERATED
-		_constant: presentVSYNC SDL_RENDERER_PRESENTVSYNC
-		_constant: targetTexture SDL_RENDERER_TARGETTEXTURE
-
-	}
-
 	_helper <- #{
 		llMessage: createWindow withVars: {
 			title <- string ptr
@@ -105,14 +65,244 @@
 			texOpaque <- make_object: (addr_of: cpointer_meta) NULL 0
 			texOpaque val!: (SDL_CreateTextureFromSurface: (rendOpaque val) (surfOpaque val))
 			if: (texOpaque val) {
-				tex <- ccall: makeTexture 1 (rendOpaque castTo: (object ptr)) (texOpaque castTo: (object ptr))
+				tex <- ccall: makeTexture 2 (rendOpaque castTo: (object ptr)) (texOpaque castTo: (object ptr))
 				mcall: value 2 option tex
 			} else: {
 				mcall: none 1 option
 			}
 		}
+
+		llMessage: pollEvent withVars: {
+			constructor <- lambda ptr
+			event <- SDL_Event
+			eventPtr <- cpointer ptr
+			eventType <- obj_uint32 ptr
+			timeStampO <- obj_uint32 ptr
+		} andCode: :constructor {
+			if: (SDL_PollEvent: (addr_of: event)) {
+				eventType <- make_object: (addr_of: obj_uint32_meta) NULL 0
+				timeStampO <- make_object: (addr_of: obj_uint32_meta) NULL 0
+				eventType num!: ((addr_of: event) type)
+				timeStampO num!: ((addr_of: ((addr_of: event) common)) timestamp)
+				eventPtr <- make_object: (addr_of: cpointer_meta) NULL 0
+				eventPtr val!: (addr_of: event)
+				mcall: value 2 option (ccall: constructor 3 (eventType castTo: (object ptr)) (
+					timeStampO castTo: (object ptr)) (eventPtr castTo: (object ptr)))
+			} else: {
+				mcall: none 1 option
+			}
+		}
+
+		llMessage: populateWindowEvent withVars: {
+			eventPtr <- cpointer ptr
+			empty <- object ptr
+			winEvent <- SDL_WindowEvent ptr
+			ou32 <- obj_uint32 ptr
+			ou8 <- obj_uint8 ptr
+			oi32 <- obj_int32 ptr
+		} andCode: :eventPtr empty {
+			winEvent <- eventPtr val
+			ou32 <- make_object: (addr_of: obj_uint32_meta) NULL 0
+			ou32 num!: (winEvent windowID)
+			mcall: windowID! 2 empty ou32
+			ou8 <- make_object: (addr_of: obj_uint8_meta) NULL 0
+			ou8 num!: (winEvent event)
+			mcall: event! 2 empty ou8
+			oi32 <- make_object: (addr_of: obj_int32_meta) NULL 0
+			oi32 num!: (winEvent data1)
+			mcall: data1! 2 empty oi32
+			oi32 <- make_object: (addr_of: obj_int32_meta) NULL 0
+			oi32 num!: (winEvent data2)
+			mcall: data2! 2 empty oi32
+			empty
+		}
+
+		llMessage: populateKeyEvent withVars: {
+			eventPtr <- cpointer ptr
+			empty <- object ptr
+			keyEvent <- SDL_KeyboardEvent ptr
+			ou32 <- obj_uint32 ptr
+			ou16 <- obj_uint32 ptr
+			ou8 <- obj_uint8 ptr
+		} andCode: :eventPtr empty {
+			keyEvent <- eventPtr val
+			ou32 <- make_object: (addr_of: obj_uint32_meta) NULL 0
+			ou32 num!: (keyEvent windowID)
+			mcall: windowID! 2 empty ou32
+			if: (keyEvent state) = SDL_PRESSED {
+				mcall: pressed?! 2 empty true
+			} else: {
+				mcall: pressed?! 2 empty false
+			}
+			ou8 <- make_object: (addr_of: obj_uint8_meta) NULL 0
+			ou8 num!: (keyEvent repeat)
+			mcall: repeat! 2 empty ou8
+			ou32 <- make_object: (addr_of: obj_uint32_meta) NULL 0
+			ou32 num!: ((addr_of: (keyEvent keysym)) scancode)
+			mcall: scanCode! 2 empty ou32
+			ou32 <- make_object: (addr_of: obj_uint32_meta) NULL 0
+			ou32 num!: ((addr_of: (keyEvent keysym)) sym)
+			mcall: keyCode! 2 empty ou32
+			ou16 <- make_object: (addr_of: obj_uint16_meta) NULL 0
+			ou16 num!: ((addr_of: (keyEvent keysym)) mod)
+			mcall: mod! 2 empty ou16
+			empty
+		}
+
+		llMessage: populateMouseButtonEvent withVars: {
+			eventPtr <- cpointer ptr
+			empty <- object ptr
+			mouseButEvent <- SDL_MouseButtonEvent ptr
+			ou32 <- obj_uint32 ptr
+			ou8 <- obj_uint8 ptr
+			oi32 <- obj_int32 ptr
+		} andCode: :eventPtr empty {
+			mouseButEvent <- eventPtr val
+			ou32 <- make_object: (addr_of: obj_uint32_meta) NULL 0
+			ou32 num!: (mouseButEvent windowID)
+			mcall: windowID! 2 empty ou32
+			ou32 <- make_object: (addr_of: obj_uint32_meta) NULL 0
+			ou32 num!: (mouseButEvent which)
+			mcall: mouseID! 2 empty ou32
+			ou8 <- make_object: (addr_of: obj_uint8_meta) NULL 0
+			ou8 num!: (mouseButEvent button)
+			mcall: button! 2 empty ou8
+			if: (mouseButEvent state) = SDL_PRESSED {
+				mcall: pressed?! 2 empty true
+			} else: {
+				mcall: pressed?! 2 empty false
+			}
+			ou8 <- make_object: (addr_of: obj_uint8_meta) NULL 0
+			ou8 num!: (mouseButEvent clicks)
+			mcall: clicks! 2 empty ou8
+			oi32 <- make_object: (addr_of: obj_int32_meta) NULL 0
+			oi32 num!: (mouseButEvent x)
+			mcall: x! 2 empty oi32
+			oi32 <- make_object: (addr_of: obj_int32_meta) NULL 0
+			oi32 num!: (mouseButEvent y)
+			mcall: y! 2 empty oi32
+		}
 	}
 
+	_constant <- macro: :name cname {
+		quote: (llMessage: name withVars: {
+			uintret <- obj_uint32 ptr
+		} andCode: {
+			uintret <- make_object: (addr_of: obj_uint32_meta) NULL 0
+			uintret num!: cname
+			uintret
+		})
+	}
+	_subsystems <- #{
+		_constant: timer SDL_INIT_TIMER
+		_constant: audio SDL_INIT_AUDIO
+		_constant: video SDL_INIT_VIDEO
+		_constant: joystick SDL_INIT_JOYSTICK
+		_constant: haptic SDL_INIT_HAPTIC
+		_constant: gameController SDL_INIT_GAMECONTROLLER
+		_constant: events SDL_INIT_EVENTS
+		_constant: everything SDL_INIT_EVERYTHING
+	}
+
+	_windowOpts <- #{
+		_constant: fullscreen SDL_WINDOW_FULLSCREEN
+		_constant: fullscreenDesktop SDL_WINDOW_FULLSCREEN_DESKTOP
+		_constant: opengl SDL_WINDOW_OPENGL
+		_constant: hidden SDL_WINDOW_HIDDEN
+		_constant: borderless SDL_WINDOW_BORDERLESS
+		_constant: minimized SDL_WINDOW_MINIMIZED
+		_constant: maximized SDL_WINDOW_MAXIMIZED
+		_constant: inputGrabbed SDL_WINDOW_INPUT_GRABBED
+		_constant: allowHighDPI SDL_WINDOW_ALLOW_HIGHDPI
+	}
+
+	_renderOpts <- #{
+		_constant: software SDL_RENDERER_SOFTWARE
+		_constant: accelerated SDL_RENDERER_ACCELERATED
+		_constant: presentVSYNC SDL_RENDERER_PRESENTVSYNC
+		_constant: targetTexture SDL_RENDERER_TARGETTEXTURE
+
+	}
+
+	_events <- #{
+		_constant: quit SDL_QUIT
+		_constant: window SDL_WINDOWEVENT
+		_constant: sysWM SDL_SYSWMEVENT
+		_constant: keyDown SDL_KEYDOWN
+		_constant: keyUp SDL_KEYUP
+		_constant: textEditing SDL_TEXTEDITING
+		_constant: textInput SDL_TEXTINPUT
+		_constant: mouseMotion SDL_MOUSEMOTION
+		_constant: mouseDown SDL_MOUSEBUTTONDOWN
+		_constant: mouseUp SDL_MOUSEBUTTONUP
+		_constant: mouseWheel SDL_MOUSEWHEEL
+		_constant: joyAxis SDL_JOYAXISMOTION
+		_constant: joyBall SDL_JOYBALLMOTION
+		_constant: joyHat SDL_JOYHATMOTION
+		_constant: joyDown SDL_JOYBUTTONDOWN
+		_constant: joyUp SDL_JOYBUTTONUP
+		_constant: joyDeviceAdded SDL_JOYDEVICEADDED
+		_constant: joyDeviceRemoved SDL_JOYDEVICEREMOVED
+		_constant: controllerAxis SDL_CONTROLLERAXISMOTION
+		_constant: controllerDown SDL_CONTROLLERBUTTONDOWN
+		_constant: controllerUp SDL_CONTROLLERBUTTONUP
+		_constant: controllerDeviceAdded SDL_CONTROLLERDEVICEADDED
+		_constant: controllerDeviceRemoved SDL_CONTROLLERDEVICEREMOVED
+		_constant: controllerDeviceRemapped SDL_CONTROLLERDEVICEREMAPPED
+		_constant: dropFile SDL_DROPFILE
+		//TODO: Add mobile/touch/gesture events
+	}
+
+	_eventConstructors <- dict hash
+	_eventConstructors set: (_events window) :typ tstamp eventPtr {
+		_helper populateWindowEvent: eventPtr #{
+			type <- typ
+			timeStamp <- tstamp
+			windowID <- 0u32
+			event <- 0u8
+			data1 <- 0
+			data2 <- 0
+		}
+	}
+	keyEvent <- :typ tstamp eventPtr {
+		_helper populateKeyEvent: eventPtr #{
+			type <- typ
+			timeStamp <- tstamp
+			windowID <- 0u32
+			pressed? <- false
+			repeat <- 0u8
+			scanCode <- 0
+			keyCode <- 0
+			mod <- 0u16
+			_constant: scanCodeMask SDLK_SCANCODE_MASK
+			keyChar <- {
+				if: (keyCode and (self scanCodeMask)) = 0 {
+					keyCode utf8
+				} else: {
+					""
+				}
+			}
+		}
+	}
+	_eventConstructors set: (_events keyDown) keyEvent
+	_eventConstructors set: (_events keyUp) keyEvent
+
+	mouseButtonEvent <- :typ tstamp eventPtr {
+		_helper populateMouseButtonEvent: eventPtr #{
+			type <- typ
+			timeStamp <- tstamp
+			windowID <- 0u32
+			mouseID <- 0u32
+			button <- 0u8
+			pressed? <- false
+			clicks <- 0u8
+			x <- 0
+			y <- 0
+		}
+	}
+	_eventConstructors set: (_events mouseDown) mouseButtonEvent
+	_eventConstructors set: (_events mouseUp) mouseButtonEvent
+
 	_makeTexture <- :rendptr texptr {
 		#{
 			includeSystemHeader: "SDL.h"
@@ -418,7 +608,22 @@
 			str
 		}
 
+		pollEvent <- {
+			_helper pollEvent: :typ tstamp eventPtr {
+				_eventConstructors ifget: typ :handler {
+					handler: typ tstamp eventPtr
+				} else: {
+					//fallback event
+					#{
+						type <- typ
+						timeStamp <- tstamp
+					}
+				}
+			}
+		}
+
 		subsystems <- { _subsystems }
 		windowOpts <- { _windowOpts }
+		eventTypes <- { _events }
 	}
 }
--- a/samples/sdl.tp	Tue Jul 22 23:33:12 2014 -0700
+++ b/samples/sdl.tp	Tue Jul 22 23:35:08 2014 -0700
@@ -3,6 +3,13 @@
 		video
 		timer
 	] from: (sdl subsystems)
+	import: [
+		quit
+		keyDown
+		keyUp
+		mouseDown
+		mouseUp
+	] from: (sdl eventTypes)
 	main <- {
 		if: (sdl init: (video or timer)) = 0 {
 			(sdl createWindow: "SDL Test" pos: 0 0 size: 640 480 flags: 0u32) value: :window {
@@ -11,16 +18,37 @@
 					render clear
 					(sdl loadBMP: "944.bmp") value: :surf {
 						(surf asTexture: render) value: :tex {
-							sdl clearError
-							if: (tex copy) != 0 {
-								print: "Failed to copy texture to renderer: " . (sdl getError) . "\n"
+							surf free
+							angle <- 45.0f32
+							continue? <- true
+							while: { continue? } do: {
+								tex copy
+								tex copyTo: (sdl rect: 160 120 size: 320 224)
+								tex copyRect: (sdl rect: 80 60 size: 160 120) To: (sdl rect: 40 30 size: 320 224)
+								tex copyTo: (sdl rect: 320 240 size: 320 224) rotated: angle
+								render present
+								angle <- angle + 1.0f32
+
+								event <- option none
+								while: {
+									event <- sdl pollEvent
+									event value?
+								} do: {
+									event value: :ev {
+										if: (ev type) = quit {
+											continue? <- false
+										} else: {
+											if: (ev type) = keyDown || (ev type) = keyUp {
+												print: "Key event for: " . (ev keyChar) . ", pressed?: " . (ev pressed?) . "\n"
+											} else: {
+												if: (ev type) = mouseDown || (ev type) = mouseUp {
+													print: "Mouse event at: " . (ev x) . ", " . (ev y) . " for button " . (ev button) . "\n"
+												}
+											}
+										}
+									} none: {}
+								}
 							}
-							surf free
-							tex copyTo: (sdl rect: 160 120 size: 320 224)
-							tex copyRect: (sdl rect: 80 60 size: 160 120) To: (sdl rect: 40 30 size: 320 224)
-							tex copyTo: (sdl rect: 320 240 size: 320 224) rotated: 45.0
-							render present
-							sdl delay: 3000u32
 							tex destroy
 						} none: {
 							surf free