# ported from Tim-Phillip Mueller's Tree View tutorial,
# http://scentric.net/tutorial/sec-custom-models.html
#

package CustomList;

use Gtk2;
use Carp;
use Data::Dumper;
use strict;
use warnings;

# maybe bad style, but makes life a lot easier
use base Exporter::;

our @EXPORT = qw/
	CUSTOM_LIST_COL_RECORD
	CUSTOM_LIST_COL_NAME
	CUSTOM_LIST_COL_YEAR_BORN
	CUSTOM_LIST_N_COLUMNS
/;

# The data columns that we export via the tree model interface

use constant CUSTOM_LIST_COL_RECORD    => 0;
use constant CUSTOM_LIST_COL_NAME      => 1;
use constant CUSTOM_LIST_COL_YEAR_BORN => 2;
use constant CUSTOM_LIST_N_COLUMNS     => 3;

use constant TRUE  => 1;
use constant FALSE => 0;

#
#  here we register our new type and its interfaces
#  with the type system. If you want to implement
#  additional interfaces like GtkTreeSortable, you
#  will need to do it here.
#

use Glib::Object::Subclass
	Glib::Object::,
	interfaces => [ Gtk2::TreeModel:: ],
	;

#
# this is called everytime a new custom list object
# instance is created (we do that in custom_list_new).
# Initialise the list structure's fields here.
#

sub INIT_INSTANCE {
	my $self = shift;
	$self->{n_columns} = CUSTOM_LIST_N_COLUMNS;
	$self->{column_types} = [
		'Glib::Scalar',	# CUSTOM_LIST_COL_RECORD
		'Glib::String',	# CUSTOM_LIST_COL_NAME
		'Glib::Uint',	# CUSTOM_LIST_COL_YEAR_BORN
	];
	$self->{rows}     = [];

	# Random int to check whether an iter belongs to our model
	$self->{stamp} = sprintf '%d', rand (1<<31);

}


#
#  this is called just before a custom list is
#  destroyed. Free dynamically allocated memory here.
#

sub FINALIZE_INSTANCE {
	my $self = shift;

	# free all records and free all memory used by the list
	#warning IMPLEMENT
}


# 
#   tells the rest of the world whether our tree model
#   has any special characteristics. In our case,
#   we have a list model (instead of a tree), and each
#   tree iter is valid as long as the row in question
#   exists, as it only contains a pointer to our struct.
#

#sub GET_FLAGS { [qw/list-only iters-persist/] }
sub GET_FLAGS { [qw/list-only/] }


#
# tells the rest of the world how many data
# columns we export via the tree model interface
#

sub GET_N_COLUMNS { shift->{n_columns}; }


#
# tells the rest of the world which type of
# data an exported model column contains
#

sub GET_COLUMN_TYPE {
	my ($self, $index) = @_;
	# and invalid index will send undef back to the calling XS layer,
	# which will croak.
	return $self->{column_types}[$index];
}


# 
# converts a tree path (physical position) into a
# tree iter structure (the content of the iter
# fields will only be used internally by our model).
# We simply store a pointer to our CustomRecord
# structure that represents that row in the tree iter.
# 

sub GET_ITER {
	my ($self, $path) = @_;

	die "no path" unless $path;

	my @indices = $path->get_indices;
	my $depth   = $path->get_depth;

	# we do not allow children
	# depth 1 = top level; a list only has top level nodes and no children
	die "depth != 1" unless $depth == 1;

	my $n = $indices[0]; # the n-th top level row 

	return [] if $n >= @{$self->{rows}} || $n < 0;

	my $record = $self->{rows}[$n];

	die "no record" unless $record;
	die "bad record" unless $record->{pos} == $n;

	# We simply store a pointer to our custom record in the iter
	return [ $self->{stamp}, $record, undef, undef ];
}


#
#  custom_list_get_path: converts a tree iter into a tree path (ie. the
#                        physical position of that row in the list).
#

sub GET_PATH {
	my ($self, $iter) = @_;
	die "no iter" unless $iter;

	my $record = $iter->[0];

	my $path = Gtk2::TreePath->new;
	$path->append_index ($record->{pos});
	return $path;
}


#
# custom_list_get_value: Returns a row's exported data columns
#                        (_get_value is what gtk_tree_model_get uses)
#

sub GET_VALUE {
	my ($self, $iter, $column) = @_;

	die "bad iter" unless $iter;

	return undef unless $column < @{$self->{column_types}};

	my $record = $iter->[1];

	return undef unless $record;

	die "bad iter" if $record->{pos} >= @{$self->{rows}};

	if ($column == &CUSTOM_LIST_COL_RECORD) {
		return $record;
	} elsif ($column == &CUSTOM_LIST_COL_NAME) {
		return $record->{name};
	} elsif ($column == &CUSTOM_LIST_COL_YEAR_BORN) {
		return $record->{year_born};
	}
}


#
# iter_next: Takes an iter structure and sets it to point to the next row.
#

sub ITER_NEXT {
	my ($self, $iter) = @_;

	return undef
		unless $iter && $iter->[1];

	my $record = $iter->[1];

	# Is this the last record in the list?
	return undef
		if $record->{pos} >= @{ $self->{rows} };

	my $nextrecord = $self->{rows}[$record->{pos} + 1];

	return undef unless $nextrecord;
	die "invalid record" unless $nextrecord->{pos} == ($record->{pos} + 1);

	return [ $self->{stamp}, $nextrecord, undef, undef ];
}


