#!/usr/bin/env perl

use strict;
use warnings;
use v5.16;
use Getopt::Long;

###############################################################################
# 2025-01-22: Pure Perl implementation of PRNG xoshiro256 family of PRNGs
# Scott Baker / https://www.perturb.org/
###############################################################################
# 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 xoshiro256
# (and most 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 those 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.
###############################################################################

# Initial seeds for testing
# 256bit functions need 4x 64bit integers, and 512 needs 8x
my $seeds = [
	1216172134540287360 , 607988272756665600 , 16172922978634559625, 8476171486693032832,
];

my $use_random_seed = 0;
GetOptions(
	'random_seed' => \$use_random_seed,
	'seeds=s'     => \&set_seeds,
);

# Get random 64bit seeds
if ($use_random_seed) {
	print color('yellow', "Using random seeds\n");
	foreach my $seed (@$seeds) {
		$seed = perl_rand64();
	}
}

my $iterations = int($ARGV[0] || 8);

print "Seeds: " . color(123, join(", ", @$seeds) . "\n\n");
for (my $i = 1; $i <= $iterations; $i++) {
	my $num;
	$num = xoshiro256plus($seeds);
	#$num = xoshiro256plusplus($seeds);
	#$num = xoshiro256starstar($seeds);

	#As a bonus we include one of the 512 bit variants also
	#$num = xoshiro512plus($seeds);

	printf("%2d) %s\n", $i, color('white', $num));
}

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

#my $seeds = [1216172134540287360, 607988272756665600, 16172922978634559625, 8476171486693032832];
#my $num   = xoshiro256starstar($seeds);
# xoshiro256**
sub xoshiro256starstar {
	# Seeds are passed in by reference so we can update them
	my ($s) = @_;

	# We use integer math here because we need the large multiplication to
	# overflow. Without this Perl will try and convert this big number to a
	# float and we don't want that.
	use integer;
	my $result = rotl($s->[1] * 5, 7) * 9;
	# We have to unconvert the overflowed number from an IV to UV after the big math
	$result    = iv_2_uv($result);
	no integer;

	my $t = $s->[1] << 17;

	$s->[2] ^= $s->[0];
	$s->[3] ^= $s->[1];
	$s->[1] ^= $s->[2];
	$s->[0] ^= $s->[3];

	$s->[2] ^= $t;

	$s->[3] = rotl($s->[3], 45);

	return $result;
}

# xoshiro256+
sub xoshiro256plus {
	# Seeds are passed in by reference so we can update them
	my ($s) = @_;

	# We use integer math here because we need the large multiplication to
	# overflow. Without this Perl will try and convert this big number to a
	# float and we don't want that.
	use integer;
	my $result = $s->[0] + $s->[3];
	# We have to unconvert the overflowed number from an IV to UV after the big math
	$result    = iv_2_uv($result);
	no integer;

	my $t = $s->[1] << 17;

	$s->[2] ^= $s->[0];
	$s->[3] ^= $s->[1];
	$s->[1] ^= $s->[2];
	$s->[0] ^= $s->[3];

	$s->[2] ^= $t;

	$s->[3] = rotl($s->[3], 45);

	return $result;
}

# xoshiro256++
sub xoshiro256plusplus {
	# Seeds are passed in by reference so we can update them
	my ($s) = @_;

	# We use integer math here because we need the large multiplication to
	# overflow. Without this Perl will try and convert this big number to a
	# float and we don't want that.
	use integer;
	my $result = rotl($s->[0] + $s->[3], 23) + $s->[0];
	# We have to unconvert the overflowed number from an IV to UV after the big math
	$result    = iv_2_uv($result);
	no integer;

	my $t = $s->[1] << 17;

	$s->[2] ^= $s->[0];
	$s->[3] ^= $s->[1];
	$s->[1] ^= $s->[2];
	$s->[0] ^= $s->[3];

	$s->[2] ^= $t;

	$s->[3] = rotl($s->[3], 45);

	return $result;
}

# Bonus: xoshiro512+
# This requires 8x 64bit seeds to run
sub xoshiro512plus {
	# Seeds are passed in by reference so we can update them
	my ($s) = @_;

	# We use integer math here because we need the large multiplication to
	# overflow. Without this Perl will try and convert this big number to a
	# float and we don't want that.
	use integer;
	my $result = $s->[0] + $s->[2];
	# We have to unconvert the overflowed number from an IV to UV after the big math
	$result    = iv_2_uv($result);
	no integer;

	my $t = $s->[1] << 11;

	$s->[2] ^= $s->[0];
	$s->[5] ^= $s->[1];
	$s->[1] ^= $s->[2];
	$s->[7] ^= $s->[3];
	$s->[3] ^= $s->[4];
	$s->[4] ^= $s->[5];
	$s->[0] ^= $s->[6];
	$s->[6] ^= $s->[7];

	$s->[6] ^= $t;

	$s->[7] = rotl($s->[7], 21);

	return $result;
}

# During large integer math when a UV overflows and wraps back around
# Perl casts it as a IV value. For the purposes of PCG we need that
# wraparound math to stay in place. We need uint64_t all the time.
sub iv_2_uv {
	my $x = $_[0];

	# Flip it from a IV (signed) to a UV (unsigned)
	# use Devel::Peek; Dump($var) # See the internal Perl type
	if ($x < 0) {
		no integer;
		$x += 18446744073709551615;
		$x += 1;
	}

    return $x;
}

# Rotate the bits in a 64bit integer to the left and wrap back
# around to the right side.
sub rotl {
	my ($num, $shift) = @_;
	my $ret           = ($num << $shift) | ($num >> (64 - $shift));

	return $ret;
}

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

sub rotl_mini {
	return ($_[0] << $_[1]) | ($_[0] >> (64 - $_[1]));
}

sub iv_2_uv_mini {
	my $x = $_[0];
	if ($x < 0) { no integer; $x += 18446744073709551615; $x += 1; }

    return $x;
}

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 perl_rand64 {
	my $low  = int(rand() * (2**32-1));
	my $high = int(rand() * (2**32-1));

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

	return $ret;
}

sub set_seeds {
	my ($name, $val) = @_;

	my @nums = split(/,/, $val);

	# Convert to integers
	foreach my $num (@nums) {
		$num = int($num);
	}

	$seeds   = \@nums;
}

# 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