sub read_strz($) {
    local *code = $_[0];
    $code =~ s/^([^\000]*)\000//s or die "No zero in $code";
    $text = $1;
    $text =~ s/\001/\0n/gs;
    $text =~ s/\002/\0c/gs;
    $text =~ s/([\001-\003\005\010-\037])/sprintf("\0%03o", ord($1))/egs;
    $text =~ s/\004(.)/sprintf("\0*\003%d\002*\0", ord($1))/egs;
    $text =~ s/\006(.)/sprintf("\0o\003%d\002o\0", ord($1))/egs;
    $text =~ s/\007(.)/sprintf("\0'\003%d\002'\0", ord($1))/egs;
    $text =~ s/([\200-\377])/chr(ord($1)-128).chr(32)/egs;
    $text =~ s/\{/ö/gs;
    $text =~ s/\}/Ö/gs;
    $text =~ s/\\/ä/gs;
    $text =~ s/\|/Ä/gs;
    $text =~ s/\[/ü/gs;
    $text =~ s/\]/Ü/gs;
    $text =~ s/~/ß/g;
    $text =~ s/\000/\\/gs;
    return $text;
}


@opcodes = ();
@verbs = ("0", "open", "close", "give", "turnon", 
	  "turnoff", "puton", "takeoff", "8",
	  "push", "pull", "use", "read",
	  "goto", "take", "whatis", "16",
	  "17", "18", "19", "20");
$verbs[250] = "run_ui";
$verbs[253] = "run";
$verbs[254] = "stop";
$verbs[255] = "any";


sub BYTE()  { 1 }
sub WORD()  { 2 }
sub ACTOR() { BYTE }
sub ROOM()  { BYTE }
sub JUMP()    { 3 }
sub VERB()  { 4 }
sub OBJ()   { 5 }
sub IDX()   { 6 }
sub BIDX()  { 7 }
sub SCRIPT(){ 8 }
sub IIIDX()   { IDX+256 }
sub IIBYTE()  { BYTE+256 }
sub IIWORD()  { WORD+256 }
sub IIACTOR() { ACTOR+256 }
sub IIOBJ()   { OBJ+256 }
sub IISCRIPT(){ SCRIPT+256 }
sub IIROOM()  { ROOM+256 }
sub IIVERB()  { VERB+256 }
sub IIDX()    { IDX+512 }
sub IBYTE()   { BYTE+512 }
sub IWORD()   { WORD+512 }
sub IACTOR()  { ACTOR+512 }
sub IOBJ()    { OBJ+512 }
sub ISCRIPT() { SCRIPT+512 }
sub IROOM()   { ROOM+512 }
sub IVERB()   { VERB+512 }
sub STRZ()    { 10 }
sub ACTORSET(){ 11 }
sub BYTEARR() { 12 }
sub WORDARR() { 13 }
sub RES()     { 14 }
sub VERBOPS()   { 15 }
sub IVERBOPS()   { 16 }
sub DOSENTENCE()   { 17 }
sub IDOSENTENCE()   { 17+512 }
sub BARRZ()   { 18 }

sub opc_m {
    my $mask = shift @_;
    my $opc = shift @_;
    my $descr = shift @_;
    my @params = @_;
    my $i;
    for ($i=0; $i < @params; $i++) {
	if ($params[$i] > 512) {
	    $params[$i] -= 256;
	    opc_m($mask >> 1, $opc | $mask, $descr, @params);
	    $params[$i] -= 256;
	    $mask >>=1;
	}
    }
    $opcodes[$opc] = [ $descr, @params ];
}

sub opc {
    opc_m(0x80, @_);
}

