rebol [
	title: "Dialect enhancements functions"
	author: "oldes"
	email: oliva.david@seznam.cz
	version: 0.1.0
	date: 05-11-02
]
extended-image: func[val val2 dirs /local i size s sz100][
	wrd: pop-set-word
	if none? find names-ids-table 'spr_shared_mask1x1 [
		parse/all [
			shp_shared_mask1x1: shape [bounds 0x0 1x1 fill color 0.0.0 box 0x0 1x1]
			spr_shared_mask1x1: sprite shp_shared_mask1x1
		] tag-rules
	]
	i: load-image val
	size: i/size
	either all [
		any [not none? find dirs 'vertical not none? find dirs 'v]
		none? find dirs 'horizontal	none? find dirs 'h
	][
		;vertical resizing only
		sz100: to-pair reduce [size/x 100]
		parse/all load rejoin [{[
		bmpext_} wrd {1: bitmap layout [
			at 1x1 image } s: to-pair reduce [size/x val2/1] { %} val { effect [crop 0x0 } to-pair reduce [size/x val2/1] {]
		] [color 255.0.255 size } 1x1 + s { key 255.0.255]
		bmpext_} wrd {2: bitmap layout [
			at 1x0 image } sz100 { %} val { effect [crop } to-pair reduce [0 val2/1 + 1] { } s: to-pair reduce [size/x size/y - val2/2 - 1] { extend 0x0 } to-pair reduce [0 100 - size/y + val2/2 + val2/1 + 1 ] {]
		] [color 255.0.255 size } 1x0 + sz100 { key 255.0.255]
		bmpext_} wrd {3: bitmap layout [
			at 1x0 image } to-pair reduce [size/x val2/2] { %} val { effect [crop } to-pair reduce [0 size/y - val2/2] { } size {]
		] [color 255.0.255 size } 1x1 + to-pair reduce [size/x val2/2] { key 255.0.255]
		imgext_} wrd {1: bitmap-to-image bmpext_} wrd {1
		imgext_} wrd {2: bitmap-to-image bmpext_} wrd {2
		imgext_} wrd {3: bitmap-to-image bmpext_} wrd {3
		sprext_} wrd {1: sprite imgext_} wrd {1
		sprext_} wrd {2: sprite imgext_} wrd {2
		sprext_} wrd {3: sprite imgext_} wrd {3
		} wrd {: sprite [
			a: place sprext_} wrd {1 at -2x-2
			m: place spr_shared_mask1x1 at } s: to-pair reduce [-2 val2/1] {
			b: place sprext_} wrd {2 at } s {
			c: place sprext_} wrd {3 at -2x98
			doAction [
				constantPool [resize a b c m h _height _width]
				resize: func[h][
					m._height: b._height: ((h - (a._height + c._height) + 2 ))
					c._y: (b._y + b._height - 1)
				]
				b.setMask(m)
				m._width: b._width + 1
				resize(50)
			]
			showFrame end
		]
		]}
		] tag-rules
	][
		;horizontal resizing only
		parse/all load az: rejoin [{[
		bmphext_} wrd {1: bitmap layout [
			at 1x1 image } s: to-pair reduce [val2/1 size/y] { %} val { effect [crop 0x0 } to-pair reduce [val2/1 size/y] {]
		] [color 255.0.255 size } 1x1 + s { key 255.0.255]
		bmphext_} wrd {2: bitmap layout [
			at 0x1 image } sz100: to-pair reduce [100 size/y] { %} val { effect [crop } to-pair reduce [val2/1 + 1 0] { } s: to-pair reduce [size/x - val2/2 - 1 size/y] { extend 0x0 } to-pair reduce [100 - size/x + val2/2 + val2/1 + 1 0] {]
		] [color 255.0.255 size } 0x1 + sz100 { key 255.0.255]
		bmphext_} wrd {3: bitmap layout [
			at 1x1 image } s: to-pair reduce [val2/2 size/y] { %} val { effect [crop } to-pair reduce [size/x - val2/2 0] { } size {]
		] [color 255.0.255 size } 1x1 + s { key 255.0.255]
		imghext_} wrd {1: bitmap-to-image bmphext_} wrd {1
		imghext_} wrd {2: bitmap-to-image bmphext_} wrd {2
		imghext_} wrd {3: bitmap-to-image bmphext_} wrd {3
		sprhext_} wrd {1: sprite imghext_} wrd {1
		sprhext_} wrd {2: sprite imghext_} wrd {2
		sprhext_} wrd {3: sprite imghext_} wrd {3
		} wrd {: sprite [
			a: place sprhext_} wrd {1 at -2x-2
			m: place spr_shared_mask1x1 at } s: to-pair reduce [val2/1 - 2 -2] {
			b: place sprhext_} wrd {2 at } s {
			c: place sprhext_} wrd {3 at 109x-2
			doAction [
				constantPool [resize a b c m h _height _width]
				resize: func[h][
					;_root.test: _root.test add newline add "hresize: " add h
					m._width: b._width: ((h - (a._width + c._width) + 4 ))
					c._x: (b._x + b._width - 2)
				]
				b.setMask(m)
				m._height: b._height + 2
				resize(50)
			]
			showFrame end
		]
		]}
		] tag-rules
	]
]

