doc/scripts/makeps.pl

#!/usr/bin/perl
eval 'exec perl -S $0 "$@"'
    if $running_under_some_shell;
                        # this emulates #! processing on NIH machines.
                        # (remove #! line above if indigestible)

eval '$'.$1.'$2;' while $ARGV[0] =~ /^([A-Za-z_0-9]+=)(.*)/ && shift;
                        # process any FOO=bar switches

# makeps - make Postscript-files of the archetypes listed in text file whose
# filename is passed in 'input'
# Variables passed in:
#   archdir - root of crossfire-src, with a trailing slash
#   libdir  - where archetypes etc. is found

$[ = 1;                 # set array base to 1
$, = ' ';               # set output field separator
$\ = "\n";              # set output record separator

$size=0.4;
$IMAGE_SIZE=32;         # Size of PNG images

if ($output eq "tex") { $BG="\\#ffffff"; }
else { $BG="\\#ab0945"; }

# Set colour to 1 if you want colour postscript.
$colour = 0;
# IF you have giftrans installed and want transparent gifs, set
# appropriately.  IT looks much nicer if you can do it.
$giftrans = 1;


$bmaps = $libdir . '/bmaps';
$bmappaths = $libdir . '/bmaps.paths';

open(BMAPS,"<".$bmappaths) || die("Can't open $bmappaths");
while (<BMAPS>) {
    ($f1,$f2) = split;
    if ($f1 ne '#') {
        # A bit tricky.  We first substitute the first .
        # (./arch to ^/arch), so that the second substitute
        # puts the 'base' portion in the name, and then we
        # put the first . back in place.
        $f2 =~ s/\./\^/;
        $f2 =~ s/\./\.base\./;
        $f2 =~ s/\^/\./;
        $bmappath{$f1} = $f2;
    }
}
close(BMAPS);

open(BMAPS,"<".$bmaps);
while (<BMAPS>) {
    ($f1,$f2) = split;
    if (defined $bmappath{("\\".$f1)}) {
        $bmap{$f2} = $bmappath{("\\".$f1)};
    }
}
close(BMAPS);

# An array listing which archetypes files need fixing, the value
# is the file where it is used. There must be at least one character
# between the ~~spec~~'s.


open(IN,"<".$input) || die("can not open $input\n");
while (<IN>) {
    @flds = split(/~~/);
    $work_todo = 1;
    $i = 2;
    while ($flds[$i] ne "") {
                $makeps{$flds[$i]} = 0;
                $i += 2;
    }
}
close(IN);


# An array to reduce the size of the bitmap exponentially.
# A 4x8 bitmap will be reduced to 60% of its full size.
if ($work_todo) {
    $size_mul{1} = 1;
    for ($i = 2; $i <= 12; $i++) {# Max input is 12x12, a *large* bitmap ;-)
        $size_mul{$i} = $size_mul{$i - 1} * 0.9;
    }
}

$More = 0;
print STDERR "starting to process $inarch\n";
open(IN,"<".$inarch) || die("could not open $inarch\n");
line: while (<IN>) {
    chomp;      # strip record separator
    @Fld = split(/ /, $_, 2);
    if ($Fld[1] eq 'Object') {
        if ($interesting) {
            $faces{$X, $Y} = $face;
            if (!$More && $makeps{$obj} != 1) {
                $makeps{$obj} = &assemble();
            }
        }

        # Get ready for next archetype
        if (!$More) {
            $xmin = $xmax = $ymin = $ymax = 0;
            $obj = $Fld[2];
            $interesting = defined $makeps{$obj};
        }
        $X = $Y = 0;
        $More = 0;
    }

    if ($Fld[1] eq 'face') {
        $face = $Fld[2];
    }
    if ($Fld[1] eq 'x') {
        $X = $Fld[2];
        if ($X > $xmax) {       #???
            $xmax = $X;
        }
        elsif ($X < $xmin) {    #???
            $xmin = $X;
        }
    }
    if ($Fld[1] eq 'y') {
        $Y = $Fld[2];
        if ($Y > $ymax) {       #???
            $ymax = $Y;
        }
        elsif ($Y < $ymin) {    #???
            $ymin = $Y;
        }
    }
    if ($Fld[1] eq 'More') {
        $More = 1;
    }
    if ($Fld[1] eq 'msg') {
        do {
            $_ = <IN>;
            @Fld = split;           
        }
        while ($Fld[1] ne 'endmsg');
    }
}
close(IN);

# Remember to check the last archetype also...
if ($interesting) {
    $faces{$X, $Y} = $face;
    if ($makeps{$obj} != 1) {
        $makeps{$obj} = &assemble();
    }
}

system('rm -f work.pbm tmp.pbm empty.pbm');
# clean up a little
system("pbmmake -white $IMAGE_SIZE $IMAGE_SIZE > empty.pbm");

# We've created a number of Postscript-files - now we need to
# patch the filenames and sizes into the TeX-files.

$, = '';
open(IN,"<".$input);
while (<IN>) {
    @Fld = split(/~~/);
    if ($#Fld > 1) {
        for ($i = 2; $i <= $#Fld; $i += 2) {
            if (defined $makeps{$Fld[$i]}) {
                        $Fld[$i] = $makeps{$Fld[$i]};
            }
        }
    }
    print @Fld;
}
close(IN);


sub assemble {
    local($w, $h, $ppm, $buff, $i, $j, $bmap_file, $ps_file) = @_;
    my($one_image)=0;

    $bmap_file = $archdir.$bmap{$faces{0,0}}.".png";
    if ($output eq "tex") {$ps_file = $faces{0, 0} . '.ps';     } 
    else { $ps_file = $faces{0, 0} . '.gif'; }
    $ps_file =~ s/[_ ]/-/g;

    $w = $xmax - $xmin + 1;
    $h = $ymax - $ymin + 1;

    # with big image support, we don't need to assemble images.  But not all
    # images are big image - so we do a simple check - see if the face for the
    # first and last piece are the same - if so, presume this is a big image
    if ($archdir.$bmap{$faces{0,0}} eq $archdir.$bmap{$faces{$w-1,$h-1}}) { $one_image=1; }

    if (! -e $ps_file) {
        if ((($w == 1) && ($h == 1)) || $one_image) {
            # Maybe ln -s instead?
            if ($output eq "tex") {
                if ($colour) {  system("pngtopnm -mix -background $BG $bmap_file | pnmtops -noturn -nosetpage > $ps_file"); }
                else {  system("pngtopnm -mix -background $BG $bmap_file | pnmdepth 255 | ppmtopgm | pnmtops -noturn -nosetpage> $ps_file"); }
            }
            elsif ($giftrans) {
                system("pngtopnm -mix -background $BG $bmap_file | ppmtogif | giftrans -t $BG $ppm > $ps_file");
            } else {
                system("pngtopnm -mix -background $BG $bmap_file | ppmtogif > $ps_file");
            }
        }
        else {
            $ppm = sprintf('%dx%d.ppm', $w, $h);
            print STDERR "$ppm\n";
            if (! -e $ppm) {
                print STDERR
                      "pnmscale -xsc $w -ysc $h < empty.pbm | pgmtoppm white > $ppm\n";

                system(sprintf('pnmscale -xsc %d -ysc %d < empty.pbm | pgmtoppm white > %s',
                $w, $h, $ppm));
            }

            system("cp $ppm work.ppm");
            $ppm = "work.ppm";

            for ($i = $xmin; $i <= $xmax; $i++) {
                for ($j = $ymin; $j <= $ymax; $j++) {
                    print STDERR
                         'Processing x ' . $bmap{$faces{$i, $j}};
                    $valx = ($i - $xmin) * $IMAGE_SIZE;
                    $valy = ($j - $ymin) * $IMAGE_SIZE;
#                   print STDERR "pngtopnm -background #ABCD01239876 $archdir$bmap{$faces{$i,$j}}.png > tmp.ppm\n";
                    system("pngtopnm -mix -background $BG $archdir$bmap{$faces{$i,$j}}.png > tmp.ppm");
                    system("pnmpaste tmp.ppm $valx $valy $ppm > tmp2.ppm");
                    rename("tmp2.ppm", $ppm);
                }
            }
            if ($output eq "tex") {
                if ($colour) {  system("pnmtops -noturn $ppm> $ps_file"); }
                else {  system("pnmdepth 255 $ppm | ppmtopgm | pnmtops -noturn > $ps_file"); }
            }
            elsif ($giftrans) {
                system("ppmtogif $ppm | giftrans -t $BG > $ps_file");
            } else {
                system("ppmtogif $ppm > $ps_file");
            }
        }
    }
    $mul = $size_mul{int(sqrt($w * $h))} * $size;
    if ($output eq "tex") {
        if ($h == 1) { 
            $ps = sprintf "\\psfig{figure=$ps_file,width=%0.2fcm,height=%0.2fcm}", $w * $mul, $h * $mul;
        } else {
            $ps = sprintf "\\raisebox{-%0.2fcm}{\\psfig{figure=$ps_file,width=%0.2fcm,height=%0.2fcm}}", ($h-1) * $mul, $w * $mul, $h * $mul;
        }
    } else {
            $ps = "<img src=$ps_file>";
    }
    $ps;
}

Revision:	1.1
Committed:	Fri Feb 3 07:12:43 2006 UTC (20 years, 8 months ago) by root
Content type:	text/plain
Branch:	MAIN
Branch point for:	UPSTREAM
Log Message:	Initial revision
#	User	Rev	Content
1	root	1.1	#!/usr/bin/perl
2			eval 'exec perl -S $0 "$@"'
3			if $running_under_some_shell;
4			# this emulates #! processing on NIH machines.
5			# (remove #! line above if indigestible)
6
7			eval '$'.$1.'$2;' while $ARGV[0] =~ /^([A-Za-z_0-9]+=)(.*)/ && shift;
8			# process any FOO=bar switches
9
10			# makeps - make Postscript-files of the archetypes listed in text file whose
11			# filename is passed in 'input'
12			# Variables passed in:
13			# archdir - root of crossfire-src, with a trailing slash
14			# libdir - where archetypes etc. is found
15
16			$[ = 1; # set array base to 1
17			$, = ' '; # set output field separator
18			$\ = "\n"; # set output record separator
19
20			$size=0.4;
21			$IMAGE_SIZE=32; # Size of PNG images
22
23			if ($output eq "tex") { $BG="\\#ffffff"; }
24			else { $BG="\\#ab0945"; }
25
26			# Set colour to 1 if you want colour postscript.
27			$colour = 0;
28			# IF you have giftrans installed and want transparent gifs, set
29			# appropriately. IT looks much nicer if you can do it.
30			$giftrans = 1;
31
32
33			$bmaps = $libdir . '/bmaps';
34			$bmappaths = $libdir . '/bmaps.paths';
35
36			open(BMAPS,"<".$bmappaths) \|\| die("Can't open $bmappaths");
37			while (<BMAPS>) {
38			($f1,$f2) = split;
39			if ($f1 ne '#') {
40			# A bit tricky. We first substitute the first .
41			# (./arch to ^/arch), so that the second substitute
42			# puts the 'base' portion in the name, and then we
43			# put the first . back in place.
44			$f2 =~ s/\./\^/;
45			$f2 =~ s/\./\.base\./;
46			$f2 =~ s/\^/\./;
47			$bmappath{$f1} = $f2;
48			}
49			}
50			close(BMAPS);
51
52			open(BMAPS,"<".$bmaps);
53			while (<BMAPS>) {
54			($f1,$f2) = split;
55			if (defined $bmappath{("\\".$f1)}) {
56			$bmap{$f2} = $bmappath{("\\".$f1)};
57			}
58			}
59			close(BMAPS);
60
61			# An array listing which archetypes files need fixing, the value
62			# is the file where it is used. There must be at least one character
63			# between the ~~spec~~'s.
64
65
66			open(IN,"<".$input) \|\| die("can not open $input\n");
67			while (<IN>) {
68			@flds = split(/~~/);
69			$work_todo = 1;
70			$i = 2;
71			while ($flds[$i] ne "") {
72			$makeps{$flds[$i]} = 0;
73			$i += 2;
74			}
75			}
76			close(IN);
77
78
79			# An array to reduce the size of the bitmap exponentially.
80			# A 4x8 bitmap will be reduced to 60% of its full size.
81			if ($work_todo) {
82			$size_mul{1} = 1;
83			for ($i = 2; $i <= 12; $i++) {# Max input is 12x12, a large bitmap ;-)
84			$size_mul{$i} = $size_mul{$i - 1} * 0.9;
85			}
86			}
87
88			$More = 0;
89			print STDERR "starting to process $inarch\n";
90			open(IN,"<".$inarch) \|\| die("could not open $inarch\n");
91			line: while (<IN>) {
92			chomp; # strip record separator
93			@Fld = split(/ /, $_, 2);
94			if ($Fld[1] eq 'Object') {
95			if ($interesting) {
96			$faces{$X, $Y} = $face;
97			if (!$More && $makeps{$obj} != 1) {
98			$makeps{$obj} = &assemble();
99			}
100			}
101
102			# Get ready for next archetype
103			if (!$More) {
104			$xmin = $xmax = $ymin = $ymax = 0;
105			$obj = $Fld[2];
106			$interesting = defined $makeps{$obj};
107			}
108			$X = $Y = 0;
109			$More = 0;
110			}
111
112			if ($Fld[1] eq 'face') {
113			$face = $Fld[2];
114			}
115			if ($Fld[1] eq 'x') {
116			$X = $Fld[2];
117			if ($X > $xmax) { #???
118			$xmax = $X;
119			}
120			elsif ($X < $xmin) { #???
121			$xmin = $X;
122			}
123			}
124			if ($Fld[1] eq 'y') {
125			$Y = $Fld[2];
126			if ($Y > $ymax) { #???
127			$ymax = $Y;
128			}
129			elsif ($Y < $ymin) { #???
130			$ymin = $Y;
131			}
132			}
133			if ($Fld[1] eq 'More') {
134			$More = 1;
135			}
136			if ($Fld[1] eq 'msg') {
137			do {
138			$_ = <IN>;
139			@Fld = split;
140			}
141			while ($Fld[1] ne 'endmsg');
142			}
143			}
144			close(IN);
145
146			# Remember to check the last archetype also...
147			if ($interesting) {
148			$faces{$X, $Y} = $face;
149			if ($makeps{$obj} != 1) {
150			$makeps{$obj} = &assemble();
151			}
152			}
153
154			system('rm -f work.pbm tmp.pbm empty.pbm');
155			# clean up a little
156			system("pbmmake -white $IMAGE_SIZE $IMAGE_SIZE > empty.pbm");
157
158			# We've created a number of Postscript-files - now we need to
159			# patch the filenames and sizes into the TeX-files.
160
161			$, = '';
162			open(IN,"<".$input);
163			while (<IN>) {
164			@Fld = split(/~~/);
165			if ($#Fld > 1) {
166			for ($i = 2; $i <= $#Fld; $i += 2) {
167			if (defined $makeps{$Fld[$i]}) {
168			$Fld[$i] = $makeps{$Fld[$i]};
169			}
170			}
171			}
172			print @Fld;
173			}
174			close(IN);
175
176
177			sub assemble {
178			local($w, $h, $ppm, $buff, $i, $j, $bmap_file, $ps_file) = @_;
179			my($one_image)=0;
180
181			$bmap_file = $archdir.$bmap{$faces{0,0}}.".png";
182			if ($output eq "tex") {$ps_file = $faces{0, 0} . '.ps'; }
183			else { $ps_file = $faces{0, 0} . '.gif'; }
184			$ps_file =~ s/[_ ]/-/g;
185
186			$w = $xmax - $xmin + 1;
187			$h = $ymax - $ymin + 1;
188
189			# with big image support, we don't need to assemble images. But not all
190			# images are big image - so we do a simple check - see if the face for the
191			# first and last piece are the same - if so, presume this is a big image
192			if ($archdir.$bmap{$faces{0,0}} eq $archdir.$bmap{$faces{$w-1,$h-1}}) { $one_image=1; }
193
194			if (! -e $ps_file) {
195			if ((($w == 1) && ($h == 1)) \|\| $one_image) {
196			# Maybe ln -s instead?
197			if ($output eq "tex") {
198			if ($colour) { system("pngtopnm -mix -background $BG $bmap_file \| pnmtops -noturn -nosetpage > $ps_file"); }
199			else { system("pngtopnm -mix -background $BG $bmap_file \| pnmdepth 255 \| ppmtopgm \| pnmtops -noturn -nosetpage> $ps_file"); }
200			}
201			elsif ($giftrans) {
202			system("pngtopnm -mix -background $BG $bmap_file \| ppmtogif \| giftrans -t $BG $ppm > $ps_file");
203			} else {
204			system("pngtopnm -mix -background $BG $bmap_file \| ppmtogif > $ps_file");
205			}
206			}
207			else {
208			$ppm = sprintf('%dx%d.ppm', $w, $h);
209			print STDERR "$ppm\n";
210			if (! -e $ppm) {
211			print STDERR
212			"pnmscale -xsc $w -ysc $h < empty.pbm \| pgmtoppm white > $ppm\n";
213
214			system(sprintf('pnmscale -xsc %d -ysc %d < empty.pbm \| pgmtoppm white > %s',
215			$w, $h, $ppm));
216			}
217
218			system("cp $ppm work.ppm");
219			$ppm = "work.ppm";
220
221			for ($i = $xmin; $i <= $xmax; $i++) {
222			for ($j = $ymin; $j <= $ymax; $j++) {
223			print STDERR
224			'Processing x ' . $bmap{$faces{$i, $j}};
225			$valx = ($i - $xmin) * $IMAGE_SIZE;
226			$valy = ($j - $ymin) * $IMAGE_SIZE;
227			# print STDERR "pngtopnm -background #ABCD01239876 $archdir$bmap{$faces{$i,$j}}.png > tmp.ppm\n";
228			system("pngtopnm -mix -background $BG $archdir$bmap{$faces{$i,$j}}.png > tmp.ppm");
229			system("pnmpaste tmp.ppm $valx $valy $ppm > tmp2.ppm");
230			rename("tmp2.ppm", $ppm);
231			}
232			}
233			if ($output eq "tex") {
234			if ($colour) { system("pnmtops -noturn $ppm> $ps_file"); }
235			else { system("pnmdepth 255 $ppm \| ppmtopgm \| pnmtops -noturn > $ps_file"); }
236			}
237			elsif ($giftrans) {
238			system("ppmtogif $ppm \| giftrans -t $BG > $ps_file");
239			} else {
240			system("ppmtogif $ppm > $ps_file");
241			}
242			}
243			}
244			$mul = $size_mul{int(sqrt($w * $h))} * $size;
245			if ($output eq "tex") {
246			if ($h == 1) {
247			$ps = sprintf "\\psfig{figure=$ps_file,width=%0.2fcm,height=%0.2fcm}", $w * $mul, $h * $mul;
248			} else {
249			$ps = sprintf "\\raisebox{-%0.2fcm}{\\psfig{figure=$ps_file,width=%0.2fcm,height=%0.2fcm}}", ($h-1) * $mul, $w * $mul, $h * $mul;
250			}
251			} else {
252			$ps = "<img src=$ps_file>";
253			}
254			$ps;
255			}
256