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.erl284
1 files changed, 0 insertions, 284 deletions
diff --git a/lib/gs/src/gstk_grid.erl b/lib/gs/src/gstk_grid.erl
deleted file mode 100644
index 4e8cffc018..0000000000
--- a/lib/gs/src/gstk_grid.erl
+++ /dev/null
@@ -1,284 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1996-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions 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).
-