(* #load "graphics.cma";; *)
open Graphics ;;

let draw_rect x y w h =
        moveto x y;
        lineto (x+w) y;
        lineto (x+w) (y+h);
        lineto x (y+h);
        lineto x y;
;;

let current_color () =
        let c = point_color 42 42 in
        plot 42 42;
        let y = point_color 42 42 in
        set_color c;
        plot 42 42;
        set_color y;
        y;
;;

let dot_h y x1 x2 =
        plot x1 y;
        for i=0 to (x2-x1-4)/2 do plot (x1+1+2*i) y done;
        plot (x2-1) y;
        plot x2 y;
;;

let dot_v x y1 y2 =
        plot x y1;
        for i=0 to (y2-y1-4)/2 do plot x (y1+1+2*i) done;
        plot x (y2-1);
        plot x y2;
;;

let dot_rect x y w h =
        dot_h y x (x+w-1);
        dot_h (y+h-1) x (x+w-1);
        dot_v x y (y+h-1);
        dot_v (x+w-1) y (y+h-1);
;;

let transp_bg i =
        let m = dump_image i in
        for i = 0 to Array.length m -1 do
        for j = 0 to Array.length m.(0) -1 do
                if m.(i).(j) = background then m.(i).(j) <- transp
        done;
        done;
        make_image m;
;;


type buttxt = { apos:int*int ; texte:string ; raccl:int } ;;
type button = { pos:int*int ; taille:int*int ; image:image ; rac:char ; res:string } ;;

let button_of_buttxt b c =
        let a = get_image 0 0 (size_x()) (size_y()) and y = current_color() in
        clear_graph() ; set_color c;
        let n = String.length b.texte in
        moveto 200 200;
        draw_string b.texte;
        let im = get_image 200 200 (n*8) 18 in
        let im = transp_bg im in
        clear_graph();
        set_color (rgb 200 200 200);
        fill_rect 380 292 (40+8*n) 28;
        draw_image im 400 300;
        set_color c;
        moveto (400+(b.raccl-1)*8) 299 ; lineto (400+b.raccl*8) 299;
        let im = get_image 380 292 (40+8*n) 28 in
        draw_image a 0 0 ; set_color y;
        { pos = b.apos ; taille = 40+8*n,28 ; image = im ; rac = b.texte.[b.raccl-1] ; res = b.texte };
;;

let draw_string1 s =
	let x,y = current_point() and n = String.length s in
        let c = point_color 0 0 in
        plot 0 0;
        let cc = point_color 0 0 in
        set_color c;
        plot 0 0;
	let im0 = get_image 0 0 (n*8) 19 in
	moveto 0 0;
        set_color black;
	draw_string s;
	let im = get_image 0 0 (n*8) 19 in
	let t = dump_image im in
	for i = 0 to 18 do
	for j = 0 to n*8-1 do
		if t.(i).(j) = white then t.(i).(j) <- -1;
                if t.(i).(j) = black then t.(i).(j) <- cc;
	done;
	done;
	let im = make_image t in
	draw_image im x y;
	draw_image im0 0 0;
        set_color cc;
	moveto (x+n*8) y;
;;


let wait_event ml bl y action =
        let n = Array.length bl and m = Array.length ml
        and k = ref y and s = ref "" in
        if y < -1 || y >= n then k:= -1;

        let zone () =
                let x,y = mouse_pos() and i = ref (-1) in
                for j = 0 to n-1 do
                        let a,b = bl.(j).pos and w,h = bl.(j).taille in
                        if x > a && x < a+w && y > b && y < b+h then i:= j
                done;
                !i;
        in

        while true do

        for i = 0 to m-1 do
                let x,y,w,ss,s,_ = ml.(i) in
                set_color (rgb 0 128 255);
        	fill_rect (x+w+1) (y-27) 25 25;
	        set_color blue;
        	moveto (x+w+4) (y-12);
	        lineto (x+w+13) (y-21);
        	lineto (x+w+23) (y-11);
	        moveto (x+w+5) (y-12);
        	lineto (x+w+13) (y-20);
	        lineto (x+w+22) (y-11);
        	moveto (x+w+5) (y-11);
	        lineto (x+w+13) (y-19);
        	lineto (x+w+22) (y-10);
	        set_color black;
                draw_rect x (y+1) (w+27) (-30);
	        moveto (x+4) (y-22);
        	draw_string !s;
                moveto (x-20-(String.length ss)*8) (y-22);
                draw_string ss;
        done;

        for i = 0 to n-1 do
                let a,b = bl.(i).pos and w,h = bl.(i).taille in
                draw_image bl.(i).image a b;
                set_color black;
                moveto a b;
                lineto (a+w) b;
                lineto (a+w) (b+h);
                set_color white;
                moveto (a+w-1) (b+h);
                lineto (a-1) (b+h);
                lineto (a-1) b;
                set_color (rgb 200 200 200);
                draw_rect (a-2) (b-1) (w+3) (h+2);

                set_color black;
                if !k = i then dot_rect (a+2) (b+2) (w-4) (h-4);

        done;

        let e = wait_next_event [Button_down ; Key_pressed] in

        for i = 0 to n-1 do if e.key = bl.(i).rac then k:= i done;

        if e.key = '\t' then k:= (!k + 1) mod n;

        if e.key = '\013' then (if !k <> -1 then action bl.(!k).res);

        if e.button then (

                let mx = e.mouse_x and my = e.mouse_y in
                for j = 0 to m-1 do
                        let x,y,w,_,s,v = ml.(j) in
                	if mx >= x+w+1 && mx <= x+w+26 && my >= y-27 && my <= y-2 then (
		                let n = Array.length v in
                                set_color white;
                                fill_rect x (y-32-20*n) (w+27) (20*n+2);
                                set_color black;
                                moveto x (y-30);
		                lineto x (y-31-20*n);
                		lineto (x+w+27) (y-31-20*n);
		                lineto (x+w+27) (y-29);
                		for i = 1 to n do
		                	moveto (x+5) (y-28-20*i);
		                	draw_string v.(i-1);
                		done;
		                let b = ref true and c = ref (-1) in
                		while !b do
	                		let e = wait_next_event [Mouse_motion ; Button_down] in
		                	let mx = e.mouse_x and my = e.mouse_y in
			                if mx >= x && mx <= x+w+27 then (
				                let cc = (y-30-my)/20 in
                				if my < y-30 && cc >= 0 && cc < n then (
                                                        if cc <> !c then (
        			                		if !c <> -1 then (
	        				                	set_color white;
		        		                		fill_rect (x+2) (y-50-20* !c) (w+24) 19;
			        			                set_color black;
                				        		moveto (x+5) (y-48-20* !c);
		                			        	draw_string v.(!c);
        			                		);
        	        				        c:= cc;
	                	        			set_color blue;
			                        		fill_rect (x+2) (y-50-20* !c) (w+24) 19;
				                        	set_color white;
                					        moveto (x+5) (y-48-20* !c);
        	                				draw_string1 v.(!c);
		        	                	);
                                                        if e.button then s:= v.(!c);
                                                );
                			);
                                        if e.button then (
                                                b:= false;
                                                clear_graph();
                                        );
                		done;
                	);
                done;


                k:=zone();
                if !k <> -1 then (
                        let a,b = bl.(!k).pos and w,h = bl.(!k).taille in
                        set_color white;
                        moveto a b;
                        lineto (a+w) b;
                        lineto (a+w) (b+h);
                        set_color black;
                        moveto (a+w-1) (b+h);
                        lineto (a-1) (b+h);
                        lineto (a-1) b;

                        let e = wait_next_event [Button_up] in
                        if !k = zone() then action bl.(!k).res;
                );

        );

        done;
;;