aboutsummaryrefslogblamecommitdiffstats
path: root/lib/gs/src/gstk_gridline.erl
blob: 914a7f1c6def5646ac7f0d8993eef2c8dbeba298 (plain) (tree)
1
2
3
4


                   
                                                        
















                                                                         

                                                    




















































































































































































































































































                                                                                  
%%
%% %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%
%%

%%
-module(gstk_gridline).
-compile([{nowarn_deprecated_function,{gs,val,2}},
          {nowarn_deprecated_function,{gs,val,3}}]).

-export([event/5,create/3,config/3,option/5,read/3,delete/2,destroy/3,
	read_option/5]).

-include("gstk.hrl").
-record(state,{canvas,ncols,max_range,cell_id, cell_pos,ids,db,tkcanvas}).
-record(item,{text_id,rect_id,line_id}).

%%-----------------------------------------------------------------------------
%% 			    GRIDLINE OPTIONS
%%
%%	text		Text
%%	row             Row
%%	data		Data
%%	fg		Color (default is the same as grid fg)
%%	click         	Bool
%%
%%-----------------------------------------------------------------------------

create(DB, Gstkid, Options) ->
    Pgstkid = gstk_db:lookup_gstkid(DB,Gstkid#gstkid.parent),
    Id = Gstkid#gstkid.id,
    #gstkid{widget_data=State} = Pgstkid,
    #state{cell_pos=CP,tkcanvas=TkW,ncols=Ncols} = State,
    Row = gs:val(row,Options),
    case check_row(CP,Row) of
	{error,Reason} -> {error,Reason};
	ok ->
	    Ngstkid = Gstkid#gstkid{widget=TkW},
	    gstk_db:insert_opts(DB,Id,[{data,[]},{row,Row}]),
	    update_cp_db(Ncols,Row,Id,CP),
	    config_line(DB,Pgstkid,Ngstkid,Row,Options),
	    Ngstkid
    end.

%%----------------------------------------------------------------------
%% Returns: ok|false
%%----------------------------------------------------------------------
check_row(_CellPos,undefined) ->
    {error,{gridline,{row,undefined}}};
check_row(CellPos,Row) ->
    case ets:lookup(CellPos,{1,Row}) of
	[] ->
	    {error,{gridline,row_outside_range,Row}};
	[{_,Item}] ->
	    case Item#item.line_id of
		free -> ok;
		_    ->
		    {error,{gridline,row_is_occupied,Row}}
	    end
    end.

%%----------------------------------------------------------------------
%% s => text item
%% p => rect item
%%----------------------------------------------------------------------
option(Option, _Gstkid, _TkW, DB,_) ->
    case Option of
	{{bg,_Item}, Color} -> {p,[" -f ", gstk:to_color(Color)]};
	{{text,_Item},Text} -> {s, [" -te ", gstk:to_ascii(Text)]};
	{{fg,_Item},Color} -> {sp,{[" -fi ", gstk:to_color(Color)],
				  [" -outline ", gstk:to_color(Color)]}};
	{{font,_Item},Font} -> {s,[" -font ",gstk_font:choose_ascii(DB,Font)]};
	_ -> invalid_option
    end.

%%----------------------------------------------------------------------
%% Is always called.
%% Clean-up my specific side-effect stuff.
%%----------------------------------------------------------------------
delete(DB, Gstkid) ->
    Row = gstk_db:opt(DB,Gstkid,row),
    gstk_db:delete_widget(DB, Gstkid),    
    {Gstkid#gstkid.parent, Gstkid#gstkid.id, gstk_gridline,[Gstkid, Row]}.

%%----------------------------------------------------------------------
%% Is called iff my parent is not also destroyed.
%%----------------------------------------------------------------------
destroy(DB, Lgstkid, Row) ->
    Ggstkid = gstk_db:lookup_gstkid(DB,Lgstkid#gstkid.parent),
    #gstkid{widget_data=State} = Ggstkid,
    config_line(DB,Ggstkid,Lgstkid,Row,
		[{bg,gstk_db:opt(DB,Ggstkid,bg)},
		 {fg,gstk_db:opt(DB,Ggstkid,fg)},{text,""}]),
    Ncols = State#state.ncols,
    update_cp_db(Ncols,Row,free,State#state.cell_pos).


config(DB, Gstkid, Opts) ->
    Pgstkid = gstk_db:lookup_gstkid(DB,Gstkid#gstkid.parent),
    case {gs:val(row,Opts,missing),gstk_db:opt(DB,Gstkid,row)} of
	{Row,Row} -> % stay here...
	    config_line(DB,Pgstkid,Gstkid,Row,Opts);
	{missing,Row} ->  % stay here...
	    config_line(DB,Pgstkid,Gstkid,Row,Opts);
	{NewRow,OldRow} ->
	    config_line(DB,Pgstkid,Gstkid,OldRow,Opts),
	    Ngstkid = gstk_db:lookup_gstkid(DB,Gstkid#gstkid.id),
	    case move_line(NewRow,OldRow,DB,Pgstkid#gstkid.widget_data,Ngstkid) of
		true -> 
		    gstk_db:insert_opt(DB,Ngstkid,{row,NewRow}),
		    ok;
		{error,_Reason} -> ok
	    end
    end,
    ok.

%%----------------------------------------------------------------------
%% Returns: true|false depending on if operation succeeded
%%----------------------------------------------------------------------
move_line(NewRow,OldRow,_DB,State,_Ngstkid) ->
    case ets:lookup(State#state.cell_pos,{1,NewRow}) of
	[] ->
	    {error,{gridline,row_outside_grid,NewRow}};
	[{_,#item{line_id=Lid}}] when Lid =/= free->
	    {error,{gridline,new_row_occupied,NewRow}};
	[{_,_NewItem}] ->
	    #state{tkcanvas=TkW,ncols=Ncols,cell_pos=CP} = State,
	    swap_lines(TkW,OldRow,NewRow,1,Ncols,CP),
	    true
    end.

%%----------------------------------------------------------------------
%% Purpose: swaps an empty newrow with a (oldrow) gridline
%%----------------------------------------------------------------------
swap_lines(TkW,OldRow,NewRow,Col,MaxCol,CellPos) when Col =< MaxCol ->
    [{_,NewItem}] = ets:lookup(CellPos,{Col,NewRow}),
    [{_,OldItem}] = ets:lookup(CellPos,{Col,OldRow}),
    swap_cells(TkW,NewItem,OldItem),
    ets:insert(CellPos,{{Col,NewRow},OldItem}),
    ets:insert(CellPos,{{Col,OldRow},NewItem}),
    swap_lines(TkW,OldRow,NewRow,Col+1,MaxCol,CellPos);
swap_lines(_,_,_,_,_,_) -> done.

swap_cells(TkW,#item{rect_id=NewRectId,text_id=NewTextId},
	   #item{rect_id=OldRectId,text_id=OldTextId}) ->
    Aorid = gstk:to_ascii(OldRectId),
    Aotid = gstk:to_ascii(OldTextId),
    Anrid = gstk:to_ascii(NewRectId),
    Antid = gstk:to_ascii(NewTextId),
    Pre = [TkW," coords "],
    OldRectCoords = tcl2erl:ret_str([Pre,Aorid]),
    OldTextCoords = tcl2erl:ret_str([Pre,Aotid]),
    NewRectCoords = tcl2erl:ret_str([Pre,Anrid]),
    NewTextCoords = tcl2erl:ret_str([Pre,Antid]),
    gstk:exec([Pre,Aotid," ",NewTextCoords]),
    gstk:exec([Pre,Antid," ",OldTextCoords]),
    gstk:exec([Pre,Aorid," ",NewRectCoords]),
    gstk:exec([Pre,Anrid," ",OldRectCoords]).

%%----------------------------------------------------------------------
%% Pre: {row,Row} option is taken care of.
%%----------------------------------------------------------------------
config_line(DB,Pgstkid,Lgstkid,Row,Opts) ->
    #gstkid{widget_data=State, widget=TkW} = Pgstkid,
    #state{cell_pos=CP,ncols=Ncols} = State,
    Ropts = transform_opts(Opts,Ncols),
    RestOpts = config_gridline(DB,CP,Lgstkid,Ncols,Row,Ropts),
    gstk_generic:mk_cmd_and_exec(RestOpts,Lgstkid,TkW,"","",DB).

%%----------------------------------------------------------------------
%% Returns: non-processed options
%%----------------------------------------------------------------------
config_gridline(_DB,_CP,_Gstkid,0,_Row,Opts) ->
    Opts;
config_gridline(DB,CP,Gstkid,Col,Row,Opts) ->
    {ColOpts,OtherOpts} = opts_for_col(Col,Opts,[],[]),
    if
	ColOpts==[] -> done;
	true ->
	    [{_pos,Item}] =  ets:lookup(CP,{Col,Row}),
	    TkW = Gstkid#gstkid.widget,
	    TextPre = [TkW," itemconf ",gstk:to_ascii(Item#item.text_id)],
	    RectPre = [$;,TkW," itemconf ",gstk:to_ascii(Item#item.rect_id)],
	    case gstk_generic:make_command(ColOpts,Gstkid,TkW,
					  TextPre,RectPre,DB) of
		[] -> ok;
		{error,_Reason} -> ok;
		Cmd -> gstk:exec(Cmd)
	    end
    end,
    config_gridline(DB,CP,Gstkid,Col-1,Row,OtherOpts).

opts_for_col(Col,[{{Key,Col},Val}|Opts],ColOpts,RestOpts) ->
    opts_for_col(Col,Opts,[{{Key,Col},Val}|ColOpts],RestOpts);
opts_for_col(Col,[Opt|Opts],ColOpts,RestOpts) ->
    opts_for_col(Col,Opts,ColOpts,[Opt|RestOpts]);
opts_for_col(_Col,[],ColOpts,RestOpts) -> {ColOpts,RestOpts}.

%%----------------------------------------------------------------------
%% {Key,{Col,Val}} becomes {{Key,Col},Val}
%% {Key,Val} becomes {{Key,1},Val}...{{Key,Ncol},Val}
%%----------------------------------------------------------------------
transform_opts([], _Ncols) -> [];
transform_opts([{{Key,Col},Val} | Opts],Ncols) ->
    [{{Key,Col},Val}|transform_opts(Opts,Ncols)];
transform_opts([{Key,{Col,Val}}|Opts],Ncols) when is_integer(Col) ->
    [{{Key,Col},Val}|transform_opts(Opts,Ncols)];
transform_opts([{Key,Val}|Opts],Ncols) ->
    case lists:member(Key,[fg,bg,text,font]) of
	true -> 
	    lists:append(expand_to_all_cols(Key,Val,Ncols),
			 transform_opts(Opts,Ncols));
	false ->
	    case lists:member(Key,[click,doubleclick,row]) of
		true ->
		    [{keep_opt,{Key,Val}}|transform_opts(Opts,Ncols)];
		false ->
		    [{Key,Val}|transform_opts(Opts,Ncols)]
	    end
    end;
transform_opts([Opt|Opts],Ncols) ->
    [Opt|transform_opts(Opts,Ncols)].

expand_to_all_cols(Key,Val,1) ->
    [{{Key,1},Val}];
expand_to_all_cols(Key,Val,Col) ->
    [{{Key,Col},Val}|expand_to_all_cols(Key,Val,Col-1)].
		     

read(DB, Gstkid, Opt) ->
    Pgstkid = gstk_db:lookup_gstkid(DB,Gstkid#gstkid.parent),
    gstk_generic:read_option(DB, Gstkid, Opt,Pgstkid).

read_option({font,Column},Gstkid, _TkW,DB,Pgstkid) -> 
    case gstk_db:opt_or_not(DB,Gstkid,{font,Column}) of
	false -> gstk_db:opt(DB,Pgstkid,font);
	{value,V} -> V
    end;
read_option({Opt,Column},Gstkid, TkW,DB,#gstkid{widget_data=State}) -> 
    Row = gstk_db:opt(DB,Gstkid,row),
    [{_pos,Item}] = ets:lookup(State#state.cell_pos,{Column,Row}),
    Rid = gstk:to_ascii(Item#item.rect_id),
    Tid = gstk:to_ascii(Item#item.text_id),
    Pre = [TkW," itemcg "],
    case Opt of
	bg -> tcl2erl:ret_color([Pre,Rid," -f"]);
	fg -> tcl2erl:ret_color([Pre,Tid," -fi"]);
	text -> tcl2erl:ret_str([Pre,Tid," -te"]);
	_ -> {bad_result, {Gstkid#gstkid.objtype, invalid_option, {Opt,Column}}}
    end;
read_option(Option,Gstkid,TkW,DB,Pgstkid) -> 
    case lists:member(Option,[bg,fg,text]) of
	      true -> read_option({Option,1},Gstkid,TkW,DB,Pgstkid);
	      false -> gstk_db:opt(DB,Gstkid,Option,undefined)
    end.

update_cp_db(0,_Row,_,_) -> ok;
update_cp_db(Col,Row,ID,CP) ->
    [{_,Item}] = ets:lookup(CP,{Col,Row}),
    ets:insert(CP,{{Col,Row},Item#item{line_id = ID}}),
    update_cp_db(Col-1,Row,ID,CP).


event(DB, GridGstkid, Etype, _Edata, [CanItem]) ->
    State = GridGstkid#gstkid.widget_data,
    #state{cell_pos=CP,cell_id=CIs,tkcanvas=TkW} = State,
    case ets:lookup(CIs,CanItem) of 
	[{_id,{Col,Row}}] ->
	    [{_pos,Item}] =  ets:lookup(CP,{Col,Row}),
	    case Item#item.line_id of
		free -> ok;
		Id   ->
		    Lgstkid = gstk_db:lookup_gstkid(DB,Id),
		    case gstk_db:opt_or_not(DB,Lgstkid,Etype) of
			{value,true}  ->
			    Txt = read_option({text,Col},Lgstkid,TkW,
					      DB,GridGstkid),
			    gstk_generic:event(DB,Lgstkid,Etype,dummy,
					      [Col,Row,Txt]);
			_ -> ok
		    end
	    end;
	_ -> ok
    end;
event(_DB, _Gstkid, _Etype, _Edata, _Args) ->
    ok.