remove pango dep of layout and move it back in ocamlgraph

tbrk · May 3, 2020 · 4f6e145 · 4f6e145
1 parent 0717d33
commit 4f6e145
Show file tree

Hide file tree

Showing 19 changed files with 78 additions and 80 deletions.
diff --git a/dgraph/dGraphContainer.ml b/dgraph/dGraphContainer.ml
@@ -3,7 +3,7 @@
 (*  This file is part of OcamlGraph.                                      *)
 (*                                                                        *)
 (*  Copyright (C) 2009-2010                                               *)
-(*    CEA (Commissariat à l'Énergie Atomique)                             *)
+(*    CEA (Commissariat � l'�nergie Atomique)                             *)
 (*                                                                        *)
 (*  you can redistribute it and/or modify it under the terms of the GNU   *)
 (*  Lesser General Public License as published by the Free Software       *)
@@ -394,8 +394,10 @@ module Make(G: Graphviz.GraphWithDotAttrs) = struct
       ~status
       ~mk_global_view:(fun () -> mk_global_view (GlobalModel.from_graph g))
       ~mk_tree_view:(fun ~depth_backward ~depth_forward w v ->
+          let context = GtkBase.Widget.create_pango_context w in
+          let fontMeasure = PangoMeasure.withContext ~context in
           let model =
-            FullTreeModel.from_graph ~depth_forward ~depth_backward w g v
+            FullTreeModel.from_graph ~depth_forward ~depth_backward ~fontMeasure g v
           in
           mk_tree_view model)
       root

diff --git a/dgraph/dGraphViewItem.ml b/dgraph/dGraphViewItem.ml
@@ -3,7 +3,7 @@
 (*  This file is part of OcamlGraph.                                      *)
 (*                                                                        *)
 (*  Copyright (C) 2009-2010                                               *)
-(*    CEA (Commissariat à l'Énergie Atomique)                             *)
+(*    CEA (Commissariat � l'�nergie Atomique)                             *)
 (*                                                                        *)
 (*  you can redistribute it and/or modify it under the terms of the GNU   *)
 (*  Lesser General Public License as published by the Free Software       *)
@@ -289,7 +289,9 @@ let text draw_st group (x,y) _align anchor label =
   let anchor =
     if anchor = -. 1. then `WEST else if anchor = 1.0 then `EAST else `CENTER
   in
-  let size_points,height = XDotDraw.string_scale_size font size_points label
+  let size_points,height = XDotDraw.string_scale_size
+    ~fontMeasure:(PangoMeasure.withContext ~context:(Gdk.Screen.get_pango_context ()))
+    font size_points label
   in
   (* y-height/4 because the base line of the text is 1/4th from the bottom *)
   graph_text

diff --git a/dgraph/pangoMeasure.ml b/dgraph/pangoMeasure.ml
@@ -0,0 +1,9 @@
+let withContext ~context ~fontName ~fontSize text =
+  let font_description = Pango.Font.from_string fontName in
+  Pango.Font.modify font_description
+    ~size:(fontSize * Pango.scale)
+    ();
+  Pango.Context.set_font_description context font_description;
+  let layout = Pango.Layout.create context in
+  Pango.Layout.set_text layout text;
+  Pango.Layout.get_pixel_size layout
diff --git a/dgraph/pangoMeasure.mli b/dgraph/pangoMeasure.mli
@@ -0,0 +1 @@
+val withContext : context:Pango.context -> fontName:string -> fontSize:int -> string -> int * int
diff --git a/dgraph/dGraphModel.ml → src/dGraphModel.ml b/dgraph/dGraphModel.ml → src/dGraphModel.ml
@@ -25,7 +25,6 @@
 
 (* This graph model is for now immutable, no adding or removing nodes. *)
 
-open Graph
 open XDot
 
 exception DotError of string

diff --git a/dgraph/dGraphModel.mli → src/dGraphModel.mli b/dgraph/dGraphModel.mli → src/dGraphModel.mli
@@ -3,7 +3,7 @@
 (*  This file is part of OcamlGraph.                                      *)
 (*                                                                        *)
 (*  Copyright (C) 2009-2010                                               *)
-(*    CEA (Commissariat à l'Énergie Atomique)                             *)
+(*    CEA (Commissariat � l'�nergie Atomique)                             *)
 (*                                                                        *)
 (*  you can redistribute it and/or modify it under the terms of the GNU   *)
 (*  Lesser General Public License as published by the Free Software       *)
@@ -26,7 +26,6 @@
 (** Abstract graph model *)
 
 open XDot
-open Graph
 
 exception DotError of string
 
@@ -63,7 +62,7 @@ class type ['vertex, 'edge, 'cluster] abstract_model = object
 end
 
 (** This functor creates a model from a graph *)
-module Make(G : Graph.Graphviz.GraphWithDotAttrs) : sig
+module Make(G : Graphviz.GraphWithDotAttrs) : sig
 
   type cluster = string
   exception Multiple_layouts of (G.E.t * edge_layout) list

diff --git a/dgraph/dGraphRandModel.ml → src/dGraphRandModel.ml b/dgraph/dGraphRandModel.ml → src/dGraphRandModel.ml
@@ -23,8 +23,6 @@
 (*                                                                        *)
 (**************************************************************************)
 
-open Graph
-
 let element = function
   | [] -> invalid_arg "empty list in element"
   | l -> 

diff --git a/dgraph/dGraphRandModel.mli → src/dGraphRandModel.mli b/dgraph/dGraphRandModel.mli → src/dGraphRandModel.mli
@@ -3,7 +3,7 @@
 (*  This file is part of OcamlGraph.                                      *)
 (*                                                                        *)
 (*  Copyright (C) 2009-2010                                               *)
-(*    CEA (Commissariat à l'Énergie Atomique)                             *)
+(*    CEA (Commissariat � l'�nergie Atomique)                             *)
 (*                                                                        *)
 (*  you can redistribute it and/or modify it under the terms of the GNU   *)
 (*  Lesser General Public License as published by the Free Software       *)
@@ -23,10 +23,10 @@
 (*                                                                        *)
 (**************************************************************************)
 
-module G: Graph.Sig.G
+module G: Sig.G
 
 module GraphAttrs: 
-  Graph.Graphviz.GraphWithDotAttrs with type t = G.t
+  Graphviz.GraphWithDotAttrs with type t = G.t
                                     and type V.t = G.V.t
                                     and type E.t = G.E.t
 

diff --git a/dgraph/dGraphSubTree.ml → src/dGraphSubTree.ml b/dgraph/dGraphSubTree.ml → src/dGraphSubTree.ml
@@ -3,7 +3,7 @@
 (*  This file is part of OcamlGraph.                                      *)
 (*                                                                        *)
 (*  Copyright (C) 2009-2010                                               *)
-(*    CEA (Commissariat à l'Énergie Atomique)                             *)
+(*    CEA (Commissariat � l'�nergie Atomique)                             *)
 (*                                                                        *)
 (*  you can redistribute it and/or modify it under the terms of the GNU   *)
 (*  Lesser General Public License as published by the Free Software       *)
@@ -23,8 +23,6 @@
 (*                                                                        *)
 (**************************************************************************)
 
-open Graph
-
 module type G = sig
   type t
   module V : sig
@@ -253,6 +251,7 @@ struct
      Queue.add (root, 0) q;
      loop ()
   *)
+
   (** Build a tree graph centered on a vertex and containing its
       predecessors and successors *)
   let make src_graph src_vertex depth_forward depth_backward =

diff --git a/dgraph/dGraphSubTree.mli → src/dGraphSubTree.mli b/dgraph/dGraphSubTree.mli → src/dGraphSubTree.mli
@@ -3,7 +3,7 @@
 (*  This file is part of OcamlGraph.                                      *)
 (*                                                                        *)
 (*  Copyright (C) 2009-2010                                               *)
-(*    CEA (Commissariat à l'Énergie Atomique)                             *)
+(*    CEA (Commissariat � l'�nergie Atomique)                             *)
 (*                                                                        *)
 (*  you can redistribute it and/or modify it under the terms of the GNU   *)
 (*  Lesser General Public License as published by the Free Software       *)
@@ -23,8 +23,6 @@
 (*                                                                        *)
 (**************************************************************************)
 
-open Graph
-
 module type G = sig
   type t
   module V : sig

diff --git a/dgraph/dGraphTreeLayout.ml → src/dGraphTreeLayout.ml b/dgraph/dGraphTreeLayout.ml → src/dGraphTreeLayout.ml
@@ -3,7 +3,7 @@
 (*  This file is part of OcamlGraph.                                      *)
 (*                                                                        *)
 (*  Copyright (C) 2009-2010                                               *)
-(*    CEA (Commissariat à l'Énergie Atomique)                             *)
+(*    CEA (Commissariat � l'�nergie Atomique)                             *)
 (*                                                                        *)
 (*  you can redistribute it and/or modify it under the terms of the GNU   *)
 (*  Lesser General Public License as published by the Free Software       *)
@@ -23,8 +23,6 @@
 (*                                                                        *)
 (**************************************************************************)
 
-open Graph
-
 let set_if_none field value = match field with
   | None -> Some value
   | Some a -> Some a
@@ -307,38 +305,26 @@ struct
 
   (* Calculate dimension of a string in pixel *)
   let calc_dimensions
-      family
+      ~fontMeasure
+      font
       ptsize
-      ?(weight=`NORMAL)
-      ?(style=`NORMAL)
       s
-      context_obj
     =
     let width_margin = 20. in
     let height_margin = 0. in
-    let font_description = Pango.Font.from_string "" in
-    Pango.Font.modify font_description
-      ~family:family
-      ~weight
-      ~style
-      ~size:(ptsize * Pango.scale)
-      ();
-    let context = GtkBase.Widget.create_pango_context context_obj in
-    Pango.Context.set_font_description context font_description;
-    let layout = Pango.Layout.create context in
-    Pango.Layout.set_text layout s;
-    let width, height = Pango.Layout.get_pixel_size layout in
+    let width, height = fontMeasure ~fontName:font ~fontSize:ptsize s in
     float width +. width_margin, float height +. height_margin
 
-  let fill_dimensions context tree vattributes geometry_info =
+  let fill_dimensions ~fontMeasure tree vattributes geometry_info =
     let add_vertex_dimensions v =
       let vattrs = try HV.find vattributes v with Not_found -> assert false in
       let minwidth, minheight = the vattrs.width, the vattrs.height in
       let truewidth, trueheight =
         calc_dimensions
+          ~fontMeasure
           (the vattrs.fontname)
           (the vattrs.fontsize)
-          (the vattrs.label) context
+          (the vattrs.label)
       in
       let width = max minwidth truewidth in
       let height = max minheight trueheight in
@@ -600,7 +586,7 @@ struct
     }
 
   (* Graph *)
-  let from_tree context tree root =
+  let from_tree ~fontMeasure tree root =
     let vattributes = HV.create 97 in
     fill_vattributes tree vattributes;
     let geometry_info =
@@ -609,7 +595,7 @@ struct
         x_offset = 0.;
         y_offset = 0 }
     in
-    fill_dimensions context tree vattributes geometry_info;
+    fill_dimensions ~fontMeasure tree vattributes geometry_info;
     set_offset geometry_info;
     fill_position tree root geometry_info;
 

diff --git a/dgraph/dGraphTreeLayout.mli → src/dGraphTreeLayout.mli b/dgraph/dGraphTreeLayout.mli → src/dGraphTreeLayout.mli
@@ -3,7 +3,7 @@
 (*  This file is part of OcamlGraph.                                      *)
 (*                                                                        *)
 (*  Copyright (C) 2009-2010                                               *)
-(*    CEA (Commissariat à l'Énergie Atomique)                             *)
+(*    CEA (Commissariat � l'�nergie Atomique)                             *)
 (*                                                                        *)
 (*  you can redistribute it and/or modify it under the terms of the GNU   *)
 (*  Lesser General Public License as published by the Free Software       *)
@@ -23,8 +23,6 @@
 (*                                                                        *)
 (**************************************************************************)
 
-open Graph
-
 type cluster = string
 
 module Make
@@ -33,7 +31,9 @@ module Make
 sig
 
   val from_tree:
-    [> `widget] Gtk.obj -> Tree.t -> Tree.V.t -> XDot.Make(Tree).graph_layout
+    fontMeasure:(
+      fontName:string -> fontSize:int -> string -> int * int
+    ) -> Tree.t -> Tree.V.t -> XDot.Make(Tree).graph_layout
 
 end
 

diff --git a/dgraph/dGraphTreeModel.ml → src/dGraphTreeModel.ml b/dgraph/dGraphTreeModel.ml → src/dGraphTreeModel.ml
@@ -3,7 +3,7 @@
 (*  This file is part of OcamlGraph.                                      *)
 (*                                                                        *)
 (*  Copyright (C) 2009-2010                                               *)
-(*    CEA (Commissariat à l'Énergie Atomique)                             *)
+(*    CEA (Commissariat � l'�nergie Atomique)                             *)
 (*                                                                        *)
 (*  you can redistribute it and/or modify it under the terms of the GNU   *)
 (*  Lesser General Public License as published by the Free Software       *)
@@ -23,8 +23,6 @@
 (*                                                                        *)
 (**************************************************************************)
 
-open Graph
-
 module type S = sig
 
   module Tree: Graphviz.GraphWithDotAttrs
@@ -208,7 +206,7 @@ module SubTreeMake(G: Graphviz.GraphWithDotAttrs) = struct
   let from_graph
       ?(depth_forward=2)
       ?(depth_backward=2)
-      context
+      ~fontMeasure
       g
       v
     =
@@ -217,7 +215,7 @@ module SubTreeMake(G: Graphviz.GraphWithDotAttrs) = struct
     tree_ref := Some t;
     graph_ref := Some g;
     let layout =
-      TreeLayout.from_tree context (TM.get_structure t) (TM.get_root t)
+      TreeLayout.from_tree ~fontMeasure (TM.get_structure t) (TM.get_root t)
     in
     new tree_model layout t
 

diff --git a/dgraph/dGraphTreeModel.mli → src/dGraphTreeModel.mli b/dgraph/dGraphTreeModel.mli → src/dGraphTreeModel.mli
@@ -3,7 +3,7 @@
 (*  This file is part of OcamlGraph.                                      *)
 (*                                                                        *)
 (*  Copyright (C) 2009-2010                                               *)
-(*    CEA (Commissariat à l'Énergie Atomique)                             *)
+(*    CEA (Commissariat � l'�nergie Atomique)                             *)
 (*                                                                        *)
 (*  you can redistribute it and/or modify it under the terms of the GNU   *)
 (*  Lesser General Public License as published by the Free Software       *)
@@ -25,7 +25,7 @@
 
 module type S = sig
 
-  module Tree: Graph.Graphviz.GraphWithDotAttrs
+  module Tree: Graphviz.GraphWithDotAttrs
 
   module TreeManipulation : sig
     type t
@@ -49,13 +49,15 @@ module type S = sig
 end
 
 (** This functor creates a model centered on a vertex from a graph *)
-module SubTreeMake(G : Graph.Graphviz.GraphWithDotAttrs) : sig
+module SubTreeMake(G : Graphviz.GraphWithDotAttrs) : sig
 
   include S with type Tree.V.label = G.V.t
 
   val from_graph :
     ?depth_forward:int -> ?depth_backward:int ->
-    [> `widget] Gtk.obj -> G.t -> G.V.t -> tree_model
+    fontMeasure:(
+      fontName:string -> fontSize:int -> string -> int * int
+    ) -> G.t -> G.V.t -> tree_model
 
 end
 

diff --git a/src/graph.ml b/src/graph.ml
@@ -37,4 +37,11 @@ module Merge = Merge
 module Mincut = Mincut
 module Clique = Clique
 module WeakTopological = WeakTopological
-module ChaoticIteration = ChaoticIteration
+module ChaoticIteration = ChaoticIteration
+module XDotDraw = XDotDraw
+module XDot = XDot
+module DGraphModel = DGraphModel
+module DGraphTreeLayout = DGraphTreeLayout
+module DGraphSubTree = DGraphSubTree
+module DGraphTreeModel = DGraphTreeModel
+module DGraphRandModel = DGraphRandModel
diff --git a/dgraph/xDot.ml → src/xDot.ml b/dgraph/xDot.ml → src/xDot.ml
@@ -3,7 +3,7 @@
 (*  This file is part of OcamlGraph.                                      *)
 (*                                                                        *)
 (*  Copyright (C) 2009-2010                                               *)
-(*    CEA (Commissariat à l'Énergie Atomique)                             *)
+(*    CEA (Commissariat � l'�nergie Atomique)                             *)
 (*                                                                        *)
 (*  you can redistribute it and/or modify it under the terms of the GNU   *)
 (*  Lesser General Public License as published by the Free Software       *)
@@ -25,7 +25,6 @@
 
 (** Reading XDot files *)
 
-open Graph
 open Dot_ast
 open Printf
 
@@ -197,7 +196,7 @@ let read_bounding_box str =
   let lower_left = (x1, -.y2) and upper_right = x2, -.y1 in
   lower_left,upper_right
 
-module Make(G : Graph.Graphviz.GraphWithDotAttrs) = struct
+module Make(G : Graphviz.GraphWithDotAttrs) = struct
 
   module HV = Hashtbl.Make(G.V)
Original file line number	Diff line number	Diff line change
		@@ -0,0 +1 @@
		val withContext : context:Pango.context -> fontName:string -> fontSize:int -> string -> int * int