1#!/usr/local/bin/perl
2#eval 'exec /usr/local/bin/perl -S $0 ${1+"$@"}'
3#	if $running_under_some_shell;
4
5require "getopts.pl";
6&Getopts('o:');
7#die "Usage: scn2g [-o outfile] [infile]\n" if @ARGV > 1;
8
9#
10# Get stdout set up and the default module name
11#
12if ( $opt_o ) {
13    #
14    # If they give us an output file name, open it
15    # and use it as the module name (minus path and extension).
16    #
17    open(STDOUT, ">$opt_o") || die "Couldn't open $opt_o for output: $!\n";
18    ($m = $opt_o) =~ s#(.*/)?(.*)\.g$#$2#;
19} elsif (@ARGV) {
20    #
21    # If they give us an input file,
22    # use it as the output file name (minus path and extension plus .g)
23    # and use it as the module name (minus path and extension).
24    #
25    ($m = $ARGV[0]) =~ s#(.*/)?(.*)\.scn$#$2#;
26    unless ( -e "$m.g" ) {
27	open(STDOUT, ">$m.g") || die "Couldn't open $m.g for output: $!\n";
28    }
29} else {
30    #
31    # OK, we got nothin', output is stdout and module name is junk.
32    #
33    $m = 'xxx';
34}
35
36$\ = "\n";	# terminate every print with a newline.
37
38@types = ( 'pt_value', 'units', 'resources', 'unit_at' );
39
40LINE:
41while (<>) {
42    # strip trailing whitespace (and the newline).
43    s/\s*$//;
44
45    if (/^Xconq (\d+) [\+-]* ([^;]*)(;?)$/) {
46	local($n) = $1;
47        print qq/(game-module "$m"\n  (blurb "$2")/;
48	if ( $3 ) {
49	    print "  (game-module (notes (";
50	    COMMENT:
51	    while (<>) {
52		last COMMENT if /^\.$/;
53		chop;
54		print;
55	    }
56	    print "  ))";
57	}
58	while ( $n-- ) {
59	    chop($f = <>);
60	    print(qq/  (base-module "$1")/), next if $f =~ /^(\S*)\.per$/;
61	    push(@incfiles, $f);
62	}
63        print ")\n";
64	foreach $f ( @incfiles ) {
65	    print qq/(include "$f")/;
66	}
67	next LINE;
68    } elsif (/^Globals/) {
69	split;
70	&read_globs(@_[1..5]);
71	next LINE;
72    } elsif (/^Sides/) {
73	split;
74	&read_sides(@_[1], @_[2]);
75	next LINE;
76    } elsif (/^Units/) {
77	split;
78	($num, $detail) = @_[1,2];
79	&read_unit($detail) while ($num--);
80	next LINE;
81    }
82
83    s/^/;/;
84    print;
85}
86
87sub read_globs {
88    local($first_turn, $last_turn, $set_prod, $leave, $conds) = @_;
89    local($n);
90
91    print "; fixed production" if $set_prod;
92    print "; leave from edges" if $leave;
93    print "(set turn $first_turn)" if $first_turn;
94    print "(set last-turn $last_turn)";
95
96    print "";
97    for ($n = 1; $n <= $conds; ++$n) {
98	chop($_ = <>);
99	local($w, $t, $st, $end, $s) = split;
100	$w = ($w = 0)? 'lose' : 'win';
101	$s++;
102	print qq/(scorekeeper |cond$n| (title "$types[$t]")/;
103	print "  (applies-to $s)" unless ($s == -1);
104	print "; (trigger if turn > $st and turn < $end)";
105
106	chop($_ = <>);
107	print "; (do if ($types[$t] $_) $w)";
108
109	print ")";
110    }
111}
112
113sub read_sides {
114    local($num, $detail) = @_;
115    local($n);
116
117    print "";
118    for ($n = 1; $n <= $num; ++$n) {
119	$_ = <>;
120	chop($_);
121	push(@sides, $_);
122	print qq/(side $n (name "$_")/;
123
124	if ( $detail > 1 ) {
125	    local(@t);
126	    $_ = <>;
127	    split;
128	    for ($i = 1; $i < $num + 1; ++$i) {
129		push(@t, (@_[$i] == 100)? 'true' : 'false');
130	    }
131	    print "  (trusts @t)";
132	}
133	if ( $detail > 2 ) {
134	    print STDERR "Oh, shit, I don't know what to do with all this";
135	}
136	print ")";
137    }
138    print "(set sides-min $num) (set sides-max $num)\n";
139}
140
141sub read_unit {
142    local($detail) = @_;
143
144    chop($_ = <>);
145    local($char, $name, $loc, $owner) = split;
146    $loc =~ s/,/ /;
147    ++$owner;
148    $name =~ s/\*/ /g;
149    print "($char $loc $owner";
150    print qq/  (n "$name")/ unless $name eq ' ';
151
152    if ( $detail > 1 ) {
153	chop($_ = <>);
154	split;
155	local($no, $hp, $qual, $prod, $tl, $before, $trans) = @_[1,3,4,7..10];
156	local(@res) = splice(@_, 11);
157	print "  (nb $no) (hp $hp) (m @res)";
158	print "  (in $trans)" if $trans != -1;
159	print "  (cxp $qual)" if $qual != 0;
160	# no handling of production type, turns left in build or made before.
161    }
162    if ( $detail > 2 ) {
163	print STDERR "Oh no, I don't know what to do with all this";
164    }
165    print ")";
166}
167