#!/usr/bin/perl

# Mud-Lua Interface Generation
# Copyright (c) 2002 Abi Brady

print "#define i_int int\n";
print "#define i_bool int\n";
print "#define i_char char\n";
print "#define i_world World<MudObject>\n";
print "#define i_object MudObject *\n";
print "#define i_nilobject MudObject *\n";
print "#define i_player Player *\n";
print "#define i_protobject MudObject *\n";
print "#define i_string const char *\n";
print "#define i_flag Flag\n";
print "#define i_priv PFlag\n";
print "#define i_nilstring const char *\n";
print "#define i_table Table\n";

print "#define r_int int\n";
print "#define r_bool int\n";
print "#define r_char char\n";
print "#define r_world World<MudObject>\n";
print "#define r_object MudObject *\n";
print "#define r_protobject MudObject *\n";
print "#define r_string string\n";
print "#define r_nilstring const char *\n";

print "\n";

$ln = 0;

$table = "";

LINE:
while (<STDIN>) {
    s/\n//;
    $q = $_;
    $ln = $ln + 1;
    $silent = 0;

    if (substr($q, 0, 1) eq "#" || length($q)==0) {
	next LINE;
    }

    ($line, $cxx) = /(^[_A-za-z0-9\:, ()]*)= (.*)/;

    if (!$line || !$cxx) {
	next LINE;
    }

#    print STDERR "[$line] [$cxx]\n";
#    next LINE;

    if (length($cxx)==0) {
      print STDERR "mkhooks: no code\n";
      exit 1;
    }
    
    $void = 0;

    $rtype = substr($line, 0, index($line, " "));
    $fname = substr($line, index($line, " "));
    
    if ($rtype eq "void") { $void = 1; }
    
    $args = substr($fname, index($fname, "(")+1);
    $args = substr($args, 0, length($args)-2);
    
    $fname = substr($fname, 1, index($fname, "(")-1);
    
    @arg = split(',', $args);
#    print STDERR "l_$fname()\n";	
    print "int l_$fname(lua_State *L) {\n";
    print "  string args;\n";
    
    if (!$silent) {
	$table = $table . "lua_register(L, \"$fname\", l_$fname); \\\n";
    }
    
    if ($silent) {
       print "  if (lua_gettop(L)>", scalar @arg, ") return -1;\n";
    } else {
       print "  if (lua_gettop(L)>", scalar @arg, ") lua_error(L, \"bad number of args to $fname\");\n";
   }

    for ($i=0;$i<scalar @arg;$i++) {
	$idx = $i+1;
	@blah = split(' ', $arg[$i]);
	$def = 0;
	if (index($blah[1], ":")!=-1) {
	    $blah[1] = substr($blah[1], 0, index($blah[1], ":"));
	    $def = 1;
	}
	if ($blah[0] eq "nilobject") {
	    if ($def) {
		print "  if (lua_gettop(L)>=$idx)";
	    }

	    print "  if (!l_isnilobject(L, $idx)) lua_error(L, \"expected a (possibly-nil) object for arg $idx of $fname\");\n";

	    print "  i_$blah[0] $blah[1] = lua_gettop(L)>=$idx?l_getobject(L, $idx):0;\n";
	    print "if (lua_tracing())\n";
	    print "  args += ssprintf(\"%s, \", esc(".$blah[1].").c_str());\n";
	} elsif ($blah[0] eq "object" || $blah[0] eq "protobject" || $blah[0] eq "player") {
	    if ($def) {
		print "  if (lua_gettop(L)>=$idx)";
	    }
	    if ($silent) {
		print "  if (!l_isobject(L, $idx)) return -1;\n";
	    } else {
		print "  if (!l_isobject(L, $idx)) lua_error(L, \"expected an object for arg $idx of $fname\");\n";
	    }
	    if ($def) {
		if ($blah[0] eq "player") {
		    print "  i_$blah[0] $blah[1] = lua_gettop(L)>=$idx?dynamic_cast<Player*>(l_getobject(L, $idx)):0;\n";
		    print "  if (!$blah[1]) lua_error(L, \"expected a player for arg $idx of $fname.\");\n";
		} else {
		    print "  i_$blah[0] $blah[1] = lua_gettop(L)>=$idx?l_getobject(L, $idx):0;\n";
		}
		
	    } else {
		if ($blah[0] eq "player") {
		    print "  i_$blah[0] $blah[1] = dynamic_cast<Player*>(l_getobject(L, $idx));\n";
		    print "  if (!$blah[1]) lua_error(L, \"expected a player for arg $idx of $fname.\");\n";
		} else {
		    print "  i_$blah[0] $blah[1] = l_getobject(L, $idx);\n";
		}
	    }
	    if ($blah[0] eq "protobject") {
		print "  if (!writeaccess($blah[1])) lua_error(L, \"permission violation in $fname\");\n";
	    }
	    print "if (lua_tracing())\n";
	    print "  args += ssprintf(\"%s, \", esc(".$blah[1].").c_str());\n";
	} elsif ($blah[0] eq "flag") {
	    if ($silent) {
		print "  if (!lua_isnumber(L, $idx)) return -1;\n";
	    } else {
		print "  if (!lua_isnumber(L, $idx)) lua_error(L, \"expected number for arg $idx of $fname\");\n";
	    }
	    print "  i_$blah[0] $blah[1] = i_flag(lua_tonumber(L, $idx)-1);\n";
	    print "if (lua_tracing())\n";
	    print "  args += ssprintf(\"flag.%s, \", flag_names[$blah[1]]);\n";
	} elsif ($blah[0] eq "priv") {
	    if ($silent) {
		print "  if (!lua_isnumber(L, $idx)) return -1;\n";
	    } else {
		print "  if (!lua_isnumber(L, $idx)) lua_error(L, \"expected number for arg $idx of $fname\");\n";
	    }
	    print "  i_$blah[0] $blah[1] = i_priv(lua_tonumber(L, $idx)-1);\n";
	    print "if (lua_tracing())\n";
	    print "  args += ssprintf(\"priv.%s, \", priv_names[$blah[1]]);\n";
	} elsif ($blah[0] eq "int") {
	    if ($silent) {
		print "  if (!lua_isnumber(L, $idx)) return -1;\n";
	    }  else {
		print "  if (!lua_isnumber(L, $idx)) lua_error(L, \"expected number for arg $idx of $fname\");\n";
	    }
	    print "  i_$blah[0] $blah[1] = (i_int)lua_tonumber(L, $idx);\n";
	    print "if (lua_tracing())\n";
	    print "  args += ssprintf(\"%i, \", $blah[1]);\n";
	} elsif ($blah[0] eq "table") {
	    if ($silent) {
		print "  if (!l_isstringtable(L, $idx)) return -1;\n";
	    }  else {
		print "  if (!l_isstringtable(L, $idx)) lua_error(L, \"expected table for arg $idx of $fname\");\n";
	    }
	    print "  i_$blah[0] $blah[1] = l_totable(L, $idx);\n";
	    print "if (lua_tracing())\n";
	    print "  args += ssprintf(\"%s, \", esc($blah[1]).c_str());\n";
	} elsif ($blah[0] eq "world") {
	    if ($silent) {
		print "  if (!l_isworld(L, $idx)) return -1;\n";
	    }  else {
		print "  if (!l_isworld(L, $idx)) lua_error(L, \"expected table for arg $idx of $fname\");\n";
	    }
	    print "  i_$blah[0] $blah[1] = l_toworld(L, $idx);\n";
	    print "if (lua_tracing())\n";
	    print "  args += ssprintf(\"%s, \", esc($blah[1]).c_str());\n";
	} elsif ($blah[0] eq "bool") {
	    if ($def) {
		print "  if (lua_gettop(L)>=$idx)";
	    }
	    if ($silent) {
		print "  if (!(lua_isnumber(L, $idx) || lua_isnil(L,$idx))) return -1;\n";
	    } else {
		print "  if (!(lua_isnumber(L, $idx) || lua_isnil(L,$idx))) lua_error(L, \"expected bool for arg $idx of $fname\");\n";
	    }
	    print "  i_$blah[0] $blah[1] = (bool)(lua_gettop(L)>=$idx?(lua_isnil(L,$idx)?0:lua_tonumber(L, $idx)):0);\n";
	    print "if (lua_tracing())\n";
	    print "  args += ssprintf(\"%i, \", $blah[1]);\n";
	} elsif ($blah[0] eq "string") {
	    if ($def) {
		print "  if (lua_gettop(L)>=$idx)";
	    }
	    if ($silent) {
		print "  if (!lua_isstring(L, $idx)) return -1;\n";
	    } else {
		print "  if (!lua_isstring(L, $idx)) lua_error(L, \"expected string for arg $idx of $fname\");\n";
	    }
	    print "  i_$blah[0] $blah[1] = lua_gettop(L)>=$idx?lua_tostring(L, $idx):0;\n";
	    print "if (lua_tracing())\n";
	    print "  args += ssprintf(\"%s, \", esc($blah[1]).c_str());\n";
	} elsif ($blah[0] eq "nilstring") {
	    if ($silent) {
		print "  if (!lua_isstring(L, $idx) && !lua_isnil(L, $idx)) return -1;\n";
	    } else {
		print "  if (!lua_isstring(L, $idx) && !lua_isnil(L, $idx)) lua_error(L, \"expected string for arg $idx of $fname\");\n";		
	    }
	    print "  i_$blah[0] $blah[1] = lua_isnil(L, $idx)?NULL:lua_tostring(L, $idx);\n";
	    print "if (lua_tracing())\n";
	    print "  args += ssprintf(\"%s, \", esc($blah[1]).c_str());\n";
	} else {
	    print STDERR "mkhooks: bad parameter type '$blah[0]'\n";
	    exit 1;
	}
    }
    
    print "#line $ln \"hookdef.txt\"\n";
    if ($void) {
	print "  $cxx;\n";
    } else {
	if (substr($cxx, 0, 1) eq "{") {
	    if ($cxx eq "{") {
		print "  r_$rtype ret;\n{\n";
		while (<STDIN>) {
		    print $_;
		    chomp $_;
		    if ($_ eq "}") {
			goto end;
		    }
		}
	      end:
	    } else {
		print "  r_$rtype ret;\n$cxx;\n";
	    }
	} else {
	    print "  r_$rtype ret = $cxx;\n";
	}
    }
    
    print "if (lua_tracing()) {args=args.substr(0, args.length()-2);log(PFL_SEELUASPAM, 0, \"lua\", \n";
    if ($void) {
	print "  \"%s(%s)\", \"$fname\", args.c_str());\n";
    } elsif ($rtype eq "int") {
	print "  \"%s(%s) == %i\", \"$fname\", args.c_str(), ret);\n";
    } elsif ($rtype eq "bool") {
	print "  \"%s(%s) == %s\", \"$fname\", args.c_str(), ret?\"1\":\"nil\");\n";
    } elsif ($rtype eq "string" || $rtype eq "nilstring") {
	print "  \"%s(%s) == %s\", \"$fname\", args.c_str(), esc(ret).c_str());\n";
    } elsif ($rtype eq "char") {
	print "  \"%s(%s) == \\\"%c\\\"\", \"$fname\", args.c_str(), ret);\n";
    } elsif ($rtype eq "object") {
	print "  \"%s(%s) == %s\", \"$fname\", args.c_str(), esc(ret).c_str());\n";
    } elsif ($rtype eq "world") {
	print "  \"%s(%s) == %s\", \"$fname\", args.c_str(), esc(&ret).c_str());\n";
    } else {
	print STDERR "mkhooks: unknown return type $rtype\n";
        exit 1;
    }
    print "}";
    
    if ($void) {
	print "  return 0;\n";
    } else {
	if ($rtype eq "world") {
	    print "  l_pushworld(L, &ret);\n";
	} elsif ($rtype eq "int") {
	    print "  lua_pushnumber(L, ret);\n";
	} elsif ($rtype eq "bool") {
	    print "  ret?lua_pushnumber(L, ret):lua_pushnil(L);\n";
	} elsif ($rtype eq "char") {
	    print "  char realret[2]={ret, 0};lua_pushstring(L, realret);\n";
	} elsif ($rtype eq "string") {
	    print "  lua_pushstring(L, ret);\n";
	} elsif ($rtype eq "nilstring") {
	    print "  ret?lua_pushstring(L, ret):lua_pushnil(L);\n";
	} else {
	    print "  l_pushobject(L, ret);\n";
	}
	print "  return 1;\n";
    }
    print "}\n\n";
}

print "#define AUTODEFINE \\\n";
print $table;
print "\n";