Skip to content
This repository
tree: b4eb282066
Fetching contributors…

Octocat-spinner-32-eaf2f5

Cannot retrieve contributors at this time

file 180 lines (146 sloc) 5.1 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179
(*s: main_treemap.ml *)
open Common

(*****************************************************************************)
(* Purpose *)
(*****************************************************************************)

(*****************************************************************************)
(* Flags *)
(*****************************************************************************)

(*s: treemap_viewer flags *)
let algorithm = ref Treemap.Squarified
let big_screen = ref false

let verbose = ref false
(*e: treemap_viewer flags *)

(* action mode *)
let action = ref ""

let version = "0.1"

(*****************************************************************************)
(* Helpers *)
(*****************************************************************************)

let init_graph big_screen =

  let w_view_hint, h_view_hint =
    if big_screen
    then
      2300, 1500
    else
      640, 640
  in
  let h_status = 30 in
  let w_legend = 200 in
  
  Graphics.open_graph
    (spf " %dx%d" (w_view_hint + w_legend) (h_view_hint+ h_status));
  Graphics.set_color (Graphics.rgb 1 1 1);
  let w_view, h_view =
    Graphics.size_x () - w_legend,
    Graphics.size_y () - h_status
  in
  let w, h = Graphics.size_x (), Graphics.size_y () in

  {
    Treemap.w = w;
    h = h;
    w_view = w_view;
    h_view = h_view;
    h_status = h_status;
    w_legend = w_legend;
  }


(*****************************************************************************)
(* Main action *)
(*****************************************************************************)

(*s: function main_action *)
let main_action jsonfile =
  let json = Json_in.load_json jsonfile in
  let treemap = Treemap_json.treemap_of_json json in

  let rendering = Treemap.render_treemap_algo treemap in
  let json = Treemap_json.json_of_treemap_rendering rendering in
  let s = Json_out.string_of_json json in
  pr2 s;

  let dim = init_graph !big_screen in

  Treemap_graphics.display_treemap_interactive
    ~algo:!algorithm
    ~info_of_file_under_cursor:Treemap_graphics.info_of_file_under_cursor_default
    treemap dim
  ;
  ()
(*e: function main_action *)

(*****************************************************************************)
(* The options *)
(*****************************************************************************)

let all_actions () =
 Treemap.actions () ++
 Treemap_json.actions () ++
 []

let options () =
  [
  (*s: treemap_viewer cmdline options *)
      "-algorithm", Arg.String (fun s ->
        algorithm := Treemap.algo_of_s s;
      ),
      (spf " <algo> (choices are: %s, default = %s"
          (Treemap.algos +> List.map Treemap.s_of_algo +> Common.join ", ")
          (Treemap.s_of_algo !algorithm));

      "-big_screen", Arg.Set big_screen,
      " ";
      "-verbose", Arg.Set verbose,
      " ";
  (*e: treemap_viewer cmdline options *)
  ] ++
  Common.options_of_actions action (all_actions()) ++
  Common.cmdline_flags_devel () ++
  Common.cmdline_flags_verbose () ++
  Common.cmdline_flags_other () ++
  [
  "-version", Arg.Unit (fun () ->
    pr2 (spf "ocamltreemap version: %s" version);
    exit 0;
  ),
    " guess what";

  (* this can not be factorized in Common *)
  "-date", Arg.Unit (fun () ->
    pr2 "version: $Date: 2008/10/26 00:44:57 $";
    raise (Common.UnixExit 0)
    ),
  " guess what";
  ] ++
  []

(*****************************************************************************)
(* Main entry point *)
(*****************************************************************************)

let main () =
  let usage_msg =
    "Usage: " ^ Common.basename Sys.argv.(0) ^
      " [options] <json file> " ^ "\n" ^ "Options are:"
  in
  (* does side effect on many global flags *)
  let args = Common.parse_options (options()) usage_msg Sys.argv in

  (* must be done after Arg.parse, because Common.profile is set by it *)
  Common.profile_code "Main total" (fun () ->

    (match args with
   
    (* --------------------------------------------------------- *)
    (* actions, useful to debug subpart *)
    (* --------------------------------------------------------- *)
    | xs when List.mem !action (Common.action_list (all_actions())) ->
        Common.do_action !action xs (all_actions())

    | _ when not (Common.null_string !action) ->
        failwith ("unrecognized action or wrong params: " ^ !action)

    (* --------------------------------------------------------- *)
    (* main entry *)
    (* --------------------------------------------------------- *)
    | [x] ->
        main_action x

    (* --------------------------------------------------------- *)
    (* empty entry *)
    (* --------------------------------------------------------- *)
    | [] ->
        Common.usage usage_msg (options());
        failwith "too few arguments"

    | x::y::xs ->
        Common.usage usage_msg (options());
        failwith "too many arguments"
    )
  )

(*****************************************************************************)
let _ =
  Common.main_boilerplate (fun () ->
      main ();
  )

(*e: main_treemap.ml *)
Something went wrong with that request. Please try again.