opc(0x00, "stopObjectCode");
opc(0x01, "putActor", IACTOR, IBYTE, IBYTE);
opc(0x02, "startMusic", IBYTE);
opc(0x03, "getActorRoom", IDX, IACTOR);
opc(0x04, "isGreater", IDX, IWORD, JUMP);
opc(0x05, "drawObjectAt", IOBJ, IBYTE, IBYTE);
opc(0x06, "getActorElevation", IDX, IACTOR);
opc(0x07, "setStatus1", IOBJ);
opc(0x08, "isEqual", IDX, IWORD, JUMP);
opc(0x09, "faceActorToObj", IACTOR, IWORD);
opc(0x0a, "move", IIIDX, IWORD);
opc(0x0b, "setObjPreposition", IOBJ, IBYTE);
opc(0x0c, "resourceRoutines", IBYTE, RES);
opc(0x0d, "walkActorToActor", IACTOR, IACTOR, BYTE);
opc(0x0e, "putActorAtObject", IACTOR, IOBJ);
opc(0x0f, "isStatus1", IOBJ, JUMP);
opc(0x10, "getObjectOwner", IDX, IWORD);
opc(0x11, "animateActor", IBYTE, IBYTE);
opc(0x12, "panCameraTo", IBYTE);
opc(0x13, "actorSet", IACTOR, IBYTE, ACTORSET);
opc(0x14, "say", IACTOR, STRZ);
opc(0x15, "getActorByCoord", IDX, IBYTE, IBYTE);
opc(0x16, "getRandomNr", IDX, IBYTE);
opc(0x17, "setStatus2", IOBJ);
opc(0x18, "jump", JUMP);
opc(0x19, "doSentence", IDOSENTENCE, IOBJ, IOBJ, IBYTE);
opc(0x1a, "move", IDX, IWORD);
opc(0x1b, "setBit", BIDX, IBYTE, IBYTE);
opc(0x1c, "startSound", IBYTE);
opc(0x1d, "isNotObjectClass", IOBJ, IBYTE, JUMP);
opc(0x1e, "walkActorTo", IACTOR, IBYTE, IBYTE);
opc(0x1f, "isStatus2", IOBJ, JUMP);
opc(0x20, "stopMusic");
opc(0x22, "doSaveGame", IDX, IBYTE);
opc(0x23, "getActorY", IDX, IACTOR);
opc(0x24, "loadRoomWithEGO", IOBJ, IROOM, BYTE, BYTE);
opc(0x26, "setVarRange", IDX, BYTEARR);
opc(0x2a, "add", IIIDX, IWORD);
opc(0x27, "setStatus3", IOBJ);
opc(0x28, "isNotEqualZero", IDX, JUMP);
opc(0x29, "setOwner", IOBJ, IACTOR);
opc(0x2a, "moveWord", IDX, IWORD);
opc(0x2b, "delayFromVar", BYTE);
opc(0x2e, "delay", BYTE, BYTE, BYTE);
opc(0x2f, "isStatus3", IOBJ, JUMP);
opc(0x30, "setWalkboxFlag", IBYTE, BYTE);
opc(0x31, "getBit", IDX, BIDX, IBYTE);
opc(0x32, "setCameraAt", IBYTE);
opc(0x33, "roomOps", IBYTE, IBYTE, BYTE);
opc(0x34, "getDist", IDX, IWORD, IWORD);
opc(0x35, "findObject", IDX, IBYTE, IBYTE);
opc(0x36, "walkActorToObj", IACTOR, IOBJ);
opc(0x37, "setStatus4", IOBJ);
opc(0x38, "isLess", IDX, IWORD, JUMP);
opc(0x3a, "sub", IDX, IWORD);
opc(0x3b, "waitActor", IACTOR);
opc(0x3c, "stopSound", IBYTE);
opc(0x3d, "setActorElevation", IACTOR, IBYTE);
opc(0x3f, "isStatus4", IOBJ, JUMP);
opc(0x40, "cutScene");
opc(0x42, "startScript", SCRIPT);
opc(0x43, "getActorX", IDX, IBYTE);
opc(0x44, "isLessEqual", IDX, IWORD, JUMP);
opc(0x46, "incr", IDX);
opc(0x47, "clearStatus1", IOBJ);
opc(0x48, "isNotEqual", IDX, IWORD, JUMP);
opc(0x4a, "chainScript", ISCRIPT);
opc(0x4c, "stopTopSentence");
opc(0x4f, "isNotStatus1", IOBJ, JUMP);
opc(0x50, "pickupObject", IOBJ);
opc(0x52, "actorFollowCamera??", IACTOR);
opc(0x54, "setObjectName", IWORD, STRZ);
opc(0x56, "getActorWalkState", IDX, IACTOR);
opc(0x57, "clearStatus2", IOBJ);
opc(0x58, "onBreakCutScene", BYTE, JUMP);
opc(0x5a, "add", IDX, IWORD);
opc(0x5c, "nop");
opc(0x5f, "isNotStatus2", IOBJ, JUMP);
opc(0x60, "cursorCommand", IWORD);
opc(0x62, "stopScript", ISCRIPT);
opc(0x63, "getActorFacing", IDX, IACTOR);
opc(0x66, "getNearestActor", IDX, IWORD);
opc(0x67, "clearStatus3", IOBJ);
opc(0x68, "getScriptRunning", IDX, ISCRIPT);
opc(0x6a, "sub", IIIDX, IWORD);
opc(0x6c, "getObjectUnk4", IDX, IOBJ);
opc(0x6e, "nop");
opc(0x6f, "isNotStatus3", IOBJ, JUMP);
opc(0x70, "lights", IBYTE, BYTE, BYTE);
opc(0x71, "getActorCostume", IDX, IACTOR);
opc(0x72, "loadRoom", IBYTE);
opc(0x77, "clearStatus4", IOBJ);
opc(0x78, "isGreaterEqual", IDX, IWORD, JUMP);
opc(0x7a, "verbOps", VERBOPS);
opc(0x7b, "getActorWalkbox", IDX, IACTOR);
opc(0xfa, "verbOps", IVERBOPS);
opc(0x7c, "getSoundRunning", IDX, IBYTE);
opc(0x7f, "isNotStatus4", IOBJ, JUMP);
opc(0x80, "yield");
opc(0x98, "quitPauseRestart");
opc(0xa0, "stopCurrentScript");
opc(0xa6, "setVarRange", IDX, WORDARR);
opc(0xa8, "isEqualZero", IDX, JUMP);
opc(0xac, "buildSentence");
opc(0xae, "wait");
opc(0xc0, "endCutScene");
opc(0xc6, "decr", IDX);
opc(0xcc, "createRooms", BYTE, BARRZ);
opc(0xd8, "printEgo", STRZ);
opc(0xee, "nop");
opc(0x2d, "putActorInRoom", IACTOR, IBYTE);

