changeset 332:ead24192ed45

Initial work on a UI module
author Michael Pavone <pavone@retrodev.com>
date Sat, 28 Mar 2015 14:21:22 -0700
parents 61f5b794d939
children 577406b25f89
files modules/object.tp modules/sdl.tp modules/ui.tp samples/ui.tp
diffstat 4 files changed, 182 insertions(+), 6 deletions(-) [+]
line wrap: on
line diff
--- a/modules/object.tp	Sat Mar 28 14:21:04 2015 -0700
+++ b/modules/object.tp	Sat Mar 28 14:21:22 2015 -0700
@@ -68,6 +68,14 @@
 		} andCode: :methodId :obj {
 			mcall: (methodId num) 1 obj
 		}
+		
+		llMessage: setProperty:on:to withVars: {
+			obj <- object ptr
+			methodId <- obj_int32 ptr
+			val <- object ptr
+		} andCode: :methodId :obj :val {
+			mcall: (methodId num) 1 obj val
+		}
 	}
 	getMethodDict <- {
 		methodDict <- dict hash
@@ -114,9 +122,16 @@
 
 		sendMessage:to <- :message :obj {
 			d <- getMethodDict:
-			d ifget: message :messageId{
+			d ifget: message :messageId {
 				rt sendMessage: messageId to: obj
 			} else: { false }
 		}
+		
+		setProperty:on:to <- :message :obj :val {
+			d <- getMethodDict:
+			d ifget: (message. "!") :messageId {
+				rt setProperty: messageId on: obj to: val
+			} else: { false }
+		}
 	}
 }
--- a/modules/sdl.tp	Sat Mar 28 14:21:04 2015 -0700
+++ b/modules/sdl.tp	Sat Mar 28 14:21:22 2015 -0700
@@ -120,22 +120,42 @@
 				mcall: none 1 option
 			}
 		}
+		
+		llMessage: waitEvent withVars: {
+			constructor <- lambda ptr
+			event <- SDL_Event
+			eventPtr <- cpointer ptr
+			eventType <- obj_uint32 ptr
+			timeStampO <- obj_uint32 ptr
+		} andCode: :constructor {
+			if: (SDL_WaitEvent: (addr_of: event)) {
+				eventType <- make_object: (addr_of: obj_uint32_meta) NULL 0
+				timeStampO <- make_object: (addr_of: obj_uint32_meta) NULL 0
+				eventType num!: ((addr_of: event) type)
+				timeStampO num!: ((addr_of: ((addr_of: event) common)) timestamp)
+				eventPtr <- make_object: (addr_of: cpointer_meta) NULL 0
+				eventPtr val!: (addr_of: event)
+				mcall: value 2 option (ccall: constructor 3 (eventType castTo: (object ptr)) (
+					timeStampO castTo: (object ptr)) (eventPtr castTo: (object ptr)))
+			} else: {
+				mcall: none 1 option
+			}
+		}
 
 		llMessage: populateWindowEvent withVars: {
 			eventPtr <- cpointer ptr
 			empty <- object ptr
 			winEvent <- SDL_WindowEvent ptr
 			ou32 <- obj_uint32 ptr
-			ou8 <- obj_uint8 ptr
 			oi32 <- obj_int32 ptr
 		} andCode: :eventPtr empty {
 			winEvent <- eventPtr val
 			ou32 <- make_object: (addr_of: obj_uint32_meta) NULL 0
 			ou32 num!: (winEvent windowID)
 			mcall: windowID! 2 empty ou32
-			ou8 <- make_object: (addr_of: obj_uint8_meta) NULL 0
-			ou8 num!: (winEvent event)
-			mcall: event! 2 empty ou8
+			ou32 <- make_object: (addr_of: obj_uint32_meta) NULL 0
+			ou32 num!: (winEvent event)
+			mcall: event! 2 empty ou32
 			oi32 <- make_object: (addr_of: obj_int32_meta) NULL 0
 			oi32 num!: (winEvent data1)
 			mcall: data1! 2 empty oi32
@@ -314,6 +334,23 @@
 		//TODO: Add mobile/touch/gesture events
 	}
 	
