1/*  Part of XPCE --- The SWI-Prolog GUI toolkit
    2
    3    Author:        Jan Wielemaker and Anjo Anjewierden
    4    E-mail:        jan@swi.psy.uva.nl
    5    WWW:           http://www.swi.psy.uva.nl/projects/xpce/
    6    Copyright (c)  2001-2011, University of Amsterdam
    7    All rights reserved.
    8
    9    Redistribution and use in source and binary forms, with or without
   10    modification, are permitted provided that the following conditions
   11    are met:
   12
   13    1. Redistributions of source code must retain the above copyright
   14       notice, this list of conditions and the following disclaimer.
   15
   16    2. Redistributions in binary form must reproduce the above copyright
   17       notice, this list of conditions and the following disclaimer in
   18       the documentation and/or other materials provided with the
   19       distribution.
   20
   21    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   22    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   23    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   24    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   25    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   26    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   27    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   28    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   29    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   30    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   31    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   32    POSSIBILITY OF SUCH DAMAGE.
   33*/
   34
   35:- module(tabular, []).   36:- use_module(library(pce)).   37
   38:- pce_begin_class(tabular, device,
   39                   "Device with associated table <-layout_manager").
   40
   41delegate_to(layout_manager).
   42
   43initialise(TD, Table:[table]) :->
   44    send_super(TD, initialise),
   45    (   Table == @default
   46    ->  send(TD, layout_manager, new(_, tabular_table))
   47    ;   send(TD, layout_manager, Table)
   48    ).
   49
   50:- pce_group(appearance).
   51
   52
   53:- pce_group(event).
   54
   55:- pce_global(@tabular_device_recogniser,
   56              new(resize_table_slice_gesture(column, left))).
   57
   58event(RT, Ev:event) :->
   59    get(RT, table, Table),
   60    (   get(Table, cell_from_position, Ev, Cell),
   61        send(Cell, instance_of, table_cell),
   62        get(Cell, image, Gr),
   63        (   send(Gr, has_send_method, on_mark_clicked),
   64            send(Ev, is_a, button),
   65            get(Cell, note_mark, Mark),
   66            Mark \== @nil,
   67            get(Cell, area, area(X, Y, W, _)),
   68            get(Ev, position, RT, point(EX, EY)),
   69            get(Mark, size, size(MW, MH)),
   70            EX > X+W-MW,
   71            EY < Y+MH
   72        ->  (   send(Ev, is_up)
   73            ->  send(Gr, on_mark_clicked)
   74            ;   true
   75            )
   76        ;   send(Ev, post, Gr)
   77        )
   78    ;   send(@tabular_device_recogniser, event, Ev)
   79    ).
   80
   81:- pce_group(geometry).
   82
   83table_width(TD, W:int) :->
   84    "Set width of the table"::
   85    send(TD?table, width, W).
   86
   87:- pce_group(parts).
   88
   89table(TD, Table:table) :<-
   90    "Get the table layout_manager"::
   91    get(TD, layout_manager, Table).
   92
   93:- pce_group(fill).
   94
   95append(TD,
   96       Label:label='name|graphical|table_cell',
   97       Font:font=[font],
   98       HAlign:halign=[{left,center,right}],
   99       VAlign:valign=[{top,center,bottom}],
  100       Span:colspan='[1..]',
  101       RSpan:rowspan='[1..]',
  102       BG:background=[colour],
  103       FG:colour=[colour]) :->
  104    "Append a cell to the table"::
  105    get(TD, table, Table),
  106    (   atom(Label)
  107    ->  new(TC, table_cell(text(Label, @default, Font)))
  108    ;   send(Label, instance_of, graphical)
  109    ->  new(TC, table_cell(Label)),
  110        (   Font \== @default
  111        ->  send(Label, font, Font)
  112        ;   true
  113        )
  114    ;   TC = Label,
  115        (   Font \== @default
  116        ->  send(Label, font, Font)
  117        ;   true
  118        )
  119    ),
  120    (   HAlign \== @default
  121    ->  send(TC, halign, HAlign)
  122    ;   true
  123    ),
  124    send(TC, background, BG),
  125    (   FG \== @default
  126    ->  send(TC?image, colour, FG)
  127    ;   true
  128    ),
  129    (   Span \== @default
  130    ->  send(TC, col_span, Span)
  131    ;   true
  132    ),
  133    (   RSpan \== @default
  134    ->  send(TC, row_span, RSpan)
  135    ;   true
  136    ),
  137    (   VAlign \== @default
  138    ->  send(TC, valign, VAlign)
  139    ;   true
  140    ),
  141    send(Table, append, TC).
  142
  143clear(TD) :->
  144    "Delete all rows"::
  145    get(TD, table, Table),
  146    send(Table, delete_rows).
  147
  148:- pce_group(label).
  149
  150append_label_button(TD, Field:name) :->
  151    "Append a button to sort the field"::
  152    get(TD, layout_manager, Table),
  153    get(Table, current, point(X, Y)),
  154    send(Table, append,
  155         new(TC, table_cell(new(B, button(Field,
  156                                          message(TD, sort_rows,
  157                                                  X, Y+1)))))),
  158    send(B, radius, 0),
  159    get(class(dialog), class_variable, background, BGVar),
  160    send(TC, background, BGVar?value),
  161    send(TC, cell_padding, size(0,0)),
  162    send(TC, halign, stretch).
  163
  164:- pce_group(sort).
  165
  166sort_rows(TD, Col:int, FromRow:int) :->
  167    "Sort rows starting at FromRow on the indicated column"::
  168    format('~p: Sorting rows below ~w on column ~w~n', [TD, FromRow, Col]).
  169
  170:- pce_end_class(tabular).
  171
  172
  173                 /*******************************
  174                 *          THE TABLE           *
  175                 *******************************/
  176
  177:- pce_begin_class(tabular_table, table,
  178                   "The layout manager class tabular").
  179
  180stretched_column(Table, Col:table_column, W:int) :->
  181    "Adjust the size of cells holding a wrapped text"::
  182    get(Col, index, Index),
  183    send(Col, for_all, message(Table, stretched_cell, @arg1, W, Index)),
  184    send_super(Table, stretched_column, Col, W).
  185
  186stretched_cell(T, Cell:table_cell, W:int, ColN:int) :->
  187    (   get(Cell, image, Graphical),
  188        send(Graphical, instance_of, graphical)
  189    ->  (   send(Graphical, has_send_method, margin),
  190            get(Graphical, send_method, margin,
  191                tuple(Graphical, Method)),
  192            get(Method, argument_type, 2, T2),
  193            send(T2, validate, wrap)
  194        ->  spanned_cell_width(Cell, ColN, W, T, TextW),
  195            send(Graphical, margin, TextW, wrap)
  196        ;   send(Graphical, instance_of, device),
  197            get(Graphical, format, Format),
  198            Format \== @nil,
  199            get(Format, columns, @off)
  200        ->  spanned_cell_width(Cell, ColN, W, T, TextW),
  201            send(Graphical, format, width, TextW)
  202        ;   send(Graphical, has_get_method, auto_align),
  203            get(Graphical, auto_align, @on)
  204        ->  spanned_cell_width(Cell, ColN, W, T, TextW),
  205            send(Graphical, do_set, width := TextW)
  206        ;   true
  207        )
  208    ;   true
  209    ).
  210
  211spanned_cell_width(Cell, ColN, W, T, TextW) :-
  212    get(Cell, col_span, Span),
  213    get(Cell, column, Col0),
  214    EndCol is Col0+Span,
  215    cell_width(Col0, EndCol, ColN, W, T, 0, TotalW),
  216    (   get(Cell, cell_padding, size(PW, _))
  217    ->  TextW is TotalW - PW*2
  218    ;   get(Cell?table, cell_padding, size(PW, _))
  219    ->  TextW is TotalW - PW*2
  220    ;   TextW is TotalW
  221    ).
  222
  223%       Determine the width of a spanned cell.
  224
  225cell_width(End, End, _, _, _, W, W) :- !.
  226cell_width(C, End, N, W, T, W0, Width) :-
  227    (   C == N
  228    ->  W1 is W0 + W
  229    ;   get(T, column, C, Col),
  230        get(Col, width, WC),
  231        W1 is W0 + WC
  232    ),
  233    C2 is C + 1,
  234    cell_width(C2, End, N, W, T, W1, Width).
  235
  236:- pce_end_class(tabular_table)