1#!/usr/local/bin/perl5 -w 2 3# Program collecting the xpm-cards to a huge pixmap. 4# Not very robust. 5 6$inDir = "xpm"; 7$outFile = "all-cards.xpm"; 8$cardWidth = 71; 9$cardHeight = 96; 10$charsPerPixel = 1; 11 12$width = 4 * $cardWidth; 13$height = 15 * $cardHeight; 14 15@image = (); 16%colorCodeOfDescr = ( 17 "c white" => ".", 18 "s None c None" => " " 19); 20%colorDescrOfCode = ( 21 "." => "c white", 22 " " => "s None c None" 23); 24$numColors = 2; 25 26sub addColor { 27 my($line) = @_; 28 my($code, $descr) = ("", ""); 29 my($ret) = ""; 30 31 $_ = $line; 32 ($code, $descr) = /\"(.)\s+([^\"]*)/; 33 $descr =~ s/\s+/ /g; 34 $ret = $colorCodeOfDescr{"$descr"}; 35 if (!$ret) { 36 while ($colorDescrOfCode{"$code"}) { 37 if (ord($code) < ord("a")) { 38 $code = "a"; 39 } else { 40 $code = chr(ord($code) + 1); 41 } 42 } 43 $colorCodeOfDescr{"$descr"} = $code; 44 $colorDescrOfCode{"$code"} = $descr; 45 $ret = $code; 46 ++$numColors; 47 } 48 return $ret; 49} 50 51sub initImage { 52 my($q) = 0; 53 my($code) = ""; 54 55 $code = &addColor("\" s None c None\""); 56 for ($q = 0; $q < $height; $q++) { 57 $image[$q] = "$code" x $width; 58 } 59} 60 61sub readXpmFile { 62 my($filename, $x, $y) = @_; 63 my($line) = ""; 64 my($w, $h, $nc, $cpp) = (0, 0, 0, 0); 65 my($q) = 0; 66 my(%colorRemap) = (); 67 68 print "$filename\n"; 69 open(F, $filename) || die "unable to open $filename\n"; 70 while (<F>) { 71 last if (/\"\s*\d+\s+\d+\s+\d+\s+\d+\s*\"/); 72 } 73 ($w, $h, $nc, $cpp) = /\"\s*(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s*\"/; 74 die "size fault\n" 75 if ($w != $cardWidth || $h != $cardHeight || $cpp != $charsPerPixel); 76 $q = 0; 77 while ($q < $nc) { 78 $_ = <F>; 79 next if (!/\s*\"/); 80 ($origCode) = /\"(.)/; 81 ($newCode) = &addColor($_); 82 $colorRemap{"$origCode"} = $newCode; 83 ++$q; 84 } 85 $q = 0; 86 while ($q < $h) { 87 $_ = <F>; 88 next if (!/\s*\"/); 89 ($line) = /\s*\"([^\"]*)/; 90 for ($w = 0; $w < length($line); $w++) { 91 substr($line, $w, 1) = $colorRemap{substr($line, $w, 1)}; 92 } 93 substr($image[$y * $cardHeight + $q], $x * $cardWidth, $w) = $line; 94 ++$q; 95 } 96 close(F); 97} 98 99sub writeXpmFile { 100 my($q) = 0; 101 102 open(F, ">$outFile") || die "unable to write $outFile\n"; 103 print F "/* XPM */\n"; 104 print F "static char *allCards[] = {\n"; 105 print F "/* width height num_colors chars_per_pixel */\n"; 106 print F "\" $width $height $numColors"; 107 print F " $charsPerPixel\",\n"; 108 print F "/* colors */\n"; 109 foreach $code (keys %colorDescrOfCode) { 110 print F "\"$code $colorDescrOfCode{$code}\",\n"; 111 } 112 print F "/* pixels */\n"; 113 for ($q = 0; $q < $height; $q++) { 114 print F "\"$image[$q]\""; 115 print F "," if ($q < $height - 1); 116 print F "\n"; 117 } 118 print F "};\n"; 119 close(F); 120} 121 122&initImage; 123$q = 0; 124for ($q = 0; $q < 13; $q++) { 125 &readXpmFile(sprintf("$inDir/clubs-%02d.xpm", $q + 1), 0, $q); 126 &readXpmFile(sprintf("$inDir/diamonds-%02d.xpm", $q + 1), 1, $q); 127 &readXpmFile(sprintf("$inDir/hearts-%02d.xpm", $q + 1), 2, $q); 128 &readXpmFile(sprintf("$inDir/spades-%02d.xpm", $q + 1), 3, $q); 129} 130for ($q = 0; $q < 4; $q++) { 131 $filename = sprintf("$inDir/backs-%02d.xpm", $q + 1); 132 last if (!-f $filename); 133 &readXpmFile($filename, $q, 13); 134} 135for ($q = 0; $q < 4; $q++) { 136 $filename = sprintf("$inDir/outline-%02d.xpm", $q + 1); 137 last if (!-f $filename); 138 &readXpmFile($filename, $q, 14); 139} 140&writeXpmFile; 141