make-cards

A simple blackjack game. New graphics, added sounds. Features: dealing, hitting, standing, insurance

#!/usr/bin/perl

$workfile="work.tmp";
$tmp=".";

start("border");
insert("4 4","back");
finish("b");

makecard("J"," ","j");

foreach $suit (qw/c d h s/)
{
    foreach $number (qw/2 3 4 5 6 7 8 9 t j q k a/)
    {
	makecard($number,$suit,"$number$suit");
    }
}

sub makecard
{
    my($number,$suit,$save)=@_;
    my($nfile);
    my($s);

    $s="large-$suit";

    print "Making $save\n";
#    print "Making card for $number/$suit\n";

    $nfile="red-$number" if $suit=~/h|d/;
    $nfile="black-$number" if $suit=~/c|s/;

    start("border");

    if($number eq "J")
    {
	insert("5 11","joker");
	symrotinsert("2 3","black-j");
    }
    else
    {
	symrotinsert("2 3",$nfile);
	symrotinsert("2 18","small-$suit");
	
	if($number=~/[qjk]/)
	{
	    insert("13 11","box");
	    symrotinsert("14 12","face-$number$suit");
	}
	elsif($number eq "a" && $suit eq "s")
	{
	    insert("16 18","ace");
	}
	else
	{
	    insert("29 41",$s) if($number=~/[a359]/);
	    insert("29 25",$s) if($number=~/[7]/);
	    
	    symrotinsert("29 20",$s) if($number=~/[2t]/);
	    symrotinsert("29 9",$s) if($number=~/[3]/);
	    symrotinsert("29 25",$s) if($number=~/[8]/);
	    
	    flipxinsert("13 41",$s) if($number=~/[678]/);
	    
	    quadinsert("13 30",$s) if($number=~/[9t]/);
	    quadinsert("13 9",$s) if($number=~/[456789t]/);
	}	
    }
    finish($save);
}

sub getsize
{
    my($file)=@_;
    my($out);

    $out=`pnmfile $file`;

    $out=~/(\d+) by (\d+)/;

#    print "Size of $file is $1 by $2\n";

    return "$1 $2";
}

sub getx
{
    @_[0]=~/(\d+) (\d+)/;

    return $1;
}

sub gety
{
    @_[0]=~/(\d+) (\d+)/;

    return $2;
}

sub start
{
    my($startfile)=@_;

    $startfile.=".pnm";

    $worksize=getsize($startfile);

    system("cp $startfile $workfile");
}

sub finish
{
    my($save)=@_;

    $save.=".gif";

    system("ppmtogif -interlace -sort -transparent yellow < $workfile > $save 2>/dev/null");
    system("rm $workfile");
}


sub insert
{
    my($pos,$ovly)=@_;

#    print "Inserting $ovly at ($pos)\n";

    system("pnmpaste $ovly.pnm $pos $workfile > $tmp/1.tmp");
    system("mv $tmp/1.tmp $workfile");
}

sub rotinsert
{
    my($pos,$ovly)=@_;

#    print "Flipping and inserting $ovly at ($pos)\n";

    system("pnmflip -r180 $ovly.pnm > $tmp/f.tmp");
    system("pnmpaste $tmp/f.tmp $pos $workfile > $tmp/1.tmp");
    system("mv $tmp/1.tmp $workfile");
    system("rm $tmp/f.tmp");
}

sub symrotinsert
{
    my($pos,$ovly)=@_;
    my($size,$sympos);
    
#    print "Sym rot insert $ovly at ($pos):\n";

    $size=getsize("$ovly.pnm");
    $sympos=(getx($worksize)-getx($pos)-getx($size)).
	" ".(gety($worksize)-gety($pos)-gety($size));
    
    rotinsert($sympos,$ovly);
    insert($pos,$ovly);
}

sub flipxinsert
{
    my($pos,$ovly)=@_;
    my($size,$sympos);
    
#    print "Flip x insert $ovly at ($pos):\n";

    $size=getsize("$ovly.pnm");
    $sympos=(getx($worksize)-getx($pos)-getx($size)).
	" ".(gety($pos));
    
    insert($sympos,$ovly);
    insert($pos,$ovly);
}

sub quadinsert
{
    my($pos,$ovly)=@_;
    my($size,$sympos);
    
#    print "Quad insert $ovly at ($pos):\n";

    $size=getsize("$ovly.pnm");
    $sympos=(getx($worksize)-getx($pos)-getx($size)).
	" ".(gety($pos));
    
    symrotinsert($sympos,$ovly);
    symrotinsert($pos,$ovly);
}