#!/usr/bin/env perl 

use v5.34.1;

use strict;
use warnings;

use IO::Socket::UNIX;

use Path::Tiny qw/path/;

my $HOME = $ENV{HOME};
my $PACKET_HELLO = 0;

my $fh = IO::Socket::UNIX->new(
    Type => SOCK_STREAM(),
    Peer => 'msgba.sock',
) || die "Can't open socket: $IO::Socket::errstr";

my $rom = path($HOME)->child('ruby.gba')->slurp;
my $sav = path($HOME)->child('ruby.ss1')->slurp;

my $packet_hello = "";
open my $fh_packet_hello, '>', \$packet_hello;
write_packet_hello($fh_packet_hello, \$rom, \$sav);
close $fh_packet_hello;
my $packet = "";
open my $fh_packet, '>', \$packet;
write_packet($fh_packet, $PACKET_HELLO, \$packet_hello);
close $fh_packet;
print $fh $packet;

while (retrieve_packet($fh)) {
}

sub retrieve_packet {
    my $fh = shift;
    (read $fh, my $id, 8) or return 0;
    $id = unpack('Q>', $id);
    (read $fh, my $size, 8) or return 0;
    $size = unpack('Q>', $size);
    (read $fh, my $raw_data, $size) or return 0;
    state $i = 0;
    if ($i == 500) {
        read_send_frame($raw_data);
    }
    $i++;
    return 1;
}

sub read_send_frame {
    my $raw_data = shift;
    open my $fh, '<', \$raw_data;
    (read $fh, my $stride, 4) or return 0;
    $stride = unpack('N', $stride);
    (read $fh, my $size, 8) or return 0;
    $size = unpack('Q>', $size);
    (read $fh, my $rgbx, $size) or return 0;
    my @rgbx = split '', $rgbx;
    for (my $i = 3; $i < length $rgbx; $i+=4) {
        $rgbx[$i] = chr 255;
    }
    $rgbx = join '', @rgbx;
    path('screenshot.rgbx')->spew($rgbx);
    close $fh;
}

sub write_packet {
    my $fh = shift;
    my $id = shift;
    my $raw_data = ret_scalar(shift);
    print $fh pack('Q>', $id);
    print $fh pack('Q>', length $raw_data);
    print $fh $raw_data;
}

sub write_packet_hello {
    my $fh = shift or die "No file handle";
    my $rom = ret_scalar(shift);
    my $save = ret_scalar(shift);
    my $rom_length = length $rom;
    my $save_length = length $save;
    say "Packet size = @{[16 + $rom_length + $save_length]}";


    print $fh pack 'Q>', $rom_length;
    print $fh $rom;
    print $fh pack 'Q>', $save_length;
    print $fh $save;
}

sub ret_scalar {
    my $arg = shift;
    if (check_scalar_ref($arg)) {
        return ${$arg};
    }
    die "No scalar ref";
}

sub check_scalar_ref {
    my $arg = shift or die "Undefined scalar ref";

    if ((ref $arg) eq 'SCALAR') {
        return 1;
    }
    return 0;
}