[zx-fizzbuzz] / tapify

#! /usr/bin/perl

use autodie;

sub intify ($) {
  my ($n) = @_;
  if ($n =~ /^0/) { $n = oct $n; }
  return $n;
}

sub frame ($$) {
  my ($flag, $d) = @_;
  my $a = $flag;
  for (my $i = 0; $i < length $d; $i++) { $a ^= ord substr $d, $i, 1; }
  return pack("S< C", 2 + length $d, $flag) . $d . chr($a);
}

@ARGV == 4 or die "usage: $0 TY NAME P1 P2";
my ($ty, $name, $p1, $p2) = @ARGV;

my $body = "";
READ: for (;;) {
  sysread STDIN, my $buf, 4096;
  last READ unless length $buf;
  $body .= $buf;
}

my $tap = "";
$tap .= frame 0, pack "C A10 S< S< S<",
  $ty, $name, length $body, intify $p1, intify $p2;
$tap .= frame 255, $body;

syswrite STDOUT, $tap;
Commit	Line	Data
79f86650 MW	1	#! /usr/bin/perl
	2
	3	use autodie;
	4
	5	sub intify ($) {
	6	my ($n) = @_;
	7	if ($n =~ /^0/) { $n = oct $n; }
	8	return $n;
	9	}
	10
	11	sub frame ($$) {
	12	my ($flag, $d) = @_;
	13	my $a = $flag;
	14	for (my $i = 0; $i < length $d; $i++) { $a ^= ord substr $d, $i, 1; }
	15	return pack("S< C", 2 + length $d, $flag) . $d . chr($a);
	16	}
	17
	18	@ARGV == 4 or die "usage: $0 TY NAME P1 P2";
	19	my ($ty, $name, $p1, $p2) = @ARGV;
	20
	21	my $body = "";
	22	READ: for (;;) {
	23	sysread STDIN, my $buf, 4096;
	24	last READ unless length $buf;
	25	$body .= $buf;
	26	}
	27
	28	my $tap = "";
	29	$tap .= frame 0, pack "C A10 S< S< S<",
	30	$ty, $name, length $body, intify $p1, intify $p2;
	31	$tap .= frame 255, $body;
	32
	33	syswrite STDOUT, $tap;