#!/usr/bin/env perl

use strict;
use warnings;
use v5.16;

use Test::More;

###############################################################################
# 2025-01-22: Pure Perl implementation of PRNG splitmix64 PRNG
# 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 splitmix
# (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/signed numbers back into UV/unsigned (positive) values.
###############################################################################
#uint64_t splitmix64::rand64() {
#    uint64_t z;
#
#    z = (x += 0x9e3779b97f4a7c15);
#    z = (z ^ (z >> 30)) * 0xbf58476d1ce4e5b9;
#    z = (z ^ (z >> 27)) * 0x94d049bb133111eb;
#
#    return z ^ (z >> 31);
#}
###############################################################################

use Getopt::Long;

my $seed        = 11; # Default 64bit seed
my $random_seed = 0;

GetOptions(
	'seed=i'       => \$seed,
	'random_seed'  => \$random_seed,
	'unit-tests'   => \&run_unit_tests,
);

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

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

print color(123, "Using seed: $seed\n\n");

for my $x (1 .. $iters) {
	my $num1  = splitmix64_perl(\$seed);

	printf("%2d: %20u\n", $x, $num1);
}

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

#my $seed = [10293820198];
#my $num  = splitmix_64_perl($seed);
sub splitmix64_perl {
	# Seed must be passed as a reference so we can update it
	my ($seed) = @_;

	use integer;
	my $z  = iv_2_uv($$seed += 11400714819323198485);
	$$seed = iv_2_uv($$seed);
	no integer;

	$z = shift_xor_multiply($z, 30, 13787848793156543929);
	$z = shift_xor_multiply($z, 27, 10723151780598845931);
	$z = shift_xor_multiply($z, 31, 1);

	return $z;
}

# Splitmix does a lot of bitshifting, xoring, and multiplying so we
# create one function to simplify that. We utilize `use integer` to
# make sure all math is done using integers and preserve the rollover
sub shift_xor_multiply {
	my ($x, $shift, $mult) = @_;

	# This needs to be done with `no integer`
	no integer;
	$x = ($x ^ ($x >> $shift));

	# Use integer math for the overflow
	use integer;
	$x = iv_2_uv($x * $mult);
	no integer;

	return $x;
}

# During large integer math when a UV overflows and wraps back around
# Perl casts it as a IV value. For the purposes of a PRNG 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;
}

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

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;
}

# 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);
	}
}

# Run a test with a given seed and return a string of the results
sub quick_test {
	my $seed = $_[0];

	my @data = ();
	for (my $i = 0; $i < 4; $i++) {
		my $num = splitmix64_perl(\$seed);
		push(@data, $num);
	}

	my $ret = join(", ", @data);
	return $ret;
}

sub run_unit_tests {
	# Seeds < 2**32
	cmp_ok(quick_test(11)       , 'eq', '5833679380957638813, 4839782808629744545, 11769803791402734189, 9308485889748266480');
	cmp_ok(quick_test(22)       , 'eq', '14415425345905102346, 17264975761475716686, 1412077619021228083, 12404402112097020482');
	cmp_ok(quick_test(100)      , 'eq', '2532601429470541124, 269152572843532260, 4491231873834608077, 4673566422923057776');
	cmp_ok(quick_test(123456789), 'eq', '2466975172287755897, 8832083440362974766, 3534771765162737125, 9592110948284743397');
	cmp_ok(quick_test(9999)     , 'eq', '6117204470161645077, 15966700211956150513, 15034308290212886683, 7774926710803868520');

	# Seeds > 2**32
	cmp_ok(quick_test(7774926710803868520)  , 'eq', '9605346004387840742, 17435495358832388828, 12684084655726398219, 9795402745067826113');
	cmp_ok(quick_test(9795402745067826113)  , 'eq', '13110559830617540027, 13626988459271143897, 846014752197971904, 13956522239222304255');
	cmp_ok(quick_test(846014752197971904)   , 'eq', '17051223190671778754, 12943043929365758946, 17796463379074244041, 16028253299916138813');
	cmp_ok(quick_test(12943043929365758946) , 'eq', '13152169664619309884, 10188724118650338133, 13259243310153093243, 12185650234802439251');
	cmp_ok(quick_test(16028253299916138813) , 'eq', '17201533047954400773, 3347092783829409799, 2118253649191891459, 15494166571380546778');

	done_testing();
	exit(0);
}

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

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

	return $ret;
}

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