make-window: func[data /local wrd tmp v extim d-size d-backgr][
	wrd: pop-set-word
	tmp: make string! 2000
	extim: func[d v t][
		insert tail tmp rejoin [{spr_} d {frm_} wrd {: } t { extended image %} v/1 { } v/2 { } v/3 {^/}]
	]
	d-size: 100x100
	d-backgr: 20.20.20
	ttl-at: 0x0
	ttl-rclip: 0
	ttl-font: "Arial"
	parse/all data [
		any [
			  'left set v block! (extim 'left v #"v")
			| 'right set v block! (extim 'right v #"v")
			| 'top set v block! (extim 'top v #"h")
			| 'bottom set v block! (extim 'bottom v #"h")
			| 'background set d-backgr [tuple! | issue!]
			| 'size set d-size pair!
			| 'title set v block! (
				parse v [any [
					  'at set ttl-at pair!
					| 'rclip set ttl-rclip integer!
					| 'font set ttl-font [word! | string! | lit-word!]
				]]
			)
			| v: any-type! (make-warning! v)
		]
	]
	insert tail tmp a: rejoin [{
		} wrd {: sprite [
			shp_bg_} wrd {: shape [
				bounds 0x0 100x100
				fill color } d-backgr { box 0x0 100x100
			]
			} either none? find names-ids-table 'fnt_Arial [{fnt_Arial: Font [name "Arial" bold]}][""] {
			spr_bg_} wrd {: sprite shp_bg_} wrd {
			m: place spr_bg_} wrd { at 16x22
			bg: place spr_bg_} wrd { at 16x22
			content: place spr_bg_} wrd { at 16x22
			lf: place spr_leftfrm_} wrd {
			rf: place spr_rightfrm_} wrd { at 116x0
			tf: place spr_topfrm_} wrd { at 16x0
			bf: place spr_bottomfrm_} wrd { at 16x193
			txt_} wrd {: EditText 'title 60x20 [text "untitled" color #ffffcc ReadOnly NoSelect Font [fnt_Arial 9] UseOutlines ]
			ttl: place txt_} wrd { at } ttl-at {
			doAction [
				constantPool [resize x y h lf rf tf bf m _height _width content]
				bg._x: tf._x: bf._x: content._x: m._x: lf._width - 2
				bg._y: content._y: m._y: tf._height - 3
				ttlrclip: } ttl-rclip {
				resize(} d-size/x { } d-size/y {)
			]
			showFrame end
		]
	}]
	if not WindowClassCreated? [
		insert tail tmp rejoin [{
doInitAction } wrd { [
	ConstantPool [WindowClass this init prototype content bg tf bf lf rf resize content _width _height ttl resizeContent v]
	WindowClass: func[][
		this.init()
		;_root.test: _root.test add newline add "winClass init end"
	]
	WindowClass.prototype: make MovieClip
	WindowClass.prototype.init: func[][
		this.resizeContent: false
		this.useHandCursor: false
		this.onMouseMove: func[][updateAfterEvent()]
		this.tf.onPress: func[][this._parent.startDrag() ]
		;this.content.onPress: null
		this.onMouseUp: func[][stopDrag]
		with this [
			bg._x: tf._x: bf._x: content._x: lf._width - 2
			bg._y: content._y: tf._height - 3
		]
		this.m._visible: false
	]
	WindowClass.prototype.loadMovie: func[url][
		this.title: url
		this.content.createEmptyMovieClip("loaded" 0) 
		this.content.loaded.loadMovie(url)
	]
	WindowClass.prototype.resize: func[x y /local h][
		with this [
			h: y + tf._height + bf._height - 6
			lf.resize(h) this.rf.resize(h)
			tf.resize(x) this.bf.resize(x)
			if resizeContent [
				content._width: x
				content._height: y
			]
			m._width: bg._width:   x
			m._height: bg._height: y
			rf._x: lf._width - 2 + x
			bf._y: h + 3 - bf._height
			ttl._width: x - ttlrclip + rf._width + lf._width
		]
	]
	WindowClass.prototype.setResizeContent: func[v][
		this.resizeContent: true
		this.setMask(false)
	]
	WindowClass.prototype.setMask: func[v][
		this.m._visible: v
		either v [
			this.content.setMask(this.m)
		][	this.content.setMask(null)]
	]
]}]
		WindowClassCreated?: true
	]
	probe tmp
	parse/all load tmp tag-rules
]