diff samples/sdl.tp @ 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 2b045d5b673b
children
line wrap: on
line diff
--- 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: {