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