#!/usr/bin/perl 

use strict;
use vars qw(@LINE $scene_cond);

my $CFILE = my $cfile = "genact";

$cfile =~ tr/A-Z/a-z/;
$CFILE =~ tr/a-z/A-Z/;
$CFILE =~ tr/a-zA-Z0-9/_/c;

while(<>){
  if(/^\#/){
    next;
  }
  else{
    push(@LINE, $_);
  }
}

my $def_action = `egrep '^def_action_' action.c`;
my @def_action = split(/\n/, $def_action);
map {s/\(.*//;}@def_action;

my $hook_action = `egrep '^hook_action_' action.c`;
my @hook_action = split(/\n/, $hook_action);
map {s/\(.*//;}@hook_action;

open C, ">$cfile.c";
print C <<_T_;
#include <stdio.h>
#include <string.h>

#include "minami.h"
#include "scene.h"
#include "item.h"
_T_

my $mode = undef;
my $n_scene = 1;
my $scene;

my @scene_name;

my %action_func;
my %action;
my %action_lint;
my %map;

my %verb_list;
my %obj_list;

my %dict;
my @dict;
my $dict_re;

open DICT, "DICT.d";
while(<DICT>){
  if(/^\#/){
    next;
  }
  my @l = split(/\s+/, $_);
  my $key = shift @l;
  my $val = join(" ", @l);
  my $f;

  if($key =~ /^\!/){
    $key = $';
    $f = 1;
  }
  if($key and $val){
    $dict{$key} = $val;
    if(!$f){
      push(@dict, $key);
    }
  }
}
close DICT;

$dict_re = join("|", @dict);

while(@LINE){
  $_ = shift(@LINE);
  chop;

  if(/%%% /i){
    my $tmp;

    ($scene, $scene_cond) = split(/:/, $');
    $scene_cond =~ s/\s//g;
    if(!$scene_cond){
      $scene_cond = "1";
    }

    while(@LINE){
      $_ = shift(@LINE);
      if(/^%%%/){
	unshift(@LINE, $_);
	last;
      }
      else{
	$tmp .= $_;
      }
    }
    
    my @l = split(/\@/, $tmp);
    while(@l){
      $_ = shift @l;
      if($_){
	my @l = split(/:/, $_);
	if($l[1] =~ /\//){	# object style
	  my $obj = shift @l;
	  $obj =~ s/\n//g;
	  my @args = @l;
	  while(@args){
	    $_ = shift(@args);
	    my @ll = split(/\//, $_);
	    my ($verb, $cond, $hook, $prog, $msg)= @ll;
	    if($#ll >= 5){
	      print STDERR "Warning: to many field: @ll\n";
	    }
	    if($verb){
	      &print_code($verb, $obj, $cond, $prog, $msg, $hook);
	    }
	  }
	}
	else{			# verb style
	  my $verb;
	  my $obj;
	  my @l = split(/:/, $_);
	  my ($cmd, $cond, $hook, $prog, $msg) = @l;
	  if($#l >= 5){
	    print STDERR "Warning: to many field: @l\n";
	  }

	  my @cmd = split(/\|/, $cmd);

	  while(@cmd){
	    $cmd = shift @cmd;

	    if($cmd =~ / /){
	      $verb = $`;
	      $obj = $';
	    }
	    else{
	      $verb = $cmd;
	      $obj = '';
	    }
	    if($verb){
	      &print_code($verb, $obj, $cond, $prog, $msg, $hook);
	    }
	  }
	}
      }
    }
  }
}

my @lint = keys %action_lint;
my $i;
foreach $i (keys %action_lint){
  my @l = split(/:/, $i);
  my $v = $action_lint{$i};

  my ($verb, $obj, $scene_cond, $cond, $scene) = @l;

  if(!$action_lint{"$l[0]:$l[1]:$l[2]:1:$l[4]"} and $scene !~ 'VOID'){
    if($scene="ITEM"){
      ;
    }
    else{
      print STDERR "Warning: no default action for $v/$i\n";
    }
  }
  if(!$action_lint{"look::$scene_cond:1:$scene"} and $scene ne 'ITEM'){
    print STDERR "Warning: no default look $v/$i\n";
  }
  if($verb ne "look" and $obj =~ /[a-z]/ && !$action_lint{"look:$l[1]:$l[2]:1:$l[4]"} and $scene !~ 'VOID'){
    $_ = $action_lint{"look:$l[1]:1:I_Have(item):ITEM"};
    if(!$_){
      print STDERR "Warning: no look action for $obj ($i)\n";
    }
  }
  if($obj =~ /[A-Z]/){
    print STDERR "Warning: capital character in '$obj' ($i)\n";
  }
  if($scene ne "VOID" and $verb ne "n" and $verb ne "s"
     and $verb ne "e" and $verb ne "w"
     and $verb ne "u" and $verb ne "d"
     and $verb ne "look" and $verb ne "msg" and $verb ne "search"
     and $verb ne "hear" and $verb ne "enter" and $verb ne "exit"
     and $verb ne "help" and $verb ne "yes" and $verb ne "no"
     and $verb ne "c"){
    if(!$obj){
#      print STDERR "Warning: no objective word ($i)\n";
      ;
    }
  }

}

if(!-e "action"){
  mkdir "action", 0777;
}

open MAKEFILE, ">action/Makefile";

my @k = keys %action;
map{$_ = "$_.o";}@k;
print MAKEFILE <<_T_;

CFLAGS = -g -O -Wall

libaction.a: @k
	-rm -f libaction.a
	ar ur libaction.a @k
	ranlib libaction.a
	touch libaction.a
_T_

foreach $i (keys %action)
{
  print MAKEFILE <<_T_;
$i.o: ../minami.h
	\$(CC) \$(CFLAGS) -c $i.c -o $i.o
_T_
  print C "extern int action_$i(int, const char *, const char *);\n";

  open ACTION_FUNC, ">action/$i";
  print ACTION_FUNC <<_T_;

#include <stdio.h>
#include "../minami.h"
#include "../scene.h"
_T_
  print ACTION_FUNC $action_func{$i};
  print ACTION_FUNC <<_T_;
	if(0)/* dummy */
		;
_T_
  print ACTION_FUNC $action{$i};
  print ACTION_FUNC <<_T_;
   
	minami[cur_scene].cnt = cnt;
    }while(redo);

    return contflg;
\}
_T_
  close ACTION_FUNC;
  if(!-e "action/$i.c"){
    print "generate action/$i.c\n";
    rename "action/$i", "action/$i.c";
  }
  elsif(system("diff -c action/$i action/$i.c >/dev/null 2>&1") != 0){
    print "update action/$i.c\n";
    rename "action/$i", "action/$i.c";
  }
}
close MAKEFILE;

print C <<_T_;
int
CheckMove(int cur_scene)
\{
	int cnt = minami[cur_scene].cnt;
	int map = 0;

_T_

foreach $i (keys %map){
  print C $map{$i};
}
	
print C <<_T_;
	return map;
\}
_T_

print C <<_T_;

ActionTab actionTab[] = {
_T_

foreach $i (keys %action)
{
  print C qq'\t{$i, action_$i},\n';
}
print C <<_T_;
	\{0, NULL},
\};
_T_

print C <<_T_;

VerbTab verbTab[] = {
_T_
foreach $i (@def_action)
{
  $i =~ /^def_action_/;
  my $verb = $';
  print C qq'\t{"$verb", $i},\n';
}
print C <<_T_;
	\{0, NULL},
\};
_T_

close C;

open LIST, ">verb.list";
foreach $i (keys %verb_list){
  print LIST "$i\n";
}
close LIST;

open LIST, ">obj.list";
foreach $i (keys %obj_list){
  print LIST "$i\n";
}
close LIST;

sub print_code{
  my ($verb, $obj, $cond, $prog, $omsg, $hook) = @_;
  $verb =~ s/^\s*//;
  $verb =~ s/\s*$//;
  if(!$verb){
    return;
  }
  $obj =~ s/^\s*//;
  $obj =~ s/\s*$//;

#ե뤫鼫ưС      
  $omsg =~ s/\"([^\"]+)\"/$1$dict{$1}/g;
  $omsg =~ s/^\s+//g;
  $omsg =~ s/\s+$//g;
  if($omsg =~ /ڡ/){
    print STDERR "Warning: No dictionaly at $omsg\n";
  }
  if($omsg =~ // and $omsg !~ //){
    print STDERR "Warning: No `' in $omsg\n";
  }
#  if($omsg =~ /[a-zA-Z]/){
#    my $q = $&;
#    if($q !~ /^\$\w$/){
#      print "Warning: hankaku in $omsg\n";
#    }
#  }
    
  my @verb = split(/\|/, $verb);

  while(@verb){
    my $verb = shift @verb;
    my @obj = split(/\|/, $obj);

    if(!@obj){
      @obj = ('');
    }
    while(@obj){
      my $msg = $omsg;
      my $obj = shift @obj;
      my $qu;
      my $vqu;

      $verb_list{$verb} .= "$scene ";
      $obj_list{$obj} .= "$scene ";


      if($verb =~ /^\?/){
	$verb =~ s/^\?//;
	$vqu = 1;
      }

      if($obj =~ /^\?/){
	$obj =~ s/^\?//;
	$qu = 1;
      }

      $prog =~ s/\n$//;
      $hook =~ s/\n$//;
      if(!$hook){
	$hook = "MIN_CONT";
      }
  
      if($cond eq undef){
	$cond = "1";
      }

      my $action_idx;
      my $objcmp;
      my $verbcmp;

      if($vqu){
	$verbcmp = qq'(EQ(verb, "$verb")||!*verb)';
      }
      elsif($verb =~ /^\*/){
	$verbcmp = qq'1';
      }
      else{
	$verbcmp = qq'EQ(verb, "$verb")';
      }

      if($qu){
	$objcmp = qq'(EQ(obj, "$obj")||!*obj)';
      }
      elsif($obj =~ /^\*/){
	$objcmp = qq'1';
      }
      else{
	$objcmp = qq'EQ(obj, "$obj")';
      }

#mapޥ
      if($obj eq undef and $cond !~ /tmp/ and $prog =~ /NewScene/ and
	 ($verb eq "n" or $verb eq "s" or $verb eq "w" or $verb eq "e" or
	  $verb eq "forward" or $verb eq "back" or
	  $verb eq "u" or $verb eq "d" or $verb eq "enter" or $verb eq "exit")){
	$map{$scene} .= <<_T_;
	if($scene_cond && $cond && cur_scene == $scene)
		map |= MAP_$verb;
_T_
      }

      $action_idx = "${scene}";
      if(!$action{$action_idx}){
	$action_func{$action_idx} = <<_T_;
int
action_$action_idx(int cur_scene, const char *verb, const char *obj)
\{
    int contflg = MIN_CONT;
    Minami *m = &minami[cur_scene];
    int cnt = m->cnt;
    int redo;
    int tmp;
    int item;
    ItemTab *itab;

    tmp = 0;
    itab = ItemByName(obj);
    if(itab)
	item = itab->n;
    else
        item = 0;

    do\{
	redo = 0;
_T_
      }
      my $cont = "MIN_OK";
      if($verb eq "n" or $verb eq "s" or $verb eq "w" or $verb eq "e" or
	 $verb eq "forward" or $verb eq "back" or
	 $verb eq "u" or $verb eq "d" or $verb eq "enter" or $verb eq "exit"){
	$msg .= "ġġ";
      }
      if($msg =~ /^ۤ餷/){
	$msg = "";
	$cont = "MIN_CONT";
      }
      $msg =~ tr/a-mn-z/n-za-m/;
      $msg =~ tr/A-MN-Z/N-ZA-M/;
      $msg =~ tr/\xa1-\xcf\xd0-\xfe/\xd0-\xfe\xa1-\xcf/;

      $action_lint{"$verb:$obj:$scene_cond:$cond:$scene"} = $scene;
      my $def_hook;
      if(grep(/^hook_action_$verb$/, @hook_action)){
	$def_hook = "hook_action_$verb(cur_scene, verb, obj)";
      }
      else{
	$def_hook = "MIN_CONT";
      }

      $action{$action_idx} .= <<_T_;
	else if(cur_scene==$scene && $verbcmp && $objcmp && $scene_cond && $cond)\{
		if($hook==MIN_CONT && $def_hook==MIN_CONT){
			rotmsg("$msg");
			$prog;
		}
		contflg = $cont;
	\}
_T_
    }
  }
}

__END__
