open Tk

(***********************************)
(* Pour la creation de l'interface *)
(***********************************)
let button_create ?(relief=`Raised) owner name  =
  Button.create ~relief ~text:name owner

and frame_create owner =
  Frame.create ~relief:`Groove ~borderwidth:2 owner

and menubutton_create owner name =
  Menubutton.create ~text:name owner 

(**************************************)
(* Creation d'un item texte du canvas *)
(**************************************)
let texte_create canvas (name,x,y) =
  ignore(Canvas.create_text ~x:x ~y:y ~fill:`Red ~text:name canvas)

(*******************************************)
(* Creation du canvas, creation des items  *)
(**&****************************************)
let new_def top name =
  let wgt = Toplevel.create top in
  Wm.title_set wgt name;
  let frm = Frame.create wgt in
  let cvs = Canvas.create frm in
  pack ~expand:true ~fill:`Both [cvs];
  pack ~expand:true ~fill:`Both [frm];
  let ref =[("Texte0",20,20);("Texte1",60,60);("Texte2",90,90)] in
  List.iter ~f:(function r -> texte_create cvs r) ref;

  let b = Button.create ~text:"erase" ~command:(function _ -> Canvas.delete cvs (Canvas.find cvs ~specs:[`All])) wgt in
  pack ~side:`Bottom [b]


let win = openTk();;

(******************************************)
(* Le menu...                             *)
(* Start : fonctionnement normal          *)
(* Start_Pb : probleme                    *)
(******************************************)
let start () =
  new_def win "essai" in

let quit () =
  closeTk();
  exit 0 in

let menu_bar = frame_create win in
let menu_button = menubutton_create menu_bar "Menu" in
let menu = Menu.create ~tearoff:false menu_button in
Menu.add_command ~label:"Start" ~command:start menu;
Menu.add_command ~label:"Quit" ~command:quit menu;
Menubutton.configure ~menu:menu menu_button;
pack ~side:`Top ~fill:`X [menu_bar]; 
pack ~side:`Left ~fill:`Y [menu_button]; 

mainLoop()