package marr_poggio_pak;
	procedure marr_poggio(Tkm);		-- main entry for cafe_wall
end marr_poggio_pak;

package body marr_poggio_pak;

use tkw,grlib,string_utility_pak;			-- use the main widget class
use image,random_pak,image_pak;				-- use the image class, randomization, image_pak
use map_slider,radio_buttons;				-- use the map_slider and radio_buttons clas

	var Tk,canvas;
	var parent,parent1,slider;
	var img_orig,imgL,imgR,box,background,canvasL,canvasR,draw_L,draw_R;
	var anag,anaglyph;
	var chkbut1,chkbut2;
	var onoff1,onoff2,dark;
	var big,small,thresh;

procedure marr_poggio(Tkm);	
	onoff1 := onoff2 := dark := anaglyph := false;

	Tk := Tkm("toplevel","10,10"); Tk(OM) := "Marr-Poggio Zero-Crossings Laboratory";
	
	canvas := Tk("canvas","620,300");
	canvas("side") := "top";	
	
	parent := Tk("frame","10,10"); 			-- creates a frame.
	parent("side") := "top"; 
	
	slider := map_slider(parent,
		"Big@0@100@10;Small@0@100@5;Threshold * 10@1@50@10;VLBlur@0@10@0;" + "HRBlur@0@10@0;;" + 
		"Width@1@300@200;Height@1@300@200;Hdisparity@-20@20@10;VDisparity@-20@20@0;Blending@0@100@100;;" + 
		"Width2@1@100@80;Height2@1@300@250;Hdisparity2@-30@30@15;Blending2@0@100@50;Horizontal2@-100@100@0",draw_all);
	
	anag := parent("checkbutton","Anaglyph"); 
	anag("side") := "left";
	anag{OM} := lambda() ;if anaglyph then anaglyph := false; else anaglyph := true; end if; draw_all(); end lambda;
	
	ckbut2 := parent("checkbutton","Gradient"); 
	ckbut2("side") := "left";
	ckbut2{OM} := lambda() ;if onoff2 then onoff2 := false; else onoff2 := true; end if; draw_all(); end lambda;
	
	ckbut3 := parent("checkbutton","Dark"); 
	ckbut3("side") := "left";
	ckbut3{OM} := lambda() ;if dark then dark := false; else dark := true; end if; draw_all(); end lambda;
	
	j := radio_buttons(parent,"rads1,Orig.,Poggio-Marr difference,Zero-crossing image", draw_all);

	setup_image();

	Tk.mainloop();		-- enter the Tk main loop
		
end marr_poggio;

procedure setup_image();						-- creates a random dot image -- 400 * 400

	draw_L := image([[255.0,255.0,255.0],[300,300]]);
	draw_R := image([[255.0,255.0,255.0],[300,300]]);

	img_orig := image([[255.0],[300,300]]);
	img_orig := img_orig.to_random(0.0,510.0); 
	img_orig := img_orig.threshold([255.0]);								
	imgL := imgR := img_orig;
	
	imgLtoTK := imgL.to_int();
	imgRtoTK := imgR.to_int();
	
	tk_abs_imageL := Tk("image",imgLtoTK);	-- convert the image library image to a Tk 'absolute image'
	tk_abs_imageR := Tk("image",imgRtoTK);	-- convert the image library image to a Tk 'absolute image'
	
	canvasL := canvas("image",tk_abs_imageL); 
	canvasL("coords") := "0,0"; 
	canvasL("anchor") := "nw";
	
	canvasR := canvas("image",tk_abs_imageR); 
	canvasR("coords") := "320,0";
	canvasR("anchor") := "nw"; 

end setup_image;

