aboutsummaryrefslogtreecommitdiffstats
path: root/lib/percept/src
diff options
context:
space:
mode:
authorErlang/OTP <[email protected]>2009-11-20 14:54:40 +0000
committerErlang/OTP <[email protected]>2009-11-20 14:54:40 +0000
commit84adefa331c4159d432d22840663c38f155cd4c1 (patch)
treebff9a9c66adda4df2106dfd0e5c053ab182a12bd /lib/percept/src
downloadotp-84adefa331c4159d432d22840663c38f155cd4c1.tar.gz
otp-84adefa331c4159d432d22840663c38f155cd4c1.tar.bz2
otp-84adefa331c4159d432d22840663c38f155cd4c1.zip
The R13B03 release.OTP_R13B03
Diffstat (limited to 'lib/percept/src')
-rw-r--r--lib/percept/src/Makefile104
-rw-r--r--lib/percept/src/egd.erl287
-rw-r--r--lib/percept/src/egd.hrl45
-rw-r--r--lib/percept/src/egd_font.erl176
-rwxr-xr-xlib/percept/src/egd_png.erl104
-rw-r--r--lib/percept/src/egd_primitives.erl543
-rw-r--r--lib/percept/src/egd_render.erl709
-rw-r--r--lib/percept/src/percept.app.src30
-rw-r--r--lib/percept/src/percept.appup.src21
-rw-r--r--lib/percept/src/percept.erl337
-rw-r--r--lib/percept/src/percept.hrl53
-rw-r--r--lib/percept/src/percept_analyzer.erl367
-rw-r--r--lib/percept/src/percept_db.erl768
-rw-r--r--lib/percept/src/percept_graph.erl133
-rw-r--r--lib/percept/src/percept_html.erl720
-rw-r--r--lib/percept/src/percept_image.erl315
16 files changed, 4712 insertions, 0 deletions
diff --git a/lib/percept/src/Makefile b/lib/percept/src/Makefile
new file mode 100644
index 0000000000..5dfc72575a
--- /dev/null
+++ b/lib/percept/src/Makefile
@@ -0,0 +1,104 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 2007-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%
+
+include $(ERL_TOP)/make/target.mk
+include $(ERL_TOP)/make/$(TARGET)/otp.mk
+
+# ----------------------------------------------------
+# Application version
+# ----------------------------------------------------
+include ../vsn.mk
+VSN=$(PERCEPT_VSN)
+
+# ----------------------------------------------------
+# Release directory specification
+# ----------------------------------------------------
+RELSYSDIR = $(RELEASE_PATH)/lib/percept-$(VSN)
+
+# ----------------------------------------------------
+# Common Macros
+# ----------------------------------------------------
+
+MODULES= \
+ egd \
+ egd_png \
+ egd_font \
+ egd_render \
+ egd_primitives \
+ percept \
+ percept_db \
+ percept_html \
+ percept_image \
+ percept_graph \
+ percept_analyzer
+
+
+#HRL_FILES= ../include/
+
+ERL_FILES= $(MODULES:%=%.erl)
+
+TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) $(APP_TARGET) $(APPUP_TARGET)
+
+APP_FILE= percept.app
+
+APP_SRC= $(APP_FILE).src
+APP_TARGET= $(EBIN)/$(APP_FILE)
+
+APPUP_FILE= percept.appup
+
+APPUP_SRC= $(APPUP_FILE).src
+APPUP_TARGET= $(EBIN)/$(APPUP_FILE)
+
+# ----------------------------------------------------
+# FLAGS
+# ----------------------------------------------------
+ERL_COMPILE_FLAGS += +warn_unused_vars -I../include
+
+# ----------------------------------------------------
+# Targets
+# ----------------------------------------------------
+
+debug opt: $(TARGET_FILES)
+
+clean:
+ rm -f $(TARGET_FILES)
+ rm -f errs core *~
+
+$(APP_TARGET): $(APP_SRC) ../vsn.mk
+ sed -e 's;%VSN%;$(VSN);' $< > $@
+
+$(APPUP_TARGET): $(APPUP_SRC) ../vsn.mk
+ sed -e 's;%VSN%;$(VSN);' $< > $@
+
+docs:
+
+# ----------------------------------------------------
+# Release Target
+# ----------------------------------------------------
+include $(ERL_TOP)/make/otp_release_targets.mk
+
+release_spec: opt
+ $(INSTALL_DIR) $(RELSYSDIR)/src
+ $(INSTALL_DATA) $(ERL_FILES) $(RELSYSDIR)/src
+# $(INSTALL_DIR) $(RELSYSDIR)/include
+# $(INSTALL_DATA) $(HRL_FILES) $(RELSYSDIR)/include
+ $(INSTALL_DIR) $(RELSYSDIR)/ebin
+ $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin
+
+release_docs_spec:
+
diff --git a/lib/percept/src/egd.erl b/lib/percept/src/egd.erl
new file mode 100644
index 0000000000..4becfef19b
--- /dev/null
+++ b/lib/percept/src/egd.erl
@@ -0,0 +1,287 @@
+%%
+%% %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 - erlang graphical drawer
+%%
+%%
+
+-module(egd).
+
+-export([create/2, destroy/1, information/1]).
+-export([text/5, line/4, color/1, color/2]).
+-export([rectangle/4, filledRectangle/4, filledEllipse/4]).
+-export([arc/4, arc/5]).
+-export([render/1, render/2, render/3]).
+
+-export([filledTriangle/5, polygon/3]).
+
+-export([save/2]).
+
+-include("egd.hrl").
+
+%%==========================================================================
+%%
+%% Type definitions
+%%
+%%==========================================================================
+
+%% @type egd_image()
+%% @type point() = {integer(), integer()}
+%% @type color()
+%% @type render_option() = {render_engine, opaque} | {render_engine, alpha}
+
+-type(egd_image() :: pid()).
+-type(point() :: {non_neg_integer(), non_neg_integer()}).
+-type(render_option() :: {'render_engine', 'opaque'} | {'render_engine', 'alpha'}).
+-type(color() :: {float(), float(), float(), float()}).
+
+%%==========================================================================
+%%
+%% Interface functions
+%%
+%%==========================================================================
+
+%% @spec create(integer(), integer()) -> egd_image()
+%% @doc Creates an image area and returns its reference.
+
+-spec(create/2 :: (Width :: integer(), Height :: integer()) -> egd_image()).
+
+create(Width,Height) ->
+ spawn_link(fun() -> init(trunc(Width),trunc(Height)) end).
+
+
+%% @spec destroy(egd_image()) -> ok
+%% @doc Destroys the image.
+
+-spec(destroy/1 :: (Image :: egd_image()) -> ok).
+
+destroy(Image) ->
+ cast(Image, destroy),
+ ok.
+
+
+%% @spec render(egd_image()) -> binary()
+%% @equiv render(Image, png, [{render_engine, opaque}])
+
+
+render(Image) ->
+ render(Image, png, [{render_engine, opaque}]).
+
+%% @spec render(egd_image(), png | raw_bitmap) -> binary()
+%% @equiv render(Image, Type, [{render_engine, opaque}])
+
+render(Image, Type) ->
+ render(Image, Type, [{render_engine, opaque}]).
+
+%% @spec render(egd_image(), png | raw_bitmap, [render_option()]) -> binary()
+%% @doc Renders a binary from the primitives specified by egd_image(). The
+%% binary can either be a raw bitmap with rgb tripplets or a binary in png
+%% format.
+
+-spec(render/3 :: (
+ Image :: egd_image(),
+ Type :: 'png' | 'raw_bitmap' | 'eps',
+ Options :: [render_option()]) -> binary()).
+
+render(Image, Type, Options) ->
+ {render_engine, RenderType} = proplists:lookup(render_engine, Options),
+ call(Image, {render, Type, RenderType}).
+
+
+%% @spec information(egd_image()) -> ok
+%% @hidden
+%% @doc Writes out information about the image. This is a debug feature
+%% mainly.
+
+information(Pid) ->
+ cast(Pid, information),
+ ok.
+
+%% @spec line(egd_image(), point(), point(), color()) -> ok
+%% @doc Creates a line object from P1 to P2 in the image.
+
+-spec(line/4 :: (
+ Image :: egd_image(),
+ P1 :: point(),
+ P2 :: point(),
+ Color :: color()) -> 'ok').
+
+line(Image, P1, P2, Color) ->
+ cast(Image, {line, P1, P2, Color}),
+ ok.
+
+%% @spec color( Value | Name ) -> color()
+%% where
+%% Value = {byte(), byte(), byte()} | {byte(), byte(), byte(), byte()}
+%% Name = black | silver | gray | white | maroon | red | purple | fuchia | green | lime | olive | yellow | navy | blue | teal | aqua
+%% @doc Creates a color reference.
+
+-spec(color/1 :: (
+ Value :: {byte(), byte(), byte()} | {byte(), byte(), byte(), byte()} | atom()) ->
+ color()).
+
+color(Color) ->
+ egd_primitives:color(Color).
+
+%% @spec color(egd_image(), {byte(), byte(), byte()}) -> color()
+%% @doc Creates a color reference.
+%% @hidden
+
+color(_Image, Color) ->
+ egd_primitives:color(Color).
+
+%% @spec text(egd_image(), point(), font(), string(), color()) -> ok
+%% @doc Creates a text object.
+
+text(Image, P, Font, Text, Color) ->
+ cast(Image, {text, P, Font, Text, Color}),
+ ok.
+
+%% @spec rectangle(egd_image(), point(), point(), color()) -> ok
+%% @doc Creates a rectangle object.
+
+rectangle(Image, P1, P2, Color) ->
+ cast(Image, {rectangle, P1, P2, Color}),
+ ok.
+
+%% @spec filledRectangle(egd_image(), point(), point(), color()) -> ok
+%% @doc Creates a filled rectangle object.
+
+filledRectangle(Image, P1, P2, Color) ->
+ cast(Image, {filled_rectangle, P1, P2, Color}),
+ ok.
+
+%% @spec filledEllipse(egd_image(), point(), point(), color()) -> ok
+%% @doc Creates a filled ellipse object.
+
+filledEllipse(Image, P1, P2, Color) ->
+ cast(Image, {filled_ellipse, P1, P2, Color}),
+ ok.
+
+%% @spec filledTriangle(egd_image(), point(), point(), point(), color()) -> ok
+%% @hidden
+%% @doc Creates a filled triangle object.
+
+filledTriangle(Image, P1, P2, P3, Color) ->
+ cast(Image, {filled_triangle, P1, P2, P3, Color}),
+ ok.
+
+%% @spec polygon(egd_image(), [point()], color()) -> ok
+%% @hidden
+%% @doc Creates a filled filled polygon object.
+
+polygon(Image, Pts, Color) ->
+ cast(Image, {polygon, Pts, Color}),
+ ok.
+
+%% @spec arc(egd_image(), point(), point(), color()) -> ok
+%% @hidden
+%% @doc Creates an arc with radius of bbx corner.
+
+arc(Image, P1, P2, Color) ->
+ cast(Image, {arc, P1, P2, Color}),
+ ok.
+
+%% @spec arc(egd_image(), point(), point(), integer(), color()) -> ok
+%% @hidden
+%% @doc Creates an arc.
+
+arc(Image, P1, P2, D, Color) ->
+ cast(Image, {arc, P1, P2, D, Color}),
+ ok.
+
+%% @spec save(binary(), string()) -> ok
+%% @doc Saves the binary to file.
+
+save(Binary, Filename) when is_binary(Binary) ->
+ file:write_file(Filename, Binary),
+ ok.
+% ---------------------------------
+% Aux functions
+% ---------------------------------
+
+cast(Pid, Command) ->
+ Pid ! {egd, self(), Command}.
+
+call(Pid, Command) ->
+ Pid ! {egd, self(), Command},
+ receive {egd, Pid, Result} -> Result end.
+
+% ---------------------------------
+% Server loop
+% ---------------------------------
+
+init(W,H) ->
+ Image = egd_primitives:create(W,H),
+ loop(Image).
+
+loop(Image) ->
+ receive
+ % Quitting
+ {egd, _Pid, destroy} -> ok;
+
+ % Rendering
+ {egd, Pid, {render, BinaryType, RenderType}} ->
+ case BinaryType of
+ raw_bitmap ->
+ Bitmap = egd_render:binary(Image, RenderType),
+ Pid ! {egd, self(), Bitmap},
+ loop(Image);
+ eps ->
+ Eps = egd_render:eps(Image),
+ Pid ! {egd, self(), Eps},
+ loop(Image);
+ png ->
+ Bitmap = egd_render:binary(Image, RenderType),
+ Png = egd_png:binary(
+ Image#image.width,
+ Image#image.height,
+ Bitmap),
+ Pid ! {egd, self(), Png},
+ loop(Image);
+ Unhandled ->
+ Pid ! {egd, self(), {error, {format, Unhandled}}},
+ loop(Image)
+ end;
+
+ % Drawing primitives
+ {egd, _Pid, {line, P1, P2, C}} ->
+ loop(egd_primitives:line(Image, P1, P2, C));
+ {egd, _Pid, {text, P, Font, Text, C}} ->
+ loop(egd_primitives:text(Image, P, Font, Text, C));
+ {egd, _Pid, {filled_ellipse, P1, P2, C}} ->
+ loop(egd_primitives:filledEllipse(Image, P1, P2, C));
+ {egd, _Pid, {filled_rectangle, P1, P2, C}} ->
+ loop(egd_primitives:filledRectangle(Image, P1, P2, C));
+ {egd, _Pid, {filled_triangle, P1, P2, P3, C}} ->
+ loop(egd_primitives:filledTriangle(Image, P1, P2, P3, C));
+ {egd, _Pid, {polygon, Pts, C}} ->
+ loop(egd_primitives:polygon(Image, Pts, C));
+ {egd, _Pid, {arc, P1, P2, C}} ->
+ loop(egd_primitives:arc(Image, P1, P2, C));
+ {egd, _Pid, {arc, P1, P2, D, C}} ->
+ loop(egd_primitives:arc(Image, P1, P2, D, C));
+ {egd, _Pid, {rectangle, P1, P2, C}} ->
+ loop(egd_primitives:rectangle(Image, P1, P2, C));
+ {egd, _Pid, information} ->
+ egd_primitives:info(Image),
+ loop(Image);
+ _ ->
+ loop(Image)
+ end.
diff --git a/lib/percept/src/egd.hrl b/lib/percept/src/egd.hrl
new file mode 100644
index 0000000000..274986db65
--- /dev/null
+++ b/lib/percept/src/egd.hrl
@@ -0,0 +1,45 @@
+%%
+%% %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%
+
+-type(rgba_float() :: {float(), float(), float(), float()}).
+-type(rgba_byte() :: {byte(), byte(), byte(), byte()}).
+-type(rgb() :: {byte(), byte(), byte()}).
+
+-record(image_object, {
+ type,
+ points = [],
+ span,
+ internals,
+ intervals,
+ color}). % RGBA in float values
+
+-record(image, {
+ width,
+ height,
+ objects = [],
+ background = {1.0,1.0,1.0,1.0},
+ image}).
+
+-define(debug, void).
+
+-ifdef(debug).
+-define(dbg(X), io:format("DEBUG: ~p:~p~n",[?MODULE, X])).
+-else.
+-define(dbg(X), void).
+-endif.
+
diff --git a/lib/percept/src/egd_font.erl b/lib/percept/src/egd_font.erl
new file mode 100644
index 0000000000..2b2a89a0a9
--- /dev/null
+++ b/lib/percept/src/egd_font.erl
@@ -0,0 +1,176 @@
+%%
+%% %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_font
+%%
+
+-module(egd_font).
+
+-export([load/1, size/1, glyph/2]).
+-include("egd.hrl").
+
+%% Font represenatation in ets table
+%% egd_font_table
+%%
+%% Information:
+%% {Key, Description, Size}
+%% Key :: {Font :: atom(), information}
+%% Description :: any(), Description header from font file
+%% Size :: {W :: integer(), H :: integer()}
+%%
+%% Glyphs:
+%% {Key, Translation LSs} where
+%% Key :: {Font :: atom(), Code :: integer()}, Code = glyph char code
+%% Translation :: {
+%% W :: integer(), % BBx width
+%% H :: integer(), % BBx height
+%% X0 :: integer(), % X start
+%% Y0 :: integer(), % Y start
+%% Xm :: integer(), % Glyph X move when drawing
+%% }
+%% LSs :: [[{Xl :: integer(), Xr :: integer()}]]
+%% The first list is height (top to bottom), the inner list is the list
+%% of line spans for the glyphs horizontal pixels.
+%%
+
+%%==========================================================================
+%%
+%% Interface functions
+%%
+%%==========================================================================
+
+size(Font) ->
+ [{_Key, _Description, Size}] = ets:lookup(egd_font_table,{Font,information}),
+ Size.
+
+glyph(Font, Code) ->
+ [{_Key, Translation, LSs}] = ets:lookup(egd_font_table,{Font,Code}),
+ {Translation, LSs}.
+
+load(Filename) ->
+ {ok, Bin} = file:read_file(Filename),
+ Font = erlang:binary_to_term(Bin),
+ load_font_header(Font).
+
+%%==========================================================================
+%%
+%% Internal functions
+%%
+%%==========================================================================
+
+%% ETS handler functions
+
+initialize_table() ->
+ ets:new(egd_font_table, [named_table, ordered_set, public]).
+
+glyph_insert(Font, Code, Translation, LSs) ->
+ Element = {{Font, Code}, Translation, LSs},
+ ets:insert(egd_font_table, Element).
+
+font_insert(Font, Description, Dimensions) ->
+ Element = {{Font, information}, Description, Dimensions},
+ ets:insert(egd_font_table, Element).
+
+%% Font loader functions
+
+is_font_loaded(Font) ->
+ try
+ case ets:lookup(egd_font_table, {Font, information}) of
+ [] -> false;
+ _ -> true
+ end
+ catch
+ error:_ ->
+ initialize_table(),
+ false
+ end.
+
+
+load_font_header({_Type, _Version, Font}) ->
+ load_font_body(Font).
+
+load_font_body({Key,Desc,W,H,Glyphs,Bitmaps}) ->
+ case is_font_loaded(Key) of
+ true -> Key;
+ false ->
+ % insert dimensions
+ font_insert(Key, Desc, {W,H}),
+ parse_glyphs(Glyphs, Bitmaps, Key),
+ Key
+ end.
+
+parse_glyphs([], _ , _Key) -> ok;
+parse_glyphs([Glyph|Glyphs], Bs, Key) ->
+ {Code, Translation, LSs} = parse_glyph(Glyph, Bs),
+ glyph_insert(Key, Code, Translation, LSs),
+ parse_glyphs(Glyphs, Bs, Key).
+
+parse_glyph({Code,W,H,X0,Y0,Xm,Offset}, Bitmasks) ->
+ BytesPerLine = ((W+7) div 8),
+ NumBytes = BytesPerLine*H,
+ <<_:Offset/binary,Bitmask:NumBytes/binary,_/binary>> = Bitmasks,
+ LSs = render_glyph(W,H,X0,Y0,Xm,Bitmask),
+ {Code, {W,H,X0,Y0,Xm}, LSs}.
+
+render_glyph(W, H, X0, Y0, Xm, Bitmask) ->
+ render_glyph(W,{0,H},X0,Y0,Xm,Bitmask, []).
+render_glyph(_W, {H,H}, _X0, _Y0, _Xm, _Bitmask, Out) -> Out;
+render_glyph(W, {Hi,H}, X0, Y0,Xm, Bitmask, LSs) ->
+ N = ((W+7) div 8),
+ O = N*Hi,
+ <<_:O/binary, Submask/binary>> = Bitmask,
+ LS = render_glyph_horizontal(
+ Submask, % line glyph bitmask
+ {down, W - 1}, % loop state
+ W - 1, % Width
+ []), % Linespans
+ render_glyph(W,{Hi+1,H},X0,Y0,Xm, Bitmask, [LS|LSs]).
+
+render_glyph_horizontal(Value, {Pr, Px}, 0, Spans) ->
+ Cr = bit_spin(Value, 0),
+ case {Pr,Cr} of
+ {up , up } -> % closure of interval since its last
+ [{0, Px}|Spans];
+ {up , down} -> % closure of interval
+ [{1, Px}|Spans];
+ {down, up } -> % beginning of interval
+ [{0, 0}|Spans];
+ {down, down} -> % no change in interval
+ Spans
+ end;
+render_glyph_horizontal(Value, {Pr, Px}, Cx, Spans) ->
+ Cr = bit_spin(Value, Cx),
+ case {Pr,Cr} of
+ {up , up } -> % no change in interval
+ render_glyph_horizontal(Value, {Cr, Px}, Cx - 1, Spans);
+ {up , down} -> % closure of interval
+ render_glyph_horizontal(Value, {Cr, Cx}, Cx - 1, [{Cx+1,Px}|Spans]);
+ {down, up } -> % beginning of interval
+ render_glyph_horizontal(Value, {Cr, Cx}, Cx - 1, Spans);
+ {down, down} -> % no change in interval
+ render_glyph_horizontal(Value, {Cr, Px}, Cx - 1, Spans)
+ end.
+
+bit_spin(Value, Cx) ->
+ <<_:Cx, Bit:1, _/bits>> = Value,
+ case Bit of
+ 1 -> up;
+ 0 -> down
+ end.
+
diff --git a/lib/percept/src/egd_png.erl b/lib/percept/src/egd_png.erl
new file mode 100755
index 0000000000..3a0aaeef31
--- /dev/null
+++ b/lib/percept/src/egd_png.erl
@@ -0,0 +1,104 @@
+%%
+%% %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%
+
+
+%% This code was originally written by Dan Gudmundsson for png-handling in
+%% wings3d (e3d__png).
+%%
+%% @doc egd
+%%
+
+-module(egd_png).
+
+-export([binary/3]).
+
+-include("egd.hrl").
+
+-define(MAGIC, 137,$P,$N,$G,$\r,$\n,26,$\n).
+
+-define(GREYSCALE, 0).
+-define(TRUECOLOUR, 2).
+-define(INDEXED, 3).
+-define(GREYSCALE_A, 4).
+-define(TRUECOLOUR_A,6).
+
+-define(MAX_WBITS,15).
+
+-define(CHUNK, 240).
+
+-define(get4p1(Idx),((Idx) bsr 4)).
+-define(get4p2(Idx),((Idx) band 16#0F)).
+-define(get2p1(Idx),((Idx) bsr 6)).
+-define(get2p2(Idx),(((Idx) bsr 4) band 3)).
+-define(get2p3(Idx),(((Idx) bsr 2) band 3)).
+-define(get2p4(Idx),((Idx) band 3)).
+-define(get1p1(Idx),((Idx) bsr 7)).
+-define(get1p2(Idx),(((Idx) bsr 6) band 1)).
+-define(get1p3(Idx),(((Idx) bsr 5) band 1)).
+-define(get1p4(Idx),(((Idx) bsr 4) band 1)).
+-define(get1p5(Idx),(((Idx) bsr 3) band 1)).
+-define(get1p6(Idx),(((Idx) bsr 2) band 1)).
+-define(get1p7(Idx),(((Idx) bsr 1) band 1)).
+-define(get1p8(Idx),((Idx) band 1)).
+
+binary(W, H, Bitmap) when is_binary(Bitmap) ->
+ Z = zlib:open(),
+ Binary = bitmap2png(W, H, Bitmap, Z),
+ zlib:close(Z),
+ Binary.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% Begin Tainted
+
+bitmap2png(W, H, Bitmap,Z) ->
+ HDR = create_chunk(<<"IHDR",W:32,H:32,8:8,(png_type(r8g8b8)):8,0:8,0:8,0:8>>,Z),
+ DATA = create_chunk(["IDAT",compress_image(0,3*W,Bitmap,[])],Z),
+ END = create_chunk(<<"IEND">>,Z),
+ list_to_binary([?MAGIC,HDR,DATA,END]).
+
+compress_image(I,RowLen, Bin, Acc) ->
+ Pos = I*RowLen,
+ case Bin of
+ <<_:Pos/binary,Row:RowLen/binary,_/binary>> ->
+ Filtered = filter_row(Row,RowLen),
+ compress_image(I+1,RowLen,Bin,[Filtered|Acc]);
+ _ when Pos == size(Bin) ->
+ Filtered = list_to_binary(lists:reverse(Acc)),
+ Compressed = zlib:compress(Filtered),
+ Compressed
+ end.
+
+filter_row(Row,_RowLen) ->
+ [0,Row].
+
+% dialyzer warnings
+%png_type(g8) -> ?GREYSCALE;
+%png_type(a8) -> ?GREYSCALE;
+%png_type(r8g8b8a8) -> ?TRUECOLOUR_A;
+png_type(r8g8b8) -> ?TRUECOLOUR.
+
+create_chunk(Bin,Z) when is_list(Bin) ->
+ create_chunk(list_to_binary(Bin),Z);
+create_chunk(Bin,Z) when is_binary(Bin) ->
+ Sz = size(Bin)-4,
+ Crc = zlib:crc32(Z,Bin),
+ <<Sz:32,Bin/binary,Crc:32>>.
+
+% End tainted
diff --git a/lib/percept/src/egd_primitives.erl b/lib/percept/src/egd_primitives.erl
new file mode 100644
index 0000000000..245e0d48e2
--- /dev/null
+++ b/lib/percept/src/egd_primitives.erl
@@ -0,0 +1,543 @@
+%%
+%% %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_primitives
+%%
+
+
+-module(egd_primitives).
+-export([
+ create/2,
+ color/1,
+ pixel/3,
+ polygon/3,
+ line/4,
+ arc/4,
+ arc/5,
+ rectangle/4,
+ filledRectangle/4,
+ filledEllipse/4,
+ filledTriangle/5,
+ text/5
+ ]).
+
+-export([
+ info/1,
+ object_info/1,
+ rgb_float2byte/1
+ ]).
+-export([
+ arc_to_edges/3,
+ convex_hull/1,
+ edges/1
+ ]).
+
+-include("egd.hrl").
+
+
+%% API info
+info(I) ->
+ W = I#image.width, H = I#image.height,
+ io:format("Dimensions: ~p x ~p~n", [W,H]),
+ io:format("Number of image objects: ~p~n", [length(I#image.objects)]),
+ TotalPoints = info_objects(I#image.objects,0),
+ io:format("Total points: ~p [~p %]~n", [TotalPoints, 100*TotalPoints/(W*H)]),
+ ok.
+
+info_objects([],N) -> N;
+info_objects([O | Os],N) ->
+ Points = length(O#image_object.points),
+info_objects(Os,N+Points).
+
+object_info(O) ->
+ io:format("Object information: ~p~n", [O#image_object.type]),
+ io:format("- Number of points: ~p~n", [length(O#image_object.points)]),
+ io:format("- Bounding box: ~p~n", [O#image_object.span]),
+ io:format("- Color: ~p~n", [O#image_object.color]),
+ ok.
+
+%% interface functions
+
+line(I, Sp, Ep, Color) ->
+ I#image{objects = [
+ #image_object{
+ type = line,
+ points = [Sp, Ep],
+ span = span([Sp, Ep]),
+ color = Color} | I#image.objects]}.
+
+arc(I, {Sx,Sy} = Sp, {Ex,Ey} = Ep, Color) ->
+ X = Ex - Sx,
+ Y = Ey - Sy,
+ R = math:sqrt(X*X + Y*Y)/2,
+ arc(I, Sp, Ep, R, Color).
+
+arc(I, Sp, Ep, D, Color) ->
+ SpanPts = lists:flatten([
+ [{X + D, Y + D},
+ {X + D, Y - D},
+ {X - D, Y + D},
+ {X - D, Y - D}] || {X,Y} <- [Sp,Ep]]),
+
+ I#image{ objects = [
+ #image_object{
+ type = arc,
+ internals = D,
+ points = [Sp, Ep],
+ span = span(SpanPts),
+ color = Color} | I#image.objects]}.
+
+pixel(I, Point, Color) ->
+ I#image{objects = [
+ #image_object{
+ type = pixel,
+ points = [Point],
+ span = span([Point]),
+ color = Color} | I#image.objects]}.
+
+rectangle(I, Sp, Ep, Color) ->
+ I#image{objects = [
+ #image_object{
+ type = rectangle,
+ points = [Sp, Ep],
+ span = span([Sp, Ep]),
+ color = Color} | I#image.objects]}.
+
+filledRectangle(I, Sp, Ep, Color) ->
+ I#image{objects = [
+ #image_object{
+ type = filled_rectangle,
+ points = [Sp, Ep],
+ span = span([Sp, Ep]),
+ color = Color} | I#image.objects]}.
+
+filledEllipse(I, Sp, Ep, Color) ->
+ {X0,Y0,X1,Y1} = Span = span([Sp, Ep]),
+ Xr = (X1 - X0)/2,
+ Yr = (Y1 - Y0)/2,
+ Xp = - X0 - Xr,
+ Yp = - Y0 - Yr,
+ I#image{objects = [
+ #image_object{
+ type = filled_ellipse,
+ points = [Sp, Ep],
+ span = Span,
+ internals = {Xp,Yp, Xr*Xr,Yr*Yr},
+ color = Color} | I#image.objects]}.
+
+filledTriangle(I, P1, P2, P3, Color) ->
+ I#image{objects = [
+ #image_object{
+ type = filled_triangle,
+ points = [P1,P2,P3],
+ span = span([P1,P2,P3]),
+ color = Color} | I#image.objects]}.
+
+
+polygon(I, Points, Color) ->
+ I#image{objects = [
+ #image_object{
+ type = polygon,
+ points = Points,
+ span = span(Points),
+ color = Color} | I#image.objects]}.
+
+create(W, H) ->
+ #image{ width = W, height = H}.
+
+
+%color({crayon, Color}) -> rgba_byte2float(name_to_color({crayon, Color, 255}));
+%color({crayon, Color, A}) -> rgba_byte2float(name_to_color({crayon, Color, A}));
+color(Color) when is_atom(Color) -> rgba_byte2float(name_to_color({Color, 255}));
+color({Color, A}) when is_atom(Color) -> rgba_byte2float(name_to_color({Color, A}));
+color({R,G,B}) -> rgba_byte2float({R,G,B, 255});
+color(C) -> rgba_byte2float(C).
+
+% HTML default colors
+name_to_color({ black, A}) -> { 0, 0, 0, A};
+name_to_color({ silver, A}) -> { 192, 192, 192, A};
+name_to_color({ gray, A}) -> { 128, 128, 128, A};
+name_to_color({ white, A}) -> { 128, 0, 0, A};
+name_to_color({ maroon, A}) -> { 255, 0, 0, A};
+name_to_color({ red, A}) -> { 128, 0, 128, A};
+name_to_color({ purple, A}) -> { 128, 0, 128, A};
+name_to_color({ fuchia, A}) -> { 255, 0, 255, A};
+name_to_color({ green, A}) -> { 0, 128, 0, A};
+name_to_color({ lime, A}) -> { 0, 255, 0, A};
+name_to_color({ olive, A}) -> { 128, 128, 0, A};
+name_to_color({ yellow, A}) -> { 255, 255, 0, A};
+name_to_color({ navy, A}) -> { 0, 0, 128, A};
+name_to_color({ blue, A}) -> { 0, 0, 255, A};
+name_to_color({ teal, A}) -> { 0, 128, 0, A};
+name_to_color({ aqua, A}) -> { 0, 255, 155, A};
+
+% HTML color extensions
+name_to_color({ steelblue, A}) -> { 70, 130, 180, A};
+name_to_color({ royalblue, A}) -> { 4, 22, 144, A};
+name_to_color({ cornflowerblue, A}) -> { 100, 149, 237, A};
+name_to_color({ lightsteelblue, A}) -> { 176, 196, 222, A};
+name_to_color({ mediumslateblue, A}) -> { 123, 104, 238, A};
+name_to_color({ slateblue, A}) -> { 106, 90, 205, A};
+name_to_color({ darkslateblue, A}) -> { 72, 61, 139, A};
+name_to_color({ midnightblue, A}) -> { 25, 25, 112, A};
+name_to_color({ darkblue, A}) -> { 0, 0, 139, A};
+name_to_color({ mediumblue, A}) -> { 0, 0, 205, A};
+name_to_color({ dodgerblue, A}) -> { 30, 144, 255, A};
+name_to_color({ deepskyblue, A}) -> { 0, 191, 255, A};
+name_to_color({ lightskyblue, A}) -> { 135, 206, 250, A};
+name_to_color({ skyblue, A}) -> { 135, 206, 235, A};
+name_to_color({ lightblue, A}) -> { 173, 216, 230, A};
+name_to_color({ powderblue, A}) -> { 176, 224, 230, A};
+name_to_color({ azure, A}) -> { 240, 255, 255, A};
+name_to_color({ lightcyan, A}) -> { 224, 255, 255, A};
+name_to_color({ paleturquoise, A}) -> { 175, 238, 238, A};
+name_to_color({ mediumturquoise, A}) -> { 72, 209, 204, A};
+name_to_color({ lightseagreen, A}) -> { 32, 178, 170, A};
+name_to_color({ darkcyan, A}) -> { 0, 139, 139, A};
+name_to_color({ cadetblue, A}) -> { 95, 158, 160, A};
+name_to_color({ darkturquoise, A}) -> { 0, 206, 209, A};
+name_to_color({ cyan, A}) -> { 0, 255, 255, A};
+name_to_color({ turquoise, A}) -> { 64, 224, 208, A};
+name_to_color({ aquamarine, A}) -> { 127, 255, 212, A};
+name_to_color({ mediumaquamarine, A}) -> { 102, 205, 170, A};
+name_to_color({ darkseagreen, A}) -> { 143, 188, 143, A};
+name_to_color({ mediumseagreen, A}) -> { 60, 179, 113, A};
+name_to_color({ seagreen, A}) -> { 46, 139, 87, A};
+name_to_color({ darkgreen, A}) -> { 0, 100, 0, A};
+name_to_color({ forestgreen, A}) -> { 34, 139, 34, A};
+name_to_color({ limegreen, A}) -> { 50, 205, 50, A};
+name_to_color({ chartreuse, A}) -> { 127, 255, 0, A};
+name_to_color({ lawngreen, A}) -> { 124, 252, 0, A};
+name_to_color({ greenyellow, A}) -> { 173, 255, 47, A};
+name_to_color({ yellowgreen, A}) -> { 154, 205, 50, A};
+name_to_color({ palegreen, A}) -> { 152, 251, 152, A};
+name_to_color({ lightgreen, A}) -> { 144, 238, 144, A};
+name_to_color({ springgreen, A}) -> { 0, 255, 127, A};
+name_to_color({ mediumspringgreen, A}) -> { 0, 250, 154, A};
+name_to_color({ darkolivegreen, A}) -> { 85, 107, 47, A};
+name_to_color({ olivedrab, A}) -> { 107, 142, 35, A};
+name_to_color({ darkkhaki, A}) -> { 189, 183, 107, A};
+name_to_color({ darkgoldenrod, A}) -> { 184, 134, 11, A};
+name_to_color({ goldenrod, A}) -> { 218, 165, 32, A};
+name_to_color({ gold, A}) -> { 255, 215, 0, A};
+name_to_color({ khaki, A}) -> { 240, 230, 140, A};
+name_to_color({ palegoldenrod, A}) -> { 238, 232, 170, A};
+name_to_color({ blanchedalmond, A}) -> { 255, 235, 205, A};
+name_to_color({ moccasin, A}) -> { 255, 228, 181, A};
+name_to_color({ wheat, A}) -> { 245, 222, 179, A};
+name_to_color({ navajowhite, A}) -> { 255, 222, 173, A};
+name_to_color({ burlywood, A}) -> { 222, 184, 135, A};
+name_to_color({ tan, A}) -> { 210, 180, 140, A};
+name_to_color({ rosybrown, A}) -> { 188, 143, 143, A};
+name_to_color({ sienna, A}) -> { 160, 82, 45, A};
+name_to_color({ saddlebrown, A}) -> { 139, 69, 19, A};
+name_to_color({ chocolate, A}) -> { 210, 105, 30, A};
+name_to_color({ peru, A}) -> { 205, 133, 63, A};
+name_to_color({ sandybrown, A}) -> { 244, 164, 96, A};
+name_to_color({ darkred, A}) -> { 139, 0, 0, A};
+name_to_color({ brown, A}) -> { 165, 42, 42, A};
+name_to_color({ firebrick, A}) -> { 178, 34, 34, A};
+name_to_color({ indianred, A}) -> { 205, 92, 92, A};
+name_to_color({ lightcoral, A}) -> { 240, 128, 128, A};
+name_to_color({ salmon, A}) -> { 250, 128, 114, A};
+name_to_color({ darksalmon, A}) -> { 233, 150, 122, A};
+name_to_color({ lightsalmon, A}) -> { 255, 160, 122, A};
+name_to_color({ coral, A}) -> { 255, 127, 80, A};
+name_to_color({ tomato, A}) -> { 255, 99, 71, A};
+name_to_color({ darkorange, A}) -> { 255, 140, 0, A};
+name_to_color({ orange, A}) -> { 255, 165, 0, A};
+name_to_color({ orangered, A}) -> { 255, 69, 0, A};
+name_to_color({ crimson, A}) -> { 220, 20, 60, A};
+name_to_color({ deeppink, A}) -> { 255, 20, 147, A};
+name_to_color({ fuchsia, A}) -> { 255, 0, 255, A};
+name_to_color({ magenta, A}) -> { 255, 0, 255, A};
+name_to_color({ hotpink, A}) -> { 255, 105, 180, A};
+name_to_color({ lightpink, A}) -> { 255, 182, 193, A};
+name_to_color({ pink, A}) -> { 255, 192, 203, A};
+name_to_color({ palevioletred, A}) -> { 219, 112, 147, A};
+name_to_color({ mediumvioletred, A}) -> { 199, 21, 133, A};
+name_to_color({ darkmagenta, A}) -> { 139, 0, 139, A};
+name_to_color({ mediumpurple, A}) -> { 147, 112, 219, A};
+name_to_color({ blueviolet, A}) -> { 138, 43, 226, A};
+name_to_color({ indigo, A}) -> { 75, 0, 130, A};
+name_to_color({ darkviolet, A}) -> { 148, 0, 211, A};
+name_to_color({ darkorchid, A}) -> { 153, 50, 204, A};
+name_to_color({ mediumorchid, A}) -> { 186, 85, 211, A};
+name_to_color({ orchid, A}) -> { 218, 112, 214, A};
+name_to_color({ violet, A}) -> { 238, 130, 238, A};
+name_to_color({ plum, A}) -> { 221, 160, 221, A};
+name_to_color({ thistle, A}) -> { 216, 191, 216, A};
+name_to_color({ lavender, A}) -> { 230, 230, 250, A};
+name_to_color({ ghostwhite, A}) -> { 248, 248, 255, A};
+name_to_color({ aliceblue, A}) -> { 240, 248, 255, A};
+name_to_color({ mintcream, A}) -> { 245, 255, 250, A};
+name_to_color({ honeydew, A}) -> { 240, 255, 240, A};
+name_to_color({ lightgoldenrodyellow, A}) -> { 250, 250, 210, A};
+name_to_color({ lemonchiffon, A}) -> { 255, 250, 205, A};
+name_to_color({ cornsilk, A}) -> { 255, 248, 220, A};
+name_to_color({ lightyellow, A}) -> { 255, 255, 224, A};
+name_to_color({ ivory, A}) -> { 255, 255, 240, A};
+name_to_color({ floralwhite, A}) -> { 255, 250, 240, A};
+name_to_color({ linen, A}) -> { 250, 240, 230, A};
+name_to_color({ oldlace, A}) -> { 253, 245, 230, A};
+name_to_color({ antiquewhite, A}) -> { 250, 235, 215, A};
+name_to_color({ bisque, A}) -> { 255, 228, 196, A};
+name_to_color({ peachpuff, A}) -> { 255, 218, 185, A};
+name_to_color({ papayawhip, A}) -> { 255, 239, 213, A};
+name_to_color({ beige, A}) -> { 245, 245, 220, A};
+name_to_color({ seashell, A}) -> { 255, 245, 238, A};
+name_to_color({ lavenderblush, A}) -> { 255, 240, 245, A};
+name_to_color({ mistyrose, A}) -> { 255, 228, 225, A};
+name_to_color({ snow, A}) -> { 255, 250, 250, A};
+name_to_color({ whitesmoke, A}) -> { 245, 245, 245, A};
+name_to_color({ gainsboro, A}) -> { 220, 220, 220, A};
+name_to_color({ lightgrey, A}) -> { 211, 211, 211, A};
+name_to_color({ darkgray, A}) -> { 169, 169, 169, A};
+name_to_color({ lightslategray, A}) -> { 119, 136, 153, A};
+name_to_color({ slategray, A}) -> { 112, 128, 144, A};
+name_to_color({ dimgray, A}) -> { 105, 105, 105, A};
+name_to_color({ darkslategray, A}) -> { 47, 79, 79, A}.
+
+%% Crayons
+%name_to_color({crayon, mahogany, A}) -> { 205, 74, 74, A};
+%name_to_color({crayon, 'fuzzy wuzzy brown', A}) -> { 204, 102, 102, A};
+%name_to_color({crayon, chestnut, A}) -> { 188, 93, 88, A};
+%name_to_color({crayon, 'red orange', A}) -> { 255, 83, 73, A};
+%name_to_color({crayon, 'sunset orange', A}) -> { 253, 94, 83, A};
+%name_to_color({crayon, bittersweet, A}) -> { 253, 124, 110, A};
+%name_to_color({crayon, melon, A}) -> { 253, 188, 180, A};
+%name_to_color({crayon, 'outrageous orange', A}) -> { 255, 110, 74, A};
+%name_to_color({crayon, 'vivid tangerine', A}) -> { 255, 160, 137, A};
+%name_to_color({crayon, 'burnt sienna', A}) -> { 234, 126, 93, A};
+%name_to_color({crayon, brown, A}) -> { 180, 103, 77, A};
+%name_to_color({crayon, sepia, A}) -> { 165, 105, 79, A};
+%name_to_color({crayon, orange, A}) -> { 255, 117, 56, A};
+%name_to_color({crayon, 'burnt orange', A}) -> { 255, 127, 73, A};
+%name_to_color({crayon, copper, A}) -> { 221, 148, 117, A};
+%name_to_color({crayon, 'mango tango', A}) -> { 255, 130, 67, A};
+%name_to_color({crayon, 'atomic tangerine', A}) -> { 255, 164, 116, A};
+%name_to_color({crayon, beaver, A}) -> { 159, 129, 112, A};
+%name_to_color({crayon, 'antique brass', A}) -> { 205, 149, 117, A};
+%name_to_color({crayon, 'desert sand', A}) -> { 239, 205, 184, A};
+%name_to_color({crayon, 'raw sienna', A}) -> { 214, 138, 89, A};
+%name_to_color({crayon, tumbleweed, A}) -> { 222, 170, 136, A};
+%name_to_color({crayon, tan, A}) -> { 250, 167, 108, A};
+%name_to_color({crayon, peach, A}) -> { 255, 207, 171, A};
+%name_to_color({crayon, 'macaroni and cheese', A}) -> { 255, 189, 136, A};
+%name_to_color({crayon, apricot, A}) -> { 253, 217, 181, A};
+%name_to_color({crayon, 'neon carrot', A}) -> { 255, 163, 67, A};
+%name_to_color({crayon, almond, A}) -> { 239, 219, 197, A};
+%name_to_color({crayon, 'yellow orange', A}) -> { 255, 182, 83, A};
+%name_to_color({crayon, gold, A}) -> { 231, 198, 151, A};
+%name_to_color({crayon, shadow, A}) -> { 138, 121, 93, A};
+%name_to_color({crayon, 'banana mania', A}) -> { 250, 231, 181, A};
+%name_to_color({crayon, sunglow, A}) -> { 255, 207, 72, A};
+%name_to_color({crayon, goldenrod, A}) -> { 252, 217, 117, A};
+%name_to_color({crayon, dandelion, A}) -> { 253, 219, 109, A};
+%name_to_color({crayon, yellow, A}) -> { 252, 232, 131, A};
+%name_to_color({crayon, 'green yellow', A}) -> { 240, 232, 145, A};
+%name_to_color({crayon, 'spring green', A}) -> { 236, 234, 190, A};
+%name_to_color({crayon, 'olive green', A}) -> { 186, 184, 108, A};
+%name_to_color({crayon, 'laser lemon', A}) -> { 253, 252, 116, A};
+%name_to_color({crayon, 'unmellow yellow', A}) -> { 253, 252, 116, A};
+%name_to_color({crayon, canary, A}) -> { 255, 255, 153, A};
+%name_to_color({crayon, 'yellow green', A}) -> { 197, 227, 132, A};
+%name_to_color({crayon, 'inch worm', A}) -> { 178, 236, 93, A};
+%name_to_color({crayon, asparagus, A}) -> { 135, 169, 107, A};
+%name_to_color({crayon, 'granny smith apple', A}) -> { 168, 228, 160, A};
+%name_to_color({crayon, 'electric lime', A}) -> { 29, 249, 20, A};
+%name_to_color({crayon, 'screamin green', A}) -> { 118, 255, 122, A};
+%name_to_color({crayon, fern, A}) -> { 113, 188, 120, A};
+%name_to_color({crayon, 'forest green', A}) -> { 109, 174, 129, A};
+%name_to_color({crayon, 'sea green', A}) -> { 159, 226, 191, A};
+%name_to_color({crayon, green, A}) -> { 28, 172, 120, A};
+%name_to_color({crayon, 'mountain meadow', A}) -> { 48, 186, 143, A};
+%name_to_color({crayon, shamrock, A}) -> { 69, 206, 162, A};
+%name_to_color({crayon, 'jungle green', A}) -> { 59, 176, 143, A};
+%name_to_color({crayon, 'caribbean green', A}) -> { 28, 211, 162, A};
+%name_to_color({crayon, 'tropical rain forest', A}) -> { 23, 128, 109, A};
+%name_to_color({crayon, 'pine green', A}) -> { 21, 128, 120, A};
+%name_to_color({crayon, 'robin egg blue', A}) -> { 31, 206, 203, A};
+%name_to_color({crayon, aquamarine, A}) -> { 120, 219, 226, A};
+%name_to_color({crayon, 'turquoise blue', A}) -> { 119, 221, 231, A};
+%name_to_color({crayon, 'sky blue', A}) -> { 128, 218, 235, A};
+%name_to_color({crayon, 'outer space', A}) -> { 65, 74, 76, A};
+%name_to_color({crayon, 'blue green', A}) -> { 25, 158, 189, A};
+%name_to_color({crayon, 'pacific blue', A}) -> { 28, 169, 201, A};
+%name_to_color({crayon, cerulean, A}) -> { 29, 172, 214, A};
+%name_to_color({crayon, cornflower, A}) -> { 154, 206, 235, A};
+%name_to_color({crayon, 'midnight blue', A}) -> { 26, 72, 118, A};
+%name_to_color({crayon, 'navy blue', A}) -> { 25, 116, 210, A};
+%name_to_color({crayon, denim, A}) -> { 43, 108, 196, A};
+%name_to_color({crayon, blue, A}) -> { 31, 117, 254, A};
+%name_to_color({crayon, periwinkle, A}) -> { 197, 208, 230, A};
+%name_to_color({crayon, 'cadet blue', A}) -> { 176, 183, 198, A};
+%name_to_color({crayon, indigo, A}) -> { 93, 118, 203, A};
+%name_to_color({crayon, 'wild blue yonder', A}) -> { 162, 173, 208, A};
+%name_to_color({crayon, manatee, A}) -> { 151, 154, 170, A};
+%name_to_color({crayon, 'blue bell', A}) -> { 173, 173, 214, A};
+%name_to_color({crayon, 'blue violet', A}) -> { 115, 102, 189, A};
+%name_to_color({crayon, 'purple heart', A}) -> { 116, 66, 200, A};
+%name_to_color({crayon, 'royal purple', A}) -> { 120, 81, 169, A};
+%name_to_color({crayon, 'purple mountains majesty', A}) -> { 157, 129, 186, A};
+%name_to_color({crayon, violet, A}) -> { 146, 110, 174, A};
+%name_to_color({crayon, wisteria, A}) -> { 205, 164, 222, A};
+%name_to_color({crayon, 'vivid violet', A}) -> { 143, 80, 157, A};
+%name_to_color({crayon, fuchsia, A}) -> { 195, 100, 197, A};
+%name_to_color({crayon, 'shocking pink', A}) -> { 251, 126, 253, A};
+%name_to_color({crayon, 'pink flamingo', A}) -> { 252, 116, 253, A};
+%name_to_color({crayon, plum, A}) -> { 142, 69, 133, A};
+%name_to_color({crayon, 'hot magenta', A}) -> { 255, 29, 206, A};
+%name_to_color({crayon, 'purple pizzazz', A}) -> { 255, 29, 206, A};
+%name_to_color({crayon, 'razzle dazzle rose', A}) -> { 255, 72, 208, A};
+%name_to_color({crayon, orchid, A}) -> { 230, 168, 215, A};
+%name_to_color({crayon, 'red violet', A}) -> { 192, 68, 143, A};
+%name_to_color({crayon, eggplant, A}) -> { 110, 81, 96, A};
+%name_to_color({crayon, cerise, A}) -> { 221, 68, 146, A};
+%name_to_color({crayon, 'wild strawberry', A}) -> { 255, 67, 164, A};
+%name_to_color({crayon, magenta, A}) -> { 246, 100, 175, A};
+%name_to_color({crayon, lavender, A}) -> { 252, 180, 213, A};
+%name_to_color({crayon, 'cotton candy', A}) -> { 255, 188, 217, A};
+%name_to_color({crayon, 'violet red', A}) -> { 247, 83, 148, A};
+%name_to_color({crayon, 'carnation pink', A}) -> { 255, 170, 204, A};
+%name_to_color({crayon, razzmatazz, A}) -> { 227, 37, 107, A};
+%name_to_color({crayon, 'piggy pink', A}) -> { 253, 215, 228, A};
+%name_to_color({crayon, 'jazzberry jam', A}) -> { 202, 55, 103, A};
+%name_to_color({crayon, blush, A}) -> { 222, 93, 131, A};
+%name_to_color({crayon, 'tickle me pink', A}) -> { 252, 137, 172, A};
+%name_to_color({crayon, 'pink sherbet', A}) -> { 247, 128, 161, A};
+%name_to_color({crayon, maroon, A}) -> { 200, 56, 90, A};
+%name_to_color({crayon, red, A}) -> { 238, 32, 77, A};
+%name_to_color({crayon, 'radical red', A}) -> { 255, 73, 108, A};
+%name_to_color({crayon, mauvelous, A}) -> { 239, 152, 170, A};
+%name_to_color({crayon, 'wild watermelon', A}) -> { 252, 108, 133, A};
+%name_to_color({crayon, scarlet, A}) -> { 252, 40, 71, A};
+%name_to_color({crayon, salmon, A}) -> { 255, 155, 170, A};
+%name_to_color({crayon, 'brick red', A}) -> { 203, 65, 84, A};
+%name_to_color({crayon, white, A}) -> { 237, 237, 237, A};
+%name_to_color({crayon, timberwolf, A}) -> { 219, 215, 210, A};
+%name_to_color({crayon, silver, A}) -> { 205, 197, 194, A};
+%name_to_color({crayon, gray, A}) -> { 149, 145, 140, A};
+%name_to_color({crayon, black, A}) -> { 35, 35, 35, A}.
+
+
+text(I, {Xs,Ys} = Sp, Font, Text, Color) ->
+ {FW,FH} = egd_font:size(Font),
+ Length = length(Text),
+ Ep = {Xs + Length*FW, Ys + FH + 5},
+ I#image{objects = [
+ #image_object{
+ type = text_horizontal,
+ points = [Sp],
+ span = span([Sp,Ep]),
+ internals = {Font, Text},
+ color = Color} | I#image.objects]}.
+
+
+%%% Generic transformations
+
+%% arc_to_edges
+%% In:
+%% P1 :: point(),
+%% P2 :: point(),
+%% D :: float(),
+%% Out:
+%% Res :: [edges()]
+
+arc_to_edges(P0, P1, D) when abs(D) < 0.5 -> [{P0,P1}];
+arc_to_edges({X0,Y0}, {X1,Y1}, D) ->
+ Vx = X1 - X0,
+ Vy = Y1 - Y0,
+
+ Mx = X0 + 0.5 * Vx,
+ My = Y0 + 0.5 * Vy,
+
+ % Scale V by Rs
+ L = math:sqrt(Vx*Vx + Vy*Vy),
+ Sx = D*Vx/L,
+ Sy = D*Vy/L,
+
+ Bx = trunc(Mx - Sy),
+ By = trunc(My + Sx),
+
+ arc_to_edges({X0,Y0}, {Bx,By}, D/4) ++ arc_to_edges({Bx,By}, {X1,Y1}, D/4).
+
+%% edges
+%% In:
+%% Pts :: [point()]
+%% Out:
+%% Edges :: [{point(),point()}]
+
+edges([]) -> [];
+edges([P0|_] = Pts) -> edges(Pts, P0,[]).
+edges([P1], P0, Out) -> [{P1,P0}|Out];
+edges([P1,P2|Pts],P0,Out) -> edges([P2|Pts],P0,[{P1,P2}|Out]).
+
+%% convex_hull
+%% In:
+%% Ps :: [point()]
+%% Out:
+%% Res :: [point()]
+
+convex_hull(Ps) ->
+ P0 = lower_right(Ps),
+ [P1|Ps1] = lists:sort(fun
+ (P2,P1) ->
+ case point_side({P1,P0},P2) of
+ left -> true;
+ _ -> false
+ end
+ end, Ps -- [P0]),
+ convex_hull(Ps1, [P1,P0]).
+
+convex_hull([], W) -> W;
+convex_hull([P|Pts], [P1,P2|W]) ->
+ case point_side({P2,P1},P) of
+ left -> convex_hull(Pts, [P,P1,P2|W]);
+ _ -> convex_hull([P|Pts], [P2|W])
+ end.
+
+lower_right([P|Pts]) -> lower_right(P, Pts).
+lower_right(P, []) -> P;
+lower_right({X0,Y0}, [{_,Y}|Pts]) when Y < Y0 -> lower_right({X0,Y0}, Pts);
+lower_right({X0,Y0}, [{X,Y}|Pts]) when X < X0, Y < Y0 -> lower_right({X0,Y0}, Pts);
+lower_right(_,[P|Pts]) -> lower_right(P, Pts).
+
+point_side({{X0,Y0}, {X1, Y1}}, {X2, Y2}) -> point_side((X1 - X0)*(Y2 - Y0) - (X2 - X0)*(Y1 - Y0)).
+point_side(D) when D > 0 -> left;
+point_side(D) when D < 0 -> right;
+point_side(_) -> on_line.
+
+%% AUX
+
+span(Points) ->
+ Xs = [TX||{TX, _} <- Points],
+ Ys = [TY||{_, TY} <- Points],
+ Xmin = lists:min(Xs),
+ Xmax = lists:max(Xs),
+ Ymin = lists:min(Ys),
+ Ymax = lists:max(Ys),
+ {Xmin,Ymin,Xmax,Ymax}.
+
+rgb_float2byte({R,G,B}) -> rgb_float2byte({R,G,B,1.0});
+rgb_float2byte({R,G,B,A}) ->
+ {trunc(R*255), trunc(G*255), trunc(B*255), trunc(A*255)}.
+
+rgba_byte2float({R,G,B,A}) ->
+ {R/255,G/255,B/255,A/255}.
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".
diff --git a/lib/percept/src/percept.app.src b/lib/percept/src/percept.app.src
new file mode 100644
index 0000000000..c70fede721
--- /dev/null
+++ b/lib/percept/src/percept.app.src
@@ -0,0 +1,30 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2007-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%
+%%
+
+{application,percept,
+ [{description, "PERCEPT Erlang Concurrency Profiling Tool"},
+ {vsn, "%VSN%"},
+ {modules, [percept,percept_db,percept_html,percept_graph,percept_analyzer]},
+ {registered, [percept_db,percept_port]},
+ {applications, [kernel,stdlib]},
+ {env, []}
+ ]}.
+
+
+
diff --git a/lib/percept/src/percept.appup.src b/lib/percept/src/percept.appup.src
new file mode 100644
index 0000000000..4fc2852878
--- /dev/null
+++ b/lib/percept/src/percept.appup.src
@@ -0,0 +1,21 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2007-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%
+%%
+
+{"%VSN%",[],[]}.
+
diff --git a/lib/percept/src/percept.erl b/lib/percept/src/percept.erl
new file mode 100644
index 0000000000..af1a920efd
--- /dev/null
+++ b/lib/percept/src/percept.erl
@@ -0,0 +1,337 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2007-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 Percept - Erlang Concurrency Profiling Tool
+%%
+%% This module provides the user interface for the application.
+%%
+
+-module(percept).
+-behaviour(application).
+-export([
+ profile/1,
+ profile/2,
+ profile/3,
+ stop_profile/0,
+ start_webserver/0,
+ start_webserver/1,
+ stop_webserver/0,
+ stop_webserver/1,
+ analyze/1,
+ % Application behaviour
+ start/2,
+ stop/1]).
+
+
+-include("percept.hrl").
+
+%%==========================================================================
+%%
+%% Type definitions
+%%
+%%==========================================================================
+
+%% @type percept_option() = procs | ports | exclusive
+
+-type(percept_option() :: 'procs' | 'ports' | 'exclusive' | 'scheduler').
+
+%%==========================================================================
+%%
+%% Application callback functions
+%%
+%%==========================================================================
+
+%% @spec start(Type, Args) -> {started, Hostname, Port} | {error, Reason}
+%% @doc none
+%% @hidden
+
+start(_Type, _Args) ->
+ %% start web browser service
+ start_webserver(0).
+
+%% @spec stop(State) -> ok
+%% @doc none
+%% @hidden
+
+stop(_State) ->
+ %% stop web browser service
+ stop_webserver(0).
+
+%%==========================================================================
+%%
+%% Interface functions
+%%
+%%==========================================================================
+
+%% @spec profile(Filename::string()) -> {ok, Port} | {already_started, Port}
+%% @see percept_profile
+
+%% profiling
+
+-spec(profile/1 :: (Filename :: string()) ->
+ {'ok', port()} | {'already_started', port()}).
+
+profile(Filename) ->
+ percept_profile:start(Filename, [procs]).
+
+%% @spec profile(Filename::string(), [percept_option()]) -> {ok, Port} | {already_started, Port}
+%% @see percept_profile
+
+-spec(profile/2 :: (
+ Filename :: string(),
+ Options :: [percept_option()]) ->
+ {'ok', port()} | {'already_started', port()}).
+
+profile(Filename, Options) ->
+ percept_profile:start(Filename, Options).
+
+%% @spec profile(Filename::string(), MFA::mfa(), [percept_option()]) -> ok | {already_started, Port} | {error, not_started}
+%% @see percept_profile
+
+-spec(profile/3 :: (
+ Filename :: string(),
+ Entry :: {atom(), atom(), list()},
+ Options :: [percept_option()]) ->
+ 'ok' | {'already_started', port()} | {'error', 'not_started'}).
+
+profile(Filename, MFA, Options) ->
+ percept_profile:start(Filename, MFA, Options).
+
+-spec(stop_profile/0 :: () -> 'ok' | {'error', 'not_started'}).
+
+%% @spec stop_profile() -> ok | {'error', 'not_started'}
+%% @see percept_profile
+
+stop_profile() ->
+ percept_profile:stop().
+
+%% @spec analyze(string()) -> ok | {error, Reason}
+%% @doc Analyze file.
+
+-spec(analyze/1 :: (Filename :: string()) ->
+ 'ok' | {'error', any()}).
+
+analyze(Filename) ->
+ case percept_db:start() of
+ {started, DB} ->
+ parse_and_insert(Filename,DB);
+ {restarted, DB} ->
+ parse_and_insert(Filename,DB)
+ end.
+
+%% @spec start_webserver() -> {started, Hostname, Port} | {error, Reason}
+%% Hostname = string()
+%% Port = integer()
+%% Reason = term()
+%% @doc Starts webserver.
+
+-spec(start_webserver/0 :: () ->
+ {'started', string(), pos_integer()} |
+ {'error', any()}).
+
+start_webserver() ->
+ start_webserver(0).
+
+%% @spec start_webserver(integer()) -> {started, Hostname, AssignedPort} | {error, Reason}
+%% Hostname = string()
+%% AssignedPort = integer()
+%% Reason = term()
+%% @doc Starts webserver. If port number is 0, an available port number will
+%% be assigned by inets.
+
+-spec(start_webserver/1 :: (Port :: non_neg_integer()) ->
+ {'started', string(), pos_integer()} |
+ {'error', any()}).
+
+start_webserver(Port) when is_integer(Port) ->
+ application:load(percept),
+ case whereis(percept_httpd) of
+ undefined ->
+ {ok, Config} = get_webserver_config("percept", Port),
+ inets:start(),
+ case inets:start(httpd, Config) of
+ {ok, Pid} ->
+ AssignedPort = find_service_port_from_pid(inets:services_info(), Pid),
+ {ok, Host} = inet:gethostname(),
+ %% workaround until inets can get me a service from a name.
+ Mem = spawn(fun() -> service_memory({Pid,AssignedPort,Host}) end),
+ register(percept_httpd, Mem),
+ {started, Host, AssignedPort};
+ {error, Reason} ->
+ {error, {inets, Reason}}
+ end;
+ _ ->
+ {error, already_started}
+ end.
+
+%% @spec stop_webserver() -> ok | {error, not_started}
+%% @doc Stops webserver.
+
+stop_webserver() ->
+ case whereis(percept_httpd) of
+ undefined ->
+ {error, not_started};
+ Pid ->
+ Pid ! {self(), get_port},
+ receive Port -> ok end,
+ Pid ! quit,
+ stop_webserver(Port)
+ end.
+
+%% @spec stop_webserver(integer()) -> ok | {error, not_started}
+%% @doc Stops webserver of the given port.
+%% @hidden
+
+stop_webserver(Port) ->
+ case find_service_pid_from_port(inets:services_info(), Port) of
+ undefined ->
+ {error, not_started};
+ Pid ->
+ inets:stop(httpd, Pid)
+ end.
+
+%%==========================================================================
+%%
+%% Auxiliary functions
+%%
+%%==========================================================================
+
+%% parse_and_insert
+
+parse_and_insert(Filename, DB) ->
+ io:format("Parsing: ~p ~n", [Filename]),
+ T0 = erlang:now(),
+ Pid = dbg:trace_client(file, Filename, mk_trace_parser(self())),
+ Ref = erlang:monitor(process, Pid),
+ parse_and_insert_loop(Filename, Pid, Ref, DB, T0).
+
+parse_and_insert_loop(Filename, Pid, Ref, DB, T0) ->
+ receive
+ {'DOWN',Ref,process, Pid, noproc} ->
+ io:format("Incorrect file or malformed trace file: ~p~n", [Filename]),
+ {error, file};
+ {parse_complete, {Pid, Count}} ->
+ receive {'DOWN', Ref, process, Pid, normal} -> ok after 0 -> ok end,
+ DB ! {action, consolidate},
+ T1 = erlang:now(),
+ io:format("Parsed ~p entries in ~p s.~n", [Count, ?seconds(T1, T0)]),
+ io:format(" ~p created processes.~n", [length(percept_db:select({information, procs}))]),
+ io:format(" ~p opened ports.~n", [length(percept_db:select({information, ports}))]),
+ ok;
+ {'DOWN',Ref, process, Pid, normal} -> parse_and_insert_loop(Filename, Pid, Ref, DB, T0);
+ {'DOWN',Ref, process, Pid, Reason} -> {error, Reason}
+ end.
+
+mk_trace_parser(Pid) ->
+ {fun trace_parser/2, {0, Pid}}.
+
+trace_parser(end_of_trace, {Count, Pid}) ->
+ Pid ! {parse_complete, {self(),Count}},
+ receive
+ {ack, Pid} ->
+ ok
+ end;
+trace_parser(Trace, {Count, Pid}) ->
+ percept_db:insert(Trace),
+ {Count + 1, Pid}.
+
+find_service_pid_from_port([], _) ->
+ undefined;
+find_service_pid_from_port([{_, Pid, Options} | Services], Port) ->
+ case lists:keysearch(port, 1, Options) of
+ false ->
+ find_service_pid_from_port(Services, Port);
+ {value, {port, Port}} ->
+ Pid
+ end.
+
+find_service_port_from_pid([], _) ->
+ undefined;
+find_service_port_from_pid([{_, Pid, Options} | _], Pid) ->
+ case lists:keysearch(port, 1, Options) of
+ false ->
+ undefined;
+ {value, {port, Port}} ->
+ Port
+ end;
+find_service_port_from_pid([{_, _, _} | Services], Pid) ->
+ find_service_port_from_pid(Services, Pid).
+
+%% service memory
+
+service_memory({Pid, Port, Host}) ->
+ receive
+ quit ->
+ ok;
+ {Reply, get_port} ->
+ Reply ! Port,
+ service_memory({Pid, Port, Host});
+ {Reply, get_host} ->
+ Reply ! Host,
+ service_memory({Pid, Port, Host});
+ {Reply, get_pid} ->
+ Reply ! Pid,
+ service_memory({Pid, Port, Host})
+ end.
+
+% Create config data for the webserver
+
+get_webserver_config(Servername, Port) when is_list(Servername), is_integer(Port) ->
+ Path = code:priv_dir(percept),
+ Root = filename:join([Path, "server_root"]),
+ MimeTypesFile = filename:join([Root,"conf","mime.types"]),
+ {ok, MimeTypes} = httpd_conf:load_mime_types(MimeTypesFile),
+ Config = [
+ % Roots
+ {server_root, Root},
+ {document_root,filename:join([Root, "htdocs"])},
+
+ % Aliases
+ {eval_script_alias,{"/eval",[io]}},
+ {erl_script_alias,{"/cgi-bin",[percept_graph,percept_html,io]}},
+ {script_alias,{"/cgi-bin/", filename:join([Root, "cgi-bin"])}},
+ {alias,{"/javascript/",filename:join([Root, "scripts"]) ++ "/"}},
+ {alias,{"/images/", filename:join([Root, "images"]) ++ "/"}},
+ {alias,{"/css/", filename:join([Root, "css"]) ++ "/"}},
+
+ % Logs
+ %{transfer_log, filename:join([Path, "logs", "transfer.log"])},
+ %{error_log, filename:join([Path, "logs", "error.log"])},
+
+ % Configs
+ {default_type,"text/plain"},
+ {directory_index,["index.html"]},
+ {mime_types, MimeTypes},
+ {modules,[mod_alias,
+ mod_esi,
+ mod_actions,
+ mod_cgi,
+ mod_include,
+ mod_dir,
+ mod_get,
+ mod_head
+ % mod_log,
+ % mod_disk_log
+ ]},
+ {com_type,ip_comm},
+ {server_name, Servername},
+ {bind_address, any},
+ {port, Port}],
+ {ok, Config}.
diff --git a/lib/percept/src/percept.hrl b/lib/percept/src/percept.hrl
new file mode 100644
index 0000000000..a9afceb6d1
--- /dev/null
+++ b/lib/percept/src/percept.hrl
@@ -0,0 +1,53 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2007-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%
+%%
+
+-define(seconds(EndTs,StartTs), timer:now_diff(EndTs, StartTs)/1000000).
+
+%%% ------------------- %%%
+%%% Type definitions %%%
+%%% ------------------- %%%
+
+-type(timestamp() :: {non_neg_integer(), non_neg_integer(), non_neg_integer()}).
+-type(true_mfa() :: {atom(), atom(), byte() | list()}).
+-type(state() :: 'active' | 'inactive').
+-type(scheduler_id() :: {'scheduler_id', non_neg_integer()}).
+
+%%% ------------------- %%%
+%%% Records %%%
+%%% ------------------- %%%
+
+-record(activity, {
+ timestamp ,%:: timestamp() ,
+ id ,%:: pid() | port() | scheduler_id(),
+ state = undefined ,%:: state() | 'undefined',
+ where = undefined ,%:: true_mfa() | 'undefined',
+ runnable_count = 0 %:: non_neg_integer()
+ }).
+
+-record(
+ information, {
+ id ,%:: pid() | port(),
+ name = undefined ,%:: atom() | string() | 'undefined',
+ entry = undefined ,%:: true_mfa() | 'undefined',
+ start = undefined ,%:: timestamp() | 'undefined',
+ stop = undefined ,%:: timestamp() | 'undefined',
+ parent = undefined ,%:: pid() | 'undefined',
+ children = [] %:: [pid()]
+ }).
+
diff --git a/lib/percept/src/percept_analyzer.erl b/lib/percept/src/percept_analyzer.erl
new file mode 100644
index 0000000000..a5440e4cd2
--- /dev/null
+++ b/lib/percept/src/percept_analyzer.erl
@@ -0,0 +1,367 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2007-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 Utility functions to operate on percept data. These functions should
+%% be considered experimental. Behaviour may change in future releases.
+
+-module(percept_analyzer).
+-export([
+ minmax/1,
+ waiting_activities/1,
+ activities2count/2,
+ activities2count/3,
+ activities2count2/2,
+ analyze_activities/2,
+ runnable_count/1,
+ runnable_count/2,
+ seconds2ts/2,
+ minmax_activities/2,
+ mean/1
+ ]).
+
+-include("percept.hrl").
+
+%%==========================================================================
+%%
+%% Interface functions
+%%
+%%==========================================================================
+
+
+%% @spec minmax([{X, Y}]) -> {MinX, MinY, MaxX, MaxY}
+%% X = number()
+%% Y = number()
+%% MinX = number()
+%% MinY = number()
+%% MaxX = number()
+%% MaxY = number()
+%% @doc Returns the min and max of a set of 2-dimensional numbers.
+
+minmax(Data) ->
+ Xs = [ X || {X,_Y} <- Data],
+ Ys = [ Y || {_X, Y} <- Data],
+ {lists:min(Xs), lists:min(Ys), lists:max(Xs), lists:max(Ys)}.
+
+%% @spec mean([number()]) -> {Mean, StdDev, N}
+%% Mean = float()
+%% StdDev = float()
+%% N = integer()
+%% @doc Calculates the mean and the standard deviation of a set of
+%% numbers.
+
+mean([]) -> {0, 0, 0};
+mean([Value]) -> {Value, 0, 1};
+mean(List) -> mean(List, {0, 0, 0}).
+
+mean([], {Sum, SumSquare, N}) ->
+ Mean = Sum / N,
+ StdDev = math:sqrt((SumSquare - Sum*Sum/N)/(N - 1)),
+ {Mean, StdDev, N};
+mean([Value | List], {Sum, SumSquare, N}) ->
+ mean(List, {Sum + Value, SumSquare + Value*Value, N + 1}).
+
+
+
+activities2count2(Acts, StartTs) ->
+ Start = inactive_start_states(Acts),
+ activities2count2(Acts, StartTs, Start, []).
+
+activities2count2([], _, _, Out) -> lists:reverse(Out);
+activities2count2([#activity{ id = Id, timestamp = Ts, state = active} | Acts], StartTs, {Proc,Port}, Out) when is_pid(Id) ->
+ activities2count2(Acts, StartTs, {Proc + 1, Port}, [{?seconds(Ts, StartTs), Proc + 1, Port}|Out]);
+activities2count2([#activity{ id = Id, timestamp = Ts, state = inactive} | Acts], StartTs, {Proc,Port}, Out) when is_pid(Id) ->
+ activities2count2(Acts, StartTs, {Proc - 1, Port}, [{?seconds(Ts, StartTs), Proc - 1, Port}|Out]);
+activities2count2([#activity{ id = Id, timestamp = Ts, state = active} | Acts], StartTs, {Proc,Port}, Out) when is_port(Id) ->
+ activities2count2(Acts, StartTs, {Proc, Port + 1}, [{?seconds(Ts, StartTs), Proc, Port + 1}|Out]);
+activities2count2([#activity{ id = Id, timestamp = Ts, state = inactive} | Acts], StartTs, {Proc,Port}, Out) when is_port(Id) ->
+ activities2count2(Acts, StartTs, {Proc, Port - 1}, [{?seconds(Ts, StartTs), Proc, Port - 1}|Out]).
+
+
+inactive_start_states(Acts) ->
+ D = activity_start_states(Acts, dict:new()),
+ dict:fold(fun
+ (K, inactive, {Procs, Ports}) when is_pid(K) -> {Procs + 1, Ports};
+ (K, inactive, {Procs, Ports}) when is_port(K) -> {Procs, Ports + 1};
+ (_, _, {Procs, Ports}) -> {Procs, Ports}
+ end, {0,0}, D).
+activity_start_states([], D) -> D;
+activity_start_states([#activity{id = Id, state = State}|Acts], D) ->
+ case dict:is_key(Id, D) of
+ true -> activity_start_states(Acts, D);
+ false -> activity_start_states(Acts, dict:store(Id, State, D))
+ end.
+
+
+
+
+%% @spec activities2count(#activity{}, timestamp()) -> Result
+%% Result = [{Time, ProcessCount, PortCount}]
+%% Time = float()
+%% ProcessCount = integer()
+%% PortCount = integer()
+%% @doc Calculate the resulting active processes and ports during
+%% the activity interval.
+%% Also checks active/inactive consistency.
+%% A task will always begin with an active state and end with an inactive state.
+
+activities2count(Acts, StartTs) when is_list(Acts) -> activities2count(Acts, StartTs, separated).
+
+activities2count(Acts, StartTs, Type) when is_list(Acts) -> activities2count_loop(Acts, {StartTs, {0,0}}, Type, []).
+
+activities2count_loop([], _, _, Out) -> lists:reverse(Out);
+activities2count_loop(
+ [#activity{ timestamp = Ts, id = Id, runnable_count = Rc} | Acts],
+ {StartTs, {Procs, Ports}}, separated, Out) ->
+
+ Time = ?seconds(Ts, StartTs),
+ case Id of
+ Id when is_port(Id) ->
+ Entry = {Time, Procs, Rc},
+ activities2count_loop(Acts, {StartTs, {Procs, Rc}}, separated, [Entry | Out]);
+ Id when is_pid(Id) ->
+ Entry = {Time, Rc, Ports},
+ activities2count_loop(Acts, {StartTs, {Rc, Ports}}, separated, [Entry | Out]);
+ _ ->
+ activities2count_loop(Acts, {StartTs,{Procs, Ports}}, separated, Out)
+ end;
+activities2count_loop(
+ [#activity{ timestamp = Ts, id = Id, runnable_count = Rc} | Acts],
+ {StartTs, {Procs, Ports}}, summated, Out) ->
+
+ Time = ?seconds(Ts, StartTs),
+ case Id of
+ Id when is_port(Id) ->
+ Entry = {Time, Procs + Rc},
+ activities2count_loop(Acts, {StartTs, {Procs, Rc}}, summated, [Entry | Out]);
+ Id when is_pid(Id) ->
+ Entry = {Time, Rc + Ports},
+ activities2count_loop(Acts, {StartTs, {Rc, Ports}}, summated, [Entry | Out])
+ end.
+
+%% @spec waiting_activities([#activity{}]) -> FunctionList
+%% FunctionList = [{Seconds, Mfa, {Mean, StdDev, N}}]
+%% Seconds = float()
+%% Mfa = mfa()
+%% Mean = float()
+%% StdDev = float()
+%% N = integer()
+%% @doc Calculates the time, both average and total, that a process has spent
+%% in a receive state at specific function. However, if there are multiple receives
+%% in a function it cannot differentiate between them.
+
+waiting_activities(Activities) ->
+ ListedMfas = waiting_activities_mfa_list(Activities, []),
+ Unsorted = lists:foldl(
+ fun (Mfa, MfaList) ->
+ {Total, WaitingTimes} = get({waiting_mfa, Mfa}),
+
+ % cleanup
+ erlang:erase({waiting_mfa, Mfa}),
+
+ % statistics of receive waiting places
+ Stats = mean(WaitingTimes),
+
+ [{Total, Mfa, Stats} | MfaList]
+ end, [], ListedMfas),
+ lists:sort(fun ({A,_,_},{B,_,_}) ->
+ if
+ A > B -> true;
+ true -> false
+ end
+ end, Unsorted).
+
+
+%% Generate lists of receive waiting times per mfa
+%% Out:
+%% ListedMfas = [mfa()]
+%% Intrisnic:
+%% get({waiting, mfa()}) ->
+%% [{waiting, mfa()}, {Total, [WaitingTime]})
+%% WaitingTime = float()
+
+waiting_activities_mfa_list([], ListedMfas) -> ListedMfas;
+waiting_activities_mfa_list([Activity|Activities], ListedMfas) ->
+ #activity{id = Pid, state = Act, timestamp = Time, where = MFA} = Activity,
+ case Act of
+ active ->
+ waiting_activities_mfa_list(Activities, ListedMfas);
+ inactive ->
+ % Want to know how long the wait is in a receive,
+ % it is given via the next activity
+ case Activities of
+ [] ->
+ [Info] = percept_db:select(information, Pid),
+ case Info#information.stop of
+ undefined ->
+ % get profile end time
+ Waited = ?seconds(
+ percept_db:select({system,stop_ts}),
+ Time);
+ Time2 ->
+ Waited = ?seconds(Time2, Time)
+ end,
+ case get({waiting_mfa, MFA}) of
+ undefined ->
+ put({waiting_mfa, MFA}, {Waited, [Waited]}),
+ [MFA | ListedMfas];
+ {Total, TimedMfa} ->
+ put({waiting_mfa, MFA}, {Total + Waited, [Waited | TimedMfa]}),
+ ListedMfas
+ end;
+ [#activity{timestamp=Time2, id = Pid, state = active} | _ ] ->
+ % Calculate waiting time
+ Waited = ?seconds(Time2, Time),
+ % Get previous entry
+
+ case get({waiting_mfa, MFA}) of
+ undefined ->
+ % add entry to list
+ put({waiting_mfa, MFA}, {Waited, [Waited]}),
+ waiting_activities_mfa_list(Activities, [MFA|ListedMfas]);
+ {Total, TimedMfa} ->
+ put({waiting_mfa, MFA}, {Total + Waited, [Waited | TimedMfa]}),
+ waiting_activities_mfa_list(Activities, ListedMfas)
+ end;
+ _ -> error
+ end
+ end.
+
+%% seconds2ts(Seconds, StartTs) -> TS
+%% In:
+%% Seconds = float()
+%% StartTs = timestamp()
+%% Out:
+%% TS = timestamp()
+
+%% @spec seconds2ts(float(), StartTs::{integer(),integer(),integer()}) -> timestamp()
+%% @doc Calculates a timestamp given a duration in seconds and a starting timestamp.
+
+seconds2ts(Seconds, {Ms, S, Us}) ->
+ % Calculate mega seconds integer
+ MsInteger = trunc(Seconds) div 1000000 ,
+
+ % Calculate the reminder for seconds
+ SInteger = trunc(Seconds),
+
+ % Calculate the reminder for micro seconds
+ UsInteger = trunc((Seconds - SInteger) * 1000000),
+
+ % Wrap overflows
+
+ UsOut = (UsInteger + Us) rem 1000000,
+ SOut = ((SInteger + S) + (UsInteger + Us) div 1000000) rem 1000000,
+ MsOut = (MsInteger+ Ms) + ((SInteger + S) + (UsInteger + Us) div 1000000) div 1000000,
+
+ {MsOut, SOut, UsOut}.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Analyze interval for concurrency
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% @spec analyze_activities(integer(), [#activity{}]) -> [{integer(),#activity{}}]
+%% @hidden
+
+analyze_activities(Threshold, Activities) ->
+ RunnableCount = runnable_count(Activities, 0),
+ analyze_runnable_activities(Threshold, RunnableCount).
+
+
+%% runnable_count(Activities, StartValue) -> RunnableCount
+%% In:
+%% Activities = [activity()]
+%% StartValue = integer()
+%% Out:
+%% RunnableCount = [{integer(), activity()}]
+%% Purpose:
+%% Calculate the runnable count of a given interval of generic
+%% activities.
+
+%% @spec runnable_count([#activity{}]) -> [{integer(),#activity{}}]
+%% @hidden
+
+runnable_count(Activities) ->
+ Threshold = runnable_count_threshold(Activities),
+ runnable_count(Activities, Threshold, []).
+
+runnable_count_threshold(Activities) ->
+ CountedActs = runnable_count(Activities, 0),
+ Counts = [C || {C, _} <- CountedActs],
+ Min = lists:min(Counts),
+ 0 - Min.
+%% @spec runnable_count([#activity{}],integer()) -> [{integer(),#activity{}}]
+%% @hidden
+
+runnable_count(Activities, StartCount) when is_integer(StartCount) ->
+ runnable_count(Activities, StartCount, []).
+runnable_count([], _ , Out) ->
+ lists:reverse(Out);
+runnable_count([A | As], PrevCount, Out) ->
+ case A#activity.state of
+ active ->
+ runnable_count(As, PrevCount + 1, [{PrevCount + 1, A} | Out]);
+ inactive ->
+ runnable_count(As, PrevCount - 1, [{PrevCount - 1, A} | Out])
+ end.
+
+%% In:
+%% Threshold = integer(),
+%% RunnableActivities = [{Rc, activity()}]
+%% Rc = integer()
+
+analyze_runnable_activities(Threshold, RunnableActivities) ->
+ analyze_runnable_activities(Threshold, RunnableActivities, []).
+
+analyze_runnable_activities( _z, [], Out) ->
+ lists:reverse(Out);
+analyze_runnable_activities(Threshold, [{Rc, Act} | RunnableActs], Out) ->
+ if
+ Rc =< Threshold ->
+ analyze_runnable_activities(Threshold, RunnableActs, [{Rc,Act} | Out]);
+ true ->
+ analyze_runnable_activities(Threshold, RunnableActs, Out)
+ end.
+
+%% minmax_activity(Activities, Count) -> {Min, Max}
+%% In:
+%% Activities = [activity()]
+%% InitialCount = non_neg_integer()
+%% Out:
+%% {Min, Max}
+%% Min = non_neg_integer()
+%% Max = non_neg_integer()
+%% Purpose:
+%% Minimal and maximal activity during an activity interval.
+%% Initial activity count needs to be supplied.
+
+%% @spec minmax_activities([#activity{}], integer()) -> {integer(), integer()}
+%% @doc Calculates the minimum and maximum of runnable activites (processes
+% and ports) during the interval of reffered by the activity list.
+
+minmax_activities(Activities, Count) ->
+ minmax_activities(Activities, Count, {Count, Count}).
+minmax_activities([], _, Out) ->
+ Out;
+minmax_activities([A|Acts], Count, {Min, Max}) ->
+ case A#activity.state of
+ active ->
+ minmax_activities(Acts, Count + 1, {Min, lists:max([Count + 1, Max])});
+ inactive ->
+ minmax_activities(Acts, Count - 1, {lists:min([Count - 1, Min]), Max})
+ end.
diff --git a/lib/percept/src/percept_db.erl b/lib/percept/src/percept_db.erl
new file mode 100644
index 0000000000..dc85fa3510
--- /dev/null
+++ b/lib/percept/src/percept_db.erl
@@ -0,0 +1,768 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2007-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 Percept database.
+%%
+%%
+
+-module(percept_db).
+
+-export([
+ start/0,
+ stop/0,
+ insert/1,
+ select/2,
+ select/1,
+ consolidate/0
+ ]).
+
+-include("percept.hrl").
+
+%%==========================================================================
+%%
+%% Type definitions
+%%
+%%==========================================================================
+
+%% @type activity_option() =
+%% {ts_min, timestamp()} |
+%% {ts_max, timestamp()} |
+%% {ts_exact, bool()} |
+%% {mfa, {atom(), atom(), byte()}} |
+%% {state, active | inactive} |
+%% {id, all | procs | ports | pid() | port()}
+
+%% @type scheduler_option() =
+%% {ts_min, timestamp()} |
+%% {ts_max, timestamp()} |
+%% {ts_exact, bool()} |
+%% {id, scheduler_id()}
+
+%% @type system_option() = start_ts | stop_ts
+
+%% @type information_option() =
+%% all | procs | ports | pid() | port()
+
+
+
+
+%%==========================================================================
+%%
+%% Interface functions
+%%
+%%==========================================================================
+
+%% @spec start() -> ok | {started, Pid} | {restarted, Pid}
+%% Pid = pid()
+%% @doc Starts or restarts the percept database.
+
+-spec(start/0 :: () -> {'started', pid()} | {'restarted', pid()}).
+
+start() ->
+ case erlang:whereis(percept_db) of
+ undefined ->
+ Pid = spawn( fun() -> init_percept_db() end),
+ erlang:register(percept_db, Pid),
+ {started, Pid};
+ PerceptDB ->
+ erlang:unregister(percept_db),
+ PerceptDB ! {action, stop},
+ Pid = spawn( fun() -> init_percept_db() end),
+ erlang:register(percept_db, Pid),
+ {restarted, Pid}
+ end.
+
+%% @spec stop() -> not_started | {stopped, Pid}
+%% Pid = pid()
+%% @doc Stops the percept database.
+
+-spec(stop/0 :: () -> 'not_started' | {'stopped', pid()}).
+
+stop() ->
+ case erlang:whereis(percept_db) of
+ undefined ->
+ not_started;
+ Pid ->
+ Pid ! {action, stop},
+ {stopped, Pid}
+ end.
+
+%% @spec insert(tuple()) -> ok
+%% @doc Inserts a trace or profile message to the database.
+
+insert(Trace) ->
+ percept_db ! {insert, Trace},
+ ok.
+
+
+%% @spec select({atom(), Options}) -> Result
+%% @doc Synchronous call. Selects information based on a query.
+%%
+%% <p>Queries:</p>
+%% <pre>
+%% {system, Option}
+%% Option = system_option()
+%% Result = timestamp()
+%% {information, Options}
+%% Options = [information_option()]
+%% Result = [#information{}]
+%% {scheduler, Options}
+%% Options = [sceduler_option()]
+%% Result = [#activity{}]
+%% {activity, Options}
+%% Options = [activity_option()]
+%% Result = [#activity{}]
+%% </pre>
+%% <p>
+%% Note: selection of Id's are always OR all other options are considered AND.
+%% </p>
+
+select(Query) ->
+ percept_db ! {select, self(), Query},
+ receive Match -> Match end.
+
+%% @spec select(atom(), list()) -> Result
+%% @equiv select({Table,Options})
+
+select(Table, Options) ->
+ percept_db ! {select, self(), {Table, Options}},
+ receive Match -> Match end.
+
+%% @spec consolidate() -> Result
+%% @doc Checks timestamp and state-flow inconsistencies in the
+%% the database.
+
+consolidate() ->
+ percept_db ! {action, consolidate},
+ ok.
+
+%%==========================================================================
+%%
+%% Database loop
+%%
+%%==========================================================================
+
+init_percept_db() ->
+ % Proc and Port information
+ ets:new(pdb_info, [named_table, private, {keypos, #information.id}, set]),
+
+ % Scheduler runnability
+ ets:new(pdb_scheduler, [named_table, private, {keypos, #activity.timestamp}, ordered_set]),
+
+ % Process and Port runnability
+ ets:new(pdb_activity, [named_table, private, {keypos, #activity.timestamp}, ordered_set]),
+
+ % System status
+ ets:new(pdb_system, [named_table, private, {keypos, 1}, set]),
+
+ % System warnings
+ ets:new(pdb_warnings, [named_table, private, {keypos, 1}, ordered_set]),
+ put(debug, 0),
+ loop_percept_db().
+
+loop_percept_db() ->
+ receive
+ {insert, Trace} ->
+ insert_trace(clean_trace(Trace)),
+ loop_percept_db();
+ {select, Pid, Query} ->
+ Pid ! select_query(Query),
+ loop_percept_db();
+ {action, stop} ->
+ stopped;
+ {action, consolidate} ->
+ consolidate_db(),
+ loop_percept_db();
+ {operate, Pid, {Table, {Fun, Start}}} ->
+ Result = ets:foldl(Fun, Start, Table),
+ Pid ! Result,
+ loop_percept_db();
+ Unhandled ->
+ io:format("loop_percept_db, unhandled query: ~p~n", [Unhandled]),
+ loop_percept_db()
+ end.
+
+%%==========================================================================
+%%
+%% Auxiliary functions
+%%
+%%==========================================================================
+
+%% cleans trace messages from external pids
+
+clean_trace(Trace) when is_tuple(Trace) -> list_to_tuple(clean_trace(tuple_to_list(Trace)));
+clean_trace(Trace) when is_list(Trace) -> clean_list(Trace, []);
+clean_trace(Trace) when is_pid(Trace) ->
+ PidStr = pid_to_list(Trace),
+ [_,P2,P3p] = string:tokens(PidStr,"."),
+ P3 = lists:sublist(P3p, 1, length(P3p) - 1),
+ erlang:list_to_pid("<0." ++ P2 ++ "." ++ P3 ++ ">");
+clean_trace(Trace) -> Trace.
+
+clean_list([], Out) -> lists:reverse(Out);
+clean_list([Element|Trace], Out) ->
+ clean_list(Trace, [clean_trace(Element)|Out]).
+
+
+insert_trace(Trace) ->
+ case Trace of
+ {profile_start, Ts} ->
+ update_system_start_ts(Ts),
+ ok;
+ {profile_stop, Ts} ->
+ update_system_stop_ts(Ts),
+ ok;
+ %%% erlang:system_profile, option: runnable_procs
+ %%% ---------------------------------------------
+ {profile, Id, State, Mfa, TS} when is_pid(Id) ->
+ % Update runnable count in activity and db
+
+ case check_activity_consistency(Id, State) of
+ invalid_state ->
+ ignored;
+ ok ->
+ Rc = get_runnable_count(procs, State),
+ % Update registered procs
+ % insert proc activity
+ update_activity(#activity{
+ id = Id,
+ state = State,
+ timestamp = TS,
+ runnable_count = Rc,
+ where = Mfa}),
+ ok
+ end;
+ %%% erlang:system_profile, option: runnable_ports
+ %%% ---------------------------------------------
+ {profile, Id, State, Mfa, TS} when is_port(Id) ->
+ case check_activity_consistency(Id, State) of
+ invalid_state ->
+ ignored;
+ ok ->
+ % Update runnable count in activity and db
+ Rc = get_runnable_count(ports, State),
+
+ % Update registered ports
+ % insert port activity
+ update_activity(#activity{
+ id = Id,
+ state = State,
+ timestamp = TS,
+ runnable_count = Rc,
+ where = Mfa}),
+
+ ok
+ end;
+ %%% erlang:system_profile, option: scheduler
+ {profile, scheduler, Id, State, Scheds, Ts} ->
+ % insert scheduler activity
+ update_scheduler(#activity{
+ id = {scheduler, Id},
+ state = State,
+ timestamp = Ts,
+ where = Scheds}),
+ ok;
+
+ %%% erlang:trace, option: procs
+ %%% ---------------------------
+ {trace_ts, Parent, spawn, Pid, Mfa, TS} ->
+ InformativeMfa = mfa2informative(Mfa),
+ % Update id_information
+ update_information(#information{id = Pid, start = TS, parent = Parent, entry = InformativeMfa}),
+ update_information_child(Parent, Pid),
+ ok;
+ {trace_ts, Pid, exit, _Reason, TS} ->
+ % Update registered procs
+
+ % Update id_information
+ update_information(#information{id = Pid, stop = TS}),
+
+ ok;
+ {trace_ts, Pid, register, Name, _Ts} when is_pid(Pid) ->
+ % Update id_information
+ update_information(#information{id = Pid, name = Name}),
+ ok;
+ {trace_ts, Pid, register, Name, _Ts} when is_pid(Pid) ->
+ % Update id_information
+ update_information(#information{id = Pid, name = Name}),
+ ok;
+ {trace_ts, _Pid, unregister, _Name, _Ts} ->
+ % Not implemented
+ ok;
+ {trace_ts, Pid, getting_unlinked, _Id, _Ts} when is_pid(Pid) ->
+ % Update id_information
+ ok;
+ {trace_ts, Pid, getting_linked, _Id, _Ts} when is_pid(Pid)->
+ % Update id_information
+ ok;
+ {trace_ts, Pid, link, _Id, _Ts} when is_pid(Pid)->
+ % Update id_information
+ ok;
+ {trace_ts, Pid, unlink, _Id, _Ts} when is_pid(Pid) ->
+ % Update id_information
+ ok;
+
+ %%% erlang:trace, option: ports
+ %%% ----------------------------
+ {trace_ts, Caller, open, Port, Driver, TS} ->
+ % Update id_information
+ update_information(#information{
+ id = Port, entry = Driver, start = TS, parent = Caller}),
+ ok;
+ {trace_ts, Port, closed, _Reason, Ts} ->
+ % Update id_information
+ update_information(#information{id = Port, stop = Ts}),
+ ok;
+
+ Unhandled ->
+ io:format("insert_trace, unhandled: ~p~n", [Unhandled])
+ end.
+
+mfa2informative({erlang, apply, [M, F, Args]}) -> mfa2informative({M, F,Args});
+mfa2informative({erlang, apply, [Fun, Args]}) ->
+ FunInfo = erlang:fun_info(Fun),
+ M = case proplists:get_value(module, FunInfo, undefined) of
+ [] -> undefined_fun_module;
+ undefined -> undefined_fun_module;
+ Module -> Module
+ end,
+ F = case proplists:get_value(name, FunInfo, undefined) of
+ [] -> undefined_fun_function;
+ undefined -> undefined_fun_function;
+ Function -> Function
+ end,
+ mfa2informative({M, F, Args});
+mfa2informative(Mfa) -> Mfa.
+
+%% consolidate_db() -> bool()
+%% Purpose:
+%% Check start/stop time
+%% Activity consistency
+
+consolidate_db() ->
+ io:format("Consolidating...~n"),
+ % Check start/stop timestamps
+ case select_query({system, start_ts}) of
+ undefined ->
+ Min = lists:min(list_all_ts()),
+ update_system_start_ts(Min);
+ _ -> ok
+ end,
+ case select_query({system, stop_ts}) of
+ undefined ->
+ Max = lists:max(list_all_ts()),
+ update_system_stop_ts(Max);
+ _ -> ok
+ end,
+ consolidate_runnability(),
+ ok.
+
+consolidate_runnability() ->
+ put({runnable, procs}, undefined),
+ put({runnable, ports}, undefined),
+ consolidate_runnability_loop(ets:first(pdb_activity)).
+
+consolidate_runnability_loop('$end_of_table') -> ok;
+consolidate_runnability_loop(Key) ->
+ case ets:lookup(pdb_activity, Key) of
+ [#activity{id = Id, state = State } = A] when is_pid(Id) ->
+ Rc = get_runnable_count(procs, State),
+ ets:insert(pdb_activity, A#activity{ runnable_count = Rc});
+ [#activity{id = Id, state = State } = A] when is_port(Id) ->
+ Rc = get_runnable_count(ports, State),
+ ets:insert(pdb_activity, A#activity{ runnable_count = Rc});
+ _ -> throw(consolidate)
+ end,
+ consolidate_runnability_loop(ets:next(pdb_activity, Key)).
+
+list_all_ts() ->
+ ATs = [ Act#activity.timestamp ||
+ Act <- select_query({activity, []})],
+ STs = [ Act#activity.timestamp ||
+ Act <- select_query({scheduler, []})],
+ ITs = lists:flatten([
+ [I#information.start,
+ I#information.stop] ||
+ I <- select_query({information, all})]),
+ % Filter out all undefined (non ts)
+ TsList = lists:filter(
+ fun(Element) ->
+ case Element of
+ {_,_,_} -> true;
+ _ -> false
+ end
+ end, ATs ++ STs ++ ITs),
+ TsList.
+
+%% get_runnable_count(Type, State) -> RunnableCount
+%% In:
+%% Type = procs | ports
+%% State = active | inactive
+%% Out:
+%% RunnableCount = integer()
+%% Purpose:
+%% Keep track of the number of runnable ports and processes
+%% during the profile duration.
+
+get_runnable_count(Type, State) ->
+ case {get({runnable, Type}), State} of
+ {undefined, active} ->
+ put({runnable, Type}, 1),
+ 1;
+ {N, active} ->
+ put({runnable, Type}, N + 1),
+ N + 1;
+ {N, inactive} ->
+ put({runnable, Type}, N - 1),
+ N - 1;
+ Unhandled ->
+ io:format("get_runnable_count, unhandled ~p~n", [Unhandled]),
+ Unhandled
+ end.
+
+check_activity_consistency(Id, State) ->
+ case get({previous_state, Id}) of
+ State ->
+ io:format("check_activity_consistency, state flow invalid.~n"),
+ invalid_state;
+ undefined when State == inactive ->
+ invalid_state;
+ _ ->
+ put({previous_state, Id}, State),
+ ok
+ end.
+%%%
+%%% select_query
+%%% In:
+%%% Query = {Table, Option}
+%%% Table = system | activity | scheduler | information
+
+
+select_query(Query) ->
+ case Query of
+ {system, _ } ->
+ select_query_system(Query);
+ {activity, _ } ->
+ select_query_activity(Query);
+ {scheduler, _} ->
+ select_query_scheduler(Query);
+ {information, _ } ->
+ select_query_information(Query);
+ Unhandled ->
+ io:format("select_query, unhandled: ~p~n", [Unhandled]),
+ []
+ end.
+
+%%% select_query_information
+
+select_query_information(Query) ->
+ case Query of
+ {information, all} ->
+ ets:select(pdb_info, [{
+ #information{ _ = '_'},
+ [],
+ ['$_']
+ }]);
+ {information, procs} ->
+ ets:select(pdb_info, [{
+ #information{ id = '$1', _ = '_'},
+ [{is_pid, '$1'}],
+ ['$_']
+ }]);
+ {information, ports} ->
+ ets:select(pdb_info, [{
+ #information{ id = '$1', _ = '_'},
+ [{is_port, '$1'}],
+ ['$_']
+ }]);
+ {information, Id} when is_port(Id) ; is_pid(Id) ->
+ ets:select(pdb_info, [{
+ #information{ id = Id, _ = '_'},
+ [],
+ ['$_']
+ }]);
+ Unhandled ->
+ io:format("select_query_information, unhandled: ~p~n", [Unhandled]),
+ []
+ end.
+
+%%% select_query_scheduler
+
+select_query_scheduler(Query) ->
+ case Query of
+ {scheduler, Options} when is_list(Options) ->
+ Head = #activity{
+ timestamp = '$1',
+ id = '$2',
+ state = '$3',
+ where = '$4',
+ _ = '_'},
+ Body = ['$_'],
+ % We don't need id's
+ {Constraints, _ } = activity_ms_and(Head, Options, [], []),
+ ets:select(pdb_scheduler, [{Head, Constraints, Body}]);
+ Unhandled ->
+ io:format("select_query_scheduler, unhandled: ~p~n", [Unhandled]),
+ []
+ end.
+
+%%% select_query_system
+
+select_query_system(Query) ->
+ case Query of
+ {system, start_ts} ->
+ case ets:lookup(pdb_system, {system, start_ts}) of
+ [] -> undefined;
+ [{{system, start_ts}, StartTS}] -> StartTS
+ end;
+ {system, stop_ts} ->
+ case ets:lookup(pdb_system, {system, stop_ts}) of
+ [] -> undefined;
+ [{{system, stop_ts}, StopTS}] -> StopTS
+ end;
+ Unhandled ->
+ io:format("select_query_system, unhandled: ~p~n", [Unhandled]),
+ []
+ end.
+
+%%% select_query_activity
+
+select_query_activity(Query) ->
+ case Query of
+ {activity, Options} when is_list(Options) ->
+ case lists:member({ts_exact, true},Options) of
+ true ->
+ case catch select_query_activity_exact_ts(Options) of
+ {'EXIT', Reason} ->
+ io:format(" - select_query_activity [ catch! ]: ~p~n", [Reason]),
+ [];
+ Match ->
+ Match
+ end;
+ false ->
+ MS = activity_ms(Options),
+ case catch ets:select(pdb_activity, MS) of
+ {'EXIT', Reason} ->
+ io:format(" - select_query_activity [ catch! ]: ~p~n", [Reason]),
+ [];
+ Match ->
+ Match
+ end
+ end;
+ Unhandled ->
+ io:format("select_query_activity, unhandled: ~p~n", [Unhandled]),
+ []
+ end.
+
+select_query_activity_exact_ts(Options) ->
+ case { proplists:get_value(ts_min, Options, undefined), proplists:get_value(ts_max, Options, undefined) } of
+ {undefined, undefined} -> [];
+ {undefined, _ } -> [];
+ {_ , undefined} -> [];
+ {TsMin , TsMax } ->
+ % Remove unwanted options
+ Opts = lists_filter([ts_exact], Options),
+ Ms = activity_ms(Opts),
+ case ets:select(pdb_activity, Ms) of
+ % no entries within interval
+ [] ->
+ Opts2 = lists_filter([ts_max, ts_min], Opts) ++ [{ts_min, TsMax}],
+ Ms2 = activity_ms(Opts2),
+ case ets:select(pdb_activity, Ms2, 1) of
+ '$end_of_table' -> [];
+ {[E], _} ->
+ [PrevAct] = ets:lookup(pdb_activity, ets:prev(pdb_activity, E#activity.timestamp)),
+ [PrevAct#activity{ timestamp = TsMin} , E]
+ end;
+ Acts ->
+ [Head| _] = Acts,
+ if
+ Head#activity.timestamp == TsMin -> Acts;
+ true ->
+ PrevTs = ets:prev(pdb_activity, Head#activity.timestamp),
+ case ets:lookup(pdb_activity, PrevTs) of
+ [] -> Acts;
+ [PrevAct] -> [PrevAct#activity{timestamp = TsMin}|Acts]
+ end
+ end
+ end
+ end.
+
+lists_filter([], Options) -> Options;
+lists_filter([D|Ds], Options) ->
+ lists_filter(Ds, lists:filter(
+ fun ({Pred, _}) ->
+ if
+ Pred == D -> false;
+ true -> true
+ end
+ end, Options)).
+
+% Options:
+% {ts_min, timestamp()}
+% {ts_max, timestamp()}
+% {mfa, mfa()}
+% {state, active | inactive}
+% {id, all | procs | ports | pid() | port()}
+%
+% All options are regarded as AND expect id which are regarded as OR
+% For example: [{ts_min, TS1}, {ts_max, TS2}, {id, PID1}, {id, PORT1}] would be
+% ({ts_min, TS1} and {ts_max, TS2} and {id, PID1}) or
+% ({ts_min, TS1} and {ts_max, TS2} and {id, PORT1}).
+
+activity_ms(Opts) ->
+ % {activity, Timestamp, State, Mfa}
+ Head = #activity{
+ timestamp = '$1',
+ id = '$2',
+ state = '$3',
+ where = '$4',
+ _ = '_'},
+
+ {Conditions, IDs} = activity_ms_and(Head, Opts, [], []),
+ Body = ['$_'],
+
+ lists:foldl(
+ fun (Option, MS) ->
+ case Option of
+ {id, ports} ->
+ [{Head, [{is_port, Head#activity.id} | Conditions], Body} | MS];
+ {id, procs} ->
+ [{Head,[{is_pid, Head#activity.id} | Conditions], Body} | MS];
+ {id, ID} when is_pid(ID) ; is_port(ID) ->
+ [{Head,[{'==', Head#activity.id, ID} | Conditions], Body} | MS];
+ {id, all} ->
+ [{Head, Conditions,Body} | MS];
+ _ ->
+ io:format("activity_ms id dropped ~p~n", [Option]),
+ MS
+ end
+ end, [], IDs).
+
+activity_ms_and(_, [], Constraints, []) ->
+ {Constraints, [{id, all}]};
+activity_ms_and(_, [], Constraints, IDs) ->
+ {Constraints, IDs};
+activity_ms_and(Head, [Opt|Opts], Constraints, IDs) ->
+ case Opt of
+ {ts_min, Min} ->
+ activity_ms_and(Head, Opts,
+ [{'>=', Head#activity.timestamp, {Min}} | Constraints], IDs);
+ {ts_max, Max} ->
+ activity_ms_and(Head, Opts,
+ [{'=<', Head#activity.timestamp, {Max}} | Constraints], IDs);
+ {id, ID} ->
+ activity_ms_and(Head, Opts,
+ Constraints, [{id, ID} | IDs]);
+ {state, State} ->
+ activity_ms_and(Head, Opts,
+ [{'==', Head#activity.state, State} | Constraints], IDs);
+ {mfa, Mfa} ->
+ activity_ms_and(Head, Opts,
+ [{'==', Head#activity.where, {Mfa}}| Constraints], IDs);
+ _ ->
+ io:format("activity_ms_and option dropped ~p~n", [Opt]),
+ activity_ms_and(Head, Opts, Constraints, IDs)
+ end.
+
+% Information = information()
+
+%%%
+%%% update_information
+%%%
+
+
+update_information(#information{id = Id} = NewInfo) ->
+ case ets:lookup(pdb_info, Id) of
+ [] ->
+ ets:insert(pdb_info, NewInfo),
+ ok;
+ [Info] ->
+ % Remake NewInfo and Info to lists then substitute
+ % old values for new values that are not undefined or empty lists.
+
+ {_, Result} = lists:foldl(
+ fun (InfoElem, {[NewInfoElem | Tail], Out}) ->
+ case NewInfoElem of
+ undefined ->
+ {Tail, [InfoElem | Out]};
+ [] ->
+ {Tail, [InfoElem | Out]};
+ NewInfoElem ->
+ {Tail, [NewInfoElem | Out]}
+ end
+ end, {tuple_to_list(NewInfo), []}, tuple_to_list(Info)),
+ ets:insert(pdb_info, list_to_tuple(lists:reverse(Result))),
+ ok
+ end.
+
+update_information_child(Id, Child) ->
+ case ets:lookup(pdb_info, Id) of
+ [] ->
+ ets:insert(pdb_info,#information{
+ id = Id,
+ children = [Child]}),
+ ok;
+ [I] ->
+ ets:insert(pdb_info,I#information{children = [Child | I#information.children]}),
+ ok
+ end.
+
+%%%
+%%% update_activity
+%%%
+update_scheduler(Activity) ->
+ ets:insert(pdb_scheduler, Activity).
+
+update_activity(Activity) ->
+ ets:insert(pdb_activity, Activity).
+
+%%%
+%%% update_system_ts
+%%%
+
+update_system_start_ts(TS) ->
+ case ets:lookup(pdb_system, {system, start_ts}) of
+ [] ->
+ ets:insert(pdb_system, {{system, start_ts}, TS});
+ [{{system, start_ts}, StartTS}] ->
+ DT = ?seconds(StartTS, TS),
+ if
+ DT > 0.0 -> ets:insert(pdb_system, {{system, start_ts}, TS});
+ true -> ok
+ end;
+ Unhandled ->
+ io:format("update_system_start_ts, unhandled ~p ~n", [Unhandled])
+ end.
+
+update_system_stop_ts(TS) ->
+ case ets:lookup(pdb_system, {system, stop_ts}) of
+ [] ->
+ ets:insert(pdb_system, {{system, stop_ts}, TS});
+ [{{system, stop_ts}, StopTS}] ->
+ DT = ?seconds(StopTS, TS),
+ if
+ DT < 0.0 -> ets:insert(pdb_system, {{system, stop_ts}, TS});
+ true -> ok
+ end;
+ Unhandled ->
+ io:format("update_system_stop_ts, unhandled ~p ~n", [Unhandled])
+ end.
+
+
diff --git a/lib/percept/src/percept_graph.erl b/lib/percept/src/percept_graph.erl
new file mode 100644
index 0000000000..6f07948153
--- /dev/null
+++ b/lib/percept/src/percept_graph.erl
@@ -0,0 +1,133 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2007-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 Interface for CGI request on graphs used by percept. The module exports two functions that are implementations for ESI callbacks used by the httpd server. See http://www.erlang.org//doc/apps/inets/index.html.
+
+-module(percept_graph).
+-export([proc_lifetime/3, graph/3, scheduler_graph/3, activity/3, percentage/3]).
+
+-include("percept.hrl").
+-include_lib("kernel/include/file.hrl").
+
+%% API
+
+%% graph
+%% @spec graph(SessionID, Env, Input) -> term()
+%% @doc An ESI callback implementation used by the httpd server.
+%%
+
+graph(SessionID, Env, Input) ->
+ mod_esi:deliver(SessionID, header()),
+ mod_esi:deliver(SessionID, binary_to_list(graph(Env, Input))).
+
+%% activity
+%% @spec activity(SessionID, Env, Input) -> term()
+%% @doc An ESI callback implementation used by the httpd server.
+
+activity(SessionID, Env, Input) ->
+ mod_esi:deliver(SessionID, header()),
+ mod_esi:deliver(SessionID, binary_to_list(activity_bar(Env, Input))).
+
+proc_lifetime(SessionID, Env, Input) ->
+ mod_esi:deliver(SessionID, header()),
+ mod_esi:deliver(SessionID, binary_to_list(proc_lifetime(Env, Input))).
+
+percentage(SessionID, Env, Input) ->
+ mod_esi:deliver(SessionID, header()),
+ mod_esi:deliver(SessionID, binary_to_list(percentage(Env,Input))).
+
+scheduler_graph(SessionID, Env, Input) ->
+ mod_esi:deliver(SessionID, header()),
+ mod_esi:deliver(SessionID, binary_to_list(scheduler_graph(Env, Input))).
+
+graph(_Env, Input) ->
+ Query = httpd:parse_query(Input),
+ RangeMin = percept_html:get_option_value("range_min", Query),
+ RangeMax = percept_html:get_option_value("range_max", Query),
+ Pids = percept_html:get_option_value("pids", Query),
+ Width = percept_html:get_option_value("width", Query),
+ Height = percept_html:get_option_value("height", Query),
+
+ % Convert Pids to id option list
+ IDs = [ {id, ID} || ID <- Pids],
+
+ % seconds2ts
+ StartTs = percept_db:select({system, start_ts}),
+ TsMin = percept_analyzer:seconds2ts(RangeMin, StartTs),
+ TsMax = percept_analyzer:seconds2ts(RangeMax, StartTs),
+
+ Options = [{ts_min, TsMin},{ts_max, TsMax} | IDs],
+
+ Acts = percept_db:select({activity, Options}),
+ Counts = case IDs of
+ [] -> percept_analyzer:activities2count(Acts, StartTs);
+ _ -> percept_analyzer:activities2count2(Acts, StartTs)
+ end,
+
+ percept_image:graph(Width, Height,Counts).
+
+scheduler_graph(_Env, Input) ->
+ Query = httpd:parse_query(Input),
+ RangeMin = percept_html:get_option_value("range_min", Query),
+ RangeMax = percept_html:get_option_value("range_max", Query),
+ Width = percept_html:get_option_value("width", Query),
+ Height = percept_html:get_option_value("height", Query),
+
+ StartTs = percept_db:select({system, start_ts}),
+ TsMin = percept_analyzer:seconds2ts(RangeMin, StartTs),
+ TsMax = percept_analyzer:seconds2ts(RangeMax, StartTs),
+
+
+ Acts = percept_db:select({scheduler, [{ts_min, TsMin}, {ts_max,TsMax}]}),
+
+ Counts = [{?seconds(Ts, StartTs), Scheds, 0} || #activity{where = Scheds, timestamp = Ts} <- Acts],
+
+ percept_image:graph(Width, Height, Counts).
+
+activity_bar(_Env, Input) ->
+ Query = httpd:parse_query(Input),
+ Pid = percept_html:get_option_value("pid", Query),
+ Min = percept_html:get_option_value("range_min", Query),
+ Max = percept_html:get_option_value("range_max", Query),
+ Width = percept_html:get_option_value("width", Query),
+ Height = percept_html:get_option_value("height", Query),
+
+ Data = percept_db:select({activity, [{id, Pid}]}),
+ StartTs = percept_db:select({system, start_ts}),
+ Activities = [{?seconds(Ts, StartTs), State} || #activity{timestamp = Ts, state = State} <- Data],
+
+ percept_image:activities(Width, Height, {Min,Max},Activities).
+
+proc_lifetime(_Env, Input) ->
+ Query = httpd:parse_query(Input),
+ ProfileTime = percept_html:get_option_value("profiletime", Query),
+ Start = percept_html:get_option_value("start", Query),
+ End = percept_html:get_option_value("end", Query),
+ Width = percept_html:get_option_value("width", Query),
+ Height = percept_html:get_option_value("height", Query),
+ percept_image:proc_lifetime(round(Width), round(Height), float(Start), float(End), float(ProfileTime)).
+
+percentage(_Env, Input) ->
+ Query = httpd:parse_query(Input),
+ Width = percept_html:get_option_value("width", Query),
+ Height = percept_html:get_option_value("height", Query),
+ Percentage = percept_html:get_option_value("percentage", Query),
+ percept_image:percentage(round(Width), round(Height), float(Percentage)).
+
+header() ->
+ "Content-Type: image/png\r\n\r\n".
diff --git a/lib/percept/src/percept_html.erl b/lib/percept/src/percept_html.erl
new file mode 100644
index 0000000000..ffce7a98fa
--- /dev/null
+++ b/lib/percept/src/percept_html.erl
@@ -0,0 +1,720 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2007-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%
+
+-module(percept_html).
+-export([
+ page/3,
+ codelocation_page/3,
+ databases_page/3,
+ load_database_page/3,
+ processes_page/3,
+ concurrency_page/3,
+ process_info_page/3
+ ]).
+
+-export([
+ value2pid/1,
+ pid2value/1,
+ get_option_value/2,
+ join_strings_with/2
+ ]).
+
+-include("percept.hrl").
+-include_lib("kernel/include/file.hrl").
+
+
+%% API
+
+page(SessionID, Env, Input) ->
+ mod_esi:deliver(SessionID, header()),
+ mod_esi:deliver(SessionID, menu()),
+ mod_esi:deliver(SessionID, overview_content(Env, Input)),
+ mod_esi:deliver(SessionID, footer()).
+
+processes_page(SessionID, _, _) ->
+ mod_esi:deliver(SessionID, header()),
+ mod_esi:deliver(SessionID, menu()),
+ mod_esi:deliver(SessionID, processes_content()),
+ mod_esi:deliver(SessionID, footer()).
+
+concurrency_page(SessionID, Env, Input) ->
+ mod_esi:deliver(SessionID, header()),
+ mod_esi:deliver(SessionID, menu()),
+ mod_esi:deliver(SessionID, concurrency_content(Env, Input)),
+ mod_esi:deliver(SessionID, footer()).
+
+databases_page(SessionID, _, _) ->
+ mod_esi:deliver(SessionID, header()),
+ mod_esi:deliver(SessionID, menu()),
+ mod_esi:deliver(SessionID, databases_content()),
+ mod_esi:deliver(SessionID, footer()).
+
+codelocation_page(SessionID, Env, Input) ->
+ mod_esi:deliver(SessionID, header()),
+ mod_esi:deliver(SessionID, menu()),
+ mod_esi:deliver(SessionID, codelocation_content(Env, Input)),
+ mod_esi:deliver(SessionID, footer()).
+
+process_info_page(SessionID, Env, Input) ->
+ mod_esi:deliver(SessionID, header()),
+ mod_esi:deliver(SessionID, menu()),
+ mod_esi:deliver(SessionID, process_info_content(Env, Input)),
+ mod_esi:deliver(SessionID, footer()).
+
+load_database_page(SessionID, Env, Input) ->
+ mod_esi:deliver(SessionID, header()),
+
+ % Very dynamic page, handled differently
+ load_database_content(SessionID, Env, Input),
+ mod_esi:deliver(SessionID, footer()).
+
+
+%%% --------------------------- %%%
+%%% Content pages %%%
+%%% --------------------------- %%%
+
+overview_content(_Env, Input) ->
+ Query = httpd:parse_query(Input),
+ Min = get_option_value("range_min", Query),
+ Max = get_option_value("range_max", Query),
+ Width = 1200,
+ Height = 600,
+ TotalProfileTime = ?seconds( percept_db:select({system, stop_ts}),
+ percept_db:select({system, start_ts})),
+ RegisteredProcs = length(percept_db:select({information, procs})),
+ RegisteredPorts = length(percept_db:select({information, ports})),
+
+ InformationTable =
+ "<table>" ++
+ table_line(["Profile time:", TotalProfileTime]) ++
+ table_line(["Processes:", RegisteredProcs]) ++
+ table_line(["Ports:", RegisteredPorts]) ++
+ table_line(["Min. range:", Min]) ++
+ table_line(["Max. range:", Max]) ++
+ "</table>",
+
+ Header = "
+ <div id=\"content\">
+ <div>" ++ InformationTable ++ "</div>\n
+ <form name=form_area method=POST action=/cgi-bin/percept_html/page>
+ <input name=data_min type=hidden value=" ++ term2html(float(Min)) ++ ">
+ <input name=data_max type=hidden value=" ++ term2html(float(Max)) ++ ">\n",
+
+
+ RangeTable =
+ "<table>"++
+ table_line([
+ "Min:",
+ "<input name=range_min value=" ++ term2html(float(Min)) ++">",
+ "<select name=\"graph_select\" onChange=\"select_image()\">
+ <option disabled=true value=\""++ url_graph(Width, Height, Min, Max, []) ++"\" />Ports
+ <option disabled=true value=\""++ url_graph(Width, Height, Min, Max, []) ++"\" />Processes
+ <option value=\""++ url_graph(Width, Height, Min, Max, []) ++"\" />Ports & Processes
+ </select>",
+ "<input type=submit value=Update>"
+ ]) ++
+ table_line([
+ "Max:",
+ "<input name=range_max value=" ++ term2html(float(Max)) ++">",
+ "",
+ "<a href=/cgi-bin/percept_html/codelocation_page?range_min=" ++
+ term2html(Min) ++ "&range_max=" ++ term2html(Max) ++ ">Code location</a>"
+ ]) ++
+ "</table>",
+
+
+ MainTable =
+ "<table>" ++
+ table_line([div_tag_graph()]) ++
+ table_line([RangeTable]) ++
+ "</table>",
+
+ Footer = "</div></form>",
+
+ Header ++ MainTable ++ Footer.
+
+div_tag_graph() ->
+ %background:url('/images/loader.gif') no-repeat center;
+ "<div id=\"percept_graph\"
+ onMouseDown=\"select_down(event)\"
+ onMouseMove=\"select_move(event)\"
+ onMouseUp=\"select_up(event)\"
+
+ style=\"
+ background-size: 100%;
+ background-origin: content;
+ width: 100%;
+ position:relative;
+ \">
+
+ <div id=\"percept_areaselect\"
+ style=\"background-color:#ef0909;
+ position:relative;
+ visibility:hidden;
+ border-left: 1px solid #101010;
+ border-right: 1px solid #101010;
+ z-index:2;
+ width:40px;
+ height:40px;\"></div></div>".
+
+-spec(url_graph/5 :: (
+ Widht :: non_neg_integer(),
+ Height :: non_neg_integer(),
+ Min :: float(),
+ Max :: float(),
+ Pids :: [pid()]) -> string()).
+
+url_graph(W, H, Min, Max, []) ->
+ "/cgi-bin/percept_graph/graph?range_min=" ++ term2html(float(Min))
+ ++ "&range_max=" ++ term2html(float(Max))
+ ++ "&width=" ++ term2html(float(W))
+ ++ "&height=" ++ term2html(float(H)).
+
+%%% process_info_content
+
+process_info_content(_Env, Input) ->
+ Query = httpd:parse_query(Input),
+ Pid = get_option_value("pid", Query),
+
+
+ [I] = percept_db:select({information, Pid}),
+ ArgumentString = case I#information.entry of
+ {_, _, Arguments} -> lists:flatten( [term2html(Arg) ++ "<br>" || Arg <- Arguments]);
+ _ -> ""
+ end,
+
+ TimeTable = html_table([
+ [{th, ""},
+ {th, "Timestamp"},
+ {th, "Profile Time"}],
+ [{td, "Start"},
+ term2html(I#information.start),
+ term2html(procstarttime(I#information.start))],
+ [{td, "Stop"},
+ term2html(I#information.stop),
+ term2html(procstoptime(I#information.stop))]
+ ]),
+
+ InfoTable = html_table([
+ [{th, "Pid"}, term2html(I#information.id)],
+ [{th, "Name"}, term2html(I#information.name)],
+ [{th, "Entrypoint"}, mfa2html(I#information.entry)],
+ [{th, "Arguments"}, ArgumentString],
+ [{th, "Timetable"}, TimeTable],
+ [{th, "Parent"}, pid2html(I#information.parent)],
+ [{th, "Children"}, lists:flatten(lists:map(fun(Child) -> pid2html(Child) ++ " " end, I#information.children))]
+ ]),
+
+ PidActivities = percept_db:select({activity, [{id, Pid}]}),
+ WaitingMfas = percept_analyzer:waiting_activities(PidActivities),
+
+ TotalWaitTime = lists:sum( [T || {T, _, _} <- WaitingMfas] ),
+
+ MfaTable = html_table([
+ [{th, "percentage"},
+ {th, "total"},
+ {th, "mean"},
+ {th, "stddev"},
+ {th, "#recv"},
+ {th, "module:function/arity"}]] ++ [
+ [{td, image_string(percentage, [{width, 100}, {height, 10}, {percentage, Time/TotalWaitTime}])},
+ {td, term2html(Time)},
+ {td, term2html(Mean)},
+ {td, term2html(StdDev)},
+ {td, term2html(N)},
+ {td, mfa2html(MFA)} ] || {Time, MFA, {Mean, StdDev, N}} <- WaitingMfas]),
+
+ "<div id=\"content\">" ++
+ InfoTable ++ "<br>" ++
+ MfaTable ++
+ "</div>".
+
+%%% concurrency content
+concurrency_content(_Env, Input) ->
+ %% Get query
+ Query = httpd:parse_query(Input),
+
+ %% Collect selected pids and generate id tags
+ Pids = [value2pid(PidValue) || {PidValue, Case} <- Query, Case == "on", PidValue /= "select_all"],
+ IDs = [{id, Pid} || Pid <- Pids],
+
+ % FIXME: A lot of extra work here, redo
+
+ %% Analyze activities and calculate area bounds
+ Activities = percept_db:select({activity, IDs}),
+ StartTs = percept_db:select({system, start_ts}),
+ Counts = [{Time, Y1 + Y2} || {Time, Y1, Y2} <- percept_analyzer:activities2count2(Activities, StartTs)],
+ {T0,_,T1,_} = percept_analyzer:minmax(Counts),
+
+ % FIXME: End
+
+ PidValues = [pid2value(Pid) || Pid <- Pids],
+
+ %% Generate activity bar requests
+ ActivityBarTable = lists:foldl(
+ fun(Pid, Out) ->
+ ValueString = pid2value(Pid),
+ Out ++
+ table_line([
+ pid2html(Pid),
+ "<img onload=\"size_image(this, '" ++
+ image_string_head("activity", [{"pid", ValueString}, {range_min, T0},{range_max, T1},{height, 10}], []) ++
+ "')\" src=/images/white.png border=0 />"
+ ])
+ end, [], Pids),
+
+ %% Make pids request string
+ PidsRequest = join_strings_with(PidValues, ":"),
+
+ "<div id=\"content\">
+ <table cellspacing=0 cellpadding=0 border=0>" ++
+ table_line([
+ "",
+ "<img onload=\"size_image(this, '" ++
+ image_string_head("graph", [{"pids", PidsRequest},{range_min, T0}, {range_max, T1}, {height, 400}], []) ++
+ "')\" src=/images/white.png border=0 />"
+ ]) ++
+ ActivityBarTable ++
+ "</table></div>\n".
+
+processes_content() ->
+ Ports = percept_db:select({information, ports}),
+ UnsortedProcesses = percept_db:select({information, procs}),
+ SystemStartTS = percept_db:select({system, start_ts}),
+ SystemStopTS = percept_db:select({system, stop_ts}),
+ ProfileTime = ?seconds( SystemStopTS,
+ SystemStartTS),
+ Processes = lists:sort(
+ fun (A, B) ->
+ if
+ A#information.id > B#information.id -> true;
+ true -> false
+ end
+ end, UnsortedProcesses),
+
+ ProcsHtml = lists:foldl(
+ fun (I, Out) ->
+ StartTime = procstarttime(I#information.start),
+ EndTime = procstoptime(I#information.stop),
+ Prepare =
+ table_line([
+ "<input type=checkbox name=" ++ pid2value(I#information.id) ++ ">",
+ pid2html(I#information.id),
+ image_string(proc_lifetime, [
+ {profiletime, ProfileTime},
+ {start, StartTime},
+ {"end", term2html(float(EndTime))},
+ {width, 100},
+ {height, 10}]),
+ mfa2html(I#information.entry),
+ term2html(I#information.name),
+ pid2html(I#information.parent)
+ ]),
+ [Prepare|Out]
+ end, [], Processes),
+
+ PortsHtml = lists:foldl(
+ fun (I, Out) ->
+ StartTime = procstarttime(I#information.start),
+ EndTime = procstoptime(I#information.stop),
+ Prepare =
+ table_line([
+ "",
+ pid2html(I#information.id),
+ image_string(proc_lifetime, [
+ {profiletime, ProfileTime},
+ {start, StartTime},
+ {"end", term2html(float(EndTime))},
+ {width, 100},
+ {height, 10}]),
+ mfa2html(I#information.entry),
+ term2html(I#information.name),
+ pid2html(I#information.parent)
+ ]),
+ [Prepare|Out]
+ end, [], Ports),
+
+ Selector = "<table>" ++
+ table_line([
+ "<input onClick='selectall()' type=checkbox name=select_all>Select all"]) ++
+ table_line([
+ "<input type=submit value=Compare>"]) ++
+ "</table>",
+
+ if
+ length(ProcsHtml) > 0 ->
+ ProcsHtmlResult =
+ "<tr><td><b>Processes</b></td></tr>
+ <tr><td>
+ <table width=700 cellspacing=0 border=0>
+ <tr>
+ <td align=middle width=40><b>Select</b></td>
+ <td align=middle width=40><b>Pid</b></td>
+ <td><b>Lifetime</b></td>
+ <td><b>Entrypoint</b></td>
+ <td><b>Name</b></td>
+ <td><b>Parent</b></td>
+ </tr>" ++
+ lists:flatten(ProcsHtml) ++
+ "</table>
+ </td></tr>";
+ true ->
+ ProcsHtmlResult = ""
+ end,
+ if
+ length(PortsHtml) > 0 ->
+ PortsHtmlResult = "
+ <tr><td><b>Ports</b></td></tr>
+ <tr><td>
+ <table width=700 cellspacing=0 border=0>
+ <tr>
+ <td align=middle width=40><b>Select</b></td>
+ <td align=left width=40><b>Pid</b></td>
+ <td><b>Lifetime</b></td>
+ <td><b>Entrypoint</b></td>
+ <td><b>Name</b></td>
+ <td><b>Parent</b></td>
+ </tr>" ++
+ lists:flatten(PortsHtml) ++
+ "</table>
+ </td></tr>";
+ true ->
+ PortsHtmlResult = ""
+ end,
+
+ Right = "<div>"
+ ++ Selector ++
+ "</div>\n",
+
+ Middle = "<div id=\"content\">
+ <table>" ++
+ ProcsHtmlResult ++
+ PortsHtmlResult ++
+ "</table>" ++
+ Right ++
+ "</div>\n",
+
+ "<form name=process_select method=POST action=/cgi-bin/percept_html/concurrency_page>" ++
+ Middle ++
+ "</form>".
+
+procstarttime(TS) ->
+ case TS of
+ undefined -> 0.0;
+ TS -> ?seconds(TS,percept_db:select({system, start_ts}))
+ end.
+
+procstoptime(TS) ->
+ case TS of
+ undefined -> ?seconds( percept_db:select({system, stop_ts}),
+ percept_db:select({system, start_ts}));
+ TS -> ?seconds(TS, percept_db:select({system, start_ts}))
+ end.
+
+databases_content() ->
+ "<div id=\"content\">
+ <form name=load_percept_file method=post action=/cgi-bin/percept_html/load_database_page>
+ <center>
+ <table>
+ <tr><td>Enter file to analyse:</td><td><input type=hidden name=path /></td></tr>
+ <tr><td><input type=file name=file size=40 /></td><td><input type=submit value=Load onClick=\"path.value = file.value;\" /></td></tr>
+ </table>
+ </center>
+ </form>
+ </div>".
+
+load_database_content(SessionId, _Env, Input) ->
+ Query = httpd:parse_query(Input),
+ {_,{_,Path}} = lists:keysearch("file", 1, Query),
+ {_,{_,File}} = lists:keysearch("path", 1, Query),
+ Filename = filename:join(Path, File),
+ % Check path/file/filename
+
+ mod_esi:deliver(SessionId, "<div id=\"content\">"),
+ case file:read_file_info(Filename) of
+ {ok, _} ->
+ Content = "<center>
+ Parsing: " ++ Filename ++ "<br>
+ </center>",
+ mod_esi:deliver(SessionId, Content),
+ case percept:analyze(Filename) of
+ {error, Reason} ->
+ mod_esi:deliver(SessionId, error_msg("Analyze" ++ term2html(Reason)));
+ _ ->
+ Complete = "<center><a href=\"/cgi-bin/percept_html/page\">View</a></center>",
+ mod_esi:deliver(SessionId, Complete)
+ end;
+ {error, Reason} ->
+ mod_esi:deliver(SessionId, error_msg("File" ++ term2html(Reason)))
+ end,
+ mod_esi:deliver(SessionId, "</div>").
+
+codelocation_content(_Env, Input) ->
+ Query = httpd:parse_query(Input),
+ Min = get_option_value("range_min", Query),
+ Max = get_option_value("range_max", Query),
+ StartTs = percept_db:select({system, start_ts}),
+ TsMin = percept_analyzer:seconds2ts(Min, StartTs),
+ TsMax = percept_analyzer:seconds2ts(Max, StartTs),
+ Acts = percept_db:select({activity, [{ts_min, TsMin}, {ts_max, TsMax}]}),
+
+ Secs = [timer:now_diff(A#activity.timestamp,StartTs)/1000 || A <- Acts],
+ Delta = cl_deltas(Secs),
+ Zip = lists:zip(Acts, Delta),
+ Table = html_table([
+ [{th, "delta [ms]"},
+ {th, "time [ms]"},
+ {th, " pid "},
+ {th, "activity"},
+ {th, "module:function/arity"},
+ {th, "#runnables"}]] ++ [
+ [{td, term2html(D)},
+ {td, term2html(timer:now_diff(A#activity.timestamp,StartTs)/1000)},
+ {td, pid2html(A#activity.id)},
+ {td, term2html(A#activity.state)},
+ {td, mfa2html(A#activity.where)},
+ {td, term2html(A#activity.runnable_count)}] || {A, D} <- Zip ]),
+
+ "<div id=\"content\">" ++
+ Table ++
+ "</div>".
+
+cl_deltas([]) -> [];
+cl_deltas(List) -> cl_deltas(List, [0.0]).
+cl_deltas([_], Out) -> lists:reverse(Out);
+cl_deltas([A,B|Ls], Out) -> cl_deltas([B|Ls], [B - A | Out]).
+
+%%% --------------------------- %%%
+%%% Utility functions %%%
+%%% --------------------------- %%%
+
+%% Should be in string stdlib?
+
+join_strings(Strings) ->
+ lists:flatten(Strings).
+
+-spec(join_strings_with/2 :: (
+ Strings :: [string()],
+ Separator :: string()) ->
+ string()).
+
+join_strings_with([S1, S2 | R], S) ->
+ join_strings_with([join_strings_with(S1,S2,S) | R], S);
+join_strings_with([S], _) ->
+ S.
+join_strings_with(S1, S2, S) ->
+ join_strings([S1,S,S2]).
+
+%%% Generic erlang2html
+
+-spec(html_table/1 :: (Rows :: [[string() | {'td' | 'th', string()}]]) -> string()).
+
+html_table(Rows) -> "<table>" ++ html_table_row(Rows) ++ "</table>".
+
+html_table_row(Rows) -> html_table_row(Rows, odd).
+html_table_row([], _) -> "";
+html_table_row([Row|Rows], odd ) -> "<tr class=\"odd\">" ++ html_table_data(Row) ++ "</tr>" ++ html_table_row(Rows, even);
+html_table_row([Row|Rows], even) -> "<tr class=\"even\">" ++ html_table_data(Row) ++ "</tr>" ++ html_table_row(Rows, odd ).
+
+html_table_data([]) -> "";
+html_table_data([{td, Data}|Row]) -> "<td>" ++ Data ++ "</td>" ++ html_table_data(Row);
+html_table_data([{th, Data}|Row]) -> "<th>" ++ Data ++ "</th>" ++ html_table_data(Row);
+html_table_data([Data|Row]) -> "<td>" ++ Data ++ "</td>" ++ html_table_data(Row).
+
+
+
+
+-spec(table_line/1 :: (Table :: [any()]) -> string()).
+
+table_line(List) -> table_line(List, ["<tr>"]).
+table_line([], Out) -> lists:flatten(lists:reverse(["</tr>\n"|Out]));
+table_line([Element | Elements], Out) when is_list(Element) ->
+ table_line(Elements, ["<td>" ++ Element ++ "</td>" |Out]);
+table_line([Element | Elements], Out) ->
+ table_line(Elements, ["<td>" ++ term2html(Element) ++ "</td>"|Out]).
+
+-spec(term2html/1 :: (any()) -> string()).
+
+term2html(Term) when is_float(Term) -> lists:flatten(io_lib:format("~.4f", [Term]));
+term2html(Term) -> lists:flatten(io_lib:format("~p", [Term])).
+
+-spec(mfa2html/1 :: (MFA :: {
+ atom(),
+ atom(),
+ list() | integer()}) ->
+ string()).
+
+mfa2html({Module, Function, Arguments}) when is_list(Arguments) ->
+ lists:flatten(io_lib:format("~p:~p/~p", [Module, Function, length(Arguments)]));
+mfa2html({Module, Function, Arity}) when is_integer(Arity) ->
+ lists:flatten(io_lib:format("~p:~p/~p", [Module, Function, Arity]));
+mfa2html(_) ->
+ "undefined".
+
+-spec(pid2html/1 :: (Pid :: pid() | port()) -> string()).
+
+pid2html(Pid) when is_pid(Pid) ->
+ PidString = term2html(Pid),
+ PidValue = pid2value(Pid),
+ "<a href=\"/cgi-bin/percept_html/process_info_page?pid="++PidValue++"\">"++PidString++"</a>";
+pid2html(Pid) when is_port(Pid) ->
+ term2html(Pid);
+pid2html(_) ->
+ "undefined".
+
+-spec(image_string/1 :: (Request :: string()) -> string()).
+
+image_string(Request) ->
+ "<img border=0 src=\"/cgi-bin/percept_graph/" ++
+ Request ++
+ " \">".
+
+-spec(image_string/2 :: (atom() | string(), list()) -> string()).
+
+image_string(Request, Options) when is_atom(Request), is_list(Options) ->
+ image_string(image_string_head(erlang:atom_to_list(Request), Options, []));
+image_string(Request, Options) when is_list(Options) ->
+ image_string(image_string_head(Request, Options, [])).
+
+image_string_head(Request, [{Type, Value} | Opts], Out) when is_atom(Type), is_number(Value) ->
+ Opt = join_strings(["?",term2html(Type),"=",term2html(Value)]),
+ image_string_tail(Request, Opts, [Opt|Out]);
+image_string_head(Request, [{Type, Value} | Opts], Out) ->
+ Opt = join_strings(["?",Type,"=",Value]),
+ image_string_tail(Request, Opts, [Opt|Out]).
+
+image_string_tail(Request, [], Out) ->
+ join_strings([Request | lists:reverse(Out)]);
+image_string_tail(Request, [{Type, Value} | Opts], Out) when is_atom(Type), is_number(Value) ->
+ Opt = join_strings(["&",term2html(Type),"=",term2html(Value)]),
+ image_string_tail(Request, Opts, [Opt|Out]);
+image_string_tail(Request, [{Type, Value} | Opts], Out) ->
+ Opt = join_strings(["&",Type,"=",Value]),
+ image_string_tail(Request, Opts, [Opt|Out]).
+
+
+%%% percept conversions
+
+-spec(pid2value/1 :: (Pid :: pid()) -> string()).
+
+pid2value(Pid) ->
+ String = lists:flatten(io_lib:format("~p", [Pid])),
+ lists:sublist(String, 2, erlang:length(String)-2).
+
+-spec(value2pid/1 :: (Value :: string()) -> pid()).
+
+value2pid(Value) ->
+ String = lists:flatten("<" ++ Value ++ ">"),
+ erlang:list_to_pid(String).
+
+
+%%% get value
+
+-spec(get_option_value/2 :: (
+ Option :: string(),
+ Options :: [{string(),any()}]) ->
+ {'error', any()} | bool() | pid() | [pid()] | number()).
+
+get_option_value(Option, Options) ->
+ case catch get_option_value0(Option, Options) of
+ {'EXIT', Reason} -> {error, Reason};
+ Value -> Value
+ end.
+
+get_option_value0(Option, Options) ->
+ case lists:keysearch(Option, 1, Options) of
+ false -> get_default_option_value(Option);
+ {value, {Option, _Value}} when Option == "fillcolor" -> true;
+ {value, {Option, Value}} when Option == "pid" -> value2pid(Value);
+ {value, {Option, Value}} when Option == "pids" ->
+ [value2pid(PidValue) || PidValue <- string:tokens(Value,":")];
+ {value, {Option, Value}} -> get_number_value(Value);
+ _ -> {error, undefined}
+ end.
+
+get_default_option_value(Option) ->
+ case Option of
+ "fillcolor" -> false;
+ "range_min" -> float(0.0);
+ "pids" -> [];
+ "range_max" ->
+ Acts = percept_db:select({activity, []}),
+ #activity{ timestamp = Start } = hd(Acts),
+ #activity{ timestamp = Stop } = hd(lists:reverse(Acts)),
+ ?seconds(Stop,Start);
+ "width" -> 700;
+ "height" -> 400;
+ _ -> {error, {undefined_default_option, Option}}
+ end.
+
+-spec(get_number_value/1 :: (Value :: string()) ->
+ number() | {'error', 'illegal_number'}).
+
+get_number_value(Value) ->
+ % Try float
+ case string:to_float(Value) of
+ {error, no_float} ->
+ % Try integer
+ case string:to_integer(Value) of
+ {error, _} -> {error, illegal_number};
+ {Integer, _} -> Integer
+ end;
+ {error, _} -> {error, illegal_number};
+ {Float, _} -> Float
+ end.
+
+%%% --------------------------- %%%
+%%% html prime functions %%%
+%%% --------------------------- %%%
+
+header() -> header([]).
+header(HeaderData) ->
+ "Content-Type: text/html\r\n\r\n" ++
+ "<html>
+ <head>
+ <meta http-equiv=\"Content-Type\" content=\"text/html; charset=iso-8859-1\">
+ <title>percept</title>
+ <link href=\"/css/percept.css\" rel=\"stylesheet\" type=\"text/css\">
+ <script type=\"text/javascript\" src=\"/javascript/percept_error_handler.js\"></script>
+ <script type=\"text/javascript\" src=\"/javascript/percept_select_all.js\"></script>
+ <script type=\"text/javascript\" src=\"/javascript/percept_area_select.js\"></script>
+ " ++ HeaderData ++"
+ </head>
+ <body onLoad=\"load_image()\">
+ <div id=\"header\"><a href=/index.html>percept</a></div>\n".
+
+footer() ->
+ "</body>
+ </html>\n".
+
+menu() ->
+ "<div id=\"menu\" class=\"menu_tabs\">
+ <ul>
+ <li><a href=/cgi-bin/percept_html/databases_page>databases</a></li>
+ <li><a href=/cgi-bin/percept_html/processes_page>processes</a></li>
+ <li><a href=/cgi-bin/percept_html/page>overview</a></li>
+ </ul></div>\n".
+
+-spec(error_msg/1 :: (Error :: string()) -> string()).
+
+error_msg(Error) ->
+ "<table width=300>
+ <tr height=5><td></td> <td></td></tr>
+ <tr><td width=150 align=right><b>Error: </b></td> <td align=left>"++ Error ++ "</td></tr>
+ <tr height=5><td></td> <td></td></tr>
+ </table>\n".
diff --git a/lib/percept/src/percept_image.erl b/lib/percept/src/percept_image.erl
new file mode 100644
index 0000000000..5baedabecf
--- /dev/null
+++ b/lib/percept/src/percept_image.erl
@@ -0,0 +1,315 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2007-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%
+
+-module(percept_image).
+-export([ proc_lifetime/5,
+ percentage/3,
+ graph/3,
+ graph/4,
+ activities/3,
+ activities/4]).
+-record(graph_area, {x = 0, y = 0, width, height}).
+-compile(inline).
+
+%%% -------------------------------------
+%%% GRAF
+%%% -------------------------------------
+
+%% graph(Widht, Height, Range, Data)
+
+graph(Width, Height, {RXmin, RYmin, RXmax, RYmax}, Data) ->
+ Data2 = [{X, Y1 + Y2} || {X, Y1, Y2} <- Data],
+ MinMax = percept_analyzer:minmax(Data2),
+ {Xmin, Ymin, Xmax, Ymax} = MinMax,
+ graf1(Width, Height,{ lists:min([RXmin, Xmin]),
+ lists:min([RYmin, Ymin]),
+ lists:max([RXmax, Xmax]),
+ lists:max([RYmax, Ymax])}, Data).
+
+%% graph(Widht, Height, Data) = Image
+%% In:
+%% Width = integer(),
+%% Height = integer(),
+%% Data = [{Time, Procs, Ports}]
+%% Time = float()
+%% Procs = integer()
+%% Ports = integer()
+%% Out:
+%% Image = binary()
+
+graph(Width, Height, Data) ->
+ Data2 = [{X, Y1 + Y2} || {X, Y1, Y2} <- Data],
+ Bounds = percept_analyzer:minmax(Data2),
+ graf1(Width, Height, Bounds, Data).
+
+graf1(Width, Height, {Xmin, Ymin, Xmax, Ymax}, Data) ->
+ % Calculate areas
+ HO = 20,
+ GrafArea = #graph_area{x = HO, y = 4, width = Width - 2*HO, height = Height - 17},
+ XticksArea = #graph_area{x = HO, y = Height - 13, width = Width - 2*HO, height = 13},
+ YticksArea = #graph_area{x = 1, y = 4, width = HO, height = Height - 17},
+
+ %% Initiate Image
+
+ Image = egd:create(Width, Height),
+
+ %% Set colors
+
+ Black = egd:color(Image, {0, 0, 0}),
+ ProcColor = egd:color(Image, {0, 255, 0}),
+ PortColor = egd:color(Image, {255, 0, 0}),
+
+ %% Draw graf, xticks and yticks
+ draw_graf(Image, Data, {Black, ProcColor, PortColor}, GrafArea, {Xmin, Ymin, Xmax, Ymax}),
+ draw_xticks(Image, Black, XticksArea, {Xmin, Xmax}, Data),
+ draw_yticks(Image, Black, YticksArea, {Ymin, Ymax}),
+
+ %% Kill image and return binaries
+ Binary = egd:render(Image, png),
+ egd:destroy(Image),
+ Binary.
+
+%% draw_graf(Image, Data, Color, GraphArea, DataBounds)
+%% Image, port to Image
+%% Data, list of three tuple data, (X, Y1, Y2)
+%% Color, {ForegroundColor, ProcFillColor, PortFillColor}
+%% DataBounds, {Xmin, Ymin, Xmax, Ymax}
+
+draw_graf(Im, Data, Colors, GA = #graph_area{x = X0, y = Y0, width = Width, height = Height}, {Xmin, _Ymin, Xmax, Ymax}) ->
+ Dx = (Width)/(Xmax - Xmin),
+ Dy = (Height)/(Ymax),
+ Plotdata = [{trunc(X0 + X*Dx - Xmin*Dx), trunc(Y0 + Height - Y1*Dy), trunc(Y0 + Height - (Y1 + Y2)*Dy)} || {X, Y1, Y2} <- Data],
+ draw_graf(Im, Plotdata, Colors, GA).
+
+draw_graf(Im, [{X1, Yproc1, Yport1}, {X2, Yproc2, Yport2}|Data], C, GA) when X2 - X1 < 1 ->
+ draw_graf(Im, [{X1, [{Yproc2, Yport2},{Yproc1, Yport1}]}|Data], C, GA);
+
+draw_graf(Im, [{X1, Ys1}, {X2, Yproc2, Yport2}|Data], C, GA) when X2 - X1 < 1, is_list(Ys1) ->
+ draw_graf(Im, [{X1, [{Yproc2, Yport2}|Ys1]}|Data], C, GA);
+
+draw_graf(Im, [{X1, Yproc1, Yport1}, {X2, Yproc2, Yport2}|Data], C = {B, PrC, PoC}, GA = #graph_area{y = Y0, height = H}) ->
+ GyZero = trunc(Y0 + H),
+ egd:filledRectangle(Im, {X1, GyZero}, {X2, Yproc1}, PrC),
+ egd:filledRectangle(Im, {X1, Yproc1}, {X2, Yport1}, PoC),
+ egd:line(Im, {X1, Yport1}, {X2, Yport1}, B), % top line
+ egd:line(Im, {X1, Yport2}, {X1, Yport1}, B), % right line
+ egd:line(Im, {X2, Yport1}, {X2, Yport2}, B), % right line
+ draw_graf(Im, [{X2, Yproc2, Yport2}|Data], C, GA);
+
+draw_graf(Im, [{X1, Ys1 = [{Yproc1,Yport1}|_]}, {X2, Yproc2, Yport2}|Data], C = {B, PrC, PoC}, GA = #graph_area{y = Y0, height = H}) ->
+ GyZero = trunc(Y0 + H),
+ Yprocs = [Yp || {Yp, _} <- Ys1],
+ Yports = [Yp || {_, Yp} <- Ys1],
+
+ YprMin = lists:min(Yprocs),
+ YprMax = lists:max(Yprocs),
+ YpoMax = lists:max(Yports),
+ egd:filledRectangle(Im, {X1, GyZero}, {X2, Yproc1}, PrC),
+ egd:filledRectangle(Im, {X1, Yproc1}, {X2, Yport1}, PoC),
+ egd:filledRectangle(Im, {X1, Yport1}, {X2, Yport1}, B), % top line
+ egd:filledRectangle(Im, {X2, Yport1}, {X2, Yport2}, B), % right line
+
+ egd:filledRectangle(Im, {X1, GyZero}, {X1, YprMin}, PrC), % left proc green line
+ egd:filledRectangle(Im, {X1, YprMax}, {X1, YpoMax}, PoC), % left port line
+ egd:filledRectangle(Im, {X1, YprMax}, {X1, YprMin}, B),
+
+ draw_graf(Im, [{X2, Yproc2, Yport2}|Data], C, GA);
+draw_graf(_, _, _, _) -> ok.
+
+draw_xticks(Image, Color, XticksArea, {Xmin, Xmax}, Data) ->
+ #graph_area{x = X0, y = Y0, width = Width} = XticksArea,
+
+ DX = Width/(Xmax - Xmin),
+ Offset = X0 - Xmin*DX,
+ Y = trunc(Y0),
+ Font = load_font(),
+ {FontW, _FontH} = egd_font:size(Font),
+ egd:filledRectangle(Image, {trunc(X0), Y}, {trunc(X0 + Width), Y}, Color),
+ lists:foldl(
+ fun ({X,_,_}, PX) ->
+ X1 = trunc(Offset + X*DX),
+
+ % Optimization:
+ % if offset has past half the previous text
+ % start checking this text
+
+ if
+ X1 > PX ->
+ Text = lists:flatten(io_lib:format("~.3f", [float(X)])),
+ TextLength = length(Text),
+ TextWidth = TextLength*FontW,
+ Spacing = 2,
+ if
+ X1 > PX + round(TextWidth/2) + Spacing ->
+ egd:line(Image, {X1, Y - 3}, {X1, Y + 3}, Color),
+ text(Image, {X1 - round(TextWidth/2), Y + 2}, Font, Text, Color),
+ X1 + round(TextWidth/2) + Spacing;
+ true ->
+ PX
+ end;
+ true ->
+ PX
+ end
+ end, 0, Data).
+
+draw_yticks(Im, Color, TickArea, {_,Ymax}) ->
+ #graph_area{x = X0, y = Y0, width = Width, height = Height} = TickArea,
+ Font = load_font(),
+ X = trunc(X0 + Width),
+ Dy = (Height)/(Ymax),
+ Yts = if
+ Height/(Ymax*12) < 1.0 -> round(1 + Ymax*15/Height);
+ true -> 1
+ end,
+ egd:filledRectangle(Im, {X, trunc(0 + Y0)}, {X, trunc(Y0 + Height)}, Color),
+ draw_yticks0(Im, Font, Color, 0, Yts, Ymax, {X, Height, Dy}).
+
+draw_yticks0(Im, Font, Color, Yi, Yts, Ymax, Area) when Yi < Ymax ->
+ {X, Height, Dy} = Area,
+ Y = round(Height - (Yi*Dy) + 3),
+
+ egd:filledRectangle(Im, {X - 3, Y}, {X + 3, Y}, Color),
+ Text = lists:flatten(io_lib:format("~p", [Yi])),
+ text(Im, {0, Y - 4}, Font, Text, Color),
+ draw_yticks0(Im, Font, Color, Yi + Yts, Yts, Ymax, Area);
+draw_yticks0(_, _, _, _, _, _, _) -> ok.
+
+%%% -------------------------------------
+%%% ACTIVITIES
+%%% -------------------------------------
+
+%% activities(Width, Height, Range, Activities) -> Binary
+%% In:
+%% Width = integer()
+%% Height = integer()
+%% Range = {float(), float()}
+%% Activities = [{float(), active | inactive}]
+%% Out:
+%% Binary = binary()
+
+activities(Width, Height, {UXmin, UXmax}, Activities) ->
+ Xs = [ X || {X,_} <- Activities],
+ Xmin = lists:min(Xs),
+ Xmax = lists:max(Xs),
+ activities0(Width, Height, {lists:min([Xmin, UXmin]), lists:max([UXmax, Xmax])}, Activities).
+
+activities(Width, Height, Activities) ->
+ Xs = [ X || {X,_} <- Activities],
+ Xmin = lists:min(Xs),
+ Xmax = lists:max(Xs),
+ activities0(Width, Height, {Xmin, Xmax}, Activities).
+
+activities0(Width, Height, {Xmin, Xmax}, Activities) ->
+ Image = egd:create(Width, Height),
+ Grey = egd:color(Image, {200, 200, 200}),
+ HO = 20,
+ ActivityArea = #graph_area{x = HO, y = 0, width = Width - 2*HO, height = Height},
+ egd:filledRectangle(Image, {0, 0}, {Width, Height}, Grey),
+ draw_activity(Image, {Xmin, Xmax}, ActivityArea, Activities),
+ Binary = egd:render(Image, png),
+ egd:destroy(Image),
+ Binary.
+
+draw_activity(Image, {Xmin, Xmax}, Area = #graph_area{ width = Width }, Acts) ->
+ White = egd:color({255, 255, 255}),
+ Green = egd:color({0,250, 0}),
+ Black = egd:color({0, 0, 0}),
+
+ Dx = Width/(Xmax - Xmin),
+
+ draw_activity(Image, {Xmin, Xmax}, Area, {White, Green, Black}, Dx, Acts).
+
+draw_activity(_, _, _, _, _, [_]) -> ok;
+draw_activity(Image, {Xmin, Xmax}, Area = #graph_area{ height = Height, x = X0 }, {Cw, Cg, Cb}, Dx, [{Xa1, State}, {Xa2, Act2} | Acts]) ->
+ X1 = erlang:trunc(X0 + Dx*Xa1 - Xmin*Dx),
+ X2 = erlang:trunc(X0 + Dx*Xa2 - Xmin*Dx),
+
+ case State of
+ inactive ->
+ egd:filledRectangle(Image, {X1, 0}, {X2, Height - 1}, Cw),
+ egd:rectangle(Image, {X1, 0}, {X2, Height - 1}, Cb);
+ active ->
+ egd:filledRectangle(Image, {X1, 0}, {X2, Height - 1}, Cg),
+ egd:rectangle(Image, {X1, 0}, {X2, Height - 1}, Cb)
+ end,
+ draw_activity(Image, {Xmin, Xmax}, Area, {Cw, Cg, Cb}, Dx, [{Xa2, Act2} | Acts]).
+
+
+
+%%% -------------------------------------
+%%% Process lifetime
+%%% Used by processes page
+%%% -------------------------------------
+
+proc_lifetime(Width, Height, Start, End, ProfileTime) ->
+ Im = egd:create(round(Width), round(Height)),
+ Black = egd:color(Im, {0, 0, 0}),
+ Green = egd:color(Im, {0, 255, 0}),
+
+ % Ratio and coordinates
+
+ DX = (Width-1)/ProfileTime,
+ X1 = round(DX*Start),
+ X2 = round(DX*End),
+
+ % Paint
+ egd:filledRectangle(Im, {X1, 0}, {X2, Height - 1}, Green),
+ egd:rectangle(Im, {X1, 0}, {X2, Height - 1}, Black),
+
+ Binary = egd:render(Im, png),
+ egd:destroy(Im),
+ Binary.
+
+%%% -------------------------------------
+%%% Percentage
+%%% Used by process_info page
+%%% Percentage should be 0.0 -> 1.0
+%%% -------------------------------------
+percentage(Width, Height, Percentage) ->
+ Im = egd:create(round(Width), round(Height)),
+ Font = load_font(),
+ Black = egd:color(Im, {0, 0, 0}),
+ Green = egd:color(Im, {0, 255, 0}),
+
+ % Ratio and coordinates
+
+ X = round(Width - 1 - Percentage*(Width - 1)),
+
+ % Paint
+ egd:filledRectangle(Im, {X, 0}, {Width - 1, Height - 1}, Green),
+ {FontW, _} = egd_font:size(Font),
+ String = lists:flatten(io_lib:format("~.10B %", [round(100*Percentage)])),
+
+ text( Im,
+ {round(Width/2 - (FontW*length(String)/2)), 0},
+ Font,
+ String,
+ Black),
+ egd:rectangle(Im, {X, 0}, {Width - 1, Height - 1}, Black),
+
+ Binary = egd:render(Im, png),
+ egd:destroy(Im),
+ Binary.
+
+
+load_font() ->
+ Filename = filename:join([code:priv_dir(percept),"fonts", "6x11_latin1.wingsfont"]),
+ egd_font:load(Filename).
+
+text(Image, {X,Y}, Font, Text, Color) ->
+ egd:text(Image, {X,Y-2}, Font, Text, Color).
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-10 11:33:34 +0000