add GtkCurve

git-svn-id: svn+ssh://svn.gna.org/svn/lablgtk/trunk@1525 9e25d42d-7a03-43f2-900d-8c2168964d28

CHANGES

@@ -1,5 +1,8 @@
 $Id$
 
+2010.09.09 [Jacques]
+  * add GtkCurve (but it is deprecated since 2.20)
+
 2010.08.16 [Jacques]
   * rename g_value_{get,set}_variant, as the name is used by recent
     versions of glib (reported by Florent Monnier)

examples/curve.ml

@@ -0,0 +1,15 @@
+(* $Id$ *)
+
+let w = GWindow.window ~width:200 ~height:150 ();;
+let curve = GMisc.curve ~packing:w#add ();;
+let () =
+  curve#event#connect#after_any ~callback:
+    (fun _ ->
+      let vect = curve#get_vector 5 in
+      Printf.printf "%g %g %g %g %g\n%!"
+        vect.(0) vect.(1) vect.(2) vect.(3) vect.(4));
+  w#connect#destroy ~callback:GMain.quit;
+  w#show ();
+  GMain.main ()
+
+

src/gMisc.ml

@@ -146,16 +146,33 @@ let calendar ?options ?packing ?show () =
   pack_return (new calendar w) ~packing ~show
 
 class drawing_area obj = object
-  inherit widget_full (obj : Gtk.drawing_area obj)
+  inherit widget_full (obj : [> Gtk.drawing_area] obj)
   method event = new GObj.event_ops obj
   method set_size = DrawingArea.size obj
 end
 
-let drawing_area ?(width=0) ?(height=0) ?packing ?show () =
+let may_set_size ?(width=0) ?(height=0) w =
+  if width <> 0 || height <> 0 then DrawingArea.size w ~width ~height
+
+let drawing_area ?width ?height ?packing ?show () =
   let w = DrawingArea.create [] in
-  if width <> 0 || height <> 0 then DrawingArea.size w ~width ~height;
+  may_set_size w ?width ?height;
   pack_return (new drawing_area w) ~packing ~show
 
