#!/usr/bin/perl

my %patchtable=();
my $offset = 13615;
my $programsize = 7509409;

sub parsenat($) {
    my $dna = $_[0];
    my $nat = 0;
    my $i;
    for ($i = length($dna)-2; $i >= 0; $i--) {
	$nat += $nat;
	$nat ++ if (substr($dna,$i,1) eq "C");
    }
    return $nat;
}

sub natfix($$) {
    my $len = $_[1];
    my $n = $_[0];
    my $i;
    my $res ="";
    for ($i = 0; $i < $len-1; $i++) {
	$res .= ($n & 1 ? "C" : "I");
	$n >>=1;
    }
    return $res."P";
}

sub nat($) {
    my $res = "";
    my $n = $_[0];
    if ($n =~ /\[(.*)\]/) {
	my $idx = $1;
	my $pat = substr("*$1************************************", 0, 23);
	my $res .= $pat;
	$patchtable{$idx} = $pat;
	return $pat."P";
    }
    if ($n =~ /0x(.*)/) {
	$n = hex($1);
    }
    while ($n > 0) {
	$res .= ($n & 1 ? "C" : "I");
	$n >>=1;
    }
    return $res."P";
}
sub quote($) {
    my $p = $_[0];
    $p =~ tr/ICFP/CFPI/;
    $p =~ s/I/IC/g;
    $p =~ s/q(q*f?m[0-9]+,[0-9]+)/$1/g;
    return $p;
}
sub unquote($) {
    my $p = $_[0];
    $p =~ s/IC/F/g;
    $p =~ tr/ICFP/CIPF/;
    return $p;
}
sub antiquote($) {
    my $p = $_[0];
    $p =~ s/./q$&/g;
    return $p;
}

