aboutsummaryrefslogtreecommitdiffstats
path: root/lib/toolbar/src/toolbar_graphics.erl
diff options
context:
space:
mode:
authorErlang/OTP <[email protected]>2009-11-20 14:54:40 +0000
committerErlang/OTP <[email protected]>2009-11-20 14:54:40 +0000
commit84adefa331c4159d432d22840663c38f155cd4c1 (patch)
treebff9a9c66adda4df2106dfd0e5c053ab182a12bd /lib/toolbar/src/toolbar_graphics.erl
downloadotp-84adefa331c4159d432d22840663c38f155cd4c1.tar.gz
otp-84adefa331c4159d432d22840663c38f155cd4c1.tar.bz2
otp-84adefa331c4159d432d22840663c38f155cd4c1.zip
The R13B03 release.OTP_R13B03
Diffstat (limited to 'lib/toolbar/src/toolbar_graphics.erl')
-rw-r--r--lib/toolbar/src/toolbar_graphics.erl401
1 files changed, 401 insertions, 0 deletions
diff --git a/lib/toolbar/src/toolbar_graphics.erl b/lib/toolbar/src/toolbar_graphics.erl
new file mode 100644
index 0000000000..ad390440e3
--- /dev/null
+++ b/lib/toolbar/src/toolbar_graphics.erl
@@ -0,0 +1,401 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(toolbar_graphics).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Erlang Toolbar
+%
+%%% Description %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Toolbar graphics.
+% The Toolbar window looks something like this:
+%
+% |-----------------------------|
+% | File Tools Help |
+% |-----------------------------|
+% | |-----| |-----| |-----| |
+% | | | | | | | |
+% | |Icon1| |Icon2|...|IconN| |
+% | |-----| |-----| |-----| |
+% |-----------------------------|
+% | Help text area |
+% |-----------------------------|
+%
+%%% Includes %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+-include("toolbar.hrl").
+%
+%%% Internal data structures %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Toolbar window record
+-record(tbwindow,
+ {window,menubar,canvas,labelframe,
+ label,helpmenu,
+ no_of_buttons,
+ min_height,min_width,cur_height,icons}).
+%
+%%% Constants %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Window width
+-define(width,215).
+%
+% Icon width and height
+-define(icon,34).
+%
+% Margin around icons
+-define(pad,0).
+%
+% Default label width and height
+-define(wlabel,50).
+-define(hlabel,15).
+%
+% Default button width and height
+-define(wbutton,50).
+-define(hbutton,30).
+%
+%%% Exports %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+-export([event/4]).
+-export([draw_window/1,redraw_window/2,already_added/2,add_icon/2]).
+-export([get_window/1]).
+-export([cursor/2]).
+-export([listen_configure/1]).
+-export([display_show/2,display_clear/1]).
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%%% Exported functions %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%----------------------------------------
+% event(Data,GsEvent,Data,Args) => Event
+% Data - term()
+% GsEvent - GS event
+% Data, Args - Data and Arg fields associated with the GS event
+% Event - {display,String} | display_clear | noevent | {start,{M,F,A}} |
+% update_toolbar | create_tool_file | add_gs_contribs |
+% {help,Html} | about_help | {redraw,{Width,Height}} | quit |
+% {newData,NewData}
+% String - string()
+% M, F - atom() Module and function name
+% A - [term()] Function argument
+% Html - string() HTML file | nofile
+% Width, Height - integer()
+% NewData - term()
+% Tries to convert a GS event to an internal toolbar event. The separation
+% is intented to keep the implementation details of the graphics hidden
+% for toolbar.erl. Pure graphical events triggered by the GS event will
+% be executed by this function.
+% The Data field is used for saving information between different events
+% (without having to use put/get or ets). Right now it is only used to save
+% the coordinates of the last canvasbutton pressed, making it possible to
+% check if the canvasbutton is released with the mouse moved outside the
+% button (= no action) or with the mouse still inside the button (= action).
+%----------------------------------------
+%%% Mouse enters a icon, display short help message
+event(_LoopData,enter,{canvasbutton,_Cbtn,{_Start,{message,String}}},_Args) ->
+ {display,String};
+
+%% Mouse leaves a icon, clear display area
+event(_LoopData,leave,{canvasbutton,_Cbtn,_Data},_Args) ->
+ display_clear;
+
+%% An icon is pressed, create graphical illusion of this
+event(_LoopData,buttonpress,{canvasbutton,Canvasbutton,_},_Args) ->
+ canvasbutton:press(Canvasbutton),
+ {newData,canvasbutton:read(Canvasbutton,coords)};
+
+%% An icon is released, create graphical illusion of this
+event(LoopData,buttonrelease,{canvasbutton,Cbtn,{{start,Start},_Msg}},
+ [_,X,Y|_]) ->
+ canvasbutton:release(Cbtn),
+ case within(X,Y,LoopData) of
+ true ->
+ {start,Start};
+ false ->
+ noevent
+ end;
+
+%%% Update Toolbar button pressed
+event(_LoopData,click,_Data,["Update Toolbar"|_]) ->
+ update_toolbar;
+
+%%% Tool configuration button pressed
+event(_LoopData,click,_Data,["Create Tool File..."|_]) ->
+ create_tool_file;
+
+%%% Add GS contribution button pressed
+event(_LoopData,click,_Data,["Add GS Contributions"|_]) ->
+ add_gs_contribs;
+
+%%% Help menu button selected
+event(_LoopData,click,{help,Html},_Args) ->
+ {help,Html};
+
+%%% About Help menu button selected
+event(_LoopData,click,about_help,_Args) ->
+ about_help;
+
+%% Window resized, redraw it
+event(_LoopData,configure,_Data,[Width,Height|_]) ->
+ {redraw,{Width,Height}};
+
+%%% Quit button pressed
+event(_LoopData,click,_Data,["Quit"|_]) ->
+ quit;
+
+%%% Window closed
+event(_LoopData,destroy,_Data,_Args) ->
+ quit;
+
+event(_LoopData,_GsEvent,_Data,_Args) ->
+ noevent.
+
+%=============================================================================
+% Main window functions
+%=============================================================================
+
+%----------------------------------------
+% draw_window(S) => Window
+% S - pid() GS
+% Window - tbwindow record
+% This functions create the main window, initially without any tool icons
+%----------------------------------------
+draw_window(S) ->
+
+ Norm = ?icon + 2*?pad,
+
+ %% Main window
+ Win = gs:create(window,S,[{title,"Erlang Tools"},{width,?width}]),
+
+ %% Menu bar with menu buttons
+ Menubar = gs:create(menubar,Win,[]),
+
+ %% File menu
+ File = gs:create(menubutton,Menubar,[{label,{text,"File"}},{side,left}]),
+ FileM = gs:create(menu,File,[]),
+ gs:create(menuitem,FileM,[{label,{text,"Update Toolbar"}}]),
+ gs:create(menuitem,FileM,[{label,{text,"Quit"}}]),
+
+ %% Tools menu
+ Tool = gs:create(menubutton,Menubar,[{label,{text,"Tools"}},{side,left}]),
+ ToolM = gs:create(menu,Tool,[]),
+ gs:create(menuitem,ToolM,[{label,{text,"Create Tool File..."}}]),
+ gs:create(menuitem,ToolM,[{label,{text,"Add GS Contributions"}}]),
+
+ %% Help menu
+ Help = gs:create(menubutton,Menubar,[{label,{text,"Help"}},{side,right}]),
+ HelpM = gs:create(menu,Help,[]),
+ gs:create(menuitem,HelpM,[{label,{text,"About..."}},
+ {data,about_help}]),
+ gs:create(menuitem,HelpM,[{label,{text,"Toolbar"}},
+ {data,{help,toolbar_lib:help_file()}}]),
+ gs:create(menuitem,HelpM,[{label,{text,"OTP"}},
+ {data,{help,toolbar_lib:otp_file()}}]),
+ gs:create(menuitem,HelpM,[{itemtype,separator}]),
+
+ %% Check height of menu bar
+ H = gs:read(Menubar,height),
+
+ %% Now the height of the window can be computed
+ Height = H+Norm+?hlabel+2*?pad,
+ gs:config(Win,{height,Height}),
+
+ %% Canvas, here will the Tool canvasbuttons be inserted
+ Canvas = gs:create(canvas,Win,[{width,?width},{height,Norm},{x,0},{y,H}]),
+
+ %% Label for displaying help messages and the frame containing it
+ LabelF = gs:create(frame,Win,[{bg,green},{bw,1},
+ {width,?width},{height,?hlabel+2*?pad},
+ {x,0},{y,H+Norm}]),
+ Label = gs:create(label,LabelF,[{align,w},{height,?hlabel},
+ {width,?width},{x,?pad},{y,?pad},
+ {label,{text,string:copies(" ",30)}}]),
+
+ gs:config(Win,{map,true}),
+
+ #tbwindow{window=Win,
+ menubar=Menubar,canvas=Canvas,labelframe=LabelF,
+ label=Label,helpmenu=HelpM,
+ no_of_buttons=0,
+ min_height=Height,min_width=?width,cur_height=Height,
+ icons=[]}.
+
+%----------------------------------------
+% redraw_window(Window,{NewWidth,NewHeight}) => NewWindow
+% Window, NewWindow - tbwindow record
+% NewWidth, NewHeight - integer()
+% Redraw main window contents according to a new size
+%----------------------------------------
+redraw_window(Window,{NewWidth,NewHeight}) ->
+
+ MinWidth = Window#tbwindow.min_width,
+ if
+ NewWidth=<MinWidth ->
+ true;
+ true ->
+ gs:config(Window#tbwindow.canvas,{width,NewWidth}),
+ gs:config(Window#tbwindow.labelframe,{width,NewWidth}),
+ gs:config(Window#tbwindow.label,{width,NewWidth-2*?pad})
+ end,
+
+ MinHeight = Window#tbwindow.min_height,
+ if
+ NewHeight=<MinHeight ->
+ Window;
+ true ->
+
+ %% Compute size difference
+ Diff = NewHeight - Window#tbwindow.cur_height,
+
+ %% Resize button frame
+ Canvas = Window#tbwindow.canvas,
+ gs:config(Canvas,{height,gs:read(Canvas,height)+Diff}),
+
+ %% Move label frame accordingly
+ LabelF = Window#tbwindow.labelframe,
+ gs:config(LabelF,{y,gs:read(LabelF,y)+Diff}),
+
+ %% Return updated tbwindow record
+ Window#tbwindow{cur_height=NewHeight}
+ end.
+
+%----------------------------------------
+% already_added(Window,ToolInfo) => true | false
+% Window - tbwindow record
+% ToolInfo - toolinfo record
+% Returns true if ToolInfo contains information about a tool that
+% is already included in Window
+%----------------------------------------
+already_added(Window,ToolInfo) ->
+ already_added2(Window#tbwindow.icons,ToolInfo#toolinfo.tool).
+
+%----------------------------------------
+% already_added2(ToolInfos,Tool) => true | false
+% ToolInfos - [toolinfo record]
+% Tool - atom() Tool name
+%----------------------------------------
+already_added2([#toolinfo{tool=Tool}|_Rest],Tool) ->
+ true;
+already_added2([_|Rest],Tool) ->
+ already_added2(Rest,Tool);
+already_added2([],_ToolInfo) ->
+ false.
+
+%----------------------------------------
+% add_icon(Window,ToolInfo) => NewWindow
+% Window, NewWindow - tbwindow record
+% ToolInfo - toolinfo record
+% Add an icon to the main window
+%----------------------------------------
+add_icon(Window,ToolInfo) ->
+ Norm = ?icon + 2*?pad,
+
+ %% Extend window if necessary
+ N = Window#tbwindow.no_of_buttons,
+ ReqWidth = N*Norm+Norm,
+ CurWidth = gs:read(Window#tbwindow.window,width),
+ if
+ ReqWidth>CurWidth ->
+ gs:config(Window#tbwindow.window,{width,ReqWidth}),
+ gs:config(Window#tbwindow.canvas,{width,ReqWidth}),
+ gs:config(Window#tbwindow.labelframe,{width,ReqWidth}),
+ gs:config(Window#tbwindow.label,{width,ReqWidth-2*?pad});
+ true ->
+ true
+ end,
+
+ %% Insert icon into button frame
+ canvasbutton:create(Window#tbwindow.canvas,
+ [{image,ToolInfo#toolinfo.icon},
+ {x,N*Norm+?pad},{y,?pad},
+ {width,?icon},{height,?icon},
+ {data,{{start,ToolInfo#toolinfo.start},
+ {message,ToolInfo#toolinfo.message}}}]),
+
+ %% Insert tool name into help menu (if there is any help available)
+ case ToolInfo#toolinfo.html of
+ nofile ->
+ true;
+ Html ->
+ gs:create(menuitem,Window#tbwindow.helpmenu,
+ [{label,{text,ToolInfo#toolinfo.tool}},
+ {data,{help,Html}}])
+ end,
+
+ MinWidth = gs:read(Window#tbwindow.window,width),
+ Window#tbwindow{no_of_buttons=N+1,min_width=MinWidth,
+ icons=[ToolInfo|Window#tbwindow.icons]}.
+
+%----------------------------------------
+% get_window(Window) -> gs_obj()
+% Window - tbwindow record
+%----------------------------------------
+get_window(Window) ->
+ Window#tbwindow.window.
+
+%----------------------------------------
+% cursor(Window,Cursor)
+% Window - tbwindow record
+% Cursor - arrow | busy
+%----------------------------------------
+cursor(Window,Cursor) ->
+ gs:config(Window#tbwindow.window,{cursor,Cursor}).
+
+%----------------------------------------
+% listen_configure(Window)
+% Window - tbwindow record
+% Configure Window to listen for configure events
+%----------------------------------------
+listen_configure(Window) ->
+ gs:config(Window#tbwindow.window,{configure,true}).
+
+%----------------------------------------
+% display_show(Window,Text)
+% Window - tbwindow record
+% Text - string()
+% Display text in the help text area
+%----------------------------------------
+display_show(Window,Text) ->
+ gs:config(Window#tbwindow.label,{label,{text,Text}}).
+
+%----------------------------------------
+% display_clear(Window)
+% Window - tbwindow record
+% Clear the help text area
+%----------------------------------------
+display_clear(Window) ->
+ display_show(Window,"").
+
+%%% Internal functions %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%----------------------------------------
+% within(X,Y,[{Left,Top},{Right,Bot}]) => true | false
+% Return true if {X,Y} is within the given rectangle.
+%----------------------------------------
+within(X,Y,[{L,T},{R,B}]) ->
+ if
+ X>=L,
+ X=<R,
+ Y>=T,
+ Y=<B ->
+ true;
+ true ->
+ false
+ end.