procedure first_box();						-- create the first raised box

	width := slider("Width");				-- get parameters from slider
	height := slider("Height");
	disparity := slider("Hdisparity");
	vdisparity := slider("VDisparity");
	blending := slider("Blending");

	x := (300 - width)/2;
	y := (300 - height)/2;
	box := imgL([x,y,width,height]);			-- pick out the box
	background := imgL([x + disparity,y-vdisparity,width,height]);	
	
	blended := (box * [blending] + background * [100 - blending])/[100.0];	-- put box over bacground on right 
	imgR([x + disparity,y - vdisparity]) := blended;		-- put the shifted box into imgR

	if dark then upsy := imgL.flip("v"); imgL := imgL min upsy; imgR := imgR min upsy; end if;
					-- form darkest ink combination

end first_box;

procedure make_gradient(i,j,c);			-- make_gradient utility
	return if c = 0 then float(i) * 255.0 elseif c = 1 then float(100 - j) * 255.0 else 0.0 end if / 100.0;
end make_gradient;

procedure second_box();

	width := slider("Width2");
	height := slider("Height2");
	disparity := slider("Hdisparity2");
	blending := slider("Blending2");
	horizontal := slider("Horizontal2");

	x := (300 - width)/2;
	y := (300 - height)/2;
	gradient := image([width,height,1,1,make_gradient]);					-- create the gradient image

	underneath := imgL([x - horizontal - disparity,y,width,height]);				-- LEFT
	grad_and_under := ((gradient * [blending] + underneath * [100 - blending])/[100.0]);
	imgL([x - horizontal - disparity,y]) := grad_and_under;
	
	underneath := imgR([x,y,width,height]);								-- RIGHT		
	grad_and_under := ((gradient * [blending] + underneath * [100 - blending])/[100.0]);
	imgR([x + horizontal,y]) := grad_and_under;

end second_box;

procedure draw_all();				-- master drawing routine

	imgL := imgR := img_orig; 	-- Restore the original values

	big := slider("Big"); -- pick values from slider for Poggio - Marr 
	small := slider("Small"); 
	thresh := float(slider("Threshold * 10"))/10.0;

	first_box(); 									-- Create the first object
	if onoff2 then second_box(); end if;			-- Create the second object

	case Tk.getvar("rads1") 		
		when "Poggio-Marr difference" =>			-- show the difference image
 			imgL := blur_diff(big,small,imgL);
 			imgR := blur_diff(big,small,imgR);
		when "Zero-crossing image" =>				-- show the positive and negative parts of the difference image image
			imgL := zero_crossing(big,small,imgL);
 			imgR := zero_crossing(big,small,imgR);
	end case;
	
	draw_L(1..1) := imgL; draw_R(1..1) := imgR;
	draw_L(2..2) := imgL; draw_R(2..2) := imgR;
	draw_L(3..3) := imgL; draw_R(3..3) := imgR;
	
	if anaglyph then 								-- display as anaglyph

		draw_R(1..1) := imgL;							 -- put the left image in the RED Plane
		tk_abs_image := Tk("image",draw_R.to_int());	 -- convert the image library image to a Tk 'absolute image'

		canvasL("coords") := OM;									-- clear the left canvas image
		canvasR("coords") := OM; 									-- clear the right canvas image

		canvasL := canvas("image",tk_abs_image); 					-- create a new canvas image
		canvasL("coords") := "200,0"; 				
		canvasL("anchor") := "nw";	

	else											-- display as image pair

		imgLtoTK := draw_L.to_int(); imgRtoTK := draw_R.to_int().flip("h");
	 	tk_abs_imageL := Tk("image",imgLtoTK);	-- convert the image library image to a Tk 'absolute image'
		tk_abs_imageR := Tk("image",imgRtoTK);	-- convert the image library image to a Tk 'absolute image'

		if canvasL /= OM then canvasL("coords") := OM; end if;	-- clear the left canvas image
		if canvasR /= OM then canvasR("coords") := OM; end if;	-- clear the right canvas image

		canvasL := canvas("image",tk_abs_imageL); 				-- create a new canvas image
		canvasL("coords") := "0,0"; 								-- place it appropriately
		canvasL("anchor") := "nw";

		canvasR := canvas("image",tk_abs_imageR); 				-- create a new canvas image
		canvasR("coords") := "320,0"; 							-- place it appropriately
		canvasR("anchor") := "nw"; 

	end if;	 