sub pattern($){
    my $p = $_[0];
    my $res="";
#    print STDERR "pattern:$p:";
    while ($p) {
	my $oldp = $p;
	if ($p =~ s/^((0x)?[0-9a-f]+|\[[^\]]*\])(:([0-9]+))?//) {
	    if ($3) {
		$res .= natfix($1,$4);
	    } else {
		$res .= nat($1);
	    }
	}
	$p =~ s/^p<(([^<>]|<([^<>]|<[^<>]*>)*>)*)>/pattern($1)/e;
	$p =~ s/^p!<(([^<>]|<([^<>]|<[^<>]*>)*>)*)>/$_=pattern($1);$_=~s!IIC$!!;$_/e;
	$p =~ s/^t<(([^<>]|<([^<>]|<[^<>]*>)*>)*)>/template($1)/e;
	$res .= "$1"  if ($p =~ s/^q(q*f?m[0-9]+,[0-9]+|l[0-9]+|[ICFP])//);
	$res .= "IFI" if ($p =~ s/^\?//);


	$res .= "IP"  if ($p =~ s/^\!//);
	$res .= "IIP" if ($p =~ s/^\(//);
	$res .= "IIC" if ($p =~ s/^\)//);
	$res .= "III$1" if ($p =~ s/^r([IFCP]{7})//);
	$res .= quote($1) if ($p =~ s/^([IFCP]+)//);
	die "illegal pattern $p" if ($p eq $oldp);
    }
#    print STDERR "${res}IIC\n";
    return $res . "IIC";
}

sub template($){
    my $p = $_[0];
    my $res="";
#    print STDERR "template:$p:";
    while ($p) {
	my $oldp = $p;
	if ($p =~ s/^m([0-9]+),([0-9]+)//) {
	    $res .= "IP".nat($1).nat($2);
	}
	if ($p =~ s/^fm([0-9]+),([0-9]+)//) {
	    $res .= "IF".nat($1).nat($2);
	}
	if ($p =~ s/^l([0-9]+)//) {
	    $res .= "IIP".nat($1);
	}
	$p =~ s/^p<(([^<>]|<([^<>]|<([^<>]|<([^<>]|<[^<>]*>)*>)*>)*>)*)>/
	    pattern($1)/e;
	$p =~ s/^p!<(([^<>]|<([^<>]|<([^<>]|<([^<>]|<[^<>]*>)*>)*>)*>)*)>/
	    $_=pattern($1);$_=~s!IIC$!!;$_/e;
	$p =~ s/^t<(([^<>]|<([^<>]|<([^<>]|<([^<>]|<[^<>]*>)*>)*>)*>)*)>/
	    template($1)/e;
	$res .= $1 if ($p =~ s/^q(q*f?m[0-9]+,[0-9]+|l[0-9]+|[ICFP])//);
	$res .= "III$1" if ($p =~ s/r([IFCP]{7})//);
	$res .= quote($1) if ($p =~ s/^([IFCP]+)//);
	return $res if ($p =~ s/^\.\.\.$//);
	die "illegal template $p" if ($p eq $oldp);
    }
#    print STDERR "${res}IIC\n";
    return $res . "IIC";
}


my %lengths = (
    "outcolor" => 6709,
);

my %addresses = (
  "outcolor" => 4312088
); 

sub callfunc {
    my $skipbefore = shift @_;
    my $func = shift @_;
    my $skip1 = $skipbefore+$offset;
    my $addr = $addresses{$func};
    my $len= $lengths{$func};
    if (!@_) {
	return pattern("!$skip1($addr(!$len))").
	       template("m0,0m0,1");
    } else {
	my $param ="";
	foreach (@_) {
	    $param = $param.natfix($_,24);
	}
	$skip2 = $programsize - $addresses{$func} - $len;
	return pattern("!$skip1(!$addr(!$len)!$skip2)").
	       template("m0,0m0,1$param");
    }
}

sub skipall() {
    return pattern("?IFPICFPPCIFP.");
}

#$prefix=skipall();
#$prefix=callfunc(length($prefix), "outcolor", 6402682, 2010).$prefix;


#print $pattern."\n";


# Patch code in method "6628979"
#    RNA nr 280760

#$pattern = pattern("!440").template("");
#$len = length($pattern);
#$pattern = pattern("!".(440-$len)).template("");
#die "$len / $pattern" if ($len != length ($pattern));
#$prelen = 0;
#$prefix = pattern("(!".(6642614+$prelen).")!".length($pattern)).
#          template("m0,0".$pattern);


#print pattern("(?CIFPP.)F").template("m0,0I");
#sub lenpattern($$) {
#    my ($ptrn, $tmpl) = @_;
#    my $len = 10;
#    my $oldlen = 0;
#    my $pattern;
#    do {
#	$oldlen = $len;
#	$pptrn = $ptrn;
#	$pptrn =~ s/(0x([0-9a-f]+)-len)/hex($1)-$oldlen/eg;
#	$pptrn =~ s/(([0-9a-f]+)-len)/$1-$oldlen/eg;
#	print STDERR "pattern $oldlen:$pptrn\n";
#	$pattern = pattern($pptrn).template($tmpl);
#	$len = length($pattern);
#    } while ($len != $oldlen);
#    return $pattern;
#}

#my $prefix = "";
#sub addprefix($$) {
#    my ($ptrn, $tmpl) = @_;
#    print STDERR "addprefix:$ptrn:$tmpl\n";
#    $ptrn =~ s/0x([0-9a-f]+)\+off/hex($1)+$offset+length($prefix)/eg;
#    $ptrn =~ s/([0-9]+)\+off/$1+$offset+length($prefix)/eg;
##    print STDERR "addprefix:$ptrn:$tmpl\n";
#    $prefix = pattern($ptrn).template($tmpl). $prefix;
##    print STDERR "-->$prefix\n";
#}

###########3
sub lenpattern($$) {
   my ($ptrn, $tmpl) = @_;
   my $len = 10;
   my $oldlen = 0;
   my $pattern;
   do {
       $oldlen = $len;
       $pptrn = $ptrn;
       $pptrn =~ s/0x([0-9a-f]+)-len/hex($1)-$oldlen/eg;
       $pptrn =~ s/([0-9]+)-len/$1-$oldlen/eg;
       $pptrn =~ s/0x([0-9a-f]+)\+len/hex($1)+$oldlen/eg;
       $pptrn =~ s/([0-9]+)\+len/$1+$oldlen/eg;
#       print STDERR "pattern $oldlen:$pptrn\n";
       $pattern = pattern($pptrn).template($tmpl);
       $len = length($pattern);
   } while ($len != $oldlen);
   return $pattern;
}

my $prefix = "";
sub addprefix($$) {
   my ($ptrn, $tmpl) = @_;
   printf STDERR "%5d: addprefix:$ptrn:$tmpl\n",length($prefix);
   $ptrn =~ s/0x([0-9a-f]+)\+off/hex($1)+$offset+length($prefix)/eg;
   $ptrn =~ s/(-?[0-9]+)\+off/$1+$offset+length($prefix)/eg;
#    print STDERR "addprefix:$ptrn:$tmpl\n";
   $prefix = pattern($ptrn).template($tmpl). $prefix;
#    print STDERR "-->$prefix\n";
} 

####

sub buildpolygon($@) {
    my ($dest,@poly) = @_;

    my $compressed = "";
    my $maxlen = 0;
    my $polyfirst = quote(natfix(shift (@poly), 12));
    #modifydna(0x6f3b9e, $polyfirst);
    my $i = length($polyfirst);
    while (substr($dna, $offset + $dest + $i-1, 1) eq
	   substr($polyfirst, $i-1, 1)) {
	$i--;
    }
    my $j = 0;
    while (substr($dna, $offset + $dest + $j, 1) eq substr($polyfirst, $j,1)) {
	$j++;
	$i--;
    }
    $i++ unless ($i & 1);
    $polyfirst = substr($polyfirst, $j, $i);
    for ($i = 0; $i < @poly; $i++) {
	my $to = $poly[$i]+1;
	if ($to < 0) {
	    my $nat .= nat(-$to);
	    $maxlen = length($nat) if (length($nat) > $maxlen);
	    $nat =~ tr/IC/CI/;
	    $compressed .= $nat;
	} else {
	    $compressed .= nat($to);
	}
#	modifydna($dest+13 + 13*$i, quote(natfix($poly[$i],12)));
    }
    $compressed =~ s/IC/F/g; $compressed =~ tr/ICFP/CIPF/;
    print STDERR "POLY COMPRESSED: ".length($compressed)."\n";


    my $looplenbits = 5;
    my $skiplenbits = 5;
    my $looplen = 0;
    my $delim ="CI";

    $firstinstr = undef;
    if ($prefix =~ s/^(IIPIP[CI]*PIICIICI[FP]PPI[FP]PPIIC)//) {
	$firstinstr = $1;
    } elsif ($prefix =~ s/^(IIPIF[ICFP](C|F|P|IC)*(IPP)?IICIICI[FP]PPI[FP]PPIIC)//) {
	$firstinstr = $1;
    }

    $compressed .= "$delim";
    my $destfix = length($compressed) + length($prefix) + $offset + $dest - 13;
    for ($i = 0; $i < 2; $i++) {
	my $copy =
	    pattern("F(?IICF)(?P)(?F)").
	    template("p<(?FP)I>"
                     ."t<p<(!ql0)?C>t<qfm1,0m0,0>"
                     .  "IPIPIP".("I"x($maxlen-1)).">"
		     ."p<(!qfm1,2!0x7ff)>"
                     ."t<p<(!11)?P(!qqm1,1?IC)!11>"
		     .  "t<qqm2,0qqm2,0l1fm0,1fm1,0>l0fm0,0>")."F";

	my $skiplen = length($copy)+$looplen + length(nat($destfix));
	if ($skiplen >= (1 << ($skiplenbits-1))) {
	    $skiplenbits = length(nat($skiplen));
	    $i = -1;
	}
	my $skipifend = pattern("!$skiplen:${skiplenbits}$delim")
	    .template("");
	if ($firstinstr) {
	    $skipifend =~ s/IICIIC$/$firstinstr/;
	}

	$body = "$skipifend$copy";
	
	$looplen = length($body);
	if ($looplen >= (1 << ($looplenbits-1))) {
	    $looplenbits = length(nat($looplen));
	    $i = -1;
	}
#	print STDERR "$looplen\n";
    }
    $head = pattern("(?IICF)").template("m0,0m0,0");
    print STDERR "POLY LOOP LEN: $looplen\n";

    print STDERR "$head:$body\n";
    $dist = length($compressed.$prefix) + $offset + $dest + $j;
    my $lenpatt = lenencoding(length($polyfirst));
    $polypatch = skip2encoding($dist).$lenpatt;
    print STDERR "polypatch: $polypatch $polyfirst\n";
    $prefix = $head.$body.$polypatch.$polyfirst.$compressed.$prefix;
}

sub buildreverse($$$) {
    my $looplenbits = 5;
    my $skiplenbits = 5;
    my $destbits = 5;
    my ($dest,$src,$len) = @_;
    my $ptrlen = length(nat($len));
    my $rptrlen = $ptrlen - 1;
    my $addlen = (1 << ($rptrlen));
    my $ptr1len = $ptrlen+1;

    $prefix="ICFP".$prefix;

    my $looplen = 0;
    my $loop ="";
    my $body ="";
    my $i;
    for ($i = 0; $i < 2; $i++) {
		
	my $destfix = ($dest + $src + $len)/2 - $addlen - $addlen - 1
	    + $offset + length($prefix);
	my $letter = substr($newdna, $destfix - length($prefix), 1);
	if ($destfix >= (1 << ($destbits-1))) {
	    $destbits = length(nat($destfix));
	    $i = -1;
	}
	$body =
	    pattern("(!$looplen:$looplenbits)(!${rptrlen}C)P").
	    template("p<(!$destfix:$destbits($letter!qm0,1qP))!1(!qIqm1,1qP(!1))>".
		     "t<qm1,0qm1,0l0fm0,1fm0,2fm0,3>");
	$looplen = length($body);
	if ($looplen >= (1 << ($looplenbits-1))) {
	    $looplenbits = length(nat($looplen));
	    $i = -1;
	}
#	print STDERR "$looplen\n";
    }
    $head = pattern("(?CFIIC)").template("m0,0m0,0");
    print STDERR "PALINDROMER LEN: $looplen\n";

    print STDERR "$head:$body\n";

    $prefix = $head.$body.nat(2*$addlen-($src - $dest + $len)/2).$prefix;
}

sub buildmycompressrna(@) {
    my (@rna) = @_;
    my %usage = ();

    for ($i = 0; $i < @rna; $i++) {
	$usage{$rna[$i]}++;
    }

    my @table = sort { $usage{$b} <=> $usage{$a} } keys(%usage);
    print STDERR "buildcompressedrna: ". join(":",@table)."\n";

    $table = join("", map { "I".$_ } @table);
    $table .= "PIFIPPFI"."IIFPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPFFC";
    my $tablelen = length($table);

    my $looplen = 0;
    my $looplenbits = 5;
    my $loop = "";
    my $i;
    for ($i = 0; $i < 2; $i++) {

#	print STDERR "loop:$loop\n";
	$looplen = length($loop);
	if ($looplen >= (1 << ($looplenbits-1))) {
	    $looplenbits = length(nat($looplen));
	    $i = -1;
	}
	$loop = pattern("(?FFC)F(?P)").
	    template("p<(?IIF(!3!qm0,1)?FFC)>t<m0,1m0,0>m0,0");
#	print STDERR "$looplen\n";
	$loop = $loop.pattern("(!$looplen:$looplenbits)(?FFC)(?P)")
	    .template("p<(!qIqIqIqm0,2(!8))>t<IIm0,0ICIICIICqm1,0qm1,0m0,1>m0,1");
    }

    my $head = pattern("(!$looplen)").template("m0,0m0,0");
    print STDERR "$head : $loop : $table\n";
    my %revtable;
    for ($i = 0; $i< @table; $i++) {
	$revtable{$table[$i]} = $i;
    }
    my $compress = join("", map {nat($revtable{$_})} @rna);
    $compress =~ s/^(P{3,34})/"F".nat(length($1)-3)/e;
    while ($compress =~ s/P(P{3,34})/"PF".nat(length($1)-3)/e) {
	# repeat
    }
    print STDERR "$compress\n";
    $code = $head.$loop.$table.$compress.nat(@table);
    return $code;
}

open DNA, "<../source/endo.dna";
$dna = <DNA>;
close DNA;
$newdna = $dna;

sub modifydna($$) {
    my ($start, $patch) = @_;
#    addprefix("(!$start+off)!".length($patch), "m0,0$patch");
    substr($newdna, $offset + $start, length($patch)) = $patch;
}

my $totalbytes = 0;
my %cachelenenc;
sub lenencoding($) {
    my ($len) = @_;
    if (defined $cachelenenc{$len}) {
	return $cachelenenc{$len};
    }
    die "not encodable length" if (($len & 1) != 1);
    $res = unquote(nat($len>>1));
#    my $codelen = 1;
#    while (length(unquote(nat($len-$codelen))) > $codelen) {
#	$codelen++;
#    }
#    my $res = unquote(nat($len-$codelen));
#    my $pad = "C" x ($codelen - length($res));
#    $res =~ s/F/${pad}F/;
    $cachelenenc{$len} = $res;
#    print STDERR "encode $len as $res\n";
    return $res;
}

sub distencoding($) {
    my ($dist) = @_;
    die "not encodable distance" if (($dist & 1) != 1);
    return unquote(nat($dist >> 1));
}

sub skip2encoding($) {
    my ($skip) = @_;
#    $i = (($skip+1) & 1);
#    return nat($i).distencoding($skip-$i);
    my $distpatt;
    $i = (($skip+1) & 1) - 2;
    do {
	$i += 2;
	$distpatt = distencoding($skip-$i); 
    } while (length($distpatt) > $i);
    $pad = $i - length($distpatt);
    return nat($pad).$distpatt;
}

my %cacheskip;
sub skipencoding($) {
    my ($skip) = @_;
    if (defined $cacheskip{$skip}) {
	return @{$cacheskip{$skip}};
    }
    my $distpatt;
    $i = (($skip+1) & 1) - 2;
    do {
	$i += 2;
	$distpatt = distencoding($skip-$i); 
    } while (2*length($distpatt) > $i);
    $pad1 = "C"x(($i-2*length($distpatt))&1);
    $pad2 = "C"x(($i-2*length($distpatt))>>1);
#    $pad2 = "C"x(($i-length($distpatt));
    $distpatt =~ s/F$/${pad2}F/;
    $cacheskip{$skip} = [ $distpatt, $pad1 ];
#    print STDERR "encode $skip as $distpatt : $lenpatt\n";
    return ($distpatt, $pad1);
}


sub offlenpattern($$$) {
    my ($distance, $start, $pattlen) = @_;
    my $lenpatt = lenencoding($pattlen);
    my $skip;
    my $i;
    if ($distance < 0) {
	$skip = - $distance;
	$distpatt = skip2encoding($skip); 
	$i = length($distpatt);
    } else {
	$skip = $distance - length($lenpatt);
	($distpatt,$pad1) = skipencoding($skip);
	$lenpatt =~ s/F$/${pad1}F/;
	$i = length($distpatt);
	$skip -= $i;
    }
    printf STDERR "%06x:%03x -> %06x %2d+%2d+%3d bytes %5d total\n", $start-$offset, $pattlen, $skip, $i,length($lenpatt),$pattlen, $totalbytes +=$i+length($lenpatt)+$pattlen;
    die "skip too small" if $skip < 0;
    return $distpatt.$lenpatt.
	substr($newdna, $start, $pattlen);
}
sub buildmodifications() {
    my $tail1lenbits = 5;
    my $looplenbits = 5;
    my $WINDOW = 24;


    $firstinstr = undef;
    if ($prefix =~ s/^(IIPIP[CI]*PIICIICI[FP]PPI[FP]PPIIC)//) {
	$firstinstr = $1;
    } elsif ($prefix =~ s/^(IIPIF[ICFP](C|F|P|IC)*(IPP)?IICIICI[FP]PPI[FP]PPIIC)//) {
	$firstinstr = $1;
    }

    my @difflist = map { length($_) } (split /([^\0])/, ($newdna ^ $dna));
    pop @difflist;
    my (@offsets, @lengths);
    my $pos = 0;
    while (@difflist) {
	my $off = shift @difflist;
	my $len = shift @difflist;
	$pos += $off;
	push @offsets, $pos;
	push @lengths, $len;
#	printf STDERR "%03d %06x:%03x\n", $#offsets,$pos-$offset,$len;
	$pos += $len;
    }
    my ($i, $j, $k);
    my (@best, @cost, @bestcost, @skipoffset, @limit);
    my $beststart;
    #
    # $cost[$i][$o][$j] = # of bytes to encode from $offsets[$i]-$o to end 
    #                     if current patch end is $j (without skip)
    # $bestcost[$i]  = min # of bytes to encode from $i to end (without skip)
    #
    $bestcost[$#offsets+1] = 0;
    for ($i = $#offsets; $i >= 0; $i--) {
	$bestcost[$i] = 
	    $offsets[$#offsets] + $lengths[$#offsets] - $offsets[$i] + $WINDOW;
	$last[$i] = $i;
	$first[$i] = $i;
	for ($o = 0; $o < 3 && ($i == 0 || $o < $offsets[$i] - $offsets[$i-1]); $o++) {
	    for ($j = $i; $j < @offsets; $j++) {
		my $len_ij = $offsets[$j]+$lengths[$j]-$offsets[$i] + $o;
		$len_ij++ unless ($len_ij & 1);
		next if $len_ij + $bestcost[$j+1] > $bestcost[$i]+$WINDOW;
		my $lencost_ij = length(lenencoding($len_ij));
		next if $len_ij + $bestcost[$j+1] + $lencost_ij > $bestcost[$i]+$WINDOW;
		my ($cost_j, $best_k, $best_o2);
		if ($j == $#offsets) {
		    $cost_j = 0;
		    $best_k = 0;
		    $best_o2 = 0;
		} else {
		    $cost_j = 24+$bestcost[$j+1];
		    $best_k = 0;
		    for ($o2 = 0; $o2 < 3 && 
			          $o2 < $offsets[$j+1] - $offsets[$j]; $o2++) {
			for ($k = $first[$j+1]; $k < $last[$j+1]; $k++) {
			    my $skip = $offsets[$j+1] - $o2
				- $offsets[$i] + $o - 
				$skipoffset[$j+1][$o2][$k];
			    next if !$cost[$j+1][$o2][$k];
			    last if $skip <= 1;
			    my ($x,$y) = skipencoding($skip);
			    my $skipcost = length($x.$y);
			    my $cost_jk = $cost[$j+1][$o2][$k] + $skipcost;
			    if ($cost_jk < $cost_j) {
#				print STDERR "  $i-$o:$j:-$o2:$k costj = $cost[$j+1][$o2][$k] + $skipcost = $cost_jk\n";
				$cost_j = $cost_jk;
				$best_k = $k;
				$best_o2 = $o2;
			    }
			}
		    }
		    if (!$best_k) {
			$first[$i]++ if ($first[$i] == $j);
			next;
		    }
		}
		$cost[$i][$o][$j] = $lencost_ij + $len_ij + $cost_j;
		$skipoffset[$i][$o][$j] = $len_ij + $lencost_ij;
		$best[$i][$o][$j] = [$best_k, $best_o2];
		$cost_jk = $cost[$j+1][$best_o2][$best_k] || 0;
		printf STDERR 
			"%06x:%03x  ($i-$o:$j) $lencost_ij + $len_ij + ".($cost_j - $cost_jk)." + $cost_jk = $cost[$i][$o][$j]\n", $offsets[$i]-$o-$offset, $len_ij;
		if ($cost[$i][$o][$j] < $bestcost[$i]) {
		    $bestcost[$i] = $cost[$i][$o][$j];
		    $beststart = [$j,$o] if $i == 0;
		}
		$last[$i] = $j+1 if $last[$i] < $j+1;
	    }
	}
    }

#    print STDERR join("\n", (map { join(":", @{$_}) } @cost))."\n";
    $i = 0;
    my ($j,$o) = @{$beststart};
    my $lastoffset = 0;
    my $lastoffset = 0;
    print STDERR "BESTPATH: ";
    while ($i < $#offsets) {
	my $curroffset = $offsets[$i]-$o;
	my $currlen = $offsets[$j]+$lengths[$j]-$offsets[$i]+$o;
	$currlen++ unless ($currlen & 1);
	print STDERR "$i-$o ";
	$distance = $curroffset - $lastoffset - $lastlen;
	push @info, [$distance, $curroffset, $currlen];
	$lastoffset = $curroffset;
	$lastlen = $currlen;
	$k = $best[$i][$o][$j][0];
	$o = $best[$i][$o][$j][1];
	$i = $j+1;
	$j = $k;
    }
    print STDERR "$i\n";
    my ($dummy, $curroffset, $currlen) = @{shift @info};

    for ($i = @info - 1; $i>= 0; $i--) {
	$prevlen = $i ? $info[$i-1][2] : $currlen;
	$pattern = offlenpattern($info[$i][0] - $info[$i][2] + $prevlen, 
				 $info[$i][1], $info[$i][2]).$pattern;
	$info[$i][0] = length($pattern);
    }

    my $unique = "";
    my %next;
    $next{"I"}="C"; $next{"C"}="F"; $next{"F"}="P";
    unshift @info, [length($pattern), $curroffset, $currlen];
    {
      next_unique:
	if ($unique =~ /^F*$/) {
	    $unique = "I" x (length($unique)+1);
	    $distance = $curroffset + length($pattern) + length($prefix) + length($unique);
	    $startpos = (($distance+1) & 1);
	    $distance-= $startpos;
	    $searchpattern = offlenpattern(-$distance, $curroffset, $currlen).$pattern;
	    shift @info;
	    unshift @info, [length($searchpattern), $curroffset, $currlen];
	} else {
	    $unique =~ s/^(F*)([IC])/"I" x length($1).$next{$2}/ge;
	}
	$pos = $startpos;
	for ($i = 0; $i < @info; $i++) {
	    $offs = 24 - length(nat($pos));
	    $patt = substr($searchpattern, -$info[$i][0]);
	    goto next_unique
		if (substr($patt, $offs, length($unique)) eq $unique);
	    $pos = $info[$i][0]+$info[$i][1]+$info[$i][2]+length($unique);
	}
    }
    $pattern .= $unique;

    # add pattern for first entry and add dummy P entry.
    $distance = $curroffset + length($pattern) + length($prefix);
    $pattern = offlenpattern(-$distance, $curroffset, $currlen).$pattern;

    $patt = $pattern;
    $patt =~ s/^([^P]*P)//;
    printf STDERR "initOffset %s\n", $1;
    for ($i = 0; $i < @info; $i++) {
	$patt =~ s/^([^F]*F)([^F]*F)//;
	printf STDERR "%06x:%03x %s %s %s\n", 
	   $info[$i][1]-$offset, $info[$i][2],
	   $1, $2, substr($patt,0,$info[$i][2]);
	$patt = substr($patt,$info[$i][2]);
    }

    my $looplen = 0;
    my $body ="";
    my $loop = "";
    for ($i = 0; $i < 2; $i++) {
#	print STDERR "loop:$loop\n";

	my $taillen = $looplen;
	$taillen += length(nat(length($dna)-$difflist[$#difflist]));
	if ($taillen >= (1 << ($tail1lenbits-1))) {
	    $tail1lenbits = length(nat($taillen));
	    $i = -1;
	    next;
	}
	$body = pattern("(?IICF)!$taillen:${tail1lenbits}$unique")
	    .template("m0,0");
	my $skiplen = $looplen + length(nat($destfix));
	if ($skiplen >= (1 << ($skiplenbits-1))) {
	    $skiplenbits = length(nat($skiplen));
	    $i = -1;
	}
#	if ($firstinstr) {
#	    $body =~ s/IICIIC$/$firstinstr/g;
#	}

#	print STDERR "body:$body\n";
	$looplen = length($body.$loop);
	if ($looplen >= (1 << ($looplenbits-1))) {
	    $looplenbits = length(nat($looplen));
	    $i = -1;
	}
#	print STDERR "$looplen\n";
	$loop = pattern("F(?IICF)(?P)(?F)(?F)")
	    .template("p<(!qCqfm1,3)(!qfm0,1!ql2!qCqfm1,2)!qCqfm1,3>".
		      "t<qfm1,0qfm1,0l1fm0,1fm0,0>")."F";
    }

    my $looptail = substr($loop, -5);
    my $head = pattern("(?IICF)").template("m0,0m0,0");
    print STDERR "$head : $body : $loop : ... : $unique\n";

    $prefix = $head.$body.$loop.$pattern.$prefix;
    print STDERR "Patch Code: ".length($head.$body.$loop.$unique)."\n";
#    print STDERR "$pattern\n";
}


sub buildnegate($$) {
    my ($src, $len) = @_;
    my $tail1lenbits = 5;
    my $looplenbits = 5;

    $src = $src - 13 + $offset + length($prefix);
    my $looplen = 0;
    my $body ="";
    my $loop = "";
    my $i;
    for ($i = 0; $i < 2; $i++) {
#	print STDERR "loop:$loop\n";

	my $taillen = length($loop)+$looplen;
	if ($taillen >= (1 << ($tail1lenbits-1))) {
	    $tail1lenbits = length(nat($taillen));
	    $i = -1;
	    next;
	}
	$body = pattern("!$taillen:$tail1lenbits".nat(13*$len)).template("");
#	print STDERR "body:$body\n";
	$looplen = length($body.$loop);
	if ($looplen >= (1 << ($looplenbits-1))) {
	    $looplenbits = length(nat($looplen));
	    $i = -1;
	}
#	print STDERR "$looplen\n";
	$loop = pattern("(!$looplen:$looplenbits)(?P)")
	    .template("p<(!$src(!qm0,1!13))(!11)>".
		      "t<p<(?P)(!1!qm0,2F)>".
		        "t<p<(!1(?P))>".
		          "t<p<(!ql0)>".
		            "t<p<(!11)?P(!$src!qqqm2,0)>".
		              "t<qqqqqm5,0qqqqqm5,0qqqm3,0m0,1m1,0".
		              ">m0,0IIIIIIIIII".
		            ">m0,1".
		          ">l1m0,1".
		        ">l0m0,1".
		      ">");
    }
    my $head = pattern("(!$looplen)").template("m0,0m0,0");
    print STDERR "$head : $body : $loop \n";


    $prefix = $head.$body.$loop."P".$prefix;
}

sub compress($) {
    my $prefix = $_[0];
    print STDERR "Uncompressed: ".length($prefix);

    $prefix =~ s/^IIPIF[ICFP]((C|F|P|IC)*)IICIICI[FP]PPI[FP]PPIIC// or die "Illegal start";
    $startpatt = antiquote($1);

    $prefix = reverse($prefix);
    $prefix =~ s/I/00/g;
    $prefix =~ s/C/1/g;
    $prefix =~ s/F/010/g;
    $prefix =~ s/P/011/g;
    my $odd = length($prefix) & 1;
    printf STDERR " Compressed: ".(length($prefix)/2);
    $prefix .= "0" if $odd;
    $prefix =~ s/([01])([01])/chr(2*$1+$2)/eg;
    $prefix =~ tr/\0-\003/ICFP/;
    my $unique = "I";
    my %next;
    $next{"I"}="C"; $next{"C"}="F"; $next{"F"}="P";
    $sum = $prefix;
    while ($unique =~ /^I/ || $unique =~ /II/ || $unique =~ /CCI/ || $sum =~ /$unique/ ) {
	if ($unique =~ /^F*$/) {
	    $unique = "I" x (length($unique)+1);
	} else {
	    $unique =~ s/^(F*)([IC])/"I" x length($1).$next{$2}/ge;
	}
	$sum = $prefix.substr($unique,0,length($unique)-1);
    }
    print STDERR " Unique: $unique ";
    
    # st0: I->I0 C->1   F->C2 P->CC0
    # st1: I->F2 C->FC0 F->P2 P->PC0
    # st2: I->I2 C->IC0 F->F0 P->P0
    my $tmpl0="IIC".pattern("(?IFIC)");
    my $tmpl1=pattern("(?$unique)").template("m0,0");
    $tmpl0 =~ s/IIC$//;
    $tmpl1 =~ s/IIC$//;
    my @stmtable = ([ "II", "II"  ],
		    [ "IC", "C"   ],
		    [ "IF", "FC"  ],
                    [ "IP", "ICC" ],
		    [ "CI", "FF"  ],
		    [ "CC", "ICF" ],
		    [ "CF", "FP"  ],
		    [ "CP", "ICP" ],
		    [ "FI", "FI"  ],
		    [ "FC", "ICI" ],
		    [ "FF", "IF"  ],
		    [ "FP", "IP"  ]);
    my $lastentry = ($odd ? "F" : "I").substr($unique,0,1);
    for ($i = 0; $i < @stmtable; $i++) {
	if ($stmtable[$i][0] eq $lastentry) {
	    my $temp = $stmtable[$i];
	    $stmtable[$i] = $stmtable[$#stmtable];
	    $stmtable[$#stmtable] = $temp;
	    last;
	}
    }

    my $buildstm = 
	    pattern("(?FF)").template("m0,0m0,0").
	    pattern("?FFC!0P(?FFC)").template("m0,0m0,0").
	    pattern("FF(?FF)C(!2)(!1)(?II)(?PPPIIC)").
	    template("m0,0m0,0Cm0,4p<?FFC(?FFC)qm1,1(?$unique)>IFPPIFPPm0,2IFPCPm0,3C").
	    "FFC".
	    join("", map { ${$_}[0].quote(${$_}[1])."II" } @stmtable).
	    "P".
	    pattern("?FFC?FFC!0".($odd ? "F": "I").$unique."(?$startpatt)").template("m0,0m0,0")."FFCI";
	
    print STDERR " Total: ".(length($buildstm)+length($unique)+length($prefix))."\n";
    return $buildstm.$prefix.$unique;
}


sub skipcode($$) {
    my ($from,$to) = @_;
    my $patch  = lenpattern("!".($to-$from)."-len","");
    print STDERR "skipcode($from,$to): $patch\n";
    modifydna($from, $patch);
}
sub skipcodefix($$$) {
    my ($from,$to,$bits) = @_;
    my $patch  = lenpattern("!".($to-$from)."-len:$bits","");
    print STDERR "skipcode($from,$to): $patch\n";
    modifydna($from, $patch);
}
	   
sub backskipcode($$$) {
    my ($from,$taillen,$to) = @_;
    $addr = $to + $taillen;
    $codelen = $from - $to;
    my $patch  = lenpattern("(!$addr-len(!$codelen+len))","m0,0m0,1");
    modifydna($from, $patch);
}

sub ecc($$) { $both = $_[0].$_[1];return "II" if ($both =~ /[ICF]III/ || $both =~ /I[ICF]II/ || $both =~ /II[ICF]I/ || $both =~ /III[ICF]/);return "IC" if ($both =~ /[ICF]CPF/ || $both =~ /I[ICP]PF/ || $both =~ /IC[CFP]F/ || $both =~ /ICP[IFP]/);return "IF" if ($both =~ /[ICF]FCP/ || $both =~ /I[IFP]CP/ || $both =~ /IF[ICP]P/ || $both =~ /IFC[CFP]/);return "IP" if ($both =~ /[ICF]PFC/ || $both =~ /I[CFP]FC/ || $both =~ /IP[IFP]C/ || $both =~ /IPF[ICP]/);return "CI" if ($both =~ /[ICP]IFP/ || $both =~ /C[ICF]FP/ || $both =~ /CI[IFP]P/ || $both =~ /CIF[CFP]/);return "CC" if ($both =~ /[ICP]CCC/ || $both =~ /C[ICP]CC/ || $both =~ /CC[ICP]C/ || $both =~ /CCC[ICP]/);return "CF" if ($both =~ /[ICP]FPI/ || $both =~ /C[IFP]PI/ || $both =~ /CF[CFP]I/ || $both =~ /CFP[ICF]/);return "CP" if ($both =~ /[ICP]PIF/ || $both =~ /C[CFP]IF/ || $both =~ /CP[ICF]F/ || $both =~ /CPI[IFP]/);return "FI" if ($both =~ /[IFP]IPC/ || $both =~ /F[ICF]PC/ || $both =~ /FI[CFP]C/ || $both =~ /FIP[ICP]/);return "FC" if ($both =~ /[IFP]CIP/ || $both =~ /F[ICP]IP/ || $both =~ /FC[ICF]P/ || $both =~ /FCI[CFP]/);return "FF" if ($both =~ /[IFP]FFF/ || $both =~ /F[IFP]FF/ || $both =~ /FF[IFP]F/ || $both =~ /FFF[IFP]/);return "FP" if ($both =~ /[IFP]PCI/ || $both =~ /F[CFP]CI/ || $both =~ /FP[ICP]I/ || $both =~ /FPC[ICF]/);return "PI" if ($both =~ /[CFP]ICF/ || $both =~ /P[ICF]CF/ || $both =~ /PI[ICP]F/ || $both =~ /PIC[IFP]/);return "PC" if ($both =~ /[CFP]CFI/ || $both =~ /P[ICP]FI/ || $both =~ /PC[IFP]I/ || $both =~ /PCF[ICF]/);return "PF" if ($both =~ /[CFP]FIC/ || $both =~ /P[IFP]IC/ || $both =~ /PF[ICF]C/ || $both =~ /PFI[ICP]/);return "PP" if ($both =~ /[CFP]PPP/ || $both =~ /P[CFP]PP/ || $both =~ /PP[CFP]P/ || $both =~ /PPP[CFP]/);warn "wrong ecc $both";return substr($both,0,2);}

sub correctcode($$) {
    my ($data,$ecc) = @_;
    my $result="";
    while ($data =~ s/^(..)//) {
	$dbits = $1;
	$ecc =~ s/^(..)//;
	$result .= ecc($dbits,$1);
    }
    return $result;
}

sub rc4($@) {
    my ($dna,@key) = @_;
    my @S;
    my ($j, $i, $t, $out, $keyidx);
    my $dnaout;
    $dna =~ tr/ICFP/0123/;
    for ($i = 0; $i < 256; $i++) {
	$S[$i] = $i;
    }
    $j = 0;
    $keyidx = 0;
    for ($i = 0; $i < 256; $i++) {
	if ($key[$keyidx] == 255) {
	    $keyidx = 0;
	}
	$j = ($j + $S[$i] + $key[$keyidx++]) & 255;
	$t = $S[$i];
	$S[$i] = $S[$j];
	$S[$j] = $t;
    }

    $i = 0;
    $j = 0;
    while (length($dna) >= 4) {
	$i = ($i + 1) & 255;
	$j = ($j + $S[$i]) & 255;
	$t = $S[$i];
	$S[$i] = $S[$j];
	$S[$j] = $t;

	$out = $S[($S[$i] + $S[$j]) & 255];
	$dna =~ s/([0123])([0123])([0123])([0123])//;
	$out ^= ($1 + 4*$2 + 16*$3 + 64*$4);
	$dnaout .= ($out & 3).(($out >>2)&3).(($out >>4)&3).(($out >>6)&3);
    }
    $i = ($i + 1) & 255;
    $j = ($j + $S[$i]) & 255;
    $t = $S[$i];
    $S[$i] = $S[$j];
    $S[$j] = $t;
    $out = $S[($S[$i] + $S[$j]) & 255];
    while (length($dna)) {
	$dna =~ s/([0123])//;
	$dnaout .= (($out & 3) ^ $1);
	$out >>=2;
    }
    $dnaout =~ tr/0123/ICFP/;
    return $dnaout;
}


my $patch;

#patch clouds
buildreverse(0x60fea4, 0x61181e, 0x1962);
#modifydna(0x60fea4, substr(reverse(substr($newdna, $offset+0x61181e, 0x1962)), 0, 0x1962-75));

# set hillsEnabled
modifydna(0x3346a,"P");
#modifydna(0x4cd014+57,"PF");

# damage "virus" code before surfaceTransform
#print STDERR substr($dna, $offset+0x6d3fee, 315);
modifydna(0x6d402c+6,"P");

#skipcode(0x6d3fb5+10, 0x6d412a);

# skip everything except surfaceTransform
#skipcode(0x4cccfe,0x4cd07d);
#skipcode(0x4cd37f+10, 0x4d7215);


#patch hill curves

#first hill
#Old                  0 242 -28: 3348 408   7   4
#New optimum          0 218 -20: 1816:412:  8:  4 (9.538964)

modifydna(0x6d4573, quote(natfix(218,24)));
modifydna(0x6d46b8, quote(natfix(-20,24)));
modifydna(0x6d4704, quote(natfix(1816,24)));
modifydna(0x6d4897+0x30, quote(natfix(412,24)));
modifydna(0x6d48e3+0x30, quote(natfix(8,24)));
modifydna(0x6d492f+0x30, quote(natfix(4,24)));

#2nd hill: 
#Old                200 209 -21: 1848 328: 13:  3
#New optimum         50 235 -28: 3348:328: 13:  3 (20.000000)

modifydna(0x6d543f, quote(natfix(235,24)));
modifydna(0x6d5584, quote(natfix(-28,24)));
modifydna(0x6d55d0, quote(natfix(3348,24)));
modifydna(0x6d5793, quote(natfix(328,24)));
modifydna(0x6d57df, quote(natfix(13,24)));
modifydna(0x6d582b, quote(natfix(3,24)));

# 3rd hill
# New optimum        350 257   0:    0:104: 65:  8 (99.520354)
# New optimum        350 257   0:    0:104: 60:  8 (99.520354)
#
modifydna(0x6d62a7, quote(natfix(257,24)));
modifydna(0x6d63ed, quote(natfix(104,24)));
modifydna(0x6d6439, quote(natfix(60,24)));
modifydna(0x6d6485, quote(natfix(8,24)));


# decrypt MU and cow-tail (at run-time)

my @mukey = (0x55, 0x56, 0xb1, 0x3c, 0x81, 0x67, 0xb3, 255);
my $mudummy = 0x480 - 9*(@mukey);
my @cowtailkey = (0xb9, 0xb5, 0xb4, 0xb6, 255);
my $cowtaildummy =  0x480 - 9*(@cowtailkey);

# set giveMeAPresent to cowtailkey
# since the key often breaks the CI end marker, we replace it with CF in
# the key; crypt only takes numeric values of key.
$cowtailkeybin = join('', map {natfix($_,9)} @cowtailkey); 
$cowtailkeybin =~ s/CI/CF/g;
modifydna(0x00005d, $cowtailkeybin);
# patch address from vmu-code to cow-tail
# do not patch length, because encrypting too much does not hurt.
modifydna(0x63a773+0x31, quote(natfix(0x4aa77d,24))); #.natfix(0x145c,24)));
# skip to goodvibrations
skipcode(0x63aa9b, 0x63acea);

# This is a hack to make the patch one larger than necessary
# which will overall shrink the patch.
#substr($dna, $offset + 0x63aa9f, 1) = "P";

# patch key (in initlocals)
modifydna(0x63a567, quote(join('', map {natfix($_,9)} @mukey)));
# patch address from help-beautiful-numbers to charInfo_Tempus-Bold-Huge_M
# do not patch length, because encrypting too much does not hurt.
# It changes fontTable_Tempus-Small and other font tables but the only 
# drawing command with these fonts happened just before.
modifydna(0x63b668+0x31, quote(natfix(0x7a97b,24))); #.natfix(0xe51,24)));
# skip to main
skipcode(0x63b990, 0x63bc8f);
#modifydna(0x63bc8f+3,"IP");

#################################
# WEED
#################################

# weed seed = 8128
modifydna(0xc7dc0, natfix(8128,24));

#################################
# CARGOBOX
#################################

# Patch rna code in cargobox ma->yw, gn->be
modifydna(0x21f149, "CF");
modifydna(0x21f1ca, "P");

# Switch on daylight
modifydna(0x00050f, "F");

################################
# PEARTREE
################################
# patch return in appletree to jump to pear tree
modifydna(0x3c9e30+132, quote(natfix(0x589a07,24)));

################################
# RIVER
################################
# swap mkGoldFish[LR]_adaptation
#72035a(001f46):     PARAM: drawGoldFishL_adaptation
#72038a(001f76):     PARAM: drawGoldFishR_adaptation
modifydna(0x72035a, natfix(0x7287f2,24));
modifydna(0x72038a, natfix(0x7289d2,24));

# patch coords of fish in adaptation
modifydna(0x71cc3f, natfix(18,24));

# patch ptr to emptyBox (param of threeFish_adaptation) in goldenfish
modifydna(0x71cf0f, natfix(0x71e294,24));

################################
# WHALE
################################

# patch whale coords
modifydna(0x4d535a, quote(natfix(0x187+19,24)));
modifydna(0x4d53a6, quote(natfix(0xb0+24,24)));
# patch whale face
modifydna(0x4d54b6+44, "PC");
#modifydna(0x26654d+0x31-6, "C");

################################
# BMU
################################

# Draw endo but not as a shadow!
# skip the first addbmp and the clip comp at the end
# Also skip the code that draws endo as weird cow, duck, ocaml, mlephant etc.
#skipcodefix(0xdaf2d, 0xdb0fb,25);
#modifydna(0x033963, "P");
modifydna(0xdaf2d+2, "P");
#modifydna(0xdaf4e+57, "C");
#modifydna(0xdafef+57, "CC");
#modifydna(0x0db06f+123, "F");
#modifydna(0xdafad+15, "P");
#modifydna(0xdaee5+2+25+5+25,"PP");
#modifydna(0xdaee5+2, natfix(0xdb0fb - 0xdaf2d, 25));
#modifydna(0xdaee5+57,"PP");
#modifydna(0xdaf2d,"P");
#modifydna(0xdaf2d-13,"F");
skipcodefix(0xdafad, 0xdb0fb-10,25);
#skipcode(0xdaf2d, 0xdb0fb);
#skipcode(0xdaee5, 0xdb0fb);
##skipcode(0x0df46c+10, 0x0df78c);
#IIIPFFICCFIIIPFFPCCP
#modifydna(0x0df46c+10, "IIIPFFPCCP");  #comp
modifydna(0x0df46c+14, "P");
modifydna(0x0df61a+25, "P");
#skipcode(0xdf3b3,0xdf6d3);
#modifydna(0xdf3b3+132,quote(natfix(0x25d83a,24).natfix(0x25cca1+0x000d47-0x25d83a,24)));

################################
# CLOUDS
################################
#draw clouds for weather == 0
modifydna(0x6f9e0b+57, quote(natfix(0,24)));
#modifydna(0x3394b, natfix(2,24));

#don't set cloudy
#60ff3d(000099):       cloudy := true
# modify address to cloudy (modifies unused part of biomorphPerturb)
#modifydna(0x60fea4 + 0x99 + 5, "I");
# (do it in "duolc" though)
modifydna(0x61181e + 0x001962 - 0x99 - 5, "I");


#patch cloud size
modifydna(0x5c963d, quote(natfix(10,24)));
modifydna(0x5c99dd, quote(natfix(20,24)));

#patch cloud positions
modifydna(0x5c9164, quote(natfix(25,24)));
modifydna(0x5c94fa, quote(natfix(55,24)));
modifydna(0x5c989a, quote(natfix(30,24)));

#########################
# fix motherduck
#########################
# there is one wrong coordinate in the polygon.
modifydna(0x2c932e, "C");

#######
# patch ufo
#######

# set fill point to be the same as for ufo cup
if (0) {
    $ufox = 366;
    $ufoy = 250;
    $waterx = 420-$ufox;
    $watery = 265-$ufoy;

    modifydna(0x52dce5+0x30, quote(natfix(84 - $waterx,24)));
    modifydna(0x52dd31+0x30, quote(natfix(41 - $watery,24)));

    # patch rna in water to include 2*turn
    #modifydna(0x52de36+10, "IIIPFFFFFP");
    #modifydna(0x52de4a+16, "PIIIPFFFFFP");
} else {
    $ufox = 378;
    $ufoy = 264;
    $waterx = 420-$ufox;
    $watery = 265-$ufoy;

    modifydna(0x654815+0x30, quote(natfix(36 + $waterx,24)));
    modifydna(0x654861+0x30, quote(natfix(33 + $watery,24)));
    # patch rna after call to water to include 2*turn
    #modifydna(0x65380b+16, "PIIIPFFFFFP");
    #modifydna(0x65380b+76, "PIIIPFFFFFP");
}

# set coords of water
#modifydna(0x653601+0x30, quote(natfix(55-1,24)));
#modifydna(0x65364d+0x30, quote(natfix(42-27,24)));
modifydna(0x592cde+0x30, quote(natfix($waterx,24)));
modifydna(0x592d2a+0x30, quote(natfix($watery,24)));


#modifydna(0x52de36+10, "IIIPFFFFFP");
#modifydna(0x52de4a+16, "PIIIPFFFFFP");
#modifydna(0x52de4a+2, natfix(0xbca - 0xae9 - 160, 25));
#modifydna(0x52de4a+147, "IIIPFFFFFPIIC");
#print STDERR "RETURN WATER: ".substr($newdna, $offset+0x52de4a, 200)."\n";

# patch rna before clipping the cup
modifydna(0x6538c4+10, "IIIPFFFFFPIIIPFFFFFP"); # L L

# patch rna after ufo-cup to revert 2*turn
modifydna(0x654c9d, "IIIPFFFFFPIIIPFFFFFP"); # L L


modifydna (0x654cf0+0x30, quote(natfix(259+2048-$ufox,24)));
modifydna (0x654d3c+0x30, quote(natfix(377-$ufoy,24)));
#modifydna (0x58c8ad+0x30, quote(natfix(259+2048,24)));
#modifydna (0x58c8f9+0x30, quote(natfix(377,24)));

$spiro = 0x6413c1; #483;
$spirolen = 0x63a4fd + 0x1303b - $spiro;

# patch return address of setOrigin to jump to part of main (spirograph)
# This also takes care of the missing comp
modifydna(0x654d88+132, quote(natfix($spiro,24)
			      .natfix($spirolen,24)));

#modifydna(0x654e41+32, natfix($spiro,25));
#modifydna(0x654e41+62, natfix($spirolen,25));
#modifydna(0x654e41+92, natfix($programsize - $spiro - $spirolen,25));

#replace call to resetOrigin with jump, so that it will return to caller.
#modifydna(0x654efa+2, natfix(0x2d08-0x21b0-132-3,25));
#modifydna(0x654efa+132, "IIC");

#$remfunc = 0x2d08 - (0x1f53+20);
#$patch = lenpattern("!$remfunc-len(!$spiro(!$spirolen))","m0,0m0,1");
#modifydna(0x654c9d+20, $patch);

#patch size of spirographs
#modifydna (0x641a0a+0x30, quote(natfix(1,24)));
#modifydna (0x642113+0x30, quote(natfix(1,24)));
#modifydna (0x642826+0x30, quote(natfix(1,24)));

#####
# patch spirograph
#####

#patch spirograph to ignore multiplier
#this damages the pop instruction so that it does not store the value.
modifydna (0x6f4f20+57+18, "IC");
modifydna (0x6f51b4+76, "F");
#modifydna(0x6f4d05+21, natfix(0x6f522d-0x6f4d05-21-12-9-0x48,12)."IICIICIIC");


# Patch ret addr of resetOrigin to jump to another resetOrigin
# (we still need one from ufo).
#modifydna(0x654efa+2, natfix(0x2d08-0x21b0-132-3,25));
#modifydna(0x654efa+132, "IIC");
#modifydna(0x642aa7+132, quote(natfix(0x6d7151, 24).natfix(0x9e9-0x845,24)));
#modifydna(0x642aa7+132, quote(natfix(0x6f177d, 24).natfix(0xb28-0x97a,24)));
$resetOrigin = 0x3cbbd0; #0x6f177d; 
$resetOriginLen= 0x3c870e+0x00372b-$resetOrigin; #0x6f0e03+0x000b28-$resetOrigin;
#skipcode(0x642b60+10, 0x643f7d);  #
#skipcode(0x642b92, 0x643f7d);  #0x642b60+10
modifydna(0x642b92+20, natfix(0x643ec4-31-32-64 - (0x642bd1-20) - 0x30,22-8)."IICIICIIC");


#modifydna(0x642c69+25, "P");
#modifydna(0x642d22+12, "ICCI");
#modifydna(0x642b60+40, "IIIPIPIIPF");
#modifydna(0x64309d+25, "C");
#modifydna(0x6435d0+25, "C");
#modifydna(0x643b03+25, "C");

modifydna(0x64d414+9, "P");
#modifydna(0x644040+3, "I");

#skipcode(0x64d414, 0x64d457); 
#modifydna(0x642aa7+132, quote(natfix($resetOrigin, 24).natfix($resetOriginLen,24)));
###skipcode(0x642b60+10, 0x642fe4);
#modifydna(0x642aa7+132, quote(natfix(0x642fe4, 24).natfix(0x1303b-0x8ae7,24)));
#replace it with a jump and a comp
###modifydna(0x642fe4+2, natfix(0x1303b-0x8ae7-132-3,25));
###modifydna(0x642fe4+132, "IIC");
##modifydna(0x642aa7+2,natfix(0x1303b-0x85aa-132-24-27-10-3,25));

#modifydna(0x642aa7+132, quote(natfix(0x643b60,24)).quote(natfix(0x63a4fd + 0x1303b - 0x643b60,24)));
#modifydna(0x643b6a+38, "PFFPCCP");
#modifydna(0x643bb6+28, "P");
#modifydna(0x643c02+25, "P");
#modifydna(0x643cbb+14, "P");
#modifydna(0x643ec4+25, "P");
#skipcodefix(0x643cbb, 0x643f7d,24);
#skipcodefix(0x643d94, 0x643f7d,24);
##modifydna(0x642aa7+132, quote(natfix(0x52df42,24)).quote(natfix(0x834,27)).
##	  "IIIPFFPCCPIIC");



# skip anticompressant
#skipcode(0x63bdc8, 0x63be81);


## Make wind
# old code that patches sine and cosine table
# new code just sets polarAngleIncr
#addprefix("(!0xc4da8+off)(!120)(!6024)", "m0,0m0,2m0,1");
#addprefix("(!0xc65a8+off)(!120)(!6024)", "m0,0m0,2m0,1");

#####
# patch flowerbed
#####

modifydna(0x45acfd+0x30, quote(natfix(34,24)));
modifydna(0x45ad49+0x30, quote(natfix(0,24)));
modifydna(0x45b17c+0x30, quote(natfix(0,24)));
modifydna(0x45b1c8+0x30, quote(natfix(0,24)));
modifydna(0x45b605+0x30, quote(natfix(58,24)));
modifydna(0x45b651+0x30, quote(natfix(12,24)));
modifydna(0x45ba8e+0x30, quote(natfix(17,24)));
modifydna(0x45bada+0x30, quote(natfix(24,24)));



#patch SUN
# this is shorter than fixing the code programmatically

#$flower = substr($dna,$offset+0x224fb1, 0x0006e0);  #0x206d37
#$sunflower = substr($dna,$offset+0x20742f, 0x0006e0);
#$flower =~ tr/ICFP/\0\001\002\003/;
#$sunflower =~ tr/ICFP/\0\001\002\003/;
#$sunflower ^= $flower;
#$sunflower =~ tr/\0\001\002\003/ICFP/;
#$sunflower = substr($sunflower, 0, 0x0006e0-75);

#modifydna(0x206d37, $sunflower);

#print STDERR substr($dna, $offset+0x206d37, 0x6e0)."\n";
#print STDERR $sunflower."\n";
#revert unnecessary patch

#modifydna(0x2071c1, "F");

#Now we just patch the drawPolygon call and its return address to jump to
#a non-broken function.

modifydna(0x2070d9, substr($dna, $offset+0x25f06e, 0x25f127 - 0x25f06e));

################
# checkIntegrity return true
# needed since cowspot and tail have wrong checksum.
################


# patch checkIntegrity to always return true.
# We break a goto instruction...
#modifydna(0x3ea52b+2+23, "P");
modifydna(0x3ea4a0-19,"C");


###############
# patch cowspot
###############


#$cowspot = correctcode(substr($dna,$offset+0x0d985b, 0xb34),
#		       substr($dna,$offset+0x0da3a7, 0xb34));
#$cowspot = substr($cowspot, 0, 0xb34-75);
#modifydna(0x0d985b, $cowspot);

# IPCICIIIICICIIIIIIIIIIIIIIPIIPIPICCCCCCICCCCCICIICICCICIPIIPIPCICICIICCCICCIIIIIIIIIIIPIICIPICCCIIICICICCIIIIIICCIIIPIICIICIPPPIPPCPFFCFFCFCFFCFCFCFFFCCCFCICFCFCCCCFCFCCCCCCCCCCCCCICIIC

# fix just the call to drawPolygon and change it to return to a different
# function that is not broken
#modifydna(0x0da051, substr($dna, $offset+0xcb63a, 0x23ab5b-0x23aaa2));
modifydna(0x0da051, substr($dna, $offset+0xe14df, 0x23ab5b-0x23aaa2));

#call ecc (this is actually longer than just fixing the few bases).
# 200 bytes vs. 101 bytes
#
#addprefix("(?IFPICFPPCCC(?IFPICFPPCCC)?IFPICFPPCFIPP)",
#	  "m0,0".nat(0x5b7bf3).nat(0xe8de)."m0,1".
#	  natfix(0xb34,24).natfix(0xda3a7,24).natfix(0xd985b,24));

#skip balloon
#skipcode(0x6f31b6,0x6f4b58);

#skip everything except balloon
#skipcode(0x4ccd08, 0x4d5cca);

#4d5d09(00900b):       stack_18:18 := #255:18   x
#4d5d55(009057):       stack_0:18 := #305:18    y
#6f37ef(000639):       stack_48:18 := #145:18   width
#6f383b(000685):       stack_30:18 := #116:18   height
#x 198 - 299  wd 103
#y 324 - 493  ht 169

modifydna(0x4d5d39, quote(natfix(198 - 98 + 56,24)));
modifydna(0x4d5d85, quote(natfix(324 - 20 +  2,24)));


modifydna(0x6f381f, quote(natfix(101,24)));
modifydna(0x6f386b, quote(natfix(169,24)));
#skipcode(0x6f3abe,0x6f46d1+20);

#6f4580(0013ca):       stack_18:18 := #106:18  #fill x -> 74
#modifydna(0x6f45b0, quote(natfix(74,24)));

my %shortcuts = ("bk" => "PIPIIIC",
		 "rd" => "PIPIIIP",
		 "gn" => "PIPIICC",
		 "yw" => "PIPIICF",
		 "be" => "PIPIICP",
		 "ma" => "PIPIIFC",
		 "cn" => "PIPIIFF",
		 "we" => "PIPIIPC",
		 "tt" => "PIPIIPF",
		 "oq" => "PIPIIPP",
		 "rs" => "PIIPICP",
		 
		 "M" => "PIIIIIP",  #move
		 "L" => "PCCCCCP",  #turn left
		 "R" => "PFFFFFP",  #turn right
		 
		 "S" => "PCCIFFP",  #start (mark)
		 "E" => "PFFICCP",  #end   (line)
		 "F" => "PIIPIIP",  #fill
		 "addbmp" => "PCCPFFP",
		 "comp" => "PFFPCCP",
		 "clip" => "PFFICCF");


my @poly = (
    45,51, 43,46, 41,40, 40,32, 42,19,  45,14,  47,11, 53,5,  58,3,  64,1,
    70,0,  71,1,  81,4,  90,10, 94,13, 100,22, 101,27, 99,39, 98,40, 96,43,
    93,48, 91,50, 84,54, 80,57, 69,59,  55,59,  48,58, 42,60, 38,65, 36,67,
    36,79, 38,82, 41,87, 43,93, 48,99, 45,104, 43,105, 39,112, 38,112, 35,115,
    23,128, 3,145, 3,148, 4,153, 7,158, 11,162, 16,163, 17,164, 22,164, 22,165,
    21,165, 19,169, 18,168, 10,165, 1,156, 0,153, 0,144, 7,138, 42,103, 44,100,
    41,94, 38,90, 34,84, 34,81, 31,78,  30,75,  30,65, 36,58, 39,56, 41,54);

#for ($i = 0; $i < @poly; $i+=2) {
#    my $t = $poly[$i+1];
#    $poly[$i+1] = $poly[$i];
#    $poly[$i] = $t;
#}
#@poly = reverse @poly;
$shift = 2*54;

@poly = (@poly[$shift..$#poly],@poly[0..($shift-1)]);
if (1) {

    my ($x,$y,$i);
    $x = $poly[0];
    $y = $poly[1];
    for ($i = 2; $i < @poly; $i+=2) {
	$poly[$i] -= $x;
	$poly[$i+1] -= $y;
	$x += $poly[$i];
	$y += $poly[$i+1];
    }
    my $len = @poly;
    push @poly, $x-$poly[0],$y-$poly[1];
    $poly[0] += 98 - 56;
    $poly[1] += 20 - 2;
    unshift @poly, $len/2;


#    modifydna(0x6f3b9e, join("", map { quote(natfix($_,12)) } @poly));
    buildpolygon(0x6f3b9e, @poly);
#    print "$prefix";
#    exit;
} else {
    
    my $startx = shift @poly;
    my $starty = shift @poly;
    push @poly, $startx, $starty;
    push @poly, 0,0;
    my @balloonrna = (("M")x $startx, "R", ("M")x$starty, "S");
    my $lastx = $startx;
    my $lasty = $starty;
    my $dir = 2;
    while (@poly) {
	my $x = shift @poly;
	my $y = shift @poly;
	$x -= $lastx;
	$y -= $lasty;
	next if (!$x && !$y);
	
	if ($x && $dir == ($x > 0 ? 3 : 1)) {
	    # wrong direction; start with y.
	    $newdir = ($y > 0 ? 2 : 0);
	    push @balloonrna, ((($newdir-$dir) & 3) == 1 ? "R" : "L");
	    $dir = $newdir;
	} elsif ($y && $dir == ($y > 0 ? 0 : 2)) {
	    # wrong direction; start with x.
	    $newdir = ($x > 0 ? 1 : 3);
	    push @balloonrna, ((($newdir-$dir) & 3) == 1 ? "R" : "L");
	    $dir = $newdir;
	}
	if ($dir & 1) {
	    push @balloonrna, ("M") x abs($x);
	    if ($y) {
		$newdir = ($y > 0 ? 2 : 0);
		push @balloonrna, ((($newdir-$dir) & 3) == 1 ? "R" : "L");
		push @balloonrna, ("M") x abs($y);
		$dir = $newdir;
	    }
	} else {
	    push @balloonrna, ("M") x abs($y);
	    if ($x) {
		$newdir = ($x > 0 ? 1 : 3);
		push @balloonrna, ((($newdir-$dir) & 3) == 1 ? "R" : "L");
		push @balloonrna, ("M") x abs($x);
		$dir = $newdir;
	    }
	}
	$lastx += $x;
	$lasty += $y;
	push @balloonrna, "E" if (@poly > 0); 
	push @balloonrna, "S" if (@poly > 2);
    }
    push @balloonrna, "R" if ($dir == 0);
    push @balloonrna, "L" if ($dir == 2);
    push @balloonrna, "L","L" if ($dir == 3);
    $dir = 0;
    print STDERR join ":", @balloonrna;
    $balloon = buildmycompressrna( map { $shortcuts{$_} }  @balloonrna);
    modifydna(0x6f3ad2, $balloon);
    skipcode(0x6f3ad2+length($balloon), 0x6f4541);
}
#modifydna(0x6f46d1,"I"x20);
#print $balloon;
#exit;

#6f4a25(00186f):       stack_0:480 := 'L'
modifydna(0x6f4a70, quote(natfix(0x94,9)));

#$mu = join "", map{nat($_)} 
#(split ('',"0010000000231".("0"x20)."210040020100040021".
#	"0000000300241".("0"x13)."2310000000231".("0"x22).
#	"2410021004002100213021302100000300021000240130210003002".
#	"1000040023054040100030021020400213021".
#	"0004023000302".
#	"04010402102100000400210300021000300210003021".
#	("0"x12)."203014".("0"x21)."2305".
#	"87774040014".("0"x22)."2".("0"x10)."3014020004001200004001200012".
#	"0000003012000102000400120001204000041020401020000400000001".
#	("0"x14)."233".("0"x20).
#	"14020030000120400120001200004000120030123030000123".
#	("0"x21)."300"), 20);
#
#modifydna(0x079ee5+9, natfix(length($mu),24));
#modifydna(0x079ee5+9+24, $mu);

#6f498d(0017d7):       stack_498:18 := #98:18
#6f49d9(001823):       stack_480:18 := #20:18
# modifydna(0x6f49bd, quote(natfix(56,24)));
# modifydna(0x6f4a09, quote(natfix(2,24)));


modifydna(0x6f33a3+0x30, quote(natfix(98 - 56,24)));
modifydna(0x6f33ef+0x30, quote(natfix(20 -  2,24)));



# rotate wind mill. (polarAngleIncr)
modifydna(0xc91e0, natfix(5,24));
#modifydna(0x251c28+147,"PFPCF");
#modifydna(0x251cae+155,"PFPICCF");

#patch VMU (vmuMode = 31, set registration key) to draw caravan
#skipcodefix(0x23bdc2,0x23bf3d,25);
modifydna(0x03346b,natfix(31,24));


#modifydna(0x23bd63+2,natfix(0x000241- 0x0000c6,25));
modifydna(0x033483, join("", map {natfix($_,9) }
	       (0x96,0x64,0x63,45,0x56,0x46,45,0x82,0x41,0x55,0x44,45,0x89,0x89,255)));
# set VMU coordinates
modifydna(0x4d08d3, quote(natfix(267,24)));
modifydna(0x4d091f, quote(natfix(210,24)));

################################
# GRASS layout
################################

#patch biomorph array
#modifydna(0x0c9229 + 24* 3,natfix(-16,24));
#modifydna(0x0c9229 + 24* 9,natfix(  7,24));
#modifydna(0x0c9229 + 24*21,natfix(  4,24));
#patch grass directly
modifydna(0x4cd78d + 10* 3, quote(natfix(0x47,9)));  # El *g*asto
modifydna(0x4cd78d + 10* 9, quote(natfix(0x69,9)));  # *z*iempre se
modifydna(0x4cd78d + 10*21, quote(natfix(0x49,9)));  # v*i* mas verde...

# patch enableBioMorph_adaptor
#modifydna(0x71c4ef+24, natfix(0x6ff34f,24));
# fix bioMul
#modifydna(0x719153, join '', map {natfix($_,24)}
#	  26*24,
#	  0x6fce9c, # activateAdaptationTree
#	  0x713860, # caseVar1
#	  2*24,
#	  0x6fce9c, # activateAdaptationTree
#	  0x71077e, # var1_adaptation
#	  20*24,
#	  0x6fce9c, # activateAdaptationTree
#	  0x719633, # apply2_adaptation
#	  2*24,
#	  0x6fce9c, # activateAdaptationTree
#	  0x710436, # bioAdd_adaptation
#	  2*24,
#	  0x6fce9c, # activateAdaptationTree
#	  0x712c3a, # var2_adaptation
#	  11*24,
#	  0x6fce9c, # activateAdaptationTree
#	  0x719633, # apply2_adaptation
#	  2*24,
#	  0x6fce9c, # activateAdaptationTree
#	  0x719153, # bioMul_adaptation
#	  2*24,
#	  0x6fce9c, # activateAdaptationTree
#	  0x71077e, # var1_adaptation
#	  2*24,
#	  0x6fce9c, # activateAdaptationTree
#	  0x712c3a, # var2_adaptation
#	  $programsize - 0x719153 - 26*24 - 48
#	  );

#####
# patch sun / sky-day-bodies
#####

#modifydna(0x206d37+13, "PIPIIIP");
modifydna(0x206d37+18, "P");
modifydna(0x206d37+23, "C");
#modifydna(0x206d37+24, "P");

# copy rna commands from colorSoftYellow for sun
# note that with this alignment we can reuse some of the previous command.
$patch = lenpattern("!".(0x6fa5ad-0x6fa52d-7)."-len:25".
		    "(!".(0xba3-0x7ac+0x5c9cc4+7).":24(?ICFP))",
		    "m0,0m0,1");
modifydna(0x6fa52d, $patch);
#skipcode(0x6fa52d, 0x6fa5ad-length($patch));

#my $newstart = 0x206d55-length($patch);
#my $newlength = 0x0006e0 - 30 + length($patch);

# patch sun: set color
#modifydna(0x206d37+30, $patch);
# patch addr in call to sun
#modifydna(0x6fa75d,natfix($newstart,25));
# patch length in call to sun
#modifydna(0x6fa77b,natfix($newlength,25));

#######
# patch printGeneTable (whale-blow)
#######
# swap left-right
modifydna(0x29bc48+ 424,"IIIPFFFFFP");
modifydna(0x29bc48+ 488,"IIIPCCCCCP");
#skipcodefix(0x2a8825,0x2abd95,25);
modifydna(0x2aae98+2, natfix(0x2abd81- 0x2aaee0,25));
#modifydna(0x2abd9f + 90, "I");  #return 0


#######
# patch scenario
#######

# jump to motherduck (but don't set ducksShown)
#skipcodefix(0x4cf419,0x4cf46b,25);
modifydna(0x4cf419+29, "I");  # disable goto and the next instruction
#modifydna(0x4cf3b0+57, "P");  # disable conditional goto
#modifydna(0x4cfdad+57, "P");  # disable chick conditional goto

# patch lambda-id with whale blow
my $whaleblow = 0x29bc37;  #c48; #0x29bab8;
my $whaleblowlen = 0x284bc3 + 0x0272c1 - $whaleblow;
#modifydna(0x4d1020+32, natfix($whaleblow,25));
#modifydna(0x4d1020+62, natfix($whaleblowlen,25));
#modifydna(0x4d1020+92, natfix($programsize-$whaleblow-$whaleblowlen,25));

# make color transparent, such that the first polygon of lambda is not visible.
# modify first call in lambda-id to return to whale blow.
modifydna(0x4d734a-10, "IIIPIPIIPF");  #tt
modifydna(0x4d7c7e+132, quote(natfix($whaleblow, 24).natfix($whaleblowlen,24)));

# cooords of whale blow
modifydna(0x4d0ecf+0x30, quote(natfix(430-0,24)));
modifydna(0x4d0f1b+0x30, quote(natfix(200-29,24)));
#modifydna(0x29baf7+ 0x30, quote(natfix(430-45,24)));
#modifydna(0x29bb43+ 0x30, quote(natfix(200-275+2048,24)));

# patch crater with ufo
#$ufoentry = 0x653517;  #0x6535b8
$ufoentry = 0x653699 + 118; #752;
$ufolen = 0x2d08 - ($ufoentry-0x652d4a);

#modifydna(0x4d582e+32, natfix($ufoentry,25));
#modifydna(0x4d582e+62, natfix($ufolen,25));
#modifydna(0x4d582e+92, natfix($programsize-$ufoentry-$ufolen,25));
modifydna(0x592d76+132, quote(natfix($ufoentry,24).natfix($ufolen,24)));

# patch coords for ufo
modifydna(0x4d56dd+0x30, quote(natfix($ufox,24)));
modifydna(0x4d5729+0x30, quote(natfix($ufoy,24)));

# jump back to chick
#backskipcode(0x4d6606,0xa5f8-0x9908,0x4cfe16);
#4d6791(009a93):       stack_0:480 := 'Morph Endo!'
#4d685b(009b5d):       CALL drawString

modifydna(0x4d685b, pattern("!".(0x4cccfe+0xa5f8 - 0x4d6914).":25".
			    "(!".(0x4cfe16+50).":25(!".
			    (0x4cccfe+0xa5f8 - 0x4cfe16 -50).":25)".
	                    "!".(0x7295a1-0x239a6d-0x00056f).":25)").
                    template("m0,0m0,1"));
			    
#modifydna(0x4d6791+75, quote(natfix(255,9)));
#modifydna(0x4d685b+132, quote(natfix(0x4cfe16,24).
#			      natfix(0x4cccfe+0xa5f8-0x4cfe16,24)));
#print STDERR "NEW: ".substr($newdna, $offset+ 0x4d6791,200)."\n";

# patch coords for chick
modifydna(0x4cfe85, quote(natfix(171,24)));
modifydna(0x4cfed1, quote(natfix(410,24)));

# jump from chick to output text

#modifydna(0x4d016b+132, quote(natfix(0x4d623a,24)
#			      .natfix(0x4cccfe+0xa5f8-0x4d623a,24)));

# jump into the middle of an instruction to minimize changed bases.

modifydna(0x4d016b+132, quote(natfix(0x4d6224,24)
			      .natfix(0x4cccfe+0xa5f8-0x4d6224,24)));
modifydna(0x4d623a-3,"C");
#modifydna(0x4d016b+132, quote(natfix(0x4d60fb,24)
#			      .natfix(0x4cccfe+0xa5f8-0x4d60fb,24)));

# endo ha... s morphed
modifydna(0x4d6316, join("", map {quote(natfix($_,9)) }
			   (0x62,0,0x54,0x56,0x59,0x57,0x48,0x45,0x44,0x0f)));

# decrypt cow-tail in source dna
my $cowtail = substr($dna, $offset+0x4aa77d, 0x00145c);
$cowtail = rc4($cowtail, (0xb9, 0xb5,0xb4,0xb6,255));
# ... patch it ...
my $len = 10; 
my $lenbits = 1;
while ($lenbits < length(nat($len))) {
    $lenbits = length(nat($len));
    $patch = pattern("(!$len:$lenbits)").template("m0,0m0,0m0,0");
    $len = int((length($patch)+19)/20)*10+50;
}
$lenbits += (2*$len - 100 - length($patch));
$patch = pattern("(!$len:$lenbits)").template("m0,0m0,0m0,0");
# the ultimative patch :)
$patch = "IIPIPICCIIICIIIPIICIICIPIPIIPIPPPIPPPIIC";
#         IIIPIPIIPCIIIPIPIIPCIIIPIPIIPCIIIPIPIIPC
print STDERR "compress RNA $patch ($len)\n";
$patch = "IIIPIPIIPP".$patch.("IIIPIPIIPP"x2).("IIIPIPIIPF"x1);
# insert 7 opaque and 3 transparent
#die "Something went wrong: $patch, $len" if (length($patch) != 2*$len-60);

substr($cowtail, 20+30, length($patch)) = $patch;
# ... and encrypt it again.
$cowtail = rc4($cowtail, (0xb9, 0xb5,0xb4,0xb6,255));
modifydna(0x4aa77d, $cowtail);

# ignore integrity check
#modifydna(0xdba7c+57, "PP");
#skipcode(0xdbac4, 0xdbae5);

#modifydna(0x60fea4, substr(reverse(substr($newdna, $offset+0x61181e, 0x1962)), 0, 0x1962-75));
#modifydna(0x61181e, substr($dna, $offset+0x61181e, 0x1962));

buildmodifications();

print STDERR "Total: ".length($prefix)."\n";
print $prefix;

print STDERR substr($newdna,$offset+0x6f51b4, 0x6f522d - 0x6f51b4)."\n"
