← Back to branch summary

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

« back to all changes in this revision

Viewing changes to src/cmyk32.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:
src/cmyk32.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: cmyk32.ml,v 1.1 2006/11/28 15:43:28 rousse Exp $*)
 
16
 
 
17
(* CMYK 32 bit depth image format *)
 
18
 
 
19
module E = struct
 
20
  open Color
 
21
  type t = Color.cmyk
 
22
  let bytes_per_pixel = 4
 
23
  let get str pos =
 
24
    { c = int_of_char str.[pos    ];
 
25
      m = int_of_char str.[pos + 1];
 
26
      y = int_of_char str.[pos + 2];
 
27
      k = int_of_char str.[pos + 3]; }
 
28
  let set str pos t =
 
29
    str.[pos    ] <- char_of_int t.c;
 
30
    str.[pos + 1] <- char_of_int t.m;
 
31
    str.[pos + 2] <- char_of_int t.y;
 
32
    str.[pos + 3] <- char_of_int t.k
 
33
  let make t =
 
34
    let str = String.create bytes_per_pixel in
 
35
    set str 0 t;
 
36
    str
 
37
end;;
 
38
 
 
39
module RI = Genimage.MakeRawImage(E);;
 
40
 
 
41
type rawimage = RI.t;;
 
42
type elt = Color.cmyk;;
 
43
type t = {
 
44
  width : int;
 
45
  height : int;
 
46
  rawimage : RI.t;
 
47
  mutable infos : Info.info list;
 
48
 };;
 
49
 
 
50
module C = struct
 
51
  type rawimage = RI.t
 
52
  type container = t
 
53
  let rawimage x = x.rawimage
 
54
  let create_default width height rawimage =
 
55
    { width = width;
 
56
      height = height;
 
57
      rawimage = rawimage;
 
58
      infos = []; }
 
59
  let create_duplicate src width height rawimage =
 
60
    { width = width;
 
61
      height = height;
 
62
      rawimage = rawimage;
 
63
      infos = src.infos; }
 
64
end;;
 
65
 
 
66
module IMAGE = Genimage.Make(RI)(C);;
 
67
 
 
68
let create_with width height infos data =
 
69
  { width = width;
 
70
    height = height;
 
71
    rawimage = RI.create_with width height data;
 
72
    infos = infos; };;
 
73
 
 
74
let rawimage = C.rawimage;;
 
75
let create = IMAGE.create;;
 
76
let make = IMAGE.make;;
 
77
let dump = IMAGE.dump;;
 
78
let unsafe_access = IMAGE.unsafe_access;;
 
79
let get_strip = IMAGE.get_strip;;
 
80
let set_strip = IMAGE.set_strip;;
 
81
let get_scanline = IMAGE.get_scanline;;
 
82
let set_scanline = IMAGE.set_scanline;;
 
83
let unsafe_get = IMAGE.unsafe_get;;
 
84
let unsafe_set = IMAGE.unsafe_set;;
 
85
let get = IMAGE.get;;
 
86
let set = IMAGE.set;;
 
87
let destroy = IMAGE.destroy;;
 
88
let copy = IMAGE.copy;;
 
89
let sub = IMAGE.sub;;
 
90
let blit = IMAGE.blit;;
 
91
let map = IMAGE.map;;
 
92
 
 
93
open Color;;
 
94
 
 
95
(* image resize with smoothing *)
 
96
let resize prog img nw nh =
 
97
  let newimage = create nw nh in
 
98
  let xscale = float nw /. float img.width in
 
99
  let yscale = float nh /. float img.height in
 
100
  for y = 0 to nh - 1 do
 
101
    for x = 0 to nw - 1 do
 
102
      let start_x = truncate (float x /. xscale)
 
103
      and start_y = truncate (float y /. yscale)
 
104
      in
 
105
      let end_x = truncate ((float x +. 0.99) /. xscale)
 
106
      and end_y = truncate ((float y +. 0.99) /. yscale) in
 
107
      let size = (end_x - start_x + 1) * (end_y - start_y + 1) in
 
108
      let sc = ref 0
 
109
      and sm = ref 0
 
110
      and sy = ref 0
 
111
      and sk = ref 0 in
 
112
      for xx = start_x to end_x do
 
113
        for yy = start_y to end_y do
 
114
          let c = unsafe_get img xx yy in
 
115
          sc := !sc + c.c;
 
116
          sm := !sm + c.m;
 
117
          sy := !sy + c.y;
 
118
          sk := !sk + c.k;
 
119
        done
 
120
      done;
 
121
      unsafe_set newimage x y
 
122
        { c = !sc / size;
 
123
          m = !sm / size;
 
124
          y = !sy / size;
 
125
          k = !sk / size; }
 
126
    done;
 
127
    match prog with
 
128
    | Some p -> p (float (y + 1) /. float nh)
 
129
    | None -> ()
 
130
  done;
 
131
  newimage;;