To: lablgtk at kaba.or.jp Subject: a bug and an extension Mime-Version: 1.0 Content-Type: Text/Plain; charset=us-ascii Content-Transfer-Encoding: 7bit Message-Id: <20001206170622K.wakita at is.titech.ac.jp> Date: Wed, 06 Dec 2000 17:06:22 +0900 From: Ken Wakita Lines: 199 The following patch fixes two problems. - The type of GDraw.create_from_xpm needs final unit argument. - There seems no interface is provided for drawing a pixmap on a drawable object that I wanted for doing some animation. You will notice that pixmap drawing function is given an odd name "pix_map". When I named it pixmap, I met a type error raised in the pixmap class that I failed to fix. I hope others can fix this problem. Ken Wakita *** lablgtk.org/gDraw.ml Mon Jul 3 14:50:56 2000 --- lablgtk/gDraw.ml Wed Dec 6 17:00:23 2000 *************** *** 57,62 **** --- 57,65 ---- method string s = Draw.string w gc ~string:s method image ~width ~height ?(xsrc=0) ?(ysrc=0) ?(xdest=0) ?(ydest=0) image = Draw.image w gc ~image ~width ~height ~xsrc ~ysrc ~xdest ~ydest + method pix_map ~width ~height ?(xsrc=0) ?(ysrc=0) ?(xdest=0) ?(ydest=0) + pixmap = + Draw.pixmap w gc ~pixmap ~width ~height ~xsrc ~ysrc ~xdest ~ydest end class pixmap ?colormap ?mask pm = object *************** *** 141,147 **** with Gpointer.Null -> failwith "GDraw.pixmap_from_xpm : no window" in let pm, mask = try Pixmap.create_from_xpm window ~file ?colormap ! ?transparent:(may_map transparent ~f:(fun c -> color c)) with Gpointer.Null -> invalid_arg ("GDraw.pixmap_from_xpm : " ^ file) in new pixmap pm ?colormap ~mask --- 144,150 ---- with Gpointer.Null -> failwith "GDraw.pixmap_from_xpm : no window" in let pm, mask = try Pixmap.create_from_xpm window ~file ?colormap ! ?transparent:(may_map transparent ~f:(fun c -> color c)) () with Gpointer.Null -> invalid_arg ("GDraw.pixmap_from_xpm : " ^ file) in new pixmap pm ?colormap ~mask *************** *** 152,158 **** with Gpointer.Null -> failwith "GDraw.pixmap_from_xpm_d : no window" in let pm, mask = Pixmap.create_from_xpm_d window ~data ?colormap ! ?transparent:(may_map transparent ~f:(fun c -> color c)) in new pixmap pm ?colormap ~mask class drag_context context = object --- 155,161 ---- with Gpointer.Null -> failwith "GDraw.pixmap_from_xpm_d : no window" in let pm, mask = Pixmap.create_from_xpm_d window ~data ?colormap ! ?transparent:(may_map transparent ~f:(fun c -> color c)) () in new pixmap pm ?colormap ~mask class drag_context context = object diff -c -r lablgtk.org/gDraw.mli lablgtk/gDraw.mli *** lablgtk.org/gDraw.mli Mon Jul 3 14:50:56 2000 --- lablgtk/gDraw.mli Wed Dec 6 17:00:30 2000 *************** *** 38,43 **** --- 38,47 ---- height:int -> ?xsrc:int -> ?ysrc:int -> ?xdest:int -> ?ydest:int -> image -> unit method line : x:int -> y:int -> x:int -> y:int -> unit + method pix_map : + width:int -> + height:int -> + ?xsrc:int -> ?ysrc:int -> ?xdest:int -> ?ydest:int -> pixmap -> unit method point : x:int -> y:int -> unit method polygon : ?filled:bool -> (int * int) list -> unit method rectangle : diff -c -r lablgtk.org/gdk.ml lablgtk/gdk.ml *** lablgtk.org/gdk.ml Tue Aug 29 11:44:46 2000 --- lablgtk/gdk.ml Wed Dec 6 15:33:42 2000 *************** *** 300,310 **** = "ml_gdk_pixmap_create_from_data_bc" "ml_gk_pixmap_create_from_data" external create_from_xpm : window -> ?colormap:colormap -> ?transparent:Color.t -> ! file:string -> pixmap * bitmap = "ml_gdk_pixmap_colormap_create_from_xpm" external create_from_xpm_d : window -> ?colormap:colormap -> ?transparent:Color.t -> ! data:string array -> pixmap * bitmap = "ml_gdk_pixmap_colormap_create_from_xpm_d" end --- 300,310 ---- = "ml_gdk_pixmap_create_from_data_bc" "ml_gk_pixmap_create_from_data" external create_from_xpm : window -> ?colormap:colormap -> ?transparent:Color.t -> ! file:string -> unit -> pixmap * bitmap = "ml_gdk_pixmap_colormap_create_from_xpm" external create_from_xpm_d : window -> ?colormap:colormap -> ?transparent:Color.t -> ! data:string array -> unit -> pixmap * bitmap = "ml_gdk_pixmap_colormap_create_from_xpm_d" end *************** *** 365,370 **** --- 365,380 ---- xsrc: int -> ysrc: int -> xdest: int -> ydest: int -> width: int -> height: int -> unit = "ml_gdk_draw_image_bc" "ml_gdk_draw_image" + (* + external bitmap : 'a drawable -> gc -> bitmap: bitmap -> + xsrc: int -> ysrc: int -> xdest: int -> ydest: int -> + width: int -> height: int -> unit + = "ml_gdk_draw_bitmap_bc" "ml_gdk_draw_bitmap" + *) + external pixmap : 'a drawable -> gc -> pixmap: pixmap -> + xsrc: int -> ysrc: int -> xdest: int -> ydest: int -> + width: int -> height: int -> unit + = "ml_gdk_draw_pixmap_bc" "ml_gdk_draw_pixmap" end module Rgb = struct diff -c -r lablgtk.org/gdk.mli lablgtk/gdk.mli *** lablgtk.org/gdk.mli Tue Aug 29 11:44:46 2000 --- lablgtk/gdk.mli Wed Dec 6 15:32:54 2000 *************** *** 258,269 **** external create_from_xpm : window -> ?colormap:colormap -> ! ?transparent:Color.t -> file:string -> pixmap * bitmap = "ml_gdk_pixmap_colormap_create_from_xpm" external create_from_xpm_d : window -> ?colormap:colormap -> ! ?transparent:Color.t -> data:string array -> pixmap * bitmap = "ml_gdk_pixmap_colormap_create_from_xpm_d" end --- 258,269 ---- external create_from_xpm : window -> ?colormap:colormap -> ! ?transparent:Color.t -> file:string -> unit -> pixmap * bitmap = "ml_gdk_pixmap_colormap_create_from_xpm" external create_from_xpm_d : window -> ?colormap:colormap -> ! ?transparent:Color.t -> data:string array -> unit -> pixmap * bitmap = "ml_gdk_pixmap_colormap_create_from_xpm_d" end *************** *** 317,322 **** --- 317,338 ---- xsrc:int -> ysrc:int -> xdest:int -> ydest:int -> width:int -> height:int -> unit = "ml_gdk_draw_image_bc" "ml_gdk_draw_image" + (* + external bitmap : + 'a drawable -> + gc -> + bitmap:bitmap -> + xsrc:int -> + ysrc:int -> xdest:int -> ydest:int -> width:int -> height:int -> unit + = "ml_gdk_draw_bitmap_bc" "ml_gdk_draw_bitmap" + *) + external pixmap : + 'a drawable -> + gc -> + pixmap:pixmap -> + xsrc:int -> + ysrc:int -> xdest:int -> ydest:int -> width:int -> height:int -> unit + = "ml_gdk_draw_pixmap_bc" "ml_gdk_draw_pixmap" end module Rgb : diff -c -r lablgtk.org/ml_gdk.c lablgtk/ml_gdk.c *** lablgtk.org/ml_gdk.c Thu Nov 16 17:15:16 2000 --- lablgtk/ml_gdk.c Wed Dec 6 14:52:09 2000 *************** *** 402,407 **** --- 402,413 ---- ML_6 (gdk_draw_string, GdkDrawable_val, GdkFont_val, GdkGC_val, Int_val, Int_val, String_val, Unit) ML_bc6 (ml_gdk_draw_string) + /* + ML_9 (gdk_draw_bitmap, GdkDrawable_val, GdkGC_val, GdkBitmap_val, Int_val, Int_val, Int_val, Int_val, Int_val, Int_val, Unit) + ML_bc9 (ml_gdk_draw_bitmap) + */ + ML_9 (gdk_draw_pixmap, GdkDrawable_val, GdkGC_val, GdkPixmap_val, Int_val, Int_val, Int_val, Int_val, Int_val, Int_val, Unit) + ML_bc9 (ml_gdk_draw_pixmap) ML_9 (gdk_draw_image, GdkDrawable_val, GdkGC_val, GdkImage_val, Int_val, Int_val, Int_val, Int_val, Int_val, Int_val, Unit) ML_bc9 (ml_gdk_draw_image)