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