# This is K&R for perl.

while (<>)
    {
    &lineparse;
    # deal with silly input 
    $cards  = &strlen($_[0]);
    $cards += &strlen($_[1]);
    $cards += &strlen($_[2]);
    $cards += &strlen($_[3]);
    if ($cards != 13)
	{
	print "Sorry, this 'hand' has $cards cards.  Please try again.\n";
	}
    else
	{
        $val = &cccc(@_);
	$dkval = &dkcccc(@_);
        # deal with printing voids
        if ($_[0] eq "") {$_[0] = "---";}
        if ($_[1] eq "") {$_[1] = "---";}
        if ($_[2] eq "") {$_[2] = "---";}
        if ($_[3] eq "") {$_[3] = "---";}
        printf "K&R ($_[0] $_[1] $_[2] $_[3]) = %.2f\n",$val;
	printf "DK K&R = %.2f\n",$dkval;
	}
    }

# cccc takes four arguments, spades, hearts, 
# diamonds, then clubs, all using the chars
# only "AKQJT98765432".

sub cccc
    {
    local(@len);	# lengths
    local($pakq,	# 321 points
          $plen,	# length points
          $pdist,	# shortness points
	  $psk,		# short honor deductions
	  $plq,		# long queen deduction
          $plh,		# lower honor points
	  $p4333);	# 4333 deduction
    local($i);		# counter
    
    # 321 count for AKQ 
    $pakq = 0;
    for ($i=0;$i<4;$i++)
	{
    	if ($_[$i] =~ /A/) {$pakq += 3;}
    	if ($_[$i] =~ /K/) {$pakq += 2;}
    	if ($_[$i] =~ /Q/) {$pakq += 1;}
	}

    # length points
    # find suit lengths
    for ($i=0;$i<4;$i++)
	{
	$_ = $_[$i];
	$len[$i] = tr///c;
	}

    $plen = 0;
    for ($i=0;$i<4;$i++)
	{
	if ($_[$i] =~ /A/) {$plen += $len[$i] * 4};
	if ($_[$i] =~ /K/) {$plen += $len[$i] * 3};
	if ($_[$i] =~ /Q/) {$plen += $len[$i] * 2};
	if ($_[$i] =~ /J/) {$plen += $len[$i] * 1};
	}

    # adjust length factor for long suits missing 
    # useless lower honors

    # Note: the article doesn't really specify
    # this very well.  Mark Nau suggested that
    # this is likely to be what they really meant,
    # and I concur.
    for ($i=0;$i<4;$i++)
	{
	if    (($len[$i] == 7) && !($_[$i] =~ /[QJ]/))
	 	{ $plen += 7;}
	if    (($len[$i] == 8) && !($_[$i] =~ /Q/))
	 	{ $plen += 16;}
        elsif (($len[$i] == 8) && !($_[$i] =~ /J/))
	 	{ $plen +=  8;}
	if    (($len[$i] >  8) && !($_[$i] =~ /Q/))
	 	{ $plen += 2 * $len[$i];}
	if    (($len[$i] >  8) && !($_[$i] =~ /J/))
	 	{ $plen += $len[$i];}
	}

    # lower honor suit length mods 
    for ($i=0;$i<4;$i++)
	{
	# tens
	if ($_[$i] =~ /T/)
	    {
	    $_ = $_[$i];
	    if (($len[$i] <= 6) && (tr/AKQ// >= 2 || /J/))
		{$plen += $len[$i];}
	    else
		{$plen += .5 * $len[$i];}
	    }
   	# nines
	if ($_[$i] =~ /9/ && $len[$i] <= 6)
	    {
	    $_ = $_[$i];
	    if (tr/AKQJ// >= 2 || /T/ || /8/) {$plen += .5 * $len[$i];}
	    }
	}

    # distribution points
    $pdist = 0;
    for ($i=0;$i<4;$i++)
	{
	if ($len[$i] == 0) {$pdist += 3};
	if ($len[$i] == 1) {$pdist += 2};
	if ($len[$i] == 2) {$pdist += 1};
	}
    if ($pdist) {$pdist -= 1;}  #discount 1st doubleton

    # Test for stiff kings and doubleton queens.
    $psk = 0;
    for ($i=0;$i<4;$i++)
	{
	$_ = $_[$i];
	if (/K/ && $len[$i] == 1) {$psk += -1.5;}
	if (/Q/ && $len[$i] < 3) 
	    {
	    $psk += -1;
	    if (/A/ || /K/) 
		{$psk += .5;}
	    elsif ($len[$i] == 2)
		{$psk += .25;}
	    }
	}

    # long queens are demoted if no A or K in suit 
    $plq = 0;
    for ($i=0;$i<4;$i++)
	{
	$_ = $_[$i];
	if (/Q/ && !/A/ && !/K/ && $len[$i] >= 3) {$plq += -.25;}
   	} 

    # lower honors
    $plh = 0;
    for ($i=0;$i<4;$i++)
	{
	$_ = $_[$i];
        # Jacks are worth .5 if with 2 higher honors
	if (/J/) 
	    {
	    if (tr/AKQ// == 2) {$plh += .5};
            if (tr/AKQ// == 1) {$plh += .25};
	    }
	# Tens are worth .25 with 2 higher or 1 plus the 9 
	if (/T/)
	    {
	    if (tr/AKQJ// == 2) {$plh += .25;}
	    if (tr/AKQJ// == 1 && /9/) {$plh += .25;}
	    }
	}

    # deduction for 4333
    $p4333 = 0;
    if ((($len[0] == 3) || ($len[0] == 4)) &&
	(($len[1] == 3) || ($len[1] == 4)) &&
	(($len[2] == 3) || ($len[2] == 4)) &&
	(($len[3] == 3) || ($len[3] == 4)))
	    {$p4333 = -.5;}
	

    # return value
    $pakq + $plen/10. + $pdist + $psk + $plq + $plh + $p4333;
    }

# this converts $_ from fairly flexible input format
# into @_ in cccc's form.
sub lineparse
    {
    s/10/T/g;
    tr/akqjt/AKQJT/;
    split;
    $_[0] =~ tr/AKQJT98765432-/x/c;
    $_[1] =~ tr/AKQJT98765432-/x/c;
    $_[2] =~ tr/AKQJT98765432-/x/c;
    $_[3] =~ tr/AKQJT98765432-/x/c;
    $_[0] =~ s/-//g;
    $_[1] =~ s/-//g;
    $_[2] =~ s/-//g;
    $_[3] =~ s/-//g;
    }

sub strlen
    {
    $_ = $_[0];
    tr///c;
    }

# dkcccc takes four arguments, spades, hearts, 
# diamonds, then clubs, all using the chars
# only "AKQJT98765432".

# This is Danny Kleinman's variation.

sub dkcccc
    {
    local(@len);	# lengths
    local($pakq,	# 321 points
          $plen,	# length points
	  $prich,	# richness points
          $pdist,	# shortness points
	  $psk,		# short honor deductions
	  $plq,		# long queen deduction
          $plh,		# lower honor points
	  $pbh,		# bare honor suits
	  $p4333);	# 4333 deduction
    local($i);		# counter
    
    # 321 count for AKQ  (Same as K&R)
    $pakq = 0;
    for ($i=0;$i<4;$i++)
	{
    	if ($_[$i] =~ /A/) {$pakq += 3;}
    	if ($_[$i] =~ /K/) {$pakq += 2;}
    	if ($_[$i] =~ /Q/) {$pakq += 1;}
	}

    # richness
    $prich = 0;
    $temp = 0;

    # count number of face cards
    for ($i=0;$i<4;$i++)
	{
	if ($_[$i] =~ /A/) {$prich++; $temp += 4;}
	if ($_[$i] =~ /K/) {$prich++; $temp += 3;}
	if ($_[$i] =~ /Q/) {$prich++; $temp += 2;}
	if ($_[$i] =~ /J/) {$prich++; $temp += 1;}
	}
    $prich = ($temp-2.5*$prich) * .325;

    # length points
    # find suit lengths
    for ($i=0;$i<4;$i++)
	{
	$_ = $_[$i];
	$len[$i] = tr///c;
	}

    # length is per high card, not per value
    $plen = 0;
    for ($i=0;$i<4;$i++)
	{
	if ($_[$i] =~ /A/) {$plen += $len[$i] * 2.5};
	if ($_[$i] =~ /K/) {$plen += $len[$i] * 2.5};
	if ($_[$i] =~ /Q/) {$plen += $len[$i] * 2.5};
	if ($_[$i] =~ /J/) {$plen += $len[$i] * 2.5};
	}

    # adjust length factor for long suits missing 
    # useless lower honors

    # Note: the article doesn't really specify
    # this very well.  Mark Nau suggested that
    # this is likely to be what they really meant,
    # and I concur.
    for ($i=0;$i<4;$i++)
        {
        if    (($len[$i] == 7) && !($_[$i] =~ /[QJ]/))
                { $plen += 7;}
        if    (($len[$i] == 8) && !($_[$i] =~ /Q/))
                { $plen += 16;}
        elsif (($len[$i] == 8) && !($_[$i] =~ /J/))
                { $plen +=  8;}
        if    (($len[$i] >  8) && !($_[$i] =~ /Q/))
                { $plen += 2 * $len[$i];}
        if    (($len[$i] >  8) && !($_[$i] =~ /J/))
                { $plen += $len[$i];}
        }

    # lower honor suit length mods 
    for ($i=0;$i<4;$i++)
	{
	# tens
	if ($_[$i] =~ /T/)
	    {
	    $_ = $_[$i];
	    if (($len[$i] <= 6) && (tr/AKQ// >= 2 || /J/))
		{$plen += $len[$i];}
	    else
		{$plen += .5 * $len[$i];}
	    }
   	# nines
	if ($_[$i] =~ /9/ && $len[$i] <= 6)
	    {
	    $_ = $_[$i];
	    if (tr/AKQJ// >= 2 || /T/ || /8/) {$plen += .5 * $len[$i];}
	    }
	}

    # distribution points
    $pdist = 0;
    for ($i=0;$i<4;$i++)
	{
	if ($len[$i] == 0) {$pdist += 3};
	if ($len[$i] == 1) {$pdist += 2};
	if ($len[$i] == 2) {$pdist += 1};
	}
    if ($pdist) {$pdist -= 1;}  #discount 1st doubleton

    # Test for stiff kings and doubleton queens.
    $psk = 0;
    for ($i=0;$i<4;$i++)
	{
	$_ = $_[$i];
	if (/K/ && $len[$i] == 1) {$psk += -1.5;}
	if (/Q/ && $len[$i] < 3) 
	    {
	    $psk += -1;
	    if (/A/ || /K/) 
		{$psk += .5;}
	    elsif ($len[$i] == 2)
		{$psk += .25;}
	    }
	}

    # long queens are demoted if no A or K in suit 
    $plq = 0;
    for ($i=0;$i<4;$i++)
	{
	$_ = $_[$i];
	if (/Q/ && !/A/ && !/K/ && $len[$i] >= 3) {$plq += -.25;}
   	} 

    # lower honors
    $plh = 0;
    for ($i=0;$i<4;$i++)
	{
	$_ = $_[$i];
        # Jacks are worth .5 if with 2 higher honors
	if (/J/) 
	    {
	    if (tr/AKQ// == 2) {$plh += .5};
            if (tr/AKQ// == 1) {$plh += .25};
	    }
	# Tens are worth .25 with 2 higher or 1 plus the 9 
	if (/T/)
	    {
	    if (tr/AKQJ// == 2) {$plh += .25;}
	    if (tr/AKQJ// == 1 && /9/) {$plh += .25;}
	    }
	}

    # deduction for 4333
    $p4333 = 0;
    if ((($len[0] == 3) || ($len[0] == 4)) &&
	(($len[1] == 3) || ($len[1] == 4)) &&
	(($len[2] == 3) || ($len[2] == 4)) &&
	(($len[3] == 3) || ($len[3] == 4)))
	    {$p4333 = -.5;}

    # deduction for bare  honor suits
    $pbh = 0;
    for ($i=0;$i<4;$i++)
	{
        $_ = $_[$i];
        if (tr/0123456789TXx//c == $len[$i]) {$pbh -= .5;}
	}
	
# debug stuff
#print "akq = $pakq, len = ",$plen/10.,"\n";
#print "dist = $pdist, sk = $psk, lq = $plq\n";
#print "lh = $plh, 4333 = $p4333\n";
#print "rich = $prich, bare suits = $pbh\n";

    # return value
    $pakq + $plen/10. + $pdist + $psk + $plq + $plh + $p4333 + $prich + $pbh;
    }