sub parse_script_to_str($) {
    my ($script) = @_;
    my $scrbackup = $script;
    my $len = length $script;
    my $parsed = "";
    @usedvars = ();
    while ($script) {
	$offset = $len - length($script);
	$parsed .= sprintf ("    %03x: ", $offset);
	my $opc = $opcodes[ord(substr($script, 0, 1))];
	if (! $opc) {
	    $parsed .= sprintf ("Unknown Opcode %02x\n", ord(substr($script,0,1)));
	    last;
	}
	$script = substr $script, 1;

	my ($descr, @params) = @{$opc};
	$parsed .= "$descr(";
	$comma = "";
	while (@params) {
	    $_ = shift @params;
	    $parsed .= $comma;
	    $comma = ", ";
	    if ($_ == BYTE) {
		$parsed .= ord(substr($script, 0, 1));
		$script = substr $script, 1;
	    } elsif ($_ == WORD) {
		$parsed .= unpack "v", substr($script, 0, 2);
		$script = substr $script, 2;
	    } elsif ($_ == VERB) {
		my $v = ord(substr($script, 0, 1));
		$parsed .= $verbs[$v] ? $verbs[$v] : "$v";
		$script = substr $script, 1;
	    } elsif ($_ == IDX) {
		$parsed .= "\003".ord(substr($script, 0, 1))."\002";
		push @usedvars, ord(substr($script, 0, 1));
		$script = substr $script, 1;
	    } elsif ($_ == SCRIPT) {
		$parsed .= "\005".ord(substr($script, 0, 1))."\002";
		push @usedvars, ord(substr($script, 0, 1));
		$script = substr $script, 1;
	    } elsif ($_ == BIDX) {
		my $word = unpack "v", substr($script, 0, 2);
		$parsed .= "\004$word\002";
		push @usedvars, int($word / 16);
		$script = substr $script, 2;
	    } elsif ($_ == OBJ) {
		$parsed .= "\001".(unpack "v", substr($script, 0, 2))."\002";
		$script = substr $script, 2;
	    } elsif ($_ == JUMP) {
		my $joff = unpack("v", substr($script, 0, 2));
		$joff -= 65536 if ($joff > 32767);
		$script = substr $script, 2;
		$parsed .= sprintf "->%04x", $len - length($script) + $joff;
	    } elsif ($_ >= IIBYTE && $_ < IBYTE) {
		$parsed .= sprintf "*\003%d\002",ord(substr($script, 0, 1)) & 0xff;
		push @usedvars, ord(substr($script, 0, 1));
		$script = substr $script, 1;
	    } elsif ($_ == STRZ) {
		$text = read_strz(\$script);
		$parsed .= "\"$text\"";
	    } elsif ($_ == ACTORSET) {
		$aset = ord(substr($script, 0, 1));
		$script = substr $script, 1;
		if ($aset == 1) {
		    $parsed .= "walksound";
		} elsif ($aset == 2) {
		    $parsed .= "palette_";
		    $parsed .= ord(substr($script, 0, 1));
		    $script = substr $script, 1;
		} elsif ($aset == 3) {
		    $parsed .= "setname, ";
		    $text = read_strz(\$script);
		    $parsed .= "\"$text\"";
		} elsif ($aset == 4) {
		    $parsed .= "costume";
		} elsif ($aset == 5) {
		    $parsed .= "talkcolor";
		} else {
		    $parsed .= "$aset";
		}
	    } elsif ($_ == RES) {
		$restype = ord(substr($script, 0, 1));
		$script = substr $script, 1;
		$parsed .= ($restype & 0x0f);
		$parsed .= "+";
		$restype &= 0xf0;
		if ($restype == 0x20) {
		    $parsed .= "costume";
		} elsif ($restype == 0x30) {
		    $parsed .= "room";
		} elsif ($restype == 0x50) {
		    $parsed .= "script";
		} elsif ($restype == 0x60) {
		    $parsed .= "music";
		} else {
		    $parsed .= sprintf "%02x", $restype;
		}

	    } elsif ($_ == BARRZ) {
		$parsed .= "["; $c = "";
		while (ord($script)) {
		    $parsed .=  $c . ord($script);
		    $c = ",";
		    $script = substr $script,1;
		}
		$script = substr $script,1;
		$parsed .= "]";
	    } elsif ($_ == BYTEARR || $_ == WORDARR) {
		$count = ord(substr($script, 0, 1));
		$script = substr $script, 1;
		$parsed .= "[";
		while ($count-- > 0) {
		    if ($_ == BYTEARR) {
			$parsed .= (ord(substr($script, 0, 1))) & 0xff;
			$script = substr $script, 1;
		    } else {
			$parsed .= unpack "v", substr($script, 0, 2);
			$script = substr $script, 2;
		    }
		    $parsed .= "," if ($count != 0);
		}
		$parsed .= "]";
	    } elsif ($_ == VERBOPS || $_ == IVERBOPS) {
		$subopc = ord(substr($script, 0, 1));
		if ($subopc == 0) {
		    $parsed .= "clear";
		    $script = substr $script, 1;
		    @params = (($_ == VERBOPS ? BYTE : IIBYTE), @params);
		} elsif ($subopc == -1) {
		    $parsed .= "setenabled";
		    $script = substr $script, 1;
		    @params = (BYTE, BYTE, @params);
		    $b1 = (ord(substr($script, 0, 1)) & 0xff);
		    $script = substr $script, 1;
		    $b2 = (ord(substr($script, 0, 1)) & 0xff);
		    $script = substr $script, 1;
		} else {
		    $comma = "";
		    @params = (VERB, BYTE, BYTE, ($_ == VERBOPS ? BYTE : IIBYTE), BYTE, STRZ, @params);
		}
	    } elsif ($_ == DOSENTENCE) {
		$subopc = ord(substr($script, 0, 1));
		if ($subopc == 252) {
		    $parsed .= "stop_sentence";
		    $script = substr $script, 1;
		    @params = ();
		} elsif ($subopc == 251) {
		    $parsed .= "clear_sentence";
		    $script = substr $script, 1;
		    @params = ();
		} else {
		    $comma = "";
		    @params = (VERB, @params);
		}
	    } else {
		$parsed .= "param $_??";
	    }
	}
	$parsed .= (")\n        ");
	$newoffset = $len - length($script);
	for ($i = $offset; $i < $newoffset; $i++) {
	    $parsed .= sprintf(" %02x", ord(substr($scrbackup, $i, 1)) & 0xff);
	}
	$parsed .= ("\n");
    }
    return $parsed;
}

sub parse_script($) {
    $_ = parse_script_to_str($_[0]);
    s/\001(\d*)\002/linkobj($1)/eg;
    s/\003(\d*)\002/linkobj($1)/eg;
    s/\004(\d*)\002/linkobj($1)/eg;
    s/\005(\d*)\002/linkobj($1)/eg;
}