src/lib/vampimg/ImagingPcx.pas

   1 {
   2   $Id: ImagingPcx.pas 100 2007-06-28 21:09:52Z galfar $
   3   Vampyre Imaging Library
   4   by Marek Mauder
   5   http://imaginglib.sourceforge.net
   6
   7   The contents of this file are used with permission, subject to the Mozilla
   8   Public License Version 1.1 (the "License"); you may not use this file except
   9   in compliance with the License. You may obtain a copy of the License at
  10   http://www.mozilla.org/MPL/MPL-1.1.html
  11
  12   Software distributed under the License is distributed on an "AS IS" basis,
  13   WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
  14   the specific language governing rights and limitations under the License.
  15
  16   Alternatively, the contents of this file may be used under the terms of the
  17   GNU Lesser General Public License (the  "LGPL License"), in which case the
  18   provisions of the LGPL License are applicable instead of those above.
  19   If you wish to allow use of your version of this file only under the terms
  20   of the LGPL License and not to allow others to use your version of this file
  21   under the MPL, indicate your decision by deleting  the provisions above and
  22   replace  them with the notice and other provisions required by the LGPL
  23   License.  If you do not delete the provisions above, a recipient may use
  24   your version of this file under either the MPL or the LGPL License.
  25
  26   For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html
  27 }
  28
  29 { This unit contains image format loader for ZSoft Paintbrush images known as PCX.}
  30 unit ImagingPcx;
  31
  32 {$I ImagingOptions.inc}
  33
  34 interface
  35
  36 uses
  37   ImagingTypes, Imaging, ImagingFormats, ImagingUtility, ImagingIO;
  38
  39 type
  40   { Class for loading  ZSoft Paintbrush images known as PCX. It is old
  41     format which can store 1bit, 2bit, 4bit, 8bit, and 24bit (and 32bit but is
  42     probably non-standard) images. Only loading is supported (you can still come
  43     accross some PCX files) but saving is not (I don't wont this venerable format
  44     to spread).}
  45   TPCXFileFormat = class(TImageFileFormat)
  46   protected
  47     function LoadData(Handle: TImagingHandle; var Images: TDynImageDataArray;
  48       OnlyFirstLevel: Boolean): Boolean; override;
  49   public
  50     constructor Create; override;
  51     function TestFormat(Handle: TImagingHandle): Boolean; override;
  52   end;
  53
  54 implementation
  55
  56 const
  57   SPCXFormatName = 'ZSoft Paintbrush Image';
  58   SPCXMasks      = '*.pcx';
  59
  60 type
  61   TPCXHeader = packed record
  62     Id: Byte;            // Always $0A
  63     Version: Byte;       // 0, 2, 3, 4, 5
  64     Encoding: Byte;      // 0, 1
  65     BitsPerPixel: Byte;  // 1, 2, 4, 8
  66     X0, Y0: Word;        // Image window top-left
  67     X1, Y1: Word;        // Image window bottom-right
  68     DpiX: Word;
  69     DpiY: Word;
  70     Palette16: array [0..15] of TColor24Rec;
  71     Reserved1: Byte;
  72     Planes: Byte;        // 1, 3, 4
  73     BytesPerLine: Word;
  74     PaletteType: Word;   // 1: color or s/w   2: grayscale
  75     Reserved2: array [0..57] of Byte;
  76   end;
  77
  78 { TPCXFileFormat }
  79
  80 constructor TPCXFileFormat.Create;
  81 begin
  82   inherited Create;
  83   FName := SPCXFormatName;
  84   FCanLoad := True;
  85   FCanSave := False;
  86   FIsMultiImageFormat := False;
  87
  88   AddMasks(SPCXMasks);
  89 end;
  90
  91 function TPCXFileFormat.LoadData(Handle: TImagingHandle;
  92   var Images: TDynImageDataArray; OnlyFirstLevel: Boolean): Boolean;
  93 const
  94   ifMono: TImageFormat = TImageFormat(250);
  95   ifIndex2: TImageFormat = TImageFormat(251);
  96   ifIndex4: TImageFormat = TImageFormat(252);
  97 var
  98   Hdr: TPCXHeader;
  99   PalID, B: Byte;
 100   PalPCX: TPalette24Size256;
 101   FileDataFormat: TImageFormat;
 102   I, J, UncompSize, BytesPerLine, ByteNum, BitNum: LongInt;
 103   UncompData, RowPointer, PixelIdx: PByte;
 104   Pixel24: PColor24Rec;
 105   Pixel32: PColor32Rec;
 106   AlphaPlane, RedPlane, GreenPlane, BluePlane,
 107   Plane1, Plane2, Plane3, Plane4: PByteArray;
 108
 109   procedure RleDecode(Target: PByte; UnpackedSize: LongInt);
 110   var
 111     Count: LongInt;
 112     Source: Byte;
 113   begin
 114     while UnpackedSize > 0 do
 115     with GetIO do
 116     begin
 117       GetIO.Read(Handle, @Source, SizeOf(Source));
 118       if (Source and $C0) = $C0 then
 119       begin
 120         // RLE data
 121         Count := Source and $3F;
 122         if UnpackedSize < Count then
 123           Count := UnpackedSize;
 124         Read(Handle, @Source, SizeOf(Source));
 125         FillChar(Target^, Count, Source);
 126         //Inc(Source);
 127         Inc(Target, Count);
 128         Dec(UnpackedSize, Count);
 129       end
 130       else
 131       begin
 132         // Uncompressed data
 133         Target^ := Source;
 134         Inc(Target);
 135         Dec(UnpackedSize);
 136       end;
 137     end;
 138   end;
 139
 140 begin
 141   Result := False;
 142   SetLength(Images, 1);
 143   with GetIO, Images[0] do
 144   begin
 145     // Read PCX header and store input position (start of image data)
 146     Read(Handle, @Hdr, SizeOf(Hdr));
 147     FileDataFormat := ifUnknown;
 148
 149     // Determine image's data format and find its Imaging equivalent
 150     // (using some custom TImageFormat constants)
 151     case Hdr.BitsPerPixel of
 152       1:
 153         case Hdr.Planes of
 154           1: FileDataFormat := ifMono;
 155           4: FileDataFormat := ifIndex4;
 156         end;
 157       2: FileDataFormat := ifIndex2;
 158       4: FileDataFormat := ifIndex4;
 159       8:
 160         case Hdr.Planes of
 161           1: FileDataFormat := ifIndex8;
 162           3: FileDataFormat := ifR8G8B8;
 163           4: FileDataFormat := ifA8R8G8B8;
 164         end;
 165     end;
 166
 167     // No compatible Imaging format found, exit
 168     if FileDataFormat = ifUnknown then
 169       Exit;
 170
 171     // Get width, height, and output data format (unsupported formats
 172     // like ifMono are converted later to ifIndex8)
 173     Width := Hdr.X1 - Hdr.X0 + 1;
 174     Height := Hdr.Y1 - Hdr.Y0 + 1;
 175     if FileDataFormat in [ifIndex8, ifR8G8B8] then
 176       Format := FileDataFormat
 177     else
 178       Format := ifIndex8;
 179
 180     NewImage(Width, Height, Format, Images[0]);
 181
 182     if not (FileDataFormat in [ifIndex8, ifR8G8B8]) then
 183     begin
 184       // other formats use palette embedded to file header
 185       for I := Low(Hdr.Palette16) to High(Hdr.Palette16) do
 186       begin
 187         Palette[I].A := $FF;
 188         Palette[I].R := Hdr.Palette16[I].B;
 189         Palette[I].G := Hdr.Palette16[I].G;
 190         Palette[I].B := Hdr.Palette16[I].R;
 191       end;
 192     end;
 193
 194     // Now we determine various data sizes
 195     BytesPerLine := Hdr.BytesPerLine * Hdr.Planes;
 196     UncompSize := BytesPerLine * Height;
 197
 198     GetMem(UncompData, UncompSize);
 199     try
 200       if Hdr.Encoding = 1 then
 201       begin
 202         // Image data is compressed -> read and decompress
 203         RleDecode(UncompData, UncompSize);
 204       end
 205       else
 206       begin
 207         // Just read uncompressed data
 208         Read(Handle, UncompData, UncompSize);
 209       end;
 210
 211       if FileDataFormat in [ifR8G8B8, ifA8R8G8B8] then
 212       begin
 213         // RGB and ARGB images are stored in layout different from
 214         // Imaging's (and most other file formats'). First there is
 215         // Width red values then there is Width green values and so on
 216         RowPointer := UncompData;
 217
 218         if FileDataFormat = ifA8R8G8B8 then
 219         begin
 220           Pixel32 := Bits;
 221           for I := 0 to Height - 1 do
 222           begin
 223             AlphaPlane := PByteArray(RowPointer);
 224             RedPlane :=   @AlphaPlane[Hdr.BytesPerLine];
 225             GreenPlane := @AlphaPlane[Hdr.BytesPerLine * 2];
 226             BluePlane :=  @AlphaPlane[Hdr.BytesPerLine * 3];
 227             for J := 0 to Width - 1 do
 228             begin
 229               Pixel32.A := AlphaPlane[J];
 230               Pixel32.R := RedPlane[J];
 231               Pixel32.G := GreenPlane[J];
 232               Pixel32.B := BluePlane[J];
 233               Inc(Pixel32);
 234             end;
 235             Inc(RowPointer, BytesPerLine);
 236           end;
 237         end
 238         else
 239         begin
 240           Pixel24 := Bits;
 241           for I := 0 to Height - 1 do
 242           begin
 243             RedPlane :=   PByteArray(RowPointer);
 244             GreenPlane := @RedPlane[Hdr.BytesPerLine];
 245             BluePlane :=  @RedPlane[Hdr.BytesPerLine * 2];
 246             for J := 0 to Width - 1 do
 247             begin
 248               Pixel24.R := RedPlane[J];
 249               Pixel24.G := GreenPlane[J];
 250               Pixel24.B := BluePlane[J];
 251               Inc(Pixel24);
 252             end;
 253             Inc(RowPointer, BytesPerLine);
 254           end;
 255         end;
 256       end
 257       else if FileDataFormat = ifIndex8 then
 258       begin
 259         // Just copy 8bit lines
 260         for I := 0 to Height - 1 do
 261           Move(PByteArray(UncompData)[I * Hdr.BytesPerLine], PByteArray(Bits)[I * Width], Width);
 262       end
 263       else if FileDataFormat = ifMono then
 264       begin
 265         // Convert 1bit images to ifIndex8
 266         Convert1To8(UncompData, Bits, Width, Height, Hdr.BytesPerLine);
 267       end
 268       else if FileDataFormat = ifIndex2 then
 269       begin
 270         // Convert 2bit images to ifIndex8. Note that 2bit PCX images
 271         // usually use (from specs, I've never seen one myself) CGA palette
 272         // which is not array of RGB tripplets. So 2bit PCXs are loaded but
 273         // their colors would be wrong
 274         Convert2To8(UncompData, Bits, Width, Height, Hdr.BytesPerLine);
 275       end
 276       else if FileDataFormat = ifIndex4 then
 277       begin
 278         // 4bit images can be stored similar to RGB images (in four one bit planes)
 279         // or like array of nibbles (which is more common)
 280         if (Hdr.BitsPerPixel = 1) and (Hdr.Planes = 4) then
 281         begin
 282           RowPointer := UncompData;
 283           PixelIdx := Bits;
 284           for I := 0 to Height - 1 do
 285           begin
 286             Plane1 := PByteArray(RowPointer);
 287             Plane2 := @Plane1[Hdr.BytesPerLine];
 288             Plane3 := @Plane1[Hdr.BytesPerLine * 2];
 289             Plane4 := @Plane1[Hdr.BytesPerLine * 3];
 290
 291             for J := 0 to Width - 1 do
 292             begin
 293               B := 0;
 294               ByteNum := J div 8;
 295               BitNum := 7 - (J mod 8);
 296               if (Plane1[ByteNum] shr BitNum) and $1 <> 0 then B := B or $01;
 297               if (Plane2[ByteNum] shr BitNum) and $1 <> 0 then B := B or $02;
 298               if (Plane3[ByteNum] shr BitNum) and $1 <> 0 then B := B or $04;
 299               if (Plane4[ByteNum] shr BitNum) and $1 <> 0 then B := B or $08;
 300               PixelIdx^ := B;
 301               Inc(PixelIdx);
 302             end;
 303             Inc(RowPointer, BytesPerLine);
 304           end;
 305         end
 306         else if (Hdr.BitsPerPixel = 4) and (Hdr.Planes = 1) then
 307         begin
 308           // Convert 4bit images to ifIndex8
 309           Convert4To8(UncompData, Bits, Width, Height, Hdr.BytesPerLine);
 310         end
 311       end;
 312
 313       if FileDataFormat = ifIndex8 then
 314       begin
 315         // 8bit palette is appended at the end of the file
 316         // with $0C identifier
 317         //Seek(Handle, -769, smFromEnd);
 318         Read(Handle, @PalID, SizeOf(PalID));
 319         if PalID = $0C then
 320         begin
 321           Read(Handle, @PalPCX, SizeOf(PalPCX));
 322           for I := Low(PalPCX) to High(PalPCX) do
 323           begin
 324             Palette[I].A := $FF;
 325             Palette[I].R := PalPCX[I].B;
 326             Palette[I].G := PalPCX[I].G;
 327             Palette[I].B := PalPCX[I].R;
 328           end;
 329         end
 330         else
 331           Seek(Handle, -SizeOf(PalID), smFromCurrent);
 332       end;
 333
 334     finally
 335       FreeMem(UncompData);
 336     end;
 337     Result := True;
 338   end;
 339 end;
 340
 341 function TPCXFileFormat.TestFormat(Handle: TImagingHandle): Boolean;
 342 var
 343   Hdr: TPCXHeader;
 344   ReadCount: LongInt;
 345 begin
 346   Result := False;
 347   if Handle <> nil then
 348   begin
 349     ReadCount := GetIO.Read(Handle, @Hdr, SizeOf(Hdr));
 350     GetIO.Seek(Handle, -ReadCount, smFromCurrent);
 351     Result := (ReadCount >= SizeOf(Hdr)) and
 352       (Hdr.Id = $0A) and
 353       (Hdr.Version in [0, 2, 3, 4, 5]) and
 354       (Hdr.Encoding in [0..1]) and
 355       (Hdr.BitsPerPixel in [1, 2, 4, 8]) and
 356       (Hdr.Planes in [1, 3, 4]) and
 357       (Hdr.PaletteType in [1..2]);
 358   end;
 359
 360 end;
 361
 362 initialization
 363   RegisterImageFileFormat(TPCXFileFormat);
 364
 365 {
 366   File Notes:
 367
 368   -- TODOS ----------------------------------------------------
 369     - nothing now
 370
 371   -- 0.21 Changes/Bug Fixes -----------------------------------
 372     - Made loader stream-safe - stream position is exactly at the end of the
 373       image after loading and file size doesn't need to be know during the process.
 374     - Initial TPCXFileFormat class implemented.
 375
 376 }
 377
 378 end.