aboutsummaryrefslogtreecommitdiffstats
path: root/lib/gs/src/gstk_canvas.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/gs/src/gstk_canvas.erl
downloadotp-84adefa331c4159d432d22840663c38f155cd4c1.tar.gz
otp-84adefa331c4159d432d22840663c38f155cd4c1.tar.bz2
otp-84adefa331c4159d432d22840663c38f155cd4c1.zip
The R13B03 release.OTP_R13B03
Diffstat (limited to 'lib/gs/src/gstk_canvas.erl')
-rw-r--r--lib/gs/src/gstk_canvas.erl513
1 files changed, 513 insertions, 0 deletions
diff --git a/lib/gs/src/gstk_canvas.erl b/lib/gs/src/gstk_canvas.erl
new file mode 100644
index 0000000000..868b3020fe
--- /dev/null
+++ b/lib/gs/src/gstk_canvas.erl
@@ -0,0 +1,513 @@
+%%
+%% %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%
+%%
+
+%%
+%% ------------------------------------------------------------
+%% Basic Canvas Type
+%% ------------------------------------------------------------
+
+-module(gstk_canvas).
+
+%%-----------------------------------------------------------------------------
+%% 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 <ButtonRelease-1> {erlsend ", CRef,
+ " [",Canvas, " find withtag current]};"],
+ DRef = gstk_db:insert_event(DB, GridGstkid, doubleclick, []),
+ DclickCmd = [Canvas," bind all <Double-ButtonRelease-1> {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, " <Motion> {erlsend ", Eref, " [",
+ TkW, " canvasx %x] [", TkW, " canvasy %y] %x %y}"];
+ keypress ->
+ [P, " <Key> {erlsend ", Eref," %K %N 0 0 [",
+ TkW, " canvasx %x] [", TkW, " canvasy %y]};",
+ P, " <Shift-Key> {erlsend ", Eref, " %K %N 1 0 [",
+ TkW, " canvasx %x] [", TkW, " canvasy %y]};",
+ P, " <Control-Key> {erlsend ", Eref, " %K %N 0 1 [",
+ TkW, " canvasx %x] [", TkW, " canvasy %y]};",
+ P, " <Control-Shift-Key> {erlsend ", Eref," %K %N 1 1 [",
+ TkW, " canvasx %x] [", TkW, " canvasy %y]}"];
+ keyrelease ->
+ [P, " <KeyRelease> {erlsend ", Eref," %K %N 0 0 [",
+ TkW, " canvasx %x] [", TkW, " canvasy %y]};",
+ P, " <Shift-KeyRelease> {erlsend ", Eref, " %K %N 1 0 [",
+ TkW, " canvasx %x] [", TkW, " canvasy %y]};",
+ P, " <Control-KeyRelease> {erlsend ", Eref, " %K %N 0 1 [",
+ TkW, " canvasx %x] [", TkW, " canvasy %y]};",
+ P," <Control-Shift-KeyRelease> {erlsend ",Eref," %K %N 1 1[",
+ TkW, " canvasx %x] [", TkW, " canvasy %y]}"];
+ buttonpress ->
+ [P, " <Button> {erlsend ", Eref, " %b [",
+ TkW, " canvasx %x] [", TkW, " canvasy %y] %x %y}"];
+ buttonrelease ->
+ [P, " <ButtonRelease> {erlsend ", Eref, " %b [",
+ TkW, " canvasx %x] [", TkW, " canvasy %y] %x %y}"];
+ leave -> [P, " <Leave> {erlsend ", Eref, "}"];
+ enter -> [P, " <Enter> {erlsend ", Eref, "}"];
+ destroy ->
+ [P, " <Destroy> {if {\"%W\"==\"", [TkW, WS],
+ "\"} {erlsend ", Eref, "}}"];
+ focus ->
+ [P, " <FocusIn> {erlsend ", Eref, " true};" ,
+ P, " <FocusOut> {erlsend ", Eref, " false}"];
+ configure ->
+ [P, " <Configure> {if {\"%W\"==\"", [TkW, WS],
+ "\"} {erlsend ", Eref, " %w %h %x %y}}"]
+ end,
+ Cmd.
+
+
+%%
+%% Unbind event
+%%
+%% Should return a list of tcl commands
+%% Already checked for validation in bind/5
+%%
+%% WS = Widget suffix for complex widgets
+%%
+eunbind(DB, Gstkid, TkW, Etype, WS, _Edata) ->
+ gstk_db:delete_event(DB, Gstkid, Etype),
+ P = ["bind ", TkW, WS],
+ Cmd = case Etype of
+ motion ->
+ [P, " <Motion> {}"];
+ keypress ->
+ [P, " <KeyRelease> {};",
+ P, " <Shift-KeyRelease> {};",
+ P, " <Control-KeyRelease> {};",
+ P, " <Control-Shift-KeyRelease> {}"];
+ keyrelease ->
+ [P, " <KeyRelease> {};",
+ P, " <Shift-KeyRelease> {};",
+ P, " <Control-KeyRelease> {};",
+ P, " <Control-Shift-KeyRelease> {}"];
+ buttonpress ->
+ [P, " <ButtonPress> {}"];
+ buttonrelease ->
+ [P, " <ButtonRelease> {}"];
+ leave ->
+ [P, " <Leave> {}"];
+ enter ->
+ [P, " <Enter> {}"];
+ destroy ->
+ [P, " <Destroy> {}"];
+ focus ->
+ [P, " <FocusIn> {};",
+ P, " <FocusOut> {}"];
+ configure ->
+ [P, " <Configure> {}"]
+ end,
+ Cmd.
+
+%%======================================================================
+%% Item library
+%%======================================================================
+
+mk_cmd_and_exec(Options, Gstkid, Canvas, AItem, SCmd, DB) ->
+ case make_command(Options, Gstkid, Canvas, AItem, SCmd, DB) of
+ {error,Reason} -> {error,Reason};
+ Cmd when is_list(Cmd) ->
+ gstk:exec(Cmd)
+ end.
+
+mk_cmd_and_call(Opts,Gstkid, CanvasTkW, MCmd, DB) ->
+ case make_command(Opts,Gstkid, CanvasTkW, MCmd, DB) of
+ {error,Reason} -> {error,Reason};
+ Cmd when is_list(Cmd) ->
+ case tcl2erl:ret_int(Cmd) of
+ Item when is_integer(Item) ->
+ G2 = gstk_db:lookup_gstkid(DB,Gstkid#gstkid.id), % buu, not nice
+ NewGstkid = G2#gstkid{widget_data=Item},
+ NewGstkid;
+ Bad_result ->
+ {error,Bad_result}
+ end
+ end.
+
+
+%%----------------------------------------------------------------------
+%% MCmd = Mandatory command
+%% Comment: The problem: Create everything in one async command and
+%% get the canvas obj integer id no back then.
+%% The trick is to do:
+%% set w [canvas create rectangle x1 y1 x2 y2 -Option Value ...];
+%% canvas Action $w ;$w
+%% Comment: no placer options (we don't have to consider all permutations)
+%%----------------------------------------------------------------------
+make_command(Options, Gstkid, Canvas, AItem, SCmd, DB) ->
+ case gstk_generic:out_opts(Options,Gstkid,Canvas,DB,AItem, [],[],[]) of
+ {[], [], []} -> [];
+ {Si, [], []} -> [SCmd, Si];
+ {[], [], Co} -> Co;
+ {Si, [], Co} -> [SCmd, Si, $;, Co];
+ {error,Reason} -> {error,Reason}
+ end.
+
+make_command(Options, Gstkid, Canvas, MCmd, DB) ->
+ case gstk_generic:out_opts(Options,Gstkid,Canvas,DB,"$w",[],[],[]) of
+ {[], [], []} -> MCmd;
+ {Si, [], []} -> [MCmd, Si];
+ {[], [], Co} -> ["set w [", MCmd, "];", Co, "set d $w"];
+ {Si, [], Co} -> ["set w [", MCmd, Si, "];", Co, "set d $w"];
+ {error,Reason} -> {error,Reason}
+ end.
+
+item_config(DB, Gstkid, Opts) ->
+ #gstkid{widget=Canvas,widget_data=Item}=Gstkid,
+ AItem = gstk:to_ascii(Item),
+ SCmd = [Canvas, " itemconf ", AItem],
+ case make_command(Opts, Gstkid, Canvas, AItem, SCmd, DB) of
+ {error,Reason} -> {error,Reason};
+ Cmd when is_list(Cmd) ->
+ gstk:exec(Cmd)
+ end.
+
+pickout_coords([{coords,Coords} | Rest], Opts, ObjType, NbrOfCoords)
+ when length(Coords) == NbrOfCoords ->
+ case coords(Coords) of
+ invalid ->
+ {error, io_lib:format("A ~w must have ~w coordinates",
+ [ObjType,NbrOfCoords])};
+ RealCoords ->
+ {RealCoords, lists:append(Rest, Opts)}
+ end;
+pickout_coords([Opt | Rest], Opts, ObjType, NbrOfCoords) ->
+ pickout_coords(Rest, [Opt|Opts], ObjType, NbrOfCoords);
+pickout_coords([], _Opts, ObjType, NbrOfCoords) ->
+ {error, io_lib:format("A ~w must have ~w coordinates",
+ [ObjType,NbrOfCoords])}.
+
+coords([{X,Y} | R]) when is_number(X),is_number(Y) ->
+ [gstk:to_ascii(X), " ", gstk:to_ascii(Y), " ", coords(R)];
+coords([_]) -> %% not a pair
+ invalid;
+coords([]) ->
+ [].
+
+item_delete_impl(DB,Gstkid) ->
+ gstk_db:delete_widget(DB, Gstkid),
+ #gstkid{widget=Canvas,widget_data=Item,parent=P,id=ID,objtype=Type}=Gstkid,
+ {P,ID,gstk_widgets:type2mod(Type), [Canvas, Item]}.
+
+
+upd_gstkid(DB, Gstkid, Opts) ->
+ #gstkid{parent=Parent,owner=Owner}=Gstkid,
+ Pgstkid = gstk_db:lookup_gstkid(DB, Parent, Owner),
+ SO = Pgstkid#gstkid.widget_data,
+ CanvasTkW = SO#so.object,
+ gstk_db:insert_opt(DB,Gstkid,{coords,gs:val(coords,Opts)}),
+ gstk_db:update_widget(DB,Gstkid#gstkid{widget=CanvasTkW,widget_data=no_item}).
+
+
+%%% ----- Done -----
+
+