Commit 46204172 authored by Stephane Glondu's avatar Stephane Glondu

Imported Upstream version 4.1.3

parent 39036dd1
repo: e37886d73a98029822983bee73a2d90ceb4b298b
node: e70559bc4fcc98a125fee9fc8ced22237faa2d41
branch: for-release-4.1.2
tag: 4.1.2
node: 71025db891bd826fc1d608c2b52b8b9d3afdd218
branch: for_4.02
tag: 4.1.3
......@@ -4,3 +4,4 @@ ff3f1ccc87431ff26bf9dda1495c953505ecbd23 v4.0.1
0000000000000000000000000000000000000000 v4.0.1
0000000000000000000000000000000000000000 v4.0.1
c803efa9d5d33b908069f27f49b876e35853a708 v4.0.1
f650e32ed440423e2290e1ef819aecd8c99375bc 4.1.3
4.2.0
* OCaml 4.02.0 string/bytes fix
4.1.2
* GIF lib version 5 support
* clang related compilation fixes
......
......@@ -18,9 +18,7 @@ include OMyMakeroot
# For release, -warn-error should not be put
# OCaml 4.01.0
# OCAMLFLAGS= -w A-4-9-40-42-44-45
OCAMLFLAGS= -w A-4-9-40-42-44-45-37-41-35
OCAMLFLAGS= -w A-4-9-40-42-44-45-37-41-48
# For the development, -warn-error A is turned on
if $(file-exists DEV)
......@@ -36,7 +34,7 @@ PATH_RGB_TXT[]=
########################################################################
VERSION=4.1.2
VERSION=4.1.3
# for src/META
PACKAGE_NAME=camlimages
......
......@@ -101,8 +101,10 @@ Word_size() =
Check_ocamlfind_package_compilation(package, module) =
ConfMsgChecking($(package) compilability: open $(module))
tmp_ml = $(file $(tmpfile omake, .ml))
ConfMsgChecking($(tmp_ml))
tmp = $(file $(replacesuffixes .ml, $"$(EMPTY)", $(tmp_ml)))
command[] = $(OCamlC) -c -package $(package) $(tmp_ml)
command[] = $(OCamlC) -warn-error -a -c -package $(package) $(tmp_ml)
println($(string $(command)))
# The program
program = $"""(* Configuration file; you can remove this. *)
......@@ -199,9 +201,10 @@ BuildExample(namex, modules, packages) =
OCAMLPACKS[]+=unix # exif requires unix
export
.DEFAULT: $(OCamlProgram $(namex), $(modules))
else
println(Warning: $(namex) is not built: it requires $(string $(packages)))
println(Warning: Supported: $(string all_formats supported $(SUPPORTED_SUBPACKAGES)))
# too verbose
# else
# println(Warning: $(namex) is not built: it requires $(string $(packages)))
# println(Warning: Supported: $(string all_formats supported $(SUPPORTED_SUBPACKAGES)))
clean:
rm -f $(filter-proper-targets $(ls R, .)) *.cmt* *.sp*t
......
========================================================
CamlImages - Objective Caml image processing library
========================================================
The latest released version is 4.1.3.
========================================================
Note: This library is currently under development.
========================================================
What is CamlImages ?
========================================================
This is an image processing library, which provides some basic
functions of image processing and loading/saving various image file
formats. In addition the library can handle huge images that cannot be
(or can hardly be) stored into the memory (the library automatically
creates swap files and escapes them to reduce the memory usage).
Installation
========================================================
Read the file INSTALL.txt
Using CamlImages
========================================================
Color models
--------------------------------------------------------
CamlImages supports the following color models:
* Rgb24 -- 24bit depth full color image
* Index8 -- 8bit depth indexed image with transparent information
* Index16 -- 16bit depth indexed image with transparent information
For each color models, the corresponding module is provided. Use the module
Rgb24 if you want to access 24bit depth full color images, for example.
Load/Save image files and other fancy features
--------------------------------------------------------
CamlImages supports loading and saving of the following file formats:
* Bitmap (.bmp)
* Tiff (.tiff or .tif), color only
* Jpeg (.jpeg or .jpg)
* Png (.png)
* Ppm (.pbm, .pgm, .ppm), portable pixmaps
* PS (.ps, .eps), PostScript files
* X Pixmap (.xpm), no saving
* Gif (.gif) (not recommended)
* EXIF tag
For each image format, we provide a separate module. For instance,
there is a Tiff module to load and save images stored in the tiff file
format.
If you do not want to specify the file format, you can use Image.load:
this function automatically analyses the header of the image file at hand
and loads the image into the memory, if the library supports this format.
CamlImages also provides an interface to the internal image format of
O'Caml's Graphics library (this way you can draw your image files into
the Graphics window).
You can also draw strings on images using the Freetype library, which
is an external library to load and render TrueType fonts.
Class interface
--------------------------------------------------------
The modules begins the letter 'o' are the class interface for CamlImages.
Image swap
--------------------------------------------------------
When you create/load a huge image, the computer memory may not be
sufficient to contain all the data. (For example, this may happen if
you are working with a scanned image of A4, 720dpi, 24bit fullcolor,
even if you have up to 128Mb of memory!)
(Well, my son, the first version of this document was written around 1998,
and computers had less memory at that time.)
To work with such huge
images, CamlImages provides image swaps, which can escape part of the
images into files stored on the hard disk. A huge image is thus
partitioned into several blocks and if there is not enough free
memory, the blocks which have not been accessed recently are swapped
to temporary files. If a program requests to access to such a swapped
block, the library silently loads it back into memory.
By default, image swapping is disabled, because it slows down the
programs. To activate this function, you have to modify
Bitmap.maximum_live and Bitmap.maximum_block_size. Bitmap.maximum_live
is the maximum heap live data size of the program (in words) and
Bitmap.maximum_block_size is the maximum size of swap blocks (in
words).
For example, if you do not want to use more than 10M words (that is
40Mb for a 32bit architecture or 80Mb for a 64bit architecture), set
Bitmap.maximum_live to 10000000. You may (and you should) enable heap
compaction, look at the GC interface file, gc.mli, in the standard
library for more details (you should change the compaction configuration).
Bitmap.maximum_block_size affects the speed and frequency of image
block swapping. If it is larger, each swapping becomes slower. If it
is smaller, more swappings will occur. Too large and too small
maximum_block_size, both may make the program slower. I suggest to
have maximum_block_size set to !Bitmap.maximum_live / 10.
If you activated image swapping, cache files for unused swapped
blocks will be removed automatically by Caml GC finalization,
but you may free them explicitly by hand also. The functions and methods
named "destroy" will free those blocks.
The swap files are usually created in the /tmp directory. If you
set the environment variable "CAMLIMAGESTMPDIR", then its value
replaces the default "/tmp" directory. The temporary files are erased
when the program exits successfully. In other situations, for instance
in case of spurious exception, you may need to erase temporary files
manually.
Where to report issues?
==========================================================
https://bitbucket.org/camlspotter/camlimages/issues?status=new&status=open
......@@ -46,9 +46,9 @@ let edge edgename img24 =
match edgename with
| Some _ ->
Some (new rgb24_with img24#width img24#height
[] (String.copy img24#dump))
[] (Bytes.copy img24#dump))
| None -> None in
let edge = Array.init img24#width (fun _ -> Array.create img24#height 0) in
let edge = Array.init img24#width (fun _ -> Array.make img24#height 0) in
(* inner kills outer *)
let s = if img24#width < img24#height then img24#width else img24#height in
......@@ -103,7 +103,7 @@ let edge edgename img24 =
done;
done;
let edge2 = Array.init img24#width (fun _ -> Array.create img24#height 0) in
let edge2 = Array.init img24#width (fun _ -> Array.make img24#height 0) in
(* sole points are dead *)
for x = 0 to img24#width -1 do
for y =0 to img24#height -1 do
......
......@@ -21,7 +21,7 @@ type ('a, 'b) elt = {
type ('a, 'b) t = ('a, 'b) elt option array;;
let create size = Array.create size None;;
let create size = Array.make size None;;
let find_pos t key =
let found = ref 0 in
......
......@@ -179,7 +179,7 @@ let display_pixbuf pixbuf =
(x, y), overwrap x y in
let min = ref (random_x_y ()) in
for i = 0 to 5 do
for _i = 0 to 5 do
let (x, y), over = random_x_y () in
if snd !min > over then min := (x, y), over
done;
......
......@@ -123,7 +123,6 @@ let guess link_as_link f =
end;;
let guess = guess false
and _lguess = guess true;;
(* prerr_endline "reading suffix"; *)
read_suffix_file default_mime_types;;
let () = read_suffix_file default_mime_types
......@@ -31,7 +31,7 @@ let scan_dir f fn =
| e -> prerr_endline ("readdir: " ^ Printexc.to_string e)
end;
closedir dh;
let files = Sort.list (>) !files in
let files = List.sort (fun x y -> compare y x) !files in
let subdirs = ref [] in
let treat fn' =
if not (fn' = ".." || fn' = ".") then begin
......
......@@ -395,8 +395,8 @@ let main () =
p "{ currentfile scanline readhexstring pop } false 3";
p "colorimage";
let buf = String.create (imgw * 3) in
for y = 0 to y1 - 1 do th.read_next_line buf done;
let buf = Bytes.create (imgw * 3) in
for _y = 0 to y1 - 1 do th.read_next_line buf done;
let prevperdec = ref (-1) in
for y = y1 to y1 + h - 1 do
let perdec = (y - y1) * 10 / h in
......@@ -421,7 +421,7 @@ let main () =
mono (Char.code buf.[adrs])
(Char.code buf.[adrs + 1])
(Char.code buf.[adrs + 2]) in
for i = 0 to 2 do print_string (sprintf "%02x" m) done in
for _i = 0 to 2 do print_string (sprintf "%02x" m) done in
if not conf.mirror
then for x = x1 to x1 + w - 1 do print_pixel x done
else for x = x1 + w - 1 downto x1 do print_pixel x done;
......
......@@ -9,7 +9,7 @@ remove: [
]
depends: ["ocamlfind" "base-unix" "omake"]
depopts: ["lablgtk"]
ocaml-version: [>= "4.01.0"]
ocaml-version: [>= "4.02.0"]
homepage: "https://bitbucket.org/camlspotter/camlimages"
license: "LGPL-2 with OCaml linking exception"
authors: [
......
......@@ -86,6 +86,7 @@ CFILES_all_formats=
###################################################################### ML FILES
FILES_core[]=
util
bitmap
blend
camlimages
......
......@@ -12,6 +12,8 @@
(* $Id: bitmap.ml,v 1.7 2009/07/04 03:39:28 furuse Exp $*)
open Util
let debug = ref true;;
let debugs s = if !debug then prerr_endline s;;
......@@ -35,9 +37,9 @@ type block = {
let swappable_blocks = ref [];;
(* wrapped String.create *)
(* wrapped Bytes.create *)
let string_create s =
try String.create s with Invalid_argument _ -> raise Out_of_memory;;
try Bytes.create s with Invalid_argument _ -> raise Out_of_memory;;
module Block = struct
type t = {
......@@ -186,7 +188,7 @@ module Make(B:Bitdepth) = struct
let swap_out_eldest words =
let sorted =
Sort.list (fun b1 b2 -> b1.last_used < b2.last_used) !swappable_blocks in
List.sort (fun b1 b2 -> compare b1.last_used b2.last_used) !swappable_blocks in
let rec swapper sorted i =
match sorted with
| [] -> ()
......@@ -277,7 +279,7 @@ module Make(B:Bitdepth) = struct
| Out_of_memory -> alloc_test_block (p + 1) in
let blocks, test_block = alloc_test_block (get_block_size 1) in
(* use the block so that it is not GCed too early *)
test_block.[0] <- '0';
test_block << 0 & '0';
(* Create bitmap *)
let blocks_x = blocks
......
......@@ -53,7 +53,7 @@ module Block : sig
height : int;
x : int;
y : int;
dump : string;
dump : bytes;
}
end
......@@ -65,45 +65,45 @@ module Make(B:Bitdepth) : sig
type t;;
(* Bitmap type *)
val create : int -> int -> string option -> t
val create : int -> int -> bytes option -> t
(* [create width height initopt] creates a bitmap of size
[width] x [height]. You can set [initopt] the value to
fill the bitmap *)
val create_with : int -> int -> string -> t
val create_with : int -> int -> bytes -> t
(* [create_with width height initdata] creates a bitmap whose
initial data is [initdata]. *)
val create_with_scanlines : int -> int -> string array -> t
val create_with_scanlines : int -> int -> bytes array -> t
val destroy : t -> unit
(* Destroy bitmaps *)
val access : t -> int -> int -> string * int
val access : t -> int -> int -> bytes * int
val get_strip : t -> int -> int -> int -> string
val set_strip : t -> int -> int -> int -> string -> unit
val get_strip : t -> int -> int -> int -> bytes
val set_strip : t -> int -> int -> int -> bytes -> unit
(* Strip access
Here, "strip" means a rectangle region with height 1.
[get_strip t x y w] returns the string reprensentation of strip of [t]
[get_strip t x y w] returns the bytes reprensentation of strip of [t]
at (x, y) - (x + w - 1, y).
[set_strip t x y w str] write [str] to the strip of [t]
at (x, y) - (x + w - 1, y).
*)
val get_scanline : t -> int -> string
val set_scanline : t -> int -> string -> unit
val get_scanline : t -> int -> bytes
val set_scanline : t -> int -> bytes -> unit
(* Scanline access
[get_scanline t y] returns the string representation of the scanline
[get_scanline t y] returns the bytes representation of the scanline
of [t] at [y].
[set_scanline t y str] writes [str] to the scanline of [t] at [y].
*)
(* only for one row *)
val get_scanline_ptr : t -> (int -> (string * int) * int) option
val get_scanline_ptr : t -> (int -> (bytes * int) * int) option
val dump : t -> string
(* Create a string representation of a bitmap. It may easily raise
val dump : t -> bytes
(* Create a bytes representation of a bitmap. It may easily raise
an exception Out_of_memory for large images. *)
val copy : t -> t
......
......@@ -17,6 +17,7 @@
(* Loading and saving image in the bmp format. *)
open Images;;
open Util
(*
Caml representation of a bmp bit map image.
......@@ -226,7 +227,7 @@ let load_colors bfh _bih ic =
(* Loads image data when image has 8 bit depth *)
let load_image8data bih ic =
let bitmap = String.create (bih.biWidth * bih.biHeight) in
let bitmap = Bytes.create (bih.biWidth * bih.biHeight) in
match bih.biCompression with
| BI_RGB ->
(* No compression : lines are stored in reverse order *)
......@@ -237,7 +238,7 @@ let load_image8data bih ic =
let bitmapindex = ref (i * bih.biWidth) in
for j = 0 to pad - 1 do
let c = Char.chr (read_byte ic) in
if j < bih.biWidth then bitmap.[!bitmapindex] <- c;
if j < bih.biWidth then bitmap << !bitmapindex & c;
incr bitmapindex
done
done;
......@@ -278,7 +279,7 @@ let load_image8data bih ic =
each of which contains the color index of a single pixel. *)
for _i = 0 to c - 1 do
let c1 = read_byte ic in
bitmap.[!bitmapindex] <- Char.chr c1;
bitmap << !bitmapindex & Char.chr c1;
incr x;
incr bitmapindex
done;
......@@ -289,7 +290,7 @@ let load_image8data bih ic =
(* Encoded mode *)
let c1 = read_byte ic in
for _i = 0 to c - 1 do
bitmap.[!bitmapindex] <- Char.chr c1;
bitmap << !bitmapindex & Char.chr c1;
incr x;
incr bitmapindex
done
......@@ -300,7 +301,7 @@ let load_image8data bih ic =
;;
let load_image1data bih ic =
let bitmap = String.create (bih.biWidth * bih.biHeight) in
let bitmap = Bytes.create (bih.biWidth * bih.biHeight) in
let c = ref 0 in
(* each scan line 'w', is padded to be a multiple of 32 *)
let pad = ((bih.biWidth + 31) / 32) * 32 in
......@@ -316,7 +317,7 @@ let load_image1data bih ic =
end;
if j < bih.biWidth then
begin
bitmap.[!bitmapindex] <- if !c land 0x80 <> 0 then '\001' else '\000';
bitmap << !bitmapindex & if !c land 0x80 <> 0 then '\001' else '\000';
incr bitmapindex;
c := !c lsl 1;
end;
......@@ -327,7 +328,7 @@ let load_image1data bih ic =
;;
let load_image4data bih ic =
let bitmap = String.create (bih.biWidth * bih.biHeight) in
let bitmap = Bytes.create (bih.biWidth * bih.biHeight) in
match bih.biCompression with
| BI_RGB ->
(* 'w' is padded to be a multiple of 8 pixels (32 bits) *)
......@@ -346,7 +347,7 @@ let load_image4data bih ic =
end;
if j < bih.biWidth then
begin
bitmap.[!bitmapindex] <- Char.chr ((!c land 0xf0) lsr 4);
bitmap << !bitmapindex & Char.chr ((!c land 0xf0) lsr 4);
incr bitmapindex;
c := !c lsl 4
end;
......@@ -385,7 +386,7 @@ let load_image4data bih ic =
for i = 0 to c - 1 do
if i land 1 = 0 then c1 := read_byte ic;
let c = if i land 1 <> 0 then !c1 else !c1 lsr 4 in
bitmap.[!bitmapindex] <- Char.chr (c land 0x0F);
bitmap << !bitmapindex & Char.chr (c land 0x0F);
incr x;
incr bitmapindex
done;
......@@ -400,7 +401,7 @@ let load_image4data bih ic =
and col2 = (c1 lsr 4) land 0x0F in
for i = 0 to c - 1 do
let c = if i land 1 <> 0 then col1 else col2 in
bitmap.[!bitmapindex] <- Char.chr c;
bitmap << !bitmapindex & Char.chr c;
incr x;
incr bitmapindex
done
......@@ -412,15 +413,15 @@ let load_image4data bih ic =
let load_image24data bih ic =
(* Bitmap is a string of RGB bytes *)
let bitmap = String.create ((bih.biWidth * bih.biHeight) * 3) in
let bitmap = Bytes.create ((bih.biWidth * bih.biHeight) * 3) in
let pad = (4 - ((bih.biWidth * 3) mod 4)) land 0x03 in
let pp = ref 0 in
for i = bih.biHeight - 1 downto 0 do
pp := (i * bih.biWidth * 3);
for _j = 0 to bih.biWidth - 1 do
bitmap.[!pp + 2] <- Char.chr (read_byte ic); (* Blue *)
bitmap.[!pp + 1] <- Char.chr (read_byte ic); (* Green *)
bitmap.[!pp] <- Char.chr (read_byte ic); (* Red *)
bitmap << !pp + 2 & Char.chr (read_byte ic); (* Blue *)
bitmap << !pp + 1 & Char.chr (read_byte ic); (* Green *)
bitmap << !pp & Char.chr (read_byte ic); (* Red *)
pp := !pp + 3
done;
for _j = 0 to pad - 1 do skip_byte ic done;
......@@ -430,7 +431,7 @@ let load_image24data bih ic =
let load_image32data bih ic =
(* Bitmap is a string of RGB bytes *)
let bitmap = String.create ((bih.biWidth * bih.biHeight) * 4) in
let bitmap = Bytes.create ((bih.biWidth * bih.biHeight) * 4) in
(*
let pad = (4 - ((bih.biWidth * 4) mod 4)) land 0x03 in
let pad = 1 in
......@@ -439,10 +440,10 @@ let load_image32data bih ic =
for i = bih.biHeight - 1 downto 0 do
pp := (i * bih.biWidth * 4);
for _j = 0 to bih.biWidth - 1 do
bitmap.[!pp + 2] <- Char.chr (read_byte ic); (* Blue *)
bitmap.[!pp + 1] <- Char.chr (read_byte ic); (* Green *)
bitmap.[!pp + 0] <- Char.chr (read_byte ic); (* Red *)
bitmap.[!pp + 3] <- Char.chr (read_byte ic); (* Alpha *)
bitmap << !pp + 2 & Char.chr (read_byte ic); (* Blue *)
bitmap << !pp + 1 & Char.chr (read_byte ic); (* Green *)
bitmap << !pp + 0 & Char.chr (read_byte ic); (* Red *)
bitmap << !pp + 3 & Char.chr (read_byte ic); (* Alpha *)
pp := !pp + 4
done;
(*
......
......@@ -14,11 +14,11 @@
(* $Id: bmp.mli,v 1.2 2009/02/08 14:27:00 weis Exp $ *)
val check_header : string -> Images.header;;
val check_header : bytes -> Images.header;;
(** Checks the file header *)
val load : string -> Images.load_option list -> Images.t;;
val load : bytes -> Images.load_option list -> Images.t;;
(** Loads a bmp image. *)
val save : string -> Images.save_option list -> Images.t -> unit;;
val save : bytes -> Images.save_option list -> Images.t -> unit;;
(** Save an image in bmp format file. *)
(*** Below, they are all lower interfaces *)
......@@ -39,7 +39,7 @@ type bmp = {
bmpFileHeader : bitmapfileheader; (** Bytes <0 14< *)
bmpInfoHeader : bitmapinfoheader; (** Bytes <14 54< *)
bmpRgbQuad : Images.rgb array; (** Bytes <54 ... *)
bmpBytes : string; (** Bytes <bfOffBits ... *)
bmpBytes : bytes; (** Bytes <bfOffBits ... *)
}
and bitmapfileheader = {
......@@ -108,6 +108,6 @@ and bibitcount =
(** 32 The bitmap *)
;;
val load_bmp : string -> bmp;;
val save_bmp : string -> bmp -> unit;;
val load_bmp : bytes -> bmp;;
val save_bmp : bytes -> bmp -> unit;;
(** Load and save functions for BMP images. *)
......@@ -16,6 +16,8 @@
(* CMYK 32 bit depth image format *)
open Util
module E = struct
open Color
type t = Color.cmyk
......@@ -26,12 +28,12 @@ module E = struct
y = int_of_char str.[pos + 2];
k = int_of_char str.[pos + 3]; }
let set str pos t =
str.[pos ] <- char_of_int t.c;
str.[pos + 1] <- char_of_int t.m;
str.[pos + 2] <- char_of_int t.y;
str.[pos + 3] <- char_of_int t.k
str << pos & char_of_int t.c;
str << pos + 1 & char_of_int t.m;
str << pos + 2 & char_of_int t.y;
str << pos + 3 & char_of_int t.k
let make t =
let str = String.create bytes_per_pixel in
let str = Bytes.create bytes_per_pixel in
set str 0 t;
str
end;;
......
......@@ -31,12 +31,12 @@ type t = {
(* Generic functions *)
(* Please read the comments of IMAGE in genimage.mli *)
val dump : t -> string;;
val unsafe_access : t -> int -> int -> string * int;;
val get_strip : t -> int -> int -> int -> string;;
val set_strip : t -> int -> int -> int -> string -> unit;;
val get_scanline : t -> int -> string;;
val set_scanline : t -> int -> string -> unit;;
val dump : t -> bytes;;
val unsafe_access : t -> int -> int -> bytes * int;;
val get_strip : t -> int -> int -> int -> bytes;;
val set_strip : t -> int -> int -> int -> bytes -> unit;;
val get_scanline : t -> int -> bytes;;
val set_scanline : t -> int -> bytes -> unit;;
val unsafe_get : t -> int -> int -> elt;;
val unsafe_set : t -> int -> int -> elt -> unit;;
val get : t -> int -> int -> elt;;
......@@ -47,8 +47,8 @@ val map : (elt -> elt -> elt) ->
t -> int -> int -> t -> int -> int -> int -> int -> unit;;
val blocks : t -> int * int
val dump_block : t -> int -> int -> Bitmap.Block.t
val create_with : int -> int -> Info.info list -> string -> t;;
val create_with_scanlines : int -> int -> Info.info list -> string array -> t;;
val create_with : int -> int -> Info.info list -> bytes -> t;;
val create_with_scanlines : int -> int -> Info.info list -> bytes array -> t;;
val create : int -> int -> t;;
val make : int -> int -> elt -> t;;
val copy : t -> t;;
......
......@@ -18,7 +18,7 @@ open Color;;
type t = int array;;
let create () = Array.create 256 0;;
let create () = Array.make 256 0;;
let total_samples t = Array.fold_left (fun st x -> st + x) 0 t;;
......
......@@ -26,11 +26,7 @@ let func_darken_only org level =
let func_red_only _org _level = { r = 255; g = 0; b = 0 };;
let unicode_of_latin s =
let ary = Array.create (String.length s) 0 in
for i = 0 to String.length s - 1 do
ary.(i) <- Char.code s.[i]
done;
ary;;
Array.init (String.length s) @@ fun i -> Char.code s.[i]
let unicode_of_euc_japan s = Jis_unicode.encode s;;
......
......@@ -16,6 +16,7 @@
open Images;;
open Index8;;
open Util
let debug =
try ignore (Sys.getenv "CAMLIMAGES_DEBUG_GIF"); true with
......@@ -345,10 +346,10 @@ let save filename opts sequence =
(* write loops *)
let loop_written = ref false in
if sequence.loops <> 0 then begin
let str = String.create 3 in
str.[0] <- '\001';
str.[1] <- char_of_int (sequence.loops mod 256);
str.[2] <- char_of_int (sequence.loops / 256);
let str = Bytes.create 3 in
Bytes.unsafe_set str 0 @@ '\001';
Bytes.unsafe_set str 1 @@ char_of_int (sequence.loops mod 256);
Bytes.unsafe_set str 2 @@ char_of_int (sequence.loops / 256);
eGifPutExtension oc
(gif_make_extension (GifApplication ["NETSCAPE2.0"; str]));
loop_written := true
......@@ -385,14 +386,14 @@ let save filename opts sequence =
| Some str -> str
| None -> String.make 4 '\000' in
if frame.frame_bitmap.transparent <> -1 then begin
str.[0] <- char_of_int (int_of_char str.[0] lor 0x01);
str.[3] <- char_of_int frame.frame_bitmap.transparent
str << 0 & char_of_int (int_of_char str.[0] lor 0x01);
str << 3 & char_of_int frame.frame_bitmap.transparent
end else begin
str.[0] <- char_of_int (int_of_char str.[0] land 0xfe);
str.[3] <- '\000'
str << 0 & char_of_int (int_of_char str.[0] land 0xfe);
str << 3 & '\000'
end;
str.[1] <- char_of_int (frame.frame_delay mod 256);
str.[2] <- char_of_int (frame.frame_delay / 256);
str << 1 & char_of_int (frame.frame_delay mod 256);
str << 2 & char_of_int (frame.frame_delay / 256);
eGifPutExtension oc (gif_make_extension (GifGraphics [str]))
end;
......@@ -456,7 +457,7 @@ let check_header filename =
let len = 10 in
let ic = open_in_bin filename in
try
let str = String.create len in
let str = Bytes.create len in
really_input ic str 0 len;
close_in ic;
match String.sub str 0 6 with
......
......@@ -14,14 +14,14 @@
(* $Id: image_intf.mli,v 1.2 2009/07/04 03:39:28 furuse Exp $ *)
(** Color to string encoder/decoder module type *)
(** Color to bytes encoder/decoder module type *)
module type ENCODE =
sig
type t
val bytes_per_pixel : int
val get : string -> int -> t
val set : string -> int -> t -> unit
val make : t -> string
val get : bytes -> int -> t
val set : bytes -> int -> t -> unit
val make : t -> bytes
end;;