← Back to branch summary

~ubuntu-branches/debian/squeeze/camlimages/squeeze

« back to all changes in this revision

Viewing changes to lablgtk2/oXimage2.ml

  • Committer: Bazaar Package Importer
  • Author(s): Sylvain Le Gall, Ralf Treinen, Sylvain Le Gall
  • Date: 2009-03-05 00:19:32 UTC
  • mfrom: (1.1.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20090305001932-f0hstlmun8hxvs0r
Tags: 1:3.0.1-1
[ Ralf Treinen ]
* Updated debian/watch.

[ Sylvain Le Gall ]
* New upstream version:
  * Remove useless patches
  * Adapt debian/rules and other debhelper files
  * Add debian/patches/fix_3_0_1 to fix various problem (probably due to
    OCaml 3.11 migration)
* Depends on version 2.12 of lablgtk2
* Add dh-ocaml build-dependency (rules/ocaml.mk)
* Add ${misc:Depends} to dependencies
* Update Homepage field into debian/control and debian/copyright
* Add license version for debian packaging
* Directly use eng.html rather than creating a linked index.html file

Show diffs side-by-side

added added

removed removed

Lines of Context:
lablgtk2/oXimage2.ml
1
 
(***********************************************************************)
2
 
(*                                                                     *)
3
 
(*                           Objective Caml                            *)
4
 
(*                                                                     *)
5
 
(*            Fran�ois Pessaux, projet Cristal, INRIA Rocquencourt     *)
6
 
(*            Pierre Weis, projet Cristal, INRIA Rocquencourt          *)
7
 
(*            Jun Furuse, projet Cristal, INRIA Rocquencourt           *)
8
 
(*                                                                     *)
9
 
(*  Copyright 1999-2004,                                               *)
10
 
(*  Institut National de Recherche en Informatique et en Automatique.  *)
11
 
(*  Distributed only by permission.                                    *)
12
 
(*                                                                     *)
13
 
(***********************************************************************)
14
 
 
15
 
(* $Id: oXimage2.ml,v 1.2 2004/09/24 10:02:55 weis Exp $*)
16
 
 
17
 
open Images;;
18
 
open OImages;;
19
 
open Ximage2;;
20
 
open Gdk;;
21
 
 
22
 
class ximage xim = object
23
 
  method width = xim.width
24
 
  method height = xim.height
25
 
  method unsafe_get = Ximage2.unsafe_get xim 
26
 
  method unsafe_set = Ximage2.unsafe_set xim 
27
 
  method get = Ximage2.get xim 
28
 
  method set = Ximage2.set xim 
29
 
  method data = xim.data
30
 
  method destroy = Ximage2.destroy xim
31
 
end;;
32
 
 
33
 
let create ~kind ~visual ~width ~height =
34
 
  let xim = Ximage2.create ~kind ~visual ~width ~height in
35
 
  new ximage xim;;
36
 
 
37
 
let get_image drawable ~x ~y ~width ~height = 
38
 
  new ximage (Ximage2.get_image drawable ~x ~y ~width ~height);;
39
 
 
40
 
let of_image visual progress img =
41
 
  new ximage (Ximage2.of_image visual progress img#image);;
42
 
 
43
 
open GDraw;;
44
 
 
45
 
let mask_of_image win img = (* It is really inefficient *)
46
 
  let mono_gc = get_mono_gc win in 
47
 
  let width, height = img#width, img#height in
48
 
  let draw_mask i =
49
 
    prerr_endline "making mask";
50
 
    let bmp = Bitmap.create ~window:win ~width ~height () in
51
 
    let ximg = get_image bmp ~x:0 ~y:0 ~width ~height in
52
 
    for x = 0 to width - 1 do
53
 
      for y = 0 to height - 1 do
54
 
        if i#unsafe_get x y = i#transparent
55
 
        then ximg#unsafe_set x y 0
56
 
        else ximg#unsafe_set x y 1
57
 
      done;
58
 
    done;
59
 
    Gdk.Draw.image bmp mono_gc ximg#data 
60
 
      ~xsrc:0 ~ysrc:0 ~xdest:0 ~ydest:0 ~width ~height;
61
 
    Some bmp in
62
 
 
63
 
  (* BUG ? of gtk or lablgtk? Using None for mask does not work *)
64
 
  begin match OImages.tag img with
65
 
  | Index8 i ->
66
 
    if i#transparent >= 0 then draw_mask i
67
 
    else Some (plain_mask win img#width img#height)
68
 
  | Index16 i ->
69
 
    let i = OImages.index16 img in
70
 
    if i#transparent >= 0 then draw_mask i 
71
 
    else Some (plain_mask win img#width img#height)
72
 
  | _ -> 
73
 
    Some (plain_mask win img#width img#height)
74
 
  end;;
75
 
 
76
 
let pixmap_of win ximage =
77
 
  pixmap_of win
78
 
   { width= ximage#width; height= ximage#height;
79
 
     data= ximage#data; (* finalised= false*) };;
80
 
 
81
 
let pixmap_of_image win progress img =
82
 
  let visual = Gdk.Window.get_visual win in
83
 
  let ximage = of_image visual progress img in
84
 
  let msk = mask_of_image win img in
85
 
  let pixmap = new GDraw.pixmap ?mask: msk (pixmap_of win ximage) in
86
 
  pixmap;;