changeset 318:4c669942c30d

Add bindings for SDL_CreateTexture, SDL_LockTexture, SDL_SetBlendMode and SDL_GetBlendMode in SDL module
author Michael Pavone <pavone@retrodev.com>
date Thu, 19 Mar 2015 22:40:43 -0700
parents 6dfbf5691a7f
children 8514a543bece
files modules/bytearray.tp modules/sdl.tp samples/sdl.tp
diffstat 3 files changed, 269 insertions(+), 32 deletions(-) [+]
line wrap: on
line diff
--- a/modules/bytearray.tp	Thu Mar 19 22:39:42 2015 -0700
+++ b/modules/bytearray.tp	Thu Mar 19 22:40:43 2015 -0700
@@ -1,16 +1,17 @@
 #{
 	includeSystemHeader: "unistd.h"
 	includeSystemHeader: "sys/mman.h"
-
-	normal <- :size {
+	
+	fromOpaque:withSize <- :opaque :size{
 		#{
 			llProperty: bytes withType: uint32_t
 			llProperty: buffer withType: (void ptr)
 			llMessage: _init_buf withVars: {
 				sz <- obj_int32 ptr
-			} andCode: :sz {
+				opaque <- cpointer ptr
+			} andCode: :opaque sz {
 				bytes <- sz num
-				buffer <- GC_MALLOC_ATOMIC: bytes
+				buffer <- (opaque val)
 				self
 			}
 
@@ -89,7 +90,21 @@
 					found: i
 				}
 			}
-		} _init_buf: size
+		} _init_buf: opaque size
+	}
+
+	normal <- :size {
+		helper <- #{
+			llMessage: alloc withVars: {
+				size <- obj_int32 ptr
+				opaqueret <- cpointer ptr
+			} andCode: :size {
+				opaqueret <- make_object: (addr_of: cpointer_meta) NULL 0
+				opaqueret val!: (GC_MALLOC_ATOMIC: (size num))
+				opaqueret
+			}
+		}
+		fromOpaque: (helper alloc: size) withSize: size
 	}
 
 	executable <- :size {
--- a/modules/sdl.tp	Thu Mar 19 22:39:42 2015 -0700
+++ b/modules/sdl.tp	Thu Mar 19 22:40:43 2015 -0700
@@ -71,6 +71,34 @@
 				mcall: none 1 option
 			}
 		}
