Diff for /loncom/xml/lontable.pm between versions 1.4 and 1.7

version 1.4, 2008/12/02 11:57:25 version 1.7, 2008/12/29 11:57:37
Line 39 Line 39
   
 # This module is a support packkage that helps londefdef generate  # This module is a support packkage that helps londefdef generate
 # LaTeX tables using the LaTeX::Table package.  A prerequisite is that  # LaTeX tables using the LaTeX::Table package.  A prerequisite is that
 # the print generator must have added the following to the LaTeX header:  # the print generator must have added the following to the LaTeX 
 #  #
 #  \usepackage{xtab}  #  \usepackage{xtab}
 #  \usepackage{booktabs}  #  \usepackage{booktabs}
Line 108  modified by this.  These configuration i Line 108  modified by this.  These configuration i
   
 =over3  =over3
   
   
 =item alignment  =item alignment
   
 Table alignment.  Some table styles support this but not all.  Table alignment.  Some table styles support this but not all.
Line 132  to the LaTeX::Table package, and they wi Line 133  to the LaTeX::Table package, and they wi
 not error checked.  Any use of a non-existent theme is reported by the LaTeX::Table package  not error checked.  Any use of a non-existent theme is reported by the LaTeX::Table package
 when the table text is generated.  when the table text is generated.
   
   =item width
   
   The width of the table.  This can be expressed as fractions of full width, or in any
   TeX unit measure e.g. 0.75 for 75% of the width, or 10.8cm  This forces the table to the
   tabularx environment.
   
 =back  =back
   
 =head3 Member data  =head3 Member data
