#! /usr/bin/perl -w


# Ham Radio Country info module scoring.pm by PA0R.

# This program is published under the GPL license.
#   Copyright (C) 2005, 2006
#       Rein Couperus PA0R (rein@couperus.com)
# 
# *    scoring.pm 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 2 of the License, or
# *    (at your option) any later version.
# *
# *    scoring.pm 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 this program; if not, write to the Free Software
# *    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

# Date: 04-04-06

use Switch;
use rules;
use cqzones;
use ituzones;
use yudx;
use result;
use sections;
use qso;
use iota;
use foc;
use prefix;
use wysiwyg;


#############################################
sub setmults { 	#input $call, $band
#############################################
	my ($call, $band, $mode, $country, $comment) = @_;

my @mults;
my $countrymult;
my $cqzonemult; 

	addqso($band);
	if ($mode eq "CW ") { 
		addcwqso($band);
	} elsif ($mode eq "SSB") { 
		addssbqso($band);
	}

 
######### country & cq zone ############################# (cqww)
	if ($mult1 eq "country" && $mult2 eq "cqzone") {
		$countrymult = addcountry($country, $band);
		
		$cqzonemult = addcqzone($comment, $band);
				
		if ($countrymult == 1 || $cqzonemult == 1) {
			@info = getinfo($call);
		}
		
		if ($countrymult == 1) {
			push @mults, $info[7]; # prefix
		} else {
			push @mults, "";
		}
		
		if ($cqzonemult == 1) {
			push @mults, $comment;
		} else {
			push @mults, "";
		}
		return @mults;		# returns 'mult1', 'mult2'
	}	# end country & cqzone 
######### country ############################# (fd)
	if ($mult1 eq "country" && $mult2 eq "none") {
		$countrymult = addcountry($country, $band);
						
		if ($countrymult == 1) {
			@info = getinfo($call);
		}
		
		if ($countrymult == 1) {
			push @mults, $info[7]; # prefix
		} else {
			push @mults, "";
		}
		
			push @mults, "";
		return @mults;		# returns 'mult1', ''
	}	# end country
	
	
################# prefix ################################ (wpx)

	if ($mult1 eq "prefix") {
		
		@info = getinfo($call);
		my $prefix = $info[8]; # prefix
		$pfxmult = addprefix ($prefix);
		
		if ($pfxmult == 1) {
			push @mults, $prefix;
		}
		return @mults;
	
	} 
	
######## country & section, mults * continents ########## (spdxrtty, sqp)
	if ($mult1 eq "country" && $mult2 eq "section") {
	
		$countrymult = addcountry($country, $band);
		
		$sectionband = $band;									# single band
		if ($resultsmethod eq "sqp") { $sectionband = "99"}; 	# allband
		
		$sectionmult = addsection($comment, $sectionband);
		
		if ($countrymult == 1 ) {
			@info = getinfo($call);
		}
		
		if ($countrymult == 1) {
			push @mults, $info[7];
		} else {
			push @mults, "";
		}
		
		if ($sectionmult == 1) {
			push @mults, $comment;
		} else {
			push @mults, "";
		}
		return @mults;
	}
########  cw and ssb sections ########## (iota)
	if ($mult1 eq "cwssbsection") {

		if ($mode eq "CW ") { 
			$sectionmult = addcwsection($comment, $band);
		} elsif ($mode eq "SSB") { 
			$sectionmult = addssbsection($comment, $band);
		}

		if ($sectionmult == 1) {
			push @mults, $comment;
		} else {
			push @mults, "";
		}
		return @mults;
	}
####### FOC Marathon rules -- dj1yfk ##################################
	if ($mult1 eq "foc") {
		my @info = getinfo($call);				# $info[3] == continent
		my $tmp;
		&focaddqso($call);                          # for 5-band, 6-band check
		if ($tmp = &focdxcc($country,$info[3])) {   # new DXCC, cont?
			push @mults, $tmp;
		} elsif (&focfiver($call)) {				# 5-bander?
			push @mults, "5";
		} elsif (&focsixer($call)) {				# 6-bander?
			push @mults, "6";
		}
		return @mults;
	}	
####### YUDX: ITU-Zones and YU-PFXes are mults -- dj1yfk ##############
	if (($mult1 eq "ituzone") && ($mult2 eq "yupfx")) {
		
		# Check for new ITU-Zone, new YU-Prefix
		my $ituzonemult = addituzone($comment, $band);
		my $yupfxmult = addyupfxmult($call, $band);		# returns the pfx or ''
		
		if ($ituzonemult == 1) {
			push @mults, $comment;
		} else {
			push @mults, '';
		}
		if ($yupfxmult){
			push @mults, $yupfxmult;
		} else {
			push @mults, '';
		}
		
		return @mults;		# returns 'itu-mult', 'pfx-mult'
	}
####### IARU: ITU-Zones and HQ stns are mults  ##############
	if (($mult1 eq "ituzone") && ($mult2 eq "wysiwyg")) {
		
		# Check for new ITU-Zone, wysiwyg section
		my $wsection = addwsection($comment, $band);		# returns the section or ''

		$ituzonemult = 0;
 		$ituzonemult = addituzone($comment, $band) unless $wsection;
		if ($ituzonemult == 1) {
			push @mults, $comment;
		} else {
			push @mults, '';
		}
		if ($wsection){
			push @mults, $wsection;
		} else {
			push @mults, '';
		}
		
		return @mults;		# returns 'itu-mult', 'wsection'
	}
	if ($mult1 eq "none" && $mult2 eq "none") {
		push @mults, '';
		push @mults, '';
		return @mults;		# returns nothing
	}

} # end set mults