+		
+		llMessage: createTexture withVars: {
+			rendOpaque <- cpointer ptr
+			format <- object ptr
+			formatn <- obj_uint32 ptr
+			access <- object ptr
+			accessn <- obj_int32 ptr
+			w <- object ptr
+			wn <- obj_int32 ptr
+			h <- object ptr
+			hn <- obj_int32 ptr
+			makeTexture <- lambda ptr
+			texOpaque <- cpointer ptr
+			tex <- object ptr
+		} andCode: :rendOpaque format access w h makeTexture {
+			formatn <- (mcall: uint32 1 format) castTo: (obj_uint32 ptr)
+			accessn <- (mcall: int32 1 access) castTo: (obj_int32 ptr)
+			wn <- (mcall: int32 1 w) castTo: (obj_int32 ptr)
+			hn <- (mcall: int32 1 h) castTo: (obj_int32 ptr)
+			texOpaque <- make_object: (addr_of: cpointer_meta) NULL 0
+			texOpaque val!: (SDL_CreateTexture: (rendOpaque val) (formatn num) (accessn num) (wn num) (hn num))
+			if: (texOpaque val) {
+				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
@@ -285,6 +313,56 @@
 		_constant: dropFile SDL_DROPFILE
 		//TODO: Add mobile/touch/gesture events
 	}
+	
+	_textureAccess <- #{
+		_constant: static SDL_TEXTUREACCESS_STATIC
+		_constant: streaming SDL_TEXTUREACCESS_STREAMING
+		_constant: target SDL_TEXTUREACCESS_TARGET
+	}
+	
+	_pixelFormats <- #{
+		_constant: unknown SDL_PIXELFORMAT_UNKNOWN
+		_constant: index1LSB SDL_PIXELFORMAT_INDEX1LSB
+		_constant: index1MSB SDL_PIXELFORMAT_INDEX1MSB
+		_constant: index4LSB SDL_PIXELFORMAT_INDEX4LSB
+		_constant: index4MSB SDL_PIXELFORMAT_INDEX4MSB
+		_constant: index8 SDL_PIXELFORMAT_INDEX8
+		_constant: rgb332 SDL_PIXELFORMAT_RGB332
+		_constant: rgb444 SDL_PIXELFORMAT_RGB444
+		_constant: rgb555 SDL_PIXELFORMAT_RGB555
+		_constant: bgr555 SDL_PIXELFORMAT_BGR555
+		_constant: argb4444 SDL_PIXELFORMAT_ARGB4444
+		_constant: bgra4444 SDL_PIXELFORMAT_BGRA4444
+		_constant: argb1555 SDL_PIXELFORMAT_ARGB1555
+		_constant: rgba5551 SDL_PIXELFORMAT_RGBA5551
+		_constant: abgr1555 SDL_PIXELFORMAT_ABGR1555
+		_constant: bgra5551 SDL_PIXELFORMAT_BGRA5551
+		_constant: rgb565 SDL_PIXELFORMAT_RGB565
+		_constant: bgr565 SDL_PIXELFORMAT_BGR565
+		_constant: rgb24 SDL_PIXELFORMAT_RGB24
+		_constant: bgr24 SDL_PIXELFORMAT_BGR24
+		_constant: rgb888 SDL_PIXELFORMAT_RGB888
+		_constant: rgbx8888 SDL_PIXELFORMAT_RGBX8888
+		_constant: bgr888 SDL_PIXELFORMAT_BGR888
+		_constant: bgrx8888 SDL_PIXELFORMAT_BGRX8888
+		_constant: argb8888 SDL_PIXELFORMAT_ARGB8888
+		_constant: rgba8888 SDL_PIXELFORMAT_RGBA8888
+		_constant: abgr8888 SDL_PIXELFORMAT_ABGR8888
+		_constant: bgra8888 SDL_PIXELFORMAT_BGRA8888
+		_constant: argb2101010 SDL_PIXELFORMAT_ARGB2101010
+		_constant: yv12 SDL_PIXELFORMAT_YV12
+		_constant: iyuv SDL_PIXELFORMAT_IYUV
+		_constant: yuy2 SDL_PIXELFORMAT_YUY2
+		_constant: uyvy SDL_PIXELFORMAT_UYVY
+		_constant: yvyu SDL_PIXELFORMAT_YVYU
+	}
+	
+	_blendModes <- #{
+		_constant: none SDL_BLENDMODE_NONE
+		_constant: blend SDL_BLENDMODE_BLEND
+		_constant: add SDL_BLENDMODE_ADD
+		_constant: mod SDL_BLENDMODE_MOD
+	}
 
 	_eventConstructors <- dict hash
 	_eventConstructors set: (_events window) :typ tstamp eventPtr {
@@ -431,6 +509,54 @@
 				intret
 			}
 
