#include <caml/mlvalues.h>

#include <libgnomecanvas/libgnomecanvas.h>
#include <pango/pangoft2.h>

static GObjectSetPropertyFunc orig_gnome_canvas_text_set_property;

static void
my_gnome_canvas_text_set_property (GObject            *object,
				   guint               param_id,
				   const GValue       *value,
				   GParamSpec         *pspec)
{
  static const char fmap_key[] = "monotone-viz-PangoFT2FontMap";
  GnomeCanvasItem *item;
  GnomeCanvasText *text;
  PangoFontMap *fmap;

  item = GNOME_CANVAS_ITEM (object);
  text = GNOME_CANVAS_TEXT (object);

  if (!text->layout && item->canvas->aa) {
    PangoLanguage *language;
    PangoContext *gtk_context, *context;

    fmap = g_object_get_data (G_OBJECT (item->canvas), fmap_key);

    if (fmap == NULL) {
      GtkWidget *c_w;
      GdkScreen *screen;
      gint	pixels, mm;
      double	dpi_x, dpi_y;


      c_w = GTK_WIDGET (item->canvas);
      screen = gtk_widget_has_screen (c_w) ? gtk_widget_get_screen (c_w) : gdk_screen_get_default();
      pixels = gdk_screen_get_width (screen);
      mm = gdk_screen_get_width_mm (screen);
      dpi_x = (((double) pixels * 25.4) / (double) mm);
			
      pixels = gdk_screen_get_height (screen);
      mm = gdk_screen_get_height_mm (screen);
      dpi_y = (((double) pixels * 25.4) / (double) mm);
			
      fmap = pango_ft2_font_map_new ();
      pango_ft2_font_map_set_resolution (PANGO_FT2_FONT_MAP (fmap),
					 dpi_x, dpi_y);

      g_object_set_data_full (G_OBJECT (item->canvas), fmap_key, fmap, g_object_unref);
    }

    gtk_context = gtk_widget_get_pango_context (GTK_WIDGET (item->canvas));
    context = pango_ft2_font_map_create_context (PANGO_FT2_FONT_MAP (fmap));
    language = pango_context_get_language (gtk_context);
    pango_context_set_language (context, language);
    pango_context_set_base_dir (context,
				pango_context_get_base_dir (gtk_context));
    pango_context_set_font_description (context,
					pango_context_get_font_description (gtk_context));
			
    text->layout = pango_layout_new (context);
    g_object_unref (G_OBJECT (context));
  }

  return orig_gnome_canvas_text_set_property (object, param_id, value, pspec);
}

CAMLprim value
ml_fix_libgnomecanvas_pango (value text_obj)
{
  static GnomeCanvasTextClass *ct_class;
  GObjectClass *go_class;

  if (ct_class)
    return Val_unit;

  ct_class = g_type_class_ref (GNOME_TYPE_CANVAS_TEXT);
  go_class = G_OBJECT_CLASS (ct_class);

  orig_gnome_canvas_text_set_property = go_class->set_property;
  go_class->set_property = my_gnome_canvas_text_set_property;
  
  return Val_unit;
}