src/gtk/newgui/gui_graph.ml

   1 (* Copyright 2001, 2002 b8_bavard, b8_fee_carabine, INRIA *)
   2 (*
   3     This file is part of mldonkey.
   4
   5     mldonkey is free software; you can redistribute it and/or modify
   6     it under the terms of the GNU General Public License as published by
   7     the Free Software Foundation; either version 2 of the License, or
   8     (at your option) any later version.
   9
  10     mldonkey is distributed in the hope that it will be useful,
  11     but WITHOUT ANY WARRANTY; without even the implied warranty of
  12     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13     GNU General Public License for more details.
  14
  15     You should have received a copy of the GNU General Public License
  16     along with mldonkey; if not, write to the Free Software
  17     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  18 *)
  19
  20 (** GUI for graph. *)
  21
  22 open CommonTypes
  23 open GuiProto
  24 open GMain
  25 open GtkBase
  26 open Gtk
  27 open Gdk
  28 open GDraw
  29
  30 module M = Gui_messages
  31 module P = Gpattern
  32 module O = Gui_options
  33
  34 let (!!) = Options.(!!)
  35
  36 let download_timeout = ref 1000
  37 let download_timerID = ref (Timeout.add ~ms:!download_timeout
  38                               ~callback:(fun _ -> true))
  39 let download_rate = ref 0
  40 let download_counter = ref 0
  41 let download_rate_copy = ref 0
  42 let cumulative_download = ref 0.
  43 let download_cumulative_time = ref 0.
  44 let download_time_range = ref 0
  45 let download_rate_range = ref 0
  46
  47 let upload_timeout = ref 1000
  48 let upload_timerID = ref (Timeout.add ~ms:!upload_timeout
  49                             ~callback:(fun _ -> true))
  50 let upload_rate = ref 0
  51 let upload_counter = ref 0
  52 let upload_rate_copy = ref 0
  53 let cumulative_upload = ref 0.
  54 let upload_cumulative_time = ref 0.
  55 let upload_time_range = ref 0
  56 let upload_rate_range = ref 0
  57
  58 let width = ref 0
  59 let height = ref 0
  60
  61 let exposed_downloads_pixmap = ref (None : GDraw.pixmap option)
  62 let exposed_uploads_pixmap = ref (None : GDraw.pixmap option)
  63
  64 let downloads_pixmap = ref (None : string array option)
  65 let uploads_pixmap = ref (None : string array option)
  66 let downloads_pixmap_headers = ref (None : string array option)
  67 let uploads_pixmap_headers = ref (None : string array option)
  68
  69 let color_bg_download = ref "#000000"
  70 let color_bg_upload = ref "#000000"
  71 let color_grid_download = ref "#000000"
  72 let color_grid_upload = ref "#000000"
  73
  74 let font = ref (Gdk.Font.load_fontset !!O.font_graphic)
  75
  76 (* the pixmap headers are treated separately to be more convenient.
  77 they will be merged further with the pixmap "body" when we will
  78 call pixmap_from_xpm_d *)
  79 let set_downloads_pixmap_headers w h col1 col2 =
  80   let header =
  81     Array.create 1 (Printf.sprintf "%d %d 3 1" w h) in
  82   let color_none =
  83     Array.create 1 (Printf.sprintf ". c None") in
  84   let color1 =
  85     Array.create 1 ((Printf.sprintf "a c ") ^ col1) in
  86   let color2 =
  87     Array.create 1 ((Printf.sprintf "b c ") ^ col2) in
  88   downloads_pixmap_headers :=
  89     Some (Array.concat [header;color_none;color1;color2])
  90
  91 let set_uploads_pixmap_headers w h col1 col2 =
  92   let header =
  93     Array.create 1 (Printf.sprintf "%d %d 3 1" w h) in
  94   let color_none =
  95     Array.create 1 (Printf.sprintf ". c None") in
  96   let color1 =
  97     Array.create 1 ((Printf.sprintf "a c ") ^ col1) in
  98   let color2 =
  99     Array.create 1 ((Printf.sprintf "b c ") ^ col2) in
 100   uploads_pixmap_headers :=
 101     Some (Array.concat [header;color_none;color1;color2])
 102
 103 let string_to_time s =
 104   let l = String.length s in
 105   try
 106     match int_of_string (String.sub s 0 (l - 1)) with
 107         (a : int) ->
 108           match (String.sub s (l - 1) 1) with
 109               "s" ->
 110                 int_of_string (String.sub s 0 (l - 1))
 111             | "h" ->
 112                 (int_of_string (String.sub s 0 (l - 1)))
 113                  * 60 * 60
 114             | "d" ->
 115                 (int_of_string (String.sub s 0 (l - 1)))
 116                  * 60 * 60 * 24
 117             | "w" ->
 118                 (int_of_string (String.sub s 0 (l - 1)))
 119                  * 60 * 60 * 24 * 7
 120             | _ -> 15 * 60
 121   with
 122     | _ -> try
 123       match int_of_string (String.sub s 0 (l - 2)) with
 124           (a : int) ->
 125             match (String.sub s (l - 2) 2) with
 126                 "mn" ->
 127                   (int_of_string (String.sub s 0 (l - 2))) * 60
 128               | _ -> 15 * 60
 129            with
 130              | _ -> 15 * 60
 131
 132 (* the functions draw_downloads & draw uploads are called to generate the
 133 arrays that will be used to get the pixmaps with pixmap_from_xpm_d *)
 134 let draw_downloads _ =
 135   let () = match !download_counter with
 136                0 ->
 137                  cumulative_download := !cumulative_download
 138              | _ ->
 139                cumulative_download :=
 140                  !cumulative_download +.
 141                  ((float_of_int (!download_rate) /. 1024.)
 142                  /. float_of_int (!download_counter)
 143                  *. (float_of_int (!download_timeout) /. 1000.))
 144   in
 145   let downloads_height =
 146     match !download_counter with
 147         0 ->
 148           int_of_float (float_of_int (!height)
 149           *. (float_of_int (!download_rate_copy) /. 1024.)
 150           /. (float_of_int (!download_rate_range) *. 1.2))
 151       | _ ->
 152         let h = int_of_float (float_of_int (!height)
 153                 *. (float_of_int (!download_rate) /. 1024.)
 154                 /. float_of_int (!download_counter)
 155                 /. (float_of_int (!download_rate_range) *. 1.2))
 156         in
 157         download_rate_copy := !download_rate / !download_counter;
 158         download_rate := 0;
 159         download_counter := 0;
 160         h
 161   in
 162   let downloads_av_height =
 163     if !download_cumulative_time = 0.
 164       then 0
 165       else int_of_float (float_of_int (!height)
 166            *. !cumulative_download
 167            /. (float_of_int (!download_rate_range) *. 1.2)
 168            /. !download_cumulative_time)
 169   in
 170   match !downloads_pixmap with
 171       None -> ()
 172     | Some sa ->
 173         let f i s =
 174           if (i = (!height - 1 - downloads_av_height)) ||
 175              (i = (!height - 2 - downloads_av_height))
 176             then (String.sub s 1 ((String.length s) - 1)) ^ "b"
 177             else if i < (!height - 1 - downloads_height)
 178               then (String.sub s 1 ((String.length s) - 1)) ^ "."
 179               else (String.sub s 1 ((String.length s) - 1)) ^ "a"
 180         in
 181         Array.iteri (fun i -> fun s -> sa.(i) <- f i s ) sa
 182
 183
 184 let draw_uploads _ =
 185   let () = match !upload_counter with
 186                0 ->
 187                  cumulative_upload := !cumulative_upload
 188              | _ ->
 189                cumulative_upload :=
 190                  !cumulative_upload +.
 191                  ((float_of_int (!upload_rate) /. 1024.)
 192                  /. float_of_int (!upload_counter)
 193                  *. (float_of_int (!upload_timeout) /. 1000.))
 194   in
 195   let uploads_height =
 196     match !upload_counter with
 197         0 ->
 198           int_of_float (float_of_int (!height)
 199           *. (float_of_int (!upload_rate_copy) /. 1024.)
 200           /. (float_of_int (!upload_rate_range) *. 1.2))
 201       | _ ->
 202         let h = int_of_float (float_of_int (!height)
 203                 *. (float_of_int (!upload_rate) /. 1024.)
 204                 /. float_of_int (!upload_counter)
 205                 /. (float_of_int (!upload_rate_range) *. 1.2))
 206         in
 207         upload_rate_copy := !upload_rate / !upload_counter;
 208         upload_rate := 0;
 209         upload_counter := 0;
 210         h
 211   in
 212   let uploads_av_height =
 213     if !upload_cumulative_time = 0.
 214       then 0
 215       else int_of_float (float_of_int (!height)
 216            *. !cumulative_upload
 217            /. (float_of_int (!upload_rate_range) *. 1.2)
 218            /. !upload_cumulative_time)
 219   in
 220   match !uploads_pixmap with
 221       None -> ()
 222     | Some sa ->
 223         let f i s =
 224            if i = (!height - 1 - uploads_av_height) ||
 225               i = (!height - 2 - uploads_av_height)
 226              then (String.sub s 1 ((String.length s) - 1)) ^ "b"
 227              else if i < (!height - 1 - uploads_height)
 228                then (String.sub s 1 ((String.length s) - 1)) ^ "."
 229                else (String.sub s 1 ((String.length s) - 1)) ^ "a"
 230         in
 231         Array.iteri (fun i -> fun s -> sa.(i) <- f i s ) sa
 232
 233 (* draw_downloads_graph & draw_uploads_graph are called to generate the final
 234 pixmaps merging :
 235 1 pixmap for the background
 236 1 pixmap for the grid
 237 1 pixmap for graph
 238 With this structure we can manage all the colors & font without resetting
 239 the whole pixmap which is finally exposed in the graph tab
 240 *)
 241 let draw_downloads_graph _ =
 242   let grid_pixmap =
 243     GDraw.pixmap ~width:!width ~height:!height
 244     ~mask:true ()
 245   in
 246   grid_pixmap#set_foreground (`NAME !color_grid_download);
 247   let x_step = (!width / 50) in
 248   let y_step = (!height / 50) in
 249   let x_step =
 250     if x_step > y_step then
 251       x_step
 252       else y_step
 253   in
 254   let _ =
 255     for i = 0 to x_step do
 256       let a = (i * 50) in
 257       grid_pixmap#line
 258         ~x:a ~y:0 ~x:a ~y:!height;
 259       grid_pixmap#line
 260         ~x:0 ~y:(!height - a - 1) ~x:!width ~y:(!height - a - 1);
 261       grid_pixmap#string
 262         (Date.time_to_string (a * !download_timeout / 1000) "long")
 263          ~font:!font ~x:(a + 2) ~y:(!height - 2);
 264       if a > 0 then
 265         grid_pixmap#string
 266           (Printf.sprintf "%5.1f ko/s"
 267              (float_of_int (!download_rate_range) *. 1.2
 268               *. float_of_int (a) /. float_of_int (!height)))
 269           ~font:!font ~x:2 ~y:(!height - (a + 2))
 270     done
 271   in
 272   let transit_pixmap =
 273     GDraw.pixmap ~width:!width ~height:!height
 274     ~mask:false ()
 275   in
 276   transit_pixmap#set_foreground
 277     (`NAME !color_bg_download);
 278   transit_pixmap#rectangle
 279     ~filled:true
 280     ~x:0 ~y:0
 281     ~width:!width ~height:!height ();
 282   let () =
 283     match (!downloads_pixmap_headers,!downloads_pixmap) with
 284         (Some sa1, Some sa2) ->
 285            let pixmap =
 286              pixmap_from_xpm_d
 287                ~data:(Array.concat [sa1;sa2])
 288                ~colormap:(Gdk.Color.get_system_colormap ()) ()
 289            in
 290            let () =
 291              match pixmap#mask with
 292                  Some m ->
 293                    transit_pixmap#set_clip_origin ~x:0 ~y:0;
 294                    transit_pixmap#set_clip_mask m
 295                | None -> ()
 296            in
 297            transit_pixmap#put_pixmap
 298              ~x:0 ~y:0 ~xsrc:0 ~ysrc:0
 299              ~width:!width ~height:!height
 300              pixmap#pixmap
 301       | _ -> ()
 302   in
 303   let _ =
 304     match grid_pixmap#mask with
 305         Some m ->
 306           transit_pixmap#set_clip_origin ~x:0 ~y:0;
 307           transit_pixmap#set_clip_mask m
 308       | None -> ()
 309   in
 310   transit_pixmap#put_pixmap
 311     ~x:0 ~y:0 ~xsrc:0 ~ysrc:0
 312     ~width:!width ~height:!height
 313     grid_pixmap#pixmap;
 314   match !exposed_downloads_pixmap with
 315       Some pixmap ->
 316         pixmap#put_pixmap
 317           ~x:0 ~y:0 ~xsrc:0 ~ysrc:0
 318           ~width:!width ~height:!height
 319           transit_pixmap#pixmap
 320     | None ->
 321        let pixmap =
 322          GDraw.pixmap ~width:!width ~height:!height
 323          ~mask:false ()
 324        in
 325        pixmap#put_pixmap
 326          ~x:0 ~y:0 ~xsrc:0 ~ysrc:0
 327          ~width:!width ~height:!height
 328          transit_pixmap#pixmap;
 329        exposed_downloads_pixmap := Some pixmap
 330
 331
 332 let draw_uploads_graph _ =
 333   let grid_pixmap =
 334     GDraw.pixmap ~width:!width ~height:!height
 335     ~mask:true ()
 336   in
 337   grid_pixmap#set_foreground
 338     (`NAME !color_grid_upload);
 339   let x_step = (!width / 50) in
 340   let y_step = (!height / 50) in
 341   let x_step =
 342     if x_step > y_step then
 343       x_step
 344       else y_step
 345   in
 346   let _ =
 347     for i = 0 to x_step do
 348       let a = (i * 50) in
 349       grid_pixmap#line
 350         ~x:a ~y:0 ~x:a ~y:!height;
 351       grid_pixmap#line
 352         ~x:0 ~y:(!height - a - 1) ~x:!width ~y:(!height - a - 1);
 353       grid_pixmap#string
 354         (Date.time_to_string (a * !upload_timeout / 1000) "long")
 355         ~font:!font ~x:(a + 2) ~y:(!height - 2);
 356       if a > 0 then
 357         grid_pixmap#string
 358           (Printf.sprintf "%5.1f ko/s"
 359             (float_of_int (!upload_rate_range) *. 1.2
 360              *. float_of_int (a) /. float_of_int (!height)))
 361           ~font:!font ~x:2 ~y:(!height - (a + 2))
 362     done
 363   in
 364   let transit_pixmap =
 365     GDraw.pixmap ~width:!width ~height:!height
 366     ~mask:false ()
 367   in
 368   transit_pixmap#set_foreground
 369     (`NAME !color_bg_upload);
 370   transit_pixmap#rectangle
 371     ~filled:true ~x:0 ~y:0
 372     ~width:!width ~height:!height ();
 373   let () =
 374     match (!uploads_pixmap_headers, !uploads_pixmap) with
 375        (Some sa1, Some sa2) ->
 376          let pixmap =
 377            pixmap_from_xpm_d
 378              ~data:(Array.concat [sa1; sa2])
 379              ~colormap:(Gdk.Color.get_system_colormap ()) ()
 380          in
 381          let () =
 382            match pixmap#mask with
 383                Some m ->
 384                  transit_pixmap#set_clip_origin ~x:0 ~y:0;
 385                  transit_pixmap#set_clip_mask m
 386              | None -> ()
 387          in
 388          transit_pixmap#put_pixmap
 389            ~x:0 ~y:0 ~xsrc:0 ~ysrc:0
 390            ~width:!width ~height:!height
 391            pixmap#pixmap
 392      | _ -> ()
 393   in
 394   let _ =
 395     match grid_pixmap#mask with
 396         Some m ->
 397           transit_pixmap#set_clip_origin ~x:0 ~y:0;
 398           transit_pixmap#set_clip_mask m
 399       | None -> ()
 400   in
 401   transit_pixmap#put_pixmap
 402     ~x:0 ~y:0 ~xsrc:0 ~ysrc:0
 403     ~width:!width ~height:!height
 404     grid_pixmap#pixmap;
 405   match !exposed_uploads_pixmap with
 406       Some pixmap ->
 407         pixmap#put_pixmap
 408           ~x:0 ~y:0 ~xsrc:0 ~ysrc:0
 409           ~width:!width ~height:!height
 410           transit_pixmap#pixmap
 411     | None ->
 412         let pixmap =
 413           GDraw.pixmap ~width:!width ~height:!height
 414           ~mask:false ()
 415         in
 416         pixmap#put_pixmap
 417           ~x:0 ~y:0 ~xsrc:0 ~ysrc:0
 418           ~width:!width ~height:!height
 419           transit_pixmap#pixmap;
 420         exposed_uploads_pixmap := Some pixmap
 421
 422
 423 let expose_pixmap area pixmap =
 424   let drawing =
 425     (area#misc#realize ();
 426      new GDraw.drawable (area#misc#window))
 427   in
 428   match pixmap with
 429       Some pix ->
 430         drawing#put_pixmap
 431           ~x:0 ~y:0 ~xsrc:0 ~ysrc:0
 432           ~width:!width ~height:!height
 433           pix#pixmap
 434     | None -> ()
 435
 436
 437
 438 class box () =
 439   let hbox_down = GPack.hbox ~border_width:10 ~homogeneous:true () in
 440   let hbox_up = GPack.hbox ~border_width:10 ~homogeneous:true () in
 441   let downloads_area = GMisc.drawing_area () in
 442   let uploads_area = GMisc.drawing_area ()
 443   in
 444   object (self)
 445     inherit Gui_graph_base.box () as box
 446
 447     method clear =
 448       download_rate_copy := 0;
 449       upload_rate_copy := 0
 450
 451     method set_download_rate r =
 452       incr (download_counter);
 453       download_rate := (r  + !download_rate)
 454
 455
 456     method set_upload_rate r =
 457       incr (upload_counter);
 458       upload_rate := (r + !upload_rate)
 459
 460
 461     method set_graph_properties
 462       gfont cbd cbu cgd cgu cfd
 463       cfu cfda cfua dtr mdr utr mur =
 464       (* Printf.printf "GRAPH PROPERTIES\n%s %s %s %s\n%s %s %s %s\n"
 465         cbd cbu cgd cgu cfd cfu cfda cfua;
 466       flush stdout;
 467       Printf.printf "%s %d - %s %d\n************\n" dtr mdr utr mur;
 468       flush stdout; *)
 469       font := Gdk.Font.load_fontset gfont ;
 470       color_bg_download := cbd;
 471       color_bg_upload := cbu;
 472       color_grid_download := cgd;
 473       color_grid_upload := cgu;
 474       let drawing = (downloads_area#misc#realize ();
 475                      new GDraw.drawable (downloads_area#misc#window))
 476       in
 477       (* not to mess the drawing areas when the main window is resized
 478       we fix the width & height of each area once for all. The size will
 479       be the size when the gui is started *)
 480       let (w, h) = drawing#size in
 481       if !width = 0 then width := w ;
 482       if !height = 0 then height := h ;
 483       (* Printf.printf "Width : %d Height : %d\n" !width !height;
 484       flush stdout; *)
 485       (* to get the possibility to change the colors of the all parts
 486       of the graph, the pixmaps headers are managed separately (i.e. where
 487       colors map is defined in the pixmap array ) - Like this it is not
 488       necessary to reset the graph when such a change is done in the config panel *)
 489       set_downloads_pixmap_headers !width !height cfd cfda;
 490       set_uploads_pixmap_headers !width !height cfu cfua;
 491       let (a, b) = (!download_time_range, !download_rate_range) in
 492       let (c, d) = ((string_to_time dtr), mdr) in
 493       (* Printf.printf "Download_time_range : %d Download_rate_range : %d\n%d %d\n"
 494         a b c d;
 495       flush stdout; *)
 496       (* we check if it is necessary to reset the pixmap. Only in 2 cases :
 497       when the time range is changed (x axis)
 498       when the max down/upload rate is changed (y axis) *)
 499       let () = if (a, b) <> (c, d) then begin
 500           download_time_range := c;
 501           download_rate_range := d;
 502           download_timeout := (!download_time_range * 1000 / !width );
 503           downloads_pixmap :=
 504             Some (Array.create !height (String.make !width '.')) (*;
 505           Printf.printf "DOWNLOADS GRAPH PROPERTIES HAVE CHANGED\ndownload_timeout : %d\n"
 506             !download_timeout;
 507           flush stdout*)
 508           end
 509       in
 510       let (a, b) = (!upload_time_range, !upload_rate_range) in
 511       let (c, d) = ((string_to_time utr), mur) in
 512       (* Printf.printf "Upload_time_range : %d Upload_rate_range : %d\n%d %d\n" a b c d;
 513       flush stdout;*)
 514       let () = if (a, b) <> (c, d) then begin
 515           upload_time_range := c;
 516           upload_rate_range := d;
 517           upload_timeout := (!upload_time_range * 1000 / !width );
 518           uploads_pixmap :=
 519             Some (Array.create !height (String.make !width '.')) (*;
 520           Printf.printf "UPLOADS GRAPH PROPERTIES HAVE CHANGED\nupload_timeout : %d\n"
 521             !upload_timeout;
 522           flush stdout*)
 523           end
 524       in
 525       (* we check if the pixmaps are existing. If yes we do noting, else
 526       we create it. In the pixmaps headers '.' is defined as the None color.
 527       It is necessary because we use this method at the start but also each
 528       time we use the config panel *)
 529       let () =
 530         match !downloads_pixmap with
 531             None ->
 532               downloads_pixmap :=
 533                 Some (Array.create !height (String.make !width '.'));
 534           | _ -> ()
 535       in
 536       let () =
 537         match !uploads_pixmap with
 538             None ->
 539               uploads_pixmap :=
 540                 Some (Array.create !height (String.make !width '.'));
 541           | _ -> ()
 542       in
 543       draw_downloads ();
 544       draw_downloads_graph ();
 545       draw_uploads ();
 546       draw_uploads_graph ();
 547       (* here we need to reset the timers in case the x axis as changed *)
 548       Timeout.remove (!download_timerID);
 549       download_timerID :=
 550         (Timeout.add ~ms:!download_timeout
 551            ~callback:(fun _ ->
 552              download_cumulative_time := !download_cumulative_time
 553                +. ((float_of_int !download_timeout) /. 1000.);
 554              draw_downloads ();
 555              draw_downloads_graph ();
 556              expose_pixmap downloads_area !exposed_downloads_pixmap;
 557              true));
 558       Timeout.remove (!upload_timerID);
 559       upload_timerID :=
 560         (Timeout.add ~ms:!upload_timeout
 561            ~callback:(fun _ ->
 562              upload_cumulative_time := !upload_cumulative_time
 563                +. ((float_of_int !upload_timeout) /. 1000.);
 564              draw_uploads ();
 565              draw_uploads_graph ();
 566              expose_pixmap uploads_area !exposed_uploads_pixmap;
 567              true))
 568
 569     initializer
 570
 571     hbox_down#add downloads_area#coerce;
 572     downloads_frame#add hbox_down#coerce;
 573     hbox_up#add uploads_area#coerce;
 574     uploads_frame#add hbox_up#coerce;
 575
 576     ignore (downloads_area#event#connect#expose
 577       (fun _ ->
 578                 expose_pixmap downloads_area !exposed_downloads_pixmap;
 579                 true));
 580     ignore (uploads_area#event#connect#expose
 581       (fun _ ->
 582                 expose_pixmap uploads_area !exposed_uploads_pixmap;
 583                 true))
 584
 585   end