+			llMessage: lockRect:with withVars: {
+				fun <- lambda ptr
+				rectOpaque <- cpointer ptr
+				pitch <- obj_int32 ptr
+				bufsize <- obj_int32 ptr
+				height <- obj_int32 ptr
+				pixels <- cpointer ptr
+				bytearr <- object ptr
+				rect <- object ptr
+				result <- int32_t
+				ret <- object ptr
+			} andCode: :rect fun {
+				rectOpaque <- (mcall: _rectPointer 1 rect) castTo: (cpointer ptr)
+				pitch <- make_object: (addr_of: obj_int32_meta) NULL 0
+				pixels <- make_object: (addr_of: cpointer_meta) NULL 0
+				//TODO: Check return value
+				result <- SDL_LockTexture: texture (rectOpaque val) (addr_of: (pixels val)) (addr_of: (pitch num))
+				if: result = 0 {
+					height <- (mcall: h 1 rect) castTo: (obj_int32 ptr) 
+					bufsize <- make_object: (addr_of: obj_int32_meta) NULL 0
+					bufsize num!: (pitch num) * (height num)
+					bytearr <- mcall: fromOpaque:withSize 3 bytearray pixels bufsize
+					ret <- ccall: fun 2 bytearr pitch
+					SDL_UnlockTexture: texture
+					//TODO: Return value?
+				} else: {
+					ret <- false
+				}
+				ret
+			}
+			
+			llMessage: blendMode! withVars: {
+				omode <- object ptr
+				mode <- obj_uint32 ptr
+			} andCode: :omode {
+				mode <- (mcall: uint32 1 omode) castTo: (obj_uint32 ptr)
+				SDL_SetTextureBlendMode: texture (mode num)
+				self
+			}
+			
+			llMessage: blendMode withVars: {
+				mode <- obj_uint32 ptr
+			} andCode: {
+				mode <-make_object: (addr_of: obj_uint32_meta) NULL 0
+				SDL_GetTextureBlendMode: texture (addr_of: (mode num))
+				mode
+			}
+
 			llMessage: destroy withVars: {} andCode: {
 				SDL_DestroyTexture: texture
 				true
@@ -451,7 +577,7 @@
 			}
 			llMessage: _ptr_init withVars: {
 				ptr <- cpointer ptr
-			} andCode: :ptr{
+			} andCode: :ptr {
 				surface <- ptr val
 				self
 			}
@@ -570,6 +696,10 @@
 									intret num!: (SDL_SetRenderDrawColor: renderer (rc num) (gc num) (bc num) (ac num))
 									intret
 								}
+								
+								createTexture:access:width:height <- :format :access :w :h {
+									_helper createTexture: opaque format access w h _makeTexture
+								}
 
 								llMessage: clear withVars: {
 									intret <- obj_int32 ptr
@@ -685,5 +815,8 @@
 		subsystems <- { _subsystems }
 		windowOpts <- { _windowOpts }
 		eventTypes <- { _events }
+		textureAccess <- { _textureAccess }
+		pixelFormats <- { _pixelFormats }
+		blendModes <- { _blendModes }
 	}
 }
--- a/samples/sdl.tp	Thu Mar 19 22:39:42 2015 -0700
+++ b/samples/sdl.tp	Thu Mar 19 22:40:43 2015 -0700
@@ -11,6 +11,12 @@
 		mouseUp
 		mouseMotion
 	] from: (sdl eventTypes)
