view modules/sdl.tp @ 275:d83647152485

Added option module which was omitted in commit of SDL work
author Michael Pavone <pavone@retrodev.com>
date Sun, 20 Jul 2014 12:34:25 -0700
parents a923b5b7da3d
children 2b58eafa360b
line wrap: on
line source

{
	_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
	}
	
	_helper <- #{
		llMessage: createWindow withVars: {
			title <- string ptr
			x <- obj_int32 ptr
			y <- obj_int32 ptr
			w <- obj_int32 ptr
			h <- obj_int32 ptr
			flags <- obj_uint32 ptr
			makeWindow <- lambda ptr
			windowOpaque <- cpointer ptr
			win <- object ptr
		} andCode: :title x y w h flags makeWindow {
			windowOpaque <- make_object: (addr_of: cpointer_meta) NULL 0
			windowOpaque val!: (SDL_CreateWindow: (title data) (x num) (y num) (w num) (h num) (flags num))
			if: (windowOpaque val) {
				win <- ccall: makeWindow 1 (windowOpaque castTo: (object ptr))
				mcall: value 2 option win
			} else: {
				mcall: none 1 option
			}
		}
	}
	
	#{
		includeSystemHeader: "SDL.h"
		includeSystemHeader: "stdlib.h"
		
		llMessage: init withVars: {
			flags <- obj_uint32 ptr
			intret <- obj_int32 ptr
		} andCode: :flags {
			intret <- make_object: (addr_of: obj_int32_meta) NULL 0
			intret num!: (SDL_Init: (flags num))
			if: (intret num) {
				atexit: SDL_Quit
			}
			intret
		}
		
		llMessage: initSubSystem withVars: {
			flags <- obj_uint32 ptr
			intret <- obj_int32 ptr
		} andCode: :flags {
			intret <- make_object: (addr_of: obj_int32_meta) NULL 0
			intret num!: (SDL_InitSubSystem: (flags num))
			intret
		}
		
		llMessage: quitSubSystem withVars: {
			flags <- obj_uint32 ptr
		} andCode: :flags {
			SDL_QuitSubSystem: (flags num)
			true
		}
		
		createWindow:pos:size:flags <- :title :x y :w h :flags{
			_helper createWindow: title x y w h flags :ptr {
				#{
					includeSystemHeader: "SDL.h"
					llProperty: window withType: (SDL_Window ptr)
					
					llMessage: _ptr_init withVars: {
						ptr <- cpointer ptr
					} andCode: :ptr {
						window <- ptr val
						self
					}
					
					llMessage: destroy withVars: {
					} andCode: {
						SDL_DestroyWindow: window
						true
					}
				} _ptr_init
			}
		}
		
		llMessage: delay withVars: {
			ms <- obj_uint32 ptr
		} andCode: :ms {
			SDL_Delay: (ms num)
			true
		}
		
		subsystems <- { _subsystems }
		windowOpts <- { _windowOpts }
	}
}