← Back to branch summary

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

« back to all changes in this revision

Viewing changes to src/index16.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/index16.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: index16.ml,v 1.1 2006/11/28 15:43:28 rousse Exp $*)
 
16
 
 
17
module E = struct
 
18
  open Color
 
19
  type t = int
 
20
  let bytes_per_pixel = 2
 
21
  let get str pos =
 
22
    int_of_char str.[pos    ] * 256 +
 
23
    int_of_char str.[pos + 1]
 
24
  let set str pos t =
 
25
    str.[pos    ] <- char_of_int (t / 256);
 
26
    str.[pos + 1] <- char_of_int (t mod 256)
 
27
  let make t =
 
28
    let str = String.create bytes_per_pixel in
 
29
    set str 0 t;
 
30
    str
 
31
end;;
 
32
 
 
33
module RI = Genimage.MakeRawImage(E);;
 
34
 
 
35
type rawimage = RI.t;;
 
36
type elt = int;;
 
37
type t = { width : int;
 
38
           height : int;
 
39
           rawimage : RI.t;
 
40
           mutable infos : Info.info list;
 
41
           mutable colormap : Color.rgb Color.map;
 
42
           mutable transparent : int };;
 
43
 
 
44
module C = struct
 
45
  open Color
 
46
 
 
47
  type rawimage = RI.t
 
48
  type container = t
 
49
  type mapelt = Color.rgb
 
50
  let rawimage x = x.rawimage
 
51
  let create_default width height rawimage =
 
52
    { width = width;
 
53
      height = height;
 
54
      rawimage = rawimage;
 
55
      colormap = { map = [||]; max = 65535 };
 
56
      transparent = (-1);
 
57
      infos = [] }
 
58
  let create_duplicate src width height rawimage =
 
59
    { width = width;
 
60
      height = height;
 
61
      rawimage = rawimage;
 
62
      colormap = src.colormap;
 
63
      transparent = src.transparent;
 
64
      infos = src.infos; }
 
65
  let colormap t = t.colormap
 
66
end;;
 
67
 
 
68
module IMAGE = Genimage.MakeIndexed(RI)(C);;
 
69
 
 
70
let create_with width height infos colormap transparent data =
 
71
  { width = width;
 
72
    height = height;
 
73
    rawimage = RI.create_with width height data;
 
74
    colormap = colormap;
 
75
    transparent = transparent;
 
76
    infos = infos; };;
 
77
 
 
78
let rawimage = C.rawimage;;
 
79
let create = IMAGE.create;;
 
80
let make = IMAGE.make;;
 
81
let dump = IMAGE.dump;;
 
82
let unsafe_access = IMAGE.unsafe_access;;
 
83
let get_strip = IMAGE.get_strip;;
 
84
let set_strip = IMAGE.set_strip;;
 
85
let get_scanline = IMAGE.get_scanline;;
 
86
let set_scanline = IMAGE.set_scanline;;
 
87
let unsafe_get = IMAGE.unsafe_get;;
 
88
let unsafe_set = IMAGE.unsafe_set;;
 
89
let get = IMAGE.get;;
 
90
let set = IMAGE.set;;
 
91
let unsafe_get_color = IMAGE.unsafe_get_color;;
 
92
let get_color = IMAGE.get_color;;
 
93
let destroy = IMAGE.destroy;;
 
94
let copy = IMAGE.copy;;
 
95
let sub = IMAGE.sub;;
 
96
let blit = IMAGE.blit;;
 
97
let map = IMAGE.map;;
 
98
 
 
99
let unsafe_get_rgb = unsafe_get_color;;
 
100
let get_rgb = get_color;;
 
101
 
 
102
open Color;;
 
103
 
 
104
let to_rgb24 ?failsafe t =
 
105
  let rgb24 = Rgb24.create t.width t.height in
 
106
  let cmapsize = Array.length t.colormap.map in
 
107
  begin match failsafe with
 
108
  | Some failsafecolor ->
 
109
    for y = 0 to t.height - 1 do
 
110
      for x = 0 to t.width - 1 do
 
111
        let idx = unsafe_get t x y in
 
112
        let rgb =
 
113
          if idx < 0 || idx >= cmapsize then failsafecolor
 
114
          else t.colormap.map.(idx) in
 
115
        Rgb24.unsafe_set rgb24 x y rgb
 
116
      done
 
117
    done
 
118
  | None ->
 
119
    for y = 0 to t.height - 1 do
 
120
      for x = 0 to t.width - 1 do
 
121
        Rgb24.unsafe_set rgb24 x y (unsafe_get_color t x y)
 
122
      done
 
123
    done
 
124
  end;
 
125
  rgb24;;
 
126
 
 
127
let to_rgba32 ?failsafe t =
 
128
  let rgba32 = Rgba32.create t.width t.height in
 
129
  let cmapsize = Array.length t.colormap.map in
 
130
 
 
131
  begin match failsafe with
 
132
  | Some failsafecolor ->
 
133
    for y = 0 to t.height - 1 do
 
134
      for x = 0 to t.width - 1 do
 
135
        let rgba =
 
136
          let index = unsafe_get t x y in
 
137
          if index < 0 || index >= cmapsize then failsafecolor
 
138
          else
 
139
            { color = t.colormap.map.(index);
 
140
              alpha = if index = t.transparent then 0 else 255; } in
 
141
        Rgba32.unsafe_set rgba32 x y rgba
 
142
      done
 
143
    done
 
144
  | None ->
 
145
    for y = 0 to t.height - 1 do
 
146
      for x = 0 to t.width - 1 do
 
147
        let index = unsafe_get t x y in
 
148
        Rgba32.unsafe_set rgba32 x y
 
149
          { color = t.colormap.map.(index);
 
150
            alpha = if index = t.transparent then 0 else 255 }
 
151
      done
 
152
    done
 
153
  end;
 
154
  rgba32;;