#!/usr/bin/env perl

use strict;
use warnings;
use v5.16;

###############################################################################
# Scott Baker - 2025-10-29 - https://www.perturb.org/
###############################################################################
# Pure Perl versions of the squares32 and squares64 PRNGs.
#
# A lot of work was done here to mimic how C handles overflow multiplication
# on large uint64_t numbers. Perl converts scalars that are larger than 2^64-1
# to floating point on the backend. We do *NOT* want that, because PRNGs rely
# on overflow math to do their magic. We utilize 'use integer' to force Perl
# to do all math with regular 64bit values. When overflow occurs Perl likes to
# convert large values to negative numbers. In the original C all math is done
# with uint64_t, so we have to convert the IV/negative numbers back into
# UV/unsigned (positive) values.
#
# Note: Bitshift operations are unsigned, unless you're in a `use integer`
# block which switches to signed bitshift. We do a lot of `use integer` and
# then immediately do `no integer` to get the appropriate math type
###############################################################################
# /* Borrowed from: https://squaresrng.wixsite.com/rand */
#
# inline static uint64_t squares64(uint64_t ctr, uint64_t key) {
#    uint64_t t, x, y, z;
#    y = x = ctr * key; z = y + key;
#    x = x*x + y; x = (x>>32) | (x<<32);       /* round 1 */
#    x = x*x + z; x = (x>>32) | (x<<32);       /* round 2 */
#    x = x*x + y; x = (x>>32) | (x<<32);       /* round 3 */
#    t = x = x*x + z; x = (x>>32) | (x<<32);   /* round 4 */
#    return t ^ ((x*x + y) >> 32);             /* round 5 */
# }
###############################################################################

use Getopt::Long;

my $seed;

GetOptions(
	'seed=i' => \$seed,
);

my $iterations = $ARGV[0] || 10;

###############################################################################
###############################################################################

if (!$seed) {
	$seed = perl_rand64();
	print color('yellow', "Using random seed $seed\n\n");
}

print color('white');
printf("%2s    %6s %16s\n", "", "squares32", "squares64");
print color('reset');

for (1 .. $iterations) {
	printf("%2d) %11u %21u\n", $_, squares32($_, $seed), squares64($_, $seed));
}

###############################################################################
###############################################################################

sub squares64 {
	my ($ctr, $key) = @_;

	my ($t, $x, $y, $z);

	use integer;
	$y = $x = $ctr * $key; $z = $y + $key;

	# Round 1
	$x = ($x * $x) + $y;
	no integer;
	$x = ($x >> 32) | ($x << 32);

	# Round 2
	use integer;
	$x = ($x * $x) + $z;
	no integer;
	$x = ($x >> 32) | ($x << 32);

	# Round 3
	use integer;
	$x = ($x * $x) + $y;
	no integer;
	$x = ($x >> 32) | ($x << 32);

	# Round 4
	use integer;
	$t = $x = ($x * $x) + $z;
	no integer;
	$x = ($x >> 32) | ($x << 32);

	use integer;
	my $part = ($x * $x + $y);
	no integer;

	my $ret = $t ^ ($part >> 32);

	return $ret;
}

sub squares32 {
	my ($ctr, $key) = @_;

	my ($x, $y, $z);

	use integer;
	$y = $x = $ctr * $key; $z = $y + $key;

	# Round 1
	$x = ($x * $x) + $y;
	no integer;
	$x = ($x >> 32) | ($x << 32);

	# Round 2
	use integer;
	$x = ($x * $x) + $z;
	no integer;
	$x = ($x >> 32) | ($x << 32);

	# Round 3
	use integer;
	$x = ($x * $x) + $y;
	no integer;
	$x = ($x >> 32) | ($x << 32);

	use integer;
	my $part = ($x * $x + $z);
	no integer;

	my $ret = ($part >> 32) & 4294967295;

	return $ret;
}


sub trim {
	my ($s) = (@_, $_); # Passed in var, or default to $_
	if (!defined($s) || length($s) == 0) { return ""; }
	$s =~ s/^\s*//;
	$s =~ s/\s*$//;

	return $s;
}

# String format: '115', '165_bold', '10_on_140', 'reset', 'on_173', 'red', 'white_on_blue'
sub color {
    my ($str, $txt) = @_;

    # If we're NOT connected to a an interactive terminal don't do color
    if (-t STDOUT == 0) { return $txt || ""; }

    # No string sent in, so we just reset
    if (!length($str) || $str eq 'reset') { return "\e[0m"; }

    # Some predefined colors
    my %color_map = qw(red 160 blue 27 green 34 yellow 226 orange 214 purple 93 white 15 black 0);
    $str =~ s|([A-Za-z]+)|$color_map{$1} // $1|eg;

    # Get foreground/background and any commands
    my ($fc,$cmd) = $str =~ /^(\d{1,3})?_?(\w+)?$/g;
    my ($bc)      = $str =~ /on_(\d{1,3})$/g;

    if (defined($fc) && int($fc) > 255) { $fc = undef; } # above 255 is invalid

    # Some predefined commands
    my %cmd_map = qw(bold 1 italic 3 underline 4 blink 5 inverse 7);
    my $cmd_num = $cmd_map{$cmd // 0};

    my $ret = '';
    if ($cmd_num)      { $ret .= "\e[${cmd_num}m"; }
    if (defined($fc))  { $ret .= "\e[38;5;${fc}m"; }
    if (defined($bc))  { $ret .= "\e[48;5;${bc}m"; }
    if (defined($txt)) { $ret .= $txt . "\e[0m";   }

    return $ret;
}

sub file_get_contents {
	open(my $fh, "<", $_[0]) or return undef;
	binmode($fh, ":encoding(UTF-8)");

	my $array_mode = ($_[1]) || (!defined($_[1]) && wantarray);

	if ($array_mode) { # Line mode
		my @lines  = readline($fh);

		# Right trim all lines
		foreach my $line (@lines) { $line =~ s/[\r\n]+$//; }

		return @lines;
	} else { # String mode
		local $/       = undef; # Input rec separator (slurp)
		return my $ret = readline($fh);
	}
}

sub file_put_contents {
	my ($file, $data) = @_;

	open(my $fh, ">", $file) or return undef;
	binmode($fh, ":encoding(UTF-8)");
	print $fh $data;
	close($fh);

	return length($data);
}

sub perl_rand64 {
	my $high = int(rand() * 2**32 - 1);
	my $low  = int(rand() * 2**32 - 1);

	my $ret = ($high << 32) | $low;

	return $ret;
}

# Creates methods k() and kd() to print, and print & die respectively
BEGIN {
	if (eval { require Data::Dump::Color }) {
		*k = sub { Data::Dump::Color::dd(@_) };
	} else {
		require Data::Dumper;
		*k = sub { print Data::Dumper::Dumper(\@_) };
	}

	sub kd {
		k(@_);

		printf("Died at %2\$s line #%3\$s\n",caller());
		exit(15);
	}
}

# vim: tabstop=4 shiftwidth=4 noexpandtab autoindent softtabstop=4