# 0=>A, B=>1, C=>2, D=>3, E=>4, F=>5
  # A joins
  $chat->tick(0, $stamp+0);
  # B joins
  $chat->tick(1, $stamp+1);
  # C joins
  $chat->tick(2, $stamp+2);
  # D joins
  $chat->tick(3, $stamp+3);
  # ...Time passes...
  # E joins
  $chat->tick(4, $stamp+10000+0);
  # F joins
  $chat->tick(4, $stamp+10000+1);

  # Get the colors:
  local $_;
  print "$_: " . join ", ", $chat->color($_) for 0..5;

##</code><code>##

  # 0=>A, B=>1, C=>2, D=>3, E=>4, F=>5
  # A joins
  $chat->tick(0, $stamp+0);
  print "A: " . join ", ", $chat->color(0);
  # B joins
  $chat->tick(1, $stamp+1);
  print "B: " . join ", ", $chat->color(1);
  # etc.

##</code><code>##

package Heinz::Colors;

use warnings;
use strict;

# FADE_AWAY specifies the time in seconds after a nick is considered away/left.
use constant FADE_AWAY => 3600 * 2;
use constant DEBUG     => 0;

sub new { bless [
  {}, # current
  [], # interference graph
  [], # total number of people "met"
  [], # color_id
] => shift }

# $chat->tick(3, 1092927374) marks person id 3 as present at unix-time
# 1092927374.
sub tick {
  my ($self, $id, $time) = @_;

  # First, we fade out persons who haven't said anything for FADE_AWAY seconds.
  $self->fade($time);

  # Mark $id as involved in a conversation.
  # If $self->cur->{$id} was false before the next line, the person just
  # joined.
  $self->cur->{$id} = $time;
  # keys %{ $self->cur } is now a list of "active people".

  # Now we update our interference graph $self->i.
  local $_;

  # Make sure we don't get ...is not a hashref... errors.
  $self->i->[$id] ||= {};
  # If $self->i->[$a]->{$b} is true, persons $a and $b have "met" each other,
  # i.e. they said sth. in the same time window.

  # For everbody who's online ATM...
  for (keys %{ $self->cur }) {
    # ...mark $_ and $id as persons who have "met" each other.
    $self->i->[$id]->{$_}  = 1;
    $self->i->[$_] ->{$id} = 1;
  }
}

# $chat->fade(1092927374) fades all people away which haven't said anything for
# FADE_AWAY seconds.
sub fade {
  my ($self, $time) = @_;

  local $_;

  # $self->cur is a hashref. If $self->cur->{$id} has a true value, person $id
  # is currently involved in a conversation.
  # We delete everybody who hasn't said anything for FADE_AWAY seconds.
  for(keys %{ $self->cur }) {
    delete $self->cur->{$_} if $time - $self->cur->{$_} >= FADE_AWAY;
  }
  # delete()ing keys of a hash which is iterated over is safe as long as the
  # key which is deleted is the current key.
}

# Calculate the "total number" of people $id met.
# Example (left-to-right: time):

# 
#   AAAAAAAAAAAAAAAAAAA
#      BBB      
#              CCCC    +--- No connection between A..E and F,G!
#       DDDDD          |
#          EEEEEEE     v
#                        FFFFFFF
#                          GGGGGGG
# 
# "Total number" count of A,B,C,D,E: 5
# "Total number" count of F,G:       2
# 
# The interference graph for this example is:
# 
#  4/5 E        0/2   1/2
#       \         F---G
#        \
#     0/5 A---B 1/5
#        / \
#       /   \
#  3/5 D     C 2/5
# 
# The "total number" of $id is the number of nodes in the graph $id is in.
# The color_id/total_number pair is what we have to calculate (calc_color needs
# color_id and total_number as arguments).
sub collapse {
  my ($self, $id) = @_;

  # %visited is a hash of nodes we visited. If $visited{$a} is true, we visited
  # node $a. That's necessary to break the recursion.
  my %visited;

  # $recurse is a coderef. It marks $iid, its first argument, as visited and
  # visits all nodes $iid is connected to.
  my $recurse; $recurse = sub {
    my $iid = shift;
    $visited{$iid} = 1;

    foreach my $iiid (keys %{ $self->i->[$iid] || {} }) {
      # Break the recursion: unless $visited{$iiid} -- Don't visit nodes we
      # already visited.
      $recurse->($iiid) unless $visited{$iiid};
    }
  };

  # Start.
  $recurse->($id);

  # The "total number" is the number of people we visited.
  my $count = keys %visited;

  # Now, assign color_ids. We have to sort keys %visited so we get the same
  # color_ids each time we execute da script.
  my $i = 0;
  foreach my $iid (sort { $a <=> $b } keys %visited) {
    # $self->met: "Total number"
    $self->met->[$iid] = $count;

    # $self->col: color_id
    $self->col->[$iid] = $i++;
  }
}

# Return the color (C< ("#foreground", "#background") >) of person $id.
sub color {
  my ($self, $id) = @_;

  # If we haven't calculated the total number of people $id met, do that now.
  $self->collapse($id) unless $self->met->[$id];

  # Fetch the values $self->collapse calculated.
  my ($me, $total) = ($self->col->[$id], $self->met->[$id] - 1);

  # And execute calc_color.
  return $self->calc_color($me, $total);
}

# calc_color copied from irclog2html.pl
# (http://freshmeat.net/projects/irclog2html.pl/), Copyleft (C) 2000-2002 Jeff
# Waugh, licensed under the Terms of the GNU General Public License, version 2
# or higher.
# calc_color expects the total number of colors to assign ($_[2]) and the color
# id ($_[1]) and returns a HTML-("#foreground", "#background")-pair with nice
# contrast etc.
# Take calc_color as a sub w/o errors.

sub calc_color {
  my ($self, $i, $ncolors) = @_;
    $ncolors = 1 if $ncolors == 0; # No division /0.

  my $a = 0.95;     # tune these for the starting and ending concentrations of R,G,B
  my $b = 0.5;
  my $rgb = [ [$a,$b,$b], [$b,$a,$b], [$b,$b,$a], [$a,$a,$b], [$a,$b,$a], [$b,$a,$a] ];
  my $rgbmax = 125;   # tune these two for the outmost ranges of colour depth
  my $rgbmin = 240;

  my $n = $i % @$rgb;
  my $m = $rgbmin + ($rgbmax - $rgbmin) * ($ncolors - $i) / $ncolors;

  my @c = map { $rgb->[$n][$_] * $m } 0 .. 2;
  my $g = $c[0] * .3 + $c[1] * .59 + $c[2] * .11;
  my $f = $g > 127 ? "#000000" : "#ffffff";
  my $h = sprintf "#%02x%02x%02x", @c;

  ($f, $h);
}

sub cur : lvalue { $_[0]->[0] }
sub i   : lvalue { $_[0]->[1] }
sub met : lvalue { $_[0]->[2] }
sub col : lvalue { $_[0]->[3] }

1;