- adds debugging to RESIZE-DRAW-BODY

- changed skin loading and parsing to allow adding new elements to an already loaded skin - changed build process to work with changed skin loading - more RT source headers fixed
henrikmk · Feb 27, 2012 · 9ad740e · 9ad740e
1 parent c6de09a
commit 9ad740e
Show file tree

Hide file tree

Showing 3 changed files with 113 additions and 74 deletions.
diff --git a/build/build.r b/build/build.r
@@ -1,8 +1,8 @@
 REBOL [
-	Title: "VID Build"
-	Short: "VID Build"
+	Title: "Build"
+	Short: "Build"
 	Author: ["Henrik Mikael Kristensen"]
-	Copyright: "2009, 2010 - HMK Design"
+	Copyright: "2009 - 2012 - HMK Design"
 	Filename: %vid-build.r
 	Version: 0.0.2
 	Type: 'script
@@ -25,7 +25,7 @@ print "Building VID Extension Kit"
 
 system/options/binary-base: 64 ; smaller binaries
 
-build-version: 0.0.6
+build-version: 0.0.7
 
 code: make block! []
 
@@ -86,16 +86,17 @@ foreach file [
 	]
 ]
 
+skin-dir: %../resources/skins/standard/
+
 ;-- Skin Stock
-foreach file read %../resources/skins/standard/ [
-	unless #"." = first file [
-		add-binary join %../resources/skins/standard/ file
+append code compose/deep/only [
+	store-skin 'standard make ctx-skin/skin-object [
+		colors:		(load skin-dir/colors.r)
+		images:		(load skin-dir/images.r)
+		materials:	(load skin-dir/materials.r)
+		surfaces:	(load skin-dir/surfaces.r)
 	]
-]
-
-append code [
-	read-skin 'standard
-	load-skin 'standard
+	apply-skin get-skin 'standard
 ]
 
 ;-- Styles
@@ -147,7 +148,7 @@ save/header %../release/vid-ext-kit.r code compose [
 	Version: (build-version)
 	Date: (now)
 	Author: ["Henrik Mikael Kristensen"]
-	Copyright: "2009, 2010 - HMK Design"
+	Copyright: "2009 - 2012 - HMK Design"
 	License: {
 		BSD (www.opensource.org/licenses/bsd-license.php)
 		Use at your own risk.

diff --git a/source/ctx/ctx-draw.r b/source/ctx/ctx-draw.r
@@ -1,24 +1,24 @@
 REBOL [
-	Title:  "REBOL/View: Face DRAW Core"
-	Author: "Henrik Mikael Kristensen"
-	Rights: "Copyright 2000 REBOL Technologies. All rights reserved."
-	Note:   {Improvements to this code are welcome, but all changes preserve the above copyright.}
+	Title: "Face DRAW Core"
+	Short: "Face DRAW Core"
+	Author: ["Henrik Mikael Kristensen"]
+	Copyright: "2009, 2010 - HMK Design"
+	Filename: %ctx-draw.r
+	Version: 0.0.1
+	Type: 'script
+	Maturity: 'unstable
+	Release: 'internal
+	Created: 16-Jul-2009
+	Date: 16-Jul-2009
+	License: {
+		BSD (www.opensource.org/licenses/bsd-license.php)
+		Use at your own risk.
+	}
 	Purpose: {
-		DRAW context for faces
+		DRAW context for faces.
 	}
-	; You are free to use, modify, and distribute this software with any
-	; REBOL Technologies products as long as the above header, copyright,
-	; and this comment remain intact. This software is provided "as is"
-	; and without warranties of any kind. In no event shall the owners or
-	; contributors be liable for any damages of any kind, even if advised
-	; of the possibility of such damage. See license for more information.
-
-	; Please help us to improve this software by contributing changes and
-	; fixes via http://www.rebol.com/feedback.html - Thanks!
-
-	; Changes in this file are contributed by Henrik Mikael Kristensen.
-	; Changes and fixes to this file can be contributed to Github at:
-	; https://github.com/henrikmk/VID-Extension-Kit
+	History: []
+	Keywords: []
 ]
 
 ; experimental DRAW context. this commandeers DRAW and therefore DRAW approach must be changed.
@@ -96,12 +96,12 @@ draw-body: context [
 ; creates a draw-body object
 set 'make-draw-body does [
 	make draw-body [
-		image-inner: copy
-		image-outer: copy
-		inner: copy
-		outer: array/initial 8 0x0
-		points: copy
-		vertices: make block! 100
+		image-inner:	copy
+		image-outer:	copy
+		inner:			copy
+		outer:			array/initial 8 0x0
+		points:			copy
+		vertices:		make block! 100
 	]
 ]
 
@@ -230,7 +230,7 @@ set 'set-draw-body func [face /init /local debug state state-block see touch val
 ]
 
 ; resizes all vertices in the DRAW body
-set 'resize-draw-body func [face /local fd fdo fdi fdd fdds] [
+set 'resize-draw-body func [face /local debug fd fdo fdi fdd fdds] [
 	unless all [
 		fd: face/draw-body
 		any [fd/template fd/draw]
@@ -286,6 +286,8 @@ set 'resize-draw-body func [face /local fd fdo fdi fdd fdds] [
 		fdi/8 - (fdds * 0x1 / 2) + 0x1			; left center
 	]
 	fd/image-center: either image? fdd [face/size - fdd/size / 2][fd/center]
+	debug: find ctx-vid-debug/debug 'draw-body
+	if debug [print "Resize"]
 	insert clear fd/points reduce fd/vertices
 ]
 

