# HG changeset patch
# User Michael Pavone <pavone@retrodev.com>
# Date 1405902646 25200
# Node ID 2b58eafa360bb34f6a2da5969bba3b9d6f15586f
# Parent  9f9cc73bf86d2487141819ba3486718d63209f23
Add SDL bindings for creating a renderer, clearing it, presenting it and destroying it

diff -r 9f9cc73bf86d -r 2b58eafa360b modules/sdl.tp
--- a/modules/sdl.tp	Sun Jul 20 12:48:37 2014 -0700
+++ b/modules/sdl.tp	Sun Jul 20 17:30:46 2014 -0700
@@ -18,7 +18,7 @@
 		_constant: events SDL_INIT_EVENTS
 		_constant: everything SDL_INIT_EVERYTHING
 	}
-	
+
 	_windowOpts <- #{
 		_constant: fullscreen SDL_WINDOW_FULLSCREEN
 		_constant: fullscreenDesktop SDL_WINDOW_FULLSCREEN_DESKTOP
@@ -30,7 +30,15 @@
 		_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
@@ -52,12 +60,30 @@
 				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
+			}
+		}
 	}
-	
+
 	#{
 		includeSystemHeader: "SDL.h"
 		includeSystemHeader: "stdlib.h"
-		
+
 		llMessage: init withVars: {
 			flags <- obj_uint32 ptr
 			intret <- obj_int32 ptr
@@ -69,7 +95,7 @@
 			}
 			intret
 		}
-		
+
 		llMessage: initSubSystem withVars: {
 			flags <- obj_uint32 ptr
 			intret <- obj_int32 ptr
@@ -78,44 +104,117 @@
 			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: _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_init: ptr
 			}
 		}
-		
+
 		llMessage: delay withVars: {
 			ms <- obj_uint32 ptr
 		} andCode: :ms {
 			SDL_Delay: (ms num)
 			true
 		}
-		
+
 		subsystems <- { _subsystems }
 		windowOpts <- { _windowOpts }
 	}
-}
\ No newline at end of file
+}
diff -r 9f9cc73bf86d -r 2b58eafa360b samples/sdl.tp
--- a/samples/sdl.tp	Sun Jul 20 12:48:37 2014 -0700
+++ b/samples/sdl.tp	Sun Jul 20 17:30:46 2014 -0700
@@ -6,7 +6,15 @@
 	main <- {
 		if: (sdl init: (video or timer)) = 0 {
 			(sdl createWindow: "SDL Test" pos: 0 0 size: 640 480 flags: 0u32) value: :window {
-				sdl delay: 3000u32
+				(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
+					render destroy
+				} none: {
+					print: "Failed to create renderer\n"
+				}
 				window destroy
 			} none: {
 				print: "Failed to create window\n"
@@ -17,4 +25,4 @@
 			1
 		}
 	}
-}
\ No newline at end of file
+}