pgm
pgm.ads
pgm.adb
images
bit_buffers
depixel
gray_images
images
pbm
pgm
pnm
util
hash_tables/
heaps/
images/
lists/
maths/
messages/
pipes/
primes/
readers/
strings/
writers/
ada
bin/
engine/
fonts/
internal/
text/
util/
Home
Showcase
Snapshots
Ada Source
PHP Source
Fonts
Sourceforge
Summary
Downloads
Browse CVS
Donate
Activity

Hosted by
SourceForge.net Logo

 -- $Date: 2004/02/23 08:44:24 $
-- $Revision: 1.18 $
-- $Author: jcrocholl $

with Ada.Exceptions; use Ada.Exceptions;
with Ada.Streams.Stream_IO; use Ada.Streams.Stream_IO;

with PNM; use PNM;
with Pipes;

package body PGM is

   PGM_Magic : constant String := "P5";

   procedure Read_Header
     (Stream : in Stream_Access;
      Width  : out Positive;
      Height : out Positive)
   is
      Magic  : String2;
      Maxval : Positive;
   begin
      Read_Header(Stream, Magic, Width, Height, Maxval);
      if Magic /= PGM_Magic then
         Raise_Exception(Expect_P5'Identity,
           "not a PGM file: expected """ & PGM_Magic &
           """ but found """ & Magic & """");
      end if;
      if Maxval /= 255 then
         Raise_Exception(Expect_Maxval_255'Identity,
           "maxval must be 255, is" & Positive'Image(Maxval));
      end if;
   end Read_Header;

   procedure Write_Header
     (Stream : in Stream_Access;
      Width  : in Positive;
      Height : in Positive) is
   begin
      Write_Header(Stream, PGM_Magic, Width, Height, 255);
   end Write_Header;

   -- Read a gray image from a portable graymap stream.
   function Read
     (Stream : in Stream_Access) -- Read from this stream.
     return Gray_Image_Access    -- The newly created image.
   is
      Width  : Positive;
      Height : Positive;
      Result : Gray_Image_Access;
   begin
      Read_Header(Stream, Width, Height);
      Result := new Gray_Image(Width, Height);
      for Y in Result.Pixels'Range(1) loop
         for X in Result.Pixels'Range(2) loop
            Gray_Pixel'Read(Stream, Result.Pixels(Y, X));
         end loop;
      end loop;
      return Result;
   end Read;

   -- Write a gray image to a portable graymap stream.
   procedure Write
     (Stream : in Stream_Access;                -- Write to this stream.
      Image  : access Gray_Image'Class) is -- Write this image to the stream.
   begin
      Write_Header(Stream, Image.Width, Image.Height);
      for Y in Image.Pixels'Range(1) loop
         for X in Image.Pixels'Range(2) loop
            Gray_Pixel'Write(Stream, Image.Pixels(Y, X));
         end loop;
      end loop;
   end Write;

   -- Read a gray image from a portable graymap file.
   function Read
     (Filename : in String)   -- Open a file with this name.
     return Gray_Image_Access -- The newly created image.
   is
      File   : File_Type;
      Result : Gray_Image_Access;
   begin
      Open(File, In_File, Filename);
      Result := Read(Stream(File));
      Close(File);
      return Result;
   end Read;

   -- Write a gray image to a portable graymap file.
   procedure Write
     (Filename : in String;                    -- Create a file with this name.
      Image    : access Gray_Image'Class) -- Write this image to the file.
   is
      File : File_Type;
   begin
      Create(File, Out_File, Filename);
      Write(Stream(File), Image);
      Close(File);
   end Write;

   -- Write a gray image to a portable graymap file on standard output.
   procedure Write
     (Image : access Gray_Image'Class) is -- Write this image to stdout.
   begin
      Write(Stream_Access(Pipes.Std_Out), Image);
   end Write;

end PGM;