1%%
2%%  e3d__png.erl --
3%%
4%%     Functions for reading and writing PNG files.
5%%
6%%  Copyright (c) 2005-2011 Dan Gudmundsson
7%%
8%%  See the file "license.terms" for information on usage and redistribution
9%%  of this file, and for a DISCLAIMER OF ALL WARRANTIES.
10%%
11%%     $Id$
12%%
13-module(e3d__png).
14
15-export([load/1,load/2,save/2,save/3,save_bin/1,save_bin/2]).
16-export([format_error/1, test/1, test/0]).
17
18%%-compile(export_all). %% testing
19-compile(inline).
20
21-include("e3d_image.hrl").
22
23%%-define(TC(Cmd), wings_util:tc(fun() -> Cmd end, ?MODULE, ?LINE)).
24-define(MAGIC, 137,$P,$N,$G,$\r,$\n,26,$\n).
25
26-define(GREYSCALE,   0).
27-define(TRUECOLOUR,  2).
28-define(INDEXED,     3).
29-define(GREYSCALE_A, 4).
30-define(TRUECOLOUR_A,6).
31
32-define(MAX_WBITS,15).
33
34-record(png, {w,h,bpc,type,palette,
35	      interlace=0,trns,bkgd=[0,0,0,0],
36	      restype,chunks=[]}).
37
38%% Chunk sz of 240 bytes is good divideable with 2|3|4 which always givs complete
39%% pixels in the chunks.
40-define(CHUNK, 240).
41
42-define(get4p1(Idx),((Idx)  bsr 4)).
43-define(get4p2(Idx),((Idx)  band 16#0F)).
44-define(get2p1(Idx),((Idx)  bsr 6)).
45-define(get2p2(Idx),(((Idx) bsr 4) band 3)).
46-define(get2p3(Idx),(((Idx) bsr 2) band 3)).
47-define(get2p4(Idx),((Idx)  band 3)).
48-define(get1p1(Idx),((Idx)  bsr 7)).
49-define(get1p2(Idx),(((Idx) bsr 6) band 1)).
50-define(get1p3(Idx),(((Idx) bsr 5) band 1)).
51-define(get1p4(Idx),(((Idx) bsr 4) band 1)).
52-define(get1p5(Idx),(((Idx) bsr 3) band 1)).
53-define(get1p6(Idx),(((Idx) bsr 2) band 1)).
54-define(get1p7(Idx),(((Idx) bsr 1) band 1)).
55-define(get1p8(Idx),((Idx)  band 1)).
56
57format_error({?MODULE,unsupported_format}) ->
58    "Unsupported format or bad PNG file";
59format_error({none,?MODULE,_}) ->
60    "Decoding error";
61format_error({unsupported_compression,Comp}) ->
62    io_lib:format("Unsupported compression type (~p)", [Comp]).
63
64load(FileName) ->
65    load(FileName, []).
66load(FileName, _Opts) ->
67    try load1(FileName,_Opts)
68    catch
69	throw:Reason:ST ->
70	    io:format("~n~p: Bad File: ~p ~P~n",[?MODULE,Reason,ST,30]),
71	    {error, {?MODULE,Reason}};
72        error:Reason:ST ->
73	    io:format("~n~p: Internal Error: ~P ~P~n",[?MODULE,Reason,30,ST,30]),
74	    {error, {?MODULE,Reason}}
75    end.
76
77load1(FileName, _Opts) ->
78    case file:read_file(FileName) of
79	{ok, <<?MAGIC, Chunks/binary>>} ->
80	    decode_chunks(0, Chunks, #png{});
81	{ok, _Bin} ->
82	    {error, {?MODULE,corrupt_file}};
83	Error ->
84	    Error
85    end.
86
87save_bin(Img) ->
88    save(Img,undefined,binary,[]).
89save_bin(Img,Opts) ->
90    save(Img,undefined,binary,Opts).
91
92save(Img, File) ->
93    save(Img, File, undefined,[]).
94save(Img, File,Opts) ->
95    save(Img, File, undefined,Opts).
96save(Img, File, Type, Options) ->
97    try
98	Binary = save1(Img,Options),
99	case Type of
100	    binary -> {ok, Binary};
101	    _ -> file:write_file(File, Binary)
102	end
103    catch
104	throw:Reason:ST ->
105	    io:format("~n~p: Bad File: ~p ~P~n",[?MODULE,Reason,ST,30]),
106	    {error, {?MODULE,Reason}};
107	  error:Reason:ST ->
108	    io:format("~n~p: Internal Error: ~P ~P~n",[?MODULE,Reason,30,ST,30]),
109	    {error, {?MODULE,Reason}}
110    end.
111
112get_chunk(Pos,Chunks) ->
113    case Chunks of
114	<<_:Pos/binary, Sz:32, Type:4/binary, Chunk:Sz/binary, Crc:32, _/binary>> ->
115	    Pos1=Pos+4, Sz1=4+Sz,
116	    <<_:Pos1/binary,CRCdata:Sz1/binary,_/binary>> = Chunks,
117	    check_crc(CRCdata,Crc),
118	    {Pos+12+Sz,{binary_to_list(Type),Chunk}};
119	_ ->
120	    throw(unsupported_format)
121    end.
122
123decode_chunks(Pos,Chunks,_PNG) when Pos >= size(Chunks) ->
124    throw(unsupported_format);
125decode_chunks(Pos,Chunks,PNG0) ->
126    {NewPos,Chunk} = get_chunk(Pos,Chunks),
127    case decode_chunk(Chunk,PNG0) of
128	#png{} = PNG ->
129	    decode_chunks(NewPos,Chunks,PNG);
130	#e3d_image{} = Image ->
131	    Image
132    end.
133
134decode_chunk({"IHDR",Header},PNG0) ->
135    case Header of
136	<<W:32,H:32,Bpc:8,ColT:8,0:8,0:8,IL:8>> ->
137	    PNG0#png{w=W,h=H,bpc=Bpc,type=ColT,interlace=IL};
138	_ ->
139	    throw(unsupported_format)
140    end;
141decode_chunk({"IDAT", Chunk},PNG0=#png{chunks=Prev}) ->
142    PNG0#png{chunks=[Chunk|Prev]};
143decode_chunk({"IEND",_Chunk},PNG0=#png{chunks=Prev}) ->
144    create_image(PNG0#png{chunks=lists:reverse(Prev)});
145decode_chunk({"PLTE",Chunk},PNG0) ->
146    PNG0#png{palette=Chunk};
147decode_chunk({"bKGD",Chunk},PNG0=#png{type=Type}) ->
148    Color =
149	case Chunk of
150	    <<G:16>> when Type == ?GREYSCALE ->
151		GR = rescale(G,16,8),
152		[GR,GR,GR,0];
153	    <<R:16,G:16,B:16>> when Type == ?TRUECOLOUR_A ->
154		[rescale(R,16,8),rescale(G,16,8),rescale(B,16,8),0];
155	    <<Ind:8>> when Type == ?INDEXED ->
156		Pos = Ind*3,
157		<<_:Pos/binary,R:8,G:8,B:8,_/binary>> = PNG0#png.palette,
158		[R,G,B,0];
159	    _ ->
160		[0,0,0,0]
161	end,
162    PNG0#png{bkgd=Color};
163decode_chunk({"tRNS",Chunk},PNG0=#png{type=Type}) ->
164    Color =
165	case Chunk of
166	    <<G:16>> when Type == ?GREYSCALE ->
167		rescale(G,16,8);
168	    <<R:16,G:16,B:16>> when Type == ?TRUECOLOUR ->
169		[rescale(R,16,8),rescale(G,16,8),rescale(B,16,8)];
170	    _ when Type == ?INDEXED ->
171		Chunk
172	end,
173    PNG0#png{trns=Color};
174decode_chunk({_Type,_Chunk},PNG0) ->
175%%    io:format("Skipped ~s ~n", [Type]),
176    PNG0.
177
178check_crc(Data,Crc) ->
179    case erlang:crc32(Data) of
180	Crc -> ok;
181	_E ->
182	    throw(decode_error)
183    end.
184
185create_image(P=#png{w=W,h=H,chunks=Chunks}) ->
186    Image0 = zlib:uncompress(list_to_binary(Chunks)),
187    Image1  = unfilter(Image0,P#png{chunks=used}),
188    {#png{restype=ResType},Image} = convert(Image1,P),
189%%     io:format("Sz Uncompressed ~p Unfiltered ~p Converted ~p~n",
190%% 	      [size(Image0),size(Image1),size(Image)]),
191    #e3d_image{width=W,height=H,alignment=1,
192	       type=ResType,bytes_pp=e3d_image:bytes_pp(ResType),
193	       order=upper_left,image=Image}.
194
195merge_interlace(R,_C,_W,H,_BSz,_All,[],Acc) when R >= H ->
196    Res = list_to_binary(lists:reverse(Acc)),
197    Res;
198merge_interlace(R,C,W,H,BSz,All,RA,Acc) when C >= W ->
199    Row0 = list_to_binary(lists:reverse(RA)),
200    RL = W*BSz,
201    RowLen = if (RL rem 8) == 0 -> RL div 8;true -> RL div 8 + 1 end,
202    %% Remove extra columns added by the interlacing
203    <<Row:RowLen/binary,_/binary>> = Row0,
204    merge_interlace(R+1,0,W,H,BSz,All,[],[Row|Acc]);
205merge_interlace(R,C,W,H,BSz,All=[P1,P2,_P3,P4,_P5,P6,_P7],RA,Acc)
206  when (R rem 8) == 0, C < W ->
207    Blocks = gurka,
208    [P1c1] = get_pixels(R,8,C,1,BSz,Blocks,P1),
209    [P6c1,P6c2,P6c3,P6c4] = get_pixels(R,2,C,4,BSz,Blocks,P6),
210    [P4c1,P4c2] = get_pixels(R,4,C,2,BSz,Blocks,P4),
211    [P2c1] = get_pixels(R,8,C,1,BSz,Blocks,P2),
212    Part = il_create_row([P1c1,P6c1,P4c1,P6c2,P2c1,P6c3,P4c2,P6c4],BSz),
213    merge_interlace(R,C+8,W,H,BSz,All,[Part|RA],Acc);
214merge_interlace(R,0,W,H,BSz,All=[_,_,_,_,_,_,{BytPR,P7}],[],Acc)
215  when (R rem 2) == 1 ->
216    P7S = (R div 2)*BytPR,
217    P7Row = case P7 of
218		<<_:P7S/binary,Row:BytPR/binary,_/binary>> -> Row;
219		<<_:P7S/binary,Row/binary>> ->  Row
220	    end,
221    merge_interlace(R,W,W,H,BSz,All,[P7Row],Acc);
222merge_interlace(R,C,W,H,BSz,All=[_P1,_P2,_P3,_P4,P5,P6,_P7],RA,Acc)
223  when (R rem 4) == 2 ->
224    Blocks = if W < 8 -> 1; true -> W div 8 end,
225    [P5c1,P5c2,P5c3,P5c4] = get_pixels(R,4,C,4,BSz,Blocks,P5),
226    [P6c1,P6c2,P6c3,P6c4] = get_pixels(R,2,C,4,BSz,Blocks,P6),
227    Part = il_create_row([P5c1,P6c1,P5c2,P6c2,P5c3,P6c3,P5c4,P6c4],BSz),
228    merge_interlace(R,C+8,W,H,BSz,All,[Part|RA],Acc);
229merge_interlace(R,C,W,H,BSz,All=[_P1,_P2,P3,P4,_P5,P6,_P7],RA,Acc)
230  when (R rem 8) == 4 ->
231    Blocks = if W < 8 -> 1; true -> W div 8 end,
232    [P3c1,P3c2] = get_pixels(R,8,C,2,BSz,Blocks,P3),
233    [P6c1,P6c2,P6c3,P6c4] = get_pixels(R,2,C,4,BSz,Blocks,P6),
234    [P4c1,P4c2] = get_pixels(R,4,C,2,BSz,Blocks,P4),
235    Part = il_create_row([P3c1,P6c1,P4c1,P6c2,P3c2,P6c3,P4c2,P6c4],BSz),
236    merge_interlace(R,C+8,W,H,BSz,All,[Part|RA],Acc).
237
238il_create_row(B,BSz) when (BSz rem 8) == 0 ->
239    list_to_binary(B);
240il_create_row([C1,C2,C3,C4,C5,C6,C7,C8],Sz) ->
241%    io:format("~.16B~.16B~.16B~.16B~.16B~.16B~.16B~.16B ",[C1,C2,C3,C4,C5,C6,C7,C8]),
242    <<C1:Sz,C2:Sz,C3:Sz,C4:Sz,C5:Sz,C6:Sz,C7:Sz,C8:Sz>>.
243
244get_pixels(R,RD,C,CM,BSz,_Tot,{RowBytes,Bin}) ->
245    BI = C div 8,
246    Row = (R div RD)*RowBytes,
247    Col = BI*CM,
248    BitPos = Row*8 + Col*BSz,
249    {SBy,SBi} = {BitPos div 8,BitPos rem 8},
250%    io:format("~p: ~p => ~p ~p ~n", [[R,RD,C,CM,BSz,RowBytes,Bin],[], SBy,SBi]),
251    Bits = CM*BSz,
252    case Bits rem 8 of
253	0 ->
254	    Bytes = Bits div 8,
255	    case Bin of
256		<<_:SBy/binary,Cols:Bytes/binary,_/binary>> ->
257		    split_cols(Cols,CM,BSz);
258		_ ->
259		    lists:duplicate(CM,0)
260	    end;
261	_ ->
262	    Skip = (8-((Bits+SBi) rem 8)) rem 8,
263	    case Bin of
264		<<_:SBy/binary,_:SBi,Cols:Bits,_:Skip,_/binary>> ->
265		    split_cols(Cols,CM,BSz);
266		_ -> %% Outside Image return pad bits
267		    lists:duplicate(CM,0)
268	    end
269    end.
270
271split_cols(Col,1,_) -> [Col];
272split_cols(Col,2,Bsz) when Bsz rem 8 == 0 ->
273    By = Bsz div 8,
274    <<C1:By/binary,C2:By/binary>> = Col,
275    [C1,C2];
276split_cols(Col,4,Bsz) when Bsz rem 8 == 0 ->
277    By = Bsz div 8,
278    <<C1:By/binary,C2:By/binary,C3:By/binary,C4:By/binary>> = Col,
279    [C1,C2,C3,C4];
280split_cols(Byte,2,Bsz) when is_binary(Byte) ->
281    <<C1:Bsz,C2:Bsz>> = Byte,
282    [C1,C2];
283split_cols(Byte,2,Bsz) ->
284    M = (1 bsl Bsz)-1,
285    [Byte bsr Bsz,Byte band M];
286split_cols(Byte,4,Bsz) when is_binary(Byte) ->
287    <<C1:Bsz,C2:Bsz,C3:Bsz,C4:Bsz>> = Byte,
288    [C1,C2,C3,C4];
289split_cols(Byte,4,Bsz) ->
290    M = (1 bsl Bsz)-1,
291    [Byte bsr (Bsz*4-Bsz),
292     (Byte bsr (Bsz*4-2*Bsz)) band M,
293     (Byte bsr (Bsz*4-3*Bsz)) band M,
294     Byte band M].
295
296il_pass_pixels(1,WR,HR) -> {1,(WR+7) div 8,1,(HR +7) div 8};
297il_pass_pixels(2,WR,HR) -> {1,if WR > 4 -> 1; true -> 0 end,1,(HR+7) div 8};
298il_pass_pixels(3,WR,HR) -> {2,(WR+3) div 4,1,HR div 5};
299il_pass_pixels(4,WR,HR) -> {2,(WR+1) div 4,2,(HR+3) div 4};
300il_pass_pixels(5,WR,HR) -> {4,(WR +1) div 2,2,(HR+1) div 4};
301il_pass_pixels(6,WR,HR) -> {4,WR div 2,4,(HR+1) div 2};
302il_pass_pixels(7,WR,HR) -> {8,WR,4,HR div 2}.
303
304il_bytes_psl(Pass,P=#png{w=W,h=H}) ->
305    WBlocks = W div 8,
306    HBlocks = H div 8,
307    {Bpix,Epix,HBl,EBl} = il_pass_pixels(Pass, W rem 8, H rem 8),
308    WPixels = (WBlocks*Bpix+Epix),
309    RowBytes = case WPixels*pixelsz(P) of
310		   RB when trunc(RB) == RB -> trunc(RB);
311		   RB -> trunc(RB) +1
312	       end,
313    Rows = HBlocks*HBl+EBl,
314    RowsWithFilter = if RowBytes > 0 -> RowBytes + 1; true -> 0 end,
315%    io:format("Pass ~p ~p~n", [Pass,{RowBytes,Rows,Rows*RowsWithFilter}]),
316    {RowBytes,Rows,Rows*RowsWithFilter}.
317
318unfilter(_Uncompressed,#png{interlace=I}) when I > 1 ->
319    throw(bad_file);
320unfilter(Uncompressed,P = #png{w=W,h=H,interlace=1}) ->
321%    io:format("Interlaced ~p Sz ~p ~n", [P, size(Uncompressed)]),
322    {P1Sl,_,P1Sz} = il_bytes_psl(1,P),
323    {P2Sl,_,P2Sz} = il_bytes_psl(2,P),
324    {P3Sl,_,P3Sz} = il_bytes_psl(3,P),
325    {P4Sl,_,P4Sz} = il_bytes_psl(4,P),
326    {P5Sl,_,P5Sz} = il_bytes_psl(5,P),
327    {P6Sl,_,P6Sz} = il_bytes_psl(6,P),
328    {P7Sl,_,P7Sz} = il_bytes_psl(7,P),
329%%     io:format("Sizes ~p ~p ~n",[[P1Sz,P2Sz,P3Sz,P4Sz,P5Sz,P6Sz,P7Sz],
330%%  				P1Sz+P2Sz+P3Sz+P4Sz+P5Sz+P6Sz+P7Sz]),
331    FPSz = case trunc(pixelsz(P)) of 0 -> 1; PtSz -> PtSz end,
332    Filters = {FPSz,unfilters(FPSz)},
333    case Uncompressed of
334	<<P1:P1Sz/binary,P2:P2Sz/binary,P3:P3Sz/binary,
335	 P4:P4Sz/binary,P5:P5Sz/binary,P6:P6Sz/binary,P7:P7Sz/binary>> ->
336	    Def = [{P1Sl,P1},{P2Sl,P2},{P3Sl,P3},{P4Sl,P4},
337		   {P5Sl,P5},{P6Sl,P6},{P7Sl,P7}],
338	    Filtered = lists:map(fun({SL,Pass}) ->
339					 ScanBits = SL *8,
340					 Prev = binary_to_list(<<0:ScanBits>>),
341					 {SL,unfilter(0,Pass,Prev,Filters,SL,[])}
342				 end,Def),
343	    PSz = trunc(pixelsz(P)*8),
344	    merge_interlace(0,0,W,H,PSz,Filtered,[],[]);
345	_ ->
346	    exit(size_calc_wrong)
347    end;
348
349unfilter(Uncompressed,P) ->
350    ScanLen = scanlen(P),
351%    io:format("Scanlen ~p ~p Sz ~p ~n", [ScanLen,P, size(Uncompressed)]),
352    Sz = case trunc(pixelsz(P)) of 0 -> 1; PSz -> PSz end,
353    ScanBits = (ScanLen)*8,
354    Prev = binary_to_list(<<0:ScanBits>>),
355    unfilter(0,Uncompressed,Prev,{Sz,unfilters(Sz)},ScanLen,[]).
356unfilter(Row,Uncompressed,Prev,I={Sz,Filter},ScanLen,Acc) ->
357    Skip = Row*(ScanLen+1),
358    case Uncompressed of
359	<<_:Skip/binary,FilterIdx:8,Curr0:ScanLen/binary,_/binary>> ->
360	    Curr = binary_to_list(Curr0),
361%%	    io:format("~p: Filter ~p ",[Row,FilterIdx]),
362	    Filtered =
363		case FilterIdx of
364		    0 -> Curr;
365		    1 -> sub_filter(Curr,Sz,element(FilterIdx,Filter),[]);
366		    2 -> up_filter(Prev,Curr,[]);
367		    3 -> average_filter(Prev,Curr,Sz,element(FilterIdx,Filter),[]);
368		    4 -> paeth_filter(Prev,Curr,Sz,element(FilterIdx,Filter),[])
369		end,
370	    unfilter(Row+1,Uncompressed,Filtered,I,ScanLen,
371		     [list_to_binary(Filtered)|Acc]);
372	_ ->
373	    list_to_binary(lists:reverse(Acc))
374    end.
375
376unfilters(1) ->{fun sub_filter1/2,up_filter,fun
377		average_filter1/3,fun paeth_filter1/3};
378unfilters(2) ->{fun sub_filter2/2,up_filter,
379		fun average_filter2/3,fun paeth_filter2/3};
380unfilters(3) ->{fun sub_filter3/2,up_filter,
381		fun average_filter3/3,fun paeth_filter3/3};
382unfilters(4) ->{fun sub_filter4/2,up_filter,
383		fun average_filter4/3,fun paeth_filter4/3};
384unfilters(6) ->{fun sub_filter6/2,up_filter,
385		fun average_filter6/3,fun paeth_filter6/3};
386unfilters(8) ->{fun sub_filter8/2,up_filter,
387		fun average_filter8/3,fun paeth_filter8/3}.
388
389paeth_filter8([C1,C2,C3,C4,C5,C6,C7,C8|Prev = [B1,B2,B3,B4,B5,B6,B7,B8|_]],
390	      [X1,X2,X3,X4,X5,X6,X7,X8|Curr],
391	      Acc=[A8,A7,A6,A5,A4,A3,A2,A1|_])  ->
392    RX1 = paeth_filter(A1,B1,C1,X1),
393    RX2 = paeth_filter(A2,B2,C2,X2),
394    RX3 = paeth_filter(A3,B3,C3,X3),
395    RX4 = paeth_filter(A4,B4,C4,X4),
396    RX5 = paeth_filter(A5,B5,C5,X5),
397    RX6 = paeth_filter(A6,B6,C6,X6),
398    RX7 = paeth_filter(A7,B7,C7,X7),
399    RX8 = paeth_filter(A8,B8,C8,X8),
400    paeth_filter8(Prev,Curr,[RX8,RX7,RX6,RX5,RX4,RX3,RX2,RX1|Acc]);
401paeth_filter8(Prev,Curr,Acc) ->
402    paeth_filter(Prev,Curr,8,fun paeth_filter8/3,Acc).
403paeth_filter6([C1,C2,C3,C4,C5,C6|Prev = [B1,B2,B3,B4,B5,B6|_]],
404	      [X1,X2,X3,X4,X5,X6|Curr],
405	      Acc=[A6,A5,A4,A3,A2,A1|_]) ->
406    RX1 = paeth_filter(A1,B1,C1,X1),
407    RX2 = paeth_filter(A2,B2,C2,X2),
408    RX3 = paeth_filter(A3,B3,C3,X3),
409    RX4 = paeth_filter(A4,B4,C4,X4),
410    RX5 = paeth_filter(A5,B5,C5,X5),
411    RX6 = paeth_filter(A6,B6,C6,X6),
412    paeth_filter6(Prev,Curr,[RX6,RX5,RX4,RX3,RX2,RX1|Acc]);
413paeth_filter6(Prev,Curr,Acc) ->
414    paeth_filter(Prev,Curr,6,fun paeth_filter6/3,Acc).
415paeth_filter4([C1,C2,C3,C4,B1,B2,B3,B4|Prev = [B5,B6,B7,B8|_]],
416	      [X1,X2,X3,X4,X5,X6,X7,X8|Curr],
417	      Acc=[A4,A3,A2,A1|_]) ->
418    RX1 = paeth_filter(A1,B1,C1,X1),
419    RX2 = paeth_filter(A2,B2,C2,X2),
420    RX3 = paeth_filter(A3,B3,C3,X3),
421    RX4 = paeth_filter(A4,B4,C4,X4),
422    RX5 = paeth_filter(RX1,B5,B1,X5),
423    RX6 = paeth_filter(RX2,B6,B2,X6),
424    RX7 = paeth_filter(RX3,B7,B3,X7),
425    RX8 = paeth_filter(RX4,B8,B4,X8),
426    paeth_filter4(Prev,Curr,[RX8,RX7,RX6,RX5,RX4,RX3,RX2,RX1|Acc]);
427paeth_filter4(Prev,Curr,Acc) ->
428    paeth_filter(Prev,Curr,4,fun paeth_filter4/3,Acc).
429paeth_filter3([C1,C2,C3,B1,B2,B3|Prev = [B4,B5,B6|_]],
430	      [X1,X2,X3,X4,X5,X6|Curr],
431	      Acc=[A3,A2,A1,_,_,_|_]) ->
432    RX1 = paeth_filter(A1,B1,C1,X1),
433    RX2 = paeth_filter(A2,B2,C2,X2),
434    RX3 = paeth_filter(A3,B3,C3,X3),
435    RX4 = paeth_filter(RX1,B4,B1,X4),
436    RX5 = paeth_filter(RX2,B5,B2,X5),
437    RX6 = paeth_filter(RX3,B6,B3,X6),
438    paeth_filter3(Prev,Curr,[RX6,RX5,RX4,RX3,RX2,RX1|Acc]);
439paeth_filter3(Prev,Curr,Acc) ->
440    paeth_filter(Prev,Curr,3,fun paeth_filter3/3,Acc).
441paeth_filter2([C1,C2,B1,B2,B3,B4,B5,B6|Prev = [B7,B8|_]],
442	      [X1,X2,X3,X4,X5,X6,X7,X8|Curr],
443	      Acc=[A2,A1|_]) ->
444    RX1 = paeth_filter(A1,B1,C1,X1),
445    RX2 = paeth_filter(A2,B2,C2,X2),
446    RX3 = paeth_filter(RX1,B3,B1,X3),
447    RX4 = paeth_filter(RX2,B4,B2,X4),
448    RX5 = paeth_filter(RX3,B5,B3,X5),
449    RX6 = paeth_filter(RX4,B6,B4,X6),
450    RX7 = paeth_filter(RX5,B7,B5,X7),
451    RX8 = paeth_filter(RX6,B8,B6,X8),
452    paeth_filter2(Prev,Curr,[RX8,RX7,RX6,RX5,RX4,RX3,RX2,RX1|Acc]);
453paeth_filter2(Prev,Curr,Acc) ->
454    paeth_filter(Prev,Curr,2,fun paeth_filter2/3,Acc).
455paeth_filter1([C1,B1,B2,B3,B4,B5,B6,B7|Prev = [B8|_]],
456	      [X1,X2,X3,X4,X5,X6,X7,X8|Curr],
457	      Acc=[A1|_]) ->
458    RX1 = paeth_filter(A1,B1,C1,X1),
459    RX2 = paeth_filter(RX1,B2,B1,X2),
460    RX3 = paeth_filter(RX2,B3,B2,X3),
461    RX4 = paeth_filter(RX3,B4,B3,X4),
462    RX5 = paeth_filter(RX4,B5,B4,X5),
463    RX6 = paeth_filter(RX5,B6,B5,X6),
464    RX7 = paeth_filter(RX6,B7,B6,X7),
465    RX8 = paeth_filter(RX7,B8,B7,X8),
466    paeth_filter1(Prev,Curr,[RX8,RX7,RX6,RX5,RX4,RX3,RX2,RX1|Acc]);
467paeth_filter1(Prev,Curr,Acc) ->
468    paeth_filter(Prev,Curr,1,fun paeth_filter1/3,Acc).
469
470paeth_filter(Prev0=[C|Prev],[X|Curr],Sz,Fun,Acc) ->
471    case pget(Sz,Acc) of
472	none ->
473	    Pos = length(Acc)+1,
474	    B = pget(Pos,Prev0),
475	    RX = paeth_filter(0,B,0,X),
476	    Fun(Prev0,Curr,[RX|Acc]);
477	A ->
478	    B = pget(Sz,Prev),
479	    RX = paeth_filter(A,B,C,X),
480	    Fun(Prev,Curr,[RX|Acc])
481    end;
482paeth_filter(_,[],_Sz,_Fun,Acc) ->
483    lists:reverse(Acc).
484
485paeth_filter(A,B,C,X) ->
486    P = A + B - C,
487    PA = abs(P - A),
488    PB = abs(P - B),
489    PC = abs(P - C),
490    if PA =< PB, PA =< PC -> (A+X) band 255;
491       PB =< PC -> (B+X) band 255;
492       true -> (C+X) band 255
493    end.
494
495sub_filter8([X1,X2,X3,X4,X5,X6,X7,X8|Curr],
496	    Acc=[A8,A7,A6,A5,A4,A3,A2,A1|_]) ->
497    RX1 = (X1+A1) band 255,  RX2 = (X2+A2) band 255,
498    RX3 = (X3+A3) band 255,  RX4 = (X4+A4) band 255,
499    RX5 = (X5+A5) band 255,  RX6 = (X6+A6) band 255,
500    RX7 = (X7+A7) band 255,  RX8 = (X8+A8) band 255,
501    sub_filter8(Curr,[RX8,RX7,RX6,RX5,RX4,RX3,RX2,RX1|Acc]);
502sub_filter8(Curr,Acc) ->
503    sub_filter(Curr,8,fun sub_filter8/2,Acc).
504sub_filter6([X1,X2,X3,X4,X5,X6|Curr],Acc=[A6,A5,A4,A3,A2,A1|_]) ->
505    RX1 = (X1+A1) band 255,  RX2 = (X2+A2) band 255,
506    RX3 = (X3+A3) band 255,  RX4 = (X4+A4) band 255,
507    RX5 = (X5+A5) band 255,  RX6 = (X6+A6) band 255,
508    sub_filter6(Curr,[RX6,RX5,RX4,RX3,RX2,RX1|Acc]);
509sub_filter6(Curr,Acc) ->
510    sub_filter(Curr,6,fun sub_filter6/2,Acc).
511sub_filter4([X1,X2,X3,X4,X5,X6,X7,X8|Curr],Acc=[A4,A3,A2,A1|_]) ->
512    RX1 = (X1+A1) band 255,    RX2 = (X2+A2) band 255,
513    RX3 = (X3+A3) band 255,    RX4 = (X4+A4) band 255,
514    RX5 = (X5+RX1) band 255,   RX6 = (X6+RX2) band 255,
515    RX7 = (X7+RX3) band 255,   RX8 = (X8+RX4) band 255,
516    sub_filter4(Curr,[RX8,RX7,RX6,RX5,RX4,RX3,RX2,RX1|Acc]);
517sub_filter4(Curr,Acc) ->
518    sub_filter(Curr,4,fun sub_filter4/2,Acc).
519sub_filter3([X1,X2,X3,X4,X5,X6|Curr],Acc=[A3,A2,A1|_]) ->
520    RX1 = (X1+A1) band 255,    RX2 = (X2+A2) band 255,
521    RX3 = (X3+A3) band 255,    RX4 = (X4+RX1) band 255,
522    RX5 = (X5+RX2) band 255,   RX6 = (X6+RX3) band 255,
523    sub_filter3(Curr,[RX6,RX5,RX4,RX3,RX2,RX1|Acc]);
524sub_filter3(Curr,Acc) ->
525    sub_filter(Curr,3,fun sub_filter3/2,Acc).
526sub_filter2([X1,X2,X3,X4,X5,X6,X7,X8|Curr],Acc=[A2,A1|_]) ->
527    RX1 = (X1+A1) band 255,    RX2 = (X2+A2) band 255,
528    RX3 = (X3+RX1) band 255,   RX4 = (X4+RX2) band 255,
529    RX5 = (X5+RX3) band 255,   RX6 = (X6+RX4) band 255,
530    RX7 = (X7+RX5) band 255,   RX8 = (X8+RX6) band 255,
531    sub_filter2(Curr,[RX8,RX7,RX6,RX5,RX4,RX3,RX2,RX1|Acc]);
532sub_filter2(Curr,Acc) ->
533    sub_filter(Curr,2,fun sub_filter2/2,Acc).
534sub_filter1([X1,X2,X3,X4,X5,X6,X7,X8|Curr],Acc=[A1|_]) ->
535    RX1 = (X1+A1) band 255,    RX2 = (X2+RX1) band 255,
536    RX3 = (X3+RX2) band 255,   RX4 = (X4+RX3) band 255,
537    RX5 = (X5+RX4) band 255,   RX6 = (X6+RX5) band 255,
538    RX7 = (X7+RX6) band 255,   RX8 = (X8+RX7) band 255,
539    sub_filter1(Curr,[RX8,RX7,RX6,RX5,RX4,RX3,RX2,RX1|Acc]);
540sub_filter1(Curr,Acc) ->
541    sub_filter(Curr,1,fun sub_filter1/2,Acc).
542
543sub_filter([X|Curr],Sz,Fun,Acc) ->
544    case pget(Sz,Acc) of
545	none ->
546	    Fun(Curr,[X|Acc]);
547	A ->
548	    RX = (X+A) band 255,
549	    Fun(Curr,[RX|Acc])
550    end;
551sub_filter([],_,_,Acc) ->
552    lists:reverse(Acc).
553
554up_filter([B1,B2,B3,B4,B5,B6,B7,B8|Prev],[X1,X2,X3,X4,X5,X6,X7,X8|Curr],Acc) ->
555    RX1 = (X1+B1) band 255,    RX2 = (X2+B2) band 255,
556    RX3 = (X3+B3) band 255,    RX4 = (X4+B4) band 255,
557    RX5 = (X5+B5) band 255,    RX6 = (X6+B6) band 255,
558    RX7 = (X7+B7) band 255,    RX8 = (X8+B8) band 255,
559    up_filter(Prev,Curr,[RX8,RX7,RX6,RX5,RX4,RX3,RX2,RX1|Acc]);
560up_filter([B1|Prev],[X1|Curr],Acc) ->
561    RX = (X1+B1) band 255,
562    up_filter(Prev,Curr,[RX|Acc]);
563up_filter(__Prev,[],Acc) ->
564    lists:reverse(Acc).
565
566average_filter8([B1,B2,B3,B4,B5,B6,B7,B8|Prev],
567		[X1,X2,X3,X4,X5,X6,X7,X8|Curr],
568		Acc=[A8,A7,A6,A5,A4,A3,A2,A1|_])  ->
569    RX1 = (X1+trunc((B1+A1)/2)) band 255,    RX2 = (X2+trunc((B2+A2)/2)) band 255,
570    RX3 = (X3+trunc((B3+A3)/2)) band 255,    RX4 = (X4+trunc((B4+A4)/2)) band 255,
571    RX5 = (X5+trunc((B5+A5)/2)) band 255,    RX6 = (X6+trunc((B6+A6)/2)) band 255,
572    RX7 = (X7+trunc((B7+A7)/2)) band 255,    RX8 = (X8+trunc((B8+A8)/2)) band 255,
573    average_filter8(Prev,Curr,[RX8,RX7,RX6,RX5,RX4,RX3,RX2,RX1|Acc]);
574average_filter8(Prev,Curr,Acc) ->
575    average_filter(Prev,Curr,8,fun average_filter8/3,Acc).
576average_filter6([B1,B2,B3,B4,B5,B6|Prev],
577		[X1,X2,X3,X4,X5,X6|Curr],
578		Acc=[A6,A5,A4,A3,A2,A1|_])  ->
579    RX1 = (X1+trunc((B1+A1)/2)) band 255, RX2 = (X2+trunc((B2+A2)/2)) band 255,
580    RX3 = (X3+trunc((B3+A3)/2)) band 255, RX4 = (X4+trunc((B4+A4)/2)) band 255,
581    RX5 = (X5+trunc((B5+A5)/2)) band 255, RX6 = (X6+trunc((B6+A6)/2)) band 255,
582    average_filter6(Prev,Curr,[RX6,RX5,RX4,RX3,RX2,RX1|Acc]);
583average_filter6(Prev,Curr,Acc) ->
584    average_filter(Prev,Curr,6,fun average_filter6/3,Acc).
585average_filter4([B1,B2,B3,B4,B5,B6,B7,B8|Prev],
586		[X1,X2,X3,X4,X5,X6,X7,X8|Curr],
587		Acc=[A4,A3,A2,A1|_]) ->
588    RX1 = (X1+trunc((B1+A1) /2)) band 255, RX2 = (X2+trunc((B2+A2) /2)) band 255,
589    RX3 = (X3+trunc((B3+A3) /2)) band 255, RX4 = (X4+trunc((B4+A4) /2)) band 255,
590    RX5 = (X5+trunc((B5+RX1)/2)) band 255, RX6 = (X6+trunc((B6+RX2)/2)) band 255,
591    RX7 = (X7+trunc((B7+RX3)/2)) band 255, RX8 = (X8+trunc((B8+RX4)/2)) band 255,
592    average_filter4(Prev,Curr,[RX8,RX7,RX6,RX5,RX4,RX3,RX2,RX1|Acc]);
593average_filter4(Prev,Curr,Acc) ->
594    average_filter(Prev,Curr,4,fun average_filter4/3,Acc).
595average_filter3([B1,B2,B3,B4,B5,B6|Prev],
596		[X1,X2,X3,X4,X5,X6|Curr],
597		Acc=[A3,A2,A1|_])  ->
598    RX1 = (X1+trunc((B1+A1) /2))band 255, RX2 = (X2+trunc((B2+A2) /2))band 255,
599    RX3 = (X3+trunc((B3+A3) /2))band 255, RX4 = (X4+trunc((B4+RX1)/2)) band 255,
600    RX5 = (X5+trunc((B5+RX2)/2)) band 255,RX6 = (X6+trunc((B6+RX3)/2)) band 255,
601    average_filter3(Prev,Curr,[RX6,RX5,RX4,RX3,RX2,RX1|Acc]);
602average_filter3(Prev,Curr,Acc) ->
603    average_filter(Prev,Curr,3,fun average_filter3/3,Acc).
604average_filter2([B1,B2,B3,B4,B5,B6,B7,B8|Prev],
605		[X1,X2,X3,X4,X5,X6,X7,X8|Curr],
606		Acc=[A2,A1|_])  ->
607    RX1 = (X1+trunc((B1+A1) /2)) band 255, RX2 = (X2+trunc((B2+A2) /2)) band 255,
608    RX3 = (X3+trunc((B3+RX1)/2)) band 255, RX4 = (X4+trunc((B4+RX2)/2)) band 255,
609    RX5 = (X5+trunc((B5+RX3)/2)) band 255, RX6 = (X6+trunc((B6+RX4)/2)) band 255,
610    RX7 = (X7+trunc((B7+RX5)/2)) band 255, RX8 = (X8+trunc((B8+RX6)/2)) band 255,
611    average_filter2(Prev,Curr,[RX8,RX7,RX6,RX5,RX4,RX3,RX2,RX1|Acc]);
612average_filter2(Prev,Curr,Acc) ->
613    average_filter(Prev,Curr,2,fun average_filter2/3,Acc).
614average_filter1([B1,B2,B3,B4,B5,B6,B7,B8|Prev],
615		[X1,X2,X3,X4,X5,X6,X7,X8|Curr],
616		Acc=[A1|_])  ->
617    RX1 = (X1+trunc((B1+A1) /2)) band 255, RX2 = (X2+trunc((B2+RX1)/2)) band 255,
618    RX3 = (X3+trunc((B3+RX2)/2)) band 255, RX4 = (X4+trunc((B4+RX3)/2)) band 255,
619    RX5 = (X5+trunc((B5+RX4)/2)) band 255, RX6 = (X6+trunc((B6+RX5)/2)) band 255,
620    RX7 = (X7+trunc((B7+RX6)/2)) band 255, RX8 = (X8+trunc((B8+RX7)/2)) band 255,
621    average_filter1(Prev,Curr,[RX8,RX7,RX6,RX5,RX4,RX3,RX2,RX1|Acc]);
622average_filter1(Prev,Curr,Acc) ->
623    average_filter(Prev,Curr,1,fun average_filter1/3,Acc).
624
625average_filter([B|Prev],[X|Curr],Sz,Fun,Acc) ->
626    case pget(Sz,Acc) of
627	none ->
628	    RX = (X + trunc(B/2)) band 255;
629	A ->
630	    RX = (X + trunc((A+B)/2)) band 255
631    end,
632    Fun(Prev,Curr,[RX|Acc]);
633average_filter(_,[],_,_,Acc) ->
634    lists:reverse(Acc).
635
636pget(1,[A|_]) -> A;
637pget(2,[_,A|_]) -> A;
638pget(3,[_,_,A|_]) -> A;
639pget(4,[_,_,_,A|_]) -> A;
640pget(5,[_,_,_,_,A|_]) -> A;
641pget(6,[_,_,_,_,_,A|_]) -> A;
642pget(7,[_,_,_,_,_,_,A|_]) -> A;
643pget(8,[_,_,_,_,_,_,_,A|_]) -> A;
644pget(_,_) -> none.
645
646pixelsz(#png{type=Type,bpc=Bpc}) ->
647    PixelBitSz
648	= case Type of
649	      ?GREYSCALE    -> 1*Bpc;
650	      ?GREYSCALE_A  -> 2*Bpc;
651	      ?TRUECOLOUR   -> 3*Bpc;
652	      ?TRUECOLOUR_A -> 4*Bpc;
653	      ?INDEXED      -> 1*Bpc
654	  end,
655    PixelBitSz / 8.
656
657scanlen(P=#png{w=W}) ->
658    Len = W * pixelsz(P),
659    if trunc(Len) == Len ->
660	    trunc(Len);
661       true ->
662	    trunc(Len) + 1
663    end.
664
665output_type(#png{type=?GREYSCALE,  trns=undefined}) -> g8;
666output_type(#png{type=?TRUECOLOUR, trns=undefined}) -> r8g8b8;
667output_type(_) -> r8g8b8a8.
668
669convert(Image, P= #png{type=?INDEXED,trns=Trns}) ->
670    Type = if Trns == undefined -> r8g8b8;
671	      true -> r8g8b8a8
672	   end,
673    Png = P#png{restype=Type},
674    {Png,convert_pal(0,Image,Png,[])};
675convert(Image, P=#png{trns=Trns,bkgd=BG}) ->
676    TrnsInfo = if Trns == undefined -> undefined;
677		  true -> {Trns,BG}
678	       end,
679    Png = P#png{restype=output_type(P)},
680    {Png,convert(Image,TrnsInfo,Png)}.
681
682convert(Image0, Trns, #png{bpc=8,type=?GREYSCALE}) ->
683    add_transperancyG(Trns,Image0);
684convert(Image0, Trns, P=#png{type=?GREYSCALE}) ->
685    add_transperancyG(Trns,convert(0,Image0,P,8,[]));
686convert(Image0, _, #png{bpc=8,type=?GREYSCALE_A}) ->
687    ga2rgba(Image0);
688convert(Image0, _, P=#png{type=?GREYSCALE_A}) ->
689    ga2rgba(convert(0,Image0,P,8,[]));
690convert(Image0, Trns, #png{bpc=8}) ->
691    add_transperancyRGB(Trns,Image0);
692convert(Image0, Trns, Png) ->
693    add_transperancyRGB(Trns,convert(0,Image0,Png,8,[])).
694
695convert(Pos,Image,P = #png{bpc=From},To,Acc) ->
696    case Image of
697	<<_:Pos/binary,Data:?CHUNK/binary,_/binary>> ->
698	    DL = binary_to_list(Data),
699	    Res = convert_bytes(DL,From,To),
700	    convert(Pos+?CHUNK,Image,P,To,[list_to_binary(Res)|Acc]);
701	<<_:Pos/binary,Data/binary>> ->
702	    DL = binary_to_list(Data),
703	    Last = convert_bytes(DL,From,To),
704	    list_to_binary(lists:reverse([Last|Acc]))
705    end.
706
707convert_bytes([B1,B2|T],16,8) ->
708    [rescale((B1 bsl 8) bor B2, 16,8)|convert_bytes(T,16,8)];
709convert_bytes([B1|T],4,8) ->
710    [rescale(?get4p1(B1),4,8),rescale(?get4p2(B1),4,8)|convert_bytes(T,4,8)];
711convert_bytes([B1|T],2,8) ->
712    [rescale(?get2p1(B1),2,8),rescale(?get2p2(B1),2,8),
713     rescale(?get2p3(B1),2,8),rescale(?get2p4(B1),2,8)
714     |convert_bytes(T,2,8)];
715convert_bytes([B1|T],1,8) ->
716    [rescale(?get1p1(B1),1,8),rescale(?get1p2(B1),1,8),
717     rescale(?get1p3(B1),1,8),rescale(?get1p4(B1),1,8),
718     rescale(?get1p5(B1),1,8),rescale(?get1p6(B1),1,8),
719     rescale(?get1p7(B1),1,8),rescale(?get1p8(B1),1,8)
720     |convert_bytes(T,1,8)];
721convert_bytes([],_,_) -> [].
722
723%% Depth rescaling should be done with!!
724%%output = floor((input * MAXOUTSAMPLE / MAXINSAMPLE) + 0.5)
725rescale(0,_,_) -> 0;
726rescale(1,1,8) -> 255;
727rescale(1,2,8) -> 85;
728rescale(2,2,8) -> 170;
729rescale(3,2,8) -> 255;
730rescale(Input,Inbits,Outbits) ->
731    trunc((Input*((1 bsl Outbits)-1)/((1 bsl Inbits)-1))+0.5).
732
733ga2rgba(Bin) ->
734    ga2rgba(0,Bin,[]).
735ga2rgba(Pos,Bin,Acc) ->
736    case Bin of
737	<<_:Pos/binary,Data:?CHUNK/binary,_/binary>> ->
738	    Res = do_ga2rgb(binary_to_list(Data)),
739	    ga2rgba(Pos+?CHUNK,Bin,[list_to_binary(Res)|Acc]);
740	<<_:Pos/binary,Data/binary>> ->
741	    Last = do_ga2rgb(binary_to_list(Data)),
742	    list_to_binary(lists:reverse([Last|Acc]))
743    end.
744
745do_ga2rgb([G,A|R]) -> [G,G,G,A|do_ga2rgb(R)];
746do_ga2rgb([]) -> [].
747
748add_transperancyG(undefined,Bin) ->
749    Bin;
750add_transperancyG({Trns,BG},Bin) ->
751    add_trnsG(0,Trns,BG,Bin,[]).
752add_trnsG(Pos,Trns,BG,Bin,Acc) ->
753    case Bin of
754	<<_:Pos/binary,Data:?CHUNK/binary,_/binary>> ->
755	    Res = do_addtrnsG(Trns,BG,binary_to_list(Data)),
756	    add_trnsG(Pos+?CHUNK,Trns,BG,Bin,[list_to_binary(Res)|Acc]);
757	<<_:Pos/binary,Data/binary>> ->
758	    Last = do_addtrnsG(Trns,BG,binary_to_list(Data)),
759	    list_to_binary(lists:reverse([Last|Acc]))
760    end.
761do_addtrnsG(Trns,BG,[Trns|R]) -> BG ++ do_addtrnsG(Trns,BG,R);
762do_addtrnsG(Trns,BG,[G|R]) -> [G,G,G,255|do_addtrnsG(Trns,BG,R)];
763do_addtrnsG(_,_,[]) -> [].
764
765add_transperancyRGB(undefined,Bin) ->
766    Bin;
767add_transperancyRGB({Trns,BG},Bin) ->
768    Res = add_trnsRGB(0,Trns,BG,Bin,[]),
769    Res.
770add_trnsRGB(Pos,Trns,BG,Bin,Acc) ->
771    case Bin of
772	<<_:Pos/binary,Data:?CHUNK/binary,_/binary>> ->
773	    Res = do_addtrnsRGB(Trns,BG,binary_to_list(Data)),
774	    add_trnsRGB(Pos+?CHUNK,Trns,BG,Bin,[list_to_binary(Res)|Acc]);
775	<<_:Pos/binary,Data/binary>> ->
776	    Last = do_addtrnsRGB(Trns,BG,binary_to_list(Data)),
777	    list_to_binary(lists:reverse([Last|Acc]))
778    end.
779
780do_addtrnsRGB(Trns=[R,G,B],BG,[R,G,B|T]) -> BG ++ do_addtrnsRGB(Trns,BG,T);
781do_addtrnsRGB(Trns,BG,[R,G,B|T]) -> [R,G,B,255|do_addtrnsRGB(Trns,BG,T)];
782do_addtrnsRGB(_,_,[]) -> [].
783
784convert_pal(Pos,Image,P=#png{w=W,bpc=Bpc,palette=Pal,trns=Trns,restype=ResType},Acc) ->
785    ResW = e3d_image:bytes_pp(ResType)*W,
786    ScanLen = scanlen(P),
787    case Image of
788	<<_:Pos/binary,Data:ScanLen/binary,_/binary>> ->
789	    Res0 = list_to_binary(do_lookup_pal(binary_to_list(Data),Bpc,Pal,Trns)),
790	    <<Res:ResW/binary, _G/binary>> = Res0,
791%	    io:format("Cutting ~p ~p ~p bytes ~n",[size(Res0),size(Res),size(_G)]),
792	    convert_pal(Pos+ScanLen,Image,P,[Res|Acc]);
793	<<_:Pos/binary,_Pads/binary>> ->
794%	    io:format("Skipping ~p bytes~n",[size(_Pads)]),
795	    list_to_binary(lists:reverse(Acc))
796    end.
797do_lookup_pal([],_,_,_) -> [];
798do_lookup_pal([Idx|Rest],8,Pal,Trns) ->
799    [palette_color(Idx,Pal,Trns)|do_lookup_pal(Rest,8,Pal,Trns)];
800do_lookup_pal([Idx|Rest],4,Pal,Trns) ->
801    [palette_color(?get4p1(Idx),Pal,Trns),palette_color(?get4p2(Idx),Pal,Trns)|
802     do_lookup_pal(Rest,4,Pal,Trns)];
803do_lookup_pal([Idx|Rest],2,Pal,Trns) ->
804    [palette_color(?get2p1(Idx),Pal,Trns),palette_color(?get2p2(Idx),Pal,Trns),
805     palette_color(?get2p3(Idx),Pal,Trns),palette_color(?get2p4(Idx),Pal,Trns)|
806     do_lookup_pal(Rest,2,Pal,Trns)];
807do_lookup_pal([Idx|Rest],1,Pal,Trns) ->
808    [palette_color(?get1p1(Idx),Pal,Trns),palette_color(?get1p2(Idx),Pal,Trns),
809     palette_color(?get1p3(Idx),Pal,Trns),palette_color(?get1p4(Idx),Pal,Trns),
810     palette_color(?get1p5(Idx),Pal,Trns),palette_color(?get1p6(Idx),Pal,Trns),
811     palette_color(?get1p7(Idx),Pal,Trns),palette_color(?get1p8(Idx),Pal,Trns)|
812     do_lookup_pal(Rest,1,Pal,Trns)].
813
814palette_color(Int,Pal,TrnsMap) ->
815    A = lookup_trns(Int,TrnsMap),
816    Skip = Int*3,
817    <<_:Skip/binary,R:8,G:8,B:8,_/binary>> = Pal,
818    [R,G,B|A].
819
820lookup_trns(_I,undefined) -> [];
821lookup_trns(I,Map) ->
822    case Map of
823	<<_:I/binary,A:8,_/binary>> -> [A];
824	_ -> [255]
825    end.
826
827%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
828
829save1(Orig=#e3d_image{},_Opts) ->
830    #e3d_image{width=W,height=H,type=T,image=Image,bytes_pp=Bpp} =
831	e3d_image:convert(Orig,rgb_order(Orig),1,upper_left),
832    HDR = create_chunk(<<"IHDR",W:32,H:32,8:8,(png_type(T)):8,0:8,0:8,0:8>>),
833    DATA = create_chunk(["IDAT",compress_image(0,Bpp*W,Image,[])]),
834    END  = create_chunk(<<"IEND">>),
835    list_to_binary([?MAGIC,HDR,DATA,END]).
836
837compress_image(I,RowLen, Bin, Acc) ->
838    Pos = I*RowLen,
839    case Bin of
840	<<_:Pos/binary,Row:RowLen/binary,_/binary>> ->
841	    Filtered = filter_row(Row,RowLen),
842	    compress_image(I+1,RowLen,Bin,[Filtered|Acc]);
843	_ when Pos == size(Bin) ->
844	    Filtered = list_to_binary(lists:reverse(Acc)),
845	    Compressed = zlib:compress(Filtered),
846	    Compressed
847    end.
848
849filter_row(Row,_RowLen) ->
850    [0,Row].
851
852png_type(g8) -> ?GREYSCALE;
853png_type(a8) -> ?GREYSCALE;
854png_type(r8g8b8) -> ?TRUECOLOUR;
855png_type(r8g8b8a8) -> ?TRUECOLOUR_A.
856
857rgb_order(#e3d_image{type=b8g8r8}) -> r8g8b8;
858rgb_order(#e3d_image{type=b8g8r8a8}) -> r8g8b8a8;
859rgb_order(#e3d_image{type=Type}) -> Type.
860
861create_chunk(Bin) when is_list(Bin) ->
862    create_chunk(list_to_binary(Bin));
863create_chunk(Bin) when is_binary(Bin) ->
864    Sz = size(Bin)-4,
865    Crc = erlang:crc32(Bin),
866    <<Sz:32,Bin/binary,Crc:32>>.
867
868test() ->
869    {ok, Fs} = file:list_dir("."),
870    test2(Fs).
871test(File) ->
872    test2([File]).
873
874test2([]) -> ok;
875test2([File|Rest]) ->
876    case lists:reverse(File) of
877	"gnp." ++ F ->
878	    case catch load(File,[]) of
879		Img = #e3d_image{} when hd(File) == $x ->
880		    io:format("~n Didn't Fail with ~p ~p ~n~n",[File,Img]);
881		Else when hd(File) == $x ->
882		    io:format("~n Good Fail with ~p ~p ~n~n",[File,Else]),
883		    test2(Rest);
884		Img = #e3d_image{width=W,height=H,bytes_pp=Bpp,image=Image}
885		when W*H*Bpp==size(Image) ->
886		    io:format("~n Loaded ~p ~n~n",[File]),
887		    ok = e3d_image:save(Img, lists:reverse(F)++".tga"),
888		    test2(Rest);
889		#e3d_image{width=W,height=H,bytes_pp=Bpp,image=Image} ->
890		    io:format("~n~p Failed: Size differ W*H*Bpp=~p*~p*~p=~p Isz=~p~n",
891			      [File,W,H,Bpp, W*H*Bpp,size(Image)]);
892
893		{'EXIT',not_implemented} ->
894		    io:format("~nNot implemented skipped ~p ~n~n",[File]),
895		    test2(Rest);
896		Else ->
897		    io:format("~n ~p Failed with ~p~n~n",[File,Else])
898	    end;
899	_ ->
900	    test2(Rest)
901    end.
902
903