--- /dev/null
+(* $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 ()