view release on metacpan or  search on metacpan

lib/Acme/ConspiracyTheory/Random.pm  view on Meta::CPAN

					my $clone = clone( $redstring );
					"$pronoun has been replaced by $clone";
				},
				sub {
					my $place = bad_place( $redstring );
					"$pronoun has been imprisoned in $place";
				},
			);
			
			_UCFIRST_ "$celeb found out that $truth1 and $silence. " . _UCFIRST_ "$group $are protecting this secret.";
		},
		sub {
			my $celeb  = celebrity( $redstring );
			my $pronoun = $redstring->{celebrity}{female} ? 'she' : 'he';
			my $group = shady_group( $redstring );
			$redstring->{protagonists} = $redstring->{shady_group};
			
			_UCFIRST_ _RANDOM_(
				"$celeb is a member of $group.",
				"$celeb is a former member of $group.",
				"$celeb was thrown out of $group.",
				"$celeb infiltrated $group.",
				"$celeb is the leader of $group.",
				"$celeb is secretly worshipped by $group.",
			);
		},
	);

	if ( $redstring->{protagonists} and not $redstring->{antagonists} and _RANDOM_(0..1) ) {
		my $group1 = $redstring->{protagonists}{shortname} // $redstring->{protagonists}{name};
		my $group2 = shady_group( $redstring );
		$redstring->{antagonists} = $redstring->{shady_group};
		my $know = splural ($redstring->{antagonists}) ? 'know' : 'knows';
		$theory .= " " . _UCFIRST_ _RANDOM_(
			sub {
				my $bribe = precious_resource_with_quantity( $redstring );
				"$group2 $know the truth but $group1 have paid them off with $bribe.";
			},
			"$group2 $know the truth but $group1 have threatened them to keep them silent.",
			"$group2 were helping them until $group1 betrayed them.",
			"$group2 were helping them for a while.",
			"$group2 were originally opposed to this but they're now in on it.",
			"$group2 are trying to get evidence to prove it.",
		);
	}

	_MERGE_( $redstring, base_theory => $theory );
	
	my $evidence = evidence( $redstring );
	$theory .= " $evidence" if $evidence;

	my $numerology = numerology( $redstring );
	$theory .= " $numerology" if $numerology;

	_MERGE_( $redstring, theory => $theory );

	return $theory;
}

my %special_numbers = (
	19   => [ qr/COVID/,             '19 is the coronavirus number' ],
	24   => [ qr/TINTIN/,            'There are 24 Tintin comics' ],
	33   => [ qr/MASON/,             '33 is associated with the masons' ],
	35   => [ qr/ELVIS/,             'Elvis was born in 1935' ],
	44   => [ qr/OBAMA/,             'Barack Obama was the 44th President of the USA' ],
	45   => [ qr/TRUMP|QANON|USA/,   'Donald Trump was the 45th President of the USA',
	          qr/UNITEDNATIONS/,     'The United Nations was founded in 1945' ],
	46   => [ qr/BIDEN/,             'Joe Biden was the 46th President of the USA' ],
	47   => [ qr/THECIA/,            'The CIA was founded in 1947',
	          qr/SILVER/,            'Silver has atomic number 47' ],
	49   => [ qr/NATO/,              'NATO was founded in 1949' ],
	51   => [ qr/KFC/,               'Area 51 is the fifty-first area' ],
	52   => [ qr/KFC/,               'KFC was founded in 1952' ],
	55   => [ qr/BIGMAC|MCDONALDS/,  'McDonalds was founded in 1955' ],
	63   => [ qr/JFK|OSWALD/,        'JFK was shot in 1963' ],
	79   => [ qr/GOLD/,              'Gold has the atomic number 79' ],
	81   => [ qr/HIV/,               'AIDS was discovered in 1981' ],
	82   => [ qr/COKE/,              'Diet Coke first came out in 1982' ],
	86   => [ qr/RADON/,             'The atomic number for radon is 86' ],
	92   => [ qr/URANIUM/,           'The atomic number for uranium is 92' ],
	322  => [ qr/SKULL/,             'Skull and Bones is Order 322' ],
	666  => [ qr/DEVIL|DEMON|SATAN/, '666 is the number of the beast' ],
);

sub numerology {
	my $redstring = shift // {};
	
	my @strings = List::Util::uniq(
		grep { length }
		map { my $letters = uc( $_ ); $letters =~ s/[^A-Z0-9]//g; $letters }
		map {
			/^(the )(.+)$/i ? $2 : $_
		}
		map {
			ref( $_ ) ? grep( defined, $_->{name}, $_->{shortname}, $_->{title}, $_->{author} ) : $_
		}
		values( %$redstring )
	);
	
	my %calcs;
	foreach my $string ( @strings ) {
		next if length($string) >= 20;
		my @letters = split //, $string;
		my @numbers = map /[A-Z]/ ? ( ord($_) - 0x40 ) : $_, @letters;
		my $sum     = List::Util::sum( @numbers );
		
		push @{ $calcs{$sum} ||= [] }, sprintf(
			'%s = %s = %s',
			join( '+', @letters ),
			join( '+', @numbers ),
			$sum,
		);
	}
	
	foreach my $key ( %special_numbers ) {
		if ( $calcs{$key} ) {
			my @copy = @{ $special_numbers{$key} };
			while ( @copy ) {
				my ( $test, $statement ) = splice( @copy, 0 , 2 );
				next unless "@strings" =~ $test;
				push @{ $calcs{$key} }, "And guess what? " . $statement;