Line 164  Table caption (configurable). Line 171  Table caption (configurable).
   
 Theme desired (configurable).  Theme desired (configurable).
   
   =item width
   
   If defined, the width of the table (should be supplied
   in fraction of column width e.g. .75 for 75%.
   
 =item row_open   =item row_open 
   
 True if a row is open and not yet closed.  True if a row is open and not yet closed.
Line 189  Default horizontal alignment for cells i Line 201  Default horizontal alignment for cells i
   
 Default vertical alignment for cells in this row (may be ignored).  Default vertical alignment for cells in this row (may be ignored).
   
   =item cell_width
    
   The width of the row in cells.  This is the sum of the column spans 
   of the cells in the row.
   
 =item cells  =item cells
   
 Array of hashes where each element represents the data for a cell.  Array of hashes where each element represents the data for a cell.
Line 218  If present, indicates the number of rows Line 235  If present, indicates the number of rows
 If present indicates the number of columns this cell spans.  If present indicates the number of columns this cell spans.
 Note that a cell can span both rows and columns.  Note that a cell can span both rows and columns.
   
   =item start_col
   
   The starting column of the cell in the table grid.
   
 =item contents  =item contents
   
 The contents of the cell.  The contents of the cell.
Line 278  sub alignment { Line 299  sub alignment {
     my ($self, $new_value) = @_;      my ($self, $new_value) = @_;
   
     if (defined($new_value)) {      if (defined($new_value)) {
  $self->{alignment} = $new_value;   $self->{'alignment'} = $new_value;
     }      }
     return $self->{alignment};      return $self->{'alignment'};
 }  }
   
 =pod  =pod
Line 303  sub table_border { Line 324  sub table_border {
     my ($self, $new_value) = @_;      my ($self, $new_value) = @_;
   
     if (defined($new_value)) {      if (defined($new_value)) {
  $self->{outer_border} = $new_value;   $self->{'outer_border'} = $new_value;
     }      }
     return $self->{outer_border};      return $self->{'outer_border'};
 }  }
   
   
Line 329  sub cell_border { Line 350  sub cell_border {
     my ($self, $new_value) = @_;      my ($self, $new_value) = @_;
   
     if (defined($new_value)) {      if (defined($new_value)) {
  $self->{inner_border} = $new_value;   $self->{'inner_border'} = $new_value;
     }      }
     return $self->{inner_border};      return $self->{'inner_border'};
 }  }
   
 =pod  =pod
Line 353  sub caption { Line 374  sub caption {
     my ($self, $new_value) = @_;      my ($self, $new_value) = @_;
   
     if (defined($new_value)) {      if (defined($new_value)) {
  $self->{caption} = $new_value;   $self->{'caption'} = $new_value;
     }      }
   
     return $self->{caption};      return $self->{'caption'};
 }  }
   
 =pod  =pod
Line 378  sub theme { Line 399  sub theme {
     my ($self, $new_value) = @_;      my ($self, $new_value) = @_;
   
     if (defined($new_value)) {      if (defined($new_value)) {
  $self->{theme} = $new_value;   $self->{'theme'} = $new_value;
     }      }
     return $self->{theme};      return $self->{'theme'};
   }
   
   =pod
   
   =head 2 width
   
   Gets and optionally sets the width of the table.
   
   =head 3 Examples:
   
    $table->width("0.8");    # 80% of the column width.
    my $newwidth = $table->width("10cm");   # 10cm width returns "10cm".
   
   =cut
   sub width {
       my ($self, $new_value) = @_;
       if (defined($new_value)) {
    $self->{'width'} = $new_value;
       }
       return $self->{'width'}; # Could be undef.
 }  }
   
 =pod  =pod
Line 412  The default vertical alignment of the ro Line 453  The default vertical alignment of the ro
 =cut  =cut
   
 sub start_row {  sub start_row {
     my ($self, %config) = @_;      my ($self, $config) = @_;
   
     if ($self->{row_open}) {       if ($self->{'row_open'}) { 
  $self->end_row();   $self->end_row();
     }      }
     my $row_hash = {      my $row_hash = {
  default_halign => "left",   default_halign => "left",
  default_valign => "top",   default_valign => "top",
    cell_width     =>  0,
  cells          => []   cells          => []
     };      };
   
     # Override the defaults if the config hash is present:      # Override the defaults if the config hash is present:
   
     if (defined(%config)) {      if (defined($config)) {
  foreach my $key  (keys %config) {   foreach my $key  (keys %$config) {
     $row_hash->{$key} = $config{$key};      $row_hash->{$key} = $config->{$key};
  }   }
     }      }
   
           
     my $rows = $self->{rows};      my $rows = $self->{'rows'};
     push(@$rows, $row_hash);      push(@$rows, $row_hash);
   
     $self->{row_open} = 1; # Row is now open and ready for business.      $self->{"row_open"} = 1; # Row is now open and ready for business.
 }  }
   
 =pod  =pod
Line 453  Closes off a row.  Once closed, cells ca Line 496  Closes off a row.  Once closed, cells ca
 sub end_row {  sub end_row {
     my ($self) = @_;      my ($self) = @_;
   
     if ($self->{row_open}) {      if ($self->{'row_open'}) {
   
  # Mostly we need to determine if this row has the maximum   # Mostly we need to determine if this row has the maximum
  # cell count of any row in existence in the table:   # cell count of any row in existence in the table:
   
  my $row        = $self->{rows}[-1];   my $row        = $self->{'rows'}->[-1];
  my $cells      = $row->{cells};   my $cells      = $row->{'cells'};
  my $raw_cell_count = scalar(@$cells);  
    if ($row->{'cell_width'} > $self->{'column_count'}) {
  # Need to iterate through the columns as       $self->{'column_count'} = $row->{'cell_width'};
  # colspans affect the count:  
  #  
  my $cell_count = 0;  
  for (my $i =0; $i < $raw_cell_count; $i++) {  
     $cell_count = $cell_count + $cells->[$i]->{colspan};  
  }  
  if ($cell_count > $self->{column_count}) {  
     $self->{column_count} = $cell_count;  
  }   }
   
  $self->{row_open} = 0;;   $self->{'row_open'} = 0;;
     }      }
 }  }
   
Line 509  The default vertical alignment for text Line 544  The default vertical alignment for text
 sub configure_row {  sub configure_row {
     my ($self, $config) = @_;      my ($self, $config) = @_;
   
     if (!$self->{row_open}) {      if (!$self->{'row_open'}) {
  $self->start_row();   $self->start_row();
     }      }
           
     my $row = $self->{rows}[-1];      my $row = $self->{'rows'}[-1];
     foreach my $config_item (keys %$config) {      foreach my $config_item (keys %$config) {
  $row->{$config_item} = $config->{$config_item};   $row->{$config_item} = $config->{$config_item};
     }      }
Line 568  sub add_cell { Line 603  sub add_cell {
   
     # If a row is not open, we must open it:      # If a row is not open, we must open it:
   
     if (!$self->{row_open}) {      if (!$self->{'row_open'}) {
  $self->start_row();   $self->start_row();
     }      }
       my $rows          = $self->{'rows'};
     my $current_row   = $self->{rows}->[-1];      my $current_row   = $rows->[-1];
     my $current_cells = $current_row->{cells};       my $current_cells = $current_row->{'cells'}; 
       my $last_coord    = $current_row->{'cell_width'};
     # The way we handle row spans is to insert additional  
     # blank cells as needed to reach this column.  Each      #  We have to worry about row spans if there is a prior row:
     # cell that is inserted is empty, but has a row span decreased by one  
     # from the row above.  Column spans are propagated down from the row above      if (scalar(@$rows) > 1) {
     # and handled when the table's LaTeX is generated.  
     # There must be at least two rows in the row table to need to do this:   my $last_row = $rows->[-2];
    if ($last_coord < $last_row->{'cell_width'}) {
     my $row_count = scalar(@$self->{rows});      my $prior_coord       = 0;
     if ($row_count > 1) {      my $prior_cell_index  = 0;
  my $prior_row      = $self->{rows}->[-2];      while ($prior_coord <= $last_coord) {
  my $curr_colcount  = scaler(@$current_row->{cells});  
  my $prior_colcount = scaler(@$prior_row->{cells});   # Pull a cell down if it's coord matches our start coord
    # And there's a row span > 1.
  while (($curr_colcount < $prior_colcount) &&   # Having done so, we adjust our $last_coord to match the
        $prior_row->{cells}->[$curr_colcount]->{rowspan} > 1) {   # end point of the pulled down cell.
     my %cell = $prior_row->{cells}->[$curr_colcount];  
     %cell->{rowspan}--;   my $prior_cell = $last_row->{'cells'}->[$prior_cell_index];
     %cell->{contents} = "";   if (($prior_cell->{'start_col'} == $last_coord) &&
     push(@$current_cells, \%cell);      ($prior_cell->{'rowspan'}  > 1)) {
       
       #  Need to drop the cell down
   
       my %dropped_down_cell = %$prior_cell;
       $dropped_down_cell{'rowspan'}--;
       $dropped_down_cell{'contents'} = '';
   
       push(@$current_cells, \%dropped_down_cell);
       $last_coord += $dropped_down_cell{'colspan'};
       $current_row->{'cell_width'} = $last_coord;
       
    }
    $prior_coord += $prior_cell->{'colspan'};
    $prior_cell_index++;
       }
  }   }
   
     }      }
   
     #      #
     # Now we're ready to build up our cell:      # Now we're ready to build up our cell:
   
     my $cell = {      my $cell = {
  rowspan    => 1,   rowspan    => 1,
  colspan    => 1,   colspan    => 1,
    start_col  => $last_coord,
  contents   => $text   contents   => $text
     };      };
           
Line 610  sub add_cell { Line 663  sub add_cell {
     $cell->{$key} = $config->{$key};      $cell->{$key} = $config->{$key};
  }   }
     }      }
       $current_row->{'cell_width'} += $cell->{'colspan'};
   
     push(@$current_cells, $cell);      push(@$current_cells, $cell);
 }  }
   
 # The following method allows for testability.  =pod
   
   =head2 generate
   
   Call this when the structures for the table have been built.
   This will generate and return the table object that can be used
   to generate the table.  Returning the table object allows for
   a certain amount of testing to be done on the generated table.
   The caller can then ask the table object to generate LaTeX.
   
   =cut
   sub generate {
       my ($this) = @_;
   
       my $table = LaTeX::Table->new();
   
       # Add the caption if supplied.
   
       if ($this->{'caption'} ne "") {
    $table->set_caption($this->caption);
       }
   
       
       # Set the width if defined:
   
       if (defined ($this->{'width'})) {
    $table->set_width($this->{'width'});
    $table->set_width_environment('tabularx');
       }
   
       # Build up the data:
   
       my @data;
       my $rows      = $this->{'rows'};
       my $row_count = scalar(@$rows);
       my $inner_border = $this->{'inner_border'};
       my $outer_border = $this->{'outer_border'};
       my $column_count = $this->{'column_count'};
   
       for (my $row = 0; $row < $row_count; $row++) {
    my @row;
    my $cells      = $rows->[$row]->{'cells'};
    my $def_halign = $rows->[$row]->{'default_halign'};
    my $cell_count = scalar(@$cells);
    my $startcol   = 1;
    my @underlines; # Array of \cline cells if cellborder on.
   
    for (my $cell  = 0; $cell < $cell_count; $cell++) {
       my $contents = $cells->[$cell]->{'contents'};
   
       #
       #  Cell alignment is the default alignment unless
       #  explicitly specified in the cell.
       #  NOTE: at this point I don't know how to do vert alignment.
       #
   
       my $halign   = $def_halign;
       if (defined ($cells->[$cell]->{'halign'})) {
    $halign = $cells->[$cell]->{'halign'};
       }
   
       # Create the horizontal alignment character:
   
       my $col_align = 'l';
       if ($halign eq 'right') {
    $col_align = 'r';
       }
       if ($halign eq 'center') {
    $col_align = 'c';
       }
       if ($inner_border || ($outer_border && ($cell == 0))) {
    $col_align = '|'.$col_align;
       }
       if ($inner_border || ($outer_border && ($cell == ($cell_count -1)))) {
    $col_align = $col_align.'|';
       }
   
       #factor in spans:
   
       my $cspan    = $cells->[$cell]->{'colspan'};
       my $nextcol  = $startcol + $cspan;
       $contents = '\multicolumn{'.$cspan.'}{'.$col_align.'}{'.$contents.'}';
       if ($inner_border && ($cells->[$cell]->{'rowspan'} == 1)) {
    my $lastcol = $nextcol -1;
    push(@underlines, "\\cline{$startcol-$lastcol}");
       }
       $startcol = $nextcol;
       # Rowspans should take care of themselves.
       
   
       push(@row, $contents);
   
    }
    push(@data, \@row);
    if ($inner_border) {
       for (my $i =0; $i < scalar(@underlines); $i++) {
    push(@data, [$underlines[$i]]);
       }
    }
   
       }
       $table->set_data(\@data);
       
       my $coldef = "";
       if ($outer_border || $inner_border) {
    $coldef .= '|';
       }
       for (my $i =0; $i < $column_count; $i++) {
    $coldef .= 'l';
    if ($inner_border || 
       ($outer_border && ($i == $column_count-1))) {
       $coldef .= '|';
    }
       }
       $table->{'coldef'} = $coldef;
   
       # Return the table:
   
       return $table;
   
   }
   #----------------------------------------------------------------------------
   # The following methods allow for testability.
   
   
 sub get_object_attribute {  sub get_object_attribute {
Line 621  sub get_object_attribute { Line 798  sub get_object_attribute {
     return $self->{$attribute};      return $self->{$attribute};
 }  }
   
   sub get_row {
       my ($self, $row) = @_;
       my $rows = $self->{'rows'};  # ref to an array....
       return $rows->[$row];         # ref to the row hash for the selected row.
   }
 #   Mandatory initialization.  #   Mandatory initialization.
 BEGIN{  BEGIN{
 }  }

Removed from v.1.4  
changed lines
  Added in v.1.7


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>