#############################################
sub setpoints {	#input $call, $band, $mode
#############################################
	my ($call, $band, $mode, $comment) = @_;
	
	my @owninfo = getinfo($Mycall);
	my @info = getinfo($call);
	my $points;
	switch ($pointsmethod) {
		case ["cqww", "spdxrtty"] {		 
			if ($info[10] == $owninfo[10]) {	# own country
				$points = $mycountrypoints;
			}elsif ($info[3] ne $owninfo[3]) {	# DX
				$points = $dxpoints;
			} else { 
				$points = $mycontinentpoints; # own continent
			}
		} 
		case ["fd"] {
			if ($info[10] == $owninfo[10]) {	# own country
				$points = $mycountrypoints;
			}elsif ($info[3] ne $owninfo[3]) {	# DX
				$points = $dxpoints;
			} else { 
				$points = $mycontinentpoints; # own continent
			}
			if (($call =~ /\/P$/) || ($call =~ /\/\d$/)) {
				$points *= 2;
			}
		} 
		case "iota" {
			if (myiota($comment2)) {
				$points = $myiotapoints;
			} elsif (is_iota($comment2)) {
				$points = $iotapoints;
			} else {
				$points = $noniotapoints;
			}
		}
		case "focmarathon" {
			$points =1;
		}
		case "yudx" {
			if ($info[2] == $owninfo[2]) {	# own itu zone
				$points = 1;
			}elsif ($info[3] ne $owninfo[3]) {	# DX
				$points = 5;
			} else { 
				$points = 3;					 # own continent
			}
		}
		case "iaru" {
		
			if ($info[2] == $owninfo[2] || 
				($comment !~ /\d*/)) {	# own itu zone or HQ
				$points = 1;
			}elsif ($info[3] ne $owninfo[3]) {	# DX
				$points = 5;
			} else { 
				$points = 3;					 # own continent
			}
		}
		case "wpx" {
			if ($info[10] == $owninfo[10]) {	# own country
				$points = $mycountrypoints;
			}elsif ($info[3] ne $owninfo[3]) {	# DX
				$points = $dxpoints;
			} else { 
				$points = $mycontinentpoints; # own continent
			}
			if ($band eq "160" || $band eq "80" || $band eq "40") {
				$points *= 2;				# for low bands
			}
		}
		case "cwssb" {
			if ($mode eq "CW ") {
				$points = $cwpoints;
			} elsif ($mode eq "SSB") {
				$points = $ssbpoints;
			}
			$points *= $powerfactor;		# qrp factor?
		}	
		case "general" {
				$points = 1;
		} else {
				$points = 0;
		}

	} 
		return $points;

} # end set points

