DEADSOFTWARE

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