diff options
Diffstat (limited to 'lib/gs/src/gstk_grid.erl')
| -rw-r--r-- | lib/gs/src/gstk_grid.erl | 282 |
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). + |