aboutsummaryrefslogtreecommitdiffstats
path: root/lib/percept/src/egd_render.erl
diff options
context:
space:
mode:
Diffstat (limited to 'lib/percept/src/egd_render.erl')
-rw-r--r--lib/percept/src/egd_render.erl709
1 files changed, 709 insertions, 0 deletions
diff --git a/lib/percept/src/egd_render.erl b/lib/percept/src/egd_render.erl
new file mode 100644
index 0000000000..f5e32c2a0f
--- /dev/null
+++ b/lib/percept/src/egd_render.erl
@@ -0,0 +1,709 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2008-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+
+%%
+%% @doc egd_render
+%%
+
+-module(egd_render).
+
+-export([binary/1, binary/2]).
+-export([eps/1]).
+-compile(inline).
+
+-include("egd.hrl").
+-define('DummyC',0).
+
+binary(Image) -> binary(Image, opaque).
+
+binary(Image, Type) ->
+ parallel_binary(precompile(Image),Type).
+
+parallel_binary(Image = #image{ height = Height },Type) ->
+ case lists:min([erlang:system_info(schedulers), Height]) of
+ 1 ->
+ % if the height or the number of schedulers is 1
+ % do the scanlines in this process.
+ W = Image#image.width,
+ Bg = Image#image.background,
+ Os = Image#image.objects,
+ erlang:list_to_binary(lists:map(fun
+ (Y) -> scanline(Y, Os, {0,0,W - 1, Bg}, Type)
+ end, lists:seq(1, Height)));
+ Np ->
+ Pids = start_workers(Np, Type),
+ Handler = handle_workers(Height, Pids),
+ init_workers(Image, Handler, Pids),
+ Res = receive_binaries(Height),
+ finish_workers(Pids),
+ Res
+ end.
+
+start_workers(Np, Type) -> start_workers(Np, Type, []).
+start_workers( 0, _, Pids) -> Pids;
+start_workers(Np, Type, Pids) when Np > 0 ->
+ start_workers(Np - 1, Type, [spawn_link(fun() -> worker(Type) end)|Pids]).
+
+worker(Type) ->
+ receive
+ {Pid, data, #image{ objects = Os, width = W, background = Bg }} ->
+ worker(Os, W, Bg, Type, Pid)
+ end.
+
+worker(Objects, Width, Bg, Type, Collector) ->
+ receive
+ {Pid, scan, {Ys, Ye}} ->
+ lists:foreach(fun
+ (Y) ->
+ Bin = erlang:list_to_binary(scanline(Y, Objects, {0,0,Width - 1, Bg}, Type)),
+ Collector ! {scan, Y, Bin}
+ end, lists:seq(Ys,Ye)),
+ Pid ! {self(), scan_complete},
+ worker(Objects, Width, Bg, Type, Collector);
+ {Pid, scan, Y} ->
+ Bin = erlang:list_to_binary(scanline(Y, Objects, {0,0,Width - 1, Bg}, Type)),
+ Collector ! {scan, Y, Bin},
+ Pid ! {self(), scan_complete},
+ worker(Objects, Width, Bg, Type, Collector);
+ {_, done} ->
+ ok
+ end.
+
+init_workers(_Image, _Handler, []) -> ok;
+init_workers(Image, Handler, [Pid|Pids]) ->
+ Pid ! {self(), data, Image},
+ Handler ! {Pid, scan_complete},
+ init_workers(Image, Handler, Pids).
+
+handle_workers(H, Pids) -> spawn_link(fun() -> handle_workers(H, H, length(Pids)) end).
+handle_workers(_, 0, _) -> ok;
+handle_workers(H, Hi, Np) when H > 0 ->
+ N = trunc(Hi/(2*Np)),
+ receive
+ {Pid, scan_complete} ->
+ if N < 2 ->
+ Pid ! {self(), scan, Hi},
+ handle_workers(H, Hi - 1, Np);
+ true ->
+ Pid ! {self(), scan, {Hi - N, Hi}},
+ handle_workers(H, Hi - 1 - N, Np)
+ end
+ end.
+
+finish_workers([]) -> ok;
+finish_workers([Pid|Pids]) ->
+ Pid ! {self(), done},
+ finish_workers(Pids).
+
+receive_binaries(H) -> receive_binaries(H, []).
+receive_binaries(0, Bins) -> erlang:list_to_binary(Bins);
+receive_binaries(H, Bins) when H > 0 ->
+ receive
+ {scan, H, Bin} ->
+ receive_binaries(H - 1, [Bin|Bins])
+ end.
+
+
+scanline(Y, Os, {_,_,Width,_}=LSB, Type) ->
+ OLSs = parse_objects_on_line(Y-1, Width, Os),
+ URLSs = resulting_line_spans([LSB|OLSs],Type),
+
+ % FIXME: Can we keep the list sorted instead of sorting it?
+ % sort descending
+ RLSs = lists:reverse(URLSs),
+
+ resulting_scanline(RLSs,Width).
+
+resulting_scanline(RLSs, Width) -> resulting_scanline(RLSs, Width, []).
+resulting_scanline([], _, Scanlines) -> Scanlines;
+resulting_scanline([{_,Xl, Xr, C} | RLSs], Width, Scanlines) ->
+ {R,G,B,_} = rgb_float2byte(C),
+ Scanline = lists:duplicate(trunc(Xr - Xl + 1), <<R:8,G:8,B:8>>),
+ resulting_scanline(RLSs, Width, [Scanline|Scanlines]).
+
+resulting_line_spans(LSs,Type) ->
+ %% Build a list of "transitions" from left to right.
+ Trans = line_spans_to_trans(LSs),
+ %% Convert list of "transitions" to linespans.
+ trans_to_line_spans(Trans,Type).
+
+line_spans_to_trans(LSs) ->
+ line_spans_to_trans(LSs,[],0).
+
+line_spans_to_trans([],Db,_) ->
+ lists:sort(Db);
+line_spans_to_trans([{_,L,R,C}|LSs],Db,Z) ->
+ line_spans_to_trans(LSs,[{{L,Z,start},C},{{R+1,Z,stop},C}|Db],Z+1).
+
+trans_to_line_spans(Trans,Type) ->
+ trans_to_line_spans(simplify_trans(Trans,Type,[],{0.0,0.0,0.0,0.0},[])).
+
+trans_to_line_spans(SimpleTrans) ->
+ trans_to_line_spans1(SimpleTrans,[]).
+
+trans_to_line_spans1([],Spans) ->
+ Spans;
+trans_to_line_spans1([_],Spans) ->
+ Spans;
+trans_to_line_spans1([{L1,_},{L2,C2}|SimpleTrans],Spans) ->
+ %% We are going backwards now...
+ trans_to_line_spans1([{L2,C2}|SimpleTrans],[{?DummyC,L2,L1-1,C2}|Spans]).
+
+simplify_trans([],_,_,_,Acc) ->
+ Acc;
+simplify_trans([{{L,_,_},_}|_] = Trans,Type,Layers,OldC,Acc) ->
+ {NextTrans,RestTrans} =
+ lists:splitwith(fun({{L1,_,_},_}) when L1 == L ->
+ true;
+ (_) ->
+ false
+ end, Trans),
+ {C,NewLayers} = color(NextTrans,Layers,Type,OldC),
+ case OldC of
+ C -> %% No change in color, so transition unnecessary.
+ simplify_trans(RestTrans,Type,NewLayers,OldC,Acc);
+ _ ->
+ simplify_trans(RestTrans,Type,NewLayers,C,[{L,C}|Acc])
+ end.
+
+color(Trans,Layers,Type,OldC) ->
+ case modify_layers(Layers,Trans) of
+ Layers ->
+ {OldC,Layers};
+ NewLayers ->
+ {color(NewLayers,Type),NewLayers}
+ end.
+
+color([],_) -> {0.0,0.0,0.0,0.0};
+color([{_,C}|_],opaque) -> C;
+color(Layers,alpha) -> color1({0,0,0,0},Layers).
+
+color1(Color,[]) -> Color;
+color1(Color,[{_,C}|Layers]) -> color1(blend(Color,C),Layers).
+
+blend(C1,C2) -> alpha_blend(C1,C2).
+
+modify_layers(Layers,[]) -> Layers;
+modify_layers(Layers,[{{_,Z,Op},C}|Trans]) ->
+ modify_layers(case Op of
+ start ->
+ add_layer(Layers,Z,C);
+ stop ->
+ remove_layer(Layers,Z,C)
+ end,
+ Trans).
+
+add_layer([{Z1,_}=H|Layers],Z,C) when Z1 > Z ->
+ [H|add_layer(Layers,Z,C)];
+add_layer(Layers,Z,C) ->
+ [{Z,C}|Layers].
+
+remove_layer(Layers,Z,C) ->
+ Layers -- [{Z,C}].
+
+alpha_blend({R1,G1,B1,A1}, {R2,G2,B2,A2}) ->
+ Beta = A2*(1.0 - A1),
+ A = A1 + Beta,
+ R = R1*A1 + R2*Beta,
+ G = G1*A1 + G2*Beta,
+ B = B1*A1 + B2*Beta,
+ {R,G,B,A}.
+
+parse_objects_on_line(Y, Width, Objects) ->
+ parse_objects_on_line(Y, 1, Width, Objects, []).
+parse_objects_on_line(_Y, _Z, _, [], Out) -> lists:flatten(Out);
+parse_objects_on_line(Y, Z, Width, [O|Os], Out) ->
+ case is_object_on_line(Y, O) of
+ false ->
+ parse_objects_on_line(Y, Z + 1, Width, Os, Out);
+ true ->
+ OLs = object_line_data(Y, Z, O),
+ TOLs = trim_object_line_data(OLs, Width),
+ parse_objects_on_line(Y, Z + 1, Width, Os, [TOLs|Out])
+ end.
+
+trim_object_line_data(OLs, Width) ->
+ trim_object_line_data(OLs, Width, []).
+trim_object_line_data([], _, Out) -> Out;
+trim_object_line_data([{Z, Xl, Xr, C}|OLs], Width, Out) ->
+ if
+ Xl > Width ->
+ trim_object_line_data(OLs, Width, Out);
+ Xr < 0 ->
+ trim_object_line_data(OLs, Width, Out);
+ true ->
+ trim_object_line_data(OLs, Width, [{Z, lists:max([0,Xl]), lists:min([Xr,Width]), C}|Out])
+ end.
+
+% object_line_data
+% In:
+% Y :: index of height
+% Z :: index of depth
+% Object :: image_object()
+% Out:
+% OLs = [{Z, Xl, Xr, Color}]
+% Z = index of height
+% Xl = left X index
+% Xr = right X index
+% Purpose:
+% Calculate the length (start and finish index) of an objects horizontal
+% line given the height index.
+
+object_line_data(Y, Z, Object) -> object_line_data(Y, Z, Object, Object#image_object.type).
+object_line_data(Y, Z, #image_object{ span = {X0, Y0, X1, Y1}, color = C}, rectangle) ->
+ if
+ Y0 =:= Y ; Y1 =:= Y ->
+ [{Z, X0, X1, C}];
+ true ->
+ [{Z, X0, X0, C},
+ {Z, X1, X1, C}]
+ end;
+
+object_line_data(_Y, Z, #image_object{ span = {X0, _, X1, _}, color = C}, filled_rectangle) ->
+ [{Z, X0, X1, C}];
+
+object_line_data(Y, Z, #image_object{ span = {X0,Y0,X1,Y1}, color = C}, filled_ellipse) ->
+ if
+ X1 - X0 == 0 -> % if the width is exactly one pixel
+ [{Z, X1, X0, C}];
+ X1 - X0 < 0 -> throw(bad_ellipse_width);
+ Y1 - Y0 == 0 -> % Height exactly one pixel, get width
+ [{Z, X0, X1, C}];
+ true ->
+ Xr = (X1 - X0)/2,
+ Yr = (Y1 - Y0)/2,
+ Yo = trunc(Y - Y0 - Yr),
+ Yo2 = Yo*Yo,
+ Yr2 = Yr*Yr,
+ Xo = math:sqrt((1 - Yo2/Yr2))*Xr,
+ [{Z, round(X0 - Xo + Xr), round(X0 + Xo + Xr), C}]
+ end;
+
+object_line_data(Y, Z, #image_object{ intervals = Is, color = C}, filled_triangle) ->
+ case lists:keysearch(Y, 1, Is) of
+ {value, {Y, Xl, Xr}} -> [{Z, Xl, Xr, C}];
+ false -> []
+ end;
+
+object_line_data(Y, Z, #image_object{ intervals = Is, color = C}, line) ->
+ case dict:find(Y, Is) of
+ %{ok, {Xl, Xr}} -> [{Z, Xl, Xr, C}];
+ {ok, Ls} -> [{Z, Xl, Xr, C}||{Xl,Xr} <- Ls];
+ _ -> []
+ end;
+
+object_line_data(Y, Z, O, polygon) ->
+ Is = lists:filter(
+ fun({Yp,_,_}) ->
+ if Yp == Y -> true; true -> false end
+ end, O#image_object.intervals),
+ [ {Z, Xl, Xr, O#image_object.color} || {_, Xl, Xr} <- Is];
+
+object_line_data(Y, Z, #image_object{ color = C, intervals = Is }, text_horizontal) ->
+ % FIXME: optimize!
+ lists:foldl(
+ fun ({Yg,Xl,Xr}, Out) ->
+ if
+ Yg == Y ->
+ [{Z, Xl, Xr, C}|Out];
+ true ->
+ Out
+ end
+ end, [], Is);
+object_line_data(_, Z, #image_object{ span = {X0,_,X1,_}, color = C}, _) ->
+ % faked
+ [{Z, X0, X1, C}].
+
+is_object_on_line(Y, Object) ->
+ is_object_bounds_on_line(Y, Object#image_object.span).
+
+is_object_bounds_on_line(Y, {_,Y0,_,Y1}) ->
+ if
+ Y < Y0 -> false;
+ Y > Y1 -> false;
+ true -> true
+ end.
+
+rgb_float2byte({R,G,B,A}) ->
+ {trunc(R*255), trunc(G*255), trunc(B*255), trunc(A*255)}.
+
+%%% primitives to line_spans
+
+%% compile objects to linespans
+
+precompile(Image = #image{ objects = Os }) ->
+ Image#image{ objects = precompile_objects(Os) }.
+
+precompile_objects(Os) -> precompile_objects(Os, []).
+precompile_objects([], Out) -> lists:reverse(Out);
+
+precompile_objects([O = #image_object{ type = line, points = [P0,P1] }| Os], Out) ->
+ precompile_objects(Os, [O#image_object{ intervals = ls_list2dict(line_ls(P0,P1)) } | Out]);
+
+precompile_objects([O = #image_object{ type = filled_triangle, points = [P0,P1,P2] } | Os], Out) ->
+ precompile_objects(Os, [O#image_object{ intervals = triangle_ls(P0,P1,P2) } | Out]);
+
+precompile_objects([O = #image_object{ type = polygon, points = Pts } | Os], Out) ->
+ precompile_objects(Os, [O#image_object{ intervals = polygon_ls(Pts) } | Out]);
+
+precompile_objects([O = #image_object{ type = arc, points = [P0,P1], internals = D }| Os], Out) ->
+ Es = egd_primitives:arc_to_edges(P0, P1, D),
+ Ls = lists:foldl(fun
+ ({Ep0, Ep1}, D0) ->
+ ls_list2dict(line_ls(Ep0, Ep1), D0)
+ end, dict:new(), Es),
+ precompile_objects(Os, [O#image_object{ type = line, intervals = Ls } | Out]);
+
+precompile_objects([O = #image_object{ type = text_horizontal, points = [P0], internals = {Font, Text}} | Os], Out) ->
+ precompile_objects(Os, [O#image_object{ intervals = text_horizontal_ls(P0, Font, Text) } | Out]);
+
+precompile_objects([O|Os], Out) ->
+ precompile_objects(Os, [O|Out]).
+
+% triangle
+
+triangle_ls(P1,P2,P3) ->
+ % Find top point (or left most top point),
+ % From that point, two lines will be drawn to the
+ % other points.
+ % For each Y step,
+ % bresenham_line_interval for each of the two lines
+ % Find the left most and the right most for those lines
+ % At an end point, a new line to the point already being drawn
+ % repeat same procedure as above
+ [Sp1, Sp2, Sp3] = tri_pt_ysort([P1,P2,P3]),
+ triangle_ls_lp(tri_ls_ysort(line_ls(Sp1,Sp2)), Sp2, tri_ls_ysort(line_ls(Sp1,Sp3)), Sp3, []).
+
+% There will be Y mismatches between the two lists since bresenham is not perfect.
+% I can be remedied with checking intervals this could however be costly and
+% it may not be necessary, depending on how exact we need the points to be.
+% It should at most differ by one and endpoints should be fine.
+
+triangle_ls_lp([],_,[],_,Out) -> Out;
+triangle_ls_lp(LSs1, P1, [], P2, Out) ->
+ SLSs = tri_ls_ysort(line_ls(P2,P1)),
+ N2 = length(SLSs),
+ N1 = length(LSs1),
+ if
+ N1 > N2 ->
+ [_|ILSs] = LSs1,
+ triangle_ls_lp(ILSs, SLSs, Out);
+ N2 > N1 ->
+ [_|ILSs] = SLSs,
+ triangle_ls_lp(LSs1, ILSs, Out);
+ true ->
+ triangle_ls_lp(LSs1, SLSs, Out)
+ end;
+triangle_ls_lp([], P1, LSs2, P2, Out) ->
+ SLSs = tri_ls_ysort(line_ls(P1,P2)),
+ N1 = length(SLSs),
+ N2 = length(LSs2),
+ if
+ N1 > N2 ->
+ [_|ILSs] = SLSs,
+ triangle_ls_lp(ILSs, LSs2, Out);
+ N2 > N1 ->
+ [_|ILSs] = LSs2,
+ triangle_ls_lp(SLSs, ILSs, Out);
+ true ->
+ triangle_ls_lp(SLSs, LSs2, Out)
+ end;
+triangle_ls_lp([LS1|LSs1],P1,[LS2|LSs2],P2, Out) ->
+ {Y, Xl1, Xr1} = LS1,
+ {_, Xl2, Xr2} = LS2,
+ Xr = lists:max([Xl1,Xr1,Xl2,Xr2]),
+ Xl = lists:min([Xl1,Xr1,Xl2,Xr2]),
+ triangle_ls_lp(LSs1,P1, LSs2, P2, [{Y,Xl,Xr}|Out]).
+
+triangle_ls_lp([],[],Out) -> Out;
+triangle_ls_lp([],_,Out) -> Out;
+triangle_ls_lp(_,[],Out) -> Out;
+triangle_ls_lp([LS1|LSs1], [LS2|LSs2], Out) ->
+ {Y, Xl1, Xr1} = LS1,
+ {_, Xl2, Xr2} = LS2,
+ Xr = lists:max([Xl1,Xr1,Xl2,Xr2]),
+ Xl = lists:min([Xl1,Xr1,Xl2,Xr2]),
+ triangle_ls_lp(LSs1, LSs2, [{Y,Xl,Xr}|Out]).
+
+tri_pt_ysort(Pts) ->
+ % {X,Y}
+ lists:sort(
+ fun ({_,Y1},{_,Y2}) ->
+ if Y1 > Y2 -> false; true -> true end
+ end, Pts).
+
+tri_ls_ysort(LSs) ->
+ % {Y, Xl, Xr}
+ lists:sort(
+ fun ({Y1,_,_},{Y2,_,_}) ->
+ if Y1 > Y2 -> false; true -> true end
+ end, LSs).
+
+% polygon_ls
+% In:
+% Pts :: [{X,Y}]
+% Out:
+% LSs :: [{Y,Xl,Xr}]
+% Purpose:
+% Make polygon line spans
+% Algorithm:
+% 1. Find the left most (lm) point
+% 2. Find the two points adjacent to that point
+% The tripplet will make a triangle
+% 3. Ensure no points lies within the triangle
+% 4a.No points within triangle,
+% make triangle,
+% remove lm point
+% 1.
+% 4b.point(s) within triangle,
+%
+
+
+polygon_ls(Pts) ->
+ % Make triangles
+ Tris = polygon_tri(Pts),
+ % interval triangles
+ lists:flatten(polygon_tri_ls(Tris, [])).
+
+polygon_tri_ls([], Out) -> Out;
+polygon_tri_ls([{P1,P2,P3}|Tris], Out) ->
+ polygon_tri_ls(Tris, [triangle_ls(P1,P2,P3)|Out]).
+
+polygon_tri(Pts) ->
+ polygon_tri(polygon_lm_pt(Pts), []).
+
+
+polygon_tri([P1,P2,P3],Tris) -> [{P1,P2,P3}|Tris];
+polygon_tri([P2,P1,P3|Pts], Tris) ->
+ case polygon_tri_test(P1,P2,P3,Pts) of
+ false -> polygon_tri(polygon_lm_pt([P2,P3|Pts]), [{P1,P2,P3}|Tris]);
+ [LmPt|Ptsn] -> polygon_tri([P2,P1,LmPt,P3|Ptsn], Tris)
+ end.
+
+polygon_tri_test(P1,P2,P3, Pts) ->
+ polygon_tri_test(P1,P2,P3, Pts, []).
+
+polygon_tri_test(_,_,_, [], _) -> false;
+polygon_tri_test(P1,P2,P3,[Pt|Pts], Ptsr) ->
+ case point_inside_triangle(Pt, P1,P2,P3) of
+ false -> polygon_tri_test(P1,P2,P3, Pts, [Pt|Ptsr]);
+ true -> [Pt|Pts] ++ lists:reverse(Ptsr)
+ end.
+
+% polygon_lm_pt
+% In:
+% Pts :: [{X,Y}]
+% Out
+% LmPts = [{X0,Y0},{Xmin,Y0},{X1,Y1},...]
+% Purpose:
+% The order of the list is important
+% rotate the elements until Xmin is first
+% This is not extremly fast.
+
+polygon_lm_pt(Pts) ->
+ Xs = [X||{X,_}<-Pts],
+ polygon_lm_pt(Pts, lists:min(Xs), []).
+
+polygon_lm_pt([Pt0,{X,_}=Ptm | Pts], Xmin, Ptsr) when X > Xmin ->
+ polygon_lm_pt([Ptm|Pts], Xmin, [Pt0|Ptsr]);
+polygon_lm_pt(Pts, _, Ptsr) ->
+ Pts ++ lists:reverse(Ptsr).
+
+
+% return true if P is inside triangle (p1,p2,p3),
+% otherwise false.
+
+points_same_side({P1x,P1y}, {P2x,P2y}, {L1x,L1y}, {L2x,L2y}) ->
+ ((P1x - L1x)*(L2y - L1y) - (L2x - L1x)*(P1y - L1y) *
+ (P2x - L1x)*(L2y - L1y) - (L2x - L1x)*(P2y - L1y)) >= 0.
+
+point_inside_triangle(P, P1, P2, P3) ->
+ points_same_side(P, P1, P2, P3) and
+ points_same_side(P, P2, P1, P3) and
+ points_same_side(P, P3, P1, P2).
+
+%% [{Y, Xl, Xr}]
+ls_list2dict(List) -> ls_list2dict(List, dict:new()).
+ls_list2dict([], D) -> D;
+ls_list2dict([{Y, Xl, Xr}|Ls], D) ->
+ case dict:is_key(Y, D) of
+ false -> ls_list2dict(Ls, dict:store(Y, [{Xl, Xr}], D));
+ true -> ls_list2dict(Ls, dict:append(Y, {Xl, Xr}, D))
+ end.
+
+%% line_ls
+%% In:
+%% P1 :: point()
+%% P2 :: point()
+%% Out:
+%% {{Ymin,Ymax}, LSD :: line_step_data()}
+%% Purpose:
+%% Instead of points -> intervals
+
+
+line_ls({Xi0, Yi0},{Xi1,Yi1}) ->
+ % swap X with Y if line is steep
+ Steep = abs(Yi1 - Yi0) > abs(Xi1 - Xi0),
+
+ {Xs0, Ys0, Xs1, Ys1} = case Steep of
+ true -> {Yi0,Xi0,Yi1,Xi1};
+ false -> {Xi0,Yi0,Xi1,Yi1}
+ end,
+
+ {X0,Y0,X1,Y1} = case Xs0 > Xs1 of
+ true -> {Xs1,Ys1,Xs0,Ys0};
+ false -> {Xs0,Ys0,Xs1,Ys1}
+ end,
+
+ DX = X1 - X0,
+ DY = abs(Y1 - Y0),
+
+ Error = -DX/2,
+
+ Ystep = case Y0 < Y1 of
+ true -> 1;
+ false -> -1
+ end,
+ case Steep of
+ false ->
+ line_ls_step_not_steep({X0, X1},Y0, DX, DY, Ystep, Error, X0, []);
+ true ->
+ line_ls_step_steep({X0, X1},Y0, DX, DY, Ystep, Error, X0, [])
+ end.
+
+
+%% line_ls_step_(not)_steep
+%% In:
+%% Out:
+%% [{Yi, Xl,Xr}]
+%% Purpose:
+%% Produce an line_interval for each Yi (Y index)
+
+% Iterating the X-axis
+
+line_ls_step_not_steep({X,X1},Y,Dx,Dy,Ys,E, X0, LSs) when X < X1 ->
+ case E >= 0 of
+ true ->
+ line_ls_step_not_steep({X+1,X1},Y+Ys,Dx,Dy,Ys, E - Dx + Dy, X+1,[{Y,X0,X}|LSs]);
+ false ->
+ line_ls_step_not_steep({X+1,X1},Y,Dx,Dy,Ys, E + Dy, X0, LSs)
+ end;
+line_ls_step_not_steep({X,_},Y,_Dx,_Dy,_Ystep,_E,X0,LSs) ->
+ [{Y,X0,X}|LSs].
+
+% Iterating the Y-axis
+line_ls_step_steep({X,X1},Y,Dx,Dy,Ystep,E, X0, LSs) when X =< X1 ->
+ case E >= 0 of
+ true ->
+ line_ls_step_steep({X + 1,X1},Y+Ystep,Dx,Dy,Ystep,E - Dx + Dy,X,[{X,Y,Y}|LSs]);
+ false ->
+ line_ls_step_steep({X + 1,X1},Y,Dx,Dy,Ystep,E + Dy,X0, [{X,Y,Y}|LSs])
+ end;
+line_ls_step_steep({_X,_},_Y,_Dx,_Dy,_Ystep,_E,_X0,LSs) ->
+ LSs.
+
+% Text
+
+text_horizontal_ls(Point, Font, Chars) ->
+ {_Fw,Fh} = egd_font:size(Font),
+ text_intervals(Point, Fh, Font, Chars, []).
+
+% This is stupid. The starting point is the top left (Ptl) but the font
+% offsets is relative to the bottom right origin,
+% {Xtl,Ytl} -------------------------
+% | |
+% | Glyph BoundingBox |
+% | -------- |
+% | |Bitmap| Gh |
+% FH |-Gx0-|Data | |
+% | -------- |
+% | | |
+% | Gy0 |
+% | | |
+% Glyph (0,0)------------------------- Gxm (Glyph X move)
+% FW
+% Therefore, we need Yo, which is Yo = FH - Gy0 - Gh,
+% Font height minus Glyph Y offset minus Glyph bitmap data boundingbox
+% height.
+
+text_intervals( _, _, _, [], Out) -> lists:flatten(Out);
+text_intervals({Xtl,Ytl}, Fh, Font, [Code|Chars], Out) ->
+ {{_Gw, Gh, Gx0, Gy0, Gxm}, LSs} = egd_font:glyph(Font, Code),
+ % Set offset points from translation matrix to point in TeInVe.
+ Yo = Fh - Gh + Gy0,
+ GLSs = text_intervals_vertical({Xtl+Gx0,Ytl+Yo},LSs, []),
+ text_intervals({Xtl+Gxm,Ytl}, Fh, Font, Chars, [GLSs|Out]).
+
+text_intervals_vertical( _, [], Out) -> Out;
+text_intervals_vertical({Xtl, Ytl}, [LS|LSs], Out) ->
+ H = lists:foldl(
+ fun ({Xl,Xr}, RLSs) ->
+ [{Ytl, Xl + Xtl, Xr + Xtl}|RLSs]
+ end, [], LS),
+ text_intervals_vertical({Xtl, Ytl+1}, LSs, [H|Out]).
+
+
+%%% E. PostScript implementation
+
+eps(#image{ objects = Os, width = W, height = H}) ->
+ list_to_binary([eps_header(W,H),eps_objects(H,Os),eps_footer()]).
+
+eps_objects(H,Os) -> eps_objects(H,Os, []).
+eps_objects(_,[], Out) -> lists:flatten(Out);
+eps_objects(H,[O|Os], Out) -> eps_objects(H,Os, [eps_object(H,O)|Out]).
+
+eps_object(H,#image_object{ type = text_horizontal, internals = {_Font,Text}, points = [{X,Y}], color={R,G,B,_}}) ->
+ s("/Times-Roman findfont\n14 scalefont\nsetfont\n~.4f ~.4f ~.4f setrgbcolor\nnewpath\n~p ~p moveto\n(~s) show~n",
+ [R,G,B,X,H-(Y + 10), Text]);
+eps_object(H,#image_object{ type = filled_ellipse, points = [{X1,Y1p},{X2,Y2p}], color={R,G,B,_}}) ->
+ Y1 = H - Y1p,
+ Y2 = H - Y2p,
+ Xr = trunc((X2-X1)/2),
+ Yr = trunc((Y2-Y1)/2),
+ Cx = X1 + Xr,
+ Cy = Y1 + Yr,
+ s("~.4f ~.4f ~.4f setrgbcolor\nnewpath\n~p ~p ~p ~p 0 360 ellipse fill\n",
+ [R,G,B,Cx,Cy,Xr,Yr]);
+eps_object(H,#image_object{ type = arc, points = [P0, P1], internals = D, color={R,G,B,_}}) ->
+ Es = egd_primitives:arc_to_edges(P0, P1, D),
+ [s("~.4f ~.4f ~.4f setrgbcolor\n", [R,G,B])|lists:foldl(fun
+ ({{X1,Y1},{X2,Y2}}, Eps) ->
+ [s("newpath\n~p ~p moveto\n~p ~p lineto\n1 setlinewidth\nstroke\n", [X1,H-Y1,X2,H-Y2])|Eps]
+ end, [], Es)];
+
+eps_object(H,#image_object{ type = line, points = [{X1,Y1}, {X2,Y2}], color={R,G,B,_}}) ->
+ s("~.4f ~.4f ~.4f setrgbcolor\nnewpath\n~p ~p moveto\n~p ~p lineto\n1 setlinewidth\nstroke\n",
+ [R,G,B,X1,H-Y1,X2,H-Y2]);
+eps_object(H,#image_object{ type = rectangle, points = [{X1,Y1}, {X2,Y2}], color={R,G,B,_}}) ->
+ s("~.4f ~.4f ~.4f setrgbcolor\nnewpath\n~p ~p moveto\n~p ~p lineto\n~p ~p lineto\n~p ~p lineto\n~p ~p lineto\n1 setlinewidth\nstroke\n",
+ [R,G,B,X1,H-Y1,X2,H-Y1,X2,H-Y2,X1,H-Y2,X1,H-Y1]);
+eps_object(H,#image_object{ type = filled_rectangle, points = [{X1,Y1}, {X2,Y2}], color={R,G,B,_}}) ->
+ s("~.4f ~.4f ~.4f setrgbcolor\nnewpath\n~p ~p moveto\n~p ~p lineto\n~p ~p lineto\n~p ~p lineto\n~p ~p lineto\nclosepath\nfill\n",
+ [R,G,B,X1,H-Y1,X2,H-Y1,X2,H-Y2,X1,H-Y2,X1,H-Y1]);
+eps_object(_,_) -> "".
+
+s(Format, Terms) -> lists:flatten(io_lib:format(Format, Terms)).
+
+eps_header(W,H) ->
+ s("%!PS-Adobe-3.0 EPSF-3.0\n%%Creator: Created by egd\n%%BoundingBox: 0 0 ~p ~p\n%%LanguageLevel: 2\n%%Pages: 1\n%%DocumentData: Clean7Bit\n",[W,H]) ++
+ "%%BeginProlog\n/ellipse {7 dict begin\n/endangle exch def\n/startangle exch def\n/yradius exch def\n/xradius exch def\n/yC exch def\n/xC exch def\n"
+ "/savematrix matrix currentmatrix def\nxC yC translate\nxradius yradius scale\n0 0 1 startangle endangle arc\nsavematrix setmatrix\nend\n} def\n"
+ "%%EndProlog\n".
+
+eps_footer() ->
+ "%%EOF\n".