Added login window and made many more changes

We're still in the alpha phase of an experimental program, don't expect
me to properly document my changes. -.-;

3 files changed, 164 insertions, 48 deletions

diff --git a/gui.ml b/gui.ml
index 97063eb..5c1c84c 100644
--- a/gui.ml
+++ b/gui.ml
@@ -1,9 +1,80 @@
 
 type debuglog_type = [`read | `write | `status]
 
+
+
+class loginwin mainwin =
+  (* window & layout *)
+  let g_win = GWindow.window ~modal:true ~type_hint:`DIALOG ~position:`CENTER
+    ~title:"Serika Login" ~border_width:5 ~width:400 ~resizable:false () in
+  let _ = g_win#set_transient_for mainwin in
+  let _ = g_win#set_destroy_with_parent true in
+  let g_hbox = GPack.hbox ~packing:g_win#add () in
+  let _ = GMisc.image ~stock:`DIALOG_AUTHENTICATION ~icon_size:`DIALOG ~yalign:0.2 ~packing:(g_hbox#pack ~expand:false) () in
+  let g_vbox = GPack.vbox ~packing:g_hbox#add () in
+
+  (* input fields *)
+  let g_frm = GPack.table ~rows:3 ~columns:2 ~col_spacings:3 ~packing:g_vbox#add () in
+  let g_frm_ano = GButton.check_button ~label:"Connect anonymously" ~packing:(g_frm#attach ~left:0 ~top:0 ~right:2) () in
+  let g_frm_usr = GEdit.entry ~activates_default:true ~packing:(g_frm#attach ~left:1 ~top:1 ~expand:`NONE) () in
+  let g_frm_ulb = GMisc.label ~text:"Username:" ~xalign:1.0 ~mnemonic_widget:g_frm_usr ~packing:(g_frm#attach ~left:0 ~top:1 ~expand:`NONE) () in
+  let g_frm_pas = GEdit.entry ~activates_default:true ~packing:(g_frm#attach ~left:1 ~top:2 ~expand:`NONE) () in
+  let g_frm_plb = GMisc.label ~text:"Password:" ~xalign:1.0 ~mnemonic_widget:g_frm_pas ~packing:(g_frm#attach ~left:0 ~top:2 ~expand:`NONE) () in
+  let _ = g_frm_pas#set_visibility false in
+
+  (* info part *)
+  let g_nfo     = GPack.hbox ~spacing:5 ~packing:(g_vbox#pack ~expand:false ~padding:5) () in
+  let g_nfo_img = GMisc.image ~stock:`DIALOG_WARNING ~packing:(g_nfo#pack ~expand:false) () in
+  let g_nfo_lbl = GMisc.label ~line_wrap:true ~xalign:0.0 ~packing:(g_nfo#pack ~expand:true) () in
+
+  (* buttons *)
+  let g_but     = GPack.button_box `HORIZONTAL ~spacing:10 ~layout:`END ~packing:(g_vbox#pack ~expand:false) () in
+  let g_but_con = GButton.button ~stock:`CONNECT ~packing:g_but#add () in
+  let g_but_can = GButton.button ~stock:`CANCEL  ~packing:g_but#add () in
+  let _ = g_but_can#connect#clicked g_win#misc#hide in
+  let _ = g_but_con#misc#set_can_default true in
+  let _ = g_but_con#misc#grab_default () in
+
+  (* set user/pass sensitivity *)
+  let _ = g_frm_ano#connect#toggled (fun () ->
+    g_frm_usr#misc#set_sensitive (not g_frm_ano#active);
+    g_frm_ulb#misc#set_sensitive (not g_frm_ano#active);
+    g_frm_pas#misc#set_sensitive (not g_frm_ano#active);
+    g_frm_plb#misc#set_sensitive (not g_frm_ano#active)
+  ) in
+
+  (* the object *)
+  object (self)
+    method private statusmsg img msg =
+      g_nfo_img#set_stock img;
+      g_nfo_lbl#set_text msg
+    method show =
+      if not g_win#misc#visible then (
+        self#statusmsg `DIALOG_WARNING "Note: The application might hang while connecting. Feel free to kill it when it takes too long.";
+        g_frm_usr#misc#grab_focus ();
+        g_win#show ()
+      )
+    method hide = g_win#misc#hide ()
+    method set_on_connect f =
+      ignore (g_but_con#connect#clicked (fun () ->
+        g_but_con#misc#set_sensitive false;
+        g_frm#misc#set_sensitive false;
+        ignore (self#statusmsg `DIALOG_INFO "Connecting...");
+        f g_frm_ano#active g_frm_usr#text g_frm_pas#text
+      ))
+    method set_connected = self#statusmsg `DIALOG_INFO "Connected, logging in..."
+    method failed msg =
+      self#statusmsg `DIALOG_ERROR msg;
+      g_but_con#misc#set_sensitive true;
+      g_frm#misc#set_sensitive true;
+      g_frm_usr#misc#grab_focus ()
+  end
+
+
+
 class mainwin () =
   (* main window layout *)
-  let g_win = GWindow.window ~wm_name:"Serika" ~wm_class:"serika" ~position:`CENTER () in
+  let g_win = GWindow.window ~title:"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
@@ -21,28 +92,52 @@ class mainwin () =
   (* 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
+  let g_bandwidth   = GMisc.label ~packing:(g_status#pack ~from:`END ~expand:false) ~xalign:1.0 ~width:80 ~text:"0.0 kB" () in
+  let g_cmd_count   = GMisc.label ~packing:(g_status#pack ~from:`END ~expand:false) ~xalign:1.0 ~width:30 ~text:"0" () in
+  let g_loggedinusr = GMisc.label ~packing:(g_status#pack ~from:`END ~expand:false) ~xalign:1.0 ~text:"-" () 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_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
 
+  (* login window *)
+  let login = new loginwin g_win#as_window in
+
   (* the object *)
   object (self)
     val mutable bandwidth = 0
     val mutable cmd_count = 0
-    val mutable laststatusmsg = g_statuscontext#push "Welcome to Serika!"
+    val mutable laststatusmsg = g_statuscontext#push "Not connected."
 
-    method show = g_win#show ()
+    method show =
+      self#set_sensitive false;
+      g_win#show ();
+      login#show
 
-    method set_debug_docmd f =
+    method set_on_debug_cmd f =
       ignore (g_debug_send#connect#clicked (fun () ->
         f (g_debug_cmd#text)
       ))
 
+    method login = login
+
+    method set_sensitive b =
+      g_debug_send#misc#set_sensitive b
+
+    method set_loggedin user =
+      login#hide;
+      self#statusmsg "Login successful.";
+      g_loggedinusr#set_text user;
+      self#set_sensitive true
+
+    method set_loggedout () =
+      login#show;
+      self#statusmsg "Not connected.";
+      g_loggedinusr#set_text "-";
+      self#set_sensitive false
+
     method statusmsg str =
       let msg = g_statuscontext#push str in
       g_statuscontext#remove laststatusmsg;
@@ -72,11 +167,11 @@ class mainwin () =
 
     method set_throttled sec (cb : (unit -> unit)) =
       let togo = ref sec in
-      g_debug_send#misc#set_sensitive false;
+      self#set_sensitive false;
       let secfunc () =
         togo := !togo - 1;
         if !togo < 1 then (
-          g_debug_send#misc#set_sensitive true;
+          self#set_sensitive true;
           cb ();
           false
         ) else (
diff --git a/main.ml b/main.ml
index 6bb5313..6f4f9ae 100644
--- a/main.ml
+++ b/main.ml
@@ -9,43 +9,46 @@ let pollfunc sock read cb =
 *)
 
 
-let _ = ignore (GtkMain.Main.init ())
-let win = new Gui.mainwin ()
-let api = new VndbApi.connection
-  (fun sock read cb ->
-    ignore (GMain.Io.add_watch ~cond:[if read then `IN else `OUT]
-      ~callback:(fun _ -> cb (); false) (Glib.Io.channel_of_descr sock)))
-  (fun sec cb -> win#set_throttled (sec+5) cb)
-
-
-let debugline sent str =
-  win#add_debuglog (if sent then `write else `read) str;
-    (Str.replace_first (Str.regexp "\\(\"password\"[\r\n\t ]*:[\r\n\t ]*\"\\)[^\"]+\"") "\\1<secret>\"" str);
-  win#add_bandwidth ((String.length str)+1);
-  if not sent then win#incr_cmd_count
 
+let _ =
+  ignore (GtkMain.Main.init ());
+  let win = new Gui.mainwin () in
+  let api = new VndbApi.connection
+    (fun sock read cb ->
+      ignore (GMain.Io.add_watch ~cond:[if read then `IN else `OUT]
+        ~callback:(fun _ -> cb (); false) (Glib.Io.channel_of_descr sock)))
+    (fun sec cb -> win#set_throttled (sec+5) cb)
+  in
 
-let apiconnected ip port =
-  win#statusmsg ("Connected to " ^ (Unix.string_of_inet_addr ip) ^ ":" ^ (string_of_int port));
-  api#login "user" "pass" (fun r ->
-    match r with
-    | VndbApi.ROK -> win#statusmsg "Login successful."
-    | VndbApi.RError ("auth", msg, _) -> win#statusmsg ("Login failed: "^msg)
-    | _ -> win#statusmsg "Login failed :("
-  )
+  api#set_linefunc (Some (fun sent str ->
+    win#add_debuglog (if sent then `write else `read)
+      (Str.replace_first (Str.regexp "\\(\"password\"[\r\n\t ]*:[\r\n\t ]*\"\\)[^\"]+\"") "\\1<secret>\"" str);
+    win#add_bandwidth ((String.length str)+1);
+    if not sent then win#incr_cmd_count
+  ));
 
+  api#set_disconnectfunc (Some win#set_loggedout);
 
-let _ =
-  win#show;
-  win#statusmsg "Welcome to the Serika Testing Grounds!";
-
-  api#set_linefunc (Some debugline);
-  api#connect apiconnected (fun _ _ msg ->
-    print_endline ("Connection failed: "^msg);
-    exit 1
+  win#login#set_on_connect (fun anon user pass ->
+    api#connect (fun ip port ->
+      win#add_debuglog `status ("Connected to " ^ (Unix.string_of_inet_addr ip) ^ ":" ^ (string_of_int port));
+      win#login#set_connected;
+      let u = if anon = true then VndbApi.Anonymous else VndbApi.User (user, pass) in
+      let du = if anon = true then "Anon" else user in
+      api#login u (fun r ->
+        match r with
+        | VndbApi.ROK -> win#set_loggedin du
+        | VndbApi.RError ("auth", msg, _) ->
+          win#login#failed ("Login failed: "^msg);
+          api#disconnect
+        | _ ->
+          win#login#failed "Login failed for some odd reason. :(";
+          api#disconnect
+      )
+    ) (fun _ _ msg -> win#login#failed ("Connection failed: "^msg))
   );
 
-  win#set_debug_docmd (fun str ->
+  win#set_on_debug_cmd (fun str ->
     win#statusmsg "Executing custom command...";
     api#addcmd str (fun r ->
       win#statusmsg "Custom command finished.";
@@ -58,5 +61,6 @@ let _ =
     )
   );
 
