conv_dsw.pl

十七种模拟器源代码 非常有用的作课程设计不可缺少的

#!/usr/bin/perl

use strict;

my %raine_dsw =
    (
     "Unknown" => "MSG_UNKNOWN",
     "Off" => "MSG_OFF",
     "On" => "MSG_ON",
     "Coin_A" => "MSG_COIN1",
     "9C_1C" => "MSG_9COIN_1PLAY",
     "8C_1C" => "MSG_8COIN_1PLAY",
     "7C_1C" => "MSG_7COIN_1PLAY",
     "6C_1C" => "MSG_6COIN_1PLAY",
     "5C_1C" => "MSG_5COIN_1PLAY",
     "4C_1C" => "MSG_4COIN_1PLAY",
     "3C_1C" => "MSG_3COIN_1PLAY",
     "2C_1C" => "MSG_2COIN_1PLAY",
     "2C_2C" => "MSG_2COIN_2PLAY",
     "1C_1C" => "MSG_1COIN_1PLAY",
     "1C_2C" => "MSG_1COIN_1PLAY",
     "1C_3C" => "MSG_1COIN_3PLAY",
     "1C_4C" => "MSG_1COIN_4PLAY",
     "1C_5C" => "MSG_1COIN_5PLAY",
     "1C_6C" => "MSG_1COIN_6PLAY",
     "1C_7C" => "MSG_1COIN_7PLAY",
     "1C_8C" => "MSG_1COIN_8PLAY",
     "1C_9C" => "MSG_1COIN_9PLAY",
     "Coin_B" => "MSG_COIN2",
     "Demo_Sounds" => "MSG_DEMO_SOUND",
     "Flip_Screen" => "MSG_SCREEN",
     "Cabinet" => "MSG_CABINET",
     "Upright" => "MSG_UPRIGHT",
     "Cocktail" => "MSG_TABLE",
     "Difficulty" => "MSG_DIFFICULTY",
     "Bonus_Life" => "MSG_EXTRA_LIFE",
     "Lives" => "MSG_LIVES",
     "Yes" => "MSG_YES",
     "No" => "MSG_NO",
     "Free_Play" => "MSG_FREE_PLAY",
     "Unused" => "MSG_UNUSED",
     "Coinage" => "MSG_COINAGE",
     );

sub get_raine_dsw($) {
  my $dsw = shift;
  my $function;
  if ($raine_dsw{$dsw}) {
    $function = $raine_dsw{$dsw};
  } else {
    print STDERR "Unknown DSW $dsw\n";
    exit(1);
  }
  $function;
}

my $port = $ARGV[1] || 0;
if ($port =~ /^0x/) {
  $port = hex($port);
}
$port-=2;
my $port0 = $port;
my $default = 0;
my $output;
my $started = undef;
my $length;
my ($bit,$def,$function);
my $main_out="";
my $dsw_name;

open(F,"<$ARGV[0]") || die "Impossible to open $ARGV[0]";
while (<F>) {
  if (/INPUT_PORTS_START\( (.+?) \)/) {
    my $name = $1;
    my @dsw = ();
    $name = "_".$name if ($name =~ /^\d/);
    my $nb = -1;
    $dsw_name = undef;
    while (<F>) {
      if (/PORT_START/) {
	if ($dsw_name) {
	  if ($length) {
	    push @dsw,[$dsw_name,$default,$port];
	    print "static struct DSW_DATA dsw_data_$name\_$nb\[\] =\n{\n";
	    print "$main_out  { NULL, 0, 0}\n};\n\n";
	  }
	}
	$nb++;
	$length = 0;
	$port+=2;
	$default = 0;
	$main_out = "";
	$dsw_name = "dsw_data_$name\_$nb";
	$started = undef;
      } elsif (/PORT_DIPNAME\( (.+) \)/) {
	my $args = $1;
	if ($started) {
	  if ($length < 1) {
	    print STDERR "Problem of output\n";
	    exit(1);
	  }
	  $main_out .= "  { $function, $bit, $length },\n$output";
	}
	$started = 1;
	my $rest;
	if ((($bit,$def,$function,$rest) = split(/\, ?/,$args))) {
	  $function .= ",$rest" if ($rest);
	  $def = hex($def) if ($def =~ /^0x/);
          $default |= $def;
	  $output = "";
	  $length = 0;
	  if ($function =~ /DEF_STR\( ?(.+?) ?\)/) {
	    $function = get_raine_dsw($1);
          }
	} else {
	  print STDERR "Parsing error : $args\n";
	  exit(1);
	}
      } elsif (/PORT_SERVICE\( *(.+) *\)/) {
	my $args = $1;
	my ($mask,$bit) = split(/\, */,$args);
	$output .= "  { MSG_SERVICE, $mask,2 },\n";
	if ($bit =~ /IP_ACTIVE_LOW/) {
	  $output .= "  { MSG_ON, 0,0 },\n";
	  $output .= "  { MSG_OFF, $mask,0 },\n";
	  $mask = hex($mask);
	  $default |= $mask;
	} elsif ($bit =~ /IP_ACTIVE_HIGH/) {
	  $output .= "  { MSG_OFF, 0,0 },\n";
	  $output .= "  { MSG_ON, $mask,0 },\n";
	} else {
	  print STDERR "Unknown service port $args ($bit)\n";
	  exit(1);
	}
      } elsif (/PORT_DIPSETTING\( *(.+) *\)/) {
	my $args = $1;
	my ($mask,$f2,$rest) = split(/\, */,$args);
	$f2 .= $rest if ($rest);
	if ($f2 =~ /DEF_STR\( ?(.+?) ?\)/) {
	  $f2 = get_raine_dsw($1);
	}
	$output .= "  { $f2, $mask, 0x00 },\n";
	$length++;
      } elsif ($started) { # end of the dsw section if started
	$main_out .= "  { $function, $bit, $length },\n$output";
      }
      last if (/PORTS_END/);
    } # while (<F>)
    $started = undef;
    $port = $port0;
    
    # dsw_info
    if ($#dsw>=0) {
      print "static struct DSW_INFO $name\_dsw\[\] =\n{\n";
      for (my $n=0; $n<=$#dsw; $n++) {
	my ($dname, $def, $port) = @{$dsw[$n]};
	print "  { $port, 0x",sprintf("%02x",$def),", $dname },\n";
      }
      print "  { 0, 0, NULL }\n";
      print "};\n\n";
    }
  }
}
close(F);