aboutsummaryrefslogtreecommitdiffstats
path: root/lib/gs/src/gstk_grid.erl
diff options
context:
space:
mode:
Diffstat (limited to 'lib/gs/src/gstk_grid.erl')
-rw-r--r--lib/gs/src/gstk_grid.erl282
1 files changed, 282 insertions, 0 deletions
diff --git a/lib/gs/src/gstk_grid.erl b/lib/gs/src/gstk_grid.erl
new file mode 100644
index 0000000000..4189246822
--- /dev/null
+++ b/lib/gs/src/gstk_grid.erl
@@ -0,0 +1,282 @@
+%%
+%% %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%
+%%
+
+%%
+-module(gstk_grid).
+
+-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).
+