+  win#show;
   GMain.Main.main ()
 
diff --git a/vndbApi.ml b/vndbApi.ml
index dac59d0..713c22b 100644
--- a/vndbApi.ml
+++ b/vndbApi.ml
@@ -9,6 +9,11 @@ type reply =
   | RError of (string * string * Json.json)   (* id, msg, json obj *)
 
 
+type user =
+    Anonymous
+  | User of (string * string)
+
+
 class connection
     (pollfunc : file_descr -> bool -> (unit -> unit) -> unit)
     (waitfunc : int -> (unit -> unit) -> unit)
@@ -18,6 +23,7 @@ class connection
   val mutable s_port = 19534
   val mutable s_addr = (None : inet_addr option)
   val mutable linefunc = (None : (bool -> string -> unit) option)
+  val mutable disconnectfunc = (None : (unit -> unit) option)
   val cmd_queue = (Queue.create () : (string * (reply -> unit)) Queue.t)
   val mutable cmd_running = false
 
@@ -28,6 +34,7 @@ class connection
   method set_port p = s_port <- p
   method get_addr = s_addr
   method set_linefunc f = linefunc <- f
+  method set_disconnectfunc f = disconnectfunc <- f
   method connected = match s_sock with None -> false | Some _ -> true
 
 
@@ -84,6 +91,7 @@ class connection
         (* Not throttled, so consider this command as finished *)
         | _ -> 
           ignore (Queue.pop cmd_queue);
+          cmd_running <- false;
           self#docmd ();
           recvcb preply
       in
@@ -145,14 +153,23 @@ class connection
     | Unix_error (a, b, c) -> failure a b c
 
 
-  method login user pass recvcb =
-    let o = Json.Object [
+  method disconnect =
+    match s_sock with None -> () | Some s -> close s; s_sock <- None;
+    match disconnectfunc with None -> () | Some f -> f ()
+
+
+  method login user recvcb =
+    let cr = match user with
+    | Anonymous   -> []
+    | User (n, p) -> [
+      ("username",  Json.String n);
+      ("password",  Json.String p)
+    ] in
+    let o = Json.Object (cr @ [
       ("protocol",  Json.Int    "1");
       ("client",    Json.String "Serika");
-      ("clientver", Json.Number "0.1");
-      ("username",  Json.String user);
-      ("password",  Json.String pass)
-    ] in
+      ("clientver", Json.Number "0.1")
+    ]) in
     self#addcmd ("login " ^ (Json.string_of_json o)) recvcb
 
 end