Commits

camlspotter committed 46fe34d

ppm save was somehow disabled. #FIX

  • Participants
  • Parent commits 7e9024c

Comments (0)

Files changed (4)

 let save_raw_pbm_oc =
  gen_save_raw_pbm_oc (fun c -> c.r = 255 && c.g = 255 && c.b = 255);; 
 
-(*
-(* Save a transparency mask as a bitmap in raw form. *)
-let save_mask = gen_save_raw_pbm_oc (fun c -> c = transp);;
-*)
-
 (* Save a pixmap in raw form. *)
 let save_raw_ppm_oc img oc l c =
   save_ppm_header img P6 oc l c;
-  let has_transp = ref false in
   for i = 0 to l - 1 do
    for j = 0 to c - 1 do
     let color = Rgb24.get img j i in
     output_byte oc color.g;
     output_byte oc color.b
    done
-  done;
-  !has_transp;;
+  done
 
-let save_ppm_oc img _oc =
+let save_ppm_oc img oc =
   let l = img.Rgb24.height in
   if l = 0 then invalid_arg "save_ppm: invalid null line number";
   let c = img.Rgb24.width in
   if c = 0 then invalid_arg "save_ppm: invalid null column number";
-  (*
-  let has_transp = save_raw_ppm_oc img oc l c in
-  if has_transp then
-   begin
-    (* Save the transparency mask *)
-    output_char oc '\n';
-    save_mask img oc l c;
-    (* and correct the magic number *)
-    seek_out oc 1;
-    output_char oc '0';
-   end*)
-   ();;
+  save_raw_ppm_oc img oc l c
 
 let save_ppm s img =
  let oc = open_out_bin s in

File test/OMakefile

 
 BuildExample(test, test, $(SUB_PACKAGES))
 
+# BuildExample is badly written, so we need reseting OCAML_LIBS
+OCAML_LIBS=
+BuildExample(test2, test2, $(SUB_PACKAGES))
+
 clean:
   rm -f $(filter-proper-targets $(ls R, .))
   rm -f out.image

File test/test.ml

     prerr_endline
       (Printf.sprintf "%s: %s format, %dx%d"
          name (extension format) header.header_width header.header_height);
-    begin match format with
+    match format with
     | Gif ->
-      prerr_endline ("Loading " ^ name ^ "...");
-      let sequence = Gif.load name [] in
-      prerr_endline "Loaded";
-      let w = sequence.screen_width
-      and h = sequence.screen_height in
-      let w' = Graphics.size_x () - w
-      and h' = Graphics.size_y () - h in
-      let x = if w' > 0 then Random.int w' else 0
-      and y = if h' > 0 then Random.int h' else 0 in
-      draw_string name x y;
-      List.iter (fun frame ->
-        let put_x = x + frame.frame_left
-        and put_y = y + frame.frame_top in
-        show_image (Index8 frame.frame_bitmap) put_x put_y;
-        (* if not (go_on ()) then raise Exit *) )
-        sequence.frames;
-      begin
-        try
-          Gif.save "out.image" [] sequence;
-          prerr_endline "Saved";
-        with
-        | _ -> prerr_endline "Save failed"
-      end;
-      if not (go_on ()) then raise Exit
+        prerr_endline ("Loading " ^ name ^ "...");
+        let sequence = Gif.load name [] in
+        prerr_endline "Loaded";
+        let w = sequence.screen_width
+        and h = sequence.screen_height in
+        let w' = Graphics.size_x () - w
+        and h' = Graphics.size_y () - h in
+        let x = if w' > 0 then Random.int w' else 0
+        and y = if h' > 0 then Random.int h' else 0 in
+        draw_string name x y;
+        List.iter (fun frame ->
+          let put_x = x + frame.frame_left
+          and put_y = y + frame.frame_top in
+          show_image (Index8 frame.frame_bitmap) put_x put_y;
+          (* if not (go_on ()) then raise Exit *) )
+          sequence.frames;
+        begin
+          try
+            Gif.save "out.image" [] sequence;
+            prerr_endline "Saved";
+          with
+          | _ -> prerr_endline "Save failed"
+        end;
+        if not (go_on ()) then raise Exit
     | _ ->