+	_windowEvents <- #{
+		_constant: shown SDL_WINDOWEVENT_SHOWN
+		_constant: hidden SDL_WINDOWEVENT_HIDDEN
+		_constant: exposed SDL_WINDOWEVENT_EXPOSED
+		_constant: moved SDL_WINDOWEVENT_MOVED
+		_constant: resized SDL_WINDOWEVENT_RESIZED
+		_constant: sizeChanged SDL_WINDOWEVENT_SIZE_CHANGED
+		_constant: minimized SDL_WINDOWEVENT_MINIMIZED
+		_constant: maximized SDL_WINDOWEVENT_MAXIMIZED
+		_constant: restored SDL_WINDOWEVENT_RESTORED
+		_constant: enter SDL_WINDOWEVENT_ENTER
+		_constant: leave SDL_WINDOWEVENT_LEAVE
+		_constant: focusGained SDL_WINDOWEVENT_FOCUS_GAINED
+		_constant: focusLost SDL_WINDOWEVENT_FOCUS_LOST
+		_constant: close SDL_WINDOWEVENT_CLOSE
+	}
+	
 	_textureAccess <- #{
 		_constant: static SDL_TEXTUREACCESS_STATIC
 		_constant: streaming SDL_TEXTUREACCESS_STREAMING
@@ -370,7 +407,7 @@
 			type <- typ
 			timeStamp <- tstamp
 			windowID <- 0u32
-			event <- 0u8
+			event <- 0u32
 			data1 <- 0
 			data2 <- 0
 		}
@@ -811,10 +848,25 @@
 				}
 			}
 		}
+		
+		waitEvent <- {
+			_helper pollEvent: :typ tstamp eventPtr {
+				_eventConstructors ifget: typ :handler {
+					handler: typ tstamp eventPtr
+				} else: {
+					//fallback event
+					#{
+						type <- typ
+						timeStamp <- tstamp
+					}
+				}
+			}
+		}
 
 		subsystems <- { _subsystems }
 		windowOpts <- { _windowOpts }
 		eventTypes <- { _events }
+		windowEventTypes <- { _windowEvents }
 		textureAccess <- { _textureAccess }
 		pixelFormats <- { _pixelFormats }
 		blendModes <- { _blendModes }
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/modules/ui.tp	Sat Mar 28 14:21:22 2015 -0700
@@ -0,0 +1,98 @@
+{
+    _visibleWindows <- []
+    _needsInit <- true
+    _initRes <- 0
+    _checkInitSDL <- {
+        if: _needsInit {
+            _initRes <- (sdl init: ((sdl subsystems) video)) = 0
+            _needsInit <- true
+        }
+        _initRes
+    }
+	#{
+        import: [
+            r:g:b
+            r:g:b:a
+        ] from: sdl
+        _styles <- []
+		window <- :properties {
+            _wind <- option none
+            _renderer <- option none
+            base <- #{
+                title <- "Window"
+                width <- 640
+                height <- 480
+                x <- 0
+                y <- 0
+                color <- (ui r: 255u8 g: 255u8 b: 255u8)
+                children <- #[]
+                
+                show <- {
+                    if: (_checkInitSDL: ) {
+                        _wind <- sdl createWindow: title pos: x y size: width height flags: 0u32
+                        _wind value: :window {
+                            _renderer <- window createRenderer: -1 flags: ((window renderOpts) accelerated)
+                            draw:
+                        } none: {
+                            false
+                        }
+                    }
+                }
+				
+				draw <- {
+					print: "Draw!\n"
+					_renderer value: :renderer {
+						print: "Rendering!\n"
+						renderer drawColor!: color
+						renderer clear
+						
+						foreach: children :_ child {
+							child draw: renderer
+						}
+						renderer present
+						true
+					} none: { false }
+				}
+                
+                styles <- { _styles }
+                
+                styles! <- :newstyles{
+                    //TODO: apply styles
+                    _styles <- newstyles
+                }
+            }
+            foreach: (object propertiesOf: base) :_ name {
+                if: (object does: properties understand?: name) {
+                    object setProperty: name on: base to: (object sendMessage: name to: properties)
+                }
+            }
+            base
+		}
+        
+        enterEventLoop <- {
+            continue? <- true
+            
+            _handlers <- dict hash
+            _handlers set: ((sdl eventTypes) quit) :event {
+                continue? <- false
+            }
+            _handlers set: ((sdl eventTypes) window) :event {
+                if: (event event) = ((sdl windowEventTypes) exposed) {
+					foreach: _visibleWindows :_ wind {
+						print: "Redrawing window\n"
+						wind draw
+					}
+				}
+            }
+            while: { continue? } do: {
+                (sdl waitEvent) value: :event {
+					_handlers ifget: (event type) :handler {
+						handler: event
+					} else: {
+						print: "Unhandled event type: " . (event type) . "\n"
+					}
+				} none: {}
+            }
+        }
+	}
+}
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/samples/ui.tp	Sat Mar 28 14:21:22 2015 -0700
@@ -0,0 +1,11 @@
+#{
+	main <- {
+		wind <- ui window: #{
+			title <- "Quiche UI Test"
+			color <- ui r: 192u8 g: 192u8 b: 192u8
+		}
+		
+		wind show:
+		ui enterEventLoop
+	}
+}
\ No newline at end of file