aboutsummaryrefslogtreecommitdiffstats
path: root/lib/percept/src
diff options
context:
space:
mode:
Diffstat (limited to 'lib/percept/src')
-rw-r--r--lib/percept/src/Makefile108
-rw-r--r--lib/percept/src/egd.erl275
-rw-r--r--lib/percept/src/egd.hrl45
-rw-r--r--lib/percept/src/egd_font.erl173
-rw-r--r--lib/percept/src/egd_png.erl105
-rw-r--r--lib/percept/src/egd_primitives.erl412
-rw-r--r--lib/percept/src/egd_render.erl664
-rw-r--r--lib/percept/src/percept.app.src45
-rw-r--r--lib/percept/src/percept.appup.src22
-rw-r--r--lib/percept/src/percept.erl337
-rw-r--r--lib/percept/src/percept.hrl53
-rw-r--r--lib/percept/src/percept_analyzer.erl368
-rw-r--r--lib/percept/src/percept_db.erl780
-rw-r--r--lib/percept/src/percept_graph.erl134
-rw-r--r--lib/percept/src/percept_html.erl707
-rw-r--r--lib/percept/src/percept_image.erl316
16 files changed, 0 insertions, 4544 deletions
diff --git a/lib/percept/src/Makefile b/lib/percept/src/Makefile
deleted file mode 100644
index b2ec87d08c..0000000000
--- a/lib/percept/src/Makefile
+++ /dev/null
@@ -1,108 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 2007-2016. All Rights Reserved.
-#
-# Licensed under the Apache License, Version 2.0 (the "License");
-# you may not use this file except in compliance with the License.
-# You may obtain a copy of the License at
-#
-# http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing, software
-# distributed under the License is distributed on an "AS IS" BASIS,
-# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-# See the License for the specific language governing permissions 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/
-
-INTERNAL_HRL_FILES= egd.hrl percept.hrl
-
-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
- $(vsn_verbose)sed -e 's;%VSN%;$(VSN);' $< > $@
-
-$(APPUP_TARGET): $(APPUP_SRC) ../vsn.mk
- $(vsn_verbose)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_DATA) $(INTERNAL_HRL_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
deleted file mode 100644
index fe52da71f1..0000000000
--- a/lib/percept/src/egd.erl
+++ /dev/null
@@ -1,275 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2008-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions 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 font()
-%% @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(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(Image :: egd_image()) -> ok.
-
-destroy(Image) ->
- cast(Image, destroy).
-
-
-%% @spec render(egd_image()) -> binary()
-%% @equiv render(Image, png, [{render_engine, opaque}])
-
--spec render(Image :: egd_image()) -> binary().
-
-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(
- 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).
-
-%% @spec line(egd_image(), point(), point(), color()) -> ok
-%% @doc Creates a line object from P1 to P2 in the image.
-
--spec line(
- Image :: egd_image(),
- P1 :: point(),
- P2 :: point(),
- Color :: color()) -> 'ok'.
-
-line(Image, P1, P2, Color) ->
- cast(Image, {line, P1, P2, Color}).
-
-%% @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(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}).
-
-%% @spec rectangle(egd_image(), point(), point(), color()) -> ok
-%% @doc Creates a rectangle object.
-
-rectangle(Image, P1, P2, Color) ->
- cast(Image, {rectangle, P1, P2, Color}).
-
-%% @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}).
-
-%% @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}).
-
-%% @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}).
-
-%% @spec polygon(egd_image(), [point()], color()) -> ok
-%% @hidden
-%% @doc Creates a filled filled polygon object.
-
-polygon(Image, Pts, Color) ->
- cast(Image, {polygon, Pts, Color}).
-
-%% @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}).
-
-%% @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}).
-
-%% @spec save(binary(), string()) -> ok
-%% @doc Saves the binary to file.
-
-save(Binary, Filename) when is_binary(Binary) ->
- ok = file:write_file(Filename, Binary),
- ok.
-% ---------------------------------
-% Aux functions
-% ---------------------------------
-
-cast(Pid, Command) ->
- Pid ! {egd, self(), Command},
- ok.
-
-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
deleted file mode 100644
index fc0a7e10ee..0000000000
--- a/lib/percept/src/egd.hrl
+++ /dev/null
@@ -1,45 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2008-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions 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), ok).
--endif.
diff --git a/lib/percept/src/egd_font.erl b/lib/percept/src/egd_font.erl
deleted file mode 100644
index ef1cc434df..0000000000
--- a/lib/percept/src/egd_font.erl
+++ /dev/null
@@ -1,173 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2008-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions 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() ->
- egd_font_table = ets:new(egd_font_table, [named_table, ordered_set, public]),
- ok.
-
-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
deleted file mode 100644
index fe660513b4..0000000000
--- a/lib/percept/src/egd_png.erl
+++ /dev/null
@@ -1,105 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2008-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-
-
-%% This code was originally written by Dan Gudmundsson for png-handling in
-%% wings3d (e3d__png).
-%%
-%% @doc egd
-%%
-
--module(egd_png).
-
--export([binary/3]).
-
--include("egd.hrl").
-
--define(MAGIC, 137,$P,$N,$G,$\r,$\n,26,$\n).
-
--define(GREYSCALE, 0).
--define(TRUECOLOUR, 2).
--define(INDEXED, 3).
--define(GREYSCALE_A, 4).
--define(TRUECOLOUR_A,6).
-
--define(MAX_WBITS,15).
-
--define(CHUNK, 240).
-
--define(get4p1(Idx),((Idx) bsr 4)).
--define(get4p2(Idx),((Idx) band 16#0F)).
--define(get2p1(Idx),((Idx) bsr 6)).
--define(get2p2(Idx),(((Idx) bsr 4) band 3)).
--define(get2p3(Idx),(((Idx) bsr 2) band 3)).
--define(get2p4(Idx),((Idx) band 3)).
--define(get1p1(Idx),((Idx) bsr 7)).
--define(get1p2(Idx),(((Idx) bsr 6) band 1)).
--define(get1p3(Idx),(((Idx) bsr 5) band 1)).
--define(get1p4(Idx),(((Idx) bsr 4) band 1)).
--define(get1p5(Idx),(((Idx) bsr 3) band 1)).
--define(get1p6(Idx),(((Idx) bsr 2) band 1)).
--define(get1p7(Idx),(((Idx) bsr 1) band 1)).
--define(get1p8(Idx),((Idx) band 1)).
-
-binary(W, H, Bitmap) when is_binary(Bitmap) ->
- Z = zlib:open(),
- Binary = bitmap2png(W, H, Bitmap, Z),
- zlib:close(Z),
- Binary.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-% Begin Tainted
-
-bitmap2png(W, H, Bitmap,Z) ->
- HDR = create_chunk(<<"IHDR",W:32,H:32,8:8,(png_type(r8g8b8)):8,0:8,0:8,0:8>>,Z),
- DATA = create_chunk(["IDAT",compress_image(0,3*W,Bitmap,[])],Z),
- END = create_chunk(<<"IEND">>,Z),
- list_to_binary([?MAGIC,HDR,DATA,END]).
-
-compress_image(I,RowLen, Bin, Acc) ->
- Pos = I*RowLen,
- case Bin of
- <<_:Pos/binary,Row:RowLen/binary,_/binary>> ->
- Filtered = filter_row(Row,RowLen),
- compress_image(I+1,RowLen,Bin,[Filtered|Acc]);
- _ when Pos == size(Bin) ->
- Filtered = list_to_binary(lists:reverse(Acc)),
- Compressed = zlib:compress(Filtered),
- Compressed
- end.
-
-filter_row(Row,_RowLen) ->
- [0,Row].
-
-% dialyzer warnings
-%png_type(g8) -> ?GREYSCALE;
-%png_type(a8) -> ?GREYSCALE;
-%png_type(r8g8b8a8) -> ?TRUECOLOUR_A;
-png_type(r8g8b8) -> ?TRUECOLOUR.
-
-create_chunk(Bin,Z) when is_list(Bin) ->
- create_chunk(list_to_binary(Bin),Z);
-create_chunk(Bin,Z) when is_binary(Bin) ->
- Sz = size(Bin)-4,
- Crc = zlib:crc32(Z,Bin),
- <<Sz:32,Bin/binary,Crc:32>>.
-
-% End tainted
diff --git a/lib/percept/src/egd_primitives.erl b/lib/percept/src/egd_primitives.erl
deleted file mode 100644
index b64189c552..0000000000
--- a/lib/percept/src/egd_primitives.erl
+++ /dev/null
@@ -1,412 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2008-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-
-%%
-%% @doc egd_primitives
-%%
-
-
--module(egd_primitives).
--export([create/2,
- color/1,
- pixel/3,
- polygon/3,
- line/4,
- line/5,
- 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(#image{objects=Os}=I, Sp, Ep, Color) ->
- line(#image{objects=Os}=I, Sp, Ep, 1, Color).
-
-line(#image{objects=Os}=I, Sp, Ep, Wd, Color) ->
- I#image{objects=[#image_object{
- internals = Wd,
- type = line,
- points = [Sp, Ep],
- span = span([Sp, Ep]),
- color = Color}|Os]}.
-
-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(#image{objects=Os}=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{
- internals = D,
- type = arc,
- points = [Sp, Ep],
- span = span(SpanPts),
- color = Color}|Os]}.
-
-pixel(#image{objects=Os}=I, Point, Color) ->
- I#image{objects=[#image_object{
- type = pixel,
- points = [Point],
- span = span([Point]),
- color = Color}|Os]}.
-
-rectangle(#image{objects=Os}=I, Sp, Ep, Color) ->
- I#image{objects=[#image_object{
- type = rectangle,
- points = [Sp, Ep],
- span = span([Sp, Ep]),
- color = Color}|Os]}.
-
-filledRectangle(#image{objects=Os}=I, Sp, Ep, Color) ->
- I#image{objects=[#image_object{
- type = filled_rectangle,
- points = [Sp, Ep],
- span = span([Sp, Ep]),
- color = Color}|Os]}.
-
-filledEllipse(#image{objects=Os}=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{
- internals = {Xp,Yp, Xr*Xr,Yr*Yr},
- type = filled_ellipse,
- points = [Sp, Ep],
- span = Span,
- color = Color}|Os]}.
-
-filledTriangle(#image{objects=Os}=I, P1, P2, P3, Color) ->
- I#image{objects=[#image_object{
- type = filled_triangle,
- points = [P1,P2,P3],
- span = span([P1,P2,P3]),
- color = Color}|Os]}.
-
-polygon(#image{objects=Os}=I, Points, Color) ->
- I#image{objects=[#image_object{
- type = polygon,
- points = Points,
- span = span(Points),
- color = Color}|Os]}.
-
-text(#image{objects=Os}=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{
- internals = {Font, Text},
- type = text_horizontal,
- points = [Sp],
- span = span([Sp,Ep]),
- color = Color}|Os]}.
-
-create(W, H) ->
- #image{width = W, height = H}.
-
-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).
-
-name_to_color(Color, A) ->
- case Color of
- %% HTML default colors
- black -> { 0, 0, 0, A};
- silver -> {192, 192, 192, A};
- gray -> {128, 128, 128, A};
- white -> {128, 0, 0, A};
- maroon -> {255, 0, 0, A};
- red -> {128, 0, 128, A};
- purple -> {128, 0, 128, A};
- fuchia -> {255, 0, 255, A};
- green -> { 0, 128, 0, A};
- lime -> { 0, 255, 0, A};
- olive -> {128, 128, 0, A};
- yellow -> {255, 255, 0, A};
- navy -> { 0, 0, 128, A};
- blue -> { 0, 0, 255, A};
- teal -> { 0, 128, 0, A};
- aqua -> { 0, 255, 155, A};
-
- %% HTML color extensions
- steelblue -> { 70, 130, 180, A};
- royalblue -> { 4, 22, 144, A};
- cornflowerblue -> {100, 149, 237, A};
- lightsteelblue -> {176, 196, 222, A};
- mediumslateblue -> {123, 104, 238, A};
- slateblue -> {106, 90, 205, A};
- darkslateblue -> { 72, 61, 139, A};
- midnightblue -> { 25, 25, 112, A};
- darkblue -> { 0, 0, 139, A};
- mediumblue -> { 0, 0, 205, A};
- dodgerblue -> { 30, 144, 255, A};
- deepskyblue -> { 0, 191, 255, A};
- lightskyblue -> {135, 206, 250, A};
- skyblue -> {135, 206, 235, A};
- lightblue -> {173, 216, 230, A};
- powderblue -> {176, 224, 230, A};
- azure -> {240, 255, 255, A};
- lightcyan -> {224, 255, 255, A};
- paleturquoise -> {175, 238, 238, A};
- mediumturquoise -> { 72, 209, 204, A};
- lightseagreen -> { 32, 178, 170, A};
- darkcyan -> { 0, 139, 139, A};
- cadetblue -> { 95, 158, 160, A};
- darkturquoise -> { 0, 206, 209, A};
- cyan -> { 0, 255, 255, A};
- turquoise -> { 64, 224, 208, A};
- aquamarine -> {127, 255, 212, A};
- mediumaquamarine -> {102, 205, 170, A};
- darkseagreen -> {143, 188, 143, A};
- mediumseagreen -> { 60, 179, 113, A};
- seagreen -> { 46, 139, 87, A};
- darkgreen -> { 0, 100, 0, A};
- forestgreen -> { 34, 139, 34, A};
- limegreen -> { 50, 205, 50, A};
- chartreuse -> {127, 255, 0, A};
- lawngreen -> {124, 252, 0, A};
- greenyellow -> {173, 255, 47, A};
- yellowgreen -> {154, 205, 50, A};
- palegreen -> {152, 251, 152, A};
- lightgreen -> {144, 238, 144, A};
- springgreen -> { 0, 255, 127, A};
- darkolivegreen -> { 85, 107, 47, A};
- olivedrab -> {107, 142, 35, A};
- darkkhaki -> {189, 183, 107, A};
- darkgoldenrod -> {184, 134, 11, A};
- goldenrod -> {218, 165, 32, A};
- gold -> {255, 215, 0, A};
- khaki -> {240, 230, 140, A};
- palegoldenrod -> {238, 232, 170, A};
- blanchedalmond -> {255, 235, 205, A};
- moccasin -> {255, 228, 181, A};
- wheat -> {245, 222, 179, A};
- navajowhite -> {255, 222, 173, A};
- burlywood -> {222, 184, 135, A};
- tan -> {210, 180, 140, A};
- rosybrown -> {188, 143, 143, A};
- sienna -> {160, 82, 45, A};
- saddlebrown -> {139, 69, 19, A};
- chocolate -> {210, 105, 30, A};
- peru -> {205, 133, 63, A};
- sandybrown -> {244, 164, 96, A};
- darkred -> {139, 0, 0, A};
- brown -> {165, 42, 42, A};
- firebrick -> {178, 34, 34, A};
- indianred -> {205, 92, 92, A};
- lightcoral -> {240, 128, 128, A};
- salmon -> {250, 128, 114, A};
- darksalmon -> {233, 150, 122, A};
- lightsalmon -> {255, 160, 122, A};
- coral -> {255, 127, 80, A};
- tomato -> {255, 99, 71, A};
- darkorange -> {255, 140, 0, A};
- orange -> {255, 165, 0, A};
- orangered -> {255, 69, 0, A};
- crimson -> {220, 20, 60, A};
- deeppink -> {255, 20, 147, A};
- fuchsia -> {255, 0, 255, A};
- magenta -> {255, 0, 255, A};
- hotpink -> {255, 105, 180, A};
- lightpink -> {255, 182, 193, A};
- pink -> {255, 192, 203, A};
- palevioletred -> {219, 112, 147, A};
- mediumvioletred -> {199, 21, 133, A};
- darkmagenta -> {139, 0, 139, A};
- mediumpurple -> {147, 112, 219, A};
- blueviolet -> {138, 43, 226, A};
- indigo -> { 75, 0, 130, A};
- darkviolet -> {148, 0, 211, A};
- darkorchid -> {153, 50, 204, A};
- mediumorchid -> {186, 85, 211, A};
- orchid -> {218, 112, 214, A};
- violet -> {238, 130, 238, A};
- plum -> {221, 160, 221, A};
- thistle -> {216, 191, 216, A};
- lavender -> {230, 230, 250, A};
- ghostwhite -> {248, 248, 255, A};
- aliceblue -> {240, 248, 255, A};
- mintcream -> {245, 255, 250, A};
- honeydew -> {240, 255, 240, A};
- lemonchiffon -> {255, 250, 205, A};
- cornsilk -> {255, 248, 220, A};
- lightyellow -> {255, 255, 224, A};
- ivory -> {255, 255, 240, A};
- floralwhite -> {255, 250, 240, A};
- linen -> {250, 240, 230, A};
- oldlace -> {253, 245, 230, A};
- antiquewhite -> {250, 235, 215, A};
- bisque -> {255, 228, 196, A};
- peachpuff -> {255, 218, 185, A};
- papayawhip -> {255, 239, 213, A};
- beige -> {245, 245, 220, A};
- seashell -> {255, 245, 238, A};
- lavenderblush -> {255, 240, 245, A};
- mistyrose -> {255, 228, 225, A};
- snow -> {255, 250, 250, A};
- whitesmoke -> {245, 245, 245, A};
- gainsboro -> {220, 220, 220, A};
- lightgrey -> {211, 211, 211, A};
- darkgray -> {169, 169, 169, A};
- lightslategray -> {119, 136, 153, A};
- slategray -> {112, 128, 144, A};
- dimgray -> {105, 105, 105, A};
- darkslategray -> { 47, 79, 79, A};
- mediumspringgreen -> { 0, 250, 154, A};
- lightgoldenrodyellow -> {250, 250, 210, A}
- end.
-
-
-%%% 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([{X0,Y0}|Points]) ->
- span(Points,X0,Y0,X0,Y0).
-span([{X0,Y0}|Points],Xmin,Ymin,Xmax,Ymax) ->
- span(Points,erlang:min(Xmin,X0),
- erlang:min(Ymin,Y0),
- erlang:max(Xmax,X0),
- erlang:max(Ymax,Y0));
-span([],Xmin,Ymin,Xmax,Ymax) ->
- {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
deleted file mode 100644
index 6c708e3e86..0000000000
--- a/lib/percept/src/egd_render.erl
+++ /dev/null
@@ -1,664 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2008-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-
-%%
-%% @doc egd_render
-%%
-
--module(egd_render).
-
--export([binary/1, binary/2]).
--export([eps/1]).
--compile(inline).
-
--export([line_to_linespans/3]).
-
--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 erlang: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([scanline(Y, Os, {0,0,W - 1, Bg}, Type)
- || Y <- 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),
- RLSs = resulting_line_spans([LSB|OLSs],Type),
- [ lists:duplicate(Xr - Xl + 1, <<(trunc(R*255)):8,(trunc(G*255)):8,(trunc(B*255)):8>>) || {_,Xl, Xr, {R,G,B,_}} <- RLSs ].
-
-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,0.0,0.0},Layers).
-
-color1(Color,[]) -> Color;
-color1(Color,[{_,C}|Layers]) -> color1(alpha_blend(Color,C),Layers).
-
-modify_layers(Layers,[]) -> Layers;
-modify_layers(Layers,[{{_,Z,start},C}|Trans]) ->
- modify_layers(add_layer(Layers, Z, C), Trans);
-modify_layers(Layers,[{{_,Z,stop },C}|Trans]) ->
- modify_layers(remove_layer(Layers, Z, C), 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}) when is_float(A1), is_float(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(O, Y) of
- false ->
- parse_objects_on_line(Y, Z + 1, Width, Os, Out);
- true ->
- OLs = object_line_data(O,Y,Z),
- 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([{_, Xl, _, _}|OLs], Width, Out) when Xl > Width ->
- trim_object_line_data(OLs, Width, Out);
-trim_object_line_data([{_, _, Xr, _}|OLs], Width, Out) when Xr < 0 ->
- trim_object_line_data(OLs, Width, Out);
-trim_object_line_data([{Z, Xl, Xr, C}|OLs], Width, Out) ->
- trim_object_line_data(OLs, Width, [{Z, erlang:max(0,Xl), erlang:min(Xr,Width), C}|Out]).
-
-% object_line_data
-% In:
-% Object :: image_object()
-% Y :: index of height
-% Z :: index of depth
-% 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(#image_object{type=rectangle,
- span={X0,Y0,X1,Y1}, color=C}, Y, Z) ->
- if
- Y0 =:= Y ; Y1 =:= Y ->
- [{Z, X0, X1, C}];
- true ->
- [{Z, X0, X0, C},
- {Z, X1, X1, C}]
- end;
-
-object_line_data(#image_object{type=filled_rectangle,
- span={X0, _, X1, _}, color=C}, _Y, Z) ->
- [{Z, X0, X1, C}];
-
-object_line_data(#image_object{type=filled_ellipse,
- internals={Xr,Yr,Yr2}, span={X0,Y0,X1,Y1}, color=C}, Y, Z) ->
- if
- X1 - X0 =:= 0; Y1 - Y0 =:= 0 ->
- [{Z, X0, X1, C}];
- true ->
- Yo = trunc(Y - Y0 - Yr),
- Yo2 = Yo*Yo,
- Xo = math:sqrt((1 - Yo2/Yr2))*Xr,
- [{Z, round(X0 - Xo + Xr), round(X0 + Xo + Xr), C}]
- end;
-
-object_line_data(#image_object{type=filled_triangle,
- intervals=Is, color=C}, Y, Z) ->
- case lists:keyfind(Y, 1, Is) of
- {Y, Xl, Xr} -> [{Z, Xl, Xr, C}];
- false -> []
- end;
-
-object_line_data(#image_object{type=line,
- intervals=M, color={R,G,B,_}}, Y, Z) ->
- case M of
- #{Y := Ls} -> [{Z, Xl, Xr, {R,G,B,1.0-C/255}}||{Xl,Xr,C} <- Ls];
- _ -> []
- end;
-
-object_line_data(#image_object{type=polygon,
- color=C, intervals=Is}, Y, Z) ->
- [{Z, Xl, Xr, C} || {Yp, Xl, Xr} <- Is, Yp =:= Y];
-
-object_line_data(#image_object{type=text_horizontal,
- color=C, intervals=Is}, Y, Z) ->
- [{Z, Xl, Xr, C} || {Yg, Xl, Xr} <- Is, Yg =:= Y];
-
-object_line_data(#image_object{type=pixel,
- span={X0,_,X1,_}, color=C}, _, Z) ->
- [{Z, X0, X1, C}].
-
-is_object_on_line(#image_object{span={_,Y0,_,Y1}}, Y) ->
- if Y < Y0; Y > Y1 -> false;
- true -> true
- end.
-
-%%% primitives to line_spans
-
-%% compile objects to linespans
-
-precompile(#image{objects = Os}=I) ->
- I#image{objects = precompile_objects(Os)}.
-
-precompile_objects([]) -> [];
-precompile_objects([#image_object{type=line, internals=W, points=[P0,P1]}=O|Os]) ->
- [O#image_object{intervals = linespans_to_map(line_to_linespans(P0,P1,W))}|precompile_objects(Os)];
-precompile_objects([#image_object{type=filled_triangle, points=[P0,P1,P2]}=O|Os]) ->
- [O#image_object{intervals = triangle_ls(P0,P1,P2)}|precompile_objects(Os)];
-precompile_objects([#image_object{type=polygon, points=Pts}=O|Os]) ->
- [O#image_object{intervals = polygon_ls(Pts)}|precompile_objects(Os)];
-precompile_objects([#image_object{type=filled_ellipse, span={X0,Y0,X1,Y1}}=O|Os]) ->
- Xr = (X1 - X0)/2,
- Yr = (Y1 - Y0)/2,
- Yr2 = Yr*Yr,
- [O#image_object{internals={Xr,Yr,Yr2}}|precompile_objects(Os)];
-precompile_objects([#image_object{type=arc, points=[P0,P1], internals=D}=O|Os]) ->
- Es = egd_primitives:arc_to_edges(P0, P1, D),
- Ls = lists:foldl(fun ({Ep0,Ep1},M) ->
- linespans_to_map(line_to_linespans(Ep0,Ep1,1),M)
- end, #{}, Es),
- [O#image_object{type=line, intervals=Ls}|precompile_objects(Os)];
-precompile_objects([#image_object{type=text_horizontal,
- points=[P0], internals={Font,Text}}=O|Os]) ->
- [O#image_object{intervals=text_horizontal_ls(P0,Font,Text)}|precompile_objects(Os)];
-precompile_objects([O|Os]) ->
- [O|precompile_objects(Os)].
-
-% 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_to_linespans(Sp1,Sp2,1)), Sp2,
- tri_ls_ysort(line_to_linespans(Sp1,Sp3,1)), 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_to_linespans(P2,P1,1)),
- 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_to_linespans(P1,P2,1)),
- 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,_Ca1} = LS1,
- {_, Xl2, Xr2,_Ca2} = 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, _Ca1} = LS1,
- {_, Xl2, Xr2, _Ca2} = 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, Ca}
- 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}] -> #{Y := [{Xl,Xr}]}
-%% Reorganize linspans to a map with Y as key.
-
-linespans_to_map(Ls) ->
- linespans_to_map(Ls,#{}).
-linespans_to_map([{Y,Xl,Xr,C}|Ls], M) ->
- case M of
- #{Y := Spans} -> linespans_to_map(Ls, M#{Y := [{Xl,Xr,C}|Spans]});
- _ -> linespans_to_map(Ls, M#{Y => [{Xl,Xr,C}]})
- end;
-linespans_to_map([], M) ->
- M.
-
-
-%% line_to_linespans
-%% Anti-aliased thick line
-%% Do it CPS style
-%% In:
-%% P1 :: point()
-%% P2 :: point()
-%% Out:
-%% [{Y,Xl,Xr}]
-%%
-line_to_linespans({X0,Y0},{X1,Y1},Wd) ->
- Dx = abs(X1-X0),
- Dy = abs(Y1-Y0),
- Sx = if X0 < X1 -> 1; true -> -1 end,
- Sy = if Y0 < Y1 -> 1; true -> -1 end,
- E0 = Dx - Dy,
- Ed = if Dx + Dy =:= 0 -> 1; true -> math:sqrt(Dx*Dx + Dy*Dy) end,
- line_to_ls(X0,Y0,X1,Y1,Dx,Dy,Sx,Sy,E0,Ed,(Wd+1)/2,[]).
-
-line_to_ls(X0,Y0,X1,Y1,Dx,Dy,Sx,Sy,E,Ed,Wd,Ls0) ->
- C = max(0, 255*(abs(E - Dx+Dy)/Ed - Wd + 1)),
- Ls1 = [{Y0,X0,X0,C}|Ls0],
- line_to_ls_sx(X0,Y0,X1,Y1,Dx,Dy,Sx,Sy,E,Ed,Wd,Ls1,E).
-
-line_to_ls_sx(X0,Y0,X1,Y1,Dx,Dy,Sx,Sy,E,Ed,Wd,Ls,E2) when 2*E2 > -Dx ->
- line_to_ls_sx_do(X0,Y0,X1,Y1,Dx,Dy,Sx,Sy,E,Ed,Wd,Ls,E2+Dy,Y0);
-line_to_ls_sx(X0,Y0,X1,Y1,Dx,Dy,Sx,Sy,E,Ed,Wd,Ls,E2) ->
- line_to_ls_sy(X0,Y0,X1,Y1,Dx,Dy,Sx,Sy,E,Ed,Wd,Ls,E2,X0).
-
-line_to_ls_sx_do(X0,Y0,X1,Y1,Dx,Dy,Sx,Sy,E,Ed,Wd,Ls0,E2,Y) when E2 < Ed*Wd andalso
- (Y1 =/= Y orelse Dx > Dy) ->
- Y2 = Y + Sy,
- C = max(0,255*(abs(E2)/Ed-Wd+1)),
- Ls = [{Y2,X0,X0,C}|Ls0],
- line_to_ls_sx_do(X0,Y0,X1,Y1,Dx,Dy,Sx,Sy,E,Ed,Wd,Ls,E2+Dx,Y2);
-line_to_ls_sx_do(X0,_Y0,X1,_Y1,_Dx,_Dy,_Sx,_Sy,_E,_Ed,_Wd,Ls,_E2,_Y) when X0 =:= X1 ->
- Ls;
-line_to_ls_sx_do(X0,Y0,X1,Y1,Dx,Dy,Sx,Sy,E,Ed,Wd,Ls,_E2,_Y) ->
- line_to_ls_sy(X0+Sx,Y0,X1,Y1,Dx,Dy,Sx,Sy,E-Dy,Ed,Wd,Ls,E,X0).
-
-line_to_ls_sy(X0,Y0,X1,Y1,Dx,Dy,Sx,Sy,E,Ed,Wd,Ls0,E2,X) when 2*E2 =< Dy ->
- line_to_ls_sy_do(X0,Y0,X1,Y1,Dx,Dy,Sx,Sy,E,Ed,Wd,Ls0,Dx-E2,X);
-line_to_ls_sy(X0,Y0,X1,Y1,Dx,Dy,Sx,Sy,E,Ed,Wd,Ls0,_E2,_X) ->
- line_to_ls(X0,Y0,X1,Y1,Dx,Dy,Sx,Sy,E,Ed,Wd,Ls0).
-
-line_to_ls_sy_do(X0,Y0,X1,Y1,Dx,Dy,Sx,Sy,E,Ed,Wd,Ls0,E2,X) when E2 < Ed*Wd andalso
- (X1 =/= X orelse Dx < Dy) ->
- X2 = X + Sx,
- C = max(0,255*(abs(E2)/Ed-Wd+1)),
- Ls = [{Y0,X2,X2,C}|Ls0],
- line_to_ls_sy_do(X0,Y0,X1,Y1,Dx,Dy,Sx,Sy,E,Ed,Wd,Ls,E2+Dy,X2);
-line_to_ls_sy_do(_X0,Y0,_X1,Y1,_Dx,_Dy,_Sx,_Sy,_E,_Ed,_Wd,Ls,_E2,_X) when Y0 =:= Y1 ->
- Ls;
-line_to_ls_sy_do(X0,Y0,X1,Y1,Dx,Dy,Sx,Sy,E,Ed,Wd,Ls0,_E2,_X) ->
- line_to_ls(X0,Y0+Sy,X1,Y1,Dx,Dy,Sx,Sy,E+Dx,Ed,Wd,Ls0).
-
-% 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
deleted file mode 100644
index 1749730f97..0000000000
--- a/lib/percept/src/percept.app.src
+++ /dev/null
@@ -1,45 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2007-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-
-{application,percept, [
- {description, "PERCEPT Erlang Concurrency Profiling Tool"},
- {vsn, "%VSN%"},
- {modules, [
- egd,
- egd_font,
- egd_png,
- egd_primitives,
- egd_render,
- percept,
- percept_analyzer,
- percept_db,
- percept_graph,
- percept_html,
- percept_image
- ]},
- {registered, [percept_db,percept_port]},
- {applications, [kernel,stdlib]},
- {env,[]},
- {runtime_dependencies, ["stdlib-2.0","runtime_tools-1.8.14","kernel-3.0",
- "inets-5.10","erts-6.0"]}
-]}.
-
-
-%% vim: syntax=erlang
diff --git a/lib/percept/src/percept.appup.src b/lib/percept/src/percept.appup.src
deleted file mode 100644
index 3ccdf8db2b..0000000000
--- a/lib/percept/src/percept.appup.src
+++ /dev/null
@@ -1,22 +0,0 @@
-%% -*- erlang -*-
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2007-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-{"%VSN%",
- [{<<".*">>,[{restart_application, percept}]}],
- [{<<".*">>,[{restart_application, percept}]}]
-}.
diff --git a/lib/percept/src/percept.erl b/lib/percept/src/percept.erl
deleted file mode 100644
index 046e0b7518..0000000000
--- a/lib/percept/src/percept.erl
+++ /dev/null
@@ -1,337 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2007-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions 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(Filename :: file:filename()) ->
- {'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(Filename :: file:filename(),
- 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(Filename :: file:filename(),
- 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() -> '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(Filename :: file:filename()) ->
- '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() ->
- {'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(Port :: non_neg_integer()) ->
- {'started', string(), pos_integer()} | {'error', any()}.
-
-start_webserver(Port) when is_integer(Port) ->
- ok = ensure_loaded(percept),
- case whereis(percept_httpd) of
- undefined ->
- {ok, Config} = get_webserver_config("percept", Port),
- ok = application:ensure_started(inets),
- 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 ->
- do_stop([], Pid)
- end.
-
-do_stop([], Pid)->
- Pid ! {self(), get_port},
- Port = receive P -> P end,
- do_stop(Port, Pid);
-do_stop(Port, [])->
- case whereis(percept_httpd) of
- undefined ->
- {error, not_started};
- Pid ->
- do_stop(Port, Pid)
- end;
-do_stop(Port, Pid)->
- case find_service_pid_from_port(inets:services_info(), Port) of
- undefined ->
- {error, not_started};
- Pid2 ->
- Pid ! quit,
- inets:stop(httpd, Pid2)
- end.
-
-%% @spec stop_webserver(integer()) -> ok | {error, not_started}
-%% @doc Stops webserver of the given port.
-%% @hidden
-
-stop_webserver(Port) ->
- do_stop(Port,[]).
-
-%%==========================================================================
-%% Auxiliary functions
-%%==========================================================================
-
-%% parse_and_insert
-
-parse_and_insert(Filename, DB) ->
- io:format("Parsing: ~p ~n", [Filename]),
- T0 = erlang:monotonic_time(milli_seconds),
- 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:monotonic_time(milli_seconds),
- io:format("Parsed ~w entries in ~w ms.~n", [Count, 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:keyfind(port, 1, Options) of
- false ->
- find_service_pid_from_port(Services, Port);
- {port, Port} ->
- Pid
- end.
-
-find_service_port_from_pid([], _) ->
- undefined;
-find_service_port_from_pid([{_, Pid, Options} | _], Pid) ->
- case lists:keyfind(port, 1, Options) of
- false ->
- undefined;
- {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"]) ++ "/"}},
-
- % Configs
- {default_type,"text/plain"},
- {directory_index,["index.html"]},
- {mime_types, MimeTypes},
- {modules,[mod_alias,
- mod_esi,
- mod_actions,
- mod_cgi,
- mod_dir,
- mod_get,
- mod_head
- ]},
- {com_type,ip_comm},
- {server_name, Servername},
- {bind_address, any},
- {port, Port}],
- {ok, Config}.
-
-ensure_loaded(App) ->
- case application:load(App) of
- ok -> ok;
- {error,{already_loaded,App}} -> ok;
- Error -> Error
- end.
diff --git a/lib/percept/src/percept.hrl b/lib/percept/src/percept.hrl
deleted file mode 100644
index 58926cd1b4..0000000000
--- a/lib/percept/src/percept.hrl
+++ /dev/null
@@ -1,53 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2007-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions 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
deleted file mode 100644
index f38d026905..0000000000
--- a/lib/percept/src/percept_analyzer.erl
+++ /dev/null
@@ -1,368 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2007-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions 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
deleted file mode 100644
index 6cbe3ce022..0000000000
--- a/lib/percept/src/percept_db.erl
+++ /dev/null
@@ -1,780 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2007-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions 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").
--define(STOP_TIMEOUT, 1000).
-%%==========================================================================
-%% 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() -> {'started', pid()} | {'restarted', pid()}.
-
-start() ->
- case erlang:whereis(percept_db) of
- undefined ->
- {started, do_start()};
- PerceptDB ->
- {restarted, restart(PerceptDB)}
- end.
-
-%% @spec restart(pid()) -> pid()
-%% @private
-%% @doc restarts the percept database.
-
--spec restart(pid())-> pid().
-
-restart(PerceptDB)->
- stop_sync(PerceptDB),
- do_start().
-
-%% @spec do_start() -> pid()
-%% @private
-%% @doc starts the percept database.
-
--spec do_start()-> pid().
-
-do_start()->
- Pid = spawn(fun() -> init_percept_db() end),
- erlang:register(percept_db, Pid),
- Pid.
-
-%% @spec stop() -> not_started | {stopped, Pid}
-%% Pid = pid()
-%% @doc Stops the percept database.
-
--spec stop() -> 'not_started' | {'stopped', pid()}.
-
-stop() ->
- case erlang:whereis(percept_db) of
- undefined ->
- not_started;
- Pid ->
- Pid ! {action, stop},
- {stopped, Pid}
- end.
-
-%% @spec stop_sync(pid()) -> true
-%% @private
-%% @doc Stops the percept database, with a synchronous call.
-
--spec stop_sync(pid()) -> true.
-
-stop_sync(Pid) ->
- MonitorRef = erlang:monitor(process, Pid),
- _ = stop(),
- receive
- {'DOWN', MonitorRef, _Type, Pid, _Info}->
- true
- after ?STOP_TIMEOUT->
- erlang:demonitor(MonitorRef, [flush]),
- exit(Pid, kill)
- end.
-
-%% @spec insert(tuple()) -> ok
-%% @doc Inserts a trace or profile message to the database.
-
-insert(Trace) ->
- percept_db ! {insert, Trace},
- ok.
-
-
-%% @spec select({atom(), Options}) -> Result
-%% @doc Synchronous call. Selects information based on a query.
-%%
-%% <p>Queries:</p>
-%% <pre>
-%% {system, Option}
-%% Option = system_option()
-%% Result = timestamp()
-%% {information, Options}
-%% Options = [information_option()]
-%% Result = [#information{}]
-%% {scheduler, Options}
-%% Options = [sceduler_option()]
-%% Result = [#activity{}]
-%% {activity, Options}
-%% Options = [activity_option()]
-%% Result = [#activity{}]
-%% </pre>
-%% <p>
-%% Note: selection of Id's are always OR all other options are considered AND.
-%% </p>
-
-select(Query) ->
- percept_db ! {select, self(), Query},
- receive {result, Match} -> Match end.
-
-%% @spec select(atom(), list()) -> Result
-%% @equiv select({Table,Options})
-
-select(Table, Options) ->
- percept_db ! {select, self(), {Table, Options}},
- receive {result, 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
- pdb_info = ets:new(pdb_info, [named_table, private, {keypos, #information.id}, set]),
-
- % Scheduler runnability
- pdb_scheduler = ets:new(pdb_scheduler, [named_table, private, {keypos, #activity.timestamp}, ordered_set]),
-
- % Process and Port runnability
- pdb_activity = ets:new(pdb_activity, [named_table, private, {keypos, #activity.timestamp}, ordered_set]),
-
- % System status
- pdb_system = ets:new(pdb_system, [named_table, private, {keypos, 1}, set]),
-
- % System warnings
- pdb_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 ! {result, 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, 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)
- [Elem || Elem = {_,_,_} <- ATs ++ STs ++ ITs].
-
-%% 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
deleted file mode 100644
index e5bbaca2b4..0000000000
--- a/lib/percept/src/percept_graph.erl
+++ /dev/null
@@ -1,134 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2007-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions 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) ->
- ok = mod_esi:deliver(SessionID, header()),
- ok = 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) ->
- ok = mod_esi:deliver(SessionID, header()),
- ok = mod_esi:deliver(SessionID, binary_to_list(activity_bar(Env, Input))).
-
-proc_lifetime(SessionID, Env, Input) ->
- ok = mod_esi:deliver(SessionID, header()),
- ok = mod_esi:deliver(SessionID, binary_to_list(proc_lifetime(Env, Input))).
-
-percentage(SessionID, Env, Input) ->
- ok = mod_esi:deliver(SessionID, header()),
- ok = mod_esi:deliver(SessionID, binary_to_list(percentage(Env,Input))).
-
-scheduler_graph(SessionID, Env, Input) ->
- ok = mod_esi:deliver(SessionID, header()),
- ok = 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
deleted file mode 100644
index a675227584..0000000000
--- a/lib/percept/src/percept_html.erl
+++ /dev/null
@@ -1,707 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2007-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions 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) ->
- ok = mod_esi:deliver(SessionID, header()),
- ok = mod_esi:deliver(SessionID, menu()),
- ok = mod_esi:deliver(SessionID, overview_content(Env, Input)),
- ok = mod_esi:deliver(SessionID, footer()).
-
-processes_page(SessionID, _, _) ->
- ok = mod_esi:deliver(SessionID, header()),
- ok = mod_esi:deliver(SessionID, menu()),
- ok = mod_esi:deliver(SessionID, processes_content()),
- ok = mod_esi:deliver(SessionID, footer()).
-
-concurrency_page(SessionID, Env, Input) ->
- ok = mod_esi:deliver(SessionID, header()),
- ok = mod_esi:deliver(SessionID, menu()),
- ok = mod_esi:deliver(SessionID, concurrency_content(Env, Input)),
- ok = mod_esi:deliver(SessionID, footer()).
-
-databases_page(SessionID, _, _) ->
- ok = mod_esi:deliver(SessionID, header()),
- ok = mod_esi:deliver(SessionID, menu()),
- ok = mod_esi:deliver(SessionID, databases_content()),
- ok = mod_esi:deliver(SessionID, footer()).
-
-codelocation_page(SessionID, Env, Input) ->
- ok = mod_esi:deliver(SessionID, header()),
- ok = mod_esi:deliver(SessionID, menu()),
- ok = mod_esi:deliver(SessionID, codelocation_content(Env, Input)),
- ok = mod_esi:deliver(SessionID, footer()).
-
-process_info_page(SessionID, Env, Input) ->
- ok = mod_esi:deliver(SessionID, header()),
- ok = mod_esi:deliver(SessionID, menu()),
- ok = mod_esi:deliver(SessionID, process_info_content(Env, Input)),
- ok = mod_esi:deliver(SessionID, footer()).
-
-load_database_page(SessionID, Env, Input) ->
- ok = mod_esi:deliver(SessionID, header()),
-
- % Very dynamic page, handled differently
- load_database_content(SessionID, Env, Input),
- ok = mod_esi:deliver(SessionID, footer()).
-
-
-%%% --------------------------- %%%
-%%% Content pages %%%
-%%% --------------------------- %%%
-
-overview_content(_Env, Input) ->
- Query = httpd:parse_query(Input),
- Min = get_option_value("range_min", Query),
- Max = get_option_value("range_max", Query),
- Width = 1200,
- Height = 600,
- TotalProfileTime = ?seconds( percept_db:select({system, stop_ts}),
- percept_db:select({system, start_ts})),
- RegisteredProcs = length(percept_db:select({information, procs})),
- RegisteredPorts = length(percept_db:select({information, ports})),
-
- InformationTable =
- "<table>" ++
- table_line(["Profile time:", TotalProfileTime]) ++
- table_line(["Processes:", RegisteredProcs]) ++
- table_line(["Ports:", RegisteredPorts]) ++
- table_line(["Min. range:", Min]) ++
- table_line(["Max. range:", Max]) ++
- "</table>",
-
- Header = "
- <div id=\"content\">
- <div>" ++ InformationTable ++ "</div>\n
- <form name=form_area method=POST action=/cgi-bin/percept_html/page>
- <input name=data_min type=hidden value=" ++ term2html(float(Min)) ++ ">
- <input name=data_max type=hidden value=" ++ term2html(float(Max)) ++ ">\n",
-
-
- RangeTable =
- "<table>"++
- table_line([
- "Min:",
- "<input name=range_min value=" ++ term2html(float(Min)) ++">",
- "<select name=\"graph_select\" onChange=\"select_image()\">
- <option disabled=true value=\""++ url_graph(Width, Height, Min, Max, []) ++"\" />Ports
- <option disabled=true value=\""++ url_graph(Width, Height, Min, Max, []) ++"\" />Processes
- <option value=\""++ url_graph(Width, Height, Min, Max, []) ++"\" />Ports & Processes
- </select>",
- "<input type=submit value=Update>"
- ]) ++
- table_line([
- "Max:",
- "<input name=range_max value=" ++ term2html(float(Max)) ++">",
- "",
- "<a href=/cgi-bin/percept_html/codelocation_page?range_min=" ++
- term2html(Min) ++ "&range_max=" ++ term2html(Max) ++ ">Code location</a>"
- ]) ++
- "</table>",
-
-
- MainTable =
- "<table>" ++
- table_line([div_tag_graph()]) ++
- table_line([RangeTable]) ++
- "</table>",
-
- Footer = "</div></form>",
-
- Header ++ MainTable ++ Footer.
-
-div_tag_graph() ->
- %background:url('/images/loader.gif') no-repeat center;
- "<div id=\"percept_graph\"
- onMouseDown=\"select_down(event)\"
- onMouseMove=\"select_move(event)\"
- onMouseUp=\"select_up(event)\"
-
- style=\"
- background-size: 100%;
- background-origin: content;
- width: 100%;
- position:relative;
- \">
-
- <div id=\"percept_areaselect\"
- style=\"background-color:#ef0909;
- position:relative;
- visibility:hidden;
- border-left: 1px solid #101010;
- border-right: 1px solid #101010;
- z-index:2;
- width:40px;
- height:40px;\"></div></div>".
-
--spec url_graph(
- Widht :: non_neg_integer(),
- Height :: non_neg_integer(),
- Min :: float(),
- Max :: float(),
- Pids :: [pid()]) -> string().
-
-url_graph(W, H, Min, Max, []) ->
- "/cgi-bin/percept_graph/graph?range_min=" ++ term2html(float(Min))
- ++ "&range_max=" ++ term2html(float(Max))
- ++ "&width=" ++ term2html(float(W))
- ++ "&height=" ++ term2html(float(H)).
-
-%%% process_info_content
-
-process_info_content(_Env, Input) ->
- Query = httpd:parse_query(Input),
- Pid = get_option_value("pid", Query),
-
-
- [I] = percept_db:select({information, Pid}),
- ArgumentString = case I#information.entry of
- {_, _, Arguments} -> lists:flatten( [term2html(Arg) ++ "<br>" || Arg <- Arguments]);
- _ -> ""
- end,
-
- TimeTable = html_table([
- [{th, ""},
- {th, "Timestamp"},
- {th, "Profile Time"}],
- [{td, "Start"},
- term2html(I#information.start),
- term2html(procstarttime(I#information.start))],
- [{td, "Stop"},
- term2html(I#information.stop),
- term2html(procstoptime(I#information.stop))]
- ]),
-
- InfoTable = html_table([
- [{th, "Pid"}, term2html(I#information.id)],
- [{th, "Name"}, term2html(I#information.name)],
- [{th, "Entrypoint"}, mfa2html(I#information.entry)],
- [{th, "Arguments"}, ArgumentString],
- [{th, "Timetable"}, TimeTable],
- [{th, "Parent"}, pid2html(I#information.parent)],
- [{th, "Children"}, lists:flatten(lists:map(fun(Child) -> pid2html(Child) ++ " " end, I#information.children))]
- ]),
-
- PidActivities = percept_db:select({activity, [{id, Pid}]}),
- WaitingMfas = percept_analyzer:waiting_activities(PidActivities),
-
- TotalWaitTime = lists:sum( [T || {T, _, _} <- WaitingMfas] ),
-
- MfaTable = html_table([
- [{th, "percentage"},
- {th, "total"},
- {th, "mean"},
- {th, "stddev"},
- {th, "#recv"},
- {th, "module:function/arity"}]] ++ [
- [{td, image_string(percentage, [{width, 100}, {height, 10}, {percentage, Time/TotalWaitTime}])},
- {td, term2html(Time)},
- {td, term2html(Mean)},
- {td, term2html(StdDev)},
- {td, term2html(N)},
- {td, mfa2html(MFA)} ] || {Time, MFA, {Mean, StdDev, N}} <- WaitingMfas]),
-
- "<div id=\"content\">" ++
- InfoTable ++ "<br>" ++
- MfaTable ++
- "</div>".
-
-%%% concurrency content
-concurrency_content(_Env, Input) ->
- %% Get query
- Query = httpd:parse_query(Input),
-
- %% Collect selected pids and generate id tags
- Pids = [value2pid(PidValue) || {PidValue, Case} <- Query, Case == "on", PidValue /= "select_all"],
- IDs = [{id, Pid} || Pid <- Pids],
-
- % FIXME: A lot of extra work here, redo
-
- %% Analyze activities and calculate area bounds
- Activities = percept_db:select({activity, IDs}),
- StartTs = percept_db:select({system, start_ts}),
- Counts = [{Time, Y1 + Y2} || {Time, Y1, Y2} <- percept_analyzer:activities2count2(Activities, StartTs)],
- {T0,_,T1,_} = percept_analyzer:minmax(Counts),
-
- % FIXME: End
-
- PidValues = [pid2value(Pid) || Pid <- Pids],
-
- %% Generate activity bar requests
- ActivityBarTable = lists:foldl(
- fun(Pid, Out) ->
- ValueString = pid2value(Pid),
- Out ++
- table_line([
- pid2html(Pid),
- "<img onload=\"size_image(this, '" ++
- image_string_head("activity", [{"pid", ValueString}, {range_min, T0},{range_max, T1},{height, 10}], []) ++
- "')\" src=/images/white.png border=0 />"
- ])
- end, [], Pids),
-
- %% Make pids request string
- PidsRequest = join_strings_with(PidValues, ":"),
-
- "<div id=\"content\">
- <table cellspacing=0 cellpadding=0 border=0>" ++
- table_line([
- "",
- "<img onload=\"size_image(this, '" ++
- image_string_head("graph", [{"pids", PidsRequest},{range_min, T0}, {range_max, T1}, {height, 400}], []) ++
- "')\" src=/images/white.png border=0 />"
- ]) ++
- ActivityBarTable ++
- "</table></div>\n".
-
-processes_content() ->
- Ports = percept_db:select({information, ports}),
- UnsortedProcesses = percept_db:select({information, procs}),
- SystemStartTS = percept_db:select({system, start_ts}),
- SystemStopTS = percept_db:select({system, stop_ts}),
- ProfileTime = ?seconds( SystemStopTS,
- SystemStartTS),
- Processes = lists:sort(
- fun (A, B) ->
- if
- A#information.id > B#information.id -> true;
- true -> false
- end
- end, UnsortedProcesses),
-
- ProcsHtml = lists:foldl(
- fun (I, Out) ->
- StartTime = procstarttime(I#information.start),
- EndTime = procstoptime(I#information.stop),
- Prepare =
- table_line([
- "<input type=checkbox name=" ++ pid2value(I#information.id) ++ ">",
- pid2html(I#information.id),
- image_string(proc_lifetime, [
- {profiletime, ProfileTime},
- {start, StartTime},
- {"end", term2html(float(EndTime))},
- {width, 100},
- {height, 10}]),
- mfa2html(I#information.entry),
- term2html(I#information.name),
- pid2html(I#information.parent)
- ]),
- [Prepare|Out]
- end, [], Processes),
-
- PortsHtml = lists:foldl(
- fun (I, Out) ->
- StartTime = procstarttime(I#information.start),
- EndTime = procstoptime(I#information.stop),
- Prepare =
- table_line([
- "",
- pid2html(I#information.id),
- image_string(proc_lifetime, [
- {profiletime, ProfileTime},
- {start, StartTime},
- {"end", term2html(float(EndTime))},
- {width, 100},
- {height, 10}]),
- mfa2html(I#information.entry),
- term2html(I#information.name),
- pid2html(I#information.parent)
- ]),
- [Prepare|Out]
- end, [], Ports),
-
- Selector = "<table>" ++
- table_line([
- "<input onClick='selectall()' type=checkbox name=select_all>Select all"]) ++
- table_line([
- "<input type=submit value=Compare>"]) ++
- "</table>",
-
- if
- length(ProcsHtml) > 0 ->
- ProcsHtmlResult =
- "<tr><td><b>Processes</b></td></tr>
- <tr><td>
- <table width=700 cellspacing=0 border=0>
- <tr>
- <td align=middle width=40><b>Select</b></td>
- <td align=middle width=40><b>Pid</b></td>
- <td><b>Lifetime</b></td>
- <td><b>Entrypoint</b></td>
- <td><b>Name</b></td>
- <td><b>Parent</b></td>
- </tr>" ++
- lists:flatten(ProcsHtml) ++
- "</table>
- </td></tr>";
- true ->
- ProcsHtmlResult = ""
- end,
- if
- length(PortsHtml) > 0 ->
- PortsHtmlResult = "
- <tr><td><b>Ports</b></td></tr>
- <tr><td>
- <table width=700 cellspacing=0 border=0>
- <tr>
- <td align=middle width=40><b>Select</b></td>
- <td align=left width=40><b>Pid</b></td>
- <td><b>Lifetime</b></td>
- <td><b>Entrypoint</b></td>
- <td><b>Name</b></td>
- <td><b>Parent</b></td>
- </tr>" ++
- lists:flatten(PortsHtml) ++
- "</table>
- </td></tr>";
- true ->
- PortsHtmlResult = ""
- end,
-
- Right = "<div>"
- ++ Selector ++
- "</div>\n",
-
- Middle = "<div id=\"content\">
- <table>" ++
- ProcsHtmlResult ++
- PortsHtmlResult ++
- "</table>" ++
- Right ++
- "</div>\n",
-
- "<form name=process_select method=POST action=/cgi-bin/percept_html/concurrency_page>" ++
- Middle ++
- "</form>".
-
-procstarttime(TS) ->
- case TS of
- undefined -> 0.0;
- TS -> ?seconds(TS,percept_db:select({system, start_ts}))
- end.
-
-procstoptime(TS) ->
- case TS of
- undefined -> ?seconds( percept_db:select({system, stop_ts}),
- percept_db:select({system, start_ts}));
- TS -> ?seconds(TS, percept_db:select({system, start_ts}))
- end.
-
-databases_content() ->
- "<div id=\"content\">
- <form name=load_percept_file method=post action=/cgi-bin/percept_html/load_database_page>
- <center>
- <table>
- <tr><td>Enter file to analyse:</td><td><input type=hidden name=path /></td></tr>
- <tr><td><input type=file name=file size=40 /></td><td><input type=submit value=Load onClick=\"path.value = file.value;\" /></td></tr>
- </table>
- </center>
- </form>
- </div>".
-
-load_database_content(SessionId, _Env, Input) ->
- Query = httpd:parse_query(Input),
- {_,{_,Path}} = lists:keysearch("file", 1, Query),
- {_,{_,File}} = lists:keysearch("path", 1, Query),
- Filename = filename:join(Path, File),
- % Check path/file/filename
-
- ok = mod_esi:deliver(SessionId, "<div id=\"content\">"),
- case file:read_file_info(Filename) of
- {ok, _} ->
- Content = "<center>
- Parsing: " ++ Filename ++ "<br>
- </center>",
- ok = mod_esi:deliver(SessionId, Content),
- case percept:analyze(Filename) of
- {error, Reason} ->
- ok = mod_esi:deliver(SessionId, error_msg("Analyze" ++ term2html(Reason)));
- _ ->
- Complete = "<center><a href=\"/cgi-bin/percept_html/page\">View</a></center>",
- ok = mod_esi:deliver(SessionId, Complete)
- end;
- {error, Reason} ->
- ok = mod_esi:deliver(SessionId, error_msg("File" ++ term2html(Reason)))
- end,
- ok = mod_esi:deliver(SessionId, "</div>").
-
-codelocation_content(_Env, Input) ->
- Query = httpd:parse_query(Input),
- Min = get_option_value("range_min", Query),
- Max = get_option_value("range_max", Query),
- StartTs = percept_db:select({system, start_ts}),
- TsMin = percept_analyzer:seconds2ts(Min, StartTs),
- TsMax = percept_analyzer:seconds2ts(Max, StartTs),
- Acts = percept_db:select({activity, [{ts_min, TsMin}, {ts_max, TsMax}]}),
-
- Secs = [timer:now_diff(A#activity.timestamp,StartTs)/1000 || A <- Acts],
- Delta = cl_deltas(Secs),
- Zip = lists:zip(Acts, Delta),
- Table = html_table([
- [{th, "delta [ms]"},
- {th, "time [ms]"},
- {th, " pid "},
- {th, "activity"},
- {th, "module:function/arity"},
- {th, "#runnables"}]] ++ [
- [{td, term2html(D)},
- {td, term2html(timer:now_diff(A#activity.timestamp,StartTs)/1000)},
- {td, pid2html(A#activity.id)},
- {td, term2html(A#activity.state)},
- {td, mfa2html(A#activity.where)},
- {td, term2html(A#activity.runnable_count)}] || {A, D} <- Zip ]),
-
- "<div id=\"content\">" ++
- Table ++
- "</div>".
-
-cl_deltas([]) -> [];
-cl_deltas(List) -> cl_deltas(List, [0.0]).
-cl_deltas([_], Out) -> lists:reverse(Out);
-cl_deltas([A,B|Ls], Out) -> cl_deltas([B|Ls], [B - A | Out]).
-
-%%% --------------------------- %%%
-%%% Utility functions %%%
-%%% --------------------------- %%%
-
-%% Should be in string stdlib?
-
-join_strings(Strings) ->
- lists:flatten(Strings).
-
--spec join_strings_with(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(Rows :: [[string() | {'td' | 'th', string()}]]) -> string().
-
-html_table(Rows) -> "<table>" ++ html_table_row(Rows) ++ "</table>".
-
-html_table_row(Rows) -> html_table_row(Rows, odd).
-html_table_row([], _) -> "";
-html_table_row([Row|Rows], odd ) -> "<tr class=\"odd\">" ++ html_table_data(Row) ++ "</tr>" ++ html_table_row(Rows, even);
-html_table_row([Row|Rows], even) -> "<tr class=\"even\">" ++ html_table_data(Row) ++ "</tr>" ++ html_table_row(Rows, odd ).
-
-html_table_data([]) -> "";
-html_table_data([{td, Data}|Row]) -> "<td>" ++ Data ++ "</td>" ++ html_table_data(Row);
-html_table_data([{th, Data}|Row]) -> "<th>" ++ Data ++ "</th>" ++ html_table_data(Row);
-html_table_data([Data|Row]) -> "<td>" ++ Data ++ "</td>" ++ html_table_data(Row).
-
-
-
-
--spec table_line(Table :: [any()]) -> string().
-
-table_line(List) -> table_line(List, ["<tr>"]).
-table_line([], Out) -> lists:flatten(lists:reverse(["</tr>\n"|Out]));
-table_line([Element | Elements], Out) when is_list(Element) ->
- table_line(Elements, ["<td>" ++ Element ++ "</td>" |Out]);
-table_line([Element | Elements], Out) ->
- table_line(Elements, ["<td>" ++ term2html(Element) ++ "</td>"|Out]).
-
--spec term2html(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(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(Pid :: pid() | port()) -> string().
-
-pid2html(Pid) when is_pid(Pid) ->
- PidString = term2html(Pid),
- PidValue = pid2value(Pid),
- "<a href=\"/cgi-bin/percept_html/process_info_page?pid="++PidValue++"\">"++PidString++"</a>";
-pid2html(Pid) when is_port(Pid) ->
- term2html(Pid);
-pid2html(_) ->
- "undefined".
-
--spec image_string(Request :: string()) -> string().
-
-image_string(Request) ->
- "<img border=0 src=\"/cgi-bin/percept_graph/" ++
- Request ++
- " \">".
-
--spec image_string(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(Pid :: pid()) -> string().
-
-pid2value(Pid) ->
- String = lists:flatten(io_lib:format("~p", [Pid])),
- lists:sublist(String, 2, erlang:length(String)-2).
-
--spec value2pid(Value :: string()) -> pid().
-
-value2pid(Value) ->
- String = lists:flatten("<" ++ Value ++ ">"),
- erlang:list_to_pid(String).
-
-
-%%% get value
-
--spec get_option_value(Option :: string(), Options :: [{string(),any()}]) ->
- {'error', any()} | boolean() | 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(string()) -> number() | {'error', 'illegal_number'}.
-
-get_number_value(Value) ->
- % Try float
- case string:to_float(Value) of
- {error, no_float} ->
- % Try integer
- case string:to_integer(Value) of
- {error, _} -> {error, illegal_number};
- {Integer, _} -> Integer
- end;
- {error, _} -> {error, illegal_number};
- {Float, _} -> Float
- end.
-
-%%% --------------------------- %%%
-%%% html prime functions %%%
-%%% --------------------------- %%%
-
-header() -> header([]).
-header(HeaderData) ->
- "Content-Type: text/html\r\n\r\n" ++
- "<html>
- <head>
- <meta http-equiv=\"Content-Type\" content=\"text/html; charset=iso-8859-1\">
- <title>percept</title>
- <link href=\"/css/percept.css\" rel=\"stylesheet\" type=\"text/css\">
- <script type=\"text/javascript\" src=\"/javascript/percept_error_handler.js\"></script>
- <script type=\"text/javascript\" src=\"/javascript/percept_select_all.js\"></script>
- <script type=\"text/javascript\" src=\"/javascript/percept_area_select.js\"></script>
- " ++ HeaderData ++"
- </head>
- <body onLoad=\"load_image()\">
- <div id=\"header\"><a href=/index.html>percept</a></div>\n".
-
-footer() ->
- "</body>
- </html>\n".
-
-menu() ->
- "<div id=\"menu\" class=\"menu_tabs\">
- <ul>
- <li><a href=/cgi-bin/percept_html/databases_page>databases</a></li>
- <li><a href=/cgi-bin/percept_html/processes_page>processes</a></li>
- <li><a href=/cgi-bin/percept_html/page>overview</a></li>
- </ul></div>\n".
-
--spec error_msg(Error :: string()) -> string().
-
-error_msg(Error) ->
- "<table width=300>
- <tr height=5><td></td> <td></td></tr>
- <tr><td width=150 align=right><b>Error: </b></td> <td align=left>"++ Error ++ "</td></tr>
- <tr height=5><td></td> <td></td></tr>
- </table>\n".
diff --git a/lib/percept/src/percept_image.erl b/lib/percept/src/percept_image.erl
deleted file mode 100644
index e819938027..0000000000
--- a/lib/percept/src/percept_image.erl
+++ /dev/null
@@ -1,316 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2007-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-
--module(percept_image).
--export([ proc_lifetime/5,
- percentage/3,
- graph/3,
- graph/4,
- activities/3,
- activities/4]).
--record(graph_area, {x = 0, y = 0, width, height}).
--compile(inline).
-
-%%% -------------------------------------
-%%% GRAF
-%%% -------------------------------------
-
-%% graph(Widht, Height, Range, Data)
-
-graph(Width, Height, {RXmin, RYmin, RXmax, RYmax}, Data) ->
- Data2 = [{X, Y1 + Y2} || {X, Y1, Y2} <- Data],
- MinMax = percept_analyzer:minmax(Data2),
- {Xmin, Ymin, Xmax, Ymax} = MinMax,
- graf1(Width, Height,{ lists:min([RXmin, Xmin]),
- lists:min([RYmin, Ymin]),
- lists:max([RXmax, Xmax]),
- lists:max([RYmax, Ymax])}, Data).
-
-%% graph(Widht, Height, Data) = Image
-%% In:
-%% Width = integer(),
-%% Height = integer(),
-%% Data = [{Time, Procs, Ports}]
-%% Time = float()
-%% Procs = integer()
-%% Ports = integer()
-%% Out:
-%% Image = binary()
-
-graph(Width, Height, Data) ->
- Data2 = [{X, Y1 + Y2} || {X, Y1, Y2} <- Data],
- Bounds = percept_analyzer:minmax(Data2),
- graf1(Width, Height, Bounds, Data).
-
-graf1(Width, Height, {Xmin, Ymin, Xmax, Ymax}, Data) ->
- % Calculate areas
- HO = 20,
- GrafArea = #graph_area{x = HO, y = 4, width = Width - 2*HO, height = Height - 17},
- XticksArea = #graph_area{x = HO, y = Height - 13, width = Width - 2*HO, height = 13},
- YticksArea = #graph_area{x = 1, y = 4, width = HO, height = Height - 17},
-
- %% Initiate Image
-
- Image = egd:create(Width, Height),
-
- %% Set colors
-
- Black = egd:color(Image, {0, 0, 0}),
- ProcColor = egd:color(Image, {0, 255, 0}),
- PortColor = egd:color(Image, {255, 0, 0}),
-
- %% Draw graf, xticks and yticks
- draw_graf(Image, Data, {Black, ProcColor, PortColor}, GrafArea, {Xmin, Ymin, Xmax, Ymax}),
- draw_xticks(Image, Black, XticksArea, {Xmin, Xmax}, Data),
- draw_yticks(Image, Black, YticksArea, {Ymin, Ymax}),
-
- %% Kill image and return binaries
- Binary = egd:render(Image, png),
- egd:destroy(Image),
- Binary.
-
-%% draw_graf(Image, Data, Color, GraphArea, DataBounds)
-%% Image, port to Image
-%% Data, list of three tuple data, (X, Y1, Y2)
-%% Color, {ForegroundColor, ProcFillColor, PortFillColor}
-%% DataBounds, {Xmin, Ymin, Xmax, Ymax}
-
-draw_graf(Im, Data, Colors, GA = #graph_area{x = X0, y = Y0, width = Width, height = Height}, {Xmin, _Ymin, Xmax, Ymax}) ->
- Dx = (Width)/(Xmax - Xmin),
- Dy = (Height)/(Ymax),
- Plotdata = [{trunc(X0 + X*Dx - Xmin*Dx), trunc(Y0 + Height - Y1*Dy), trunc(Y0 + Height - (Y1 + Y2)*Dy)} || {X, Y1, Y2} <- Data],
- draw_graf(Im, Plotdata, Colors, GA).
-
-draw_graf(Im, [{X1, Yproc1, Yport1}, {X2, Yproc2, Yport2}|Data], C, GA) when X2 - X1 < 1 ->
- draw_graf(Im, [{X1, [{Yproc2, Yport2},{Yproc1, Yport1}]}|Data], C, GA);
-
-draw_graf(Im, [{X1, Ys1}, {X2, Yproc2, Yport2}|Data], C, GA) when X2 - X1 < 1, is_list(Ys1) ->
- draw_graf(Im, [{X1, [{Yproc2, Yport2}|Ys1]}|Data], C, GA);
-
-draw_graf(Im, [{X1, Yproc1, Yport1}, {X2, Yproc2, Yport2}|Data], C = {B, PrC, PoC}, GA = #graph_area{y = Y0, height = H}) ->
- GyZero = trunc(Y0 + H),
- egd:filledRectangle(Im, {X1, GyZero}, {X2, Yproc1}, PrC),
- egd:filledRectangle(Im, {X1, Yproc1}, {X2, Yport1}, PoC),
- egd:line(Im, {X1, Yport1}, {X2, Yport1}, B), % top line
- egd:line(Im, {X1, Yport2}, {X1, Yport1}, B), % right line
- egd:line(Im, {X2, Yport1}, {X2, Yport2}, B), % right line
- draw_graf(Im, [{X2, Yproc2, Yport2}|Data], C, GA);
-
-draw_graf(Im, [{X1, Ys1 = [{Yproc1,Yport1}|_]}, {X2, Yproc2, Yport2}|Data], C = {B, PrC, PoC}, GA = #graph_area{y = Y0, height = H}) ->
- GyZero = trunc(Y0 + H),
- Yprocs = [Yp || {Yp, _} <- Ys1],
- Yports = [Yp || {_, Yp} <- Ys1],
-
- YprMin = lists:min(Yprocs),
- YprMax = lists:max(Yprocs),
- YpoMax = lists:max(Yports),
- egd:filledRectangle(Im, {X1, GyZero}, {X2, Yproc1}, PrC),
- egd:filledRectangle(Im, {X1, Yproc1}, {X2, Yport1}, PoC),
- egd:filledRectangle(Im, {X1, Yport1}, {X2, Yport1}, B), % top line
- egd:filledRectangle(Im, {X2, Yport1}, {X2, Yport2}, B), % right line
-
- egd:filledRectangle(Im, {X1, GyZero}, {X1, YprMin}, PrC), % left proc green line
- egd:filledRectangle(Im, {X1, YprMax}, {X1, YpoMax}, PoC), % left port line
- egd:filledRectangle(Im, {X1, YprMax}, {X1, YprMin}, B),
-
- draw_graf(Im, [{X2, Yproc2, Yport2}|Data], C, GA);
-draw_graf(_, _, _, _) -> ok.
-
-draw_xticks(Image, Color, XticksArea, {Xmin, Xmax}, Data) ->
- #graph_area{x = X0, y = Y0, width = Width} = XticksArea,
-
- DX = Width/(Xmax - Xmin),
- Offset = X0 - Xmin*DX,
- Y = trunc(Y0),
- Font = load_font(),
- {FontW, _FontH} = egd_font:size(Font),
- egd:filledRectangle(Image, {trunc(X0), Y}, {trunc(X0 + Width), Y}, Color),
- lists:foldl(
- fun ({X,_,_}, PX) ->
- X1 = trunc(Offset + X*DX),
-
- % Optimization:
- % if offset has past half the previous text
- % start checking this text
-
- if
- X1 > PX ->
- Text = lists:flatten(io_lib:format("~.3f", [float(X)])),
- TextLength = length(Text),
- TextWidth = TextLength*FontW,
- Spacing = 2,
- if
- X1 > PX + round(TextWidth/2) + Spacing ->
- egd:line(Image, {X1, Y - 3}, {X1, Y + 3}, Color),
- text(Image, {X1 - round(TextWidth/2), Y + 2}, Font, Text, Color),
- X1 + round(TextWidth/2) + Spacing;
- true ->
- PX
- end;
- true ->
- PX
- end
- end, 0, Data).
-
-draw_yticks(Im, Color, TickArea, {_,Ymax}) ->
- #graph_area{x = X0, y = Y0, width = Width, height = Height} = TickArea,
- Font = load_font(),
- X = trunc(X0 + Width),
- Dy = (Height)/(Ymax),
- Yts = if
- Height/(Ymax*12) < 1.0 -> round(1 + Ymax*15/Height);
- true -> 1
- end,
- egd:filledRectangle(Im, {X, trunc(0 + Y0)}, {X, trunc(Y0 + Height)}, Color),
- draw_yticks0(Im, Font, Color, 0, Yts, Ymax, {X, Height, Dy}).
-
-draw_yticks0(Im, Font, Color, Yi, Yts, Ymax, Area) when Yi < Ymax ->
- {X, Height, Dy} = Area,
- Y = round(Height - (Yi*Dy) + 3),
-
- egd:filledRectangle(Im, {X - 3, Y}, {X + 3, Y}, Color),
- Text = lists:flatten(io_lib:format("~p", [Yi])),
- text(Im, {0, Y - 4}, Font, Text, Color),
- draw_yticks0(Im, Font, Color, Yi + Yts, Yts, Ymax, Area);
-draw_yticks0(_, _, _, _, _, _, _) -> ok.
-
-%%% -------------------------------------
-%%% ACTIVITIES
-%%% -------------------------------------
-
-%% activities(Width, Height, Range, Activities) -> Binary
-%% In:
-%% Width = integer()
-%% Height = integer()
-%% Range = {float(), float()}
-%% Activities = [{float(), active | inactive}]
-%% Out:
-%% Binary = binary()
-
-activities(Width, Height, {UXmin, UXmax}, Activities) ->
- Xs = [ X || {X,_} <- Activities],
- Xmin = lists:min(Xs),
- Xmax = lists:max(Xs),
- activities0(Width, Height, {lists:min([Xmin, UXmin]), lists:max([UXmax, Xmax])}, Activities).
-
-activities(Width, Height, Activities) ->
- Xs = [ X || {X,_} <- Activities],
- Xmin = lists:min(Xs),
- Xmax = lists:max(Xs),
- activities0(Width, Height, {Xmin, Xmax}, Activities).
-
-activities0(Width, Height, {Xmin, Xmax}, Activities) ->
- Image = egd:create(Width, Height),
- Grey = egd:color(Image, {200, 200, 200}),
- HO = 20,
- ActivityArea = #graph_area{x = HO, y = 0, width = Width - 2*HO, height = Height},
- egd:filledRectangle(Image, {0, 0}, {Width, Height}, Grey),
- draw_activity(Image, {Xmin, Xmax}, ActivityArea, Activities),
- Binary = egd:render(Image, png),
- egd:destroy(Image),
- Binary.
-
-draw_activity(Image, {Xmin, Xmax}, Area = #graph_area{ width = Width }, Acts) ->
- White = egd:color({255, 255, 255}),
- Green = egd:color({0,250, 0}),
- Black = egd:color({0, 0, 0}),
-
- Dx = Width/(Xmax - Xmin),
-
- draw_activity(Image, {Xmin, Xmax}, Area, {White, Green, Black}, Dx, Acts).
-
-draw_activity(_, _, _, _, _, [_]) -> ok;
-draw_activity(Image, {Xmin, Xmax}, Area = #graph_area{ height = Height, x = X0 }, {Cw, Cg, Cb}, Dx, [{Xa1, State}, {Xa2, Act2} | Acts]) ->
- X1 = erlang:trunc(X0 + Dx*Xa1 - Xmin*Dx),
- X2 = erlang:trunc(X0 + Dx*Xa2 - Xmin*Dx),
-
- case State of
- inactive ->
- egd:filledRectangle(Image, {X1, 0}, {X2, Height - 1}, Cw),
- egd:rectangle(Image, {X1, 0}, {X2, Height - 1}, Cb);
- active ->
- egd:filledRectangle(Image, {X1, 0}, {X2, Height - 1}, Cg),
- egd:rectangle(Image, {X1, 0}, {X2, Height - 1}, Cb)
- end,
- draw_activity(Image, {Xmin, Xmax}, Area, {Cw, Cg, Cb}, Dx, [{Xa2, Act2} | Acts]).
-
-
-
-%%% -------------------------------------
-%%% Process lifetime
-%%% Used by processes page
-%%% -------------------------------------
-
-proc_lifetime(Width, Height, Start, End, ProfileTime) ->
- Im = egd:create(round(Width), round(Height)),
- Black = egd:color(Im, {0, 0, 0}),
- Green = egd:color(Im, {0, 255, 0}),
-
- % Ratio and coordinates
-
- DX = (Width-1)/ProfileTime,
- X1 = round(DX*Start),
- X2 = round(DX*End),
-
- % Paint
- egd:filledRectangle(Im, {X1, 0}, {X2, Height - 1}, Green),
- egd:rectangle(Im, {X1, 0}, {X2, Height - 1}, Black),
-
- Binary = egd:render(Im, png),
- egd:destroy(Im),
- Binary.
-
-%%% -------------------------------------
-%%% Percentage
-%%% Used by process_info page
-%%% Percentage should be 0.0 -> 1.0
-%%% -------------------------------------
-percentage(Width, Height, Percentage) ->
- Im = egd:create(round(Width), round(Height)),
- Font = load_font(),
- Black = egd:color(Im, {0, 0, 0}),
- Green = egd:color(Im, {0, 255, 0}),
-
- % Ratio and coordinates
-
- X = round(Width - 1 - Percentage*(Width - 1)),
-
- % Paint
- egd:filledRectangle(Im, {X, 0}, {Width - 1, Height - 1}, Green),
- {FontW, _} = egd_font:size(Font),
- String = lists:flatten(io_lib:format("~.10B %", [round(100*Percentage)])),
-
- text( Im,
- {round(Width/2 - (FontW*length(String)/2)), 0},
- Font,
- String,
- Black),
- egd:rectangle(Im, {X, 0}, {Width - 1, Height - 1}, Black),
-
- Binary = egd:render(Im, png),
- egd:destroy(Im),
- Binary.
-
-
-load_font() ->
- Filename = filename:join([code:priv_dir(percept),"fonts", "6x11_latin1.wingsfont"]),
- egd_font:load(Filename).
-
-text(Image, {X,Y}, Font, Text, Color) ->
- egd:text(Image, {X,Y-2}, Font, Text, Color).
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-04 22:53:50 +0000