Date: Sat, 26 Jan 2002 21:24:16 +0200 From: Lauri Alanko To: garrigue at kurims.kyoto-u.ac.jp Cc: lablgtk at kaba.or.jp Subject: Patch: GtkPreview support for lablgtk Message-ID: <20020126192416.GB720 at la.iki.fi> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="ikeVEW9yuYc//A+q" Content-Disposition: inline Sender: Lauri Alanko --ikeVEW9yuYc//A+q Content-Type: text/plain; charset=us-ascii Content-Disposition: inline Hello. I seem to have a strange talent: when I encounter a new piece of software and try to get acquainted with it, the first thing I try to do with it often turns out to require such an exotic feature that it's either unimplemented or buggy. In this case, the piece of software was lablgtk, and the very first thing I tried to do with it was dabbling with bitmap graphics. After a while I realized that though there were wrappers for almost everything else, there was no support for GtkPreview nor for GdkRgb. Just my luck. Thankfully, the wrapper interface was relatively straightforward (though still IMHO more tedious than necessary), so it was easy to add the missing functionality. I also added the queue_draw and queue_resize -methods to the widget class, which were implemented but were for no apparent reason missing from the class interface. I attach the patch (based on 1.2.3) below in the hope that other folks might find it useful as well. I haven't tested it extensively, but it seems to work. If the code seems to make sense, feel free to include it in the distribution. (Oh, and if it so happens that gtkpreview support has already been added since 1.2.3, then please disregard this entire mail. :) Lauri Alanko la@iki.fi --ikeVEW9yuYc//A+q Content-Type: text/plain; charset=us-ascii Content-Disposition: attachment; filename="lablgtk-preview.patch" diff -U3 -r lablgtk-1.2.3.orig/src/gMisc.ml lablgtk-1.2.3.new/src/gMisc.ml --- lablgtk-1.2.3.orig/src/gMisc.ml Thu Nov 22 11:22:07 2001 +++ lablgtk-1.2.3.new/src/gMisc.ml Sat Jan 26 20:42:32 2002 @@ -217,3 +217,31 @@ let w = FontSelection.create () in Container.set w ?border_width ?width ?height; pack_return (new font_selection w) ~packing ~show + +module Preview = struct + class preview obj = object + inherit widget_full (obj : Gtk.preview obj) + method event = new event_ops obj + method put = Preview.put obj + method draw_row = Preview.draw_row obj + method size = Preview.size obj + method set_expand = Preview.set_expand obj + method set_dither = Preview.set_dither obj + end + + let preview ?(kind=`COLOR) ?(width=0) ?(height=0) ?(dither=`NORMAL) + ?(expand=false) ?packing ?show () = + let w = Preview.create kind in + Preview.size w width height; + Preview.set_dither w dither; + Preview.set_expand w expand; + pack_return (new preview w) ~packing ~show + + let set_gamma = Preview.set_gamma + let set_color_cube = Preview.set_color_cube + let set_install_cmap = Preview.set_install_cmap + let set_reserved = Preview.set_reserved + let get_visual = Preview.get_visual + let get_cmap = Preview.get_cmap + let reset = Preview.reset +end diff -U3 -r lablgtk-1.2.3.orig/src/gMisc.mli lablgtk-1.2.3.new/src/gMisc.mli --- lablgtk-1.2.3.orig/src/gMisc.mli Thu Nov 22 11:22:07 2001 +++ lablgtk-1.2.3.new/src/gMisc.mli Sat Jan 26 20:36:16 2002 @@ -263,3 +263,42 @@ ?width:int -> ?height:int -> ?packing:(widget -> unit) -> ?show:bool -> unit -> font_selection + + +module Preview : sig + class preview : Gtk.preview obj -> + object + inherit widget_full + val obj : Gtk.preview obj + method event : event_ops + method put : + Gdk.window -> + Gdk.gc -> + ?srcx:int -> + ?srcy:int -> + ?destx:int -> + ?desty:int -> + int -> int -> unit + method draw_row : int array -> ?x:int -> int -> unit + method size : int -> int -> unit + method set_expand : bool -> unit + method set_dither : Gdk.Tags.rgb_dither -> unit + end + val preview : + ?kind:Tags.preview_type -> + ?width:int -> + ?height:int -> + ?dither:Gdk.Tags.rgb_dither -> + ?expand:bool -> + ?packing:(widget -> unit) -> + ?show:bool -> + unit -> preview + val set_gamma : float -> unit + val set_color_cube : int -> int -> int -> int -> unit + val set_install_cmap : int -> unit + val set_reserved : int -> unit + val get_visual : unit -> Gdk.visual + val get_cmap : unit -> Gdk.colormap + val reset : unit -> unit +end + diff -U3 -r lablgtk-1.2.3.orig/src/gObj.ml lablgtk-1.2.3.new/src/gObj.ml --- lablgtk-1.2.3.orig/src/gObj.ml Wed Dec 12 12:53:50 2001 +++ lablgtk-1.2.3.new/src/gObj.ml Sat Jan 26 20:19:18 2002 @@ -217,6 +217,8 @@ method unmap () = Widget.unmap obj method realize () = Widget.realize obj method unrealize () = Widget.unrealize obj + method queue_draw () = Widget.queue_draw obj + method queue_resize () = Widget.queue_resize obj method draw = Widget.draw obj method activate () = Widget.activate obj method reparent (w : widget) = Widget.reparent obj w#as_widget diff -U3 -r lablgtk-1.2.3.orig/src/gObj.mli lablgtk-1.2.3.new/src/gObj.mli --- lablgtk-1.2.3.orig/src/gObj.mli Mon Mar 12 05:43:42 2001 +++ lablgtk-1.2.3.new/src/gObj.mli Sat Jan 26 20:20:08 2002 @@ -146,6 +146,8 @@ method parent : widget option method pointer : int * int method popup : x:int -> y:int -> unit + method queue_draw : unit -> unit + method queue_resize : unit -> unit method realize : unit -> unit method remove_accelerator : group:accel_group -> ?modi:Gdk.Tags.modifier list -> Gdk.keysym -> unit Only in lablgtk-1.2.3.new/src: gPreview.mli diff -U3 -r lablgtk-1.2.3.orig/src/gdk.ml lablgtk-1.2.3.new/src/gdk.ml --- lablgtk-1.2.3.orig/src/gdk.ml Thu Oct 4 12:45:40 2001 +++ lablgtk-1.2.3.new/src/gdk.ml Sat Jan 26 18:42:52 2002 @@ -68,6 +68,8 @@ type drag_action = [ `DEFAULT|`COPY|`MOVE|`LINK|`PRIVATE|`ASK ] + type rgb_dither = + [ `NONE|`NORMAL|`MAX] end open Tags diff -U3 -r lablgtk-1.2.3.orig/src/gdk.mli lablgtk-1.2.3.new/src/gdk.mli --- lablgtk-1.2.3.orig/src/gdk.mli Thu Oct 4 12:45:40 2001 +++ lablgtk-1.2.3.new/src/gdk.mli Sat Jan 26 14:55:05 2002 @@ -50,6 +50,7 @@ [ `SHIFT|`LOCK|`CONTROL|`MOD1|`MOD2|`MOD3|`MOD4|`MOD5|`BUTTON1 |`BUTTON2|`BUTTON3|`BUTTON4|`BUTTON5 ] type drag_action = [ `DEFAULT|`COPY|`MOVE|`LINK|`PRIVATE|`ASK ] + type rgb_dither = [ `NONE|`NORMAL|`MAX] end module Convert : diff -U3 -r lablgtk-1.2.3.orig/src/gdk_tags.var lablgtk-1.2.3.new/src/gdk_tags.var --- lablgtk-1.2.3.orig/src/gdk_tags.var Wed Nov 15 12:20:19 2000 +++ lablgtk-1.2.3.new/src/gdk_tags.var Sat Jan 26 18:50:09 2002 @@ -81,6 +81,12 @@ type gdkDragAction = "GDK_ACTION_" [ `DEFAULT | `COPY | `MOVE | `LINK | `PRIVATE | `ASK ] +type gdkRgbDither = "GDK_RGB_DITHER_" [ + `NONE + | `NORMAL + | `MAX + ] + type gdkCursorType = "GDK_" [ | `NUM_GLYPHS | `X_CURSOR diff -U3 -r lablgtk-1.2.3.orig/src/gtk.ml lablgtk-1.2.3.new/src/gtk.ml --- lablgtk-1.2.3.orig/src/gtk.ml Mon Mar 12 05:43:43 2001 +++ lablgtk-1.2.3.new/src/gtk.ml Sat Jan 26 14:42:15 2002 @@ -156,3 +156,4 @@ type scrollbar = [`widget|`range|`scrollbar] type ruler = [`widget|`ruler] type separator = [`widget|`separator] +type preview = [`widget|`preview] diff -U3 -r lablgtk-1.2.3.orig/src/gtkMisc.ml lablgtk-1.2.3.new/src/gtkMisc.ml --- lablgtk-1.2.3.orig/src/gtkMisc.ml Mon Mar 12 05:43:43 2001 +++ lablgtk-1.2.3.new/src/gtkMisc.ml Sat Jan 26 20:42:19 2002 @@ -319,3 +319,39 @@ external set_preview_text : [>`fontsel] obj -> string -> unit = "ml_gtk_font_selection_set_preview_text" end + +module Preview = struct + external create : Tags.preview_type -> preview obj + = "ml_gtk_preview_new" + external put : + [>`preview] obj -> Gdk.window -> Gdk.gc -> + int -> int -> int -> int -> int -> int -> unit + = "ml_gtk_preview_put" + let put w gdkwin gc ?(srcx = 0) ?(srcy = 0) ?(destx = 0) ?(desty = 0) + width height = put w gdkwin gc srcx srcy destx desty width height + external draw_row : [>`preview] obj -> int array -> int -> int -> unit + = "ml_gtk_preview_draw_row" + let draw_row w data ?(x = 0) y = draw_row w data x y + external size : [>`preview] obj -> int -> int -> unit + = "ml_gtk_preview_size" + external set_expand : [>`preview] obj -> bool -> unit + = "ml_gtk_preview_set_expand" + external set_expand : [>`preview] obj -> bool -> unit + = "ml_gtk_preview_set_expand" + external set_dither : [>`preview] obj -> Gdk.Tags.rgb_dither -> unit + = "ml_gtk_preview_set_dither" + external set_color_cube : int -> int -> int -> int -> unit + = "ml_gtk_preview_set_color_cube" + external set_install_cmap : int -> unit + = "ml_gtk_preview_set_install_cmap" + external set_reserved : int -> unit + = "ml_gtk_preview_set_reserved" + external set_gamma : float -> unit + = "ml_gtk_preview_set_gamma" + external reset : unit -> unit + = "ml_gtk_preview_reset" + external get_visual : unit -> Gdk.visual + = "ml_gtk_preview_get_visual" + external get_cmap : unit -> Gdk.colormap + = "ml_gtk_preview_get_cmap" +end diff -U3 -r lablgtk-1.2.3.orig/src/ml_gtkmisc.c lablgtk-1.2.3.new/src/ml_gtkmisc.c --- lablgtk-1.2.3.orig/src/ml_gtkmisc.c Thu Nov 16 10:31:09 2000 +++ lablgtk-1.2.3.new/src/ml_gtkmisc.c Sat Jan 26 20:42:01 2002 @@ -13,6 +13,7 @@ #include "ml_gdk.h" #include "ml_gtk.h" #include "gtk_tags.h" +#include "gdk_tags.h" /* gtkgamma.h */ @@ -137,3 +138,57 @@ ML_0 (gtk_hseparator_new, Val_GtkWidget_sink) ML_0 (gtk_vseparator_new, Val_GtkWidget_sink) + +/* gtkpreview.h */ + +#define GtkPreview_val(val) check_cast(GTK_PREVIEW,val) +ML_1 (gtk_preview_new, Preview_type_val, Val_GtkWidget_sink) +ML_9 (gtk_preview_put, GtkPreview_val, GdkWindow_val, GdkGC_val, + Int_val, Int_val, Int_val, Int_val, Int_val, Int_val, Unit) +ML_3 (gtk_preview_size, GtkPreview_val, Int_val, Int_val, Unit) +ML_2 (gtk_preview_set_expand, GtkPreview_val, Bool_val, Unit) +ML_1 (gtk_preview_set_gamma, Float_val, Unit) +ML_4 (gtk_preview_set_color_cube, Int_val, Int_val, Int_val, Int_val, Unit) +ML_1 (gtk_preview_set_install_cmap, Int_val, Unit) +ML_1 (gtk_preview_set_reserved, Int_val, Unit) +ML_2 (gtk_preview_set_dither, GtkPreview_val, GdkRgbDither_val, Unit) +ML_0 (gtk_preview_get_visual, Val_GdkVisual) +ML_0 (gtk_preview_get_cmap, Val_GdkColormap) +ML_0 (gtk_preview_reset, Unit) + +#define ROWBUF_SIZE 3072 +value ml_gtk_preview_draw_row (value val, value data, value x, value y) +{ + GtkPreview *w = GtkPreview_val(val); + gint length = Wosize_val(data); + gint xi = Int_val(x); + gint yi = Int_val(y); + guchar buf[ROWBUF_SIZE]; + gint offset = 0; + gboolean rgb = w->type == GTK_PREVIEW_COLOR; + + while (offset < length) { + guchar* p = buf; + gint block_len; + gint i; + + if (rgb) { + block_len = MIN(length - offset, ROWBUF_SIZE / 3); + for (i = 0; i < block_len; i++) { + gint32 c = Int_val(Field(data, offset + i)); + *p++ = (c >> 16) & 0xff; + *p++ = (c >> 8) & 0xff; + *p++ = c & 0xff; + } + } else { + block_len = MIN(length - offset, ROWBUF_SIZE); + for (i = 0; i < block_len; i++) { + gint32 c = Int_val(Field(data, offset + i)); + *p++ = c & 0xff; + } + } + gtk_preview_draw_row(w, buf, xi + offset, yi, block_len); + offset += block_len; + } + return Val_unit; +} --ikeVEW9yuYc//A+q--