108 lines
2.4 KiB
Perl
108 lines
2.4 KiB
Perl
#!/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;
|
|
}
|