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

https://github.com/slibre/freepascal · Puppet · 345 lines · 345 code · 0 blank · 0 comment · 0 complexity · 86f8fa337657dff63f406359be946ed8 MD5 · raw file

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