From 84adefa331c4159d432d22840663c38f155cd4c1 Mon Sep 17 00:00:00 2001 From: Erlang/OTP Date: Fri, 20 Nov 2009 14:54:40 +0000 Subject: The R13B03 release. --- lib/percept/src/Makefile | 104 +++++ lib/percept/src/egd.erl | 287 +++++++++++++ lib/percept/src/egd.hrl | 45 ++ lib/percept/src/egd_font.erl | 176 ++++++++ lib/percept/src/egd_png.erl | 104 +++++ lib/percept/src/egd_primitives.erl | 543 +++++++++++++++++++++++++ lib/percept/src/egd_render.erl | 709 ++++++++++++++++++++++++++++++++ lib/percept/src/percept.app.src | 30 ++ lib/percept/src/percept.appup.src | 21 + lib/percept/src/percept.erl | 337 +++++++++++++++ lib/percept/src/percept.hrl | 53 +++ lib/percept/src/percept_analyzer.erl | 367 +++++++++++++++++ lib/percept/src/percept_db.erl | 768 +++++++++++++++++++++++++++++++++++ lib/percept/src/percept_graph.erl | 133 ++++++ lib/percept/src/percept_html.erl | 720 ++++++++++++++++++++++++++++++++ lib/percept/src/percept_image.erl | 315 ++++++++++++++ 16 files changed, 4712 insertions(+) create mode 100644 lib/percept/src/Makefile create mode 100644 lib/percept/src/egd.erl create mode 100644 lib/percept/src/egd.hrl create mode 100644 lib/percept/src/egd_font.erl create mode 100755 lib/percept/src/egd_png.erl create mode 100644 lib/percept/src/egd_primitives.erl create mode 100644 lib/percept/src/egd_render.erl create mode 100644 lib/percept/src/percept.app.src create mode 100644 lib/percept/src/percept.appup.src create mode 100644 lib/percept/src/percept.erl create mode 100644 lib/percept/src/percept.hrl create mode 100644 lib/percept/src/percept_analyzer.erl create mode 100644 lib/percept/src/percept_db.erl create mode 100644 lib/percept/src/percept_graph.erl create mode 100644 lib/percept/src/percept_html.erl create mode 100644 lib/percept/src/percept_image.erl (limited to 'lib/percept/src') 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), + <>. + +% 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), <>), + 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. +%% +%%

Queries:

+%% 
+%% {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{}]
+%%
+%%

+%% Note: selection of Id's are always OR all other options are considered AND. +%%

+ +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_line(["Profile time:", TotalProfileTime]) ++ + table_line(["Processes:", RegisteredProcs]) ++ + table_line(["Ports:", RegisteredPorts]) ++ + table_line(["Min. range:", Min]) ++ + table_line(["Max. range:", Max]) ++ + "
", + + Header = " +
+
" ++ InformationTable ++ "
\n +
+ + \n", + + + RangeTable = + ""++ + table_line([ + "Min:", + "", + "", + "" + ]) ++ + table_line([ + "Max:", + "", + "", + "Code location" + ]) ++ + "
", + + + MainTable = + "" ++ + table_line([div_tag_graph()]) ++ + table_line([RangeTable]) ++ + "
", + + Footer = "
", + + Header ++ MainTable ++ Footer. + +div_tag_graph() -> + %background:url('/images/loader.gif') no-repeat center; + "
+ +
". + +-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) ++ "
" || 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]), + + "
" ++ + InfoTable ++ "
" ++ + MfaTable ++ + "
". + +%%% 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), + "" + ]) + end, [], Pids), + + %% Make pids request string + PidsRequest = join_strings_with(PidValues, ":"), + + "
+ " ++ + table_line([ + "", + "" + ]) ++ + ActivityBarTable ++ + "
\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([ + "", + 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_line([ + "Select all"]) ++ + table_line([ + ""]) ++ + "
", + + if + length(ProcsHtml) > 0 -> + ProcsHtmlResult = + "Processes + + + + + + + + + + " ++ + lists:flatten(ProcsHtml) ++ + "
SelectPidLifetimeEntrypointNameParent
+ "; + true -> + ProcsHtmlResult = "" + end, + if + length(PortsHtml) > 0 -> + PortsHtmlResult = " + Ports + + + + + + + + + + " ++ + lists:flatten(PortsHtml) ++ + "
SelectPidLifetimeEntrypointNameParent
+ "; + true -> + PortsHtmlResult = "" + end, + + Right = "
" + ++ Selector ++ + "
\n", + + Middle = "
+ " ++ + ProcsHtmlResult ++ + PortsHtmlResult ++ + "
" ++ + Right ++ + "
\n", + + "
" ++ + Middle ++ + "
". + +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() -> + "
+
+
+ + + +
Enter file to analyse:
+
+
+
". + +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, "
"), + case file:read_file_info(Filename) of + {ok, _} -> + Content = "
+ Parsing: " ++ Filename ++ "
+
", + mod_esi:deliver(SessionId, Content), + case percept:analyze(Filename) of + {error, Reason} -> + mod_esi:deliver(SessionId, error_msg("Analyze" ++ term2html(Reason))); + _ -> + Complete = "
View
", + mod_esi:deliver(SessionId, Complete) + end; + {error, Reason} -> + mod_esi:deliver(SessionId, error_msg("File" ++ term2html(Reason))) + end, + mod_esi:deliver(SessionId, "
"). + +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 ]), + + "
" ++ + Table ++ + "
". + +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) -> "" ++ html_table_row(Rows) ++ "
". + +html_table_row(Rows) -> html_table_row(Rows, odd). +html_table_row([], _) -> ""; +html_table_row([Row|Rows], odd ) -> "" ++ html_table_data(Row) ++ "" ++ html_table_row(Rows, even); +html_table_row([Row|Rows], even) -> "" ++ html_table_data(Row) ++ "" ++ html_table_row(Rows, odd ). + +html_table_data([]) -> ""; +html_table_data([{td, Data}|Row]) -> "" ++ Data ++ "" ++ html_table_data(Row); +html_table_data([{th, Data}|Row]) -> "" ++ Data ++ "" ++ html_table_data(Row); +html_table_data([Data|Row]) -> "" ++ Data ++ "" ++ html_table_data(Row). + + + + +-spec(table_line/1 :: (Table :: [any()]) -> string()). + +table_line(List) -> table_line(List, [""]). +table_line([], Out) -> lists:flatten(lists:reverse(["\n"|Out])); +table_line([Element | Elements], Out) when is_list(Element) -> + table_line(Elements, ["" ++ Element ++ "" |Out]); +table_line([Element | Elements], Out) -> + table_line(Elements, ["" ++ term2html(Element) ++ ""|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), + ""++PidString++""; +pid2html(Pid) when is_port(Pid) -> + term2html(Pid); +pid2html(_) -> + "undefined". + +-spec(image_string/1 :: (Request :: string()) -> string()). + +image_string(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" ++ + " + + + percept + + + + + " ++ HeaderData ++" + + + \n". + +footer() -> + " + \n". + +menu() -> + "\n". + +-spec(error_msg/1 :: (Error :: string()) -> string()). + +error_msg(Error) -> + " + + + +
Error: "++ Error ++ "
\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). -- cgit v1.2.3