aboutsummaryrefslogblamecommitdiffstats
path: root/lib/gs/src/gstk_grid.erl
blob: 5f4f4a24f07b9e8c85d2b78b572f55ca022c6b70 (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_grid).
-compile([{nowarn_deprecated_function,{gs,val,2}}]).

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

-include("gstk.hrl").

%%-----------------------------------------------------------------------------
%% 			    GRID OPTIONS
%%
%%	rows		{ViewFrom, ViewTo}
%%	columnwidths	[CW1, CW2, ..., CWn]
%%	vscroll		Bool | left | right
%%	hscroll		Bool | top | bottom
%%	x		Coord
%%	y		Coord
%%	width		Int
%%	height		Int
%%	fg		Color  (lines and default line color)
%%	bg		Color
%%-----------------------------------------------------------------------------

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

%%======================================================================
%% Interfaces
%%======================================================================

event(DB, Gstkid, Etype, Edata, Args) ->
    gstk_gridline:event(DB, Gstkid, Etype, Edata, Args).

create(DB, Gstkid, Options) ->
    WinParent=Gstkid#gstkid.parent,
    {OtherOpts,CanvasOpts} = parse_opts(Options,[],[]),
    %% Why this (secret) hack? Performance reasons.
    %% if we ".canvas bind all" once and for all, then we can
    %% create lines twice as fast since we don't have to bind each line.
    C = make_ref(),
    gstk:create_impl(DB,{a_grid, {canvas,C,WinParent,
				 [{secret_hack_gridit, Gstkid}
				  | CanvasOpts]}}),
    CanvasGstkid = gstk_db:lookup_gstkid(DB, C),
    Wid = CanvasGstkid#gstkid.widget,
    SO = CanvasGstkid#gstkid.widget_data,
    TkCanvas = SO#so.object,
    CI=ets:new(gstk_grid_cellid,[private,set]),
    CP=ets:new(gstk_grid_cellpos,[private,set]),
    IDs=ets:new(gstk_grid_id,[private,set]),
    S=#state{db=DB,ncols=length(gs:val(columnwidths,OtherOpts)),
	     canvas=C,cell_id=CI,tkcanvas=TkCanvas,cell_pos=CP,ids=IDs},
    Ngstkid = Gstkid#gstkid{widget=Wid,widget_data=S},
    gstk_db:insert_opts(DB,Ngstkid,OtherOpts),
    gstk_db:insert_widget(DB,Ngstkid),
    gstk_generic:mk_cmd_and_exec(lists:keydelete(columnwidths,1,OtherOpts),
				Ngstkid, TkCanvas,"","", DB,nop).

config(DB, Gstkid, Options) ->
    #gstkid{widget=TkW,widget_data=State}=Gstkid,
    {OtherOpts,CanvasOpts} = parse_opts(Options,[],[]),
    case gstk:config_impl(DB,State#state.canvas,CanvasOpts) of
	ok ->
	    SimplePreCmd = "nyi?",
	    PlacePreCmd = [";place ", TkW],
	    gstk_generic:mk_cmd_and_exec(OtherOpts,Gstkid,TkW,
					SimplePreCmd,PlacePreCmd,DB,State);
	Err -> Err
    end.
    

option(Option, Gstkid, _TkW, DB,State) ->
    case Option of
	{rows,{From,To}} ->
	    Ngstkid = reconfig_rows(From,To,Gstkid),
	    gstk_db:insert_opt(DB,Gstkid,Option),
	    gstk_db:update_widget(DB,Ngstkid),
	    {none,Ngstkid};
	{fg,_Color} ->
	    reconfig_grid(DB,Option,State),
	    gstk_db:insert_opt(DB,Gstkid,Option),
	    none;
	{bg,_Color} ->
	    reconfig_grid(DB,Option,State),
	    gstk_db:insert_opt(DB,Gstkid,Option),
	    none;
	{font,_Font} ->
	    reconfig_grid(DB,Option,State),
	    gstk_db:insert_opt(DB,Gstkid,Option),
	    none;
	{columnwidths,ColWs} ->
	    gstk_db:insert_opt(DB,Gstkid,Option),
	    Rows = gstk_db:opt(DB,Gstkid,rows),
	    CellHeight = gstk_db:opt(DB,Gstkid,cellheight),
	    gstk:config_impl(DB,State#state.canvas,
			    [calc_scrollregion(Rows,ColWs,CellHeight)]),
	    %% Crash upon an error msg (so we know WHY)
	    {result,_} = gstk:call(["resize_grid_cols ",State#state.tkcanvas,
				   " [list ",asc_tcl_colw(ColWs),"]"]),
	    none;
	{cellheight,_Height} ->
	    gstk_db:insert_opt(DB,Gstkid,Option),
	    none;	
	_ ->
	    invalid_option
    end.

reconfig_grid(_,_,nop) -> done;
reconfig_grid(DB,Option,#state{tkcanvas=TkW,cell_pos=CP,
			       ncols=Ncols,max_range={From,To}}) ->
    reconfig_grid(DB,TkW,Option,From,To,CP,Ncols).
    
