Mercurial > repos > tabletprog
view modules/sdl.tp @ 279:eb83863fd33e
Store renderer pointer in texture object since the texture can only be used with the renderer it was created with
author | Michael Pavone <pavone@retrodev.com> |
---|---|
date | Mon, 21 Jul 2014 19:11:15 -0700 |
parents | 1205c7a43cb4 |
children | 0ec4f1b68a38 |
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 } _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 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 } } llMessage: createRenderer withVars: { window <- cpointer ptr index <- obj_int32 ptr flags <- obj_uint32 ptr rendOpaque <- cpointer ptr rend <- object ptr makeRender <- lambda ptr } andCode: :window index flags makeRender { rendOpaque <- make_object: (addr_of: cpointer_meta) NULL 0 rendOpaque val!: (SDL_CreateRenderer: (window val) (index num) (flags num)) if: (rendOpaque val) { rend <- ccall: makeRender 1 (rendOpaque castTo: (object ptr)) mcall: value 2 option rend } else: { mcall: none 1 option } } llMessage: loadBMP withVars: { filename <- string ptr makeSurface <- lambda ptr surfOpaque <- cpointer ptr surf <- object ptr } andCode: :filename makeSurface{ surfOpaque <- make_object: (addr_of: cpointer_meta) NULL 0 surfOpaque val!: (SDL_LoadBMP: (filename data)) if: (surfOpaque val) { surf <- ccall: makeSurface 1 (surfOpaque castTo: (object ptr)) mcall: value 2 option surf } else: { mcall: none 1 option } } llMessage: createTextureFromSurface withVars: { rendOpaque <- cpointer ptr surfOpaque <- cpointer ptr makeTexture <- lambda ptr texOpaque <- cpointer ptr tex <- object ptr } andCode: :rendOpaque surfOpaque makeTexture { 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)) mcall: value 2 option tex } else: { mcall: none 1 option } } } _makeTexture <- :rendptr texptr { #{ includeSystemHeader: "SDL.h" llProperty: renderer withType: (SDL_Renderer ptr) llProperty: texture withType: (SDL_Texture ptr) llMessage: opaque withVars: { ptr <- cpointer ptr } andCode: { ptr <- make_object: (addr_of: cpointer_meta) NULL 0 ptr val!: texture ptr } llMessage: _ptr_init withVars: { rendptr <- cpointer ptr texptr <- cpointer ptr } andCode: :rendptr texptr{ renderer <- rendptr val texture <- texptr val self } llMessage: copy withVars: { intret <- obj_int32 ptr } andCode: { intret <- make_object: (addr_of: obj_int32_meta) NULL 0 intret num!: (SDL_RenderCopy: renderer texture NULL NULL) intret } llMessage: destroy withVars: {} andCode: { SDL_DestroyTexture: texture true } } _ptr_init: rendptr texptr } _makeSurface <- :ptr { #{ includeSystemHeader: "SDL.h" llProperty: surface withType: (SDL_Surface ptr) llMessage: opaque withVars: { ptr <- cpointer ptr } andCode: { ptr <- make_object: (addr_of: cpointer_meta) NULL 0 ptr val!: surface ptr } llMessage: _ptr_init withVars: { ptr <- cpointer ptr } andCode: :ptr{ surface <- ptr val self } asTexture <- :renderer { _helper createTextureFromSurface: (renderer opaque) opaque _makeTexture } llMessage: free withVars: {} andCode: { SDL_FreeSurface: surface true } } _ptr_init: ptr } #{ 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 } r:g:b:a <- :rc :gc :bc :ac { #{ r <- rc g <- gc b <- bc a <- ac } } r:g:b <- :r :g :b { r: r g: g b: b a: 255u8 } createWindow:pos:size:flags <- :title :x y :w h :flags{ _helper createWindow: title x y w h flags :ptr { print: (string: ptr) . "\n" #{ includeSystemHeader: "SDL.h" llProperty: window withType: (SDL_Window ptr) llMessage: opaque withVars: { op <- cpointer ptr } andCode: { op <- make_object: (addr_of: cpointer_meta) NULL 0 op val!: window op } llMessage: _ptr_init withVars: { ptr <- cpointer ptr } andCode: :ptr { window <- ptr val self } renderOpts <- { _renderOpts } createRenderer:flags <- :index :flags { _helper createRenderer: (self opaque) index flags :ptr { #{ includeSystemHeader: "SDL.h" llProperty: renderer withType: (SDL_Renderer ptr) llMessage: opaque withVars: { op <- cpointer ptr } andCode: { op <- make_object: (addr_of: cpointer_meta) NULL 0 op val!: renderer op } llMessage: _ptr_init withVars: { ptr <- cpointer ptr } andCode: :ptr { renderer <- ptr val self } llMessage: drawColor! withVars: { color <- object ptr rc <- obj_uint8 ptr gc <- obj_uint8 ptr bc <- obj_uint8 ptr ac <- obj_uint8 ptr intret <- obj_int32 ptr } andCode: :color { intret <- make_object: (addr_of: obj_int32_meta) NULL 0 rc <- (mcall: r 1 color) castTo: (obj_uint8 ptr) gc <- (mcall: g 1 color) castTo: (obj_uint8 ptr) bc <- (mcall: b 1 color) castTo: (obj_uint8 ptr) ac <- (mcall: a 1 color) castTo: (obj_uint8 ptr) intret num!: (SDL_SetRenderDrawColor: renderer (rc num) (gc num) (bc num) (ac num)) intret } llMessage: clear withVars: { intret <- obj_int32 ptr } andCode: { intret <- make_object: (addr_of: obj_int32_meta) NULL 0 intret num!: (SDL_RenderClear: renderer) intret } llMessage: present withVars: {} andCode: { SDL_RenderPresent: renderer true } llMessage: destroy withVars: {} andCode: { SDL_DestroyRenderer: renderer true } } _ptr_init: ptr } } llMessage: destroy withVars: { } andCode: { SDL_DestroyWindow: window true } } _ptr_init: ptr } } loadBMP <- :filename { _helper loadBMP: filename _makeSurface } llMessage: delay withVars: { ms <- obj_uint32 ptr } andCode: :ms { SDL_Delay: (ms num) true } llMessage: clearError withVars: {} andCode: { SDL_ClearError: true } llMessage: getError withVars: { str <- string ptr rawstr <- char ptr } andCode: { rawstr <- SDL_GetError: str <- make_object: (addr_of: string_meta) NULL 0 str bytes!: (strlen: rawstr) str len!: (str bytes) str data!: (GC_MALLOC: (str bytes) + 1) memcpy: (str data) rawstr (str bytes) + 1 str } subsystems <- { _subsystems } windowOpts <- { _windowOpts } } }