#!/usr/bin/perl

# Note:  The windows code is totally untested, as I don't use Windows.
# If there's a problem and you know how to solve it, please send a patch.

#$windows = 1;

if ($windows) {

  $device = "COM1";

  open FTDI, '+<', $device  or die "Cannot open $device: $!\n";

} else {

  $device = '/dev/ttyUSB0';

  unless (-c $device) {
    die "Device file '$device' does not exist!\n";
  };

  print "If you see this message, unplug your device and try again.\n";
  `stty raw -echo < $device`; print "\e[A\e[K"; select undef, undef, undef, 0.1;

  open FTDI, '+<', $device or die "Cannot open $device: $!\n";

};

select FTDI; $| = 1; select STDOUT;

print "Switching Z80 to 'program' mode...\n";
$code = pack('H*', '00000000000000000000000000000000');
special_write($code);

print "Testing two-way communication...\n";

$test = "This is a test string!";

$code = pack('H*', 'C30000');
$code .= pack('H*', '210000'); # ld hl $0000
for ($i = 0; $i < length($test); $i++) {
  $code .= pack('H*', '7E');          # ld a [hl]
  $code .= substr($test, $i, 1);  #   [data]
  $code .= pack('H*', '77');          # ld [hl] a
  $code .= pack('H*', 'C30000');      # jp $0000
};

special_write($code);
unless ($test eq special_read(length($test))) {
  die "Two-way communication test failed.\n";
};

print "Two-way communication successful!\n";

print "Testing SRAM...\n";

for ($j = 0; $j < 1; $j++) {

  open RANDOM, '<', '/dev/urandom';
    read RANDOM, $test, 16384;
  close RANDOM;

  $code = '';
  $code .= pack('H*', '210000'); # ld hl $0000
  $code .= pack('H*', '110040'); # ld de $4000
  for ($i = 0; $i < length($test); $i++) {
    $code .= pack('H*', '7E');          # ld a [hl]
    $code .= substr($test, $i, 1);      #   [data]
    $code .= pack('H*', '12');          # ld [de] a
    $code .= pack('H*', '13');          # inc de
    $code .= pack('H*', 'C30000');      # jp $0000
  };
  $code .= pack('H*', '210000'); # ld hl $0000
  $code .= pack('H*', '110040'); # ld de $4000
  for ($i = 0; $i < length($test); $i++) {
    $code .= pack('H*', '1A');          # ld a [de]
    $code .= pack('H*', '77');          # ld [hl] a
    $code .= pack('H*', '13');          # inc de
    $code .= pack('H*', 'C30000');      # jp $0000
  };

  print "...\n";
  $sent = 0; $receive = '';
  while ('whatever') {
    $read = $write = $what = '';
    vec($read, fileno(FTDI), 1) = 1;
    vec($write, fileno(FTDI), 1) = 1 if $sent < length($code);
    if ($sent == length($code) and length($receive) == length($test)) {
      $timeout = 0.1;
    } else {
      $timeout = 1.0;
    };
    $result = select $read, $write, $what, $timeout;
    last if $result == 0 and $sent == length($code);
    if (vec($read, fileno(FTDI), 1)) {
      $result = sysread FTDI, $receive, 4096, length($receive);
      die "Read error: $!" if $result < 0;
      die "FTDI device disappeared!" if $result == 0;
    };
    if (vec($write, fileno(FTDI), 1)) {
      $result = syswrite FTDI, $code, 4096, $sent;
      die "Write error: $!" if $result < 0;
      die "FTDI device disappeared!" if $result == 0;
      $sent += $result;
    };
    print "\e[1ASent $sent bytes, received " . length($receive) . " bytes...\n";
  };

  unless ($receive eq $test) {
    compare($test, $receive);
    die "SRAM test failed!\n";
  };

};

print "SRAM test succeeded!\n";

unless (-f $ARGV[0]) {
  die "Please specify a file to be written to the EEPROM.\n";
};

open FILE, '<', $ARGV[0] or die "Unable to open '$ARGV[0]' for input: $!\n";
  read FILE, $image, 65536;
close FILE;

if (length($image) != 32768) {
  die "ROM image must be 32768 bytes!\n";
};

