REBOL [
	title: "Rebcode test - 3x3 convolutions by Cyphre"
	author: cyphre@rebol.com
	type: 'graphic
	purpose: {
		Shows how to implement a convolution engine using rebcode.
	}
]

time: func [b /local start] [
	start: now/precise
	do b
	status/text: rejoin  ["Rendered in: " difference now/precise start]
	show status
]

view/new center-face layout [origin 5 backcolor sky banner "loading image..."]
img: load-thru/binary http://www.rebol.cz/~cyphre/land.png
unview
img2: make image! img/size

widht: img/size/x
isx: img/size/x - 2
isy: img/size/y - 2

width: img/size/x

conv-data: [
	"Emboss 1" [
	 	[
			0 0 0
			0 1 0
			0 0 -1
		]
		1
		128
		#[true]
	]
	"Emboss 2" [
	 	[
			2 0 0
			0 -1 0
			0 0 -1
		]
		1
		128
		#[true]
	]
	"Emboss 3" [
	 	[
			-2 -1 0
			-1 1 1
			0 1 2
		]
		0
		0
		#[true]
	]
	"Emboss 4 Laplascian" [
	 	[
			-1 0 -1
			0 4 0
			-1 0 -1
		]
		1
		127
		#[true]
	]
	"Emboss 5 All Directions" [
	 	[
			-1 -1 -1
			-1 8 -1
			-1 -1 -1
		]
		1
		127
		#[true]
	]
	"Emboss 6 Horizontal Only" [
	 	[
			0 0 0
			-1 2 -1
			0 0 0
		]
		1
		127
		#[true]
	]
	"Emboss 7 Vertical Only" [
	 	[
			0 -1 0
			0 0 0
			0 1 0
		]
		1
		127
		#[true]
	]
	"Emboss 8 Horiz/Vert" [
	 	[
			0 -1 0
			-1 4 -1
			0 -1 0
		]
		1
		127
		#[true]
	]
	"Emboss 9 Lossy" [
	 	[
			1 -2 1
			-2 4 -2
			-2 -1 -2
		]
		1
		127
		#[true]
	]
	"Sobel Horiz" [
		[
			1 2 1
			0 0 0
			-1 -2 -1
		]
		1
		0
		#[false]
	]
	"Sobel Vert" [
		[
			1 0 -1
			2 0 -2
			1 0 -1
		]
		1
		0
		#[false]
	]
	"Pervit Horiz" [
		[
			1 1 1
			0 0 0
			-1 -1 -1
		]
		1
		0
		#[false]
	]
	"Pervit Vert" [
		[
			1 0 -1
			1 0 -1
			1 0 -1
		]
		1
		0
		#[false]
	]
	"Kirsh Horiz" [
		[
			5 5 5
			-3 -3 -3
			-3 -3 -3
		]
		1
		0
		#[false]
	]
	"Kirsh Vert" [
		[
			5 -3 -3
			5 -3 -3
			5 -3 -3
		]
		1
		0
		#[false]
	]
	"Edge detect 1" [
	 	[
			0 1 0
			1 -4 1
			0 1 0
		]
		1
		0
		#[false]
	]	
	"Edge detect 2" [
	 	[
			-5 0 0
			0 0 0
			0 0 5
		]
		1
		0
		#[false]
	]
	"Edge detect 3" [
	 	[
			-0.125 -0.125 -0.125
			-0.125 1 -0.125
			-0.125 -0.125 -0.125
		]
		0
		0
		#[false]
	]
	"Edge detect 5" [
	 	[
			-1 -1 -1
			-1 8 -1
			-1 -1 -1
		]
		0
		127
		#[false]
	]
	"Edge detect 6" [
	 	[
			-1 -1 -1
			2 2 2
			-1 -1 -1
		]
		0
		127
		#[false]
	]
	"Edge detect 7" [
	 	[
			-5 -5 -5
			-5 39 -5
			-5 -5 -5
		]
		0
		127
		#[false]
	]
	"Edge enhance" [
	 	[
			0 0 0
			-1 1 0
			0 0 0
		]
		0
		127
		#[false]
	]
	"Mean removal" [
	 	[
			-1 -1 -1
			-1 9 -1
			-1 -1 -1
		]
		0
		0
		#[false]
	]
	"sharpen 1" [
	 	[
			-1 -1 -1
			-1 16 -1
			-1 -1 -1
		]
		0
		0
		#[false]
	]
	"sharpen 2" [
	 	[
			0 -2 0
			-2 11 -2
			0 -2 0
		]
		3
		0
		#[false]
	]
	"sharpen 3" [
	 	[
			0 -1 0
			-1 5 -1
			0 -1 0
		]
		0
		0
		#[false]
	]
	"Gaussian blur 1" [
	 	[
			1 2 1
			2 4 2
			1 2 1
		]
		16
		0
		#[false]
	]
	"Gaussian blur 2" [
	 	[
			0.045 0.122 0.045
			0.122 0.332 0.122
			0.045 0.122 0.045
		]
		0
		0
		#[false]
	]
	"Gaussian blur 3" [
	 	[
			0 1 0
			1 1 1
			0 1 0
		]
		0
		0
		#[false]
	]

	"blur/smooth" [
	 	[
			1 1 1
			1 1 1
			1 1 1
		]
		9
		0
		#[false]
	]
	"box blur" [
	 	[
			0.111 0.111 0.111
			0.111 0.111 0.111
			0.111 0.111 0.111
		]
		0
		0
		#[false]
	]
	"triangle blur" [
	 	[
			0.0625 0.125 0.0625
  			0.125 0.25 0.125
			0.0625 0.125 0.0625
		]
		0
		0
		#[false]
	]

]