#
# iter_children: Returns TRUE or FALSE depending on whether the row
#                specified by 'parent' has any children.  If it has
#                children, then 'iter' is set to point to the first
#                child.  Special case: if 'parent' is undef, then the
#                first top-level row should be returned if it exists.
#

sub ITER_CHILDREN {
	my ($self, $parent) = @_;

###	return undef unless $parent and $parent->[1];

	# this is a list, nodes have no children
	return undef if $parent;

	# parent == NULL is a special case; we need to return the first top-level row

 	# No rows => no first row
	return undef unless @{ $self->{rows} };

	# Set iter to first item in list
	return [ $self->{stamp}, $self->{rows}[0] ];
}


#
# iter_has_child: Returns TRUE or FALSE depending on whether
#                 the row specified by 'iter' has any children.
#                 We only have a list and thus no children.
#

sub ITER_HAS_CHILD { FALSE }

#
# iter_n_children: Returns the number of children the row specified by
#                  'iter' has. This is usually 0, as we only have a list
#                  and thus do not have any children to any rows.
#                  A special case is when 'iter' is undef, in which case
#                  we need to return the number of top-level nodes, ie.
#                  the number of rows in our list.
#

sub ITER_N_CHILDREN {
	my ($self, $iter) = @_;

	# special case: if iter == NULL, return number of top-level rows
	return scalar @{$self->{rows}}
		if ! $iter;

	return 0; # otherwise, this is easy again for a list
}


#
# iter_nth_child: If the row specified by 'parent' has any children,
#                 set 'iter' to the n-th child and return TRUE if it
#                 exists, otherwise FALSE.  A special case is when
#                 'parent' is NULL, in which case we need to set 'iter'
#                 to the n-th row if it exists.
#

sub ITER_NTH_CHILD {
	my ($self, $parent, $n) = @_;

	# a list has only top-level rows
	return undef if $parent;

	# special case: if parent == NULL, set iter to n-th top-level row

	return undef if $n >= @{$self->{rows}};

	my $record = $self->{rows}[$n];

	die "no record" unless $record;
	die "bad record" unless $record->{pos} == $n;

	return [ $self->{stamp}, $record ];
}


#
# iter_parent: Point 'iter' to the parent node of 'child'.  As we have a
#              a list and thus no children and no parents of children,
#              we can just return FALSE.
#

sub ITER_PARENT { FALSE }

#
# ref_node and unref_node get called as the model manages the lifetimes
# of nodes in the model.  you normally don't need to do anything for these,
# but may want to if you plan to implement data caching.
#
#sub REF_NODE { warn "REF_NODE @_\n"; }
#sub UNREF_NODE { warn "UNREF_NODE @_\n"; }

#
# new:  This is what you use in your own code to create a
#       new custom list tree model for you to use.
#

# we inherit new from Glib::Object::Subclass


#
# append_record:  Empty lists are boring. This function can be used in your
#                 own code to add rows to the list.  Note how we emit the
#                 "row-inserted" signal after we have appended the row
#                 so the tree view and other interested objects know about
#                 the new row.
#

sub append_record {
	my ($self, $name, $year_born) = @_;

	croak "usage: \$list->append_record (NAME, YEAR_BORN)"
  		unless $name;

	my $newrecord = {
		name => $name,
#		name_collate_key => g_utf8_collate_key(name,-1), # for fast sorting, used later
		year_born => $year_born,
	};

	push @{ $self->{rows} }, $newrecord;
	$newrecord->{pos} = @{$self->{rows}} - 1;

	# inform the tree view and other interested objects
	# (e.g. tree row references) that we have inserted
	# a new row, and where it was inserted

	my $path = Gtk2::TreePath->new;
	$path->append_index ($newrecord->{pos});
	$self->row_inserted ($path, $self->get_iter ($path));
}

############################################################################
############################################################################
############################################################################

package main;

no strict 'subs';
use Gtk2 -init;
use constant TRUE  => 1;
use constant FALSE => 0;

import CustomList;

sub fill_model {
	my $customlist = shift;

	my @firstnames = qw(Joe Jane William Hannibal Timothy Gargamel);
	my @surnames   = qw(Grokowich Twitch Borheimer Bork);

	foreach my $sname (@surnames) {
		foreach my $fname (@firstnames) {
			$customlist->append_record ("$fname $sname",
			                            1900 + rand (103.0))
		}
	}
}

sub create_view_and_model {
  my $customlist = CustomList->new;
  fill_model ($customlist);

  my $view = Gtk2::TreeView->new ($customlist);

  my $renderer = Gtk2::CellRendererText->new;
  my $col = Gtk2::TreeViewColumn->new;

  $col->pack_start ($renderer, TRUE);
  $col->add_attribute ($renderer, text => &CustomList::CUSTOM_LIST_COL_NAME);
  $col->set_title ("Name");
  $view->append_column ($col);

  $renderer = Gtk2::CellRendererText->new;
  $col = Gtk2::TreeViewColumn->new;
  $col->pack_start ($renderer, TRUE);
  $col->add_attribute ($renderer, text => &CustomList::CUSTOM_LIST_COL_YEAR_BORN);
  $col->set_title ("Year Born");
  $view->append_column ($col);

  return $view;
}

{
  my $window = Gtk2::Window->new;
  $window->set_default_size (200, 400);
  $window->signal_connect (delete_event => sub {Gtk2->main_quit; 0});

  my $scrollwin = Gtk2::ScrolledWindow->new;

  my $view = create_view_and_model();

  $scrollwin->add ($view);
  $window->add ($scrollwin);

  $window->show_all;

  Gtk2->main;

  exit 0;
}


############################################################################
############################################################################
############################################################################