Go to the list of seismic processes.      Go to SIOSEIS
Using PERL and ALCHEMY to create a side label for a SIOSEIS SUN
rasterfile.  Submitted by Geoff Ely at UCSB.

#!/net/quake/opta/bin/perl

if( $#ARGV != 2 ) {
  print "usage: label   \n";
  exit 0; }
$rasfile = $ARGV[0];
$histfile = $ARGV[1];
$outfile = $ARGV[2];

# Create a Postscript label from SIOSEIS history file.
open( OFILE, "> label.ps" );
print OFILE "%!PS\n";
print OFILE "/p {moveto show} def\n";
print OFILE "/Helvetica-Bold findfont 24 scalefont setfont\n";
open( HFILE, $histfile );
while() {
  $height = 1560 - $. * 12;
  chop;
  if ($. == 1) {
    print OFILE "(", $_, ") 36 72 22 mul p\n"; }
  elsif ($. == 2) {
    print OFILE "/Helvetica findfont 12 scalefont setfont\n";
    print OFILE "(", $_ , ") 36 72 21.6 mul p\n";
    print OFILE "/Helvetica-Bold findfont 10 scalefont setfont\n"; }
  else {
    print OFILE "(", $_, ") 36 ", $height, " p\n"; }
}
print OFILE "showpage\n";
close( HFILE );
close( OFILE );

# Convert PostScript label to a Sun Raster file.
system( "alchemy -Zi 6 23 -Zd 200 200 -Zr 90 -s -o label.ps label.ras" );

# Combine SIOSEIS raster file and label raster file.
$rasmagic = 1504078485;
open( RFILE, "$rasfile" );
open( LFILE, "label.ras" );
open( OFILE, "> $outfile" );
read( RFILE, $rheader, 32, 0 );
read( LFILE, $lheader, 32, 0 );
($rmagic, $rwidth, $rheight, $rdepth) = unpack( "i8", $rheader);
($lmagic, $lwidth, $lheight, $ldepth) = unpack( "i8", $lheader);
if ( $rmagic != $rasmagic || $lmagic != $rasmagic || $rdepth != 1 || $ldepth != 1) {
  print "Error opening files."; exit 1; }
$oheight = $rheight + $lheight;
$olength = $oheight * $rwidth / 8;
$oheader = pack( "i8", $rasmagic, $rwidth, $oheight, 1, $olength, 1, 0, 0);
print OFILE $oheader;
$rbufflen = $rwidth / 8;
$lbufflen = $lwidth / 8 + 1;
for ($i = 1; $i <= $lheight; $i++)  { 
  read( LFILE, $buff, $lbufflen, 0);
  $clipbuff = substr( $buff, 0, $rbufflen);
  print OFILE $clipbuff; }
for ($i = 1; $i <= $rheight; $i++)  { 
  read( RFILE, $buff, $rbufflen, 0);
  print OFILE $buff; }
close( RFILE );
close( LFILE );
close( OFILE );