src/lib/vampimg/ImagingPcx.pas

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