#!/usr/bin/perl # # This script generates an SVG card deck suitable for KDE # card games. # Currently developed to generate a deck for lskat from a public domain image. # use MIME::Base64; my $year = 2009; my $author = "Luciano Montanaro "; # Width and height of the card board my $boardwidth = 1024; my $boardheight = 804; # Width and height of each card my $width = 128; my $height = 201; # corner radius my $cradius = 9; # offset from card border to pattern border my $off = 6; # width and height of card figure my $figwidth = $width - 2 * $off; my $figheight = $height - 2 * $off; my $figradius = $cradius - 2; my $centerx = $width / 2; my $centery = $height / 2 - 1; my @suits = ("heart", "diamond", "spade", "club"); # A Skat deck only has cards down to 7. The Ace is really the Queen, King is # itself, queen is high knave, jack is low knave. I guess. my @cardnames = ("1", "king", "queen", "jack", "10", "9", "8", "7", "6", "5", "4", "3", "2"); my $viewwidth = @cardnames * $width; my $viewheight = (1 + @suits) * $height; my $ratiox = 1; my $ratioy = 1; my $suitsize = 16; my @column = ($centerx - 2 * ($suitsize + 2) - $off, $centerx - $off, $centerx + 2 * ($suitsize + 2) - $off); my @row = ($off + $suitsize, $off + 2 * $suitsize, $off + 3 * $suitsize, $off + 4 * $suitsize, $centery, ); # Rows for "branched" suits. my $bspacing = 14; my @brow = ($off + $bspacing, $off + 2 * $bspacing, $off + 3 * $bspacing, $off + 4 * $bspacing, $off + 5 * $bspacing, $off + $figwidth / 2, ); sub generate_court_images() { for ($i = 0; $i < 4; $i++) { for ($j = 0; $j < 4; $j++) { my $pngname = 1 + $j * 4 + $i; my $offsetx = $j * $width; my $offsety = $i * $height; my $cardid = "$cardnames[$j]_$suits[$i]"; open(CARD, "; my $card_encoded = encode_base64(join("", @card_data)); print < EOF } } } sub generate_groups($$) { my $suit = shift; my $image = shift; if ($suit eq "diamond" || $suit eq "heart") { print < EOF } else { print < EOF } } print < EOF print < EOF # include external court images generate_court_images(); # Generate all groups generate_groups("heart", "heart"); generate_groups("diamond", "bell"); generate_groups("spade", "leaf"); generate_groups("club", "acorn"); # generate all cards: for each suit and each card name generate a card my $leftborder = $off; my $rightborder = $off + $figwidth; my $centery = $height / 2 - 0.2; for ($j = 0; $j < @suits; $j++) { print "\n"; for ($i = 0; $i < @cardnames; $i++) { my $cardid = "$cardnames[$i]_$suits[$j]"; print < EOF } } print < EOF # generate all suits (not strictly needed, but nice to see the cards when # loading the deck in an editor) for ($j = 0; $j < @suits; $j++) { print "\n"; for ($i = 0; $i < @cardnames; $i++) { my $cardid = "$cardnames[$i]_$suits[$j]"; my $x = $width * $i; print < EOF } print "\n"; } my $boff = 4; my $b2off = 6; my $bwidth = $width - 2 * $boff; my $bheight = $height - 2 * $boff; my $bradius = $cradius - $boff; my $b2width = $width - 2 * $b2off; my $b2height = $height - 2 * $b2off; my $b2radius = $cradius - $b2off; my $cx = $width / 2; my $cy = $height / 2; print < EOF # generate suits for display for ($j = 0; $j < @suits; $j++) { my $y = (0 + $height) * $j; print < EOF } my $y = $height * (@suits); print < EOF