From 84adefa331c4159d432d22840663c38f155cd4c1 Mon Sep 17 00:00:00 2001 From: Erlang/OTP Date: Fri, 20 Nov 2009 14:54:40 +0000 Subject: The R13B03 release. --- lib/gs/src/gstk_line.erl | 202 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 202 insertions(+) create mode 100644 lib/gs/src/gstk_line.erl (limited to 'lib/gs/src/gstk_line.erl') diff --git a/lib/gs/src/gstk_line.erl b/lib/gs/src/gstk_line.erl new file mode 100644 index 0000000000..19f36f7636 --- /dev/null +++ b/lib/gs/src/gstk_line.erl @@ -0,0 +1,202 @@ +%% +%% %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 Line Type +%% ------------------------------------------------------------ + +-module(gstk_line). + + +%%----------------------------------------------------------------------------- +%% LINE OPTIONS +%% +%% Attributes: +%% arrow none | first | last | both +%% capstyle butt | projecting | round +%% coords [{X1,Y1}, {X2,Y2} | {Xn,Yn}] +%% data Data +%% fg Color +%% joinstyle miter | bevel | round +%% smooth Bool +%% splinesteps Int +%% stipple Bool +%% width Wth +%% +%% Commands: +%% lower +%% move {Dx, Dy} +%% raise +%% scale {Xo, Yo, Sx, Sy} +%% setfocus Bool +%% +%% Events: +%% buttonpress [Bool | {Bool, Data}] +%% buttonrelease [Bool | {Bool, Data}] +%% enter [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: +%% + +-export([create/3, config/3, read/3, delete/2, destroy/3, event/5, + option/5,read_option/5]). + +-include("gstk.hrl"). + +%%----------------------------------------------------------------------------- +%% MANDATORY INTERFACE FUNCTIONS +%%----------------------------------------------------------------------------- +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Function : create/3 +%% Purpose : Create a widget of the type defined in this module. +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +create(DB, Gstkid, Opts) -> + case pickout_coords(Opts, []) of + {error, Error} -> + {bad_result, Error}; + {Coords, NewOpts} -> + Ngstkid=gstk_canvas:upd_gstkid(DB, Gstkid, Opts), + #gstkid{widget=CanvasTkW}=Ngstkid, + MCmd = [CanvasTkW, " create li ", Coords], + gstk_canvas:mk_cmd_and_call(NewOpts,Ngstkid, CanvasTkW, MCmd, DB) + end. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Function : config/3 +%% Purpose : Configure a widget of the type defined in this module. +%% Return : [true | {bad_result, Reason}] +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +config(DB, Gstkid, Opts) -> + gstk_canvas:item_config(DB, Gstkid, Opts). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% 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) -> + Item = Gstkid#gstkid.widget_data, + gstk_generic:read_option(DB,Gstkid,Opt,[gstk:to_ascii(Item)]). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% 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 | {Parent, Objmod, Args}. +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +delete(DB, Gstkid) -> + gstk_canvas:item_delete_impl(DB,Gstkid). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Function : destroy/3 +%% Purpose : Destroy a widget +%% Args : DB - The Database +%% Canvas - The canvas tk widget +%% Item - The item number to destroy +%% +%% Return : [true | {bad_result, Reason}] +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +destroy(_DB, Canvas, Item) -> + gstk:exec([Canvas, " delete ", gstk:to_ascii(Item)]). + + +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, _Canvas, _DB, _AItem) -> + case Option of + {arrow, Where} -> {s, [" -arrow ", gstk:to_ascii(Where)]}; + {capstyle, Style} -> {s, [" -ca ", gstk:to_ascii(Style)]}; + {fg, Color} -> {s, [" -f ", gstk:to_color(Color)]}; + {joinstyle, Style} -> {s, [" -jo ", gstk:to_ascii(Style)]}; + {smooth, Bool} -> {s, [" -sm ", gstk:to_ascii(Bool)]}; + {splinesteps, Int} -> {s, [" -sp ", gstk:to_ascii(Int)]}; + {width, Int} -> {s, [" -w ", gstk:to_ascii(Int)]}; + + _ -> invalid_option + end. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Function : read_option/5 +%% Purpose : Take care of a read option +%% Args : DB - The Database +%% Return : The value of the option or invalid_option +%% [OptionValue | {bad_result, Reason}] +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +read_option(Option, Gstkid, Canvas, _DB, AItem) -> + case Option of + arrow -> tcl2erl:ret_atom([Canvas, " itemcg ",AItem, " -arrow"]); + capstyle -> tcl2erl:ret_atom([Canvas, " itemcg ", AItem, " -ca"]); + fg -> tcl2erl:ret_color([Canvas, " itemcg ", AItem, " -f"]); + joinstyle -> tcl2erl:ret_atom([Canvas, " itemcg ", AItem, " -jo"]); + smooth -> tcl2erl:ret_bool([Canvas, " itemcg ", AItem, " -sm"]); + splinesteps -> tcl2erl:ret_int([Canvas, " itemcg ", AItem, " -sp"]); + stipple -> + tcl2erl:ret_stipple([Canvas," itemcg ",AItem," -stipple"]); + width -> tcl2erl:ret_int([Canvas, " itemcg ", AItem, " -w"]); + _ -> {bad_result, {Gstkid#gstkid.objtype, invalid_option, Option}} + end. + +pickout_coords([{coords,Coords} | Rest], Opts) when length(Coords) >= 2 -> + case gstk_canvas:coords(Coords) of + invalid -> + {error, "A line must have at least four coordinates"}; + RealCoords -> + {RealCoords, lists:append(Rest, Opts)} + end; +pickout_coords([Opt | Rest], Opts) -> + pickout_coords(Rest, [Opt|Opts]); +pickout_coords([], _Opts) -> + {error, "A line must have at least four coordinates"}. + +%% ----- Done ----- + -- cgit v1.2.3