of class C, that contains one or more C

of class C. Each row contains C elements for each linked word. If words were supplied without links, they are contained in C elements. Colouring and font-sizing is contained in the C and C C\n"; } sub html { my $self = shift; $self->{limit} = $_[0] if $_[0]; my $out = "\n\n"; return $out; } # Move into sub html sub tags { my $self = shift; $self->{limit} = $_[0] if $_[0]; $self->_build unless $self->{inputs}; my $c = 0; my $t = scalar( @{ $self->{words} } ); my @rv; my $blank = quotemeta BLANK; my $re = qr/^$blank+$/; for my $y (1..$self->{size_y} ){ for my $x (1..$self->{size_x} ){ next if not defined $self->{grid}->[$x-1]->[$y-1] or $self->{grid}->[$x-1]->[$y-1] eq BLANK; my $w = $self->{grid}->[$x-1]->[$y-1]; push @rv, { %$w, count => $t - $c, level => $c, }; $c ++; } } return @rv; } sub _prepare { my $self = shift; die "No words from which to create a cloud - see add(...)." unless $self->{words} and scalar @{ $self->{words} }; # Custom size does not work yet #if (not $self->{size_x} and not $self->{size_y}){ $self->{size_y} = $self->{size_x} = int( sqrt(scalar @{$self->{words}})) +1; #} $self->{inputs} = [@{ $self->{words} }]; $self->{grid} = []; $self->{tags} = []; # HTML::TagCloud API $self->{size_max_pc} ||= 120; $self->{size_min_pc} ||= $self->{size_max_pc} / 2; $self->{scale_code} ||= sub { ($self->{size_max_pc} - $self->{size_min_pc}) / scalar @{$self->{words}}; }; $self->{scale_f} = $self->{scale_code}->($self); for my $y (1..$self->{size_y}){ $self->{grid}->[$y-1] = []; for my $x (1..$self->{size_x}){ $self->{grid}->[$y-1]->[$x-1] = BLANK; } } # If inputs supplied as words: foreach my $w (@{ $self->{inputs} } ){ if (not ref $w){ $w = new HTML::TagCloud::Centred::Word( %$w ); $w->{html_esc_code} = $self->{html_esc_code} if $self->{html_esc_code}; } } # For API of HTML::TagCloud if (exists $self->{limit}){ $self->{inputs} = [ @{ $self->{inputs} } [ 0 .. $self->{limit} -1 ] ]; } return $self; } # Naive spiral - 1,1,2,2,3,3,..N,N. Replace! sub _build { my $self = shift; $self->_prepare; my $x = int ($self->{size_x} / 2); # Centre starting position my $y = int ($self->{size_y} / 2); # Centre starting position my @d = ( # Direction of turns [1, 0], [0, 1], [-1, 0], [0, -1] ); my $tside = 0; # Total sides so far my $cside = 0; # Current side, index to @d my $length = 1; # Length of current side my @clrs; # Color palette if requested if ($Color::Spectrum::VERSION){ @clrs = Color::Spectrum::generate( scalar( @{ $self->{inputs} } ), $self->{clr_max}, $self->{clr_min} ); } while (@{ $self->{inputs} } ){ my $add_x = ($length * $d[ $cside ]->[0] ); my $add_y = ($length * $d[ $cside ]->[1] ); $self->_create_side( from_x => $x, from_y => $y, to_x => $x + $add_x, to_y => $y + $add_y, (@clrs? (clrs => \@clrs) : ()), ); $x += $add_x; $y += $add_y; DEBUG "For $tside $cside, X $x, Y $y \n\tadd to x $add_x; add to y $add_y \n"; # Increase length every second side $length += 1 if $cside % 2; # Next side if (++$cside == 4){ $cside = 0; } $tside++; } } sub _create_side { my ($self, $args) = (shift, ref($_[0])? shift : {@_}); my ($from_x, $from_y, $to_x, $to_y); if ($args->{from_x} > $args->{to_x}){ $from_x = $args->{to_x}; $to_x = $args->{from_x}; } else { $from_x = $args->{from_x}; $to_x = $args->{to_x}; } if ($args->{from_y} > $args->{to_y}){ $from_y = $args->{to_y}; $to_y = $args->{from_y}; } else { $from_y = $args->{from_y}; $to_y = $args->{to_y}; } DEBUG "From X $from_x -> $to_x;From Y $from_y -> $to_y"; WORDS: for my $x ($from_x .. $to_x){ for my $y ($from_y .. $to_y){ # TRACE $x-1, ', ', $y-1; next if not $self->{grid}->[ $x-1 ]->[ $y-1 ]; next if $self->{grid}->[ $x-1 ]->[ $y-1 ] ne BLANK; last WORDS if not @{ $self->{inputs} }; my $word = shift @{ $self->{inputs} }; DEBUG " set $x $y = $word->{name}"; $word->{clr} = $args->{clr} if $args->{clr}; $word->{x} = $x-1; $word->{y} = $y-1; $word->{size} = int $self->{size_min_pc} + ( $self->{scale_f} * (1 + scalar @{ $self->{inputs} })); $word->{clr} = shift( @{$args->{clrs}}) if $args->{clrs}; $self->{grid}->[ $x-1 ]->[ $y-1 ] = $word; } } } package HTML::TagCloud::Centred::Word; use base 'HTML::TagCloud::Centred::Base'; sub _init { my $self = shift; $self->{html_esc_code} ||= sub { if (require CGI::Util){ return CGI::Util::escape(shift)} return shift; }; die "No 'name'?" if not defined $self->{name}; } sub html { my $self = shift; my $ctag = 'span'; my $otag = $ctag; my $name = $self->{html_esc_code}->( $self->{name} ); if (defined $self->{url}){ $ctag = 'a'; $otag = "a href='$self->{url}' title='$name'"; } my $clr = defined($self->{clr})? 'color:'.$self->{clr} : ''; return "<$otag style='$clr; font-size:$self->{size}%'>$name"; } 1; =head1 SEE ALSO L. =head1 AUTHOR AND COPYRIGHT Copyright (C) Lee Goddard, 2010-2011. All Rights Reserved. This distribution is made available under the same terms as Perl.