#############################################
sub printresults {
#############################################
	my ($totalpoints, $resultsmethod) = @_;
	my ($qsos, $qsoprint);
	my $printlines;
		
	if ($resultsmethod eq "cqww") { 
		
		($qsos, $qsoprint) = qsos();
		$printlines = $qsoprint;
		
		($cties, $ctieprint) = cnt_countries();
		($zones, $zoneprint) = cnt_cqzones();
		
		$printlines .= $ctieprint;
		$printlines .= $zoneprint;
		
		$totalmults  = $cties + $zones;
		
		$score = $totalpoints * $totalmults;
	} elsif ($resultsmethod eq "fd") { 
		
		($qsos, $qsoprint) = qsos();
		$printlines = $qsoprint;
		
		($cties, $ctieprint) = cnt_countries();
		
		$printlines .= $ctieprint;
		
		$totalmults  = $cties;
		
		$score = $totalpoints * $totalmults;
		
	} elsif ($resultsmethod eq "spdxrtty") {
		
		($qsos, $qsoprint) = qsos();
		$printlines = $qsoprint;
		
		
		($cties, $ctieprint) = cnt_countries();
		($sections, $sectionprint) = cnt_sections();
		
		$printlines .= $ctieprint;
		$printlines .= $sectionprint;
		$printlines .= getcontinents_all();
		
		$totalmults  = $cties + $sections;
		$totalmults *= nr_continents_all(); # special for spdxrtty
		
		$score = $totalpoints * $totalmults;
		
	} elsif ($resultsmethod eq "iota"){

		($qsos, $qsoprint) = cwqsos();
		$printlines = $qsoprint;
		($qsos, $qsoprint) = ssbqsos();
		$printlines .= $qsoprint;
		
		($cwsections, $cwsectionprint) = cnt_cwsections();
		($ssbsections, $ssbsectionprint) = cnt_ssbsections();
		
		$printlines .= $cwsectionprint;
		$printlines .= $ssbsectionprint;
		
		$totalmults  = $cwsections + $ssbsections;
		$score = $totalpoints * $totalmults;
		
	} elsif ($resultsmethod eq "iaru"){

		($qsos, $qsoprint) = cwqsos();
		$printlines = $qsoprint;
		($qsos, $qsoprint) = ssbqsos();
		$printlines .= $qsoprint;
		
		($zones, $zoneprint) = cnt_ituzones();
		($wsections, $wsectionprint) = cnt_wsections();
		
		$printlines .= $wsectionprint;
		$printlines .= $zoneprint;
		
		$totalmults  = $wsections + $zones;
		$score = $totalpoints * $totalmults;
	
	} elsif ($resultsmethod eq "wpx") {
		($qsos, $qsoprint) = qsos();
		$printlines = $qsoprint;
		($pfxs, $pfxprint) = cnt_prefixes();
		
		$printlines .= $pfxprint;

		$totalmults = $pfxs;
		$score = $totalpoints * $totalmults;
		
	}  elsif ($resultsmethod eq "focmarathon") {
		($qsos, $qsoprint) = qsos();
		$printlines = $qsoprint;
                
		$totalmults  = "0";                 # no mults in Marathon
                
		my $focpoints = &get_focpoints();
		$printlines .= &get_focinfo();
		$score = $totalpoints + $focpoints;
	} elsif ($resultsmethod eq "yudx") {
		($qsos, $qsoprint) = qsos();
		$printlines = $qsoprint;
		
		($zones, $zoneprint) = cnt_ituzones();
		($yupfxes, $yupfxesprint) = cnt_yupfxes();
		
		$printlines .= $zoneprint;
		$printlines .= $yupfxesprint;
		
		$totalmults  = $yupfxes + $zones;
		
		$score = $totalpoints * $totalmults;
		
	} elsif ($resultsmethod eq "sqp") {
		($qsos, $qsoprint) = cwqsos();
		$printlines = $qsoprint;
		($qsos, $qsoprint) = ssbqsos();
		$printlines .= $qsoprint;
		
		($cties, $ctieprint) = cnt_countries();
		($sections, $sectionprint) = cnt_sections_all();
		
		$printlines .= $ctieprint;
		$printlines .= $sectionprint;
		
		$totalmults  = $cties + $sections;
		
		$score = $totalpoints * $totalmults;
	} elsif ($resultsmethod eq "general") {
		($qsos, $qsoprint) = qsos();
		$printlines = $qsoprint;
		$totalmults = 0;
		$score = $totalpoints;
	}
	
#	printresult($totalpoints, $totalmults, $score, $printlines);

	$totalscore = $score;

	 return printtable($totalpoints, $totalmults, $score, $printlines);
	
	
} # end print results


{ #start block
%continents = ();

############################################
sub init_continents {
############################################
%continents = ();
}

############################################
sub addcontinent { # input: $continent
############################################
	my $cont = shift @_;
	$continents{$cont}++;
	return $continents{$cont};
}

############################################
sub nr_continents_all {
############################################
	my $count = 0;
	foreach $key (keys %continents) {
		if ($continents{$key}) {$count++;}
	}
	return $count;
}

############################################
sub getcontinents_all {
############################################
my $string = "Continents worked: ";
 	foreach $key (keys %continents) {
	 	$string .= $key;
	 	$string .= " ";
 	}
	$string .= "\n";
	return $string;
}

} # end block

########################################################
sub writenewlog {
########################################################

	my @inarray = @_;
	my $in = "";
	my $m1 = "";
	my $m2 = "";
	my $points = 0;
	if ($#inarray == 3) {	# 2 mults
		$in = $inarray[0];
		$m1 = $inarray[1];
		$m2 = $inarray[2];
		$points = $inarray[3];
	} elsif ($#inarray == 2) { # 1 mult
		$in = $inarray[0];
		$m1 = $inarray[1];
		$points = $inarray[2];
	} else {				# no mult
		$in = $inarray[0];
		$points = $inarray[1];
	} 

	my $out = "";
	
	$in .= "              ";
	$in = substr ($in, 0,  68);
	if ($m2 ne ""){			# two mult
		$m1 .= "    ";
		$m1 = substr ($m1, 0, 4);
		$m2 .= "    ";
		$m2 = substr ($m2 . "    ", 0, 4);
	$out = sprintf ("%s%s%s%2d \n", $in, $m1, $m2, $points);
	} else {				# one mults
		$m1 .= "         ";
		$m1 = substr ($m1, 0, 8);		
	$out = sprintf ("%s%s%2d \n", $in, $m1, $points);
	} 
#print $out;	
    return $out;

}

1;