diff 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
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 }
 	}
 }