📄 ieraw.pas
字号:
with xprogress do
if assigned(fOnProgress) then
fOnProgress(Sender, trunc(per1 * row));
for i:=0 to 3-1 do
mul[i] := getbits(rec^,6);
for c:=0 to 3-1 do
begin
val := (($1000000 div last[c] + $7ff) shr 12) * mul[c];
s := IEIFI(val > 65564 , 10,12);
x := not (-1 shl (s-1));
val := val shl (12-s);
for i:=0 to sizeof(buf[0]) div sizeof(smallint)-1 do
buf[c][0][i] := (buf[c][0][i] * val + x) shr s;
last[c] := mul[c];
for r:=0 to IENOT(c) do
begin
buf[c][2][width div 2] := mul[c] shl 7;
buf[c][1][width div 2] := buf[c][2][width div 2];
tree:=1; col:=width div 2;
while ( col > 0 ) do
begin
tree := radc_token(rec^,tree);
if (tree<>0) then
begin
dec(col , 2);
if (tree = 8) then
for y:=1 to 3-1 do
for x:=col+1 downto col do
buf[c][y][x] := radc_token(rec^,tree+10) * mul[c]
else
for y:=1 to 3-1 do
for x:=col+1 downto col do
buf[c][y][x] := radc_token(rec^,tree+10) * 16 + PREDICTOR;
end
else
repeat
nreps := IEIFI( (col > 2) , radc_token(rec^,9) + 1 , 1 );
rep:=0;
while ( rep < 8) and (rep < nreps) and (col > 0 ) do
begin
dec(col , 2);
for y:=1 to 3-1 do
for x:=col+1 downto col do
buf[c][y][x] := PREDICTOR;
if (rep and 1)<>0 then
begin
step := radc_token(rec^,10) shl 4;
for y:=1 to 3-1 do
for x:=col+1 downto col do
inc(buf[c][y][x] , step);
end;
inc(rep);
end;
until (nreps <> 9);
end;
for y:=0 to 2-1 do
for x:=0 to width div 2 do
begin
val := (buf[c][y+1][x] shl 4) div mul[c];
if (val < 0) then
val := 0;
if (c<>0) then
BAYER(rec^,row+y*2+c-1,x*2+2-c)^ := val
else
BAYER(rec^,row+r*2+y,x*2+y)^ := val;
end;
memcpy( pointer(integer(@buf[c][0])+IENOT(c)*sizeof(smallint)) , @buf[c][2] , 386-2*IENOT(c) );
end;
end;
for y:=row to row+4-1 do
for x:=0 to width-1 do
if ((x+y) and 1)<>0 then
begin
val := (BAYER(rec^,y,x)^-2048)*2 + (BAYER(rec^,y,x-1)^+BAYER(rec^,y,x+1)^) div 2;
if (val < 0) then
val := 0;
BAYER(rec^,y,x)^ := val;
end;
inc(row,4);
end;
end;
end;
function fill_input_buffer(var rec:TRec; cinfo: pointer): LongBool;
var
nbytes:integer;
begin
with rec do
begin
nbytes := ifp.Read(jpeg_buffer[0],4096); //nbytes = fread (jpeg_buffer, 1, 4096, ifp);
swab (pchar(@jpeg_buffer), pchar(@jpeg_buffer), nbytes);
IEJPEG_SetNextInput(cinfo,@jpeg_buffer,nbytes);
//cinfo^.src^.next_input_byte := @jpeg_buffer;
//cinfo^.src^.bytes_in_buffer := nbytes;
result:=TRUE;
end;
end;
procedure kodak_jpeg_load_raw(rec:PRec);
type
t3bytes=array [0..2] of byte;
p3bytes=^t3bytes;
t3bytesarray=array [0..maxint div 16] of p3bytes;
p3bytesarray=^t3bytesarray;
JSAMPLE_ARRAY = array[0..(MaxInt div SIZEOF(byte)) - 1] of byte;
JSAMPROW = ^JSAMPLE_ARRAY;
JSAMPROW_ARRAY = array[0..(MaxInt div SIZEOF(JSAMPROW)) - 1] of JSAMPROW;
JSAMPARRAY = ^JSAMPROW_ARRAY;
var
cinfo:pointer ;
jerr:pointer;
buf:JSAMPARRAY ;
pixel:p3bytesarray; // 'byte (*pixel)[3]';
row, col:integer;
output_width,output_height,output_components,output_scanline:integer;
begin
with rec^ do
begin
cinfo:=IEJPEG_CreateDecompStruct;
jerr:=IEJPEG_CreateErrMgr(cinfo);
//cinfo.err := jpeg_std_error (@jerr); // inside IEJPEG_CreateErrMgr
IEJPEG_CreateDecompress(cinfo);
IEJPEG_SetReadStream(cinfo,ifp); //jpeg_stdio_src (@cinfo, ifp);
IEJPEG_SetFillInputBuffer(cinfo,@fill_input_buffer); //cinfo.src^.fill_input_buffer := fill_input_buffer;
IEJPEG_ReadHeader(cinfo,true); //jpeg_read_header (@cinfo, TRUE);
IEJPEG_StartDecompress(cinfo); // jpeg_start_decompress (@cinfo);
output_width:=IEJPEG_GetOutputWidth(cinfo);
output_height:=IEJPEG_GetOutputHeight(cinfo);
output_components:=IEJPEG_GetOutputComponents(cinfo);
if ((output_width <> width ) or (output_height*2 <> height ) or (output_components <> 3)) then
begin
IEJPEG_DestroyDecompress(cinfo); //jpeg_destroy_decompress (@cinfo);
raise Exception.Create(': incorrect JPEG dimensions');
end;
buf:=IEJPEG_AllocSArray(cinfo,1,width*3,1); //buf := cinfo.mem^.alloc_sarray(j_common_ptr( @cinfo), JPOOL_IMAGE, width*3, 1);
xprogress.per1 := 100 / output_height / 2;
output_scanline:=IEJPEG_GetOutputScanline(cinfo);
while (output_scanline < output_height) do
begin
with xprogress do
if assigned(fOnProgress) then
fOnProgress(Sender, trunc(per1 * output_scanline));
row := output_scanline * 2;
IEJPEG_ReadScanlines(cinfo,buf,1); //jpeg_read_scanlines (@cinfo, buf, 1);
pixel := pointer( buf[0] );
col:=0;
while (col < width) do
begin
BAYER(rec^,row+0,col+0)^ := pixel[col+0][1] shl 6;
BAYER(rec^,row+1,col+1)^ := pixel[col+1][1] shl 6;
BAYER(rec^,row+0,col+1)^ := (pixel[col][0] + pixel[col+1][0]) shl 5;
BAYER(rec^,row+1,col+0)^ := (pixel[col][2] + pixel[col+1][2]) shl 5;
inc(col,2);
end;
end;
IEJPEG_FinishDecompress(cinfo); //jpeg_finish_decompress (&cinfo);
IEJPEG_DestroyDecompress(cinfo); //jpeg_destroy_decompress (&cinfo);
IEJPEG_FreeDecompStruct(cinfo);
IEJPEG_FreeErrMgr(jerr);
end;
end;
procedure kodak_dc120_load_raw(rec:PRec);
const
mul:array [0..4-1] of integer = ( 162, 192, 187, 92 );
add:array [0..4-1] of integer = ( 0, 636, 424, 212 );
var
pixel:array [0..848-1] of byte;
row, shift, col:integer;
begin
with rec^ do
begin
xprogress.per1 := 100 / height / 2;
for row:=0 to height-1 do
begin
with xprogress do
if assigned(fOnProgress) then
fOnProgress(Sender, trunc(per1 * row));
ifp.Read(pixel[0],848); //fread (pixel, 848, 1, ifp);
shift := row * mul[row and 3] + add[row and 3];
for col:=0 to width-1 do
BAYER(rec^,row,col)^ := pixel[(col + shift) mod 848] shl 6;
end;
end;
end;
procedure kodak_dc20_coeff (var rec:TRec; juice:single);
const
my_coeff:array [0..3-1] of array [0..4-1] of single=
( ( 2.25, 0.75, -1.75, -0.25 ),
( -0.25, 0.75, 0.75, -0.25 ),
( -0.25, -1.75, 0.75, 2.25 ) );
flat:array [0..3-1] of array [0..4-1] of single=
( ( 1, 0, 0, 0 ),
( 0, 0.5, 0.5, 0 ),
( 0, 0, 0, 1 ) );
var
r, g:integer;
begin
with rec do
begin
for r:=0 to 3-1 do
for g:=0 to 4-1 do
coeff[r][g] := my_coeff[r][g] * juice + flat[r][g] * (1-juice);
use_coeff := 1;
end;
end;
procedure kodak_easy_load_raw(rec:PRec);
var
pixel:pbytearray;
curve:array [0..$1000-1] of word;
row, col, icol:dword;
begin
with rec^ do
begin
kodak_curve (rec^,@curve);
if (raw_width > width) then
black := 0;
pixel := allocmem(raw_width * sizeof(byte));
merror (pixel, 'kodak_easy_load_raw()');
xprogress.per1 := 100 / height / 2;
for row:=0 to height-1 do
begin
with xprogress do
if assigned(fOnProgress) then
fOnProgress(Sender, trunc(per1 * row));
ifp.Read(pixel[0],raw_width); //fread (pixel, 1, raw_width, ifp);
for col:=0 to raw_width-1 do
begin
icol := col - left_margin;
if (icol < width) then
BAYER(rec^,row,icol)^ := curve[pixel[col]] shl 2
else
inc(black , curve[pixel[col]]);
end;
end;
if (raw_width > width) then
black := ( black shl 2) div ((raw_width - width) * height);
if strncmp(model,'DC2',3)=0 then
black := 0;
freemem(pixel);
end;
end;
procedure kodak_compressed_load_raw(rec:PRec);
var
c:byte;
blen:array [0..256-1] of byte;
raw:array [0..6-1] of word;
curve:array [0..$1000-1] of word;
row, col, len, save, i, israw, bits:dword;
pred:array [0..2-1] of dword;
bitbuf:int64;
diff:integer;
temp:integer;
begin
with rec^ do
begin
israw:=0;
bits:=0;
bitbuf:=0;
kodak_curve (rec^,@curve);
xprogress.per1 := 100 / height / 2;
for row:=0 to height-1 do
begin
with xprogress do
if assigned(fOnProgress) then
fOnProgress(Sender, trunc(per1 * row));
for col:=0 to width-1 do
begin
if ((col and 255) = 0) then
begin (* Get the bit-lengths of the *)
len := width - col; (* next 256 pixel values *)
if (len > 256) then
len := 256;
save := ftell(ifp);
i:=0;
israw:=0;
while ( i < len ) do
begin
c := fgetc(ifp);
blen[i+0] := c and 15;
if blen[i+0]>12 then
israw:=1
else
begin
blen[i+1] := c shr 4;
if blen[i+1]>12 then
israw:=1;
end;
inc(i,2);
end;
bitbuf := 0;
bits := 0;
pred[0] := 0;
pred[1] := 0;
if (len mod 8 = 4) then
begin
bitbuf := fgetc(ifp) shl 8;
inc(bitbuf , fgetc(ifp) );
bits := 16;
end;
if (israw<>0) then
ifp.Position:=save; //fseek (ifp, save, SEEK_SET);
end;
if (israw<>0) then (* If the data is not compressed *)
begin
case (col and 7) of
0:
begin
ifp.Read(raw[0],2*6); // fread (raw, 2, 6, ifp);
for i:=0 to 6-1 do
raw[i] := ntohs(raw[i]);
diff := raw[0] shr 12 shl 8 or raw[2] shr 12 shl 4 or raw[4] shr 12;
end;
1:
diff := raw[1] shr 12 shl 8 or raw[3] shr 12 shl 4 or raw[5] shr 12;
else
diff := raw[(col and 7) - 2] and $fff;
end;
end
else
begin (* If the data is compressed *)
len := blen[col and 255]; (* Number of bits for this pixel *)
if (bits < len) then (* Got enough bits in the buffer? *)
begin
i:=0;
while (i < 32) do
begin
inc(bitbuf , int64(fgetc(ifp)) shl (bits+(i xor 8)));
inc(i,8);
end;
inc(bits , 32);
end;
diff := bitbuf and ($ffff shr (16-len)); (* Pull bits from buffer *)
bitbuf := bitbuf shr len;
dec(bits , len);
if ((diff and (1 shl (len-1))) = 0) then
dec(diff , (1 shl len) - 1);
inc( pred[col and 1] , diff);
diff := pred[col and 1];
end;
BAYER(rec^,row,col)^ := curve[diff] shl 2;
end;
end;
end;
end;
procedure kodak_yuv_load_raw(rec:PRec);
var
c:byte;
blen:array [0..384-1] of byte;
row, col, len, bits:dword;
bitbuf:int64;
i, li, si, diff, cb, cr:integer ;
y:array [0..4-1] of integer;
six:array [0..6-1] of integer;
rgb:array [0..3-1] of integer;
ip:pwordarray;
curve:array [0..$1000-1] of word;
begin
with rec^ do
begin
bits:=0;
bitbuf:=0;
li:=0;
cb:=0;
cr:=0;
kodak_curve (rec^,@curve);
xprogress.per1 := 100 / height / 2;
row:=0;
while ( row < height ) do
begin
with xprogress do
if assigned(fOnProgress) then
fOnProgress(Sender, trunc(per1 * row));
col:=0;
while ( col < width ) do
begin
if ((col and 127) = 0) then
begin
len := (width - col + 1) * 3 and -4;
if (len > 384) then
len := 384;
i:=0;
while ( i < len ) do
begin
c := fgetc(ifp);
blen[i] := c and 15; inc(i);
blen[i] := c shr 4; inc(i);
end;
li := 0;
bitbuf := 0;
bits := 0;
y[1] := 0;
y[3] := 0;
cb := 0;
cr := 0;
if (len mod 8 = 4) then
begin
bitbuf := fgetc(ifp) shl 8;
inc( bitbuf , fgetc(ifp) );
bits := 16;
end;
end;
for si:=0 to 6-1 do
begin
len := blen[li]; inc(li);
if (bits < len) then
begin
i:=0;
while ( i < 32 ) do
begin
inc( bitbuf , fgetc(ifp) shl (bits+(i xor 8)) );
inc(i,8);
end;
inc(bits , 32 );
end;
diff := bitbuf and ($ffff shr (16-len));
bitbuf := bitbuf shr len;
dec(bits , len);
if ((diff and (1 shl (len-1))) = 0) then
dec( diff , (1 shl len) - 1 );
six[si] := diff;
end;
y[0] := six[0] + y[1];
y[1] := six[1] + y[0];
y[2] := six[2] + y[3];
y[3] := six[3] + y[2];
inc( cb , six[4] );
inc( cr , six[5] );
for i:=0 to 4-1 do
begin
ip := pwordarray( @image[ (row+(i shr 1))*width + col+(i and 1) ][0] );
rgb[0] := y[i] + cr;
rgb[1] := y[i];
rgb[2] := y[i] + cb;
for c:=0 to 3-1 do
if (rgb[c] > 0) then
ip[c] := curve[rgb[c]] shl 2;
end;
inc(col,2);
end;
inc(row,2);
end;
end;
end;
procedure sony_decrypt (var rec:TRec; data:pdword; len:integer; start:integer; key:integer);
begin
with rec do
begin
if (start<>0) then
begin
decrypt_p:=0;
while( decrypt_p<4 ) do
begin
key := key * 48828125 + 1;
pad[decrypt_p] := key ;
inc(decrypt_p);
end;
pad[3] := pad[3] shl 1 or (pad[0]⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -