view release on metacpan or  search on metacpan

lib/Games/Quake/Stats.pm  view on Meta::CPAN

	    print "     " . $player_fragged->name() . " " . $player->times_fragged_player($player_fragged->name()) . "\n";
	}	
    }    
    return 1;
}



#-----------------------------------------------------------------------
#
# generate_graph
#
#-----------------------------------------------------------------------
sub generate_stats_graph
{
    my ($self, $graph_file) = @_;
    my $players = $self->{_players};

    if(!$graph_file){
	$graph_file = $self->{_stats_graph};	
    }

    my $data_ref = [];
    my @player_names;    
    my $max_y = 0;
    
    push(@player_names, "total  (- self-inflicted)");

    foreach my $player_name (sort(keys %$players)){

	my $player = $players->{$player_name};

	push(@player_names, $player->name());
	push(@{$data_ref->[0]}, $player->name());

	my $total_frags = $player->total_frags();
       	push(@{$data_ref->[1]}, $total_frags);	
	if ($total_frags > $max_y){
	    $max_y = $total_frags;
	}

	my $i = 2;
	foreach my $player_fragged_name (sort(keys %$players)){	    

	    my $player_fragged = $players->{$player_fragged_name};	    
	    my $times_fragged_player = $player->times_fragged_player($player_fragged->name());
	    
	    push(@{$data_ref->[$i]}, $times_fragged_player);
	    $i++;
	}	
    }
    
    my $my_graph = GD::Graph::hbars->new(550,550);
    
    $my_graph->set(
	x_label  =>  'player',
	y_label  =>  'frags',
	title    =>  'manliness',
	bar_spacing => 1,
	bargroup_spacing => 10, 
	legend_spacing => 3,
	legend_placement  => 'RT',
	show_values       => 1,
	y_max_value       => $max_y + int($max_y/10),
        #x_label_position   => 0,
	dclrs => [ ( "orange", "lgreen", "#0050FF", "dgreen", "#00BBBB", 
		     "dblue", "dred", "blue", "dpurple", "lgray"  ) ],
	) or warn $my_graph->error;


    $my_graph->set_legend(@player_names);
    $my_graph->plot($data_ref) or croak $my_graph->error;
    my $ext = $my_graph->export_format;
    my $outfile;
    open($outfile, ">$graph_file") or croak "Could not open $graph_file: $!\n";
    binmode $outfile;
    print $outfile $my_graph->gd->$ext();    
    close $outfile;
    
}


#-----------------------------------------------------------------------
#
# generate_skill_graph
#
#-----------------------------------------------------------------------
sub generate_skill_graph
{
    my ($self, $skill_graph_file) = @_;
    my $players = $self->{_players};

    if(!$skill_graph_file){
	$skill_graph_file = $self->{_skill_graph};	
    }

    my $data_ref = [];
    my @player_names;    
    my $max_y = 0;
    
    push(@player_names, "skill (frags/fragged * 100)");

    foreach my $player_name (sort(keys %$players)){
	
	my $player = $players->{$player_name};
	push(@player_names, $player_name);
	push(@{$data_ref->[0]}, $player_name);
	my $skill = sprintf("%0.2f", $player->{_skill} * 100);	
	push(@{$data_ref->[1]}, $skill);	
	if ($skill > $max_y){
	    $max_y = $skill;
	}
    }
    
    my $my_graph = GD::Graph::hbars->new(550,550);
   
    $my_graph->set(
	x_label  =>  'player',
	y_label  =>  'skill (% frags/fragged)',
	title    =>  'skill',
	bar_spacing => 1,
	bargroup_spacing => 50, 
	legend_spacing => 5,
	legend_placement  => 'RT',
	show_values       => 1,
	y_max_value       => $max_y + int($max_y/10),
        #x_label_position   => 0,
	dclrs => [ ( "#017797", "dpurple", "dred", "dgreen", "blue", "green", 
		     "lblue", "dgray", "dgreen", "dblue", "marine" ) ],
	) or warn $my_graph->error;
    

    $my_graph->set_legend(@player_names);
    $my_graph->plot($data_ref) or croak $my_graph->error;
    my $ext = $my_graph->export_format;
    my $outfile;

    open($outfile, ">$skill_graph_file") or croak "Could not open $skill_graph_file: $!\n";
    binmode $outfile;
    
    print $outfile $my_graph->gd->$ext();    
    close $outfile;    
}




#-----------------------------------------------------------------------
#
# generate_html
#
#-----------------------------------------------------------------------
sub generate_html{

    my ($self, $graph_base_url) = @_;

    my $players = $self->{_players};

    my $graph_file = $self->{_stats_graph};
    my $skill_graph_file = $self->{_skill_graph};
    my $graph_file_short;
    my $skill_graph_file_short;

    if($graph_file){
	my @path_components = split('/', $graph_file);
	$graph_file_short = pop(@path_components);
    }
    if($skill_graph_file){
	my @path_components = split('/', $skill_graph_file);
	$skill_graph_file_short = pop(@path_components);
    }
	
    print "<HTML>\n";
    print "<HEAD><TITLE>frag log statistics</TITLE></HEAD>\n";
    print "<BODY>\n";
    print "<H2><font face='courier'>frag log statistics</font></H2>";
    print "<TABLE cellpadding=0 cellspacing=0><TR><TD>\n";
    if($graph_file_short){
	print "<IMG src='" . $graph_base_url . $graph_file_short . "'></IMG>\n";
    }
    print "</TD><TD>\n";
    if($skill_graph_file_short){
	print "<IMG src='" . $graph_base_url . $skill_graph_file_short . "'></IMG>\n";
    }
    print "</TD></TR></TABLE>\n";
    print "<BR><BR><font face='courier' size=-1><b><i>the numbers don't lie</i></b></font><BR>";
    print "<PRE>\n";


    foreach my $player_name (sort(keys %$players)){	
	
	my $player = $players->{$player_name};
	my $total_frags = $player->total_frags();