convolution: rebcode [
	src dst conv divisor oft gray
	/local x div.i idx cr cg cb tmp idx2 pr pg pb h c
][
	set x 0
	set div.i 0.0
	set idx 0
	set tmp 0
	set idx2 0
	set h 0.0


	repeat y isy [
		repeat xx isx [
			set.i x xx
			add.i x 1
	
			set.d div.i 0.0
			set.i idx 0
			set cr 0.0
			set cg 0.0
			set cb 0.0
			
			repeat j 3 [
				repeat i 3 [
					add.i idx 1
					pick c conv idx
					to-dec c
					add.d div.i c
					
					set.i tmp y
					add.i tmp j
					sub.i tmp 2
					mul.i tmp width
					set.i idx2 x
					add.i idx2 i
					sub.i idx2 2
					add.i idx2 tmp
					
					pick src-pix src idx2
comment {
					set pr src-pix
					and pr 16711680
					lsr pr 16
					set pg src-pix
					and pg 65280
					lsr pg 8
					set pb src-pix
					and pb 255
}

	set pb src-pix
	set pg src-pix
	lsr pg 8
	set pr pg
	lsr pr 8
	and pr 255
	and pg 255
	and pb 255

					to-dec pr
					to-dec pg
					to-dec pb

					sett gray

					either [
						set.d h pr
						add.d h pg 
						add.d h pb
						div.d h 3.0

						gt.d h 255.0
						ift [
							set.d h 255.0
						]
						lt.d h 0.0
						ift [
							set.d h 0.0
						]

						set.d pr h
						mul.d pr c
						add.d cr pr
						set.d pg h
						mul.d pg c
						add.d cg pg
						set.d pb h
						mul.d pb c
						add.d cb pb
					][
						mul.d pr c
						add.d cr pr
						mul.d pg c
						add.d cg pg
						mul.d pb c
						add.d cb pb
					]
				]
			]
			eq.d divisor 0.0
			ift [
				set.d divisor div.i
			]
			
			lteq.d divisor 0.0
			ift [
				set.d divisor 1.0
			]

			div.d cr divisor
			add.d cr oft
			gt.d cr 255.0
			ift [
				set.d cr 255.0
			]
			lt.d cr 0.0
			ift [
				set.d cr 0.0
			]

			div.d cg divisor
			add.d cg oft
			gt.d cg 255.0
			ift [
				set.d cg 255.0
			]
			lt.d cg 0.0
			ift [
				set.d cg 0.0
			]

			div.d cb divisor
			add.d cb oft
			gt.d cb 255.0
			ift [
				set.d cb 255.0
			]
			lt.d cb 0.0
			ift [
				set.d cb 0.0
			]

			to-int cr
			to-int cg
			to-int cb
			
		    lsl cr 16
		    lsl cg 8
		    or cr cg
		    or cr cb

			set.i idx2 y
			mul.i idx2 width

			add.i idx2 x
			poke dst idx2 cr
		]
	]
]

tl-data: copy []
foreach [n d] conv-data [
	append tl-data n
]

set-gui: has [fac] [
	repeat n 9 [
		set in fac: get to-word rejoin ["m" n] 'text to-decimal pick current-conv/1 n
		show fac
	]
	f-divisor/text: to-decimal current-conv/2
	f-oft/text: to-decimal current-conv/3
	ch-gray/data: to-logic current-conv/4
	show [f-divisor f-oft ch-gray]
]

get-gui: has [fac] [
	repeat n 9 [
		poke current-conv/1 n to-decimal get in fac: get to-word rejoin ["m" n] 'text
	]
	current-conv/2: to-decimal f-divisor/text
	current-conv/3: to-decimal f-oft/text
	current-conv/4: to-logic ch-gray/data
]

stylize/master [
	field: field with [
		size: 200x20
		edge: make edge [
			size: 1x1
			color: black
			effect: none
		]
	]
	info: info with [
		size: 200x20
		edge: make edge [
			size: 1x1
			color: black
			effect: none
		]
	]
]

view center-face layout [
	origin 5
	space 5
	image img
	i2: image img2
	return
	guide
	m1: field 50
	m4: field 50
	m7: field 50
	return
	m2: field 50
	m5: field 50
	m8: field 50
	return
	m3: field 50
	m6: field 50
	m9: field 50
	return
	across
	text "divisor:"
	f-divisor: field 113
	return
	text "offset:"
	f-oft: field 119
	return
	ch-gray: check-line "preprocess grayscale"
	return
	btn "Apply" [
		get-gui
		time [convolution img img2 current-conv/1 to-decimal current-conv/2 to-decimal current-conv/3 current-conv/4]
		show i2
	]
	btn "Apply more" [
		get-gui
		time [convolution img2 img2 current-conv/1 to-decimal current-conv/2 to-decimal current-conv/3 current-conv/4]
		show i2
	]
	return
	tl: text-list 165x214 [
		current-conv: copy/deep select conv-data face/picked
		set-gui
;		time [convolution img img2 current-conv/1 to-decimal current-conv/2 to-decimal current-conv/3 current-conv/4]
		show i2
	] with [data: tl-data]
	return
	status: info 165
]