diff --git a/examples/dune b/examples/dune index de2026056..41a2e433b 100644 --- a/examples/dune +++ b/examples/dune @@ -29,6 +29,7 @@ ; testdnd testgtk testthread ; timer toolbar tooltip tree tree_model tree_store ; tron + glarea ) (modules about accel_tree action assistant assistant_tutorial @@ -46,6 +47,7 @@ stackcontainer stackswitcher testdnd ; testgtk testthread timer toolbar tooltip tree tree_model tree_store tron + glarea ) (flags :standard -w -3-6-7-10-24-26-27-33-35 -no-strict-sequence) (libraries lablgtk3)) diff --git a/examples/glarea.ml b/examples/glarea.ml new file mode 100644 index 000000000..9eb4b7f93 --- /dev/null +++ b/examples/glarea.ml @@ -0,0 +1,12 @@ + +let () = + ignore @@ GMain.init (); + let window = GWindow.window () in + ignore @@ window#connect#destroy ~callback:GMain.quit; + let obj = GlGtk.area ~packing:window#add () in + obj#set_required_version 3 2; + obj#set_has_auto_render true; + ignore @@ obj#connect#realize ~callback:(fun () -> print_endline "creating opengl context"); + ignore @@ obj#connect#render ~callback:(fun () -> print_endline "rendering opengl context"; true); + window#show (); + GtkMain.Main.main () diff --git a/src/dune b/src/dune index b712a7f78..a6b93c86c 100644 --- a/src/dune +++ b/src/dune @@ -33,6 +33,7 @@ ml_gtkaction ml_gtkbin ml_gtkbutton ml_gtktext ml_gtkedit ml_gtkmenu ml_gtkfile ml_gtktree ml_gtkpack ml_gtkstock ml_gtkrange ml_gtkassistant + ml_gtkgl ) (c_flags (:include cflag-gtk+-3.0.sexp) (:include cflag-extraflags.sexp) -Wno-deprecated-declarations) (c_library_flags (:include clink-gtk+-3.0.sexp)) diff --git a/src/glGtk.ml b/src/glGtk.ml new file mode 100644 index 000000000..8465dec15 --- /dev/null +++ b/src/glGtk.ml @@ -0,0 +1,119 @@ +(**************************************************************************) +(* Lablgtk *) +(* *) +(* This program is free software; you can redistribute it *) +(* and/or modify it under the terms of the GNU Library General *) +(* Public License as published by the Free Software Foundation *) +(* version 2, with the exception described in file COPYING which *) +(* comes with the library. *) +(* *) +(* This program is distributed in the hope that it will be useful, *) +(* but WITHOUT ANY WARRANTY; without even the implied warranty of *) +(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) +(* GNU Library General Public License for more details. *) +(* *) +(* You should have received a copy of the GNU Library General *) +(* Public License along with this program; if not, write to the *) +(* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) +(* Boston, MA 02111-1307 USA *) +(* *) +(* *) +(**************************************************************************) + +(* $Id$ *) + +open Gaux +open Gtk + +type gl_area = [Gtk.drawing_area|`glarea] + +module GtkRaw = struct + external create : unit -> gl_area obj = "ml_gtk_gl_area_new" + + external make_current : [>`glarea] obj -> unit = "ml_gtk_gl_area_make_current" + + external set_has_alpha : [>`glarea] obj -> bool -> unit = "ml_gtk_gl_area_set_has_alpha" + external get_has_alpha : [>`glarea] obj -> bool = "ml_gtk_gl_area_get_has_alpha" + + external set_has_depth_buffer : [>`glarea] obj -> bool -> unit = "ml_gtk_gl_area_set_has_depth_buffer" + external get_has_depth_buffer : [>`glarea] obj -> bool = "ml_gtk_gl_area_get_has_depth_buffer" + + external set_has_stencil_buffer : [>`glarea] obj -> bool -> unit = "ml_gtk_gl_area_set_has_stencil_buffer" + external get_has_stencil_buffer : [>`glarea] obj -> bool = "ml_gtk_gl_area_get_has_stencil_buffer" + + external set_has_auto_render : [>`glarea] obj -> bool -> unit = "ml_gtk_gl_area_set_auto_render" + external get_has_auto_render : [>`glarea] obj -> bool = "ml_gtk_gl_area_get_auto_render" + + external set_required_version : [>`glarea] obj -> int -> int -> unit = "ml_gtk_gl_area_set_required_version" + external get_required_version : [>`glarea] obj -> (int * int) = "ml_gtk_gl_area_get_required_version" + +end + +class area_signals obj = +object (connect) + inherit GObj.widget_signals_impl (obj : [> gl_area] obj) + method display ~callback = + (new GObj.event_signals obj)#after#expose ~callback: + begin fun ev -> + if GdkEvent.Expose.count ev = 0 then begin + GtkRaw.make_current obj; + callback () + end; + true + end + + + method render ~callback = + let render = + GtkSignal.{name="render"; classe=`widget; marshaller=fun f -> + marshal1_ret ~ret:Gobject.Data.boolean + (Gobject.Data.gobject_option : _ Gobject.data_conv) + "Gtk::render" f} in + let f = connect#connect render in + f (fun _ -> callback ()) + + method reshape ~(callback: (width:int -> height:int -> unit)) = + (new GObj.event_signals obj)#after#configure ~callback: + begin fun ev -> + GtkRaw.make_current obj; + callback ~width:(GdkEvent.Configure.width ev) ~height:(GdkEvent.Configure.height ev); + true + end + method realize ~callback = + (new GObj.misc_signals (obj :> Gtk.widget obj))#after#realize ~callback: + begin fun ev -> + GtkRaw.make_current obj; + callback () + end +end + +class area obj = object (self) + inherit GObj.widget (obj : gl_area obj) + method as_area = obj + method event = new GObj.event_ops obj + method connect = new area_signals obj + (* method set_size = GtkMisc.DrawingArea.size obj *) + method make_current () = ignore (GtkRaw.make_current obj) + + method set_has_alpha = GtkRaw.set_has_alpha obj + method get_has_alpha () = GtkRaw.get_has_alpha obj + + method set_has_depth_buffer = GtkRaw.set_has_depth_buffer obj + method get_has_depth_buffer () = GtkRaw.get_has_depth_buffer obj + + method set_has_stencil_buffer = GtkRaw.set_has_stencil_buffer obj + method get_has_stencil_buffer () = GtkRaw.get_has_stencil_buffer obj + + method set_has_auto_render = GtkRaw.set_has_auto_render obj + method get_has_auto_render () = GtkRaw.get_has_auto_render obj + + method set_required_version = GtkRaw.set_required_version obj + method get_required_version () = GtkRaw.get_required_version obj + +end + +let area ?packing ?show () = + let w = GtkRaw.create () in + GtkBase.Widget.add_events w [`EXPOSURE]; + GObj.pack_return (new area w) ~packing ~show + diff --git a/src/glGtk.mli b/src/glGtk.mli new file mode 100644 index 000000000..8072a0b5a --- /dev/null +++ b/src/glGtk.mli @@ -0,0 +1,92 @@ +(**************************************************************************) +(* Lablgtk *) +(* *) +(* This program is free software; you can redistribute it *) +(* and/or modify it under the terms of the GNU Library General *) +(* Public License as published by the Free Software Foundation *) +(* version 2, with the exception described in file COPYING which *) +(* comes with the library. *) +(* *) +(* This program is distributed in the hope that it will be useful, *) +(* but WITHOUT ANY WARRANTY; without even the implied warranty of *) +(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) +(* GNU Library General Public License for more details. *) +(* *) +(* You should have received a copy of the GNU Library General *) +(* Public License along with this program; if not, write to the *) +(* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) +(* Boston, MA 02111-1307 USA *) +(* *) +(* *) +(**************************************************************************) + +(* $Id$ *) + +open Gtk +open GObj + +type gl_area = [Gtk.drawing_area|`glarea] + +module GtkRaw : + sig + external create : unit -> gl_area obj = "ml_gtk_gl_area_new" + external make_current : [>`glarea] obj -> unit = "ml_gtk_gl_area_make_current" + + external set_has_alpha : [>`glarea] obj -> bool -> unit = "ml_gtk_gl_area_set_has_alpha" + external get_has_alpha : [>`glarea] obj -> bool = "ml_gtk_gl_area_get_has_alpha" + + external set_has_depth_buffer : [>`glarea] obj -> bool -> unit = "ml_gtk_gl_area_set_has_depth_buffer" + external get_has_depth_buffer : [>`glarea] obj -> bool = "ml_gtk_gl_area_get_has_depth_buffer" + + external set_has_stencil_buffer : [>`glarea] obj -> bool -> unit = "ml_gtk_gl_area_set_has_stencil_buffer" + external get_has_stencil_buffer : [>`glarea] obj -> bool = "ml_gtk_gl_area_get_has_stencil_buffer" + + external set_has_auto_render : [>`glarea] obj -> bool -> unit = "ml_gtk_gl_area_set_auto_render" + external get_has_auto_render : [>`glarea] obj -> bool = "ml_gtk_gl_area_get_auto_render" + + external set_required_version : [>`glarea] obj -> int -> int -> unit = "ml_gtk_gl_area_set_required_version" + external get_required_version : [>`glarea] obj -> (int * int) = "ml_gtk_gl_area_get_required_version" + + end + +class area_signals : 'a obj -> + object + inherit GObj.widget_signals + constraint 'a = [> gl_area] + val obj : 'a obj + method display : callback:(unit -> unit) -> GtkSignal.id + method realize : callback:(unit -> unit) -> GtkSignal.id + method render: callback:(unit -> bool) -> GtkSignal.id + method reshape : + callback:(width:int -> height:int -> unit) -> GtkSignal.id + end + +class area : gl_area obj -> + object + inherit GObj.widget + val obj : gl_area obj + method event : event_ops + method as_area : gl_area obj + method connect : area_signals + + method make_current : unit -> unit + + method set_has_alpha : bool -> unit + method get_has_alpha : unit -> bool + + method set_has_depth_buffer : bool -> unit + method get_has_depth_buffer : unit -> bool + + method set_has_stencil_buffer : bool -> unit + method get_has_stencil_buffer : unit -> bool + + method set_has_auto_render : bool -> unit + method get_has_auto_render : unit -> bool + + method set_required_version : int -> int -> unit + method get_required_version : unit -> (int * int) + + end + +val area : ?packing:(widget -> unit) -> ?show:bool -> unit -> area + diff --git a/src/gobject.ml b/src/gobject.ml index 0d6443c8f..95ae10864 100644 --- a/src/gobject.ml +++ b/src/gobject.ml @@ -285,7 +285,8 @@ module Data = struct let gobject_option = { kind = `OBJECT; proj = (function `OBJECT c -> may_map ~f:unsafe_cast c - | _ -> failwith "Gobject.get_object"); + | `NONE -> None + | _ -> failwith "Gobject.get_object"); inj = (fun c -> `OBJECT (may_map ~f:unsafe_cast c)) } let gobject = { kind = `OBJECT; diff --git a/src/ml_gtkgl.c b/src/ml_gtkgl.c new file mode 100644 index 000000000..d1a1f3351 --- /dev/null +++ b/src/ml_gtkgl.c @@ -0,0 +1,68 @@ +/**************************************************************************/ +/* Lablgtk */ +/* */ +/* This program is free software; you can redistribute it */ +/* and/or modify it under the terms of the GNU Library General */ +/* Public License as published by the Free Software Foundation */ +/* version 2, with the exception described in file COPYING which */ +/* comes with the library. */ +/* */ +/* This program is distributed in the hope that it will be useful, */ +/* but WITHOUT ANY WARRANTY; without even the implied warranty of */ +/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */ +/* GNU Library General Public License for more details. */ +/* */ +/* You should have received a copy of the GNU Library General */ +/* Public License along with this program; if not, write to the */ +/* Free Software Foundation, Inc., 59 Temple Place, Suite 330, */ +/* Boston, MA 02111-1307 USA */ +/* */ +/* */ +/**************************************************************************/ + +/* $Id$ */ + +#include +#include +#include +#include +#include +#include + +#include "wrappers.h" +#include "ml_glib.h" +#include "ml_gobject.h" +#include "ml_gdk.h" +#include "ml_gtk.h" +/* #include "gtkgl_tags.h" */ + +/* Conversion functions */ +/* #include "gtkgl_tags.c" */ + +#define GtkGLArea_val(val) check_cast(GTK_GL_AREA,val) + +ML_0 (gtk_gl_area_new, Val_GtkWidget_sink) +ML_1 (gtk_gl_area_make_current, GtkGLArea_val, Unit) + +ML_2 (gtk_gl_area_set_has_alpha, GtkGLArea_val, Bool_val, Unit) +ML_1 (gtk_gl_area_get_has_alpha, GtkGLArea_val, Bool_val) + +ML_2 (gtk_gl_area_set_has_depth_buffer, GtkGLArea_val, Bool_val, Unit) +ML_1 (gtk_gl_area_get_has_depth_buffer, GtkGLArea_val, Bool_val) + +ML_2 (gtk_gl_area_set_has_stencil_buffer, GtkGLArea_val, Bool_val, Unit) +ML_1 (gtk_gl_area_get_has_stencil_buffer, GtkGLArea_val, Bool_val) + +ML_2 (gtk_gl_area_set_auto_render, GtkGLArea_val, Bool_val, Unit) +ML_1 (gtk_gl_area_get_auto_render, GtkGLArea_val, Bool_val) + +ML_3 (gtk_gl_area_set_required_version, GtkGLArea_val, Int_val, Int_val, Unit) +CAMLprim value ml_gtk_gl_area_get_required_version(value area) +{ + int major, minor; + value res = alloc_tuple(2); + gtk_gl_area_get_required_version(GtkGLArea_val(area), &major, &minor); + Field(res,0) = Val_int(major); + Field(res,1) = Val_int(minor); + return res; +}