X-Git-Url: http://matita.cs.unibo.it/gitweb/?p=helm.git;a=blobdiff_plain;f=helm%2FDEVEL%2Flablgtk%2Flablgtk_20000829-0.1.0%2Fexamples%2Fkaimono.ml;fp=helm%2FDEVEL%2Flablgtk%2Flablgtk_20000829-0.1.0%2Fexamples%2Fkaimono.ml;h=0000000000000000000000000000000000000000;hp=e52415645dbb7aec38fb4cc83eb0a3dbf694110e;hb=3ef089a4c58fbe429dd539af6215991ecbe11ee2;hpb=1c7fb836e2af4f2f3d18afd0396701f2094265ff diff --git a/helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/examples/kaimono.ml b/helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/examples/kaimono.ml deleted file mode 100644 index e52415645..000000000 --- a/helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/examples/kaimono.ml +++ /dev/null @@ -1,130 +0,0 @@ -(* $Id$ *) - -open GMain -open Printf - -let file_dialog ~title ~callback ?filename () = - let sel = GWindow.file_selection ~title ~modal:true ?filename () in - sel#cancel_button#connect#clicked ~callback:sel#destroy; - sel#ok_button#connect#clicked ~callback: - begin fun () -> - let name = sel#get_filename in - sel#destroy (); - callback name - end; - sel#show () - -let w = GWindow.window ~title:"Okaimono" () -let vb = GPack.vbox ~packing:w#add () - -let menubar = GMenu.menu_bar ~packing:vb#pack () -let factory = new GMenu.factory menubar -let file_menu = factory#add_submenu "File" -let edit_menu = factory#add_submenu "Edit" - -let sw = GBin.scrolled_window ~height:200 ~packing:vb#add - ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC () -let vp = GBin.viewport ~width:340 ~shadow_type:`NONE ~packing:sw#add () -let table = GPack.table ~columns:4 ~rows:256 ~packing:vp#add () -let _ = - table#focus#set_vadjustment (Some vp#vadjustment) - -let top = ref 0 -and left = ref 0 -let add_to_table w = - table#attach ~left:!left ~top:!top ~expand:`X w; - incr left; - if !left >= 4 then (incr top; left := 0) - -let entry_list = ref [] - -let add_entry () = - let entry = - List.map [40;200;40;60] - ~f:(fun width -> GEdit.entry ~packing:add_to_table ~width ()) - in entry_list := entry :: !entry_list - -let _ = - List.iter2 ["Number";"Name";"Count";"Price"] [40;200;40;60] ~f: - begin fun text width -> - ignore (GButton.button ~label:text ~width ~packing:add_to_table ()) - end; - for i = 1 to 9 do add_entry () done - -let split ~sep s = - let len = String.length s in - let rec loop pos = - let next = - try String.index_from s pos sep with Not_found -> len - in - let sub = String.sub s ~pos ~len:(next-pos) in - if next = len then [sub] else sub::loop (next+1) - in loop 0 - -let load name = - try - let ic = open_in name in - List.iter !entry_list - ~f:(fun l -> List.iter l ~f:(fun e -> e#set_text "")); - let entries = Stack.create () in - List.iter !entry_list ~f:(fun x -> Stack.push x entries); - try while true do - let line = input_line ic in - let fields = split ~sep:'\t' line in - let entry = - try Stack.pop entries - with Stack.Empty -> - add_entry (); List.hd !entry_list - in - List.fold_left fields ~init:entry ~f: - begin fun acc field -> - (List.hd acc)#set_text field; - List.tl acc - end - done - with End_of_file -> close_in ic - with Sys_error _ -> () - - -let save name = - try - let oc = open_out name in - List.iter (List.rev !entry_list) ~f: - begin fun entry -> - let l = List.map entry ~f:(fun e -> e#text) in - if List.exists l ~f:((<>) "") then - let rec loop = function - [] -> () - | [x] -> fprintf oc "%s\n" x - | x::l -> fprintf oc "%s\t" x; loop l - in loop l - end; - close_out oc - with Sys_error _ -> () - -open GdkKeysyms - -let _ = - w#connect#destroy ~callback:Main.quit; - w#event#connect#key_press ~callback: - begin fun ev -> - let key = GdkEvent.Key.keyval ev and adj = vp#vadjustment in - if key = _Page_Up then - adj#set_value (adj#value -. adj#page_increment) - else if key = _Page_Down then - adj#set_value (min (adj#value +. adj#page_increment) - (adj#upper -. adj#page_size)); - false - end; - w#add_accel_group factory#accel_group; - let ff = new GMenu.factory file_menu ~accel_group:factory#accel_group in - ff#add_item ~key:_O "Open..." - ~callback:(file_dialog ~title:"Open data file" ~callback:load); - ff#add_item ~key:_S "Save..." - ~callback:(file_dialog ~title:"Save data" ~callback:save); - ff#add_separator (); - ff#add_item ~key:_Q "Quit" ~callback:w#destroy; - let ef = new GMenu.factory edit_menu ~accel_group:factory#accel_group in - ef#add_item ~key:_A "Add line" ~callback:add_entry; - w#show (); - Main.main ()