+	import: [
+		streaming
+	] from: (sdl textureAccess)
+	import: [
+		bgra8888
+	] from: (sdl pixelFormats)
 	main <- {
 		if: (sdl init: (video or timer)) = 0 {
 			(sdl createWindow: "SDL Test" pos: 0 0 size: 640 480 flags: 0u32) value: :window {
@@ -20,39 +26,122 @@
 					(sdl loadBMP: "944.bmp") value: :surf {
 						(surf asTexture: render) value: :tex {
 							surf free
-							angle <- 45.0f32
-							continue? <- true
-							while: { continue? } do: {
-								tex copy
-								tex copyTo: (sdl rect: 160 120 size: 320 224)
-								tex copyRect: (sdl rect: 80 60 size: 160 120) To: (sdl rect: 40 30 size: 320 224)
-								tex copyTo: (sdl rect: 320 240 size: 320 224) rotated: angle
-								render present
-								angle <- angle + 1.0f32
+							(render createTexture: bgra8888 access: streaming width: 32 height: 32) value: :drawTex {
+								angle <- 45.0f32
+								continue? <- true
+								drawTex blendMode!: ((sdl blendModes) blend)
+								drawTex lockRect: (sdl rect: 0 0 size: 32 32) with: :bytearr pitch {
+									row <- 0
+									start <- -1
+									while: { row < 32 } do: {
+										col <- 0
+										i <- row * pitch
+										while: { col < start } do: {
+											bytearr set: i 0u8
+											i <- i + 1
+											bytearr set: i 0u8
+											i <- i + 1
+											bytearr set: i 0u8
+											i <- i + 1
+											bytearr set: i 0u8
+											i <- i + 1
+											col <- col + 1
+										}
+										end <- start + 3
+										while: { col < end } do: {
+											bytearr set: i 255u8
+											i <- i + 1
+											bytearr set: i 255u8
+											i <- i + 1
+											bytearr set: i 255u8
+											i <- i + 1
+											bytearr set: i 255u8
+											i <- i + 1
+											col <- col + 1
+										}
+										start2 <- 32 - 3 - start
+										while: { col < start2 } do: {
+											bytearr set: i 0u8
+											i <- i + 1
+											bytearr set: i 0u8
+											i <- i + 1
+											bytearr set: i 0u8
+											i <- i + 1
+											bytearr set: i 0u8
+											i <- i + 1
+											col <- col + 1
+										}
+										end <- start2 + 3
+										if: end > 32 {
+											end <- 32
+										}
+										while: { col < end } do: {
+											bytearr set: i 255u8
+											i <- i + 1
+											bytearr set: i 255u8
+											i <- i + 1
+											bytearr set: i 255u8
+											i <- i + 1
+											bytearr set: i 255u8
+											i <- i + 1
+											col <- col + 1
+										}
+										while: { col < 32 } do: {
+											bytearr set: i 0u8
+											i <- i + 1
+											bytearr set: i 0u8
+											i <- i + 1
+											bytearr set: i 0u8
+											i <- i + 1
+											bytearr set: i 0u8
+											i <- i + 1
+											col <- col + 1
+										}
+										if: row < 16 {
+											start <- start + 1
+										} else: {
+											if: row > 16 {
+												start <- start - 1
+											}
+										}
+										row <- row + 1
+									}
+								}
+								while: { continue? } do: {
+									tex copy
+									tex copyTo: (sdl rect: 160 120 size: 320 224)
+									tex copyRect: (sdl rect: 80 60 size: 160 120) To: (sdl rect: 40 30 size: 320 224)
+									tex copyTo: (sdl rect: 320 240 size: 320 224) rotated: angle
+									drawTex copyTo: (sdl rect: 484 32 size: 32 32) rotated: angle / 60.0f32
+									render present
+									angle <- angle + 1.0f32
 
-								event <- option none
-								while: {
-									event <- sdl pollEvent
-									event value?
-								} do: {
-									event value: :ev {
-										if: (ev type) = quit {
-											continue? <- false
-										} else: {
-											if: (ev type) = keyDown || (ev type) = keyUp {
-												print: "Key event for: " . (ev keyChar) . ", pressed?: " . (ev pressed?) . "\n"
+									event <- option none
+									while: {
+										event <- sdl pollEvent
+										event value?
+									} do: {
+										event value: :ev {
+											if: (ev type) = quit {
+												continue? <- false
 											} else: {
-												if: (ev type) = mouseDown || (ev type) = mouseUp {
-													print: "Mouse button event at: " . (ev x) . ", " . (ev y) . " for button " . (ev button) . "\n"
+												if: (ev type) = keyDown || (ev type) = keyUp {
+													print: "Key event for: " . (ev keyChar) . ", pressed?: " . (ev pressed?) . "\n"
 												} else: {
-													if: (ev type) = mouseMotion {
-														print: "Mouse motion event: " . (ev xRel) . ", " . (ev yRel) . "\n"
+													if: (ev type) = mouseDown || (ev type) = mouseUp {
+														print: "Mouse button event at: " . (ev x) . ", " . (ev y) . " for button " . (ev button) . "\n"
+													} else: {
+														if: (ev type) = mouseMotion {
+															print: "Mouse motion event: " . (ev xRel) . ", " . (ev yRel) . "\n"
+														}
 													}
 												}
 											}
-										}
-									} none: {}
+										} none: {}
+									}
 								}
+							} none: {
+								print: "Failed to create texture\n"
 							}
 							tex destroy
 						} none: {