1 // SPDX-License-Identifier: GPL-3.0-only
2 unit URaw;
3
4 {$mode objfpc}{$H+}
5
6 interface
7
8 uses
9 Classes, SysUtils, FPimage, BGRABitmap, BGRABitmapTypes, Controls;
10
11 type
12 TRawExtension = record
13 ext: string;
14 brand: string;
15 end;
16
17 const
18 RawFileExtensions: array[0..28] of TRawExtension =
19 ((ext:'3fr'; brand:'Hasselblad'),
20 (ext:'ari'; brand:'Arri_Alexa'),
21 (ext:'arw;srf;sr2'; brand:'Sony'),
22 (ext:'bay'; brand:'Casio'),
23 (ext:'braw'; brand:'Blackmagic Design'),
24 (ext:'cri'; brand:'Cintel'),
25 (ext:'crw;cr2;cr3'; brand:'Canon'),
26 (ext:'cap;iiq;eip'; brand:'Phase_One'),
27 (ext:'dcs;dcr;drf;k25;kdc'; brand:'Kodak'),
28 (ext:'dng'; brand:'Adobe'),
29 (ext:'erf'; brand:'Epson'),
30 (ext:'fff'; brand:'Imacon/Hasselblad raw'),
31 (ext:'gpr'; brand:'GoPro'),
32 (ext:'mef'; brand:'Mamiya'),
33 (ext:'mdc'; brand:'Minolta, Agfa'),
34 (ext:'mos'; brand:'Leaf'),
35 (ext:'mrw'; brand:'Minolta, Konica Minolta'),
36 (ext:'nef;nrw'; brand:'Nikon'),
37 (ext:'orf'; brand:'Olympus'),
38 (ext:'pef;ptx'; brand:'Pentax'),
39 (ext:'pxn'; brand:'Logitech'),
40 (ext:'R3D'; brand:'RED Digital Cinema'),
41 (ext:'raf'; brand:'Fuji'),
42 (ext:'raw'; brand:'Panasonic/Leica'),
43 (ext:'rw2'; brand:'Panasonic'),
44 (ext:'rwl;dng'; brand:'Leica'),
45 (ext:'rwz'; brand:'Rawzor'),
46 (ext:'srw'; brand:'Samsung'),
47 (ext:'x3f'; brand:'Sigma'));
48
49 var
50 AllRawExtensions: string;
51
GetRawStreamThumbnailnull52 function GetRawStreamThumbnail(AStream: TStream; AWidth,AHeight: integer;
53 ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap= nil): TBGRABitmap;
GetRawStreamImagenull54 function GetRawStreamImage(AStream: TStream): TBGRABitmap;
IsRawFilenamenull55 function IsRawFilename(AFilename: string): boolean;
GetRawFileImagenull56 function GetRawFileImage(AFilename: string): TBGRABitmap;
57
58 implementation
59
60 uses process, BGRAThumbnail, UResourceStrings, UFileSystem, Forms, LazFileUtils;
61
62 var
63 RawCriticalSection: TRTLCriticalSection;
64
GetAllRawExtensionsnull65 function GetAllRawExtensions: string;
66 var
67 i: Integer;
68 begin
69 result := '';
70 for i := low(RawFileExtensions) to high(RawFileExtensions) do
71 begin
72 if result <> '' then result += ';';
73 result += RawFileExtensions[i].ext;
74 end;
75 end;
76
77 procedure RunDCRaw(AOptions: array of string;
78 AInputStream, AOutputStream: TStream);
79 var
80 tempName,tempOutName: String;
81 s: TFileStream;
82 p: TProcess;
83 available: DWord;
84 i: Integer;
85 consoleOut, tiffOut: boolean;
86 begin
87 tempName := '';
88 p := nil;
89 try
90
91 EnterCriticalsection(RawCriticalSection);
92 try
93 tempName := GetTempFileName;
94 s := TFileStream.Create(tempName, fmCreate);
95 try
96 s.CopyFrom(AInputStream, AInputStream.Size);
97 finally
98 s.Free;
99 end;
100 finally
101 LeaveCriticalsection(RawCriticalSection);
102 end;
103
104 p := TProcess.Create(nil);
105 try
106 p.Options:= p.Options+[poStderrToOutPut, poNoConsole];
107 {$IFDEF WINDOWS}
108 p.CurrentDirectory:= ExtractFilePath(Application.ExeName);
109 p.Executable:= 'dcraw.exe';
110 if not FileExistsUTF8(p.CurrentDirectory+p.Executable) then
111 raise exception.Create('Cannot find DCRaw binary');
112 {$ELSE}
113 p.Executable:= 'dcraw';
114 {$ENDIF}
115
116 consoleOut := false;
117 tiffOut := false;
118 for i := 0 to High(AOptions) do
119 begin
120 p.Parameters.Add(AOptions[i]);
121 if AOptions[i] = '-c' then consoleOut := true;
122 if AOptions[i] = '-T' then tiffOut := true;
123 end;
124 p.Parameters.Add(tempName);
125
126 if consoleOut then
127 begin
128 p.Options:= p.Options+[poUsePipes];
129 p.PipeBufferSize:= 524288;
130 p.Execute;
131 while p.Running do
132 begin
133 available:=P.Output.NumBytesAvailable;
134 if available > 0 then
135 AOutputStream.CopyFrom(P.Output, available)
136 else
137 sleep(30);
138 end;
139 available:=P.Output.NumBytesAvailable;
140 if available > 0 then
141 AOutputStream.CopyFrom(P.Output, available);
142 end else
143 begin
144 if tiffOut then
145 tempOutName := ChangeFileExt(tempName, '.tiff')
146 else
147 tempOutName := ChangeFileExt(tempName, '.ppm');
148 p.Execute;
149 try
150 p.WaitOnExit;
151 if not FileExists(tempOutName) then
152 raise exception.Create(rsErrorDecodingRaw);
153 s := TFileStream.Create(tempOutName, fmOpenRead);
154 try
155 AOutputStream.CopyFrom(s, s.Size);
156 finally
157 s.Free;
158 end;
159 finally
160 if FileExists(tempOutName) then DeleteFile(tempOutName);
161 end;
162 end;
163 finally
164 FreeAndNil(p);
165 end;
166 finally
167 if FileExists(tempName) then DeleteFile(tempName);
168 end;
169 end;
170
GetRawStreamThumbnailnull171 function GetRawStreamThumbnail(AStream: TStream; AWidth, AHeight: integer;
172 ABackColor: TBGRAPixel; ACheckers: boolean; ADest: TBGRABitmap): TBGRABitmap;
173 var
174 thumbData: TMemoryStream;
175 begin
176 result := nil;
177 thumbData := TMemoryStream.Create;
178 try
179 RunDCRaw(['-c','-e'],AStream,thumbData);
180 thumbData.Position:= 0;
181 result := GetStreamThumbnail(thumbData, AWidth,AHeight, ABackColor,ACheckers,'',ADest);
182 finally
183 thumbData.Free;
184 end;
185 end;
186
GetRawStreamImagenull187 function GetRawStreamImage(AStream: TStream): TBGRABitmap;
188 var
189 imageData: TMemoryStream;
190 prevCursor: TCursor;
191 begin
192 prevCursor := Screen.Cursor;
193 Screen.Cursor:= crHourGlass;
194 result := nil;
195 imageData := TMemoryStream.Create;
196 try
197 RunDCRaw(['-T'],AStream,imageData);
198 imageData.Position:= 0;
199 result := TBGRABitmap.Create(imageData);
200 finally
201 imageData.Free;
202 Screen.Cursor:= prevCursor;
203 end;
204 end;
205
IsRawFilenamenull206 function IsRawFilename(AFilename: string): boolean;
207 var
208 ext: String;
209 begin
210 ext := LowerCase(ExtractFileExt(AFilename));
211 delete(ext,1,1);
212 result := Pos(';'+ext+';',';'+AllRawExtensions+';') <> 0;
213 end;
214
GetRawFileImagenull215 function GetRawFileImage(AFilename: string): TBGRABitmap;
216 var
217 s: TStream;
218 begin
219 s := FileManager.CreateFileStream(AFilename, fmOpenRead);
220 result := nil;
221 try
222 result := GetRawStreamImage(s);
223 finally
224 s.Free;
225 end;
226 end;
227
228 initialization
229
230 AllRawExtensions := GetAllRawExtensions;
231 InitCriticalSection(RawCriticalSection);
232
233 finalization
234
235 DoneCriticalsection(RawCriticalSection);
236
237 end.
238
239