Skip to content
Browse files

Initial commit: erl_img-1.6

  • Loading branch information...
0 parents commit ad1e703917d32f08605c70683125144c9ce80617 @davide davide committed Aug 20, 2009
1 doc/short-desc
@@ -0,0 +1 @@
+Image processing stuff (bmp, gif, jpeg, png, xpm, tiff, mpeg)
BIN ebin/erl_img.beam
Binary file not shown.
BIN ebin/exif.beam
Binary file not shown.
BIN ebin/image_bmp.beam
Binary file not shown.
BIN ebin/image_gif.beam
Binary file not shown.
BIN ebin/image_jpeg.beam
Binary file not shown.
BIN ebin/image_png.beam
Binary file not shown.
BIN ebin/image_tiff.beam
Binary file not shown.
BIN ebin/image_undef.beam
Binary file not shown.
BIN ebin/image_x_xpixmap.beam
Binary file not shown.
BIN ebin/lzw.beam
Binary file not shown.
BIN ebin/video_mpeg.beam
Binary file not shown.
81 include/erl_img.hrl
@@ -0,0 +1,81 @@
+%%
+%% image format A R G B
+%% pixel data 16 16 16 16
+%%
+-ifndef(__ERL_IMG_HRL__).
+-define(__ERL_IMG_HRL__, true).
+
+-define(IMAGE_JPEG, image_jpeg).
+-define(IMAGE_TIFF, image_tiff).
+-define(IMAGE_GIF, image_gif).
+-define(IMAGE_PNG, image_png).
+-define(IMAGE_BMP, image_bmp).
+-define(IMAGE_X_XPIXMAP, image_x_xpixmap).
+-define(IMAGE_UNDEF, image_undef).
+-define(VIDEO_MPEG, video_mpeg).
+
+-define(PAD_Len(L,A), (((A)-((L) rem (A))) rem (A))).
+
+-define(PAD_Len8(L), ((8 - ((L) band 7)) band 7)).
+
+-define(PAD(L,A),
+ case ?PAD4_Len(L,A) of
+ 0 -> <<>>;
+ 1 -> <<0>>;
+ 2 -> <<0,0>>;
+ 3 -> <<0,0,0>>;
+ 4 -> <<0,0,0,0>>;
+ 5 -> <<0,0,0,0,0>>;
+ 6 -> <<0,0,0,0,0,0>>;
+ 7 -> <<0,0,0,0,0,0,0>>;
+ N -> list_to_binary(lists:duplicate(N,0))
+ end).
+
+-define(IMAGE_TYPES, [?IMAGE_JPEG,
+ ?IMAGE_TIFF,
+ ?IMAGE_GIF,
+ ?IMAGE_PNG,
+ ?IMAGE_BMP,
+ ?IMAGE_X_XPIXMAP,
+ ?VIDEO_MPEG]).
+
+-record(erl_pixmap,
+ {
+ top = 0,
+ left = 0,
+ width = 0,
+ height = 0,
+ palette, %% list [{R,G,B}]
+ format, %% pixmap format
+ attributes = [], %% extension codes
+ pixels = [] %% [ {Ri,binary(Row)} ]
+ }).
+
+
+-record(erl_image,
+ {
+ type, %% module name of image handler
+ name, %% Image name (no path)
+ filename, %% Full filename
+ size, %% File size
+ extension, %% extension used
+ mtime, %% file creation date {{YYYY,MM,DD},{HH,MM,SS}}
+ itime, %% image creation date {{YYYY,MM,DD},{HH,MM,SS}}
+ comment = "", %% image comment (if present)
+ format, %% pixel format:
+ %% gray4, gray8,
+ %% palette4, palette8
+ %% b8g8r8 r8g8b8 r8g8b8a8
+ width, %% Image width
+ height, %% Image height
+ depth, %% Image depth
+ bytes_pp = 3, %% bytes per pixel
+ alignment = 1,
+ attributes = [], %% list of attributes [{atom(Key),term(Value)}]
+ order, %% sample order left_to_right or right_to_left
+ palette, %% list [{R,G,B}]
+ pixmaps = [] %% [#erl_pixmap]
+ }).
+
+-endif.
+
35 src/Makefile
@@ -0,0 +1,35 @@
+
+EBIN = ../ebin
+ERLC = erlc
+ERLC_FLAGS = -I../include
+
+OBJS = $(EBIN)/image_bmp.beam \
+ $(EBIN)/image_x_xpixmap.beam \
+ $(EBIN)/image_png.beam \
+ $(EBIN)/image_gif.beam \
+ $(EBIN)/image_jpeg.beam \
+ $(EBIN)/image_tiff.beam \
+ $(EBIN)/image_undef.beam \
+ $(EBIN)/video_mpeg.beam \
+ $(EBIN)/exif.beam \
+ $(EBIN)/lzw.beam \
+ $(EBIN)/erl_img.beam
+
+
+debug: ERLC_FLAGS += -Ddebug
+
+
+all: $(OBJS)
+
+debug: all
+
+
+$(OBJS): ../include/erl_img.hrl
+
+$(EBIN)/image_tiff.beam: tiff.hrl
+$(EBIN)/image_jpeg.beam: jpeg.hrl exif.hrl
+$(EBIN)/exif.beam: exif.hrl
+
+$(EBIN)/%.beam: %.erl
+ $(ERLC) $(ERLC_FLAGS) -o $(EBIN) $<
+
44 src/adler.erl
@@ -0,0 +1,44 @@
+%%% File : adler.erl
+%%% Author : Tony Rogvall <tony@bit.hemma.se>
+%%% Description : adler checksum
+%%% Created : 8 Apr 2003 by Tony Rogvall <tony@bit.hemma.se>
+
+-module(adler).
+
+-export([adler32/1, adler32/2]).
+
+-define(BASE, 65521). %% largest prime smaller than 65536
+-define(NMAX, 5552).
+
+adler32(Bin) ->
+ adler32(0, Bin).
+
+
+adler32(Adler, Bin) ->
+ S1 = Adler band 16#ffff,
+ S2 = (Adler bsr 16) band 16#ffff,
+ adler_n(Adler, 0, S1, S2, Bin, 0).
+
+adler_n(Adler, Offs, S1, S2, Bin, 0) ->
+ S11 = S1 rem ?BASE,
+ S12 = S2 rem ?BASE,
+ Len = size(Bin) - Offs,
+ K = if Len < ?NMAX -> Len; true -> ?NMAX end,
+ if K == 0 ->
+ (S2 bsl 16) bor S1;
+ true ->
+ adler_n(Adler, Offs, S11, S12, Bin, K)
+ end;
+adler_n(Adler, Offs, S1, S2, Bin, I) when I >= 8 ->
+ <<_:Offs/binary, C0,C1,C2,C3,C4,C5,C6,C7,_/binary>> = Bin,
+ S11 = S1+C0,
+ adler_n(Adler, Offs+8,
+ S11+C1+C2+C3+C4+C5+C6+C7,
+ S2+8*S11+7*C1+6*C2+5*C3+4*C4+3*C5+2*C6+C7, Bin, I-8);
+adler_n(Adler, Offs, S1, S2, Bin, I) ->
+ <<_:Offs/binary, C0,_/binary>> = Bin,
+ adler_n(Adler, Offs+1, S1+C0, S2+S1+C0, Bin, I-1).
+
+
+
+
34 src/api.hrl
@@ -0,0 +1,34 @@
+%%
+%% These are the functions that make the image api
+%%
+
+
+%% magic(Bin) -> true | false
+-export([magic/1]).
+
+%% mime_type() -> <mime-type>
+-export([mime_type/0]).
+
+%% extensions() -> [ ".<ext1>" ... ".<extn>"]
+-export([extensions/0]).
+
+%% read_info(Fd) -> {ok, #erl_img} | Error
+-export([read_info/1]).
+
+%% write_info(Fd, #erl_img) -> ok | Error
+-export([write_info/2]).
+
+%% read(Fd, #erl_img) -> {ok, #erl_img'} | Error
+%% read(Fd, #erl_img, RowFun, State) -> {ok, #erl_img'} | Error
+%% RowFun = fun(#erl_img, Row, RowNumber, RowFormat, St) -> St'
+%%
+-export([read/2, read/4]).
+
+%% write(Fd, #erl_img) -> ok | Error
+-export([write/2]).
+
+
+
+
+
+
6 src/dbg.hrl
@@ -0,0 +1,6 @@
+
+-ifdef(debug).
+-define(dbg(Fmt,Args), io:format((Fmt),(Args))).
+-else.
+-define(dbg(Fmt,Args), ok).
+-endif.
214 src/erl_img.erl
@@ -0,0 +1,214 @@
+%%% File : erl_img.erl
+%%% Author : Tony Rogvall <tony@bix.hemma.se>
+%%% Description : Image processing stuff
+%%% Created : 5 Mar 2003 by Tony Rogvall <tony@bix.hemma.se>
+
+-module(erl_img).
+
+-include_lib("kernel/include/file.hrl").
+
+-include("erl_img.hrl").
+
+-export([magic_info/1]).
+-export([mime_type/1]).
+-export([dir_info/1]).
+-export([read_file_info/1]).
+-export([read/2, write/2]).
+-export([load/1, save/1, save/2, to_binary/1]).
+-export([attribute/2, attribute/3, set_attribute/3]).
+-export([extensions/1]).
+-export([write_info/3]).
+-export([hex32/1, hex16/1, hex8/1]).
+
+hex32(X) ->
+ hex8(X bsr 24) ++ hex8(X bsr 16) ++ hex8(X bsr 8) ++ hex8(X).
+
+hex16(X) ->
+ hex8(X bsr 8) ++ hex8(X).
+
+%% convert a hex byte into two ascii letters
+hex8(X) ->
+ [nib((X bsr 4) band 16#f),nib(X band 16#f)].
+
+nib(N) when N =< 9 -> N+$0;
+nib(N) -> (N-10)+$A.
+
+%% Read magic info check MAGIC type and width and height (depth)
+%% of image
+
+%% Check a header of least 64 bytes
+magic([Type|Ts], Bin) ->
+ case apply(Type, magic, [Bin]) of
+ true -> {true, Type };
+ false -> magic(Ts, Bin)
+ end;
+magic([], _Bin) ->
+ false.
+
+
+%% Read file mtime information
+file_info(File, _IMG) ->
+ case file:read_file_info(File) of
+ {ok, Info} when Info#file_info.type == regular,
+ Info#file_info.size > 0 ->
+ {ok, {Info#file_info.mtime,Info#file_info.size}};
+ {ok, _Other} ->
+ {error, bad_file};
+ Error ->
+ Error
+ end.
+
+
+
+read_magic_info(Fd) ->
+ file:position(Fd, 0),
+ case file:read(Fd, 64) of
+ {ok, Bin} ->
+ case magic(?IMAGE_TYPES, Bin) of
+ {true, Type} ->
+ read_info(Type, Fd);
+ false ->
+ {error, not_supported}
+ end;
+ Error ->
+ Error
+ end.
+
+
+magic_info(File) ->
+ case file:open(File,[raw,binary,read]) of
+ {ok,Fd} ->
+ Res = read_magic_info(Fd),
+ file:close(Fd),
+ case Res of
+ {ok,IMG} ->
+ {ok,IMG#erl_image { filename = File,
+ name = filename:basename(File) }};
+ Error ->
+ Error
+ end;
+ Error -> Error
+ end.
+
+
+
+mime_type(IMG) ->
+ apply(IMG#erl_image.type, mime_type, []).
+
+extensions(IMG) ->
+ apply(IMG#erl_image.type, extensions, []).
+
+
+read_file_info(File) ->
+ case file_info(File, #erl_image { }) of
+ {ok, {MTime,Size}} ->
+ case magic_info(File) of
+ {ok,IMG} ->
+ {ok,IMG#erl_image { mtime = MTime,
+ size = Size}};
+ Error ->
+ Error
+ end;
+ Error -> Error
+ end.
+
+
+load(File) ->
+ case file:open(File, [raw, binary, read]) of
+ {ok,Fd} ->
+ Res = case read_magic_info(Fd) of
+ {ok, IMG} ->
+ read(Fd, IMG#erl_image { filename = File });
+ Error ->
+ Error
+ end,
+ file:close(Fd),
+ Res;
+ Error -> Error
+ end.
+
+save(IMG) ->
+ save(IMG#erl_image.filename, IMG).
+
+save(File, IMG) ->
+ case file:open(File, [raw, binary, write]) of
+ {ok,Fd} ->
+ Res = write(Fd, IMG),
+ file:close(Fd),
+ Res;
+ Error ->
+ Error
+ end.
+
+to_binary(IMG) ->
+ case file:open(<<>>, [ram, binary, write]) of
+ {ok,Fd} ->
+ ok = write(Fd, IMG),
+ case ram_file:get_file_close(Fd) of
+ {ok, Data} ->
+ {ok,Data};
+ Error ->
+ Error
+ end;
+ Error ->
+ Error
+ end.
+
+
+
+
+read_info(Type, Fd) ->
+ file:position(Fd, 0),
+ apply(Type, read_info, [Fd]).
+
+write_info(Type, Fd, IMG) ->
+ file:position(Fd, 0),
+ apply(Type, write_info, [Fd,IMG]).
+
+read(Fd,IMG) ->
+ file:position(Fd, 0),
+ apply(IMG#erl_image.type, read, [Fd,IMG]).
+
+write(Fd,IMG) ->
+ file:position(Fd, 0),
+ apply(IMG#erl_image.type, write, [Fd,IMG]).
+
+
+
+attribute(IMG, Key) ->
+ {value, {_, Value}} = lists:keysearch(Key, 1, IMG#erl_image.attributes),
+ Value.
+
+attribute(IMG, Key, Default) ->
+ case lists:keysearch(Key, 1, IMG#erl_image.attributes) of
+ {value, {_, Value}} -> Value;
+ false -> Default
+ end.
+
+set_attribute(IMG, Key, Value) ->
+ As = IMG#erl_image.attributes,
+ As1 = case lists:keysearch(Key, 1, As) of
+ false -> [{Key,Value}|As];
+ {value,_} ->
+ lists:keyreplace(Key, 1, As, {Key,Value})
+ end,
+ IMG#erl_image { attributes = As1 }.
+
+
+dir_info(Dir) ->
+ case file:list_dir(Dir) of
+ {ok, Listing} ->
+ dir_list(Listing,Dir);
+ Error ->
+ Error
+ end.
+
+dir_list([File|Fs], Dir) ->
+ case read_file_info(filename:join(Dir, File)) of
+ {ok,IMG} ->
+ [IMG|dir_list(Fs, Dir)];
+ _Error ->
+ dir_list(Fs, Dir)
+ end;
+dir_list([], _Dir) ->
+ [].
291 src/erl_img_show.erl
@@ -0,0 +1,291 @@
+%%% File : erl_img_show.erl
+%%% Author : Tony Rogvall <tony@bit.hemma.se>
+%%% Description : Sample function for displaying images
+%%% Created : 31 Mar 2003 by Tony Rogvall <tony@bit.hemma.se>
+
+-module(erl_img_show).
+
+-compile(export_all).
+
+-include_lib("erlgtk/include/gtk.hrl").
+-include_lib("erlgtk/include/gdk.hrl").
+-include("erl_img.hrl").
+
+-import(lists, [foldl/3, reverse/1, foreach/2, map/2]).
+
+
+file(File) ->
+ case erl_img:load(File) of
+ {ok,Image} ->
+ io:format("pixmaps = ~p\n", [length(Image#erl_image.pixmaps)]),
+ image(Image);
+ Error ->
+ Error
+ end.
+
+
+image(Image) ->
+ gtk:start(),
+ Window = gtk:window_new ('GTK_WINDOW_TOPLEVEL'),
+ %% GdkWindow = gtk:widget_get_window(Window),
+ {IList,Visual,Colormap} = make_gdk_image(Image),
+
+ gtk:window_set_title (?GTK_WINDOW (Window), "View"),
+ gtk:widget_set_usize(?GTK_WIDGET(Window),
+ Image#erl_image.width,
+ Image#erl_image.height),
+ gtk:widget_set_colormap(Window,Colormap),
+ gtk:widget_set_visual(Window, Visual),
+
+ gtk:signal_connect (?GTK_OBJECT (Window), 'destroy',
+ fun() -> gtk:main_quit() end, []),
+ Drawing_area = gtk:drawing_area_new (),
+
+ gtk:widget_set_usize (Drawing_area,
+ Image#erl_image.width,
+ Image#erl_image.height),
+ gtk:signal_connect (?GTK_OBJECT (Drawing_area), 'expose_event',
+ fun expose_event/3, ?NULL),
+ gtk:signal_connect (?GTK_OBJECT(Drawing_area), 'configure_event',
+ fun configure_event/3, ?NULL),
+ gtk:widget_set_events (Drawing_area, ?GDK_EXPOSURE_MASK),
+ gtk:container_add (?GTK_CONTAINER(Window), Drawing_area),
+ gtk:widget_show (Drawing_area),
+ gtk:widget_show (Window),
+
+ Area = #gdk_rectangle { x=0, y=0,
+ width=Image#erl_image.width,
+ height = Image#erl_image.height
+ },
+ set_image_list(IList, Drawing_area, Area),
+ gtk:main().
+
+
+set_image_next([Widget,Area]) ->
+ case get(image_list) of
+ [P1,P2|Ps] ->
+ set_image_list([P2|Ps]++[P1],Widget,Area);
+ [P1] ->
+ set_image_list([P1],Widget,Area);
+ [] ->
+ ok
+ end,
+ gtk:widget_draw(Widget, Area),
+ false.
+
+
+set_image_list(IList, Widget, Area) ->
+ put(image_list, IList),
+ case IList of
+ [{Tmo,_}|Ps] when Ps =/= [], Tmo > 0->
+ gtk:timeout_add(Tmo*10, fun set_image_next/1, [Widget,Area]);
+ _ ->
+ false
+ end.
+
+
+
+configure_event(Widget, Event, _) ->
+ true.
+
+expose_event(Widget, Event, _) ->
+ Area = Event#gdk_event_expose.area,
+ GdkWindow = gtk:widget_get_window(Widget),
+ Style = gtk:widget_get_style(Widget),
+ State = ?GTK_WIDGET_STATE(Widget),
+ Gc = gtk:style_get_fg_gc(Style, State),
+ [{_,Image}|_] = get(image_list),
+ gdk:draw_image(GdkWindow, Gc,
+ Image,
+ Area#gdk_rectangle.x, Area#gdk_rectangle.y,
+ Area#gdk_rectangle.x, Area#gdk_rectangle.y,
+ Area#gdk_rectangle.width,
+ Area#gdk_rectangle.height),
+ true.
+
+%%
+%% generate a list of images
+%%
+make_gdk_image(Image) ->
+ Visual = gdk:visual_get_system(),
+ Colormap = gdk:colormap_get_system(),
+ %% Visual = gdk:window_get_visual(Window),
+ %% Colormap = gdk:window_get_colormap(Window),
+ Map0 = map_colors(Image#erl_image.palette, Colormap),
+ IList =
+ map(
+ fun(Pixmap) ->
+ GdkImage = gdk:image_new('GDK_IMAGE_FASTEST',
+ Visual,
+ Image#erl_image.width,
+ Image#erl_image.height),
+ if Pixmap#erl_pixmap.format == palette8;
+ Pixmap#erl_pixmap.format == palette4 ->
+ Pal = Pixmap#erl_pixmap.palette,
+ Map = if Pal == undefined ->
+ Map0;
+ true ->
+ map_colors(Pal, Colormap)
+ end,
+ indexed_colors(Pixmap,GdkImage,Visual,Colormap,
+ Image#erl_image.order, Map);
+ true ->
+ direct_colors(Pixmap,GdkImage,Visual,Colormap,
+ Image#erl_image.order)
+ end,
+ As = Pixmap#erl_pixmap.attributes,
+ case lists:keysearch('DelayTime',1,As) of
+ {value,{_, Tmo}} when Tmo > 0 ->
+ {Tmo, GdkImage};
+ _ ->
+ {0, GdkImage}
+ end
+ end, Image#erl_image.pixmaps),
+ {IList, Visual, Colormap}.
+
+
+
+%% create a color lookup table
+map_colors(undefined, Colormap) ->
+ {};
+map_colors(Colors, Colormap) ->
+ map_colors(Colors, Colormap, []).
+
+map_colors([{R,G,B}| Cs], Colormap, Acc) ->
+ C0 = #gdk_color { red = R,green = G, blue = B },
+ Pixel = case gdk:colormap_alloc_color(Colormap,C0,false,true) of
+ {true,C1} ->
+ C1#gdk_color.pixel;
+ _ ->
+ 0
+ end,
+ map_colors(Cs, Colormap, [Pixel|Acc]);
+map_colors([Spec | Cs], Colormap, Acc) ->
+ Pixel = case gdk:color_parse(Spec) of
+ {true,C1} ->
+ case gdk:colormap_alloc_color(Colormap,C1,false,true) of
+ {true,C2} ->
+ C2#gdk_color.pixel;
+ _ ->
+ 0
+ end;
+ {false,_} ->
+ 0
+ end,
+ map_colors(Cs, Colormap, [Pixel|Acc]);
+map_colors([], Colormap, Acc) ->
+ list_to_tuple(reverse(Acc)).
+
+%%
+%%
+%%
+%%
+indexed_colors(Pixmap, GdkImg, Visual, Colormap,Order,Map) ->
+ #erl_pixmap { top = Y0, left = X0, width = W, height = H } = Pixmap,
+ XList =
+ case Order of
+ left_to_right -> lists:seq(0, W-1);
+ right_to_left -> reverse(lists:seq(0, W-1))
+ end,
+ Transparent =
+ case lists:keysearch('Transparent', 1, Pixmap#erl_pixmap.attributes) of
+ false -> undefined;
+ {value,{_,T}} -> T
+ end,
+ Background =
+ case lists:keysearch('Background', 1, Pixmap#erl_pixmap.attributes) of
+ false -> 0;
+ {value,{_,B}} -> B
+ end,
+ foreach(
+ fun({Y,Row}) ->
+ foreach(
+ fun(X) ->
+ IX =
+ case Pixmap#erl_pixmap.format of
+ palette4 ->
+ Offs = X*4,
+ Pad = (X band 1)*4,
+ <<_:Offs,I:4,_:Pad,_/binary>> = Row,
+ I;
+ palette8 ->
+ Offs = X,
+ <<_:Offs/binary,I,_/binary>> = Row,
+ I
+ end,
+ IX1 = if IX == Transparent ->
+ B;
+ true ->
+ IX
+ end,
+ true ->
+ gdk:image_put_pixel(GdkImg, X+X0, Y+Y0,
+ element(IX1+1, Map))
+ end
+ end, XList)
+ end, Pixmap#erl_pixmap.pixels),
+ GdkImg.
+
+
+
+direct_colors(Pixmap, GdkImg, Visual, Colormap, Order) ->
+ #erl_pixmap { top = Y0, left = X0, width = W, height = H } = Pixmap,
+ XList =
+ case Order of
+ left_to_right -> lists:seq(0, W-1);
+ right_to_left -> reverse(lists:seq(0, W-1))
+ end,
+ foreach(
+ fun({Y,Row}) ->
+ foreach(
+ fun(X) ->
+ C0 =
+ case Pixmap#erl_pixmap.format of
+ gray4 ->
+ Offs = X*4,
+ Pad = (X band 1)*4,
+ <<_:Offs,G:4,_:Pad,_/binary>> = Row,
+ #gdk_color { red = G*16*255,
+ green = G*16*255,
+ blue = G*16*255 };
+ gray8 ->
+ Offs = X,
+ <<_:Offs/binary,G,_/binary>> = Row,
+ #gdk_color { red = G*255,
+ green = G*255,
+ blue = G*255 };
+ b8g8r8 ->
+ Offs = 3*X,
+ <<_:Offs/binary,B,G,R,_/binary>> = Row,
+ #gdk_color { red = R*255,
+ green = G*255,
+ blue = B*255 };
+ b8g8r8a8 ->
+ Offs = 4*X,
+ <<_:Offs/binary,B,G,R,A,_/binary>> = Row,
+ #gdk_color { red = R*255,
+ green = G*255,
+ blue = B*255 };
+ r8g8b8 ->
+ Offs = 3*X,
+ <<_:Offs/binary,R,G,B,_/binary>> = Row,
+ #gdk_color { red = R*255,
+ green = G*255,
+ blue = B*255 };
+ r8g8b8a8 ->
+ Offs = 4*X,
+ <<_:Offs/binary,R,G,B,A,_/binary>> = Row,
+ #gdk_color { red = R*255,
+ green = G*255,
+ blue = B*255 }
+ end,
+ case gdk:colormap_alloc_color(Colormap,C0,false,true)of
+ {true,C1} ->
+ gdk:image_put_pixel(GdkImg,X+X0,Y+Y0,
+ C1#gdk_color.pixel);
+ {false,_} ->
+ gdk:image_put_pixel(GdkImg, X+X0, Y+Y0, 0)
+ end
+ end, XList)
+ end, Pixmap#erl_pixmap.pixels),
+ GdkImg.
65 src/exif.erl
@@ -0,0 +1,65 @@
+%%% File : img_exif.erl
+%%% Author : Tony Rogvall <tony@a55.hemma.se>
+%%% Description : Utils for decoding Exif tags
+%%% Created : 6 Mar 2003 by Tony Rogvall <tony@a55.hemma.se>
+
+-module(exif).
+
+-export([decode_tag/1]).
+
+-include("exif.hrl").
+
+decode_tag(Tag) when integer(Tag) ->
+ case Tag of
+ ?ExposureTime -> 'ExposureTime';
+ ?FNumber -> 'FNumber';
+ ?ExposureProgram -> 'ExposureProgram';
+ ?ISOSpeedRatings -> 'ISOSpeedRatings';
+ ?ExifVersion -> 'ExifVersion';
+ ?DateTimeOriginal -> 'DateTimeOriginal';
+ ?DateTimeDigitized -> 'DateTimeDigitized';
+ ?ComponentsConfiguration -> 'ComponentsConfiguration';
+ ?CompressedBitsPerPixel -> 'CompressedBitsPerPixel';
+ ?ShutterSpeedValue -> 'ShutterSpeedValue';
+ ?ApertureValue -> 'ApertureValue';
+ ?BrightnessValue -> 'BrightnessValue';
+ ?ExposureBiasValue -> 'ExposureBiasValue';
+ ?MaxApertureValue -> 'MaxApertureValue';
+ ?SubjectDistance -> 'SubjectDistance';
+ ?MeteringMode -> 'MeteringMode';
+ ?LightSource -> 'LightSource';
+ ?Flash -> 'Flash';
+ ?FocalLength -> 'FocalLength';
+ ?MakerNote -> 'MakerNote';
+ ?UserComment -> 'UserComment';
+ ?SubsecTime -> 'SubsecTime';
+ ?SubsecTimeOriginal -> 'SubsecTimeOriginal';
+ ?SubsecTimeDigitized -> 'SubsecTimeDigitized';
+ ?FlashPixVersion -> 'FlashPixVersion';
+ ?ColorSpace -> 'ColorSpace';
+ ?ExifImageWidth -> 'ExifImageWidth';
+ ?ExifImageHeight -> 'ExifImageHeight';
+ ?RelatedSoundFile -> 'RelatedSoundFile';
+ ?ExifInteroperabilityOffset -> 'ExifInteroperabilityOffset';
+ ?FocalPlaneXResolution -> 'FocalPlaneXResolution';
+ ?FocalPlaneYResolution -> 'FocalPlaneYResolution';
+ ?FocalPlaneResolutionUnit -> 'FocalPlaneResolutionUnit';
+ ?ExposureIndex -> 'ExposureIndex';
+ ?SensingMethod -> 'SensingMethod';
+ ?FileSource -> 'FileSource';
+ ?SceneType -> 'SceneType';
+ ?CFAPattern -> 'CFAPattern';
+ ?InteroperabilityIndex -> 'InteroperabilityIndex';
+ ?InteroperabilityVersion -> 'InteroperabilityVersion';
+ ?RelatedImageFileFormat -> 'RelatedImageFileFormat';
+ ?RelatedImageWidth -> 'RelatedImageWidth';
+ ?RelatedImageLength -> 'RelatedImageLength';
+ Tag -> Tag
+ end;
+decode_tag(Tag) ->
+ Tag.
+
+
+
+
+
64 src/exif.hrl
@@ -0,0 +1,64 @@
+-ifndef(__IMAGE_EXIF_HRL__).
+-define(__IMAGE_EXIF_HRL__, true).
+
+%% IFD0 usage
+-define(ExifOffset, 16#8769). %% unsigned long1 Offset to Exif Sub IFD
+
+%% SubExif IFD usage
+-define(ExposureTime, 16#829a).
+-define(FNumber, 16#829d).
+-define(ExposureProgram, 16#8822).
+-define(ISOSpeedRatings, 16#8827).
+-define(CFARepeatPatternDim, 16#828d ).
+
+-define(ExifVersion, 16#9000).
+-define(DateTimeOriginal, 16#9003).
+-define(DateTimeDigitized, 16#9004).
+-define(ComponentsConfiguration, 16#9101).
+-define(CompressedBitsPerPixel, 16#9102).
+-define(ShutterSpeedValue, 16#9201).
+-define(ApertureValue, 16#9202).
+-define(BrightnessValue, 16#9203).
+-define(ExposureBiasValue, 16#9204).
+-define(MaxApertureValue, 16#9205).
+-define(SubjectDistance, 16#9206).
+-define(MeteringMode, 16#9207).
+-define(LightSource, 16#9208).
+-define(Flash, 16#9209).
+-define(FocalLength, 16#920a).
+-define(MakerNote, 16#927c).
+-define(UserComment, 16#9286).
+-define(SubsecTime, 16#9290).
+-define(SubsecTimeOriginal, 16#9291).
+-define(SubsecTimeDigitized, 16#9292).
+-define(FlashPixVersion, 16#a000).
+-define(ColorSpace, 16#a001).
+-define(ExifImageWidth, 16#a002).
+-define(ExifImageHeight, 16#a003).
+-define(RelatedSoundFile, 16#a004).
+-define(ExifInteroperabilityOffset, 16#a005 ).
+-define(FocalPlaneXResolution, 16#a20e).
+-define(FocalPlaneYResolution, 16#a20f).
+-define(FocalPlaneResolutionUnit, 16#a210).
+-define(ExposureIndex, 16#a215).
+-define(SensingMethod, 16#a217).
+-define(FileSource, 16#a300).
+-define(SceneType, 16#a301).
+-define(CFAPattern, 16#a302).
+
+%% Interoperability IFD
+
+-define(InteroperabilityIndex, 16#0001 ).
+-define(InteroperabilityVersion, 16#0002 ).
+-define(RelatedImageFileFormat, 16#1000 ).
+-define(RelatedImageWidth, 16#1001 ).
+-define(RelatedImageLength, 16#1001 ).
+
+%% Other tags
+
+%% FIXME add OLYMP
+
+
+-endif.
+
+
114 src/image_bmp.erl
@@ -0,0 +1,114 @@
+%%% File : image_bmp.erl
+%%% Author : Tony Rogvall <tony@bix.hemma.se>
+%%% Description : BMP Files
+%%% Created : 5 Mar 2003 by Tony Rogvall <tony@bix.hemma.se>
+
+-module(image_bmp).
+
+-include("erl_img.hrl").
+-include("api.hrl").
+-include("dbg.hrl").
+
+-import(lists, [reverse/1]).
+
+
+-define(BMP_HEADER(FileSz, Offset),
+ $B:8,$M:8,
+ FileSz:32/little,
+ 0:16, 0:16,
+ Offset:32/little).
+
+-define(BMP_INFO(HSize,Width,Height,Planes,BitCount,Compression,
+ ImageSize,XRes,YRes,ColorsUsed,ImportantColors),
+ HSize:32/little,
+ Width:32/little,
+ Height:32/little,
+ Planes:16/little,
+ BitCount:16/little,
+ Compression:32/little,
+ ImageSize:32/little,
+ XRes:32/little,
+ YRes:32/little,
+ ColorsUsed:32/little,
+ ImportantColors:32/little).
+
+magic(<<$B,$M, _/binary>>) -> true;
+magic(_) -> false.
+
+mime_type() -> "image/bmp".
+
+extensions() -> [".bmp" ].
+
+
+read_info(Fd) ->
+ case file:read(Fd, 54) of
+ {ok, << ?BMP_HEADER(Size,Offset),
+ ?BMP_INFO(_,Width,Height,Planes,BitCount,
+ Compression,_,_,_,_,_) >> } ->
+ {ok, #erl_image { type = ?MODULE,
+ width = Width,
+ height = Height,
+ depth = Planes,
+ format = b8g8r8,
+ bytes_pp = 3,
+ alignment = 4,
+ order = left_to_right,
+ attributes = [{'Compression',Compression}]
+ }};
+ {ok, _} ->
+ {error, bad_magic};
+ Error ->
+ Error
+ end.
+
+
+write_info(Fd, IMG) ->
+ ok.
+
+read(Fd, IMG, RowFun, St0) ->
+ file:position(Fd, 54),
+ case read_pixels(Fd, IMG, RowFun, St0) of
+ {ok,PIX} ->
+ {ok, IMG#erl_image { pixmaps = [PIX] }};
+ Error -> Error
+ end.
+
+%% load image
+read(Fd, IMG) ->
+ read(Fd, IMG,
+ fun(_, Row, Ri, St) ->
+ ?dbg("bmp: load row ~p\n", [Ri]),
+ [{Ri,Row}|St] end,
+ []).
+
+%% save image
+write(Fd, IMG) ->
+ ok.
+
+%% Read all rows
+read_pixels(Fd, IMG, RowFun, St0) ->
+ Width = IMG#erl_image.width,
+ Height = IMG#erl_image.height,
+ RowLength = Width*3 + ?PAD_Len(Width*3, 4),
+ PIX = #erl_pixmap { width = Width, height = Height,
+ format = IMG#erl_image.format },
+ read_pixels(Fd, PIX, 0, Height, RowLength, RowFun, St0).
+
+
+read_pixels(Fd, PIX, NRows, NRows, BytesPerRow, RowFun, St) ->
+ {ok,PIX#erl_pixmap { pixels = St }};
+read_pixels(Fd, PIX, Ri, NRows, BytesPerRow, RowFun, St) ->
+ case file:read(Fd, BytesPerRow) of
+ {ok,Row} ->
+ St1 = RowFun(PIX, Row, Ri, St),
+ read_pixels(Fd, PIX, Ri+1, NRows, BytesPerRow, RowFun, St1);
+ Error ->
+ Error
+ end.
+
+
+
+
+
+
+
573 src/image_gif.erl
@@ -0,0 +1,573 @@
+%%% File : image_gif.erl
+%%% Author : Tony Rogvall <tony@bix.hemma.se>
+%%% Description : GIF image processing
+%%% Created : 5 Mar 2003 by Tony Rogvall <tony@bix.hemma.se>
+
+-module(image_gif).
+
+-include("erl_img.hrl").
+
+-include("api.hrl").
+
+%% -define(debug, true).
+-include("dbg.hrl").
+
+-import(lists, [reverse/1]).
+
+
+-define(APP_EXTENSION, 16#ff).
+-define(COM_EXTENSION, 16#fe).
+-define(CTL_EXTENSION, 16#f9).
+-define(TXT_EXTENSION, 16#01).
+
+-define(EXTENSION, 16#21). %% $!
+-define(IMAGE, 16#2c). %% $,
+-define(TRAILER, 16#3b). %% $;
+
+%% Read magic info check MAGIC type and width and height (depth)
+%% of image
+-define(MAGIC87, $G,$I,$F,$8,$7,$a).
+-define(MAGIC89, $G,$I,$F,$8,$9,$a).
+
+magic(<<?MAGIC87,_/binary>>) -> true;
+magic(<<?MAGIC89,_/binary>>) -> true;
+magic(_) -> false.
+
+mime_type() -> "image/gif".
+
+extensions() -> [ ".gif" ].
+
+
+read_info(Fd) ->
+ case file:read(Fd, 10) of
+ {ok, <<?MAGIC87,
+ Width:16/little-unsigned-integer,
+ Height:16/little-unsigned-integer,_/binary>>} ->
+ {ok,#erl_image { type = ?MODULE,
+ width = Width,
+ height = Height,
+ format = palette8,
+ order = left_to_right,
+ depth = 8 }};
+ {ok, <<?MAGIC89,
+ Width:16/little-unsigned-integer,
+ Height:16/little-unsigned-integer,_/binary>>} ->
+ {ok,#erl_image { type = ?MODULE,
+ width = Width,
+ height = Height,
+ format = palette8,
+ order = left_to_right,
+ depth = 8 }};
+ {ok, _} ->
+ {error, bad_magic};
+ Error ->
+ Error
+ end.
+
+write_info(Fd, IMG) ->
+ %% Should version be configurable?
+ file:write(Fd, <<?MAGIC89,
+ (IMG#erl_image.width):16/little-unsigned-integer,
+ (IMG#erl_image.height):16/little-unsigned-integer>>).
+
+
+%% The Grammar.
+%% <GIF Data Stream> ::= Header <Logical Screen> <Data>* Trailer
+%%
+%% <Logical Screen> ::= Logical Screen Descriptor [Global Color Table]
+%%
+%% <Data> ::= <Graphic Block> |
+%% <Special-Purpose Block>
+%%
+%% <Graphic Block> ::= [Graphic Control Extension] <Graphic-Rendering Block>
+%%
+%% <Graphic-Rendering Block> ::= <Table-Based Image> |
+%% Plain Text Extension
+%%
+%% <Table-Based Image> ::= Image Descriptor [Local Color Table] Image Data
+%%
+%% <Special-Purpose Block> ::= Application Extension |
+%% Comment Extension
+
+read(Fd,IMG,RowFun,St0) ->
+ file:position(Fd, 6),
+ case file:read(Fd, 7) of
+ {ok, <<_Width:16/little, _Hight:16/little,
+ Map:1, _Cr:3, Sort:1, Pix:3,
+ Background:8,
+ AspectRatio:8>>} ->
+ Palette = read_palette(Fd, Map, Pix+1),
+ ?dbg("sizeof(palette)=~p Map=~w, Cr=~w, Sort=~w, Pix=~w\n",
+ [length(Palette),Map,Cr,Sort,Pix]),
+ ?dbg("Background=~w, AspectRatio=~w\n",
+ [Background, AspectRatio]),
+ As = [{'Background',Background},
+ {'AspectRatio',AspectRatio},
+ {'Sort',Sort} | IMG#erl_image.attributes],
+ IMG1 = IMG#erl_image { palette = Palette, attributes = As},
+ read_data(Fd, IMG1, RowFun, St0, []);
+ Error ->
+ Error
+ end.
+
+
+read(Fd, IMG) ->
+ read(Fd, IMG,
+ fun(_, Row, Ri, St) ->
+ ?dbg("gif: load row ~p\n", [Ri]),
+ [{Ri,Row}|St] end,
+ []).
+
+
+read_data(Fd, IMG, RowFun, St0, As) ->
+ case file:read(Fd, 1) of
+ {ok, <<?EXTENSION>>} ->
+ ?dbg("Extension\n",[]),
+ read_extension(Fd, IMG, RowFun, St0, As);
+ {ok, <<?IMAGE>>} ->
+ ?dbg("Image\n",[]),
+ case file:read(Fd, 9) of
+ {ok, <<Left:16/little, Top:16/little,
+ Width:16/little, Height:16/little,
+ Map:1, Interlaced:1, Sort:1,_:2, Pix:3>>} ->
+ Palette = read_palette(Fd, Map, Pix+1),
+ As1 = [{'Interlaced', Interlaced},
+ {'Sort', Sort} | As],
+ Pixmap0 =
+ #erl_pixmap { top = Top,
+ left = Left,
+ width = Width,
+ height = Height,
+ format = IMG#erl_image.format,
+ palette = Palette,
+ attributes = As1
+ },
+ ?dbg("pix=~w, sizeof(palette)=~p\n", [Pix,Palette]),
+ case read_pixels(Fd,Pixmap0,RowFun,St0,
+ Width,Height,Interlaced) of
+ {ok, Pixmap1} ->
+ %% ?dbg("Pixmap = ~p\n", [Pixmap2]),
+ Ps = IMG#erl_image.pixmaps ++ [Pixmap1],
+ read_data(Fd, IMG#erl_image { pixmaps = Ps },
+ RowFun, St0, []);
+ Error -> Error
+ end;
+ Error -> Error
+ end;
+ {ok, <<?TRAILER>>} ->
+ ?dbg("Trailer\n",[]),
+ {ok, IMG};
+ Error ->
+ Error
+ end.
+
+
+read_extension(Fd, IMG,RowFun,St0,As) ->
+ case file:read(Fd, 1) of
+ {ok,<<?COM_EXTENSION>>} ->
+ read_comment(Fd, IMG,RowFun,St0,As);
+ {ok,<<?APP_EXTENSION>>} ->
+ read_app(Fd, IMG,RowFun,St0,As);
+ {ok,<<?CTL_EXTENSION>>} ->
+ read_ctl(Fd, IMG,RowFun,St0,As);
+ {ok,<<?TXT_EXTENSION>>} ->
+ read_txt(Fd, IMG,RowFun,St0,As);
+ {ok, _} ->
+ read_blocks(Fd), %% skip
+ read_data(Fd, IMG,RowFun,St0,As)
+ end.
+
+
+read_ctl(Fd, IMG,RowFun,St0,As) ->
+ ?dbg("Control block\n",[]),
+ case read_block(Fd) of
+ {ok, <<_:3, DisposalMethod:3, UserInput:1, Transparent:1,
+ DelayTime:16/unsigned-little,
+ TransparentColor:8>>} ->
+ case read_block(Fd) of
+ terminator ->
+ As1 = [{'TransparentColor', TransparentColor},
+ {'DelayTime', DelayTime},
+ {'UserInput', UserInput},
+ {'Transparent', Transparent},
+ {'DisposalMethod', DisposalMethod} | As],
+ read_data(Fd,IMG,RowFun,St0,As1);
+ {ok,_} ->
+ {error, bad_ctl_block};
+ Error -> Error
+ end;
+ Error -> Error
+ end.
+
+
+read_comment(Fd, IMG,RowFun,St0,As) ->
+ ?dbg("Comment block\n",[]),
+ case read_blocks(Fd) of
+ {ok, Comment} ->
+ read_data(Fd,
+ IMG#erl_image { comment = binary_to_list(Comment)}
+ ,RowFun,St0,As);
+ Error -> Error
+ end.
+
+
+read_txt(Fd, IMG,RowFun,St0,As) ->
+ ?dbg("Text block\n",[]),
+ case read_block(Fd) of
+ {ok, <<GridLeft:16/little, GridTop:16/little,
+ _GridWidth:16/little, _GridHeight:16/little,
+ CellWidth:8, CellHeight:8,
+ Foreground:8, Background:8>>} ->
+ case read_blocks(Fd) of
+ {ok,Bin} ->
+ As1 =
+ [{'TextGridLeftPosition', GridLeft},
+ {'TextGridTopPosition', GridTop},
+ {'CharacterCellWidth', CellWidth},
+ {'CharacterCellHeight', CellHeight},
+ {'TextForegroundColorIndex', Foreground},
+ {'TextBackgroundColorIndex', Background},
+ {'Text', binary_to_list(Bin)} | As],
+ read_data(Fd,IMG,RowFun,St0,As1);
+ Error ->
+ Error
+ end;
+ terminator ->
+ {error, bad_txt_block};
+ Error -> Error
+ end.
+
+read_app(Fd, IMG,RowFun,St0,As) ->
+ ?dbg("Application block\n",[]),
+ case read_block(Fd) of
+ {ok, <<Ident:8/binary, AuthCode:3/binary>>} ->
+ case read_blocks(Fd) of
+ {ok, AppData} ->
+ As1 =
+ [{'ApplicationIdentifier', binary_to_list(Ident)},
+ {'ApplicationAuthenticationCode',
+ binary_to_list(AuthCode)},
+ {'ApplicationData', AppData} |
+ IMG#erl_image.attributes],
+ read_data(Fd,IMG#erl_image { attributes = As1},
+ RowFun,St0,As);
+ Error ->
+ Error
+ end;
+ terminator ->
+ {error, bad_app_block};
+ Error ->
+ Error
+ end.
+
+%%
+%% Read One block
+%% return
+%% {ok, Block}
+%% terminator
+%% | {error,Reason}
+%%
+%%
+%%
+read_block(Fd) ->
+ case file:read(Fd, 1) of
+ {ok, <<0>>} ->
+ terminator;
+ {ok, <<Size>>} ->
+ file:read(Fd, Size);
+ Error ->
+ Error
+ end.
+
+
+%%
+%% Read a list of blocks
+%%
+read_blocks(Fd) ->
+ read_blocks(Fd,<<>>).
+
+read_blocks(Fd,Acc) ->
+ case read_block(Fd) of
+ {ok,Bin} -> read_blocks(Fd,<<Acc/binary,Bin/binary>>);
+ terminator -> {ok, Acc};
+ Error -> Error
+ end.
+
+
+
+read_palette(_Fd, 0, _Pixel) ->
+ undefined;
+read_palette(Fd, 1, Pixel) ->
+ Sz = (1 bsl Pixel),
+ case file:read(Fd, Sz*3) of
+ {ok, Bin} ->
+ rd_palette(Bin, [], Sz)
+ end.
+
+
+rd_palette(_Bin, Map, 0) ->
+ reverse(Map);
+rd_palette(<<R:8,G:8,B:8, Bin/binary>>, Map, I) ->
+ rd_palette(Bin, [{R,G,B} | Map], I-1).
+
+
+
+write(Fd, IMG) ->
+ write_info(Fd, IMG),
+ Palette = IMG#erl_image.palette,
+ Background = attribute('Background',IMG#erl_image.attributes,0),
+ AspectRatio = attribute('AspectRatio', IMG#erl_image.attributes,0),
+ if list(Palette) ->
+ PLen = length(Palette),
+ ColorRes = if PLen > 0, PLen =< 256 ->
+ trunc(math:log(PLen)/math:log(2))+1;
+ PLen > 0 ->
+ 8;
+ true ->
+ 1
+ end,
+ Map = 1,
+ Cr = ColorRes - 1,
+ Sort = 0,
+ Pix = ColorRes - 1,
+ file:write(Fd, <<Map:1, Cr:3, Sort:1, Pix:3>>),
+ file:write(Fd, <<Background:8, AspectRatio:8>>),
+ write_palette(Fd, IMG#erl_image.palette, Pix+1);
+ true ->
+ Map = 0,
+ Cr = 0,
+ Sort = 0,
+ Pix = 0,
+ file:write(Fd, <<Map:1, Cr:3, Sort:1, Pix:3>>),
+ file:write(Fd, <<Background:8, AspectRatio:8>>)
+ end,
+ write_data(Fd, IMG),
+ file:write(Fd, <<?TRAILER>>).
+
+
+write_palette(Fd, Map, Pixel) ->
+ wr_palette(Fd, Map, (1 bsl Pixel)).
+
+wr_palette(_Fd, _, 0) -> ok;
+wr_palette(Fd, [{R,G,B}|Map], I) ->
+ file:write(Fd, <<R:8, G:8, B:8>>),
+ wr_palette(Fd, Map, I-1);
+wr_palette(Fd, [], I) ->
+ file:write(Fd, <<0:8, 0:8, 0:8>>),
+ wr_palette(Fd, [], I-1).
+
+write_data(Fd, IMG) ->
+ write_pixmaps(Fd, IMG, IMG#erl_image.pixmaps).
+
+write_pixmaps(Fd, IMG, [Pm|Pms]) ->
+ DisposalMethod = attribute('DisposalMethod',Pm#erl_pixmap.attributes, 0),
+ UserInput = attribute('UserInput', Pm#erl_pixmap.attributes, 0),
+ DelayTime = attribute('DelayTime', Pm#erl_pixmap.attributes, 0),
+ Transparent = attribute('Transparent', Pm#erl_pixmap.attributes, 0),
+ TransparentColor = attribute('TransparentColor',
+ Pm#erl_pixmap.attributes, 0),
+ file:write(Fd, <<?EXTENSION, ?CTL_EXTENSION>>),
+ write_blocks(Fd, <<0:3, DisposalMethod:3,
+ UserInput:1, Transparent:1,
+ DelayTime:16/unsigned-little,
+ TransparentColor:8>>),
+ write_image(Fd, Pm),
+ write_pixmaps(Fd, IMG, Pms);
+write_pixmaps(_Fd, _IMG, []) ->
+ ok.
+
+
+write_image(Fd, Pm) ->
+ file:write(Fd, <<?IMAGE>>),
+ file:write(Fd,
+ <<(Pm#erl_pixmap.left):16/little,
+ (Pm#erl_pixmap.top):16/little,
+ (Pm#erl_pixmap.width):16/little,
+ (Pm#erl_pixmap.height):16/little>>),
+ Palette = Pm#erl_pixmap.palette,
+ Interlaced = attribute('Interlaced', Pm#erl_pixmap.attributes, 0),
+ %% Special code for none compressed data!!!
+ Inline = attribute('Inline', Pm#erl_pixmap.attributes, 0),
+ if list(Palette) ->
+ PLen = length(Palette),
+ ColorRes = if PLen > 0, PLen =< 256 ->
+ trunc(math:log(PLen)/math:log(2))+1;
+ PLen > 0 ->
+ 8;
+ true ->
+ 1
+ end,
+ Sort = 0,
+ Pix = ColorRes - 1,
+ Map = 1,
+ file:write(Fd, <<Map:1, Interlaced:1, Sort:1, 0:2, Pix:3>>),
+ write_palette(Fd, Palette, Pix+1);
+ true ->
+ Sort = 0,
+ Pix = 0,
+ Map = 0,
+ file:write(Fd, <<Map:1, Interlaced:1, Sort:1, 0:2, Pix:3>>)
+ end,
+ write_pixels(Fd,
+ Pm#erl_pixmap.pixels,
+ Pm#erl_pixmap.width,
+ Pm#erl_pixmap.height, Interlaced, Inline).
+
+write_pixels(Fd, Pixels, Width, Height, Interlaced, Inline) ->
+ Bin = collect_pixels(Pixels, Width, Height, Interlaced),
+ {LZWCodeSize, Bin1} =
+ if Inline == 1 ->
+ %% FIXME: check that all pixels are 7 bit !!!!!
+ {7,<<128, Bin/binary, 129>>};
+ true ->
+ lzw:compress_gif(Bin)
+ end,
+ ?dbg("compress: orig_size=~w, size=~w codesize=~w\n",
+ [size(Bin), size(Bin1), LZWCodeSize]),
+ file:write(Fd, <<LZWCodeSize>>),
+ write_blocks(Fd, Bin1).
+
+%%
+%% Fixme check that all rows are present and
+%% implement interlaced order
+%%
+collect_pixels(Rows, Width, Height, Interlaced) ->
+ SortedRows = lists:sort(Rows),
+ if Interlaced == 1 ->
+ collect_interlaced(SortedRows,Width,Height,[],[],[],[]);
+ true ->
+ collect_raw(SortedRows,Width,Height,[])
+ end.
+
+collect_raw([{Ri,Row} | Rows], Width, Height,Acc) when Ri < Height ->
+ Sz = size(Row),
+ R = if Sz > Width ->
+ %% remove pixels
+ <<Bin:Width/binary, _/binary>> = Row,
+ Bin;
+ Sz < Width ->
+ %% add pixels
+ <<Row/binary,
+ (list_to_binary(lists:duplicate(Width-Sz,0)))/binary>>;
+ true ->
+ Row
+ end,
+ collect_raw(Rows, Width, Height, [R | Acc]);
+collect_raw([{_Ri,_Row} | Rows], Width, Height, Acc) ->
+ %% ignore line out of range
+ collect_raw(Rows, Width, Height, Acc);
+collect_raw([], _Width, _Height, Acc) ->
+ list_to_binary(reverse(Acc)).
+
+collect_interlaced([{Ri,Row}|Rows],Width,Height,R1,R2,R3,R4) ->
+ case Ri band 7 of
+ 0 -> collect_interlaced(Rows,Width,Height,[Row|R1],R2,R3,R4);
+ 1 -> collect_interlaced(Rows,Width,Height,R1,R2,R3,[Row|R4]);
+ 2 -> collect_interlaced(Rows,Width,Height,R1,R2,[Row|R3],R4);
+ 3 -> collect_interlaced(Rows,Width,Height,R1,R2,R3,[Row|R4]);
+ 4 -> collect_interlaced(Rows,Width,Height,R1,[Row|R2],R3,R4);
+ 5 -> collect_interlaced(Rows,Width,Height,R1,R2,R3,[Row|R4]);
+ 6 -> collect_interlaced(Rows,Width,Height,R1,R2,[Row|R3],R4);
+ 7 -> collect_interlaced(Rows,Width,Height,R1,R2,R3,[Row|R4])
+ end;
+collect_interlaced([],_Width,_Height,R1,R2,R3,R4) ->
+ list_to_binary([reverse(R1),reverse(R2),reverse(R3),reverse(R4)]).
+
+
+
+write_blocks(Fd, Bin) ->
+ write_blocks(Fd, Bin, 0, size(Bin)).
+
+write_blocks(Fd, Bin, Pos, Size) ->
+ Sz = Size - Pos,
+ if Sz > 255 ->
+ <<_:Pos/binary, Block:255/binary, _/binary>> = Bin,
+ file:write(Fd, <<255, Block/binary>>),
+ write_blocks(Fd, Bin, Pos+255, Size);
+ true ->
+ <<_:Pos/binary, Block:Sz/binary, _/binary>> = Bin,
+ file:write(Fd, <<Sz, Block/binary>>),
+ file:write(Fd, <<0>>)
+ end.
+
+
+read_pixels(Fd,Pix0,RowFun,St0,Width,Height,Interlaced) ->
+ case file:read(Fd, 1) of
+ {ok, <<LZWCodeSize>>} ->
+ case read_image(Fd,LZWCodeSize,Width,Height) of
+ {ok,Data} ->
+ case Interlaced of
+ 1 ->
+ interlaced_data(Data,Pix0,RowFun,St0,Width,Height);
+ 0 ->
+ raw_data(Data,Pix0,RowFun,St0,0,Width)
+ end;
+ Error ->
+ Error
+ end;
+ Error ->
+ Error
+ end.
+
+read_image(Fd, LZWCodeSize, _Width, _Height) ->
+ case read_blocks(Fd) of
+ {ok,Bin} ->
+ ?dbg("LZWCodeSize=~p compressed=~p\n", [LZWCodeSize, size(Bin)]),
+ {ok,lzw:decompress_gif(Bin, LZWCodeSize)};
+ Error ->
+ Error
+ end.
+
+
+%%
+%% Read raw data
+%%
+raw_data(Bin,Pix,RowFun,St0,Ri,Width) ->
+ case Bin of
+ <<Row:Width/binary, Bin1/binary>> ->
+ St1 = RowFun(Pix,Row,Ri,St0),
+ raw_data(Bin1,Pix,RowFun,St1,Ri+1,Width);
+ <<>> ->
+ {ok, Pix#erl_pixmap { pixels = St0 }}
+ end.
+
+%% Read interlaced data
+%%
+%% 0 R1a
+%% 1 R4a
+%% 2 R3a
+%% 3 R4b
+%% 4 R2a
+%% 5 R4c
+%% 6 R3b
+%% 7 R4d
+%% ...
+
+interlaced_data(Bin,Pix,RowFun,St0,Width,Height) ->
+ {St1,Bin1} = raster_data(Bin, Pix,RowFun,St0, Height,0,8, Width),
+ {St2,Bin2} = raster_data(Bin1,Pix,RowFun,St1, Height,4,8, Width),
+ {St3,Bin3} = raster_data(Bin2,Pix,RowFun,St2, Height,2,4, Width),
+ {St4,_Bin4} = raster_data(Bin3,Pix,RowFun,St3, Height,1,2, Width),
+ {ok, Pix#erl_pixmap{ pixels = St4 }}.
+
+raster_data(Bin,_Pix,_RowFun,St,Height,Ri,_Rs,_Width) when Ri >= Height ->
+ {St, Bin};
+raster_data(Bin,Pix,RowFun,St0,Height,Ri,Rs,Width) ->
+ <<Row:Width/binary, Bin1/binary>> = Bin,
+ St1 = RowFun(Pix,Row,Ri,St0),
+ raster_data(Bin1,Pix,RowFun,St1,Height,Ri+Rs,Rs,Width).
+
+
+attribute(Name, List, Default) ->
+ case lists:keysearch(Name, 1, List) of
+ false ->
+ Default;
+ {value,{_,Value}} ->
+ Value
+ end.
+
+
+
+
+
+
280 src/image_jpeg.erl
@@ -0,0 +1,280 @@
+%%% File : img_jpg.erl
+%%% Author : Tony Rogvall <tony@bix.hemma.se>
+%%% Description : JPG image processing (Exif/JPG files)
+%%% Created : 5 Mar 2003 by Tony Rogvall <tony@bix.hemma.se>
+
+-module(image_jpeg).
+
+-include("erl_img.hrl").
+
+-include("jpeg.hrl").
+-include("tiff.hrl").
+-include("exif.hrl").
+
+-include("api.hrl").
+%% -define(debug, true).
+-include("dbg.hrl").
+
+%% YCbCr => RGB
+-define(R(Y,Cb,Cr), (Y + (1.402)*((Cr)-128))).
+-define(G(Y,Cb,Cr), (Y - 0.34414*((Cb)-128) - 0.71414*((Cr)-128))).
+-define(B(Y,Cb,Cr), (Y + 1.772*(Cb-128))).
+
+%% RGB => YCbCr
+-define(Y(R,G,B), (0.299*(R) + 0.587*(G) + 0.114*(B))).
+-define(Cb(R,G,B), (0.1687*(R) - 0.3313*(G) + 0.5*(B) + 128)).
+-define(Cr(R,G,B), (0.5*R - 0.4187*(G) - 0.0813*(B) + 128)).
+
+
+
+magic(<<?M_SOI:16,?M_APP1:16,Len:16,"Exif",0,0,_/binary>>) -> true;
+magic(<<?M_SOI:16,?M_JFIF:16,Len:16,"JFIF",_,_,_/binary>>) -> true;
+magic(_) -> false.
+
+mime_type() -> "image/jpeg".
+
+extensions() -> [".jpeg", ".jpg"].
+
+
+read_info(Fd) ->
+ case file:read(Fd, 2) of
+ {ok, <<?M_SOI:16>>} ->
+ read_sections(Fd,
+ #erl_image { type = ?MODULE,
+ order = upper_left
+ });
+ {ok,_} ->
+ {error, bad_magic};
+ Error -> Error
+ end.
+
+write_info(Fd, IMG) ->
+ ok.
+
+
+read(Fd,IMG) ->
+ {ok,IMG}.
+
+read(Fd,IMG,RowFun,St0) ->
+ {ok,IMG}.
+
+write(Fd,IMG) ->
+ ok.
+
+
+read_sections(Fd, IMG) ->
+ case file:read(Fd, 4) of
+ eof ->
+ {ok,IMG};
+ {ok,<<Marker:16,Len:16>>} ->
+ read_section(Fd,Marker,Len-2,IMG);
+ {ok,_} ->
+ {error, bad_file};
+ Error -> Error
+ end.
+
+read_section(Fd,Marker,Len,IMG) ->
+ if Marker == ?M_SOS -> {ok,IMG};
+ Marker == ?M_EOI -> {ok,IMG};
+ Marker == ?M_COM ->
+ case file:read(Fd, Len) of
+ {ok,Bin} ->
+ read_sections(Fd, IMG#erl_image {comment=
+ binary_to_list(Bin)});
+ Error ->
+ {error, bad_file}
+ end;
+ Marker == ?M_APP1 ->
+ case file:read(Fd, Len) of
+ {ok,<<"Exif",0,0,Bin/binary>>} ->
+ read_sections(Fd, process_exif(Bin,IMG));
+ {ok,_} ->
+ read_sections(Fd, IMG)
+ end;
+ Marker == ?M_SOF0;
+ Marker == ?M_SOF1;
+ Marker == ?M_SOF2;
+ Marker == ?M_SOF3;
+ Marker == ?M_SOF5;
+ Marker == ?M_SOF6;
+ Marker == ?M_SOF7;
+ Marker == ?M_SOF9;
+ Marker == ?M_SOF10;
+ Marker == ?M_SOF11;
+ Marker == ?M_SOF13;
+ Marker == ?M_SOF14;
+ Marker == ?M_SOF15 ->
+ case file:read(Fd, Len) of
+ {ok,Bin} ->
+ read_sections(Fd, process_sofn(Bin,IMG));
+ Error ->
+ Error
+ end;
+ true ->
+ file:position(Fd, {cur,Len}),
+ read_sections(Fd, IMG)
+ end.
+
+process_sofn(<<Depth:8,Height:16,Width:16,Components:8,Bin/binary>>, IMG) ->
+ IMG#erl_image { depth = Depth,
+ height = Height,
+ width = Width }.
+
+%% Maker OLYMP
+collect_olymp(Fd, T, St) ->
+ Key = erl_img:hex16(T#tiff_entry.tag),
+ ?dbg("OLYMP(~s) ~p ~p ~p\n",
+ [T#tiff_entry.ifd,Key,T#tiff_entry.type, T#tiff_entry.value]),
+ St.
+
+%% Maker Nikon
+collect_nikon(Fd, T, St) ->
+ Key = erl_img:hex16(T#tiff_entry.tag),
+ ?dbg("Nikon(~s) ~p ~p ~p\n",
+ [T#tiff_entry.ifd,Key,T#tiff_entry.type, T#tiff_entry.value]),
+ St.
+
+%% Maker FUJIFILM
+collect_fujifilm(Fd, T, St) ->
+ Key = erl_img:hex16(T#tiff_entry.tag),
+ ?dbg("Fujifilm(~s) ~p ~p ~p\n",
+ [T#tiff_entry.ifd,Key,T#tiff_entry.type, T#tiff_entry.value]),
+ St.
+
+%% Maker Sony DSC
+collect_sony(Fd, T, St) ->
+ Key = erl_img:hex16(T#tiff_entry.tag),
+ ?dbg("Sony(~s) ~p ~p ~p\n",
+ [T#tiff_entry.ifd,Key,T#tiff_entry.type, T#tiff_entry.value]),
+ St.
+
+%% Maker other
+collect_other(Fd, T, St) ->
+ Key = erl_img:hex16(T#tiff_entry.tag),
+ ?dbg("Maker(~s) ~p ~p ~p\n",
+ [T#tiff_entry.ifd,Key,T#tiff_entry.type, T#tiff_entry.value]),
+ St.
+
+collect_maker(Fd, T, St) ->
+ {ok, St}.
+
+collect_maker_fixme(Fd, T, St) ->
+ ?dbg("Tif entry=~p\n", [T]),
+ MakerBin = T#tiff_entry.value,
+ case MakerBin of
+ <<"OLYMP",0,1,0,_/binary>> ->
+ image_tiff:scan_ifd(Fd,
+ [$0,$:|T#tiff_entry.ifd],
+ T#tiff_entry.offs+8,
+ T#tiff_entry.endian,
+ fun collect_olymp/3, St);
+ <<"Nikon",0,1,0,_/binary>> ->
+ image_tiff:scan_ifd(Fd,
+ [$0,$:|T#tiff_entry.ifd],
+ T#tiff_entry.offs+8,
+ T#tiff_entry.endian,
+ fun collect_nikon/3, St);
+ <<"SONY DSC ",0,0,0,_/binary>> ->
+ %% NOT working - what is SONY doing ?
+ image_tiff:scan_ifd(Fd,
+ [$0,$:|T#tiff_entry.ifd],
+ T#tiff_entry.offs+14,
+ T#tiff_entry.endian,
+ fun collect_sony/3, St);
+ <<"FUJIFILM",Offset:32/little>> ->
+ image_tiff:scan_ifd_bin(MakerBin,
+ [$0,$:|T#tiff_entry.ifd],
+ Offset, little,
+ fun collect_fujifilm/3, St);
+ _ ->
+ image_tiff:scan_ifd(Fd,
+ [$0,$:|T#tiff_entry.ifd],
+ T#tiff_entry.offs+8,
+ T#tiff_entry.endian,
+ fun collect_other/3, St)
+ end.
+
+
+collect_exif(Fd, T, St) ->
+ Key = exif:decode_tag(T#tiff_entry.tag),
+ ?dbg("EXIF(~s) ~p ~p ~p\n",
+ [T#tiff_entry.ifd,Key,T#tiff_entry.type, T#tiff_entry.value]),
+ case T#tiff_entry.tag of
+ ?ExifInteroperabilityOffset ->
+ [Offset] = T#tiff_entry.value,
+ %% could be handle by a collect_interop?
+ case image_tiff:scan_ifd(Fd, [$0,$.|T#tiff_entry.ifd],
+ Offset, T#tiff_entry.endian,
+ fun collect_exif/3, St) of
+ {ok, St1} ->
+ St1;
+ Error ->
+ St
+ end;
+ ?MakerNote ->
+ case collect_maker(Fd, T, St) of
+ {ok,St1} ->
+ St1;
+ Error ->
+ St
+ end;
+ _ ->
+ St
+ end.
+
+
+%% Image info collector functions
+collect_tiff(Fd, T, St) ->
+ Key = image_tiff:decode_tag(T#tiff_entry.tag),
+ ?dbg("TIFF(~s) ~p ~p ~p\n",
+ [T#tiff_entry.ifd,Key,T#tiff_entry.type, T#tiff_entry.value]),
+ case T#tiff_entry.tag of
+ ?ImageWidth ->
+ [Width] = T#tiff_entry.value,
+ St#erl_image { width = Width };
+ ?ImageLength ->
+ [Length] = T#tiff_entry.value,
+ St#erl_image { height = Length };
+ ?BitsPerSample ->
+ Bs = T#tiff_entry.value,
+ St#erl_image { depth = lists:sum(Bs) };
+ ?ImageDescription ->
+ [Value] = T#tiff_entry.value,
+ St#erl_image { comment = Value };
+ ?DateTime ->
+ [Value] = T#tiff_entry.value,
+ case string:tokens(Value, ": ") of
+ [YYYY,MM,DD,H,M,S] ->
+ DateTime = {{list_to_integer(YYYY),
+ list_to_integer(MM),
+ list_to_integer(DD)},
+ {list_to_integer(H),
+ list_to_integer(M),
+ list_to_integer(S)}},
+ St#erl_image { itime = DateTime};
+ _ ->
+ St
+ end;
+ ?ExifOffset ->
+ [Offset] = T#tiff_entry.value,
+ case image_tiff:scan_ifd(Fd, [$0,$.|T#tiff_entry.ifd],
+ Offset, T#tiff_entry.endian,
+ fun collect_exif/3, St) of
+ {ok, St1} ->
+ St1;
+ Error ->
+ St
+ end;
+ _ ->
+ Value = T#tiff_entry.value,
+ As = St#erl_image.attributes,
+ St#erl_image { attributes = [{Key,Value}|As]}
+ end.
+
+process_exif(Bin, IMG) ->
+ case image_tiff:scan_binary(Bin, fun collect_tiff/3, IMG) of
+ {ok, IMG1} ->
+ IMG1;
+ Error ->
+ IMG
+ end.
454 src/image_png.erl
@@ -0,0 +1,454 @@
+%%% File : image_png.erl
+%%% Author : Tony Rogvall <tony@bix.hemma.se>
+%%% Description : PNG Files
+%%% Created : 5 Mar 2003 by Tony Rogvall <tony@bix.hemma.se>
+
+-module(image_png).
+
+-include("erl_img.hrl").
+-include("api.hrl").
+
+-include("dbg.hrl").
+
+-import(lists, [reverse/1]).
+-import(erl_img, [attribute/3, set_attribute/3]).
+-export([filter/4]).
+
+-define(MAGIC, 137,$P,$N,$G,$\r,$\n,26,$\n).
+
+-define(IHDR, "IHDR"). %% image header
+-define(PLTE, "PLTE"). %% palette
+-define(IDAT, "IDAT"). %% image data
+-define(IEND, "IEND"). %% image trailer
+
+-define(bKGD, "bKGD"). %% background color
+-define(cHRM, "cHRM"). %% primary chromaticites and white point
+-define(gAMA, "gAMA"). %% Image gamma
+-define(hIST, "hIST"). %% Image histogram
+-define(pHYs, "pHYs"). %% Physical pixel dimensions
+-define(sBIT, "sBIT"). %% Significant bits
+-define(tEXt, "tEXt"). %% Textual data
+-define(tIME, "tIME"). %% Image last modification time
+-define(tRNS, "tRNS"). %% Transparency
+-define(zTXt, "zTXt"). %% Compressed textual data
+
+magic(<<?MAGIC, _/binary>>) -> true;
+magic(_) -> false.
+
+mime_type() -> "image/png".
+
+extensions() -> [ ".png" ].
+
+read_info(Fd) ->
+ case file:read(Fd, 8) of
+ {ok, << ?MAGIC >> } ->
+ scan_info(Fd, #erl_image { type = ?MODULE }, true);
+ {ok, _} ->
+ {error, bad_magic};
+ Error ->
+ Error
+ end.
+
+scan_info(Fd, IMG, First) ->
+ case read_chunk_hdr(Fd) of
+ {ok, Length, Type} ->
+ scan_info(Fd, IMG, First, Type, Length);
+ Error ->
+ Error
+ end.
+
+scan_info(Fd, IMG, true, ?IHDR, Length) ->
+ case read_chunk_crc(Fd,Length) of
+ {ok, <<Width:32, Height:32, BitDepth:8,
+ ColorType:8, CompressionMethod:8,
+ FilterMethod:8, InterlaceMethod:8, _/binary >>} ->
+ scan_info(Fd, IMG#erl_image {
+ width = Width,
+ height = Height,
+ depth = BitDepth,
+ format = format(ColorType,BitDepth),
+ order = left_to_right,
+ attributes =
+ [ {'ColorType', ColorType},
+ {'Compression', CompressionMethod},
+ {'Filter', FilterMethod },
+ {'Interlace', InterlaceMethod }]}, false);
+ Error -> Error
+ end;
+scan_info(Fd, IMG, false, ?tEXt, Length) ->
+ case read_chunk_crc(Fd, Length) of
+ {ok, Bin} ->
+ scan_info(Fd, update_txt(IMG, Bin), false);
+ Error -> Error
+ end;
+scan_info(Fd, IMG, false, ?zTXt, Length) ->
+ case read_chunk_crc(Fd, Length) of
+ {ok, CBin} ->
+ Bin = zlib:uncompress(CBin),
+ scan_info(Fd, update_txt(IMG, Bin), false);
+ Error -> Error
+ end;
+scan_info(Fd, IMG, false, ?bKGD, Length) ->
+ CT = attribute(IMG, 'ColorType', undefined),
+ case read_chunk_crc(Fd, Length) of
+ {ok, <<Index:8>>} when CT==3 ->
+ scan_info(Fd, set_attribute(IMG, 'Background', Index), false);
+ {ok, <<Gray:16>>} when CT==0; CT==4 ->
+ scan_info(Fd, set_attribute(IMG, 'Background', Gray), false);
+ {ok, <<R:16,G:16,B:16>>} when CT==2; CT==6 ->
+ scan_info(Fd, set_attribute(IMG, 'Background', {R,G,B}), false);
+ {ok, _Data} ->
+ ?dbg("bKGD other=~p\n", [_Data]),
+ scan_info(Fd, IMG, false);
+ Error -> Error
+ end;
+scan_info(Fd, IMG, false, ?tIME, Length) ->
+ case read_chunk_crc(Fd, Length) of
+ {ok, <<Year:16, Mon:8, Day:8, H:8, M:8, S:8>>} ->
+ scan_info(Fd, IMG#erl_image { mtime = {{Year,Mon,Day},
+ {H,M,S}} }, false);
+ {ok, _Data} ->
+ ?dbg("tIME other=~p\n", [_Data]),
+ scan_info(Fd, IMG, false);
+ Error -> Error
+ end;
+scan_info(Fd, IMG, false, ?pHYs, Length) ->
+ case read_chunk_crc(Fd, Length) of
+ {ok, <<X:32, Y:32, _Unit:8>>} ->
+ scan_info(Fd, set_attribute(IMG,'Physical',{X,Y,meter}),false);
+ {ok, _Data} ->
+ ?dbg("pHYs other=~p\n", [_Data]),
+ scan_info(Fd, IMG, false);
+ Error -> Error
+ end;
+scan_info(_Fd, IMG, false, ?IEND, 0) ->
+ {ok, IMG};
+scan_info(Fd, IMG, false, _Type, Length) ->
+ ?dbg("~s skipped=~p\n", [_Type,Length]),
+ skip_chunk(Fd, Length),
+ scan_info(Fd, IMG, false).
+
+%% Update txt attributes
+update_txt(IMG, Txt) ->
+ case txt(binary_to_list(Txt), []) of
+ {value,{Key,Value}} ->
+ case Key of
+ 'Comment' ->
+ IMG#erl_image { comment = Value };
+ _ ->
+ As = [{Key,Value} | IMG#erl_image.attributes],
+ IMG#erl_image { attributes = As }
+ end;
+ false ->
+ IMG
+ end.
+
+
+%% determine the erl_image format
+bytes_per_row(gray1,W) -> W div 8;
+bytes_per_row(gray2,W) -> W div 4;
+bytes_per_row(gray4,W) -> W div 2;
+bytes_per_row(gray8,W) -> W;
+bytes_per_row(gray16,W) -> W*2;
+bytes_per_row(r8g8b8,W) -> W*3;
+bytes_per_row(r16g16b16,W) -> W*6;
+bytes_per_row(palette1,W) -> W div 8;
+bytes_per_row(palette2,W) -> W div 4;
+bytes_per_row(palette4,W) -> W div 2;
+bytes_per_row(palette8,W) -> W;
+bytes_per_row(gray8a8,W) -> W*2;
+bytes_per_row(gray16a16,W) -> W*4;
+bytes_per_row(r8g8b8a8,W) -> W*4;
+bytes_per_row(r16g16b16a16,W) -> W*8.
+
+
+bpp(gray1) -> 1;
+bpp(gray2) -> 1;
+bpp(gray4) -> 1;
+bpp(gray8) -> 1;
+bpp(gray16) -> 2;
+bpp(r8g8b8) -> 3;
+bpp(r16g16b16) -> 6;
+bpp(palette1) -> 1;
+bpp(palette2) -> 1;
+bpp(palette4) -> 1;
+bpp(palette8) -> 1;
+bpp(gray8a8) -> 2;
+bpp(gray16a16) -> 4;
+bpp(r8g8b8a8) -> 4;
+bpp(r16g16b16a16) -> 8.
+
+
+format(0, 1) -> gray1;
+format(0, 2) -> gray2;
+format(0, 4) -> gray4;
+format(0, 8) -> gray8;
+format(0, 16) -> gray16;
+format(2, 8) -> r8g8b8;
+format(2, 16) -> r16g16b16;
+format(3, 1) -> palette1;
+format(3, 2) -> palette2;
+format(3, 4) -> palette4;
+format(3, 8) -> palette8;
+format(4, 8) -> gray8a8;
+format(4, 16) -> gray16a16;
+format(6, 8) -> r8g8b8a8;
+format(6, 16) -> r16g16b16a16.
+
+%% process text chunk
+txt([0|Value], RKey) ->
+ {value, {list_to_atom(reverse(RKey)), Value}};
+txt([C|Cs], RKey) ->
+ txt(Cs,[C|RKey]);
+txt([], _) ->
+ false.
+
+%% read palette
+plte(<<R,G,B, Data/binary>>) ->
+ [{R*255,G*255,B*255} | plte(Data)];
+plte(<<>>) -> [].
+
+%% IMPLEMENT This:
+write_info(_Fd, _IMG) ->
+ ok.
+
+
+read(Fd, IMG) ->
+ read(Fd, IMG,
+ fun(_, Row, Ri, St) ->
+ ?dbg("png: load row ~p\n", [Ri]),
+ [{Ri,Row}|St] end,
+ []).
+
+
+read(Fd, IMG, RowFun, St0) ->
+ file:position(Fd, 8), %% skip magic
+ Z = zlib:open(),
+ zlib:inflateInit(Z),
+ Resp = read_image(Fd, [], undefined, Z),
+ zlib:close(Z),
+ case Resp of
+ {ok, Binary, Palette} ->
+ {ok,Pixmap} = create_pixmap(IMG, Binary, Palette, RowFun, St0),
+ {ok, IMG#erl_image { pixmaps = [Pixmap],
+ palette = Palette }};
+ Error -> Error
+ end.
+
+create_pixmap(IMG, Bin, Palette, RowFun, St0) ->
+ Pix0 = #erl_pixmap { width = IMG#erl_image.width,
+ height = IMG#erl_image.height,
+ palette = Palette,
+ format = IMG#erl_image.format },
+ Bpp = bpp(IMG#erl_image.format),
+ BytesPerRow = bytes_per_row(IMG#erl_image.format,IMG#erl_image.width),
+ raw_data(Bin,Pix0,RowFun,St0,0,Bpp,BytesPerRow).
+
+
+raw_data(Bin,Pix,RowFun,St0,Ri,Bpp,Width) ->
+ case Bin of
+ <<Filter:8,Row:Width/binary,Bin1/binary>> ->
+ Prior = case St0 of
+ [] -> <<>>;
+ [{_,Row0}|_] -> Row0
+ end,
+ Row1 = filter(Filter,Bpp,Row,Prior), %% Filter method=0 assumed
+ St1 = RowFun(Pix,Row1,Ri,St0),
+ raw_data(Bin1,Pix,RowFun,St1,Ri+1,Bpp,Width);
+ _ ->
+ {ok, Pix#erl_pixmap { pixels = St0 }}
+ end.
+
+filter(0,_,Row,_Prior) -> Row;
+filter(1, Bpp, Row, Prior) -> filter_sub(Row,Prior,Bpp);
+filter(2, Bpp, Row,Prior) -> filter_up(Row,Prior,Bpp);
+filter(3, Bpp, Row,Prior) -> filter_avg(Row,Prior,Bpp);
+filter(4, Bpp, Row,Prior) -> filter_paeth(Row,Prior,Bpp).
+
+%%
+%% Raw(x) = Sub(x) + Raw(x-bpp) [ Sub(x) = Raw(x) - Raw(x-bpp) ]
+%%
+filter_sub(Sub,_Prior,Bpp) ->
+ Rn = lists:duplicate(Bpp, 0),
+ Rm = [],
+ filter_sub(Sub, 0, size(Sub), [], Rn, Rm).
+
+filter_sub(_Sub, X, X, Acc, _, _) ->
+ list_to_binary(reverse(Acc));
+filter_sub(Sub, X, N, Acc, [Rxb|Rn], Rm) ->
+ <<_:X/binary, Sx:8, _/binary>> = Sub,
+ Rx = (Sx + Rxb) band 16#ff,
+ if Rn == [] ->
+ filter_sub(Sub,X+1,N,[Rx|Acc],reverse([Rx|Rm]),[]);
+ true ->
+ filter_sub(Sub,X+1,N,[Rx|Acc],Rn,[Rx|Rm])
+ end.
+%%
+%% Raw(x) = Up(x) + Prior(x) [ Up(x) = Raw(x) - Prior(x) ]
+%%
+filter_up(Up, Prior, _Bpp) ->
+ filter_up(Up, Prior, 0, size(Up), []).
+
+filter_up(_Up, _Prior, X, X, Acc) ->
+ list_to_binary(reverse(Acc));
+filter_up(Up, Prior, X, N, Acc) ->
+ <<_:X/binary,Ux:8,_/binary>> = Up,
+ Px = case Prior of
+ <<_:X/binary,Pi,_/binary>> -> Pi;
+ _ -> 0
+ end,
+ Rx = (Ux + Px) band 16#ff,
+ filter_up(Up,Prior,X+1,N,[Rx|Acc]).
+
+%%
+%% Raw(x) = Avarage(x) + floor((Raw(x-bpp)+Prior(x))/2)
+%% [ Avarage(x) = Raw(x) - floor((Raw(x-bpp)+Prior(x))/2) ]
+%%
+
+filter_avg(Avg, Prior,Bpp) ->
+ Rn = lists:duplicate(Bpp, 0),
+ Rm = [],
+ filter_avg(Avg, Prior, 0, size(Avg), [], Rn, Rm).
+
+filter_avg(_Avg,_Prior, X, X, Acc, _, _) ->
+ list_to_binary(reverse(Acc));
+filter_avg(Avg, Prior, X, N, Acc, [Rxb|Rn], Rm) ->
+ <<_:X/binary, Ax:8, _/binary>> = Avg,
+ Px = case Prior of
+ <<_:X/binary,Pi,_/binary>> -> Pi;
+ _ -> 0
+ end,
+ Rx = (Ax + ((Rxb+Px) div 2)) band 16#ff,
+ if Rn == [] ->
+ filter_avg(Avg,Prior,X+1,N,[Rx|Acc],reverse([Rx|Rm]),[]);
+ true ->
+ filter_avg(Avg,Prior,X+1,N,[Rx|Acc],Rn,[Rx|Rm])
+ end.
+
+%%
+%% Paeth(x) = Raw(x) -
+%% PaethPredictor(Raw(x-bpp),Prior(x),Prior(x-bpp))
+%%
+%% Raw(x) = Paeth(x) + PaethPredictor(Raw(x-bpp),Prior(x),Prior(x-bpp))
+%%
+filter_paeth(Pae,Prior,Bpp) ->
+ Pn = Rn = lists:duplicate(Bpp, 0),
+ Pm = Rm = [],
+ filter_pae(Pae, Prior, 0, size(Pae), [], Rn, Rm, Pn, Pm).
+
+
+filter_pae(_Pae, _Prior, X, X, Acc, _Rn, _Rm, _Pn, _Pm) ->