diff --git a/source/ctx/ctx-skin.r b/source/ctx/ctx-skin.r
@@ -1,15 +1,15 @@
 REBOL [
-	Title: "VID Extension Kit SKIN Core"
-	Short: "VID Extension Kit SKIN Core"
+	Title: "SKIN Core"
+	Short: "SKIN Core"
 	Author: ["Henrik Mikael Kristensen"]
-	Copyright: "2011 - HMK Design"
+	Copyright: "2011, 2012 - HMK Design"
 	Filename: %ctx-skin.r
-	Version: 0.0.1
+	Version: 0.0.2
 	Type: 'script
 	Maturity: 'unstable
 	Release: 'internal
 	Created: 09-May-2010
-	Date: 09-May-2010
+	Date: 19-feb-2012
 	License: {
 		BSD (www.opensource.org/licenses/bsd-license.php)
 		Use at your own risk.
@@ -35,41 +35,69 @@ skin-object: make object! [
 		none
 ]
 
-; parse the skin and build images, colors and surfaces in that order
-set 'make-skin func [skin [object!]] [
+; words of the skin object
+types: words-of skin-object
+
+set 'get-skin func [
+	"Returns a skin object from the skin stock. Returns error! if it does not exist."
+	skin [word!] "Skin name as word"
+] [
+	any [
+		select skins skin
+		throw make error! rejoin ["Skin '" skin "' does not exist."]
+	]
+]
+
+set 'append-skin func [
+	"Append a skin object onto another skin object."
+	obj1 [object!] "The skin object to append to."
+	obj2 [object!] "The skin object that is appended."
+] [
+	foreach type types [
+		if all [obj1/:type in obj2 type] [append obj1/:type obj2/:type]
+	]
+]
+
+set 'apply-skin func [
+	"Applies a skin object to the user interface."
+	obj [object!]
+] [
 	;---------- Colors
-	ctx-colors/colors: make object! skin/colors
+	ctx-colors/colors: make object! obj/colors
 	;---------- Images
 	; images are appliable as draw images, which means they must be ready before surfaces
 	;---------- Materials
 	; materials are appliable for draw blocks, which means they must be ready before surfaces
 	;---------- Surfaces
-	append clear ctx-surface/surfaces skin/surfaces
-]
-
-; clears the old skin and loads a new one from the skin stock
-set 'load-skin func [name] [
-	make-skin select skins name
+	append clear ctx-surface/surfaces obj/surfaces
 ]
 
-; reads a skin from disk or memory and appends it to the skin stock. Input is the skin directory.
-set 'read-skin func [file [word! file!] /local item skin p paren-rule word] [
-	skin: make skin-object []
-	; Retrieve colors, images, materials and surfaces from files
-	foreach type [colors images materials surfaces] [
-		case [
-			; Attempt to retrieve from memory
-			word? file [
-				word: to-word join type '.r
-				set in skin type load as-string get word
-				unset word
-			]
-			; Then attempt to load from disk
-			if exists? item: to-file rejoin [dirize file join type '.r] [
-				set in skin type load item
+set 'read-skin func [
+	[catch]
+	"Reads skin files from directory into a skin object."
+	skin [file!] "Directory or word to read from."
+	/local item new-obj
+] [
+	new-obj: make skin-object []
+	; Retrieve colors, images, materials and surfaces from files or skin object
+	either exists? skin [
+		foreach type types [
+			if exists? item: to-file rejoin [dirize form skin join type '.r] [
+				set in new-obj type load item
 			]
 		]
-		; Process parenthesis blocks, except for template and draw
+	][
+		throw make error! rejoin ["Skin '" skin "' not found"]
+	]
+	new-obj
+]
+
+set 'parse-skin func [
+	"Parses a skin object."
+	obj [object!]
+] [
+	; Process parenthesis blocks, except for template and draw from the current processing position
+	foreach type types [
 		switch type [
 			surfaces [
 				; [!] - this executes code in the skin, which is not secure
@@ -82,17 +110,25 @@ set 'read-skin func [file [word! file!] /local item skin p paren-rule word] [
 						| skip
 					]
 				]
-				parse skin/surfaces paren-rule
+				parse obj/surfaces paren-rule
 			]
+			; other types come later
 		]
 	]
-	; Append loaded skin to skin stock
-	append skins either word? file [
-		file
+	obj
+]
+
+set 'store-skin func [
+	"Stores a skin object in the skin stock with the given word."
+	skin [word!] "Name of skin"
+	obj [object!] "Skin object"
+] [
+	either find skins skin [
+		change next find skin skin obj
 	][
-		to-word trim/with form last split-path file "/"
+		append append skins skin obj
 	]
-	append skins skin
+	obj
 ]
 
 ]