REBOL[
	Title: "TextureLab - Texture generator"
	Author: "ReBolek"
	Email: "rebolek>!a!t!!d!o!t!!a!t!!d!o!t! "png"] [filename: to-file append filename ".png"]
						save/png filename f-image/image
					]
				]
				engines: has [tmp engs][
					tmp: copy []
					engs: ctx-texture/engines
					forskip engs 2 [append tmp to string! engs/1]
					tmp
				]
				get-gui-settings: does [
					ctx-texture/prefs: make ctx-texture/prefs [
						size: to pair! ~fld-size/text
						color: ~btn-color/color
						color2: ~btn-color2/color
						colorize?: ~chk-colorize/data
						strength: to integer! ~fld-strength/text
						engine: to block! ~fld-engine/text
						pre: to block! ~fld-preeffect/text
						post: to block! ~fld-posteffect/text
						tile?: ~chk-tile/data
						seed: either 1 < length? parse to string! ~fld-seed/text ":" [to time! ~fld-seed/text][to integer! ~fld-seed/text]
					]
					;ctx-texture/prefs/colorize?: cls
				]
			]
;-------------------------------------------------------------------------------------	
			~editor: layout compose/deep [
				origin 2x2
				style text text white
				style btn btn 80x25
				style h1 h1 250.250.100
				backeffect [gradient 0x1 water coal]
				across
				space 0
				btn "New" [
					~fld-strength/text: "1"
					~sld-strength/data: 0
					~fld-preeffect/text: copy ""
					~fld-posteffect/text: copy ""
					~fld-engine/text: copy ""
					~btn-color/color: white
					~btn-color/text: 255.255.255
					~btn-color2/color: none
					~btn-color2/text: "none"
					show ~editor
					ctx-guifunc/show-preview
				]
				btn "Open" [
					result: copy []
					foreach [name block] ctx-texture/presets [append result to-string name]
					append result "----"
					foreach [name block] ctx-texture/user-presets [append result to-string name]
					value: request-list "Select preset" result				
					if any [none? value value = "----"] [exit]
					;ctx-texture/prefs/init
					ctx-texture/set-preset select append copy ctx-texture/presets ctx-texture/user-presets to-word value
					f-image/image: texture/no-init none
					~fld-strength/text: to-string ctx-texture/prefs/strength
					;~sld-strength
					~fld-seed/text: to-string ctx-texture/prefs/seed
					~chk-tile/data: ctx-texture/prefs/tile?
					~btn-color/color: ctx-texture/prefs/color
					~btn-color/text: to-string ctx-texture/prefs/color
					~btn-color2/color: ctx-texture/prefs/color2
					~btn-color2/text: to-string ctx-texture/prefs/color2
					~fld-preeffect/text: block-to-string ctx-texture/prefs/pre
					~fld-posteffect/text: block-to-string ctx-texture/prefs/post
					~fld-engine/text: block-to-string ctx-texture/prefs/engine
					;show reduce [~fld-strength ~fld-seed ~chk-tile ~btn-color ~btn-color2 ~fld-preeffect ~fld-posteffect ~fld-engine f-image]
					;get-gui-settings
					show ~editor
					current-preset: ctx-texture/prefs-to-dialect
				]
				btn red "Save" [inform layout [h1 "not yet.."]]
				btn red "Save As PNG" [ctx-guifunc/save-as-png]
				bar 3x24
				btn yellow "Dialect code" [view/new center-face layout compose [text (to paren! [ctx-guifunc/get-gui-settings mold/only prefs-to-dialect]) as-is font [size: 14 style: 'bold]]] ;ctx-guifunc/get-gui-settings ctx-guifunc/show-preview]
				box 117x10
				btn "Help" [ctx-guifunc/show-help]
				return
				bar 600
				return
				panel [
					tabs 50
					across
					h1 "Source ------>" return
					space 0x8
					text "Size:" tab 
						~fld-size: field 70 "100x100" [~fld-size/data: ~fld-size/text if error? try [to pair! ~fld-size/text][use 'tmp [tmp: pick [10 25 50 75 100 150 200 300 400] 1 + to integer! ~sld-size/data * 8 ~fld-size/text: rejoin [tmp "x" tmp]] show ~fld-size] ctx-guifunc/show-preview] 
						~sld-size: slider 80x24 with [data: 0.5] [ use 'tmp [tmp: pick [10 25 50 75 100 150 200 300 400] 1 + to integer! ~sld-size/data * 8 ~fld-size/text: rejoin [tmp "x" tmp]] show ~fld-size ctx-guifunc/show-preview]
						return
					text "Seed:" tab ~fld-seed: field 70 "0" [~fld-seed/data: ~fld-seed/text if error? try [to integer! ~fld-seed/text][~fld-seed/text: random 99999 show ~fld-seed] ctx-guifunc/show-preview] btn "random" [~fld-seed/text: random 99999 show ~fld-seed ctx-guifunc/show-preview] return
					text "Pre-Effect:" return
					~fld-preeffect: field 200x60 wrap [ctx-guifunc/show-preview]
				]
				panel [
					tabs 60
					across
					h1 "Engine ------>" return
					space 0x8 text "Strength:" tab 
						~fld-strength: field 40 "30" [~fld-strength/data: ~fld-strength/text if error? try [to integer! ~fld-strength/text][~fld-strength/text: 1 + to integer! ~sld-strength/data ** 2 * 99 ~fld-strength/data: ~fld-strength/text show ~fld-strength] ctx-guifunc/show-preview]
						~sld-strength: slider 100x24 with [data: 0.55] [~fld-strength/text: 1 + to integer! ~sld-strength/data ** 2 * 99 show ~fld-strength ctx-guifunc/show-preview] 
						return
					text "Engine:" tab (tmp: [drop-down 140] append tmp ctx-guifunc/engines tmp) [all [not none? value ~fld-engine/text: block-to-string select engines to word! value show ~fld-engine ctx-guifunc/show-preview]] return
					text "Main-Effect:" return
					~fld-engine: field 200x60 wrap "multiply 150.150.150 blur luma -20" [ctx-guifunc/show-preview]
				]
				panel [
					across
					space 0x8
					h1 "Post-production" return
						text "Colors:" 50
						~btn-color: box 75x24 (ctx-texture/prefs/color) (to string! ctx-texture/prefs/color) font-size 10 [~btn-color/color: request-color/color ~btn-color/color ~btn-color/text: to string! ~btn-color/color show ~btn-color ctx-guifunc/show-preview]
						~btn-color2: box 75x24 (either none? ctx-texture/prefs/color2 [0.0.0][ctx-texture/prefs/color2]) (to string! ctx-texture/prefs/color2) font-size 10 [~btn-color2/color: request-color/color ~btn-color2/color ~btn-color2/text: to string! ~btn-color2/color show ~btn-color2 ctx-guifunc/show-preview]
						return
						~chk-tile: check-line "tile" on font-color white 40x24 [ctx-guifunc/show-preview]
						~chk-colorize: check-line "colorize" font-color white 66x24 [ctx-guifunc/show-preview] 
						~chk-cache: check-line "disk cache" font-color white 92x24 [either value [cache-type: 'disk if not exists? cache-path [make-dir/deep cache-path]][cache-type: 'memory]] 
						;~fld-colorize: field 40 "0" [ctx-guifunc/show-preview]
						return
					text "Post-Effect:" return
					~fld-posteffect: field 200x60 wrap [ctx-guifunc/show-preview]
					
				]
				return
				bar 600
				return
				f-image: image 600x200 effect 'tile
				return
				~txt-copy: text "(c)2001-2006 REBolek"
			]
			ctx-guifunc/show-preview
			view/title/options center-face ~editor "TextureLab" 'resize
			quit
			;view/title center-face editor "TextureX Texture Studio" exit
		]	;if no parrameter supplied, runs GUI
		if none? dialect [dialect: prefs-to-dialect]
		unless no-init [prefs: make *prefs []]
		if word? dialect [dialect: select presets dialect if none? dialect [dialect: copy []]]
		img: cache-get dialect: compose dialect
		if image? img [return img]
		set-preset dialect
		img: make image! either prefs/tile? [prefs/size][prefs/size + 6x6]
		random/seed prefs/seed
		if not none? prefs/color2 [set-gradient]
		repeat i (length? img) [
			either none? prefs/color2 [
				poke img i random 255.255.255 ;prefs/color
			][
				poke img i pick gradient random 256
			]
		]
		if prefs/tile? [
			img: to image! make face [
				edge: none
				size: img/size * 3
				image: img
				effect: 'tile
			]
		]
		img: to image! make face [
			image: img
			size: img/size
			edge: none
			effect: copy prefs/pre
			repeat i prefs/strength [
				append effect prefs/engine
			]
			effect
		]
		img: to image! make face [
			edge: none
			size: either prefs/tile? [img/size / 3][img/size - 6x6]
			effect: either prefs/tile? [compose/deep [draw [image (- img/size / 3) img]]][[draw [image -3x-3 img]]]
		]
		img: to image! make face [
			image: img
			size: img/size
			edge: none
			effect: copy []
			append effect prefs/post
			if none? prefs/color2 [append effect compose [grayscale colorize (prefs/color)]]
		]
		if prefs/colorize? [
			img1: to image! layout compose/deep [origin 0 image img effect [grayscale colorize (prefs/color)]]
			img2: to image! layout compose/deep [origin 0 image img effect [grayscale invert colorize (prefs/color2)]]
			img: to image! layout [origin 0 image img1 effect [add img2]]
		]
		cache-add dialect img
		img
	]
	select-engine: func [	"Returns engine name or input if engine does not exist"
		block
		/local eng
	][
		either none? eng: find/only engines block [block][first back eng]
	]
	change-engine: func [block][prefs/engine: to-block block f-engine/text: block-to-string block show f-engine]
	set 'block-to-string func [block ][head trim remove back tail remove mold block ]

;----request texture function

	set 'request-texture func [/local rt result][
		rt: center-face layout compose [
			label "Select texture:"
		(
			result: copy [text-list 100x140]
			foreach [name block] presets [append result to-string name]
			append/only result [
				datas: select presets to-word value
				unview self
				result: texture datas
			]
			result
		)
		]
		result: none
		view rt
		result
	]
]

texturex: :texture

texturex