pkg://genscheme-1.1.tar.gz:32227/genscheme-1.1/genscheme.pl  downloads

$version = "1.1";
############################################################################
# genscheme - process color schemes
#
# Copyright 1996-97 Andrew Veliath <veliaa@rpi.edu>
#
# $Id: genscheme.pl,v 0.7 1996/12/27 01:20:54 drewvel Exp $
############################################################################
require 5.003;
use Getopt::Long;

############################################################################
package ColorScheme;

sub new {
    my $this = shift;
    my %parms = @_;
    my $class = ref($this) || $this;
    my $self = {};
    bless $self, $class;
    $self->{file} = $parms{'input'};
    $self->initialize;
    return $self;
}

sub initialize {
    my $self = shift;
    my $fh = $self->{file};
    $self->{scheme} = [];
    $self->{count} = 0;
    while (<$fh>)
    {
	if (/^(\w*)\s+(?:"(.*)"|(.*))/) {
	    if ("$1" eq "Scheme") {
		++$self->{count};
		$self->{scheme}[$self->{count}] = {};
		$self->{scheme}[$self->{count}]{Name} = "$2" ? "$2" : "$3";
	    } elsif ("$1") {
		$tmp = "$2" ? "$2" : "$3";
		$/ = "
"; chomp($tmp); $/ = "\n";
		$self->{scheme}[$self->{count}]{$1} = $tmp;
	    }
	}
    }
}

############################################################################
package main;

sub make_defines {
    my $s = $_[0];
    my $defs = "";
    my $i = 0;
    foreach $color (%$s) {
	if ((++$i%2)==0) {
	    $defs = $defs . "$color\" ";
	} else {
	    $defs = $defs . "-D$color=\"";
	}
    }
    return \$defs;
}

sub usage {
    print STDERR "\n";
    print STDERR "Genscheme $version\n";
    print STDERR "Copyright 1996-97 Andrew Veliath <veliaa\@rpi.edu>\n";
    print STDERR "\n";
    print STDERR "Usage: genscheme [options] template\n";
    print STDERR "\n";
    print STDERR "Template directory is set to: $tmpl_dir\n";
    print STDERR "\n";
    print STDERR "See the man page for options.\n";
    print STDERR "\n";
};

$outputdir="genscheme.out";
$append_fn = "append.out";
$m4opts = "";
$suffix = "";
$regex = "";

$parse_err = 
    !GetOptions(
		"o=s" => \$outputdir,
		"T=s" => \$tmpl_dir,
		"appendfn=s" => \$append_fn,
		"m4opts=s" => \$m4opts,
		"suffix=s" => \$suffix,
		"regex=s" => \$regex
		);

if ($parse_err||($#ARGV<0)) {
    usage();
    exit 1;
}

$template = $ARGV[0];
$tmpl = "$tmpl_dir/$template";
$append_fn = $append_fn . $suffix;
$gendefines = "$m4opts -DOutputDir=\"$outputdir\"";

if (!-d "$tmpl") {
    print STDERR "$0: cannot open template, tried $tmpl (-T option?)\n";
    exit 1;
}

$S = new ColorScheme('input'=> \*STDIN);

undef $/;

mkdir($outputdir,0755);
if (-e "$tmpl/init_append") {
    print STDERR "Processing init_append...\n";
    open(INPUT,"$m4_prog $gendefines $tmpl/init_append|") || die "open: $!";
    open(OUTPUT,">>$outputdir/$append_fn") || die "open: $!";
    if ($readpipe = <INPUT>) {
	print OUTPUT $readpipe;
    }
    close(OUTPUT);
    close(INPUT);
}

$count = 0;
if (-e "$tmpl/append") {
    print STDERR "Processing append...\n";
    open(OUTPUT,">>$outputdir/$append_fn") || die "open: $!";
    for ($i = 1; $i <= $S->{count}; ++$i) {
	if ($regex) {
	    next if !eval "\$S->{scheme}[$i]{Name} =~ $regex;";
	}
	++$count;
	my $defs = make_defines(\%{$S->{scheme}[$i]});
	open(INPUT,"$m4_prog $gendefines $$defs$tmpl/append|") || die "open: $!";
	if ($readpipe = <INPUT>) {
	    print OUTPUT $readpipe;
	}
	close(INPUT);
    }
    close(OUTPUT);
}

if (-e "$tmpl/end_append") {
    print STDERR "Processing end_append...\n";
    open(INPUT,"$m4_prog $gendefines $tmpl/end_append|") || die "open: $!";
    open(OUTPUT,">>$outputdir/$append_fn") || die "open: $!";
    if ($readpipe = <INPUT>) {
	print OUTPUT $readpipe;
    }
    close(OUTPUT);
    close(INPUT);
}

$count = 0;
if (-e "$tmpl/foreach") {
    print STDERR "Processing foreach...\n";
    for ($i = 1; $i <= $S->{count}; ++$i) {
	if ($regex) {
	    next if !eval "\$S->{scheme}[$i]{Name} =~ $regex;";
	}
	++$count;
	my $defs = make_defines(\%{$S->{scheme}[$i]});
	open(INPUT,"$m4_prog $gendefines $$defs$tmpl/foreach|") || die "open: $!";
	open(OUTPUT,">>$outputdir/$S->{scheme}[$i]{Name}$suffix") || die "open: $!";
	if ($readpipe = <INPUT>) {
	    print OUTPUT $readpipe;
	}
	close(OUTPUT);
	close(INPUT);
    }
}
print STDERR "$count scheme(s) matched.\n";