reconfig_grid(DB,TkW,Opt,Row,MaxRow,CellPos,Ncols) when Row =< MaxRow ->
    [{_,Item}] = ets:lookup(CellPos,{1,Row}),
    case Item#item.line_id of
	free -> empty_cell_config(DB,TkW,Row,1,Ncols,CellPos,Opt);
	GridLine ->
	    gstk_gridline:config(DB,gstk_db:lookup_gstkid(DB,GridLine),
				[Opt])
    end,
    reconfig_grid(DB,TkW,Opt,Row+1,MaxRow,CellPos,Ncols);
reconfig_grid(_,_,_,_,_,_,_) -> done.

%%----------------------------------------------------------------------
%% Purpose: Config an empty cell (i.e. has no gridline)
%%----------------------------------------------------------------------
empty_cell_config(DB,TkW,Row,Col,Ncols,CellPos,Opt) when Col =< Ncols ->
    [{_,Item}] = ets:lookup(CellPos,{Col,Row}),
    empty_cell_config(DB,TkW,Item,Opt),
    empty_cell_config(DB,TkW,Row,Col+1,Ncols,CellPos,Opt);
empty_cell_config(_,_,_,_,_,_,_) -> done.

empty_cell_config(_,TkW,#item{rect_id=Rid},{bg,Color}) ->
    gstk:exec([TkW," itemconf ",gstk:to_ascii(Rid)," -f ",gstk:to_color(Color)]);
empty_cell_config(_,TkW,#item{rect_id=Rid,text_id=Tid},{fg,Color}) ->
    Acolor = gstk:to_color(Color),
    Pre = [TkW," itemconf "],
    RectStr = [Pre, gstk:to_ascii(Rid)," -outline ",Acolor],
    TexdStr = [Pre,  gstk:to_ascii(Tid)," -fi ",Acolor],
    gstk:exec([RectStr,$;,TexdStr]);
empty_cell_config(DB,TkW,#item{text_id=Tid},{font,Font}) ->
    gstk:exec([TkW," itemconf ",gstk:to_ascii(Tid)," -font ",
	      gstk_font:choose_ascii(DB,Font)]);
empty_cell_config(_,_,_,_) -> done.



reconfig_rows(From, To, Gstkid) ->
    #gstkid{widget_data=State,id=Id} = Gstkid,
    #state{tkcanvas=TkCanvas,cell_pos=CP,cell_id=CI,
	   canvas=C,db=DB,max_range=Range}=State,
    NewRange =
	if Range == undefined ->
		mkgrid(DB,CP,CI,TkCanvas,Id,From,To),
		{From,To};
	   true ->
		{Top,Bot} = Range,
		if
		    From < Top -> % we need more rects above
			mkgrid(DB,CP,CI,TkCanvas,Id,From,Top-1);
		    true -> true
		end,
		if
		    To > Bot ->   % we need more rects below
			mkgrid(DB,CP,CI,TkCanvas,Id,Bot+1,To);
		    true -> true
		end,
		{lists:min([Top, From]), lists:max([Bot, To])}
	end,
    gstk:config_impl(DB,C,[calc_scrollregion({From,To},
					    gstk_db:opt(DB,Id,columnwidths),
					    gstk_db:opt(DB,Id,cellheight))]),
    S2 = State#state{max_range=NewRange},
    Gstkid#gstkid{widget_data=S2}.

read(DB,Gstkid,Opt) ->
    State = Gstkid#gstkid.widget_data,
    case lists:member(Opt,[x,y,width,height,hscroll,vscroll]) of
	true -> gstk:read_impl(DB,State#state.canvas,Opt);
	false ->
	    gstk_generic:read_option(DB, Gstkid, Opt,State)
      end.

read_option(Option,Gstkid,_TkW,DB,State) -> 
    case Option of
	{obj_at_row,Row} ->
	    case ets:lookup(State#state.cell_pos,{1,Row}) of
		[{_pos,Item}] ->
		    case Item#item.line_id of
			free -> undefined;
			GridLine ->
			    gstk:make_extern_id(GridLine, DB)
		    end;
		_ -> undefined
	    end;
	Opt -> gstk_db:opt(DB,Gstkid#gstkid.id,Opt,undefined)
    end.


%%----------------------------------------------------------------------
%% Is always called.
%% Clean-up my specific side-effect stuff.
%%----------------------------------------------------------------------
delete(DB, Gstkid) ->
    gstk_db:delete_widget(DB, Gstkid),
    State = Gstkid#gstkid.widget_data,
    #state{canvas=C,cell_pos=CP,cell_id=CIs, ids=IDs} = State,
    ets:delete(CP),
    ets:delete(CIs),
    ets:delete(IDs),
    {Gstkid#gstkid.parent, Gstkid#gstkid.id, gstk_grid, [C]}.

%%----------------------------------------------------------------------
%% Is called iff my parent is not also destroyed.
%%----------------------------------------------------------------------
destroy(DB, Canvas) ->
    gstk:destroy_impl(DB,gstk_db:lookup_gstkid(DB,Canvas)).

mk_create_opts_for_child(DB,Cgstkid, Pgstkid, Opts) ->
    gstk_generic:mk_create_opts_for_child(DB,Cgstkid,Pgstkid,Opts).

mkgrid(DB,CellPos,CellIds,TkCanvas,Id,From,To) ->
    ColWs = gstk_db:opt(DB,Id,columnwidths),
    AscColW = ["[list ",asc_tcl_colw(ColWs),"]"],
    Font = gstk_font:choose_ascii(DB,gstk_db:opt(DB,Id,font)),
    Fg = gstk:to_color(gstk_db:opt(DB,Id,fg)),
    Bg = gstk:to_color(gstk_db:opt(DB,Id,bg)),
    Objs = tcl2erl:ret_list(["mkgrid ",TkCanvas," ",AscColW," ",
			     gstk:to_ascii(From)," ",
			     gstk:to_ascii(To)," ",
			     gstk:to_ascii(gstk_db:opt(DB,Id,cellheight))," ",
			     Font," ",Fg," ",Bg]),
    insert_objs(CellPos,CellIds,From,To,1,length(ColWs)+1,Objs).

insert_objs(_,_,_,_,_,_,[]) -> done;
insert_objs(CP,CI,Row,T,MaxCol,MaxCol,Objs) ->
    insert_objs(CP,CI,Row+1,T,1,MaxCol,Objs);
insert_objs(CellPos,CellIds,Row,To,Col,Ncols,[RectId,TextId|Objs]) ->
    ets:insert(CellPos,{{Col,Row},
		   #item{text_id=TextId,rect_id=RectId,line_id=free}}),
    ets:insert(CellIds,{RectId,{Col,Row}}),
    ets:insert(CellIds,{TextId,{Col,Row}}),
    insert_objs(CellPos,CellIds,Row,To,Col+1,Ncols,Objs).

asc_tcl_colw([]) -> "";
asc_tcl_colw([Int|T]) -> [gstk:to_ascii(Int)," "|asc_tcl_colw(T)].

%%----------------------------------------------------------------------
%% Args: Cols  list of column sizes (measured in n-chars)
%%----------------------------------------------------------------------
calc_scrollregion({From, To}, Cols, Height) ->
    {scrollregion, {0, ((From-1) * Height) + From,
		    lists:sum(Cols)+length(Cols)+1, (To * Height)+ To+1}}.

parse_opts([],OtherOpts,CanvasOpts) -> {OtherOpts,CanvasOpts};
parse_opts([{Key,Val}|Opts],OtherOpts,CanvasOpts) ->
    case lists:member(Key,[x,y,width,height,vscroll,hscroll]) of
	true -> parse_opts(Opts,OtherOpts,[{Key,Val}|CanvasOpts]);
	false -> parse_opts(Opts,[{Key,Val}|OtherOpts],CanvasOpts)
    end;
parse_opts([Opt|Opts],OtherOpts,CanvasOpts) ->
    parse_opts(Opts,[Opt|OtherOpts],CanvasOpts).