/packages/fcl-image/src/fpreadtga.pp

  1{*****************************************************************************}
  2{
  3    This file is part of the Free Pascal's "Free Components Library".
  4    Copyright (c) 2003 by Mazen NEIFER of the Free Pascal development team
  5
  6    BMP writer implementation.
  7
  8    See the file COPYING.FPC, included in this distribution,
  9    for details about the copyright.
 10
 11    This program is distributed in the hope that it will be useful,
 12    but WITHOUT ANY WARRANTY; without even the implied warranty of
 13    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 14}
 15{*****************************************************************************}
 16
 17{ - 22/11/2007 Modified by Laurent Jacques for support all format }
 18
 19{$mode objfpc}
 20{$h+}
 21
 22unit FPReadTGA;
 23
 24interface
 25
 26uses FPImage, classes, sysutils, targacmn;
 27
 28const
 29  TARGA_EMPTY_IMAGE = 0;
 30  TARGA_INDEXED_IMAGE = 1;
 31  TARGA_TRUECOLOR_IMAGE = 2;
 32  TARGA_GRAY_IMAGE = 3;
 33
 34type
 35
 36  { TFPReaderTarga }
 37
 38  TFPReaderTarga = class (TFPCustomImageReader)
 39  Private
 40    Procedure FreeBuffers;       // Free (and nil) buffers.
 41  protected
 42    Header         : TTargaHeader;
 43    AlphaBits      : Byte;
 44    Identification : ShortString;
 45    Compressed,
 46    BottomUp       : Boolean;
 47    BytesPerPixel  : Byte;
 48    FPalette       : PFPColor;
 49    FScanLine      : PByte;
 50    FLineSize      : Integer;
 51    FPaletteSize   : Integer;
 52    FBlockCount    : Integer;
 53    FPixelCount    : Integer;
 54    FLastPixel     : Packed Array[0..3] of byte;
 55    // AnalyzeHeader will allocate the needed buffers.
 56    Procedure AnalyzeHeader(Img : TFPCustomImage);
 57    procedure CreateGrayPalette;
 58    Procedure ReadPalette(Stream : TStream);
 59    procedure ReadScanLine(Row : Integer; Stream : TStream); virtual;
 60    procedure WriteScanLine(Row : Integer; Img : TFPCustomImage); virtual;
 61    // required by TFPCustomImageReader
 62    procedure InternalRead  (Stream:TStream; Img:TFPCustomImage); override;
 63    function  InternalCheck (Stream:TStream) : boolean; override;
 64  public
 65    constructor Create; override;
 66    destructor Destroy; override;
 67  end;
 68
 69Implementation
 70
 71Constructor TFPReaderTarga.Create;
 72
 73begin
 74end;
 75
 76Destructor TFPReaderTarga.Destroy;
 77
 78begin
 79  FreeBuffers;
 80  Inherited;
 81end;
 82
 83Procedure TFPReaderTarga.FreeBuffers;
 84
 85begin
 86  If (FScanLine<>Nil) then
 87    begin
 88    FreeMem(FScanLine);
 89    FScanLine:=Nil;
 90    end;
 91  If (FPalette<>Nil) then
 92    begin
 93    FreeMem(FPalette);
 94    FScanLine:=Nil;
 95    end;
 96end;
 97
 98Procedure TFPReaderTarga.AnalyzeHeader(Img : TFPCustomImage);
 99
