%% %% %CopyrightBegin% %% %% Copyright Ericsson AB 1996-2012. 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% %% %% %% ------------------------------------------------------------ %% Basic Canvas Type %% ------------------------------------------------------------ -module(gstk_canvas). -compile([{nowarn_deprecated_function,{gs,pair,2}}, {nowarn_deprecated_function,{gs,val,2}}]). %%----------------------------------------------------------------------------- %% CANVAS OPTIONS %% %% Attributes: %% activebg Color %% anchor n,w,s,e,nw,se,ne,sw,center %% bc Color %% bg Color %% bw Wth %% data Data %% height Int %% highlightbg Color %% highlightbw Wth %% highlightfg Color %% hscroll Bool | top | bottom %% relief Relief %% scrollbg Color %% scrollfg Color %% scrollregion {X1, Y1, X2, Y2} %% selectbg Color %% selectbw Width %% selectfg Color %% vscroll Bool | left | right %% width Int %% x Int %% y Int %% %% %% Commands: %% find {X, Y} => Item at pos X,Y or false %% setfocus Bool %% %% Events: %% buttonpress [Bool | {Bool, Data}] %% buttonrelease [Bool | {Bool, Data}] %% configure [Bool | {Bool, Data}] %% destroy [Bool | {Bool, Data}] %% enter [Bool | {Bool, Data}] %% focus [Bool | {Bool, Data}] %% keypress [Bool | {Bool, Data}] %% keyrelease [Bool | {Bool, Data}] %% leave [Bool | {Bool, Data}] %% motion [Bool | {Bool, Data}] %% %% Read Options: %% children %% id %% parent %% type %% %% Not Implemented: %% fg Color %% -export([create/3,config/3,read/3,delete/2,event/5,option/5,read_option/5]). -export([make_command/5,make_command/6,pickout_coords/4, coords/1, item_config/3,mk_create_opts_for_child/4, upd_gstkid/3,item_delete_impl/2,mk_cmd_and_exec/6,mk_cmd_and_call/5]). -include("gstk.hrl"). %%----------------------------------------------------------------------------- %% MANDATORY INTERFACE FUNCTIONS %%----------------------------------------------------------------------------- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Function : create/3 %% Return : [Gsid_of_new_widget | {bad_result, Reason}] %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% create(DB, Gstkid, Opts) -> MainW = gstk_generic:mk_tkw_child(DB,Gstkid), Canvas = lists:append(MainW,".z"), {Vscroll, Hscroll, NewOpts} = gstk_generic:parse_scrolls(Opts), WidgetD = #so{main=MainW, object=Canvas, hscroll=Hscroll, vscroll=Vscroll}, NGstkid=Gstkid#gstkid{widget=MainW, widget_data=WidgetD}, MandatoryCmd = ["so_create canvas ", MainW], case gstk:call(MandatoryCmd) of {result, _} -> SimplePreCmd = [MainW, " conf"], PlacePreCmd = [";place ", MainW], gstk_db:insert_opt(DB,Gstkid,gs:pair(scrollregion,Opts)), case gstk_generic:make_command(NewOpts, NGstkid, MainW, SimplePreCmd, PlacePreCmd, DB,Canvas) of {error,Reason} -> {error,Reason}; Cmd when is_list(Cmd) -> gstk:exec(Cmd), gstk:exec([MainW,".sy conf -rel sunken -bo 2;", MainW,".pad.sx conf -rel sunken -bo 2;"]), NGstkid end; Bad_Result -> {bad_result, Bad_Result} end. mk_create_opts_for_child(DB,Cgstkid, Pgstkid, Opts) -> gstk_generic:mk_create_opts_for_child(DB,Cgstkid,Pgstkid,Opts). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Function : config/3 %% Purpose : Configure a widget of the type defined in this module. %% Args : DB - The Database %% Gstkid - The gstkid of the widget %% Opts - A list of options for configuring the widget %% %% Return : [true | {bad_result, Reason}] %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% config(DB, Gstkid, Options) -> SO = Gstkid#gstkid.widget_data, MainW = Gstkid#gstkid.widget, Canvas = SO#so.object, NewOpts = gstk_generic:parse_scrolls(Gstkid, Options), SimplePreCmd = [MainW, " conf"], PlacePreCmd = [";place ", MainW], gstk_generic:mk_cmd_and_exec(NewOpts, Gstkid, MainW, SimplePreCmd, PlacePreCmd, DB,Canvas). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Function : read/3 %% Purpose : Read one option from a widget %% Args : DB - The Database %% Gstkid - The gstkid of the widget %% Opt - An option to read %% %% Return : [OptionValue | {bad_result, Reason}] %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% read(DB, Gstkid, Opt) -> SO = Gstkid#gstkid.widget_data, gstk_generic:read_option(DB, Gstkid, Opt,SO#so.object). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Function : delete/2 %% Purpose : Delete widget from databas and return tkwidget to destroy %% Args : DB - The Database %% Gstkid - The gstkid of the widget %% %% Return : TkWidget to destroy %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% delete(DB, Gstkid) -> gstk_db:delete_widget(DB, Gstkid), Gstkid#gstkid.widget. event(DB, Gstkid, Etype, Edata, Args) -> gstk_generic:event(DB, Gstkid, Etype, Edata, Args). %%----------------------------------------------------------------------------- %% MANDATORY FUNCTIONS %%----------------------------------------------------------------------------- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Function : option/5 %% Purpose : Take care of options %% Args : Option - An option tuple %% Gstkid - The gstkid of the widget %% MainW - The main tk-widget %% Canvas - The canvas tk-widget %% DB - The Database %% %% Return : A tuple {OptionType, OptionCmd} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% option(Option,Gstkid,_MainW,DB,Canvas) -> case Option of {scrollregion, {X1, Y1, X2, Y2}} -> gstk_db:insert_opt(DB,Gstkid,Option), {c, [Canvas, " conf -scrollr {", gstk:to_ascii(X1), " ", gstk:to_ascii(Y1), " ", gstk:to_ascii(X2), " ", gstk:to_ascii(Y2),"}"]}; {yscrollpos, Y} -> {_,Ymin,_,Ymax} = gstk_db:opt(DB,Gstkid,scrollregion), K = 1/(Ymax-Ymin), M = -K*Ymin, PercentOffViewTop = K*Y+M, {c, [Canvas," yvi mo ",gstk:to_ascii(PercentOffViewTop)]}; {xscrollpos, X} -> {Xmin,_,Xmax,_} = gstk_db:opt(DB,Gstkid,scrollregion), K = 1/(Xmax-Xmin), M = -K*Xmin, PercentOffViewLeft = K*X+M, {c, [Canvas," xvi mo ",gstk:to_ascii(PercentOffViewLeft)]}; {buttonpress, On} -> bind(DB, Gstkid, Canvas, buttonpress, On); {buttonrelease, On} -> bind(DB, Gstkid, Canvas, buttonrelease, On); {configure, On} -> bind(DB, Gstkid, Canvas, configure, On); {destroy, On} -> bind(DB, Gstkid, Canvas, destroy, On); {enter, On} -> bind(DB, Gstkid, Canvas, enter, On); {focus, On} -> bind(DB, Gstkid, Canvas, focus, On); {keypress, On} -> bind(DB, Gstkid, Canvas, keypress, On); {keyrelease, On} -> bind(DB, Gstkid, Canvas, keyrelease, On); {leave, On} -> bind(DB, Gstkid, Canvas, leave, On); {motion, On} -> bind(DB, Gstkid, Canvas, motion, On); {secret_hack_gridit, GridGstkid} -> CRef = gstk_db:insert_event(DB, GridGstkid, click, []), ClickCmd = [Canvas, " bind all {erlsend ", CRef, " [",Canvas, " find withtag current]};"], DRef = gstk_db:insert_event(DB, GridGstkid, doubleclick, []), DclickCmd = [Canvas," bind all {erlsend ", DRef," [",Canvas, " find withtag current]}"], %% bind all at once for preformance reasons. {c, [ClickCmd,DclickCmd]}; {secret_forwarded_grid_event, {Event,On},GridGstkid} -> bind(DB,GridGstkid,Canvas,Event,On); _ -> invalid_option end. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Function : read_option/5 %% Purpose : Take care of a read option %% Return : The value of the option or invalid_option %% [OptionValue | {bad_result, Reason}] %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% read_option(Option,Gstkid,_MainW,DB,Canvas) -> case Option of scrollregion -> gstk_db:opt(DB,Gstkid,scrollregion); {hit, {X,Y}} -> hit(DB,Canvas,X,Y,X,Y); {hit, [{X1,Y1},{X2,Y2}]} -> hit(DB,Canvas,X1,Y1,X2,Y2); % {% hidden above, % of total area that is visible + % hidden above} yscrollpos -> {PercentOffViewTop,_} = tcl2erl:ret_tuple([Canvas," yvi"]), {_,Ymin,_,Ymax} = gstk_db:opt(DB,Gstkid,scrollregion), K = 1/(Ymax-Ymin), M = -K*Ymin, _Y = round((PercentOffViewTop - M)/K); xscrollpos -> {PercentOffViewLeft,_} = tcl2erl:ret_tuple([Canvas," xvi"]), {Xmin,_,Xmax,_} = gstk_db:opt(DB,Gstkid,scrollregion), K = 1/(Xmax-Xmin), M = -K*Xmin, _X = round((PercentOffViewLeft-M)/K); buttonpress -> gstk_db:is_inserted(DB, Gstkid, buttonpress); buttonrelease -> gstk_db:is_inserted(DB, Gstkid, buttonrelease); configure -> gstk_db:is_inserted(DB, Gstkid, configure); destroy -> gstk_db:is_inserted(DB, Gstkid, destroy); enter -> gstk_db:is_inserted(DB, Gstkid, enter); focus -> gstk_db:is_inserted(DB, Gstkid, focus); keypress -> gstk_db:is_inserted(DB, Gstkid, keypress); keyrelease -> gstk_db:is_inserted(DB, Gstkid, keyrelease); leave -> gstk_db:is_inserted(DB, Gstkid, leave); motion -> gstk_db:is_inserted(DB, Gstkid, motion); _ -> {bad_result, {Gstkid#gstkid.objtype, invalid_option, Option}} end. hit(DB,Canvas,X1,Y1,X2,Y2) -> Ax1 = gstk:to_ascii(X1), Ay1 = gstk:to_ascii(Y1), Ax2 = gstk:to_ascii(X2), Ay2 = gstk:to_ascii(Y2), case tcl2erl:ret_list([Canvas," find overlapping ", Ax1,$ ,Ay1,$ ,Ax2,$ ,Ay2]) of Items when is_list(Items) -> [{_,Node}] = ets:lookup(DB,frontend_node), fix_ids(Items,DB,Canvas,Node); Other -> {bad_result, Other} end. fix_ids([Item|Items],DB,Canvas,Node) -> [{gstk_db:lookup_item(DB,Canvas,Item),Node}|fix_ids(Items,DB,Canvas,Node)]; fix_ids([],_,_,_) -> []. %%----------------------------------------------------------------------------- %% PRIMITIVES %%----------------------------------------------------------------------------- %% %% Event bind main function %% %% Should return a list of tcl commands or invalid_option %% %% WS = Widget suffix for c widgets %% bind(DB, Gstkid, TkW, Etype, On) -> case bind(DB, Gstkid, TkW, Etype, On, "") of invalid_option -> invalid_option; Cmd -> {c, Cmd} end. bind(DB, Gstkid, TkW, Etype, On, WS) -> case On of true -> ebind(DB, Gstkid, TkW, Etype, WS, ""); false -> eunbind(DB, Gstkid, TkW, Etype, WS, ""); {true, Edata} -> ebind(DB, Gstkid, TkW, Etype, WS, Edata); {false, Edata} -> eunbind(DB, Gstkid, TkW, Etype, WS, Edata); _ -> invalid_option end. %% %% Event bind on %% %% Should return a list of tcl commands or invalid_option %% %% WS = Widget suffix for complex widgets %% ebind(DB, Gstkid, TkW, Etype, WS, Edata) -> Eref = gstk_db:insert_event(DB, Gstkid, Etype, Edata), P = ["bind ", TkW, WS], Cmd = case Etype of motion -> [P, " {erlsend ", Eref, " [", TkW, " canvasx %x] [", TkW, " canvasy %y] %x %y}"]; keypress -> [P, " {erlsend ", Eref," %K %N 0 0 [", TkW, " canvasx %x] [", TkW, " canvasy %y]};", P, " {erlsend ", Eref, " %K %N 1 0 [", TkW, " canvasx %x] [", TkW, " canvasy %y]};", P, " {erlsend ", Eref, " %K %N 0 1 [", TkW, " canvasx %x] [", TkW, " canvasy %y]};", P, " {erlsend ", Eref," %K %N 1 1 [", TkW, " canvasx %x] [", TkW, " canvasy %y]}"]; keyrelease -> [P, " {erlsend ", Eref," %K %N 0 0 [", TkW, " canvasx %x] [", TkW, " canvasy %y]};", P, " {erlsend ", Eref, " %K %N 1 0 [", TkW, " canvasx %x] [", TkW, " canvasy %y]};", P, " {erlsend ", Eref, " %K %N 0 1 [", TkW, " canvasx %x] [", TkW, " canvasy %y]};", P," {erlsend ",Eref," %K %N 1 1[", TkW, " canvasx %x] [", TkW, " canvasy %y]}"]; buttonpress -> [P, "