$assembly = pack('H*', '310070210080224140014000110050210000EDB03EAA3255D53E5532AAAA3EA03255D5013F00ED5B4140210050EDB07E12D5E1BE20FD232241407CB720CBC30000');

unless ($assembly ne '') {
  open CODE, '<', 'burn.rom';
    read FILE, $assembly, 16384;
  close CODE;
  if (length($assembly) == 0) {
    die "I need some special code in a file named 'burn.rom'\n";
  };
};

print "Sending 'burn' program to Z80 SRAM...\n";

$data = '';
$data .= pack('H*', '310060'); # ld sp $6000
$data .= pack('H*', '210000'); # ld hl $0000
$data .= pack('H*', '110040'); # ld de $4000
for ($i = 0; $i < length($assembly); $i++) {
  $data .= pack('H*', '7E');          # ld a [hl]
  $data .= substr($assembly, $i, 1);  #   [data]
  $data .= pack('H*', '12');          # ld [de] a
  $data .= pack('H*', '13');          # inc de
  $data .= pack('H*', 'C30000');      # jp $0000
};
$data .= pack('H*', 'C30040');  # jp $4000

special_write($data);

print "Sending ROM image to Z80...\n";

special_write($image);

print "Sending 'verify' program to Z80 SRAM...\n";
$assembly = '';
$assembly .= pack('H*', '210000');        # ld hl $0000
$assembly .= pack('H*', '110080');        # ld de $0080
$assembly .= pack('H*', '010000');        # ld bc $0000
$assembly .= pack('H*', '1A');            # ld a [de]
$assembly .= pack('H*', '77');            # ld [hl] a
$assembly .= pack('H*', '13');            # inc de
$assembly .= pack('H*', '0D');            # dec c
$assembly .= pack('H*', '0D20F9');        # dec c; jp nz ...
$assembly .= pack('H*', '0520F5');        # dec b; jp nz ...
$assembly .= pack('H*', 'C30000');        # jp $0000

$data = '';
$data .= pack('H*', '310060'); # ld sp $6000
$data .= pack('H*', '210000'); # ld hl $0000
$data .= pack('H*', '110040'); # ld de $4000
for ($i = 0; $i < length($assembly); $i++) {
  $data .= pack('H*', '7E');          # ld a [hl]
  $data .= substr($assembly, $i, 1);  #   [data]
  $data .= pack('H*', '12');          # ld [de] a
  $data .= pack('H*', '13');          # inc de
  $data .= pack('H*', 'C30000');      # jp $0000
};
$data .= pack('H*', 'C30040') . pack('H*', '00');

special_write($data);

print "Reading EEPROM contents...\n";

$verify = special_read(32768);

print "Switching Z80 to 'normal' mode...\n";

special_write(pack('C*', 0x76));

if ($image eq $verify) {
  print "\nEEPROM has been programmed and verified!\n";
} else {
  compare($image, $verify);
  die "\nVerification of EEPROM contents failed!\n";
};

sub compare {
  open FILE, ">", ".first";
    print FILE $_[0];
  close FILE;
  open FILE, ">", ".second";
    print FILE $_[1];
  close FILE;
  `hexdump -C ".first" > .first.txt`;
  `hexdump -C ".second" > .second.txt`;
  print `diff .first.txt .second.txt`;
};

sub special_read {
  my ($buffer, $result, $size);
  print "Reading $_[0] bytes:\n";
  print "...\n";
  while (length($buffer) < $_[0]) {
    $size = $_[0] - length($buffer);
    $size = 4096 if $size > 4096;
    $result = sysread FTDI, $buffer, $size, length($buffer);
    die "Read error: $!\n" if $result < 0;
    print "\e[1ARead " . length($buffer) . " bytes so far...\n";
    last if length($buffer) == $_[0];
    last if $result == 0;
  };
  print "Read complete!\n";
  return $buffer;
};

sub special_write {
  my ($count, $result, $size);
  print "Writing " . length($_[0]) . " bytes:\n";
  print "...\n";
  while ($count < length($_[0])) {
    $size = length($_[0]) - $count;
    $size = 4096 if $size > 4096;
    $result = syswrite FTDI, substr($_[0], $count, $size);
    die "Write error: $!\n" if $result < 0;
    $count += $result;
    print "\e[1AWrote $count bytes so far...\n";
  };
  print "Write complete!\n";
};