+class curve obj = object
+  inherit drawing_area (obj : Gtk.curve obj)
+  inherit curve_props
+  method set_gamma = Curve.set_gamma obj
+  method set_vector = Curve.set_vector obj
+  method get_vector = Curve.get_vector obj
+end
+
+let curve ?width ?height =
+  Curve.make_params [] ~cont:(fun pl ?packing ?show () ->
+    let w = Curve.create pl in
+    may_set_size w ?width ?height;
+    pack_return (new curve w) ~packing ~show)
+
 class misc obj = object
   inherit ['a] widget_impl obj
   inherit misc_props

src/gMisc.mli

@@ -169,10 +169,10 @@ val calendar :
 
 (** A widget for custom user interface elements
     @gtkdoc gtk GtkDrawingArea *)
-class drawing_area : Gtk.drawing_area obj ->
+class drawing_area : ([> Gtk.drawing_area] as 'a) obj ->
   object
     inherit GObj.widget_full
-    val obj : Gtk.drawing_area obj
+    val obj : 'a obj
     method event : event_ops
     method set_size : width:int -> height:int -> unit
   end
@@ -183,6 +183,35 @@ val drawing_area :
   ?height:int ->
   ?packing:(widget -> unit) -> ?show:bool -> unit -> drawing_area
 
+(** {3 Curve} *)
+
+(** Allows direct editing of a curve
+    @gtkdoc gtk GtkCurve *)
+class curve : Gtk.curve obj ->
+  object
+    inherit drawing_area
+    val obj : Gtk.curve obj
+    method set_gamma : int -> unit
+    method set_vector : float array -> unit
+    method get_vector : int -> float array
+    method max_x : float
+    method max_y : float
+    method min_x : float
+    method min_y : float
+    method set_max_x : float -> unit
+    method set_max_y : float -> unit
+    method set_min_x : float -> unit
+    method set_min_y : float -> unit
+  end
+
+(** @gtkdoc gtk GtkCurve *)
+val curve :
+  ?width:int -> ?height:int ->
+  ?max_x:float -> ?max_y:float ->
+  ?min_x:float -> ?min_y:float ->
+  ?packing:(widget -> unit) -> ?show:bool -> unit -> curve
+
+
 (** {3 Misc. Widgets} *)
 
 (** A base class for widgets with alignments and padding

src/gtk.ml

@@ -207,6 +207,7 @@ type menu_tool_button = [tool_button|`menutoolbutton]
 type tree = [container|`tree]
 type calendar = [widget|`calendar]
 type drawing_area = [widget|`drawingarea]
+type curve = [drawing_area|`curve]
 type editable = [widget|`editable]
 type entry = [editable|`entry]
 type spin_button = [editable|`entry|`spinbutton]

src/gtkMisc.ml

@@ -44,20 +44,7 @@ module Calendar = Calendar
 
 module DrawingArea = DrawingArea
 
-(* Does not seem very useful ...
-module Curve = struct
-  type t = [widget drawing curve] obj
-  let cast w : t = Object.try_cast w "GtkCurve"
-  external create : unit -> t = "ml_gtk_curve_new"
-  external reset : [>`curve] obj -> unit = "ml_gtk_curve_reset"
-  external set_gamma : [>`curve] obj -> float -> unit
-      = "ml_gtk_curve_set_gamma"
-  external set_range :
-      [>`curve] obj -> min_x:float -> max_x:float ->
-      min_y:float -> max_y:float -> unit
-      = "ml_gtk_curve_set_gamma"
-end
-*)
+module Curve = Curve
 
 module Misc = struct
   include Misc

src/gtkMisc.props

@@ -174,14 +174,16 @@ class DrawingArea : Widget {
   method size : "width:int -> height:int -> unit"
 }
 
-(*
-class Curve {
+class Curve set wrap : DrawingArea {
   "curve-type"           GtkCurveType         : Read / Write
   "max-x"                gfloat               : Read / Write
   "max-y"                gfloat               : Read / Write
   "min-x"                gfloat               : Read / Write
   "min-y"                gfloat               : Read / Write
+  method reset
+  method set_gamma  : "int -> unit"
+  method set_vector : "float array -> unit"
+  method get_vector : "int -> float array"
 }
-*)
 
 class Separator hv : Widget {}

src/ml_gtkmisc.c

@@ -51,6 +51,7 @@ CAMLprim value ml_gtkmisc_init(value unit)
 #endif
         gtk_calendar_get_type() +
         gtk_drawing_area_get_type() +
+        gtk_curve_get_type() +
         gtk_misc_get_type() +
         gtk_arrow_get_type() +
         gtk_image_get_type() +
@@ -175,6 +176,35 @@ CAMLprim value ml_gtk_calendar_is_day_marked (value c, value d)
 #define GtkDrawingArea_val(val) check_cast(GTK_DRAWING_AREA,val)
 ML_3 (gtk_drawing_area_size, GtkDrawingArea_val, Int_val, Int_val, Unit)
 
+/* gtkcurve.h */
+
+#define GtkCurve_val(val) check_cast(GTK_CURVE,val)
+ML_1 (gtk_curve_reset, GtkCurve_val, Unit)
+ML_2 (gtk_curve_set_gamma, GtkCurve_val, Float_val, Unit)
+value ml_gtk_curve_set_vector (value curve, value points)
+{
+  guint len = Wosize_val(points) / Double_wosize;
+  gfloat* vect = caml_stat_alloc(len * sizeof(gfloat));
+  int i;
+  for (i = 0; i < len; i++)
+    vect[i] = Double_field(points,i);
+  gtk_curve_set_vector(GtkCurve_val(curve), len, vect);
+  caml_stat_free(vect);
+  return Val_unit;
+}
+value ml_gtk_curve_get_vector (value curve, value len)
+{
+  gfloat* vect = caml_stat_alloc(len * sizeof(gfloat));
+  value ret;
+  int i;
+  gtk_curve_get_vector(GtkCurve_val(curve), Int_val(len), vect);
+  ret = caml_alloc(Int_val(len)*Double_wosize, Double_array_tag);
+  for (i = 0; i < len; i++)
+    Store_double_field(ret, i, vect[i]);
+  caml_stat_free(vect);
+  return ret;
+}
+
 /* gtkmisc.h */
 
 /* gtkarrow.h */