# HG changeset patch
# User Michael Pavone <pavone@retrodev.com>
# Date 1405972298 25200
# Node ID 1205c7a43cb42581019d0b10177ebee3f1f83207
# Parent  2b58eafa360bb34f6a2da5969bba3b9d6f15586f
Add bindings for SDL_ClearError, SDL_GetError, SDL_LoadBMP, SDL_CreateTextureFromSurface and a partial binding for SDL_RendererCopy

diff -r 2b58eafa360b -r 1205c7a43cb4 modules/sdl.tp
--- a/modules/sdl.tp	Sun Jul 20 17:30:46 2014 -0700
+++ b/modules/sdl.tp	Mon Jul 21 12:51:38 2014 -0700
@@ -78,6 +78,104 @@
 				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 (texOpaque castTo: (object ptr))
+				mcall: value 2 option tex
+			} else: {
+				mcall: none 1 option
+			}
+		}
+	}
+
+	_makeTexture <- :ptr {
+		#{
+			includeSystemHeader: "SDL.h"
+			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: {
+				ptr <- cpointer ptr
+			} andCode: :ptr{
+				texture <- ptr val
+				self
+			}
+
+			llMessage: copyTo withVars: {
+				renderer <- object ptr
+				rendOpaque <- cpointer ptr
+				intret <- obj_int32 ptr
+			} andCode: :renderer {
+				rendOpaque <- (mcall: opaque 1 renderer) castTo: (cpointer ptr)
+				intret <- make_object: (addr_of: obj_int32_meta) NULL 0
+				intret num!: (SDL_RenderCopy: (rendOpaque val) texture NULL NULL)
+				intret
+			}
+
+			llMessage: destroy withVars: {} andCode: {
+				SDL_DestroyTexture: texture
+				true
+			}
+		} _ptr_init: ptr
+	}
+
+	_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
 	}
 
 	#{
@@ -153,6 +251,13 @@
 							#{
 								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 {
@@ -207,6 +312,10 @@
 			}
 		}
 
+		loadBMP <- :filename {
+			_helper loadBMP: filename _makeSurface
+		}
+
 		llMessage: delay withVars: {
 			ms <- obj_uint32 ptr
 		} andCode: :ms {
@@ -214,6 +323,24 @@
 			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 }
 	}
diff -r 2b58eafa360b -r 1205c7a43cb4 samples/sdl.tp
--- a/samples/sdl.tp	Sun Jul 20 17:30:46 2014 -0700
+++ b/samples/sdl.tp	Mon Jul 21 12:51:38 2014 -0700
@@ -9,8 +9,21 @@
 				(window createRenderer: -1 flags: ((window renderOpts) accelerated)) value: :render {
 					render drawColor!: (sdl r: 0u8 g: 0u8 b: 255u8)
 					render clear
-					render present
-					sdl delay: 3000u32
+					(sdl loadBMP: "944.bmp") value: :surf {
+						(surf asTexture: render) value: :tex {
+							sdl clearError
+							if: (tex copyTo: render) != 0 {
+								print: "Failed to copy texture to renderer: " . (sdl getError) . "\n"
+							}
+							surf free
+							render present
+							sdl delay: 3000u32
+							tex destroy
+						} none: {
+							surf free
+						}
+					} none: {
+					}
 					render destroy
 				} none: {
 					print: "Failed to create renderer\n"