summaryrefslogtreecommitdiff
path: root/gui.ml
diff options
context:
space:
mode:
Diffstat (limited to 'gui.ml')
-rw-r--r--gui.ml91
1 files changed, 91 insertions, 0 deletions
diff --git a/gui.ml b/gui.ml
new file mode 100644
index 0000000..97063eb
--- /dev/null
+++ b/gui.ml
@@ -0,0 +1,91 @@
+
+type debuglog_type = [`read | `write | `status]
+
+class mainwin () =
+ (* main window layout *)
+ let g_win = GWindow.window ~wm_name:"Serika" ~wm_class:"serika" ~position:`CENTER () in
+ let _ = g_win#connect#destroy GMain.Main.quit in
+ let _ = g_win#set_default_width 640 and _ = g_win#set_default_height 480 in
+ let g_vbox = GPack.vbox ~packing:g_win#add () in
+ let g_tabs = GPack.notebook ~packing:g_vbox#add () in
+
+ (* debug tab *)
+ let g_debug_tbl = GPack.table ~rows:2 ~columns:2 () in
+ let g_debug_scroll = GBin.scrolled_window ~vpolicy:`ALWAYS ~hpolicy:`AUTOMATIC ~packing:(g_debug_tbl#attach ~left:0 ~top:0 ~right:2 ~expand:`BOTH) () in
+ let g_debug = GText.view ~editable:false ~wrap_mode:`CHAR ~packing:g_debug_scroll#add () in
+ let g_debug_cmd = GEdit.entry ~activates_default:true ~packing:(g_debug_tbl#attach ~left:0 ~top:1 ~expand:`X) () in
+ let g_debug_send = GButton.button ~label:"_Send command" ~use_mnemonic:true ~packing:(g_debug_tbl#attach ~left:1 ~top:1 ~expand:`NONE) () in
+ let _ = g_tabs#append_page ~tab_label:((GMisc.label ~text:"Debug" ())#coerce) g_debug_tbl#coerce in
+ let _ = g_debug_cmd#connect#activate (fun () -> ignore (g_debug_send#misc#activate ())) in
+
+ (* status bar *)
+ let g_status = GMisc.statusbar ~packing:(g_vbox#pack ~expand:false) () in
+ let g_statuscontext = g_status#new_context ~name:"Meh" in
+ let g_bandwidth = GMisc.label ~packing:(g_status#pack ~from:`END ~expand:false) ~width:70 ~text:"0.0 kB" () in
+ let g_cmd_count = GMisc.label ~packing:(g_status#pack ~from:`END ~expand:false) ~width:25 ~text:"0" () in
+
+ (* coloring and marking for the debug textview *)
+ let _ = g_debug#buffer#create_tag ~name:"read" [`FOREGROUND "#cc6666"] in
+ let _ = g_debug#buffer#create_tag ~name:"write" [`FOREGROUND "#6666cc"] in
+ let _ = g_debug#buffer#create_tag ~name:"prefix" [`WEIGHT `LIGHT] in
+ let _ = g_debug#buffer#create_mark ~name:"end" ~left_gravity:false g_debug#buffer#end_iter in
+
+ (* the object *)
+ object (self)
+ val mutable bandwidth = 0
+ val mutable cmd_count = 0
+ val mutable laststatusmsg = g_statuscontext#push "Welcome to Serika!"
+
+ method show = g_win#show ()
+
+ method set_debug_docmd f =
+ ignore (g_debug_send#connect#clicked (fun () ->
+ f (g_debug_cmd#text)
+ ))
+
+ method statusmsg str =
+ let msg = g_statuscontext#push str in
+ g_statuscontext#remove laststatusmsg;
+ laststatusmsg <- msg;
+ self#add_debuglog `status str
+
+ method add_bandwidth s =
+ bandwidth <- bandwidth+s;
+ g_bandwidth#set_text (Printf.sprintf "%.1f kB" ((float bandwidth) /. 1024.0))
+
+ method incr_cmd_count =
+ cmd_count <- cmd_count+1;
+ g_cmd_count#set_text (string_of_int cmd_count)
+
+ method add_debuglog (t : debuglog_type) str =
+ let tm = Unix.localtime (Unix.time ()) in
+ let time = Printf.sprintf "[%02d:%02d:%02d] " tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec in
+ let tags, prefix = match t with
+ | `read -> (["read"], "< ")
+ | `write -> (["write"], "> ")
+ | `status -> ([], "= ") in
+ let buf = g_debug#buffer in
+ buf#insert ~iter:buf#end_iter ~tag_names:["prefix"] (time ^ prefix);
+ buf#insert ~iter:buf#end_iter ~tag_names:tags str;
+ buf#insert ~iter:buf#end_iter "\n";
+ g_debug#scroll_mark_onscreen (`NAME "end")
+
+ method set_throttled sec (cb : (unit -> unit)) =
+ let togo = ref sec in
+ g_debug_send#misc#set_sensitive false;
+ let secfunc () =
+ togo := !togo - 1;
+ if !togo < 1 then (
+ g_debug_send#misc#set_sensitive true;
+ cb ();
+ false
+ ) else (
+ g_statuscontext#flash ~delay:1000 ("Throttled. Waiting "
+ ^(string_of_int !togo)^" seconds before continuing...");
+ true
+ )
+ in
+ ignore (GMain.Timeout.add ~ms:1000 ~callback:secfunc)
+
+ end
+