The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# Copyright 2008, 2009 Kevin Ryde

# This file is part of Chart.
#
# Chart is free software; you can redistribute it and/or modify it under the
# terms of the GNU General Public License as published by the Free Software
# Foundation; either version 3, or (at your option) any later version.
#
# Chart is distributed in the hope that it will be useful, but WITHOUT ANY
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
# FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
# details.
#
# You should have received a copy of the GNU General Public License along
# with Chart.  If not, see <http://www.gnu.org/licenses/>.


package Gtk2::Ex::TreeModelConcat;
use strict;
use warnings;
use Gtk2;
use Carp;

use Glib::Object::Subclass
  'Glib::Object',
  interfaces => [ Gtk2::TreeModel:: ],
  properties => [ Glib::ParamSpec->scalar
                  ('models',
                   'models',
                   'Arrayref of Gtk2::TreeModel objects to concatenate.',
                   Glib::G_PARAM_READWRITE)
                ];

use constant DEBUG => 0;

sub INIT_INSTANCE {
  my ($self) = @_;
  $self->{'models'} = [];

  require Tie::RefHash;
  my %mhash;
  tie %mhash, 'Tie::RefHash';
  $self->{'mhash'} = \%mhash;

  my %offsets;
  tie %offsets, 'Tie::RefHash';
  $self->{'offsets'} = \%offsets;
}

sub SET_PROPERTY {
  my ($self, $pspec, $newval) = @_;
  my $pname = $pspec->get_name;
  $self->{$pname} = $newval;  # per default GET_PROPERTY
  if (DEBUG) { print "TreeModelConcat set $pname\n"; }

  if ($pname eq 'models') {
    my $models = $newval;
    $self->{'flags'} = undef;
    $self->{'offsets'} = ();
    %{$self->{'mhash'}} = (map {$_ => {}} @$models);
  }
}

# gtk_tree_model_get_flags
#
sub GET_FLAGS {
  my ($self) = @_;
  return ($self->{'flags'} ||= do {
    my $flags = [];
    my $models = $self->{'models'};
    if (@$models) {
      $flags = [ 'list-only' ];
      foreach my $model (@$models) {
        if (! ($model->get_flags & 'list-only')) {
          $flags = [];
          last;
        }
      }
    }
    $flags;
  });
}

# gtk_tree_model_get_n_columns
#
sub GET_N_COLUMNS {
  my ($self) = @_;
  my $model = $self->{'models'}->[0] || return 0;
  return $model->get_n_columns;
}

# gtk_tree_model_get_column_type
#
sub GET_COLUMN_TYPE {
  my ($self, $col) = @_;
  if (DEBUG) { print "TreeModelConcat get_column_type\n"; }
  my $model = $self->{'models'}->[0]
    or croak "No models";
  return $model->get_column_type ($col);
}

# gtk_tree_model_get_iter
#
sub GET_ITER {
  my ($self, $path) = @_;
  if (DEBUG) { print "TreeModelConcat get_iter ",$path->to_string,"\n"; }
  if ($path->get_depth == 0) { return undef; }

  my @indices = $path->get_indices;
  my $offset = 0;
  foreach my $model (@{$self->{'models'}}) {
    my $len = $model->iter_n_children (undef);
    if ($offset + $len > $indices[0]) {
      $indices[0] -= $offset;
      my $subpath = Gtk2::TreePath->new_from_indices (@indices);
      my $subiter = $model->get_iter ($subpath);
      return _subiter_to_iter ($self, $model, $subiter);
    }
  }
  return undef;
}

# gtk_tree_model_get_path
#
sub GET_PATH {
  my ($self, $iter) = @_;
  if (DEBUG) { print "TreeModelConcat get_path\n"; }
  my ($model, $subiter) = _iter_to_subiter ($self, $iter);
  my $subpath = $model->get_path;
  return _subpath_to_path ($self, $model, $subpath);
}

