rebol [
	title: "SWF tag-rules"
	author: "Oldes"
	email: oliva.david@seznam.cz
]

any [
	'background set val [tuple! | issue!] (
		if not including [
			ins form-tag 9 reduce either tuple? val [to binary! val][issue-to-binary val]
		]
	)
	| 'Rebol set val block! (
		error? try [if error? tmp: try [do val][probe disarm tmp]]
	)
	| 'Include set val [file! | url!] (
		use [data f][
			including: true
			either any [
				not none? f: get-filepath val
			][	compile next load/header f][
				make-warning!/msg none ["Cannot include file:" val]
			]
			including: false
		]
	)
	| 'require set val [file! | url!] (
		if none? find included-files val [
			use [data][
				insert included-files val
				including: true
				either any [
					not none? f: get-filepath val
				][	compile next load/header f][
					make-warning!/msg none ["Cannot include file:" val]
				]
				including: false
			]
		]
	)
	| 'bitmap 'layout  set id any [integer! ] set val2 block! set val3 opt [block! | none] (
		use [lay tmp ][
			lay: layout/origin val2 0x0
			if block? val3 [
				parse/all val3 [
					some [
						  'size set tmp pair! (lay/size: tmp)
						| 'color set tmp [tuple! | issue!] (
							lay/color: either tuple? tmp [tmp][to-tuple issue-to-binary tmp]
						)
						| any-type!
					]
				]
			]
			create-img/param to image! lay id val3
		]
	)
	| ['DefineBitsLossless | 'bitmap]
	  set val any [integer!]  set val2 [file! | url!] (val3: none)
	  opt ['size set val3 pair!] (
		either none? val3 [
			load-img val2 val
		][	load-img/size val2 val val3]
	)
	| 'bitmaps set tmp opt ['images | none] set val block! (
		;probe val
		use [id dir sw sh sm kcolor spr? pr? file][
			sm: true
			dir: copy ""
			spr?: false
			pr?: false
			kcolor: none
			parse val [	any [
				'from set val2 [file! | url!] (dir: dirize val2	)
				| 'key set kcolor tuple!
				| 'no 'key (kcolor: none)
				| 'make 'sprites (spr?: true)
				| 'precise (pr?: true)
				| ['no 'smoothing | 'smoothing 'off] (sm: false)
				| copy id opt [word! | set-word! | none]
				  set val2 [file! | url!] (val3: none) opt ['size set val3 pair!] (
					id: to word! either none? id [
						rejoin ["bmp_" last parse val2 "/"]
					][	first id ]
					insert val2 dir
					file: get-filepath val2
					;probe reduce [val2 val3 id]
					;insert set-word-buff id
					either pr? [
						create-img/param to image! layout/origin reduce [
							'backdrop kcolor 'at 1x1 'image file
						] 1x1 id reduce ['key kcolor]
					][
						set-id/as id
						either none? val3 [
							either none? kcolor [
								load-img file last-id
							][	load-img/key file last-id kcolor ]
						][	load-img/size file last-id val3]
					]
					if tmp = 'images [
						size: select placed-images get-id id
						sw: either "bmp_" = copy/part mold id 4 [
							replace mold id "bmp_" "img_"
						][	join "img_" mold id ]
						parse/all compose/deep [
							(to set-word! sw) Shape [
								Bounds 0x0 (size)
								(either sm [[]][[smoothing off]])
								image (id)
							]
						] tag-rules
						if spr? [
							sh: copy sw
							parse/all load rejoin [{[
								} replace sw "img_" "spr_" {: Sprite [
									place } sh { at } either pr? [-1x-1][0x0] {
								]]}
							] tag-rules
						]
					]
				)
				| val2: any-type! (make-warning! insert val2 "BITMAPS:")
			]]
		]
	)
	| ['DefineBitsLossless2 | 'alpha 'bitmap] set val any [integer!]  set val2 [file! | url!] (
		load-img/alpha val2 val
	)
	| 'DefineShape set val integer! set val2 binary! (
		ins form-tag 2 join set-id val val2
	)
	| 'DefineShape2 set val integer! set val2 binary! (
		ins form-tag 22 join set-id val val2
	)
	| 'DefineSprite set val any [integer!] set val2 binary! (
		ins form-tag 39 rejoin [set-id val val2]
	)
	| 'DefineMovie set val any [integer!] set val2 [string! | url! | file!] (
		ins form-tag 38 rejoin [set-id val val2 #{00}]
	)
	| 'RemoveObject some [
		set val [integer! | word!] set val2 integer! (
			ins form-tag 5 rejoin [
				int-to-ui16 get-id val
				int-to-ui16 val2
			]
		)
	]
	| ['RemoveDepth | 'RemoveDepths] [set val block! | copy val any [integer!]]
	  (foreach tmp val [ins form-tag 28 int-to-ui16 tmp])
	| ['DefineFont2 | 'Font] set val [block! | binary! | file!] (
		use [flags bin name enc tmp file][
			bin: make binary! 1000
			if file? val [
				file: get-filepath val	
				val: read/binary file
			]
			either binary? val [
				insert bin val
				insert bin set-id select val 'id
			][
				flags: make string! "00000000"
				
				insert bin #{00000200} ;because there are no glyphs
				if none? name: select val 'name [name: "Arial"]
				insert bin to binary! name
				insert bin int-to-ui8 length? name
				if find val 'italic [flags/7: #"1"]
				if find val 'bold [flags/8: #"1"]
				either find val 'WideCodes [
					flags/6: #"1"
					;flags/16: #"1"
				][
					if error? try [
						enc: 1 + index? find [ShiftJIS Unicode ANSI] select val 'encoding
					][	enc: 4 ]
					poke flags enc #"1"
				]
				insert bin either swf-version > 5 [#{01}][#{00}] ;languageCode (1 = western)
				insert bin load rejoin ["2#{" flags "}"]
				insert bin set-id select val 'id
			]
			ins form-tag 48 bin
		]
	)
	| ['DefineButton2 | 'Button] set val block! (
		use [bin tmp buff v key menu? old-act-bin i actions? ofs id][
			bin: make binary! 20
			insert bin set-id select val 'id
			menu?: either any [none? tmp: select val 'as tmp <> 'push][#{01}][#{00}]
			insert tail bin menu?
			menu?: menu? = #{01}
			;button shapes:
			tmp: select val 'shapes
			buff: make string! 100
			foreach [states facets] tmp [
				st: make string! "00000000"
				if word? states [states: join copy [] states]
				foreach state states [
					if found? v: find [hit down over up] state [
						poke st 4 + index? v #"1"
					]
				]
				ofs: either none? ofs: select facets 'at [0x0][ofs * 20]
				if none? id: select facets 'id [id: first facets]
				append buff st
				append buff enbase/base rejoin [
					int-to-ui16 get-id id	;character
					int-to-ui16 either none? v: select facets 'layer [1][v]		;layer
				] 2
				append buff create-matrix ofs facets
				buff: byte-align buff
				append buff create-cxform/withalpha
					select facets 'multiply
					select facets 'add
				buff: byte-align buff
			]
			buff: bits-to-bin buff
			append buff #{00}
			
			;button actions:
			tmp: select val 'actions
			actions?: (block? tmp) and (not empty? tmp)
			insert tail bin either actions? [int-to-ui16 (length? buff) + 2][#{0000}]
			insert tail bin buff
			if actions? [
				old-act-bin: copy action-bin
				i: 0
				foreach [states actions] tmp [
					i: i + 2
					if not block? states [states: join copy [] states]
					st: make string! "000000000"
					key: make string! "0000000"
					buff: make binary! 10
					parse states [
						some [
							'DragOut (either menu? [st/1: #"1"][st/5: #"1"])
							| 'DragOver (either menu? [st/2: #"1"][st/4: #"1"])
							| 'ReleaseOutside (if not menu? [st/3: #"1"])
							| 'Release (st/6: #"1")
							| 'Press (st/7: #"1")
							| 'RollOut (st/8: #"1")
							| 'RollOver  (st/9: #"1")
							| 'key set v [char! | string!] (
								if string? v [v: v/1]
								key: next enbase/base to binary! v 2
							)
						] to end
					]
					if not empty? st [
						clear action-bin
						compile-actions actions
						insert buff join action-bin #{00}
						insert buff head reverse load rejoin ["2#{" key st "}"]
						insert buff either i = length? tmp [#{0000}][
							int-to-ui16 (length? buff) + 2
						]
						;insert buff int-to-ui16 (length? buff) + 2
						insert tail bin buff
					]
				]
				action-bin: copy old-act-bin
				clear constantPool
				
			]
			ins form-tag 34 bin
		]
	)
	| 'DoAction set val [block! | binary!] (
		either binary? val [
			insert tail action-bin val
		][	compile-actions val]
	)
	| 'EditText set val opt [string! | word! | lit-word! | none] set val2 pair! set val3 block! (
		use [flags bin tmp f][
			bin: make binary! 40
			flags: make string! "0000000000000000"
			if not none? tmp: select val3 'text [
				insert bin rejoin [#{} either swf-version > 5 [utf8-encode tmp][tmp] #{00}]
				flags/1: #"1"
			]
			insert bin either none? val [#{00}][join to binary! val #{00}]
			if not none? tmp: select val3 'layout [
				tmp: make make object! [align: 'left margin: 0x0 indent: 0 leading: 2] tmp
				tmp/align: either found? f: find [left right center justify] tmp/align [
					(index? f) - 1
				][0]
				insert bin rejoin [#{}
					int-to-ui8 tmp/align
					int-to-ui16 tmp/margin/x * 20
					int-to-ui16 tmp/margin/y * 20
					int-to-ui16 tmp/indent * 20
					int-to-ui16 tmp/leading * 20
				]
				flags/11: #"1"
			]
			if not none? tmp: select val3 'MaxLength [
				insert bin int-to-ui16 tmp
				flags/7: #"1"
			]
			if not none? tmp: select val3 'color [
				tmp: either issue? tmp [issue-to-binary tmp][to binary! tmp]
				if 4 > length? tmp [insert tail tmp #{FF}]
				insert bin tmp
				flags/6: #"1"
			]
			if not none? tmp: select val3 'font [
				insert bin rejoin [int-to-ui16 get-id tmp/1 int-to-ui16 tmp/2 * 20]
				flags/8: #"1"
			]
			if find val3 'WordWrap [flags/2: #"1"]
			if find val3 'Multiline [flags/3: #"1"]
			if find val3 'Password [flags/4: #"1"]
			if find val3 'ReadOnly [flags/5: #"1"]
			if find val3 'NoSelect [flags/12: #"1"]
			if find val3 'Border [flags/13: #"1"]
			if find val3 'HTML [flags/15: #"1"]
			if find val3 'UseOutlines [flags/16: #"1"]
			insert bin load rejoin ["2#{" flags "}"]
			insert bin create-rect/bin 0x0 val2 * 20
			insert bin set-id select val3 'id 
			ins form-tag 37 bin
		]
	)
	| 'label set val [string! | word! | lit-word!] (
		ins form-tag 43 rejoin [#{} val #{00}]
	)
	| 'show set val opt [integer!] ['frame | 'frames] (
		if none? val [val: 1]
		loop val [showFrame]
	)
	| 'showFrame (showFrame)
	| 'end (if not including [ins #{0000}])
	;;now some test tags
	| 'EmptySprite set val [integer! | none] (
		ins form-tag 39 rejoin [set-id val #{010040000000}]
	)
	| 'prepared set val integer! set val2 binary! (ins form-tag val val2)
	| 'sprite set val any [integer!] set val2 [binary! | block! | word!] opt ['init] set val3 any [block! | none!] (
		compile-sprite val val2 val3
	)
	| 'Shape set val block! (
		use [
			changestyle draw-lines rect-min rect-max tmp buff
			id LineStyles cur-LineSt-id cur-FillSt0-id cur-FillSt0
			cur-FillSt1-id shs cur-state i pos w c new x shapeRecords
			bl at-pos relative? points n r curved? shp-size noise ns ns2
			tm transf smooth alpha prepare-color default-transformation
			noise? make-noise
		][
			alpha: false ;if we need to use RGBA colors
			smooth: true ;smoothing images
			id: none
			relative?: false
			twips?: false
			fixed-bounds?: false
			at-pos: 0x0
			curved?: false
			noise?: false
			pos: make pair! 0x0
			shs: make block! 10 ;help block
			FillStyles: make block! 5
			LineStyles: make block! 5
			def-LineSt: make block! [0 0.0.0]
			cur-LineSt: copy def-LineSt
			cur-FillSt0: none
			cur-LineSt-id: 0
			cur-FillSt0-id: 0
			cur-FillSt1-id: 0
			rect-max: 0x0 rect-min: 10000x10000 ;bounds
			ns: 0x0 ns2: 0x0 ;noise values
			cur-state: make string! "00000"
			shapeRecords: make string! 1000
			to-twips: func[v [number! pair!]][
				if not twips? [v: v * 20]
				either pair? v [v][to integer! v] 
			]
			prepare-color: func[c][
				c: to binary! c
				c: either alpha [
					either 4 > length? c [head insert tail c #{FF}][copy/part c 4]
				][	copy/part c 3 ]
			]
			prepare-pos: func[pos][
				forall pos [
					if not twips? [pos/1: pos/1 * 20]
					pos/1: either relative? [pos/1 + at-pos][pos/1]
				]
				head pos
			]
			default-transformation: func[][
				tm: make object! [ ;Transformation matrix
					scX: 1	scY: 1
					sk0: 0	sk1: 0
					x: 0	y: 0
					c: 0x0
				]
			]
			default-transformation
			transf: func[p][
				p: p - tm/c
				p: to pair! reduce [
					to integer! ((p/x * tm/scX) + (p/y * tm/sk1) + tm/x)
					to integer! ((p/y * tm/scY) + (p/x * tm/sk0) + tm/y)
				]
				p: p + tm/c
				if not fixed-bounds? [
					rect-max: max rect-max p
					rect-min: min rect-min p
				]
				return p
			]
			noise: func[val /x][
				val: val + either pair? val [
					ns2 - random ns
				][ 	either x [
						ns2/y - random ns/y
					][	ns2/x - random ns/x	]
				]
			]
			make-noise: func[p][
				forall p [p/1: p/1 + (random ns) - (random ns2)]
				head p
			]
			changestyle: func[first-pos /local buff][
				;if empty? LineStyles [cur-LineSt-id: 1 append/only LineStyles def-LineSt]
				buff: copy cur-state
				first-pos: transf first-pos
				if pos <> first-pos [
					;need to move pen to new drawing position
					buff/5: #"1"
					;will include the MoveBits:
					pos: first-pos
					insert tail buff ints-to-sbs/complete reduce [pos/1 pos/2] 5
				]
				insert buff #"0"
				insert shs buff
				if cur-state/4 = #"1" [cur-state/4 = #"0" insert shs reduce ['f cur-FillSt1-id ]]
				if cur-state/3 = #"1" [cur-state/3 = #"0" insert shs reduce ['f cur-FillSt0-id ]]
				if cur-state/2 = #"1" [cur-state/2 = #"0" insert shs reduce ['l cur-LineSt-id ]]
			]
			draw-lines: func[corners /local c LF x new][
				buff: make string! 1000
				forall corners [
					;now create STRAIGHTEDGERECORD
					c: transf corners/1
					new: c - pos
					pos: c
					if not zero? new [
						LF: make string! 2 ;LineFlag
						x: either zero? new/1 [ 
							LF: "01" ;vertical line
							first ints-to-sbs [new/2]
						][
							either zero? new/2 [
								LF: "00"
								first ints-to-sbs [new/1]
							][
								LF: "1"
								rejoin ints-to-sbs [new/1 new/2]
							]
						]
						insert tail buff rejoin ["11" int-to-bits max-bits - 2 4 LF	x]
					]
				]
				insert shs buff
			]
			draw-curves: func[points /local x][
				buff: make string! 1000
				foreach [c a] points [
					;now create CURVEDEDGERECORD
					c: transf c
					a: transf a
					new1: c - pos
					new2: a - c
					pos: a
					x: rejoin ints-to-sbs [new1/1 new1/2 new2/1 new2/2]
					insert tail buff rejoin ["10" int-to-bits max-bits - 2 4 x]
				]
				insert shs buff
			]
			draw-arc: func[
				r startAngle endAngle
				/center c
				/local nSegs subangle angle cx cy ax ay
			][
			    if not pair? r [r: to pair! to integer! r]
				if not center [c: at-pos]
				nSegs: 1 + to integer! ( 7 * (endAngle - startAngle) / 360)
				subangle: (endAngle - startAngle) / nSegs / 2
				angle: startAngle
				points: make block! []
			    insert points to pair! reduce [
					c/x + to integer! (r/x * sine angle)
					c/y + to integer! negate (r/y * cosine angle)
				]
				for i 1 nSegs 1 [
					angle: angle + subangle
					cx: r/x * (sine angle) / (cosine subangle)
					cy: r/y * (cosine angle) / (cosine subangle)
					insert points to pair! reduce [
						c/x + to integer! cx
						c/y + negate to integer! cy
					]
					angle: angle + subangle
					ax: r/x * sine angle
					ay: negate (r/y * cosine angle)
					insert points to pair! reduce [
						c/x + to integer! ax
						c/y + to integer! ay
					]
				]
				points: head reverse points
				;change back tail points first points
				changestyle first points
				draw-curves next points
				points
			]
			n-gon: func[n r /local fi x y][
				fi: 360 / n
				points: make block! n
				for i 0 360 fi [
					x: at-pos/x + to integer! (noise/x r) * sine i
					y: at-pos/y + to integer! (noise r) * cosine i
					insert tail points to pair! reduce [x y]
				]
				;remove points
				if noise? [points: make-noise points]
				change back tail points first points
				points
			]
	n-star: func[n r1 r2 ][
		fi: 360 / n
		corners: make block! n
		for i 0 360  fi [
			i2: i + (fi / 2)
			insert corners to pair! reduce [
				at-pos/x + to integer! r1 * sine i
				at-pos/y + to integer! r1 * cosine i
			]
			insert corners to pair! reduce [
				at-pos/x + to integer! r2 * sine i2
				at-pos/y + to integer! r2 * cosine i2
			]
		]
		remove corners
		if noise? [corners: make-noise corners]
		if (last corners) <> (first corners) [change back tail corners first corners]
		corners
	]
	draw-box: func[corners r /local c][
		tmp: prepare-pos corners
		either none? r [
			;normal box
			foreach [b-min b-max] tmp [
				either noise? [
					c: make-noise reduce [
						to pair! reduce [b-max/1 b-min/2]
						b-max
						to pair! reduce [b-min/1 b-max/2]
						b-min
					]
					update-gradient last c first c
					changestyle last c
					draw-lines c
				][
					update-gradient b-min b-max
					changestyle b-min
					draw-lines reduce [
						to pair! reduce [b-max/1 b-min/2]
						b-max
						to pair! reduce [b-min/1 b-max/2]
						b-min
					]
				]
			]
		][
			;rounded box
								use [c1 c2 c3 c4 m1 m2 p][
									r: either twips? [r][r * 20]
									foreach [c1 c3] tmp [
										update-gradient c1 c3
										m1: c3/x - c1/x
										m2: c3/y - c1/y
										r: either m1 >= m2 [
											min m2 / 2 r
										][	min m1 / 2 r ]
										c2: to pair! reduce [c3/1 c1/2]
										c4: to pair! reduce [c1/1 c3/2]
										m1: r * 1x0
										m2: r * 0x1
										changestyle p: c1 + m1
										draw-lines to block! p: c2 - m1
										draw-arc/center r 0 90 p + m2
										draw-lines to block! p: c3 - m2
										draw-arc/center r 90 180 p - m1
										draw-lines to block! p: c4 + m1
										draw-arc/center r 180 270 p - m2
										draw-lines to block! p: c1 + m2
										draw-arc/center r 270 360 p + m1
									]
								]
							]
	]
	get-fill: func[fill /local i id c type colors center gr-type rot ratios pratios gsz][
		switch first fill [
			color [join #{00} prepare-color second fill]
			bitmap [
				type: #{40}
				rot: 0
				sc: 20x20
				center: 0x0
				id: none
				parse next fill [
					any [
						'clipped (type: #{41})
						| 'at set center [pair! | block!] (
							if not twips? [
								center/1: center/1 * 20
								center/2: center/2 * 20
							]
						)
						| 'rotate set rot number!
						| 'scale set sc [block! | number!] (
							either block? sc [
								forall sc [sc/1: sc/1 * 20]
								sc: head sc
							][	sc: sc * 20 ]
						)
						| 'id set id [integer! | word!]
						| tmp: word! (
							either find names-ids-table tmp/1 [
								id: tmp/1
							][	make-warning! tmp ]
						)
					]
				]
				if not smooth [type: switch type [#{41} [#{43}] #{40} [#{42}]]]
				;type: either find fill 'clipped [#{41}][#{40}]
				;probe center
				fill: rejoin [
					type
					int-to-ui16 get-id id
					bits-to-bin create-matrix center reduce ['scale sc 'rotate rot]
				] 
			]
			gradient [
				;probe fill
				gr-type: #{10}
				rot: 0
				center: none
				sc: none
				gsz: none
				pratios: make block! 8 ;recounted ratios
				parse next fill [
					any [
						  'colors set colors block!
						| 'center set center pair! ;(if not twips? [center: center * 20])
						| 'radial (gr-type: #{12})
						| 'rotate set rot number!
						| 'size set gsz pair! (gsz: to-twips gsz)
						| 'ratios set ratios block! (
							;forall ratios [insert tail pratios to integer! (ratios/1 * 2.55)]
							pratios: copy ratios
							;ratios: copy head pratios

						)
						| 'scale set sc [block! | number!]
						| 'bounds set b-min pair! set b-max pair! (
							if not twips? [
								b-max: b-max * 20
								b-min: b-min * 20
							]
							bbox: b-max + negate b-min
							sc: min
								1 /  (32768 / max abs bbox/x 0.1)
								1 /  (32768 / max abs bbox/y 0.1)
							
							center: b-min + (bbox / 2)
						)
						| any-type!
					] to end
				]
				if none? gsz [gsz: shp-size]

				if none? center [center: gsz / 2]
				if none? sc [
					sc: reduce [
						1 /  (32768 / gsz/x)
						1 /  (32768 / gsz/y)
					]
				]
				
			print ["g" shp-size center sc]
				if empty? pratios [
					i: 0
					c: (length? colors) - 1
					step: 255 / c
					repeat i c [
						append pratios to integer! (i * step)
					]
					insert pratios 0
				]
				fill: rejoin [
					gr-type
					bits-to-bin create-matrix center reduce ['scale sc 'rotate rot]
					int-to-ui8 length? colors
				] 
				i: 1
				foreach color colors [
					repend fill [
						int-to-ui8 pratios/:i
						prepare-color color
					]
					i: i + 1
				]
				fill
			]
		]
	]
	set-fill-style: func[fill /left /local new id f][
		either issue? fill [fill: reduce ['color to tuple! issue-to-binary fill]][
			if tuple? fill [fill: reduce ['color fill]]
		]
		new: get-fill copy fill
		id: either found? f: find FillStyles new [
			index? f
		][
			append FillStyles new
			length? FillStyles
		]
		either left [
			cur-FillSt1-id: id
			cur-FillSt1: copy fill
		][
			cur-FillSt0-id: id
			cur-FillSt0: copy fill
		]
	]
	set-line-style: func[tmp /local w c new][
		cur-state/2: #"1"
		w: c: none new: make block! 2
		parse tmp [
			any [
				'width set w number!
				| 'color set c tuple!
				| 'color set c issue! (c: to tuple! issue-to-binary c)
			] to end
		]
		new: reduce [
			either none? w [cur-LineSt/1][to-twips w]
			either none? c [cur-LineSt/2][c]
		]
		cur-LineSt-id: either found? f: find LineStyles new [
			index? f
		][
			append/only LineStyles new
			length? LineStyles
		]
		cur-LineSt: new
	]
	update-gradient: func[b-min b-max /local bbox sc c][
	;probe cur-FillSt0
		if all [not none? cur-FillSt0 cur-FillSt0/1 = 'gradient none? find cur-FillSt0 'static] [
			;print [b-min b-max]
			bbox: b-max + negate b-min
							
			sc: reduce [
				1 /  (32768 / max abs bbox/x 0.1) 1 /  (32768 / max abs bbox/y 0.1)
			]
			c: b-min + (bbox / 2)
			;print [sc c]
			either found? f: find/tail cur-FillSt0 'center [
				f/1: c
			][
				repend cur-FillSt0 ['center c]
			]
			either found? f: find/tail cur-FillSt0 'scale [
				f/1: sc
			][
				repend cur-FillSt0 ['scale sc]
			]
			;print ["Updated:" mold cur-FillSt0]
			set-fill-style cur-FillSt0
		]
	]	
			
			
			parse val shp-rules: [
				any [
					'id set id integer!
					| 'comment set v string!
					| opt ['with] 'transparency (alpha: true)
					| 'Rebol set val block! (
						error? try [if error? err: try [do val][probe disarm err]]
					)
					| 'Bounds set rect-min pair! set rect-max pair! (
						fixed-bounds?: true
						shp-size: rect-max + negate rect-min
						if not twips? [
							rect-min: rect-min * 20
							rect-max: rect-max * 20
							shp-size: 20 * shp-size
						]
					)
					| 'noise copy tmp some [pair!] (
						error? try [
							ns: to-twips tmp/1
							ns2: to-twips tmp/2
							noise?: true
						]
					)
					| 'transform set tmp block! (
					use [v][
						default-transformation
						either not none? v: select tmp 'center [
							if number? v [v: reduce [v v]]
							tm/c: to-twips v
							if relative? [tm/c: tm/c + at-pos]
						][ tm/c: at-pos ]
						if not none? v: select tmp 'rotate [
							if number? v [v: reduce [v v]]
							tm/scx: cosine v/1
							tm/scy: cosine v/2
							tm/sk0: sine v/1
							tm/sk1: negate sine v/2
						]
						if not none? v: select tmp 'scale [
							if number? v [v: reduce [v v]]
							tm/scx: tm/scx * v/1
							tm/scy: tm/scy * v/2
							tm/sk0: tm/sk0 * v/1
							tm/sk1: tm/sk1 * v/2
						]
						if not none? v: select tmp 'skew [
							v: reduce either number? v [[v v]][[v/1 v/2]]
							v: reduce [v/1 / 360 v/2 / 360]
							tm/sk0: tm/sk0 + v/2
							tm/sk1: tm/sk1 + v/1
						]
						if not none? v: select tmp 'reflect [
							v: reduce either number? v [[v v]][[v/1 v/2]]
							tm/scx: tm/scx * v/1
							tm/scy: tm/scy * v/2
						]
						if not none? v: select tmp 'move [
							v: to-twips v
							v: reduce either number? v [[v v]][[v/1 v/2]]
							tm/x: tm/x + v/1
							tm/y: tm/y + v/2
						]
						;probe tm
					]
					)
					| 'positions ['relative (relative?: true) | 'absolute (relative?: false)]
					| 'at set at-pos pair! (if not twips? [at-pos: at-pos * 20] tm/c: at-pos relative?: true)
					| 'units [
						  'twips (twips?: on at-pos: at-pos * 20)
						| 'pixels (twips?: off at-pos: at-pos / 20)
					]
					| 'no [
						'fill (
							if cur-FillSt0-id > 0 [
								cur-FillSt0-id: 0 cur-state/3: #"1"
							]
						)
						| 'edge (
							if cur-LineSt-id > 0 [
								cur-LineSt-id: 0 cur-state/2: #"1"
							]
						)
						| 'noise (ns: ns2: 0x0)
						| 'transform (default-transformation)
					]
					| ['line-style | 'edge | 'lines] [
						set tmp block! (set-line-style tmp)
						| [
							(w: c: none)
							opt ['width set w number!]
							opt ['color set c [tuple! | issue!]]
							(set-line-style compose [width (w) color (c)])
						]
					 ]
					| 'gradient set tmp [block! | 'static] (
						either block? tmp [
							cur-state/3: #"1"
							insert tmp 'gradient
							set-fill-style tmp
						][
							if all [
								found? find cur-FillSt0 'gradient
								none? find cur-FillSt0 'static
							][append cur-FillSt0 'static]
						]
					)
					| 'fill 'bitmap set tmp [word! | integer! | block!] (
						cur-state/3: #"1"
						set-fill-style compose [bitmap (tmp)]
					)
					| ['fill-style | 'fill 'color] set tmp [block! | tuple! | issue!] (
						cur-state/3: #"1"
						set-fill-style tmp
					)
					| 'fill-style1 set tmp block! (
						cur-state/4: #"1"
						set-fill-style/left tmp
					)
					| 'smoothing ['on (smooth: true) | 'off (smooth: false)]
					| 'image set tmp [word! | integer!] (
						use [atp id][
							atp: at-pos / 20
							id: get-id tmp
							parse/all x: compose/deep [
								fill-style [bitmap id (tmp) at (atp) clipped]
								no edge
								box (atp) (atp + 1 + select placed-images id)
							] shp-rules
						]
					)
					| 'columns set tmp block! (
						use [data from blk i w sp ofs][
						ofs: none w: 10 sp: 0
						parse tmp [
							any [
								'data set data block!
								| 'from set from word!
								| 'at set ofs pair!
								| 'width set w number! 
								| 'space set sp integer!
								| any-type!
							]
						]
						
						blk: make block! 1 + 2 * length? data
						insert blk 'box
						i: 0
						switch from [
							bottom [
								if none? ofs [ofs: shp-size / 20]
								foreach h data [
									repend blk [
										to pair! reduce [ofs/x + i ofs/y]
										to pair! reduce [ofs/x + i: i + w ofs/y - h]
									]
									i: i + sp
								]
							]
							left [
								if none? ofs [ofs: rect-min / 20]
								foreach h data [
									repend blk  [
										to pair! reduce [ofs/x i + ofs/y]
										to pair! reduce [ofs/x + h ofs/y + i: i + w]
									]
									i: i + sp
								]
							]
						]
						parse blk shp-rules
						]
					)
					| 'box (r: none) any ['rounded set r any [integer!]] copy tmp any [pair!] (
						if block? tmp [draw-box tmp r]
					)
					| 'box2 (r: none) any ['rounded set r any [integer!]] copy tmp any [pair!] (
						if block? tmp [
							use [c p][
							c: make block! 2 * length? tmp
							forall tmp [
								p: tmp/1 / 2
								repend c [at-pos - p at-pos + p]
							]
							draw-box c r
							]
						]
					)
					| ['circle | 'oval] copy tmp any [number! | pair!] (
						forall tmp [
							c: either twips? [tmp/1][tmp/1 * 20]
							update-gradient at-pos - c at-pos + c
							draw-arc c 0 360
						]
					)
					| 'arc copy tmp any [number!] (
						foreach [r stAng enAng] tmp [
							draw-arc either twips? [r][r * 20] stAng enAng
							draw-lines reduce [at-pos first points]
						]
					)
					| 'curved (curved?: true)
					| 'n-gon set n integer! set r number! (
						if not twips? [r: r * 20]
						tmp: n-gon n r
						update-gradient at-pos - r at-pos + r
						changestyle first tmp
						either curved? [
							draw-curves next tmp
							curved?: false
						][	draw-lines next tmp]
					)
					| 'n-star set n integer! set r1 number! set r2 number! (
						r1: to-twips r1
						r2: to-twips r2
						tmp: n-star n r1 r2
						r: max r1 r2
						update-gradient at-pos - r at-pos + r
						changestyle first tmp
						either curved? [
							draw-curves next tmp
							curved?: false
						][	draw-lines next tmp]
					)
					| 'g-frame set tmp block! (
					use [tw bmi bma w colors c1 c2 c3 c4 i1 i2 i3 i4][
						bmi: to-twips tmp/1
						bma: to-twips tmp/2
						w: to-twips tmp/3
						colors: tmp/4
						tw: twips?
						twips?: on
						c1: bmi
						c2: (0x1 * bmi) + (1x0 * bma)
						c3: bma
						c4: (1x0 * bmi) + (0x1 * bma)
						i1: bmi + w
						i2: c2 + (-1x1 * w)
						i3: c3 - w
						i4: c4 + (1x-1 * w)
						;left
						cur-state/3: #"1"
						set-fill-style compose/deep [
							gradient colors [(colors)]
							bounds (c1) (c4 + (1x0 * w))
						]
						changestyle c1
						draw-lines reduce [i1 i4 c4 c1]
						;top
						cur-state/3: #"1"
						set-fill-style compose/deep [
							gradient colors [(colors)]
							rotate 90
							bounds (c1) (c2 + (0x1 * w))
						]
						changestyle c1
						draw-lines reduce [c2 i2 i1 c1]
						
						;right
						cur-state/3: #"1"
						set-fill-style compose/deep [
							gradient colors [(colors)]
							rotate 180
							bounds (c2 - (1x0 * w)) (c3)
						]
						changestyle c3
						draw-lines reduce [c2 i2 i3 c3]
						
						;bottom
						cur-state/3: #"1"
						set-fill-style compose/deep [
							gradient colors [(colors)]
							rotate 270
							bounds (c4 - (0x1 * w)) (c3)
						]
						changestyle c3
						draw-lines reduce [i3 i4 c4 c3]
						twips?: tw
					 ]
					)
					| 'line copy tmp any [pair!] (
						if block? tmp [
							tmp: prepare-pos tmp
							changestyle first tmp
							draw-lines next tmp
						]
					)
					| 'curve copy tmp any [pair!] (
						if block? tmp [
							tmp: prepare-pos tmp
							changestyle first tmp
							draw-curves next tmp
						]
					)
					| 'cross copy tmp any [pair!] (
						if block? tmp [
							foreach cr tmp [
								if not twips? [cr: cr * 20]
								cmin: to pair! reduce [cr/x / -2 cr/y / -2]
								cmax: cmin * -1
								if relative? [cmin: at-pos + cmin cmax: at-pos + cmax]
								changestyle cmin
								draw-lines to block! cmax
								changestyle to pair! reduce [cmax/x cmin/y]
								draw-lines to block! to pair! reduce [cmin/x cmax/y]
							]
						]
					)
					| 'grid copy tmp any [pair!] (
						if block? tmp [
							tmp: prepare-pos tmp
							use [i c1 c2 mi ma sz][
							set [mi ma sz] reduce [tmp/1 tmp/2 tmp/3]
								if 0 < sz/1 [
								i: mi/1
								while [i <= ma/1][
									c1: noise to pair! reduce [mi/1 + i 0]
									c2: noise to pair! reduce [mi/1 + i ma/2]
									changestyle c1
									draw-lines reduce [c1 c2]
									i: i + sz/1
								]]
								if 0 < sz/2 [
								i: mi/2
								while [i <= ma/2][
									c1: noise to pair! reduce [0 mi/2 + i]
									c2: noise to pair! reduce [ma/1 mi/2 + i]
									changestyle c1
									draw-lines reduce [c1 c2]
									i: i + sz/2
								]]
							]
						]
					)
					| val: any-type! (make-warning! val)
				]
				to end
			]
			buff: make binary! 100
			append buff rejoin [
				set-id id
				either fixed-bounds? [
					create-rect/bin rect-min rect-max
				][
					create-rect/bin rect-min - 200 rect-max + 200
				]
			]
			;fillstyles
			append buff either 255 <= tmp: length? FillStyles [
				join #{FF} int-to-ui16 tmp
			][	int-to-ui8 tmp ]
			repeat i tmp [repend buff FillStyles/:i	]
			;lineStyles
			append buff either 255 <= tmp: length? LineStyles [
				join #{FF} int-to-ui16 tmp
			][	int-to-ui8 tmp ]
			repeat i tmp [
				repend buff [
					int-to-ui16 first LineStyles/:i
					prepare-color second LineStyles/:i
				]
			]
			;------------
			append buff debase/base (
				join
					int-to-bits bf: bits-needed length? FillStyles 4
					int-to-bits bl: bits-needed length? LineStyles 4
			) 2
			parse shs [
				any [
					set tmp string! (insert shapeRecords tmp)
					| 'l set tmp integer! (insert shapeRecords int-to-bits tmp bl)
					| 'f set tmp integer! (insert shapeRecords int-to-bits tmp bf)
				]
			]
			ins form-tag either alpha [32][2] rejoin [
				buff
				debase/base byte-align join shapeRecords "000000" 2
			]
		]
	)
	| ['image | 'bitmap-to-image] set val [integer! | word! ] (
		use [size][
			
			size: select placed-images get-id val
			parse/all compose/deep [
				Shape [
					Bounds 0x0 (size)
					smoothing off
					image (val)
				]
			] tag-rules
		]
	)
	| 'MoveDepth set val opt [integer!]
		(val2: none) ['at set val2 pair! | set val2 any [block!]]
	(
		use [bin flags m a][
			bin: make binary! 40
			flags: make string! "00000001"
			either pair? val2 [val2: make block! reduce ['at val2]][
				if none? val2 [val2: make block! [at 0x0]]
			]	
			m: select val2 'multiply
			a: select val2 'add
			if any [not none? a	not none? m	][
				insert bin bits-to-bin create-cxform/withalpha m a
				flags/5: #"1"
			]
			if not none? pos: select val2 'at [
				pos: either block? pos [
					to pair! reduce [to integer! 20 * pos/1 to integer! 20 * pos/2]
				][	pos * 20]
				insert bin bits-to-bin create-matrix pos val2
				flags/6: #"1"
			]
			insert bin int-to-ui16 either integer? val [val][last-depth]
			insert bin load rejoin ["2#{" flags "}"]
 			ins form-tag 26 bin
		]
	)
	| ['PlaceObject2 | 'Place] set val [integer! | word! | block!]
		(val2: none) ['at set val2 pair! | set val2 any [block!]]
	  
	(
		use [old-act-bin act af flags bin tmp f m a name depth pos][
			if not block? val [val: to block! val]
			either pair? val2 [val2: make block! reduce ['at val2]][
				if none? val2 [val2: make block! [at 0x0]]
			]
			foreach id val [
			bin: make binary! 40
			flags: make string! "00000010"
			if not none? act: select val2 'actions [
				flags/1: #"1"
				af: make string! "0000000000000000"
				old-act-bin: copy action-bin
				insert bin either swf-version > 5 [#{00000000}][#{0000}]
				add-act: func[actions f type][
					if swf-version > 5 [insert tail type #{0000}]
					;probe type
					poke af f #"1"
					clear action-bin
					clear ConstantPool
					compile-actions actions
					insert bin rejoin [type int-to-ui32 1 + length? action-bin action-bin #{00}]
				]
				parse act [
					any [
						'load set tmp block! (add-act tmp 8 #{0100})
						| 'EnterFrame set tmp block! (add-act tmp 7 #{0200})
						| 'UnLoad set tmp block! (add-act tmp 6 #{0400})
						| 'MouseMove set tmp block! (add-act tmp 5 #{0800})
						| 'MouseDown set tmp block! (add-act tmp 4 #{1000})
						| 'MouseUp set tmp block! (add-act tmp 3 #{2000})
						| 'KeyDown set tmp block! (add-act tmp 2 #{4000})
						| 'KeyUp set tmp block! (add-act tmp 1 #{8000})
						| 'Data set tmp block! (add-act tmp 16 #{0001})
					] to end
				]
				af: bits-to-bin af
				insert bin rejoin either swf-version > 5 [[#{0000} af af]][[#{0000} af]]
				action-bin: copy old-act-bin
			]
			if any [
				not none? name: select val2 'name
				not none? name: set-word
			][
				insert bin rejoin [#{} name #{00}]
				flags/3: #"1"
			]
			
			if find val2 'move [flags/8: #"1"]
			depth: select val2 'depth
			last-depth: either none? depth [
				either flags/8 = #"1" [last-depth][last-depth + 1]
			][depth]
			
			if parse val2 [
				  thru 'ClipDepth set tmp integer! to end
				| thru 'Mask set tmp integer! to end (probe tmp: last-depth + tmp)
			][
				insert bin int-to-ui16 tmp
				flags/2: #"1"
			]
			m: select val2 'multiply
			a: select val2 'add
			if any [not none? a	not none? m	][
				insert bin bits-to-bin create-cxform/withalpha m a
				flags/5: #"1"
			]
			
			
			
			
			if not none? pos: select val2 'at [
				pos: either block? pos [
					to pair! reduce [to integer! 20 * pos/1 to integer! 20 * pos/2]
				][	pos * 20]
				insert bin bits-to-bin create-matrix pos val2
				flags/6: #"1"
			]
			insert bin int-to-ui16 get-id id
			insert bin int-to-ui16 last-depth
			;Ratio still skipped!!!!!!!!
			insert bin load rejoin ["2#{" flags "}"]
 			ins form-tag 26 bin
			;----------------------
			if not none? set-word [
				;print [set-word ":" id last-depth name pos]
				insert/only placed-objects reduce [name pos]
				insert placed-objects last-depth
				remove set-word-buff
			]
			];end of foreach
		]
	)
	| 'ExportAssets set v block! (
		use [bin][
			bin: make binary! 10
			insert bin int-to-ui16 (length? v) / 2
			foreach [id name] v [
				append bin rejoin [int-to-ui16 get-id id name #{00}]
			]
			ins form-tag 56 bin
		]
	)
	| 'ImportAssets set v block! opt ['from] copy v2 [url! | path! | word! | string! | file!](
		use [bin][
			bin: make binary! 10
			insert bin int-to-ui16 (length? v) / 2
			v2: either any [word? v2/1 path? v2/1] [mold v2/1][to string! v2/1]
			insert bin rejoin [v2 #"^@"]
			foreach [id name] v [
				append bin rejoin [set-id/as id name #{00}]
			]
			ins form-tag 57 bin
		]
	)
	| 'stop set v opt ['end] (
		compile-actions [stop]
		if v = 'end [
			showFrame ins #{0000}
		]
	)
	| 'comment set v string!
	| copy val set-word! val2: (
		insert set-word-buff val: to word! first val
		if find names-ids-table val [
			make-warning!/msg none reform ["Reusing word: " val]
		]
		;print ["TSW" mold set-word-buff]
	)
	;swf6
	| 'DoInitAction set val [word! | integer!] set val2 [block! | binary!] (
		;probe val2
		doInitAction val val2
	)
	;enhancements:
	| copy val3 any ['vertical | 'horizontal | 'v | 'h] 'extended 'image set val file! copy val2 any [integer!] (
		extended-image val val2 val3
	)
	| 'make 'window set val block! (
		make-window val
	)
	| 'animation set val block! (
		;print ["animation" mold val]
		use [i fr-pos to-pos frms step-x step-y pos positions][
			parse/all val [any [
				'move set val [word! | lit-word! | integer!]
					opt 'from set fr-pos pair!
					opt 'to set to-pos pair!
					opt 'in set frms integer! opt 'frames
					(
						step-x: (to-pos/x - fr-pos/x) / frms
						step-y: (to-pos/y - fr-pos/y) / frms
						;print ["move" val fr-pos to-pos frms step-x step-y]
						positions: make block! frms
						pos: make block! reduce [fr-pos/x fr-pos/y]
						insert positions 20 * fr-pos
						repeat i frms [
							pos/1: pos/1 + step-x
							pos/2: pos/2 + step-y
							;pos/2: (pos/2 + (i * step-y)) * (sine (90 / frms ) * i))
							;print ["pos" mold pos]
							insert tail positions to pair! reduce [
								to integer! 20 * pos/1
								to integer! 20 * pos/2
							]
						]
							
						insert/only animations reduce [val positions]
					) 
			]]
			;probe animations
		]
	)
	| 'mp3Stream set val [file! | url!] (
		;print ["mp3stream" val]
		use [file][
			either any [
				not none? file: get-filepath val
			][
				stream: make object! [
					type: 'mp3
					port: open/direct/binary file
					MakeHead?: true
					samplesPerFrame: 0
					delay: 0
					length: 0
					idealFrames: 0
					mp3frames: 0
					frame: 0
				]
			][
				print ["Mp3Stream file or url (" val ") doesn't exists!"]
			]
		]
	)
	| 'finish 'stream (
		while [not none? stream][showFrame]
		remove/part skip tail body -2 2
	)
	| 'sounds set val block! (
		foreach file val [
			insert set-word-buff to-word rejoin ['snd_ last parse file "/"]
			;probe file
			create-defineSound file
		]
	)
	| ['sound | 'defineSound] set val [file! | url!] (	create-defineSound val )
	| 'play set val [word! | integer! | string!] set val2 opt [block!] (
		use [info loop][
		if not block? val2 [val2: make block! []]
		info: #{00}
		if find val2 'noMultiple [info: info or #{10}]
		loop: either select val2 'loop [info: info or #{04} int-to-ui16 select val2 'loop][#{}]
		ins form-tag 15 rejoin [
			int-to-ui16 get-id val
			info
			loop
		]
		]
	)
	| ['stopSound | 'stop] set val [word! | integer!] (
		ins form-tag 15 join int-to-ui16 get-id val #{20}
	)
	| val: any-type! (make-warning! val)
]
to end