DW2 seed lock name search script

#!/usr/bin/perl

use strict;
use warnings;

$| = 1;

# Text input layout:
#     A B C D E F G H I J K
#     L M N O P Q R S T U V
#     W X Y Z ' , . ; ‥ → <space>
#     a b c d e f g h i j k
#     l m n o p q r s t u v
#     w x y z ! ? BACK  END
# Moving down from "s" goes to BACK, "t" and "v" go to END.

my @textmap = (
    [0x60, " "],
    [0x0A, "a"],
    [0x0B, "b"],
    [0x0C, "c"],
    [0x0D, "d"],
    [0x0E, "e"],
    [0x0F, "f"],
    [0x10, "g"],
    [0x11, "h"],
    [0x12, "i"],
    [0x13, "j"],
    [0x14, "k"],
    [0x15, "l"],
    [0x16, "m"],
    [0x17, "n"],
    [0x18, "o"],
    [0x19, "p"],
    [0x1A, "q"],
    [0x1B, "r"],
    [0x1C, "s"],
    [0x1D, "t"],
    [0x1E, "u"],
    [0x1F, "v"],
    [0x20, "w"],
    [0x21, "x"],
    [0x22, "y"],
    [0x23, "z"],
    [0x24, "A"],
    [0x25, "B"],
    [0x26, "C"],
    [0x27, "D"],
    [0x28, "E"],
    [0x29, "F"],
    [0x2A, "G"],
    [0x2B, "H"],
    [0x2C, "I"],
    [0x2D, "J"],
    [0x2E, "K"],
    [0x2F, "L"],
    [0x30, "M"],
    [0x31, "N"],
    [0x32, "O"],
    [0x33, "P"],
    [0x34, "Q"],
    [0x35, "R"],
    [0x36, "S"],
    [0x37, "T"],
    [0x38, "U"],
    [0x39, "V"],
    [0x3A, "W"],
    [0x3B, "X"],
    [0x3C, "Y"],
    [0x3D, "Z"],
    [0x60, " "],
    [0x63, "→"],
    [0x67, "'"],
    [0x69, ","],
    [0x6B, "."],
    [0x6E, "?"],
    [0x6F, "!"],
    [0x70, ";"],
    [0x75, "‥"],
);

my @initial_names = (
    ["Bran", "Glynn", "Talint", "Numor", "Lars", "Orfeo", "Artho", "Esgar"],
    ["Varia", "Elani", "Ollisa", "Roz", "Kailin", "Peta", "Illyth", "Gwen"],
);
for (my $i = 0; $i < @initial_names; $i++) {
    for (my $j = 0; $j < 8; $j++) {
        my $name = "";
        for (my $k = 0; $k < 8; $k++) {
            if ($k >= length($initial_names[$i][$j])) {
                $name .= "\x5F";
            } else {
                my $ch = substr($initial_names[$i][$j], $k, 1);
                my $code = undef;
                for (my $l = 1; $l < @textmap; $l++) {
                    if ($textmap[$l][1] eq $ch) {
                        $code = $textmap[$l][0];
                        last;
                    }
                }
                die if !defined($code);
                $name .= pack("C", $code);
            }
        }
        $initial_names[$i][$j] = $name;
    }
}

