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 const
  91   ifMono: TImageFormat = TImageFormat(250);
  92   ifIndex2: TImageFormat = TImageFormat(251);
  93   ifIndex4: TImageFormat = TImageFormat(252);
  94 var
  95   Hdr: TPCXHeader;
  96   PalID, B: Byte;
  97   PalPCX: TPalette24Size256;
  98   FileDataFormat: TImageFormat;
  99   I, J, UncompSize, BytesPerLine, ByteNum, BitNum: LongInt;
 100   UncompData, RowPointer, PixelIdx: PByte;
 101   Pixel24: PColor24Rec;
 102   Pixel32: PColor32Rec;
 103   AlphaPlane, RedPlane, GreenPlane, BluePlane,
 104   Plane1, Plane2, Plane3, Plane4: PByteArray;
 105
 106   procedure RleDecode(Target: PByte; UnpackedSize: LongInt);
 107   var
 108     Count: LongInt;
 109     Source: Byte;
 110   begin
 111     while UnpackedSize > 0 do
 112     with GetIO do
 113     begin
 114       GetIO.Read(Handle, @Source, SizeOf(Source));
 115       if (Source and $C0) = $C0 then
 116       begin
 117         // RLE data
 118         Count := Source and $3F;
 119         if UnpackedSize < Count then
 120           Count := UnpackedSize;
 121         Read(Handle, @Source, SizeOf(Source));
 122         FillChar(Target^, Count, Source);
 123         //Inc(Source);
 124         Inc(Target, Count);
 125         Dec(UnpackedSize, Count);
 126       end
 127       else
 128       begin
 129         // Uncompressed data
 130         Target^ := Source;
 131         Inc(Target);
 132         Dec(UnpackedSize);
 133       end;
 134     end;
 135   end;
 136
 137 begin
 138   Result := False;
 139   SetLength(Images, 1);
 140   with GetIO, Images[0] do
 141   begin
 142     // Read PCX header and store input position (start of image data)
 143     Read(Handle, @Hdr, SizeOf(Hdr));
 144     FileDataFormat := ifUnknown;
 145
 146     // Determine image's data format and find its Imaging equivalent
 147     // (using some custom TImageFormat constants)
 148     case Hdr.BitsPerPixel of
 149       1:
 150         case Hdr.Planes of
 151           1: FileDataFormat := ifMono;
 152           4: FileDataFormat := ifIndex4;
 153         end;
 154       2: FileDataFormat := ifIndex2;
 155       4: FileDataFormat := ifIndex4;
 156       8:
 157         case Hdr.Planes of
 158           1: FileDataFormat := ifIndex8;
 159           3: FileDataFormat := ifR8G8B8;
 160           4: FileDataFormat := ifA8R8G8B8;
 161         end;
 162     end;
 163
 164     // No compatible Imaging format found, exit
 165     if FileDataFormat = ifUnknown then
 166       Exit;
 167
 168     // Get width, height, and output data format (unsupported formats
 169     // like ifMono are converted later to ifIndex8)
 170     Width := Hdr.X1 - Hdr.X0 + 1;
 171     Height := Hdr.Y1 - Hdr.Y0 + 1;
 172     if FileDataFormat in [ifIndex8, ifR8G8B8] then
 173       Format := FileDataFormat
 174     else
 175       Format := ifIndex8;
 176
 177     NewImage(Width, Height, Format, Images[0]);
 178
 179     if not (FileDataFormat in [ifIndex8, ifR8G8B8]) then
 180     begin
 181       // other formats use palette embedded to file header
 182       for I := Low(Hdr.Palette16) to High(Hdr.Palette16) do
 183       begin
 184         Palette[I].A := $FF;
 185         Palette[I].R := Hdr.Palette16[I].B;
 186         Palette[I].G := Hdr.Palette16[I].G;
 187         Palette[I].B := Hdr.Palette16[I].R;
 188       end;
 189     end;
 190
 191     // Now we determine various data sizes
 192     BytesPerLine := Hdr.BytesPerLine * Hdr.Planes;
 193     UncompSize := BytesPerLine * Height;
 194
 195     GetMem(UncompData, UncompSize);
 196     try
 197       if Hdr.Encoding = 1 then
 198       begin
 199         // Image data is compressed -> read and decompress
 200         RleDecode(UncompData, UncompSize);
 201       end
 202       else
 203       begin
 204         // Just read uncompressed data
 205         Read(Handle, UncompData, UncompSize);
 206       end;
 207
 208       if FileDataFormat in [ifR8G8B8, ifA8R8G8B8] then
 209       begin
 210         // RGB and ARGB images are stored in layout different from
 211         // Imaging's (and most other file formats'). First there is
 212         // Width red values then there is Width green values and so on
 213         RowPointer := UncompData;
 214
 215         if FileDataFormat = ifA8R8G8B8 then
 216         begin
 217           Pixel32 := Bits;
 218           for I := 0 to Height - 1 do
 219           begin
 220             AlphaPlane := PByteArray(RowPointer);
 221             RedPlane :=   @AlphaPlane[Hdr.BytesPerLine];
 222             GreenPlane := @AlphaPlane[Hdr.BytesPerLine * 2];
 223             BluePlane :=  @AlphaPlane[Hdr.BytesPerLine * 3];
 224             for J := 0 to Width - 1 do
 225             begin
 226               Pixel32.A := AlphaPlane[J];
 227               Pixel32.R := RedPlane[J];
 228               Pixel32.G := GreenPlane[J];
 229               Pixel32.B := BluePlane[J];
 230               Inc(Pixel32);
 231             end;
 232             Inc(RowPointer, BytesPerLine);
 233           end;
 234         end
 235         else
 236         begin
 237           Pixel24 := Bits;
 238           for I := 0 to Height - 1 do
 239           begin
 240             RedPlane :=   PByteArray(RowPointer);
 241             GreenPlane := @RedPlane[Hdr.BytesPerLine];
 242             BluePlane :=  @RedPlane[Hdr.BytesPerLine * 2];
 243             for J := 0 to Width - 1 do
 244             begin
 245               Pixel24.R := RedPlane[J];
 246               Pixel24.G := GreenPlane[J];
 247               Pixel24.B := BluePlane[J];
 248               Inc(Pixel24);
 249             end;
 250             Inc(RowPointer, BytesPerLine);
 251           end;
 252         end;
 253       end
 254       else if FileDataFormat = ifIndex8 then
 255       begin
 256         // Just copy 8bit lines
 257         for I := 0 to Height - 1 do
 258           Move(PByteArray(UncompData)[I * Hdr.BytesPerLine], PByteArray(Bits)[I * Width], Width);
 259       end
 260       else if FileDataFormat = ifMono then
 261       begin
 262         // Convert 1bit images to ifIndex8
 263         Convert1To8(UncompData, Bits, Width, Height, Hdr.BytesPerLine, False);
 264       end
 265       else if FileDataFormat = ifIndex2 then
 266       begin
 267         // Convert 2bit images to ifIndex8. Note that 2bit PCX images
 268         // usually use (from specs, I've never seen one myself) CGA palette
 269         // which is not array of RGB tripplets. So 2bit PCXs are loaded but
 270         // their colors would be wrong
 271         Convert2To8(UncompData, Bits, Width, Height, Hdr.BytesPerLine, False);
 272       end
 273       else if FileDataFormat = ifIndex4 then
 274       begin
 275         // 4bit images can be stored similar to RGB images (in four one bit planes)
 276         // or like array of nibbles (which is more common)
 277         if (Hdr.BitsPerPixel = 1) and (Hdr.Planes = 4) then
 278         begin
 279           RowPointer := UncompData;
 280           PixelIdx := Bits;
 281           for I := 0 to Height - 1 do
 282           begin
 283             Plane1 := PByteArray(RowPointer);
 284             Plane2 := @Plane1[Hdr.BytesPerLine];
 285             Plane3 := @Plane1[Hdr.BytesPerLine * 2];
 286             Plane4 := @Plane1[Hdr.BytesPerLine * 3];
 287
 288             for J := 0 to Width - 1 do
 289             begin
 290               B := 0;
 291               ByteNum := J div 8;
 292               BitNum := 7 - (J mod 8);
 293               if (Plane1[ByteNum] shr BitNum) and $1 <> 0 then B := B or $01;
 294               if (Plane2[ByteNum] shr BitNum) and $1 <> 0 then B := B or $02;
 295               if (Plane3[ByteNum] shr BitNum) and $1 <> 0 then B := B or $04;
 296               if (Plane4[ByteNum] shr BitNum) and $1 <> 0 then B := B or $08;
 297               PixelIdx^ := B;
 298               Inc(PixelIdx);
 299             end;
 300             Inc(RowPointer, BytesPerLine);
 301           end;
 302         end
 303         else if (Hdr.BitsPerPixel = 4) and (Hdr.Planes = 1) then
 304         begin
 305           // Convert 4bit images to ifIndex8
 306           Convert4To8(UncompData, Bits, Width, Height, Hdr.BytesPerLine, False);
 307         end
 308       end;
 309
 310       if FileDataFormat = ifIndex8 then
 311       begin
 312         // 8bit palette is appended at the end of the file
 313         // with $0C identifier
 314         //Seek(Handle, -769, smFromEnd);
 315         Read(Handle, @PalID, SizeOf(PalID));
 316         if PalID = $0C then
 317         begin
 318           Read(Handle, @PalPCX, SizeOf(PalPCX));
 319           for I := Low(PalPCX) to High(PalPCX) do
 320           begin
 321             Palette[I].A := $FF;
 322             Palette[I].R := PalPCX[I].B;
 323             Palette[I].G := PalPCX[I].G;
 324             Palette[I].B := PalPCX[I].R;
 325           end;
 326         end
 327         else
 328           Seek(Handle, -SizeOf(PalID), smFromCurrent);
 329       end;
 330
 331     finally
 332       FreeMem(UncompData);
 333     end;
 334     Result := True;
 335   end;
 336 end;
 337
 338 function TPCXFileFormat.TestFormat(Handle: TImagingHandle): Boolean;
 339 var
 340   Hdr: TPCXHeader;
 341   ReadCount: LongInt;
 342 begin
 343   Result := False;
 344   if Handle <> nil then
 345   begin
 346     ReadCount := GetIO.Read(Handle, @Hdr, SizeOf(Hdr));
 347     GetIO.Seek(Handle, -ReadCount, smFromCurrent);
 348     Result := (ReadCount >= SizeOf(Hdr)) and
 349       (Hdr.Id = $0A) and
 350       (Hdr.Version in [0, 2, 3, 4, 5]) and
 351       (Hdr.Encoding in [0..1]) and
 352       (Hdr.BitsPerPixel in [1, 2, 4, 8]) and
 353       (Hdr.Planes in [1, 3, 4]) and
 354       (Hdr.PaletteType in [1..2]);
 355   end;
 356
 357 end;
 358
 359 initialization
 360   RegisterImageFileFormat(TPCXFileFormat);
 361
 362 {
 363   File Notes:
 364
 365   -- TODOS ----------------------------------------------------
 366     - nothing now
 367
 368   -- 0.21 Changes/Bug Fixes -----------------------------------
 369     - Made loader stream-safe - stream position is exactly at the end of the
 370       image after loading and file size doesn't need to be know during the process.
 371     - Initial TPCXFileFormat class implemented.
 372
 373 }
 374
 375 end.