# gtk_tree_model_get_value
#
sub GET_VALUE {
  my ($self, $iter, $col) = @_;
  if (DEBUG) { print "TreeModelConcat get_value ",$iter->[1]," col=$col\n"; }
  use Data::Dumper;
  print Dumper($self);
  my ($model, $subiter) = _iter_to_subiter ($self, $iter);
  return $model->get_value ($subiter, $col);
}

# gtk_tree_model_iter_next
#
sub ITER_NEXT {
  my ($self, $iter) = @_;
  if (DEBUG) { print "TreeModelConcat iter_next\n"; }
  my ($model, $subiter) = _iter_to_subiter ($self, $iter);
  if (my $nextsubiter = $model->iter_next ($subiter)) {
    return _subiter_to_iter ($self, $model, $nextsubiter);
  }
  if ($model->iter_parent ($subiter)) {
    return undef; # not a top-level
  }

  # top-level, look for first of next model
  my $models = $self->{'models'};
  my $i = 0;
  for (;;) {
    if ($models->[$i] == $model) { last; }
    $i++;
    if ($i > $#$models) { die "oops, model not found"; }
  }
  for (;;) {
    $i++;
    $model = $models->[$i];
    if (! $model) { return undef; }

    $subiter = $model->get_iter_first;
    if ($subiter) {
      return _subiter_to_iter ($self, $model, $subiter);
    }
  }
}

# gtk_tree_model_iter_children
#
sub ITER_CHILDREN {
  my ($self, $iter) = @_;
  if (DEBUG) { print "TreeModelConcat iter_children\n"; }
  my ($model, $subiter) = _iter_to_subiter ($self, $iter);
  $subiter = $model->iter_children ($subiter);
  if (! $subiter) { return undef; }
  return _subiter_to_iter ($self, $model, $subiter);
}

# gtk_tree_model_iter_has_child
#
sub ITER_HAS_CHILD {
  my ($self, $iter) = @_;
  if (DEBUG) { print "TreeModelConcat has_child\n"; }
  my ($model, $subiter) = _iter_to_subiter ($self, $iter);
  # note Gtk2 prior to 1.183 demands numeric return (zero or non-zero)
  return ($model->has_child ($subiter) ? 1 : 0);
}

# gtk_tree_model_iter_n_children
#
sub ITER_N_CHILDREN {
  my ($self, $iter) = @_;
  if (DEBUG) { print "TreeModelConcat iter_n_children\n"; }
  if (defined $iter) {
    my ($model, $subiter) = _iter_to_subiter ($self, $iter);
    return $model->iter_n_children ($subiter);
  } else {
    my $total = 0;
    foreach my $model (@{$self->{'models'}}) {
      $total += $model->iter_n_children (undef);
    }
    return $total;
  }
}

# gtk_tree_model_iter_nth_child
#
sub ITER_NTH_CHILD {
  my ($self, $iter, $n) = @_;
  if (DEBUG) { print "TreeModelConcat iter_nth_child $n\n"; }
  my ($model, $subiter) = _iter_to_subiter ($self, $iter);
  $subiter = $model->iter_nth_child ($subiter);
  if (! $subiter) { return undef; }
  return _subiter_to_iter ($self, $model, $subiter);
}

# gtk_tree_model_iter_parent
#
sub ITER_PARENT {
  my ($self, $iter) = @_;
  if (DEBUG) { print "TreeModelConcat iter_parent\n"; }
  my ($model, $subiter) = _iter_to_subiter ($self, $iter);
  $subiter = $model->iter_nth_child ($subiter);
  if (! $subiter) { return undef; }
  return _subiter_to_iter ($self, $model, $subiter);
}

#------------------------------------------------------------------------------

sub _do_row_changed {
  my ($model, $subpath, $subiter, $ref_weak_self) = @_;
  my $self = $$ref_weak_self || return;
  if (DEBUG) { print "TreeModelConcat row_changed\n";}

  # old iters no good after a signal
  unless ($model->get_flags & 'iters-persist') {
    $self->{'mhash'}->{$model} = ();
  }

  my $iter = _subiter_to_iter ($self, $model, $subiter);
  my $path = _subpath_to_path ($self, $model, $subpath);
  $self->row_changed ($path, $iter);
}

sub _do_row_inserted {
  my ($model, $subpath, $subiter, $ref_weak_self) = @_;
  my $self = $$ref_weak_self || return;
  if (DEBUG) { print "TreeModelConcat row_inserted\n";}

  $self->{'mhash'}->{$model} = (); # new numbering
  if ($subpath->get_depth == 0) {
    $self->{'offsets'} = ();       # new sizes
  }

  my $iter = _subiter_to_iter ($self, $model, $subiter);
  my $path = _subpath_to_path ($self, $model, $subpath);
  $self->row_inserted ($path, $iter);
}

sub _do_row_deleted {
  my ($model, $subpath, $ref_weak_self) = @_;
  my $self = $$ref_weak_self || return;
  if (DEBUG) { print "TreeModelConcat row_deleted\n";}

  $self->{'mhash'}->{$model} = (); # new numbering
  if ($subpath->get_depth == 0) {
    $self->{'offsets'} = ();       # new sizes
  }

  $self->row_deleted (_subpath_to_path ($self, $model, $subpath));
}

sub _do_rows_reordered {
  my ($model, $subpath, $subiter, $subaref, $ref_weak_self) = @_;
  my $self = $$ref_weak_self || return;
  if (DEBUG) { print "TreeModelConcat rows_reordered\n";}

  $self->{'mhash'}->{$model} = (); # new numbering

  my $aref;
  if ($subpath->get_depth == 0) {
    # top-level, $aref->[$newpos] == $oldpos, must apply offset to both pos
    my $offset = _model_offset ($self, $model);
    $aref = [ 0 .. $offset-1, map {$_+$offset} @$subaref ]
  } else {
    # sub-level
    $aref = $subaref;
  }

  my $iter = _subiter_to_iter ($self, $model, $subiter);
  my $path = _subpath_to_path ($self, $model, $subpath);
  $self->rows_reordered ($path, $iter, $aref);
}

#------------------------------------------------------------------------------

sub _subpath_to_path {
  my ($self, $model, $subpath) = @_;
  my @indices = $subpath->get_indices;
  if (@indices) { $indices[0] += _model_offset ($self, $model); }
  return Gtk2::TreePath->new_from_indices (@indices);
}

sub _model_offset {
  my ($self, $model) = @_;
  my $offset = $self->{'offsets'}->{$model};
  if (defined $offset) { return $offset; }
  return ($self->{'offsets'}->{$model} = do {
    my $offset = 0;
    foreach my $m (@{$self->{'models'}}) {
      if ($m == $model) { last; }
      $offset += $m->iter_n_children(undef);
    }
  });
}

sub _iter_to_subiter {
  my ($self, $iter) = @_;
  use Data::Dumper;
  print Dumper($iter);
  if (! defined $iter) {
    croak;
    return ($self->{'models'}->[0], undef);
  }
  if ($iter->[0] != $self+0) {
    croak "iter is not for this ".ref($self)
      ." (id ",$iter->[0]," want ",$self+0,")\n";
  }
  my $a = $iter->[2];
  if (DEBUG) { print "  extract subiter ",$a->[0]," ",$a->[1],"\n"; }
  return @$a;  # (model, subiter)
}

sub _subiter_to_iter {
  my ($self, $model, $subiter) = @_;
  my $path = $model->get_path ($subiter);
  my $pstr = $path->to_string;
  my $mh = $self->{'mhash'}->{$model};
  my $a = ($mh->{$pstr} ||= [ $model, $subiter ] );
  print Dumper($a);
  print Dumper($mh);
  if (DEBUG) { print "  make iter [$model,$subiter]\n"; }
  use Data::Dumper;
  print Dumper($self);
  return [ $self+0, 0, $a, undef ];
}

#------------------------------------------------------------------------------

1;
__END__