100begin
101  With Header do
102    begin
103    if not (ImgType in [1, 2, 3, 9, 10, 11]) and
104       not (PixelSize in [8, 16, 24, 32]) then
105      Raise Exception.Create('Unknown/Unsupported Targa image type');
106    BottomUp:=(Flags and $20) <>0;
107    AlphaBits := Flags and $0F;
108    BytesPerPixel:=PixelSize;
109    Compressed:=ImgType>8;
110    If Compressed then
111      ImgType:=ImgType-8;
112    FLineSize:=(BytesPerPixel div 8)*ToWord(Width);
113    GetMem(FScanLine,FLineSize);
114
115    if ImgType = TARGA_GRAY_IMAGE then
116      FPaletteSize:=SizeOf(TFPColor)*255
117    else
118      FPaletteSize:=SizeOf(TFPColor)*ToWord(MapLength);
119    GetMem(FPalette,FPaletteSize);
120    Img.Width:=ToWord(Width);
121    Img.Height:=ToWord(Height);
122    end;
123end;
124
125Procedure TFPReaderTarga.CreateGrayPalette;
126
127Var
128  I : Integer;
129
130Begin
131  For I:=0 To 255 Do
132  Begin
133    With FPalette[I] do
134      begin
135      Red:=I*255;
136      Green:=I*255;
137      Blue:=I*255;
138      Alpha:=AlphaOpaque;
139      end;
140  end;
141End;
142
143Procedure TFPReaderTarga.ReadPalette(Stream : TStream);
144
145Var
146  BGREntry : TBGREntry;
147  BGRAEntry : TBGRAEntry;
148  I : Integer;
149
150begin
151  Case Header.MapEntrySize Of
152     16, 24:
153        For I:=0 to ToWord(Header.MapLength)-1 do
154        begin
155          Stream.ReadBuffer(BGREntry, SizeOf(BGREntry));
156          With FPalette[I] do
157            begin
158            Red:=BGREntry.Red shl 8;
159            Green:=BGREntry.Green shl 8;
160            Blue:=BGREntry.Blue shl 8;
161            Alpha:=alphaOpaque;
162            end;
163        end;
164     32:
165        For I:=0 to ToWord(Header.MapLength)-1 do
166        begin
167          Stream.ReadBuffer(BGRAEntry,SizeOf(BGRAEntry));
168          With FPalette[I] do
169            begin
170            Red:=BGRAEntry.Red shl 8;
171            Green:=BGRAEntry.Green shl 8;
172            Blue:=BGRAEntry.Blue shl 8;
173            if alphaBits = 8 then
174               if (BGRAEntry.Alpha and $80) <> 0 then
175                 Alpha:=alphaTransparent
176               else
177                 Alpha:=AlphaOpaque;
178            end;
179        end;
180    end;
181end;
182
183
184Procedure TFPReaderTarga.InternalRead  (Stream:TStream; Img:TFPCustomImage);
185
186var
187  H,Row : Integer;
188
189begin
190  Stream.Read(Header,SizeOf(Header));
191  AnalyzeHeader(Img);
192  If Header.IdLen>0 then
193    begin
194    SetLength(Identification,Header.IDLen);
195    Stream.Read(Identification[1],Header.Idlen);
196    If Length(Identification)<>0 then
197      Img.Extra[KeyIdentification]:=Identification;
198    end;
199
200  If Header.MapType<>0 then
201    ReadPalette(Stream);
202  if Header.ImgType = TARGA_GRAY_IMAGE then
203    CreateGrayPalette;
204
205  H:=Img.height;
206  If BottomUp then
207    For Row:=0 to H-1 do
208      begin
209      ReadScanLine(Row,Stream);
210      WriteScanLine(Row,Img);
211      end
212  else
213    For Row:=H-1 downto 0 do
214      begin
215      ReadScanLine(Row,Stream);
216      WriteScanLine(Row,Img);
217      end;
218end;
219
220Procedure TFPReaderTarga.ReadScanLine(Row : Integer; Stream : TStream);
221
222Var
223  P : PByte;
224  B : Byte;
225  I,J : Integer;
226
227begin
228  If Not Compressed then
229    Stream.ReadBuffer(FScanLine^,FLineSize)
230  else
231    begin
232    P:=FScanLine;
233    For I:=0 to ToWord(Header.Width)-1 do
234      begin
235      If (FPixelCount>0) then
236        Dec(FPixelCount)
237      else
238        begin
239        Dec(FBlockCount);
240        If (FBlockCount<0) then
241          begin
242          Stream.ReadBuffer(B,1);
243          If (B and $80)<>0 then
244            begin
245            FPixelCount:=B and $7F;
246            FblockCount:=0;
247            end
248          else
249            FBlockCount:=B and $7F
250          end;
251        Stream.ReadBuffer(FlastPixel,BytesPerPixel shr 3);
252        end;
253      For J:=0 to (BytesPerPixel shr 3)-1 do
254        begin
255        P[0]:=FLastPixel[j];
256        Inc(P);
257        end;
258      end;
259    end;
260end;
261
262Procedure TFPReaderTarga.WriteScanLine(Row : Integer; Img : TFPCustomImage);
263
264Var
265  Col : Integer;
266  C   : TFPColor;
267  W   : Word;
268  P   : PByte;
269
270begin
271  C.Alpha:=AlphaOpaque;
272  P:=FScanLine;
273  Case Header.ImgType of
274    TARGA_INDEXED_IMAGE
275      : for Col:=0 to Img.width-1 do
276         Img.Colors[Col,Row]:=FPalette[P[Col]];
277    TARGA_TRUECOLOR_IMAGE
278      : for Col:=0 to Img.Width-1 do
279          begin
280          // Fill C depending on number of pixels.
281          case BytesPerPixel of
282          8,16 : begin
283                 W:=P[0];
284                 inc(P);
285                 W:=W or (P[0] shl 8);
286                 With C do
287                   begin
288                   Red:=((W)shr 10) shl 11;
289                   Green:=((w)shr 5) shl 11;
290                   Blue:=((w)) shl 11;
291                   end;
292                end;
293          24,32 : With C do
294                  begin
295                  Blue:=P[0] or (P[0] shl 8);
296                  Inc(P);
297                  Green:=P[0] or (P[0] shl 8);
298                  Inc(P);
299                  Red:=P[0] or (P[0] shl 8);
300                  If bytesPerPixel=32 then
301                    begin
302                    Inc(P);
303                    Alpha:=AlphaOpaque;
304                    if alphaBits = 8 then
305                      if (P[0] and $80) = 0 then
306                        Alpha:=alphaTransparent;
307                    end;
308                  end;
309          end; // Case BytesPerPixel;
310          Img[Col,Row]:=C;
311          Inc(P);
312          end;
313    TARGA_GRAY_IMAGE
314      :  case BytesPerPixel of
315           8 : for Col:=0 to Img.width-1 do
316                 Img.Colors[Col,Row]:=FPalette[P[Col]];
317          16 : for Col:=0 to Img.width-1 do
318               begin
319                 With C do
320                 begin
321                   Blue:=FPalette[P^].blue;
322                   Green:=FPalette[P^].green;
323                   Red:=FPalette[P^].red;
324                   Inc(P);
325                   Alpha:=AlphaOpaque;
326                   if alphaBits = 8 then
327                    if (P[0] and $80) = 0 then
328                        Alpha:=alphaTransparent;
329                   Inc(P);
330                 end;
331               Img[Col,Row]:=C;
332               end;
333         end;
334  end;
335end;
336
337function  TFPReaderTarga.InternalCheck (Stream:TStream) : boolean;
338
339begin
340  Result:=True;
341end;
342
343initialization
344  ImageHandlers.RegisterImageReader ('TARGA Format', 'tga', TFPReaderTarga);
345end.