end draw_all;

procedure blur_diff(big,sm,the_img);						-- form difference of blurs
	
	timprl := the_img.perlin();
--	vect_of_sizes_and_coeffs := [[big,1.0],[sm,-2.0],[sm - 1,1.0],[sm + 1,-1.0],[big + 3,1.0]];
	vect_of_sizes_and_coeffs := [[big,1.0],[sm,-1.0]];		-- approximation to standard Marr-Poggio 
--	vect_of_sizes_and_coeffs := [[big,1.0],[sm,-1.0],[24,1.0],[7,-1.0]];		-- temporary  trial 
	vect_of_imgs := [timprl * [[siz,siz,
		coeff := (0.25 * co)/(float(siz) * float(siz))],[-siz,-siz,coeff],[-siz,siz,-coeff],[siz,-siz,-coeff]]:
					 [siz,co] in vect_of_sizes_and_coeffs];
	return +/vect_of_imgs;

end blur_diff;

procedure zero_crossing(big,sm,the_img);					-- threshold to get zero-crossing image

	bd := blur_diff(big,sm,the_img);
--	bd(1..1) := (bd(1..1) max [0.0]) min [255.0];
--	bd(2..2) := (bd(2..2) max [0.0]) min [255.0];
--	bd(3..3) := (bd(3..3) max [0.0]) min [255.0];
--	return bd;
	
--	bd := abs * blur_diff(big,sm,the_img);
	return (bd.threshold([thresh]) * [5000.0]).threshold([255.0]);

end zero_crossing;

procedure write_captioned_image(an_image,cap);		-- write image to a Tk window

	var canv_image; -- global used in lambda seen below
		
	if an_image.density() = 1 then an_image := an_image.to_dense(); end if;		-- density is 1 for sparse images
	
	[height,width,num_planes,image_type,image_dens] := #an_image;
								-- image type is 1 for floating image, 2 for discrete ('grayscale')

	toplev := Tk("toplevel","10,10"); 
	ca := toplev("canvas",str(height) + "," + str(width)); ca("side") := "top";	-- create canvas
	three_zeroes := if image_type = 1 then [0.0,0.0,0.0] else [0,0,0] end if;
	
					-- use the Grlib image to create a Tk image
	if num_planes = 1 then 				-- pad out the image with additional planes

		extended_image := image([three_zeroes,[height,width]]);		
					-- set up a black image of 3 planes

		for j in [1..3] loop extended_image(j..j) := an_image; end loop;
		tk_abs_image := Tk("image",extended_image.to_int());

	elseif num_planes < 3 then 				-- pad out the image with additional planes

		extended_image := image([three_zeroes,[height,width]]);		-- set up a black image of 3 planes
		for j in [1..num_planes] loop extended_image(j..j) := an_image(j..j); end loop;
		tk_abs_image := Tk("image",extended_image.to_int());

	elseif num_planes > 3 then 		-- drop the extra planes
		tk_abs_image := Tk("image",an_image(1..3).to_int());
	else

		tk_abs_image := Tk("image",an_image.to_int());

	end if;
	
	toplev(OM) := cap;			-- enter the window title
	
	canv_image := ca("image",tk_abs_image); 	-- create as canvas image and place it
	canv_image("coords,anchor") := "0,0;nw";	-- place to make the image visible

	toplev{"Destroy"} := lambda(); canv_image("coords") := OM; end lambda;	
			-- remember to destroy the canvas image when the window is closed
	
	an_image := extended_image := OM;		-- release the images -- ?? should not be needed

end write_captioned_image;

end marr_poggio_pak;


program test;	-- test of marr_poggio_pak
use marr_poggio_pak,tkw;
	
	Tk := tkw(); Tk(OM) := "Master Panel";						-- create the Tk interpreter
	marr_poggio(Tk);	

end test;
