DEADSOFTWARE

GIT / REPO / FRED-BOY
Projects / d2df-sdl.git / blob
summary | shortlog | log | commit | commitdiff | tree
history | raw | HEAD
added Vampyre Imaging Library; now textures can be in various formats, including...
[d2df-sdl.git] / src / lib / vampimg / ImagingPsd.pas
1 {
2 $Id: ImagingPsd.pas 154 2008-12-27 15:41:09Z galfar $
3 Vampyre Imaging Library
4 by Marek Mauder
5 http://imaginglib.sourceforge.net
6
7 The contents of this file are used with permission, subject to the Mozilla
8 Public License Version 1.1 (the "License"); you may not use this file except
9 in compliance with the License. You may obtain a copy of the License at
10 http://www.mozilla.org/MPL/MPL-1.1.html
11
12 Software distributed under the License is distributed on an "AS IS" basis,
13 WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
14 the specific language governing rights and limitations under the License.
15
16 Alternatively, the contents of this file may be used under the terms of the
17 GNU Lesser General Public License (the "LGPL License"), in which case the
18 provisions of the LGPL License are applicable instead of those above.
19 If you wish to allow use of your version of this file only under the terms
20 of the LGPL License and not to allow others to use your version of this file
21 under the MPL, indicate your decision by deleting the provisions above and
22 replace them with the notice and other provisions required by the LGPL
23 License. If you do not delete the provisions above, a recipient may use
24 your version of this file under either the MPL or the LGPL License.
25
26 For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html
27 }
28
29 { This unit contains image format loader/saver for Photoshop PSD image format.}
30 unit ImagingPsd;
31
32 {$I ImagingOptions.inc}
33
34 interface
35
36 uses
37 SysUtils, ImagingTypes, Imaging, ImagingColors, ImagingUtility;
38
39 type
40 { Class for loading and saving Adobe Photoshop PSD images.
41 Loading and saving of indexed, grayscale, RGB(A), HDR (FP32), and CMYK
42 (auto converted to RGB) images is supported. Non-HDR gray, RGB,
43 and CMYK images can have 8bit or 16bit color channels.
44 There is no support for loading mono images, duotone images are treated
45 like grayscale images, and multichannel and CIE Lab images are loaded as
46 RGB images but without actual conversion to RGB color space.
47 Also no layer information is loaded.}
48 TPSDFileFormat = class(TImageFileFormat)
49 protected
50 FSaveAsLayer: LongBool;
51 function LoadData(Handle: TImagingHandle; var Images: TDynImageDataArray;
52 OnlyFirstLevel: Boolean): Boolean; override;
53 function SaveData(Handle: TImagingHandle; const Images: TDynImageDataArray;
54 Index: LongInt): Boolean; override;
55 procedure ConvertToSupported(var Image: TImageData;
56 const Info: TImageFormatInfo); override;
57 public
58 constructor Create; override;
59 function TestFormat(Handle: TImagingHandle): Boolean; override;
60 published
61 property SaveAsLayer: LongBool read FSaveAsLayer write FSaveAsLayer;
62 end;
63
64 implementation
65
66 uses
67 ImagingExtras;
68
69 const
70 SPSDFormatName = 'Photoshop Image';
71 SPSDMasks = '*.psd,*.pdd';
72 PSDSupportedFormats: TImageFormats = [ifIndex8, ifGray8, ifA8Gray8,
73 ifR8G8B8, ifA8R8G8B8, ifGray16, ifA16Gray16, ifR16G16B16, ifA16R16G16B16,
74 ifR32F, ifA32R32G32B32F];
75 PSDDefaultSaveAsLayer = True;
76
77 const
78 SPSDMagic = '8BPS';
79 CompressionNone: Word = 0;
80 CompressionRLE: Word = 1;
81
82 type
83 {$MINENUMSIZE 2}
84 { PSD Image color mode.}
85 TPSDColorMode = (
86 cmMono = 0,
87 cmGrayscale = 1,
88 cmIndexed = 2,
89 cmRGB = 3,
90 cmCMYK = 4,
91 cmMultiChannel = 7,
92 cmDuoTone = 8,
93 cmLab = 9
94 );
95
96 { PSD image main header.}
97 TPSDHeader = packed record
98 Signature: TChar4; // Format ID '8BPS'
99 Version: Word; // Always 1
100 Reserved: array[0..5] of Byte; // Reserved, all zero
101 Channels: Word; // Number of color channels (1-24) including alpha channels
102 Rows : LongWord; // Height of image in pixels (1-30000)
103 Columns: LongWord; // Width of image in pixels (1-30000)
104 Depth: Word; // Number of bits per channel (1, 8, and 16)
105 Mode: TPSDColorMode; // Color mode
106 end;
107
108 TPSDChannelInfo = packed record
109 ChannelID: Word; // 0 = Red, 1 = Green, 2 = Blue etc., -1 = Transparency mask, -2 = User mask
110 Size: LongWord; // Size of channel data.
111 end;
112
113 procedure SwapHeader(var Header: TPSDHeader);
114 begin
115 Header.Version := SwapEndianWord(Header.Version);
116 Header.Channels := SwapEndianWord(Header.Channels);
117 Header.Depth := SwapEndianWord(Header.Depth);
118 Header.Rows := SwapEndianLongWord(Header.Rows);
119 Header.Columns := SwapEndianLongWord(Header.Columns);
120 Header.Mode := TPSDColorMode(SwapEndianWord(Word(Header.Mode)));
121 end;
122
123 {
124 TPSDFileFormat class implementation
125 }
126
127 constructor TPSDFileFormat.Create;
128 begin
129 inherited Create;
130 FName := SPSDFormatName;
131 FCanLoad := True;
132 FCanSave := True;
133 FIsMultiImageFormat := False;
134 FSupportedFormats := PSDSupportedFormats;
135 AddMasks(SPSDMasks);
136
137 FSaveAsLayer := PSDDefaultSaveAsLayer;
138 RegisterOption(ImagingPSDSaveAsLayer, @FSaveAsLayer);
139 end;
140
141 function TPSDFileFormat.LoadData(Handle: TImagingHandle;
142 var Images: TDynImageDataArray; OnlyFirstLevel: Boolean): Boolean;
143 var
144 Header: TPSDHeader;
145 ByteCount: LongWord;
146 RawPal: array[0..767] of Byte;
147 Compression, PackedSize: Word;
148 LineSize, ChannelPixelSize, WidthBytes,
149 CurrChannel, MaxRLESize, I, Y, X: LongInt;
150 Info: TImageFormatInfo;
151 PackedLine, LineBuffer: PByte;
152 RLELineSizes: array of Word;
153 Col32: TColor32Rec;
154 Col64: TColor64Rec;
155 PCol32: PColor32Rec;
156 PCol64: PColor64Rec;
157 PColF: PColorFPRec;
158
159 { PackBits RLE decode code from Mike Lischke's GraphicEx library.}
160 procedure DecodeRLE(Source, Dest: PByte; PackedSize, UnpackedSize: LongInt);
161 var
162 Count: LongInt;
163 begin
164 while (UnpackedSize > 0) and (PackedSize > 0) do
165 begin
166 Count := ShortInt(Source^);
167 Inc(Source);
168 Dec(PackedSize);
169 if Count < 0 then
170 begin
171 // Replicate next byte -Count + 1 times
172 if Count = -128 then
173 Continue;
174 Count := -Count + 1;
175 if Count > UnpackedSize then
176 Count := UnpackedSize;
177 FillChar(Dest^, Count, Source^);
178 Inc(Source);
179 Dec(PackedSize);
180 Inc(Dest, Count);
181 Dec(UnpackedSize, Count);
182 end
183 else
184 begin
185 // Copy next Count + 1 bytes from input
186 Inc(Count);
187 if Count > UnpackedSize then
188 Count := UnpackedSize;
189 if Count > PackedSize then
190 Count := PackedSize;
191 Move(Source^, Dest^, Count);
192 Inc(Dest, Count);
193 Inc(Source, Count);
194 Dec(PackedSize, Count);
195 Dec(UnpackedSize, Count);
196 end;
197 end;
198 end;
199
200 begin
201 Result := False;
202 SetLength(Images, 1);
203 with GetIO, Images[0] do
204 begin
205 // Read PSD header
206 Read(Handle, @Header, SizeOf(Header));
207 SwapHeader(Header);
208 // Determine image data format
209 Format := ifUnknown;
210 case Header.Mode of
211 cmGrayscale, cmDuoTone:
212 begin
213 if Header.Depth in [8, 16] then
214 begin
215 if Header.Channels = 1 then
216 Format := IffFormat(Header.Depth = 8, ifGray8, ifGray16)
217 else if Header.Channels >= 2 then
218 Format := IffFormat(Header.Depth = 8, ifA8Gray8, ifA16Gray16);
219 end
220 else if (Header.Depth = 32) and (Header.Channels = 1) then
221 Format := ifR32F;
222 end;
223 cmIndexed:
224 begin
225 if Header.Depth = 8 then
226 Format := ifIndex8;
227 end;
228 cmRGB, cmMultiChannel, cmCMYK, cmLab:
229 begin
230 if Header.Depth in [8, 16] then
231 begin
232 if Header.Channels = 3 then
233 Format := IffFormat(Header.Depth = 8, ifR8G8B8, ifR16G16B16)
234 else if Header.Channels >= 4 then
235 Format := IffFormat(Header.Depth = 8, ifA8R8G8B8, ifA16R16G16B16);
236 end
237 else if Header.Depth = 32 then
238 Format := ifA32R32G32B32F;
239 end;
240 cmMono:; // Not supported
241 end;
242
243 // Exit if no compatible format was found
244 if Format = ifUnknown then
245 Exit;
246
247 NewImage(Header.Columns, Header.Rows, Format, Images[0]);
248 Info := GetFormatInfo(Format);
249
250 // Read or skip Color Mode Data Block (palette)
251 Read(Handle, @ByteCount, SizeOf(ByteCount));
252 ByteCount := SwapEndianLongWord(ByteCount);
253 if Format = ifIndex8 then
254 begin
255 // Read palette only for indexed images
256 Read(Handle, @RawPal, SizeOf(RawPal));
257 for I := 0 to 255 do
258 begin
259 Palette[I].A := $FF;
260 Palette[I].R := RawPal[I + 0];
261 Palette[I].G := RawPal[I + 256];
262 Palette[I].B := RawPal[I + 512];
263 end;
264 end
265 else
266 Seek(Handle, ByteCount, smFromCurrent);
267
268 // Skip Image Resources Block
269 Read(Handle, @ByteCount, SizeOf(ByteCount));
270 ByteCount := SwapEndianLongWord(ByteCount);
271 Seek(Handle, ByteCount, smFromCurrent);
272 // Now there is Layer and Mask Information Block
273 Read(Handle, @ByteCount, SizeOf(ByteCount));
274 ByteCount := SwapEndianLongWord(ByteCount);
275 // Skip Layer and Mask Information Block
276 Seek(Handle, ByteCount, smFromCurrent);
277
278 // Read compression flag
279 Read(Handle, @Compression, SizeOf(Compression));
280 Compression := SwapEndianWord(Compression);
281
282 if Compression = CompressionRLE then
283 begin
284 // RLE compressed PSDs (most) have first lengths of compressed scanlines
285 // for each channel stored
286 SetLength(RLELineSizes, Height * Header.Channels);
287 Read(Handle, @RLELineSizes[0], Length(RLELineSizes) * SizeOf(Word));
288 SwapEndianWord(@RLELineSizes[0], Height * Header.Channels);
289 MaxRLESize := RLELineSizes[0];
290 for I := 1 to High(RLELineSizes) do
291 begin
292 if MaxRLESize < RLELineSizes[I] then
293 MaxRLESize := RLELineSizes[I];
294 end;
295 end
296 else
297 MaxRLESize := 0;
298
299 ChannelPixelSize := Info.BytesPerPixel div Info.ChannelCount;
300 LineSize := Width * ChannelPixelSize;
301 WidthBytes := Width * Info.BytesPerPixel;
302 GetMem(LineBuffer, LineSize);
303 GetMem(PackedLine, MaxRLESize);
304
305 try
306 // Image color chanels are stored separately in PSDs so we will load
307 // one by one and copy their data to appropriate addresses of dest image.
308 for I := 0 to Header.Channels - 1 do
309 begin
310 // Now determine to which color channel of destination image we are going
311 // to write pixels.
312 if I <= 4 then
313 begin
314 // If PSD has alpha channel we need to switch current channel order -
315 // PSDs have alpha stored after blue channel but Imaging has alpha
316 // before red.
317 if Info.HasAlphaChannel and (Header.Mode <> cmCMYK) then
318 begin
319 if I = Info.ChannelCount - 1 then
320 CurrChannel := I
321 else
322 CurrChannel := Info.ChannelCount - 2 - I;
323 end
324 else
325 CurrChannel := Info.ChannelCount - 1 - I;
326 end
327 else
328 begin
329 // No valid channel remains
330 CurrChannel := -1;
331 end;
332
333 if CurrChannel >= 0 then
334 begin
335 for Y := 0 to Height - 1 do
336 begin
337 if Compression = CompressionRLE then
338 begin
339 // Read RLE line and decompress it
340 PackedSize := RLELineSizes[I * Height + Y];
341 Read(Handle, PackedLine, PackedSize);
342 DecodeRLE(PackedLine, LineBuffer, PackedSize, LineSize);
343 end
344 else
345 begin
346 // Just read uncompressed line
347 Read(Handle, LineBuffer, LineSize);
348 end;
349
350 // Swap endian if needed
351 if ChannelPixelSize = 4 then
352 SwapEndianLongWord(PLongWord(LineBuffer), Width)
353 else if ChannelPixelSize = 2 then
354 SwapEndianWord(PWordArray(LineBuffer), Width);
355
356 if Info.ChannelCount > 1 then
357 begin
358 // Copy each pixel fragment to its right place in destination image
359 for X := 0 to Width - 1 do
360 begin
361 Move(PByteArray(LineBuffer)[X * ChannelPixelSize],
362 PByteArray(Bits)[Y * WidthBytes + X * Info.BytesPerPixel + CurrChannel * ChannelPixelSize],
363 ChannelPixelSize);
364 end;
365 end
366 else
367 begin
368 // Just copy the line
369 Move(LineBuffer^, PByteArray(Bits)[Y * LineSize], LineSize);
370 end;
371 end;
372 end
373 else
374 begin
375 // Skip current color channel, not needed for image loading - just to
376 // get stream's position to the end of PSD
377 if Compression = CompressionRLE then
378 begin
379 for Y := 0 to Height - 1 do
380 Seek(Handle, RLELineSizes[I * Height + Y], smFromCurrent);
381 end
382 else
383 Seek(Handle, LineSize * Height, smFromCurrent);
384 end;
385 end;
386
387 if Header.Mode = cmCMYK then
388 begin
389 // Convert CMYK images to RGB (alpha is ignored here). PSD stores CMYK
390 // channels in the way that first requires substraction from max channel value
391 if ChannelPixelSize = 1 then
392 begin
393 PCol32 := Bits;
394 for X := 0 to Width * Height - 1 do
395 begin
396 Col32.A := 255 - PCol32.A;
397 Col32.R := 255 - PCol32.R;
398 Col32.G := 255 - PCol32.G;
399 Col32.B := 255 - PCol32.B;
400 CMYKToRGB(Col32.A, Col32.R, Col32.G, Col32.B, PCol32.R, PCol32.G, PCol32.B);
401 PCol32.A := 255;
402 Inc(PCol32);
403 end;
404 end
405 else
406 begin
407 PCol64 := Bits;
408 for X := 0 to Width * Height - 1 do
409 begin
410 Col64.A := 65535 - PCol64.A;
411 Col64.R := 65535 - PCol64.R;
412 Col64.G := 65535 - PCol64.G;
413 Col64.B := 65535 - PCol64.B;
414 CMYKToRGB16(Col64.A, Col64.R, Col64.G, Col64.B, PCol64.R, PCol64.G, PCol64.B);
415 PCol64.A := 65535;
416 Inc(PCol64);
417 end;
418 end;
419 end;
420
421 if Header.Depth = 32 then
422 begin
423 if (Header.Channels = 3) and (Header.Mode = cmRGB) then
424 begin
425 // RGB images were loaded as ARGB so we must wet alpha manually to 1.0
426 PColF := Bits;
427 for X := 0 to Width * Height - 1 do
428 begin
429 PColF.A := 1.0;
430 Inc(PColF);
431 end;
432 end;
433 end;
434
435 Result := True;
436 finally
437 FreeMem(LineBuffer);
438 FreeMem(PackedLine);
439 end;
440 end;
441 end;
442
443 function TPSDFileFormat.SaveData(Handle: TImagingHandle;
444 const Images: TDynImageDataArray; Index: LongInt): Boolean;
445 type
446 TURect = packed record
447 Top, Left, Bottom, Right: LongWord;
448 end;
449 const
450 BlendMode: TChar8 = '8BIMnorm';
451 LayerOptions: array[0..3] of Byte = (255, 0, 0, 0);
452 LayerName: array[0..7] of AnsiChar = #7'Layer 0';
453 var
454 MustBeFreed: Boolean;
455 ImageToSave: TImageData;
456 Info: TImageFormatInfo;
457 Header: TPSDHeader;
458 I, CurrChannel, ChannelPixelSize: LongInt;
459 LayerBlockOffset, SaveOffset, ChannelInfoOffset: Integer;
460 ChannelInfo: TPSDChannelInfo;
461 R: TURect;
462 LongVal: LongWord;
463 WordVal, LayerCount: Word;
464 RawPal: array[0..767] of Byte;
465 ChannelDataSizes: array of Integer;
466
467 function PackLine(Src, Dest: PByteArray; Length: Integer): Integer;
468 var
469 I, Remaining: Integer;
470 begin
471 Remaining := Length;
472 Result := 0;
473 while Remaining > 0 do
474 begin
475 I := 0;
476 // Look for characters same as the first
477 while (I < 128) and (Remaining - I > 0) and (Src[0] = Src[I]) do
478 Inc(I);
479
480 if I > 2 then
481 begin
482 Dest[0] := Byte(-(I - 1));
483 Dest[1] := Src[0];
484 Dest := PByteArray(@Dest[2]);
485
486 Src := PByteArray(@Src[I]);
487 Dec(Remaining, I);
488 Inc(Result, 2);
489 end
490 else
491 begin
492 // Look for different characters
493 I := 0;
494 while (I < 128) and (Remaining - (I + 1) > 0) and
495 ((Src[I] <> Src[I + 1]) or (Remaining - (I + 2) <= 0) or
496 (Src[I] <> Src[I + 2])) do
497 begin
498 Inc(I);
499 end;
500 // If there's only 1 remaining, the previous WHILE doesn't catch it
501 if Remaining = 1 then
502 I := 1;
503
504 if I > 0 then
505 begin
506 // Some distinct ones found
507 Dest[0] := I - 1;
508 Move(Src[0], Dest[1], I);
509 Dest := PByteArray(@Dest[1 + I]);
510 Src := PByteArray(@Src[I]);
511 Dec(Remaining, I);
512 Inc(Result, I + 1);
513 end;
514 end;
515 end;
516 end;
517
518 procedure WriteChannelData(SeparateChannelStorage: Boolean);
519 var
520 I, X, Y, LineSize, WidthBytes, RLETableOffset, CurrentOffset, WrittenLineSize: Integer;
521 LineBuffer, RLEBuffer: PByteArray;
522 RLELengths: array of Word;
523 Compression: Word;
524 begin
525 LineSize := ImageToSave.Width * ChannelPixelSize;
526 WidthBytes := ImageToSave.Width * Info.BytesPerPixel;
527 GetMem(LineBuffer, LineSize);
528 GetMem(RLEBuffer, LineSize * 3);
529 SetLength(RLELengths, ImageToSave.Height * Info.ChannelCount);
530 RLETableOffset := 0;
531 // No compression for FP32, Photoshop won't open them
532 Compression := Iff(Info.IsFloatingPoint, CompressionNone, CompressionRLE);
533
534 if not SeparateChannelStorage then
535 begin
536 // This is for storing background merged image. There's only one
537 // complession flag and one RLE lenghts table for all channels
538 WordVal := Swap(Compression);
539 GetIO.Write(Handle, @WordVal, SizeOf(WordVal));
540 if Compression = CompressionRLE then
541 begin
542 RLETableOffset := GetIO.Tell(Handle);
543 GetIO.Write(Handle, @RLELengths[0], SizeOf(Word) * ImageToSave.Height * Info.ChannelCount);
544 end;
545 end;
546
547 for I := 0 to Info.ChannelCount - 1 do
548 begin
549 if SeparateChannelStorage then
550 begin
551 // Layer image data has compression flag and RLE lenghts table
552 // independent for each channel
553 WordVal := Swap(CompressionRLE);
554 GetIO.Write(Handle, @WordVal, SizeOf(WordVal));
555 if Compression = CompressionRLE then
556 begin
557 RLETableOffset := GetIO.Tell(Handle);
558 GetIO.Write(Handle, @RLELengths[0], SizeOf(Word) * ImageToSave.Height);
559 ChannelDataSizes[I] := 0;
560 end;
561 end;
562
563 // Now determine which color channel we are going to write to file.
564 if Info.HasAlphaChannel then
565 begin
566 if I = Info.ChannelCount - 1 then
567 CurrChannel := I
568 else
569 CurrChannel := Info.ChannelCount - 2 - I;
570 end
571 else
572 CurrChannel := Info.ChannelCount - 1 - I;
573
574 for Y := 0 to ImageToSave.Height - 1 do
575 begin
576 if Info.ChannelCount > 1 then
577 begin
578 // Copy each pixel fragment to its right place in destination image
579 for X := 0 to ImageToSave.Width - 1 do
580 begin
581 Move(PByteArray(ImageToSave.Bits)[Y * WidthBytes + X * Info.BytesPerPixel + CurrChannel * ChannelPixelSize],
582 PByteArray(LineBuffer)[X * ChannelPixelSize], ChannelPixelSize);
583 end;
584 end
585 else
586 Move(PByteArray(ImageToSave.Bits)[Y * LineSize], LineBuffer^, LineSize);
587
588 // Write current channel line to file (swap endian if needed first)
589 if ChannelPixelSize = 4 then
590 SwapEndianLongWord(PLongWord(LineBuffer), ImageToSave.Width)
591 else if ChannelPixelSize = 2 then
592 SwapEndianWord(PWordArray(LineBuffer), ImageToSave.Width);
593
594 if Compression = CompressionRLE then
595 begin
596 // Compress and write line
597 WrittenLineSize := PackLine(LineBuffer, RLEBuffer, LineSize);
598 {RLELineSize := 7;
599 RLEBuffer[0] := 129; RLEBuffer[1] := 255; RLEBuffer[2] := 131; RLEBuffer[3] := 100;
600 RLEBuffer[4] := 1; RLEBuffer[5] := 0; RLEBuffer[6] := 255;}
601 RLELengths[ImageToSave.Height * I + Y] := SwapEndianWord(WrittenLineSize);
602 GetIO.Write(Handle, RLEBuffer, WrittenLineSize);
603 end
604 else
605 begin
606 WrittenLineSize := LineSize;
607 GetIO.Write(Handle, LineBuffer, WrittenLineSize);
608 end;
609
610 if SeparateChannelStorage then
611 Inc(ChannelDataSizes[I], WrittenLineSize);
612 end;
613
614 if SeparateChannelStorage and (Compression = CompressionRLE) then
615 begin
616 // Update channel RLE lengths
617 CurrentOffset := GetIO.Tell(Handle);
618 GetIO.Seek(Handle, RLETableOffset, smFromBeginning);
619 GetIO.Write(Handle, @RLELengths[ImageToSave.Height * I], SizeOf(Word) * ImageToSave.Height);
620 GetIO.Seek(Handle, CurrentOffset, smFromBeginning);
621 Inc(ChannelDataSizes[I], SizeOf(Word) * ImageToSave.Height);
622 end;
623 end;
624
625 if not SeparateChannelStorage and (Compression = CompressionRLE) then
626 begin
627 // Update channel RLE lengths
628 CurrentOffset := GetIO.Tell(Handle);
629 GetIO.Seek(Handle, RLETableOffset, smFromBeginning);
630 GetIO.Write(Handle, @RLELengths[0], SizeOf(Word) * ImageToSave.Height * Info.ChannelCount);
631 GetIO.Seek(Handle, CurrentOffset, smFromBeginning);
632 end;
633
634 FreeMem(LineBuffer);
635 FreeMem(RLEBuffer);
636 end;
637
638 begin
639 Result := False;
640 if MakeCompatible(Images[Index], ImageToSave, MustBeFreed) then
641 with GetIO, ImageToSave do
642 try
643 Info := GetFormatInfo(Format);
644 ChannelPixelSize := Info.BytesPerPixel div Info.ChannelCount;
645
646 // Fill header with proper info and save it
647 FillChar(Header, SizeOf(Header), 0);
648 Header.Signature := SPSDMagic;
649 Header.Version := 1;
650 Header.Channels := Info.ChannelCount;
651 Header.Rows := Height;
652 Header.Columns := Width;
653 Header.Depth := Info.BytesPerPixel div Info.ChannelCount * 8;
654 if Info.IsIndexed then
655 Header.Mode := cmIndexed
656 else if Info.HasGrayChannel or (Info.ChannelCount = 1) then
657 Header.Mode := cmGrayscale
658 else
659 Header.Mode := cmRGB;
660
661 SwapHeader(Header);
662 Write(Handle, @Header, SizeOf(Header));
663
664 // Write palette size and data
665 LongVal := SwapEndianLongWord(IffUnsigned(Info.IsIndexed, SizeOf(RawPal), 0));
666 Write(Handle, @LongVal, SizeOf(LongVal));
667 if Info.IsIndexed then
668 begin
669 for I := 0 to Info.PaletteEntries - 1 do
670 begin
671 RawPal[I] := Palette[I].R;
672 RawPal[I + 256] := Palette[I].G;
673 RawPal[I + 512] := Palette[I].B;
674 end;
675 Write(Handle, @RawPal, SizeOf(RawPal));
676 end;
677
678 // Write empty resource and layer block sizes
679 LongVal := 0;
680 Write(Handle, @LongVal, SizeOf(LongVal));
681 LayerBlockOffset := Tell(Handle);
682 Write(Handle, @LongVal, SizeOf(LongVal));
683
684 if FSaveAsLayer and (ChannelPixelSize < 4) then // No Layers for FP32 images
685 begin
686 LayerCount := SwapEndianWord(Iff(Info.HasAlphaChannel, Word(-1), 1)); // Must be -1 to get transparency in Photoshop
687 R.Top := 0;
688 R.Left := 0;
689 R.Bottom := SwapEndianLongWord(Height);
690 R.Right := SwapEndianLongWord(Width);
691 WordVal := SwapEndianWord(Info.ChannelCount);
692 Write(Handle, @LongVal, SizeOf(LongVal)); // Layer section size, empty now
693 Write(Handle, @LayerCount, SizeOf(LayerCount)); // Layer count
694 Write(Handle, @R, SizeOf(R)); // Bounds rect
695 Write(Handle, @WordVal, SizeOf(WordVal)); // Channeel count
696
697 ChannelInfoOffset := Tell(Handle);
698 SetLength(ChannelDataSizes, Info.ChannelCount); // Empty channel infos
699 FillChar(ChannelInfo, SizeOf(ChannelInfo), 0);
700 for I := 0 to Info.ChannelCount - 1 do
701 Write(Handle, @ChannelInfo, SizeOf(ChannelInfo));
702
703 Write(Handle, @BlendMode, SizeOf(BlendMode)); // Blend mode = normal
704 Write(Handle, @LayerOptions, SizeOf(LayerOptions)); // Predefined options
705 LongVal := SwapEndianLongWord(16); // Extra data size (4 (mask size) + 4 (ranges size) + 8 (name))
706 Write(Handle, @LongVal, SizeOf(LongVal));
707 LongVal := 0;
708 Write(Handle, @LongVal, SizeOf(LongVal)); // Mask size = 0
709 LongVal := 0;
710 Write(Handle, @LongVal, SizeOf(LongVal)); // Blend ranges size
711 Write(Handle, @LayerName, SizeOf(LayerName)); // Layer name
712
713 WriteChannelData(True); // Write Layer image data
714
715 Write(Handle, @LongVal, SizeOf(LongVal)); // Global mask info size = 0
716
717 SaveOffset := Tell(Handle);
718 Seek(Handle, LayerBlockOffset, smFromBeginning);
719
720 // Update layer and mask section sizes
721 LongVal := SwapEndianLongWord(SaveOffset - LayerBlockOffset - 4);
722 Write(Handle, @LongVal, SizeOf(LongVal));
723 LongVal := SwapEndianLongWord(SaveOffset - LayerBlockOffset - 8);
724 Write(Handle, @LongVal, SizeOf(LongVal));
725
726 // Update layer channel info
727 Seek(Handle, ChannelInfoOffset, smFromBeginning);
728 for I := 0 to Info.ChannelCount - 1 do
729 begin
730 ChannelInfo.ChannelID := SwapEndianWord(I);
731 if (I = Info.ChannelCount - 1) and Info.HasAlphaChannel then
732 ChannelInfo.ChannelID := Swap(Word(-1));
733 ChannelInfo.Size := SwapEndianLongWord(ChannelDataSizes[I] + 2); // datasize (incl RLE table) + comp. flag
734 Write(Handle, @ChannelInfo, SizeOf(ChannelInfo));
735 end;
736
737 Seek(Handle, SaveOffset, smFromBeginning);
738 end;
739
740 // Write background merged image
741 WriteChannelData(False);
742
743 Result := True;
744 finally
745 if MustBeFreed then
746 FreeImage(ImageToSave);
747 end;
748 end;
749
750 procedure TPSDFileFormat.ConvertToSupported(var Image: TImageData;
751 const Info: TImageFormatInfo);
752 var
753 ConvFormat: TImageFormat;
754 begin
755 if Info.IsFloatingPoint then
756 ConvFormat := IffFormat(Info.ChannelCount = 1, ifR32F, ifA32R32G32B32F)
757 else if Info.HasGrayChannel then
758 ConvFormat := IffFormat(Info.HasAlphaChannel, ifA16Gray16, ifGray16)
759 else if Info.RBSwapFormat in GetSupportedFormats then
760 ConvFormat := Info.RBSwapFormat
761 else
762 ConvFormat := IffFormat(Info.HasAlphaChannel, ifA8R8G8B8, ifR8G8B8);
763
764 ConvertImage(Image, ConvFormat);
765 end;
766
767 function TPSDFileFormat.TestFormat(Handle: TImagingHandle): Boolean;
768 var
769 Header: TPSDHeader;
770 ReadCount: LongInt;
771 begin
772 Result := False;
773 if Handle <> nil then
774 begin
775 ReadCount := GetIO.Read(Handle, @Header, SizeOf(Header));
776 SwapHeader(Header);
777 GetIO.Seek(Handle, -ReadCount, smFromCurrent);
778 Result := (ReadCount >= SizeOf(Header)) and
779 (Header.Signature = SPSDMagic) and
780 (Header.Version = 1);
781 end;
782 end;
783
784 initialization
785 RegisterImageFileFormat(TPSDFileFormat);
786
787 {
788 File Notes:
789
790 -- TODOS ----------------------------------------------------
791 - nothing now
792
793 -- 0.26.1 Changes/Bug Fixes ---------------------------------
794 - PSDs are now saved with RLE compression.
795 - Mask layer saving added to SaveData for images with alpha
796 (shows proper transparency when opened in Photoshop). Can be
797 enabled/disabled using option
798 - Fixed memory leak in SaveData.
799
800 -- 0.23 Changes/Bug Fixes -----------------------------------
801 - Saving implemented.
802 - Loading implemented.
803 - Unit created with initial stuff!
804 }
805
806 end.
[MIRROR] a port of Doom 2D Forever to FPC/SDL
[25/02/2024 19:55:35]
DEADSOFTWARE 2012-2024