X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2FDEVEL%2Flablgtk%2Flablgtk_20000829-0.1.0%2Fexamples%2Fdcalendar.ml;fp=helm%2FDEVEL%2Flablgtk%2Flablgtk_20000829-0.1.0%2Fexamples%2Fdcalendar.ml;h=6128506b4a7918570e8da3de58ea30abb73bfa05;hb=2ee84a2a641938988703e329aef9fc3c5eb5aacf;hp=0000000000000000000000000000000000000000;hpb=34d83812af9b7064cc8f735c2a78169881140010;p=helm.git

diff --git a/helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/examples/dcalendar.ml b/helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/examples/dcalendar.ml
new file mode 100644
index 000000000..6128506b4
--- /dev/null
+++ b/helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/examples/dcalendar.ml
@@ -0,0 +1,247 @@
+(* $Id$ *)
+
+(* A small calendar *)
+(* Needs Unix module, so use with lablgtk_t *)
+
+open Printf
+
+type date = { mutable year: int; mutable mon: int; mutable mday: int }
+
+    (* Load the schedule data *)
+let calendar_file = Filename.concat (Sys.getenv "HOME") ".camlendar"
+
+let schedule =
+  try
+    let ichan = open_in calendar_file in
+    let (s : (int * int * int, string) Hashtbl.t) =
+      Marshal.from_channel ichan in
+    close_in ichan;
+    s
+  with Sys_error msg ->
+    prerr_endline msg; flush stderr;
+    Hashtbl.create 13;;
+
+    (* Saves the schedule data when the application terminates *)
+at_exit (fun () ->
+  let ochan = open_out calendar_file in
+  Marshal.to_channel ochan schedule ~mode: [];
+  close_out ochan);;
+
+    (* date: Current date initialized to "today" *)
+let date =
+  let tm = Unix.localtime (Unix.time ()) in
+  { year = 1900 + tm.Unix.tm_year; mon = tm.Unix.tm_mon; mday = 1 }
+
+
+    (* previous_month, next_month: change application status *)
+let previous_month () =
+  date.mday <- 1;
+  if date.mon = 0 then
+    (date.year <- date.year - 1; date.mon <- 11)
+  else date.mon <- date.mon - 1
+
+let next_month () =
+  date.mday <- 1;
+  if date.mon = 11 then (date.year <- date.year + 1; date.mon <- 0)
+  else date.mon <- date.mon + 1
+
+    (* leap, mon_name, wday_name: Calendar related function and data *)
+let leap year =
+  (year mod 400 = 0) or
+  (year mod 4 = 0) & (year mod 100 <> 0)
+
+let mdays_in_month = [|31; 28; 31; 30; 31; 30; 31; 31; 30; 31; 30; 31|]
+
+let mon_name =
+  [|"Jan"; "Feb"; "Mar"; "Apr"; "May"; "Jun";
+    "Jul"; "Aug"; "Sep"; "Oct"; "Nov"; "Dec"|]
+
+let wday_name =
+  [|"Sun"; "Mon"; "Tue"; "Wed"; "Thu"; "Fri"; "Sat"|]
+
+let s_normal = 0 and s_focused = 1 and s_planned = 2
+let styles =
+  let default = (Obj.magic () : GObj.style) in
+  [| default; default; default |]
+
+   (* class date_button: one button for each day in the month *)
+class date_button i (calendar : GPack.table) =
+  let mday = i + 1 in
+
+  object (self)
+    val widget = GButton.button ~label: (string_of_int mday) ~show: false ()
+    val mday = mday
+    val mutable show = false
+    val mutable have_plan = false
+
+    method widget = widget
+    method focus_on =
+      date.mday <- mday;
+      widget#misc#set_style styles.(s_focused)
+    method focus_off =
+      widget#misc#set_style styles.(if have_plan then s_planned else s_normal)
+    method set_plan =
+      have_plan <- true;
+      widget#misc#set_style styles.(s_planned)
+    method unset_plan =
+      have_plan <- false;
+      widget#misc#set_style styles.(s_normal)
+	
+    method show wday0 =
+      if not show then
+      	let top = (mday + wday0) / 7 + 1
+      	and left = (mday + wday0) mod 7 in
+      	calendar#attach ~left ~top ~expand:`BOTH widget#coerce;
+      	widget#misc#show ();
+	show <- true
+	    
+    method hide =
+      if show then
+      	(widget#misc#hide ();
+	 calendar#remove widget#coerce;
+	 show <- false)
+  end
+
+let update_calendar (calendar : GPack.table) (buttons : date_button array) =
+  let now = Unix.localtime (Unix.gettimeofday ()) in
+  let _, first = Unix.mktime { now with 
+			       Unix.tm_mday = 1;
+			       Unix.tm_mon = date.mon;
+			       Unix.tm_year = date.year - 1900 } in
+
+  (* wday0: day of the week of the zero'th day in the month *)
+  let wday0 = (first.Unix.tm_wday - 1 + 7) mod 7 in
+  
+  let ndays =
+    if date.mon = 1 & leap date.year then mdays_in_month.(date.mon) + 1
+    else mdays_in_month.(date.mon) in
+
+  Array.iter ~f: (fun button -> button#hide)
+    buttons;
+
+  for i = 0 to ndays - 1 do buttons.(i)#show wday0 done
+
+let create_GUI () =
+  
+  (* views part *)
+
+  let win =
+    GWindow.window ~title: "Camlendar" ~show: true
+      ~allow_shrink: false ~allow_grow: false () in
+  win#event#connect#delete
+    ~callback: (fun _ -> GMain.Main.quit (); exit 0; false);
+
+  let style = win#misc#style#copy in
+  styles.(s_normal) <- style;
+  
+  let style = style#copy in
+  style#set_bg [`NORMAL, `NAME "light green";
+		`PRELIGHT, `NAME "light green"];
+  styles.(s_focused) <- style;
+
+  styles.(s_focused) <- style;
+  let style = style#copy in
+  style#set_bg [`NORMAL, `NAME "sky blue";
+		`PRELIGHT, `NAME "sky blue"];
+  styles.(s_planned) <- style;
+
+  let vbox = GPack.vbox ~packing: win#add () in
+  let packing = vbox#add in
+  let toolbar = GButton.toolbar ~style: `TEXT ~packing () in
+
+  let prev =
+    toolbar#insert_button ~text: "Prev" ~tooltip: "Show previous month" () in
+  let next =
+    toolbar#insert_button ~text: "Next" ~tooltip: "Show next month" () in
+  
+  let calendar =
+    GPack.table ~homogeneous: true ~rows: 7 ~columns: 7
+      ~border_width: 10 ~row_spacings: 2 ~col_spacings: 2 ~packing () in
+
+  Array.iteri
+    ~f: (fun i wday ->
+      ignore (GButton.button ~label: wday
+	      	~packing:(calendar#attach ~top: 0 ~left: i ~expand:`BOTH) ()))
+    wday_name;
+
+  let buttons =
+    Array.init 31 ~f: (fun i -> new date_button i calendar) in
+
+  let date_view = GMisc.label ~justify: `CENTER ~packing () in
+
+  let text = GEdit.text ~editable: true ~width: 70 ~height: 50 ~packing () in
+
+  (* Controls part *)
+
+  let save_text () =
+    let data = text#get_chars ~start: 0 ~stop: text#length in
+    let key = (date.year, date.mon, date.mday) in
+    Hashtbl.remove schedule key;
+    if data <> "" then
+      (Hashtbl.add schedule ~key ~data;
+       buttons.(date.mday - 1)#set_plan)
+    else buttons.(date.mday - 1)#unset_plan in
+
+  let restore_text () =
+    text#delete_text ~start: 0 ~stop: text#length;
+    try
+      text#insert_text ~pos: 0
+ 	(Hashtbl.find schedule (date.year, date.mon, date.mday));
+      ()
+    with Not_found -> () in
+
+  let update_date_view () =
+    date_view#set_text (sprintf "%d %s, %d\n"
+			  date.mday mon_name.(date.mon) date.year) in
+  
+  let update_view () =
+    update_calendar calendar buttons;
+    update_date_view ();
+    Array.iteri ~f: (fun i button ->
+      (try
+ 	Hashtbl.find schedule (date.year, date.mon, i + 1);
+	button#set_plan
+      with Not_found -> button#unset_plan);
+      button#focus_off) buttons;
+    win#set_title (sprintf "Camlendar: %s, %d"
+		     mon_name.(date.mon) date.year) in
+
+  prev#connect#clicked
+    ~callback: (fun () ->
+      save_text ();
+      previous_month ();
+      
+      update_view ();
+      restore_text ();
+      buttons.(0)#focus_on);
+  
+  next#connect#clicked
+    ~callback: (fun () ->
+      save_text ();
+      next_month ();
+      
+      update_view ();
+      restore_text ();
+      buttons.(0)#focus_on);
+  
+  Array.iteri
+    ~f: (fun i button ->
+      button#widget#connect#clicked
+      	~callback: (fun () ->
+	  save_text ();
+	  buttons.(date.mday - 1)#focus_off;
+
+	  button#focus_on;
+	  restore_text ();
+	  update_date_view ());
+      ())
+    buttons;
+
+  update_view ();
+  buttons.(0)#focus_on;;
+
+GMain.Main.init ();
+print_endline (GtkMain.Main.set_locale ());
+flush stdout;
+create_GUI ();
+GMain.Main.main ()