my @name = (0,0,0,0,0,0,0,0);
for ($name[3] = 0; $name[3] < @textmap; $name[3]++) {
  next if !$name[3] && $name[4];
  next if $textmap[$name[3]][0] == 0x50 && !$name[4];
  for ($name[2] = 0; $name[2] < @textmap; $name[2]++) {
    next if !$name[2] && $name[3];
    next if $textmap[$name[2]][0] == 0x50 && !$name[3];
    for ($name[1] = 0; $name[1] < @textmap; $name[1]++) {
      next if !$name[1] && $name[2];
      next if $textmap[$name[1]][0] == 0x50 && !$name[2];
      printf STDERR "Name: a%s\r", join("", map {$textmap[$_][1]} @name[1..$#name]);
      for ($name[0] = 1; $name[0] < @textmap; $name[0]++) {
        next if $textmap[$name[0]][0] == 0x50 && !$name[1];
        for (my $speed = 0; $speed < 3; $speed++) {
          my $save = &gen_save(\@name, $speed);
          my $checksum = &checksum($save);
          if ($checksum == 0x5FEA || $checksum == 0xAFF5) {
            printf "Name: %-4s  Speed: %-6s  Checksum: \$%04X\n",
                join("", map {$textmap[$_][1]} @name),
                ("Fast", "Medium", "Slow")[$speed], $checksum;
          }
        }
      }
    }
  }
}


sub gen_save {
    my ($name, $speed) = @_;

    my $save = "\0" x 0x71;

    substr($save, 0x09, 4) = pack("C*", map {$textmap[$_][0]} @name[0..3]);
    substr($save, 0x63, 4) = pack("C*", map {$textmap[$_][0]} @name[4..7]);

    my $name_index = 0;
    for (my $i = 3; $i >= 0; $i--) {
        $name_index += $textmap[$name[$i]][0];
        $name_index += $name_index >> 8;
        $name_index &= 0xFF;
        $name_index += $textmap[$name[$i+4]][0];
        $name_index += $name_index >> 8;
        $name_index &= 0xFF;
    }
    substr($save, 0x0D, 4) = substr($initial_names[0][$name_index & 7], 0, 4);
    substr($save, 0x67, 4) = substr($initial_names[0][$name_index & 7], 4, 4);
    substr($save, 0x11, 4) = substr($initial_names[1][$name_index>>3 & 7], 0, 4);
    substr($save, 0x6B, 4) = substr($initial_names[1][$name_index>>3 & 7], 4, 4);

    substr($save, 0x6F, 1) = ("\x28", "\x46", "\xFF")[$speed];

    my $seed = &checksum($save);

    substr($save, 0x15, 1) = "\x84";

    # Hero stats
    substr($save, 0x18, 1) = "\x1C";
    substr($save, 0x1E, 4) = "\x05\x04\x05\x08";
    substr($save, 0x23, 1) = "\x1C";
    substr($save, 0x26, 1) = "\x01";

    # Prince stats
    substr($save, 0x2A, 1) = "\x1F";
    substr($save, 0x2C, 1) = "\x06";
    substr($save, 0x30, 4) = "\x04\x04\x0C\x08";
    substr($save, 0x35, 1) = "\x1F";
    substr($save, 0x37, 2) = "\x06\x01";

    # Princess stats
    substr($save, 0x3C, 1) = "\x20";
    substr($save, 0x3E, 1) = "\x1C";
    substr($save, 0x42, 4) = "\x02\x16\x04\x0D";
    substr($save, 0x47, 1) = "\x20";
    substr($save, 0x49, 2) = "\x1C\x01";

    substr($save, 0x4B, 1) = "\x55";
    substr($save, 0x53, 2) = "\x45\x55";
    substr($save, 0x5B, 2) = "\x41\x51";

    return $save;
}


sub random {
    my ($seed_ref) = @_;
    my $seed = $$seed_ref;

    for (my $i = 0; $i < 2; $i++) {
        for (my $y = 8; $y > 0; $y--) {
            my $a = ($seed >> 15) ^ 1;
            $seed = ($seed << 1) & 0xFFFF;
            if ($a) {
                $seed ^= 0x1021;
            }
        }
    }
    my $random = $seed & 0xFF;

    $$seed_ref = $seed;
    return $random;
}


sub checksum {
    my ($data) = @_;
    my $seed = 0x7070;
    foreach my $byte (reverse(unpack("C*", $data))) {
        for (my $y = 8; $y > 0; $y--) {
            my $a = ($seed >> 8) ^ $byte;
            $seed = ($seed << 1) & 0xFFFF;
            $byte = ($byte << 1) & 0xFF;
            if ($a & 0x80) {
                $seed ^= 0x1021;
            }
        }
    }
    return $seed;
}