-      prerr_endline ("Loading " ^ name ^ "...");
-      let img = Images.load name [] in
-      prerr_endline "Loaded";
-      let w, h = Images.size img in
-      let w' = Graphics.size_x () - w
-      and h' = Graphics.size_y () - h in
-      let x = if w' > 0 then Random.int w' else 0
-      and y = if h' > 0 then Random.int h' else 0 in
-      show_image img x y;
-      draw_string name x y;
-      begin
-        try
-          Images.save "out.image" (Some format) [] img;
-          prerr_endline "Saved";
-        with
-        | _ -> prerr_endline "Save failed"
-      end;
-      if not (go_on ()) then raise Exit
-      end;
+        prerr_endline ("Loading " ^ name ^ "...");
+        let img = Images.load name [] in
+        prerr_endline "Loaded";
+        let w, h = Images.size img in
+        let w' = Graphics.size_x () - w
+        and h' = Graphics.size_y () - h in
+        let x = if w' > 0 then Random.int w' else 0
+        and y = if h' > 0 then Random.int h' else 0 in
+        show_image img x y;
+        draw_string name x y;
+        begin
+          try
+            Images.save "out.image" (Some format) [] img;
+            prerr_endline "Saved";
+          with
+          | _ -> prerr_endline "Save failed"
+        end;
+        if not (go_on ()) then raise Exit
   with
   | Wrong_file_type -> prerr_endline "file format detection failed"
   | Failure s -> prerr_endline s;;

File test/test2.ml

+(***********************************************************************)
+(*                                                                     *)
+(*                           Objective Caml                            *)
+(*                                                                     *)
+(*            Fran�ois Pessaux, projet Cristal, INRIA Rocquencourt     *)
+(*            Pierre Weis, projet Cristal, INRIA Rocquencourt          *)
+(*            Jun Furuse, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                     *)
+(*  Copyright 1999-2004,                                               *)
+(*  Institut National de Recherche en Informatique et en Automatique.  *)
+(*  Distributed only by permission.                                    *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* $Id: test.ml,v 1.32.2.1 2010/05/13 13:14:47 furuse Exp $ *)
+
+open Images;;
+open Format;;
+
+let capabilities () =
+  let supported b = if b then "supported" else "not supported" in
+  printf "*******************************************************@.";
+  printf "Camlimages library capabilities currently available@.";
+  printf "bmp\t: %s@." (supported Camlimages.lib_bmp);
+  printf "ppm\t: %s@." (supported Camlimages.lib_ppm);
+  printf "gif\t: %s@." (supported Camlimages.lib_gif);
+  printf "jpeg\t: %s@." (supported Camlimages.lib_jpeg);
+  printf "tiff\t: %s@." (supported Camlimages.lib_tiff);
+  printf "png\t: %s@." (supported Camlimages.lib_png);
+  printf "xpm\t: %s@." (supported Camlimages.lib_xpm);
+  printf "xv thumbnails\t: %s@." (supported Camlimages.lib_xvthumb);
+  printf "postscript\t: %s@." (supported Camlimages.lib_ps);
+  printf "freetype\t: %s@." (supported Camlimages.lib_freetype);
+  printf "*******************************************************@.";;
+
+let show_image img x y =
+  let img = 
+    match img with
+    | Rgba32 img -> Rgb24 (Rgb24.of_rgba32 img)
+    | _ -> img
+  in
+  let gr_img = Graphics.make_image (Graphic_image.array_of_image img) in
+  Graphics.draw_image gr_img x y;;
+
+module FtDraw = Fttext.Make(Rgb24);;
+
+let images = [
+  "apbm.pbm"; "apgm.pgm"; "appm.ppm";
+  "pbm.pbm"; "pgm.pgm"; "ppm.ppm";
+  "jpg.jpg"; "png.png"; "png-alpha.png"; "bmp.bmp"; "tif.tif";
+  "xpm.xpm"; "eps.eps"; "gif.gif"; "mmm.anim.gif";
+];;
+
+open Gif;;
+
+let treat_image name0 =
+  let name = "images/" ^ name0 in
+  prerr_endline (name ^ "...");
+  try
+    let format, header = Images.file_format name in
+    prerr_endline
+      (Printf.sprintf "%s: %s format, %dx%d"
+         name (extension format) header.header_width header.header_height);
+    match format with
+    | Gif ->
+        let sequence = Gif.load name [] in
+        Gif.save ("out-" ^ name0) [] sequence
+    | _ ->
+        let img = Images.load name [] in
+        Images.save ("out-" ^ name0) (Some format) [] img;
+  with
+  | Wrong_file_type -> prerr_endline "file format detection failed"
+  | Failure s -> prerr_endline s;;
+
+let main () =
+  capabilities ();
+  try List.iter treat_image images
+  with
+  | Exit -> exit 0
+  | End_of_file -> exit 0
+  | Sys.Break -> exit 2;;
+
+main ();;