mirror of
https://github.com/coding-horror/basic-computer-games.git
synced 2025-12-29 14:15:08 -08:00
Merge branch 'coding-horror:main' into main
This commit is contained in:
@@ -10,6 +10,8 @@ import java.util.stream.Collectors;
|
||||
* Converted from BASIC to Java by Aldrin Misquitta (@aldrinm)
|
||||
* The original BASIC program uses an array to maintain the questions and answers and to decide which question to
|
||||
* ask next. Updated this Java implementation to use a tree instead of the earlier faulty one based on a list (thanks @patimen).
|
||||
*
|
||||
* Bonus option: TREE --> prints the game decision data as a tree to visualize/debug the state of the game
|
||||
*/
|
||||
public class Animal {
|
||||
|
||||
|
||||
43
58_Love/ruby/love.rb
Normal file
43
58_Love/ruby/love.rb
Normal file
@@ -0,0 +1,43 @@
|
||||
data = [60, 1, 12, 26, 9, 12, 3, 8, 24, 17, 8, 4, 6, 23, 21, 6, 4, 6, 22, 12, 5, 6, 5,
|
||||
4, 6, 21, 11, 8, 6, 4, 4, 6, 21, 10, 10, 5, 4, 4, 6, 21, 9, 11, 5, 4, 4, 6, 21,
|
||||
8, 11, 6, 4, 4, 6, 21, 7, 11, 7, 4, 4, 6, 21, 6, 11, 8, 4, 4, 6, 19, 1, 1, 5,
|
||||
11, 9, 4, 4, 6, 19, 1, 1, 5, 10, 10, 4, 4, 6, 18, 2, 1, 6, 8, 11, 4, 4, 6, 17,
|
||||
3, 1, 7, 5, 13, 4, 4, 6, 15, 5, 2, 23, 5, 1, 29, 5, 17, 8, 1, 29, 9, 9, 12, 1,
|
||||
13, 5, 40, 1, 1, 13, 5, 40, 1, 4, 6, 13, 3, 10, 6, 12, 5, 1, 5, 6, 11, 3, 11,
|
||||
6, 14, 3, 1, 5, 6, 11, 3, 11, 6, 15, 2, 1, 6, 6, 9, 3, 12, 6, 16, 1, 1, 6, 6,
|
||||
9, 3, 12, 6, 7, 1, 10, 7, 6, 7, 3, 13, 6, 6, 2, 10, 7, 6, 7, 3, 13, 14, 10, 8,
|
||||
6, 5, 3, 14, 6, 6, 2, 10, 8, 6, 5, 3, 14, 6, 7, 1, 10, 9, 6, 3, 3, 15, 6, 16, 1,
|
||||
1, 9, 6, 3, 3, 15, 6, 15, 2, 1, 10, 6, 1, 3, 16, 6, 14, 3, 1, 10, 10, 16, 6, 12,
|
||||
5, 1, 11, 8, 13, 27, 1, 11, 8, 13, 27, 1, 60]
|
||||
|
||||
puts 'LOVE'.center(60)
|
||||
puts 'stephan.com'.center(60)
|
||||
puts "\n\n"
|
||||
|
||||
puts <<~EOLOVE
|
||||
A TRIBUTE TO THE GREAT AMERICAN ARTIST, ROBERT INDIANA.
|
||||
HIS GREATEST WORK WILL BE REPRODUCED WITH A MESSAGE OF
|
||||
YOUR CHOICE UP TO 60 CHARACTERS. IF YOU CAN'T THINK OF
|
||||
A MESSAGE, SIMPLY TYPE THE WORD 'LOVE'\n
|
||||
EOLOVE
|
||||
|
||||
message = gets.strip
|
||||
message = 'love' if message.empty?
|
||||
l = message.length
|
||||
|
||||
until data.empty?
|
||||
puts
|
||||
col = 0
|
||||
p = true
|
||||
while col < 60
|
||||
run = data.shift
|
||||
|
||||
if p
|
||||
run.times { |i| print message[(col + i) % l] }
|
||||
else
|
||||
print ' ' * run
|
||||
end
|
||||
p = !p
|
||||
col += run
|
||||
end
|
||||
end
|
||||
@@ -1,3 +1,7 @@
|
||||
Original source downloaded [from Vintage Basic](http://www.vintage-basic.net/games.html)
|
||||
|
||||
Conversion to [Perl](https://www.perl.org/)
|
||||
|
||||
This is pretty much a re-implementation of the BASIC, taking advantage
|
||||
of Perl's array functionality and working directly with the alphabetic
|
||||
color codes.
|
||||
|
||||
419
60_Mastermind/perl/mastermind.pl
Executable file
419
60_Mastermind/perl/mastermind.pl
Executable file
@@ -0,0 +1,419 @@
|
||||
#!/usr/bin/env perl
|
||||
|
||||
use 5.010; # To get 'state' and 'say'
|
||||
|
||||
use strict; # Require explicit declaration of variables
|
||||
use warnings; # Enable optional compiler warnings
|
||||
|
||||
use English; # Use more friendly names for Perl's magic variables
|
||||
use List::Util qw{ min sum }; # Convenient list utilities
|
||||
use Term::ReadLine; # Prompt and return user input
|
||||
|
||||
our $VERSION = '0.000_01';
|
||||
|
||||
use constant MAX_GUESSES => 10;
|
||||
|
||||
print <<'EOD';
|
||||
MASTERMIND
|
||||
Creative Computing Morristown, New Jersey
|
||||
|
||||
|
||||
EOD
|
||||
|
||||
=begin comment
|
||||
|
||||
MASTERMIND II
|
||||
STEVE NORTH
|
||||
CREATIVE COMPUTING
|
||||
PO BOX 789-M MORRISTOWN NEW JERSEY 07960
|
||||
|
||||
=end comment
|
||||
|
||||
=cut
|
||||
|
||||
# NOTE that mixed-case 'my' variables are 'global' in the sense that
|
||||
# they are used in subroutines, but not passed to them.
|
||||
|
||||
say '';
|
||||
|
||||
my $number_of_colors = get_input(
|
||||
'Number of colors [1-8]: ',
|
||||
sub { m/ \A [1-8] \z /smx },
|
||||
"No more than 8, please!\n",
|
||||
);
|
||||
|
||||
say '';
|
||||
|
||||
my $Number_of_Positions = get_input(
|
||||
'Number of positions: ',
|
||||
sub { m/ \A [0-9]+ \z /smx && $ARG },
|
||||
"A positive number, please\n",
|
||||
);
|
||||
|
||||
say '';
|
||||
|
||||
my $number_of_rounds = get_input(
|
||||
'Number of rounds: ',
|
||||
sub { m/ \A [0-9]+ \z /smx && $ARG },
|
||||
"A positive number, please\n",
|
||||
);
|
||||
|
||||
my $P = $number_of_colors ** $Number_of_Positions;
|
||||
say 'Total possibilities = ', $P;
|
||||
|
||||
my @colors = ( qw{
|
||||
Black White Red Green Orange Yellow Purple Tan
|
||||
})[ 0 .. $number_of_colors - 1 ];
|
||||
my @Color_Codes = map { uc substr $ARG, 0, 1 } @colors;
|
||||
|
||||
print <<'EOD';
|
||||
|
||||
|
||||
Color Letter
|
||||
===== ======
|
||||
EOD
|
||||
|
||||
foreach my $inx ( 0 .. $#colors ) {
|
||||
printf "%-13s%s\n", $colors[$inx], $Color_Codes[$inx];
|
||||
}
|
||||
|
||||
say '';
|
||||
|
||||
my $computer_score = 0; # Computer score
|
||||
my $human_score = 0; # Human score
|
||||
|
||||
foreach my $round_number ( 1 .. $number_of_rounds ) {
|
||||
|
||||
print <<"EOD";
|
||||
|
||||
Round number $round_number ----
|
||||
|
||||
Guess my combination.
|
||||
|
||||
EOD
|
||||
|
||||
$human_score += human_guesses( $Number_of_Positions );
|
||||
|
||||
print_score( $computer_score, $human_score );
|
||||
|
||||
$computer_score += computer_guesses();
|
||||
|
||||
print_score( $computer_score, $human_score );
|
||||
|
||||
}
|
||||
|
||||
# Make a $pattern into a hash with one key for each possible color. The
|
||||
# value for each color is the number of times it appears in the pattern.
|
||||
sub hashify_pattern {
|
||||
my $pattern = uc $ARG[0];
|
||||
my %p = map { $ARG => 0 } @Color_Codes;
|
||||
$p{$ARG}++ for split qr//, $pattern;
|
||||
return \%p;
|
||||
}
|
||||
|
||||
# Given a $pattern, a $guess at that pattern, and $black and $white
|
||||
# scores, return a true value if the $black and $white scores of the
|
||||
# $guess are those supplied as arguments; otherwise return a false
|
||||
# value. This is used by computer_guesses() to eliminate possibilities.
|
||||
sub analyze_black_white {
|
||||
my ( $pattern, $guess, $black, $white ) = @ARG;
|
||||
my $info = analyze_guess( $pattern, $guess );
|
||||
return $info->{black} == $black && $info->{white} == $white;
|
||||
}
|
||||
|
||||
# Given a $pattern and a $guess at that pattern, return a reference to a
|
||||
# hash with the following keys:
|
||||
# {guess} is the guess;
|
||||
# {black} is the black score of the guess
|
||||
# {white} is the white score of the guess
|
||||
sub analyze_guess {
|
||||
my ( $pattern, $guess ) = @ARG;
|
||||
my $pattern_hash = hashify_pattern( $pattern );
|
||||
my $guess_hash = hashify_pattern( $guess );
|
||||
my $white = sum(
|
||||
map { min( $pattern_hash->{$ARG}, $guess_hash->{$ARG} ) } @Color_Codes,
|
||||
);
|
||||
my $black = 0;
|
||||
foreach my $inx ( 0 .. length( $pattern ) - 1 ) {
|
||||
if ( substr( $pattern, $inx, 1 ) eq substr( $guess, $inx, 1 ) )
|
||||
{
|
||||
$black++;
|
||||
--$white;
|
||||
}
|
||||
}
|
||||
return +{
|
||||
guess => $guess,
|
||||
black => $black,
|
||||
white => $white,
|
||||
}
|
||||
}
|
||||
|
||||
# Used by the computer to guess the human's choice. The return is the
|
||||
# number of guesses the computer took. The return is the maximum plus
|
||||
# one if the computer failed to guess.
|
||||
sub computer_guesses {
|
||||
|
||||
print <<'EOD';
|
||||
|
||||
Now I guess. Think of a combination.
|
||||
EOD
|
||||
get_input(
|
||||
'Hit <return> when ready:',
|
||||
);
|
||||
|
||||
# Generate all possible permutations.
|
||||
my @possible;
|
||||
foreach my $permutation ( 0 .. @Color_Codes ** $Number_of_Positions - 1 ) {
|
||||
my $guess;
|
||||
for ( 1 .. $Number_of_Positions ) {
|
||||
my $inx = $permutation % @Color_Codes;
|
||||
$guess .= $Color_Codes[ $inx ];
|
||||
$permutation = int( $permutation / @Color_Codes );
|
||||
}
|
||||
push @possible, $guess;
|
||||
}
|
||||
|
||||
# Guess ...
|
||||
foreach my $guess_num ( 1 .. MAX_GUESSES ) {
|
||||
|
||||
# Guess a possible permutation at random, removing it from the
|
||||
# list.
|
||||
my $guess = splice @possible, int rand @possible, 1;
|
||||
say 'My guess is: ', $guess;
|
||||
|
||||
# Find out its black/white score.
|
||||
my ( $black, $white ) = split qr< , >smx, get_input(
|
||||
'Blacks, Whites: ',
|
||||
sub { m/ \A [0-9]+ , [0-9]+ \z /smx },
|
||||
"Please enter two unsigned integers\n",
|
||||
);
|
||||
|
||||
# If it's all black, the computer wins.
|
||||
if ( $black == $Number_of_Positions ) {
|
||||
say "I got it in $guess_num moves!";
|
||||
return $guess_num;
|
||||
}
|
||||
|
||||
# Eliminate all possible permutations that give the black/white
|
||||
# score that our guess got. If there are any left, take another
|
||||
# guess.
|
||||
next if @possible = grep { analyze_black_white( $ARG, $guess, $black,
|
||||
$white ) } @possible;
|
||||
|
||||
# There were no permutations left. Complain.
|
||||
print <<'EOD';
|
||||
You have given me inconsistent information.
|
||||
Try again, and this time please be more careful.
|
||||
EOD
|
||||
|
||||
goto &computer_guesses; # Tail-call ourselves to try again.
|
||||
}
|
||||
|
||||
print <<'EOD';
|
||||
I used up all my moves!
|
||||
I guess my CPU is just having an off day.
|
||||
EOD
|
||||
|
||||
return MAX_GUESSES + 1;
|
||||
}
|
||||
|
||||
# Used to generate a pattern and process the human's guesses. The return
|
||||
# is the number of guesses the human took. The return is the maximum
|
||||
# plus one if the human failed to guess.
|
||||
sub human_guesses {
|
||||
|
||||
my @saved_moves; # Saved moves
|
||||
my $pattern = uc join '',
|
||||
map { $Color_Codes[ rand @Color_Codes ] } 1 .. $Number_of_Positions;
|
||||
|
||||
foreach my $guess_num ( 1 .. MAX_GUESSES ) {
|
||||
|
||||
my $guess = uc get_input(
|
||||
"Move # $guess_num guess: ",
|
||||
sub {
|
||||
|
||||
# If the user entered 'quit', bail out.
|
||||
if ( m/ \A quit \z /smxi ) {
|
||||
die "Quitter! My combination was $pattern\n\nGood bye\n";
|
||||
}
|
||||
|
||||
# If the user entered 'board', display the board so far.
|
||||
# We return success to prevent the warning message, but
|
||||
# we also clear $ARG. The caller's caller sees this and
|
||||
# re-queries.
|
||||
if ( m/ \A board \z /smxi ) {
|
||||
print <<'EOD';
|
||||
|
||||
Board
|
||||
Move Guess Black White
|
||||
EOD
|
||||
my $number = 1;
|
||||
foreach my $item ( @saved_moves ) {
|
||||
printf "%4d %-13s %3d %3d\n", $number++,
|
||||
@{ $item }{ qw{ guess black white } };
|
||||
}
|
||||
return undef; # Validation failure, but suppress warning.
|
||||
}
|
||||
|
||||
# End of special-case code. Below here we are dealing
|
||||
# with guess input.
|
||||
|
||||
# The length of the input must equal the number of
|
||||
# positions.
|
||||
if ( $Number_of_Positions != length ) {
|
||||
warn "Bad number of positions\n";
|
||||
return 0;
|
||||
}
|
||||
|
||||
# The input may contain only valid color codes.
|
||||
state $invalid_color = do { # Evaluated only once
|
||||
local $LIST_SEPARATOR = '';
|
||||
qr< [^@Color_Codes] >smxi;
|
||||
};
|
||||
if ( m/ ( $invalid_color ) /smxi ) {
|
||||
warn "'$1' is unrecognized.\n";
|
||||
return 0;
|
||||
}
|
||||
|
||||
# We're good.
|
||||
return 1;
|
||||
},
|
||||
"Please enter 'board', 'quit', or any $Number_of_Positions of @{[
|
||||
join ', ', map { qq<'$ARG'> } @Color_Codes ]}.\n",
|
||||
);
|
||||
|
||||
my $rslt = analyze_guess( $pattern, $guess );
|
||||
|
||||
push @saved_moves, $rslt;
|
||||
|
||||
if ( $rslt->{black} == $Number_of_Positions ) {
|
||||
say "You guessed it in $guess_num moves.";
|
||||
return $guess_num;
|
||||
}
|
||||
|
||||
say "You have $rslt->{black} blacks and $rslt->{white} whites.";
|
||||
|
||||
}
|
||||
|
||||
print <<"EOD";
|
||||
You ran out of moves. That's all you get.
|
||||
|
||||
The actual combination was: $pattern
|
||||
EOD
|
||||
|
||||
return MAX_GUESSES + 1;
|
||||
}
|
||||
|
||||
# Print the $computer and $human score
|
||||
sub print_score {
|
||||
my ( $computer, $human ) = @ARG;
|
||||
print <<"EOD";
|
||||
Score:
|
||||
Computer: $computer
|
||||
Human: $human
|
||||
EOD
|
||||
return;
|
||||
}
|
||||
|
||||
# Get input from the user. The arguments are:
|
||||
# * The prompt
|
||||
# * A reference to validation code. This code receives the response in
|
||||
# $ARG and returns true for a valid response.
|
||||
# * A warning to print if the response is not valid. This must end in a
|
||||
# return. It is suppressed if the validation code returned undef.
|
||||
# The first valid response is returned. An end-of-file terminates the
|
||||
# script.
|
||||
sub get_input {
|
||||
my ( $prompt, $validate, $warning ) = @ARG;
|
||||
|
||||
# If no validator is passed, default to one that always returns
|
||||
# true.
|
||||
$validate ||= sub { 1 };
|
||||
|
||||
# Create the readline object. The 'state' causes the variable to be
|
||||
# initialized only once, no matter how many times this subroutine is
|
||||
# called. The do { ... } is a compound statement used because we
|
||||
# need to tweak the created object before we store it.
|
||||
state $term = do {
|
||||
my $obj = Term::ReadLine->new( 'reverse' );
|
||||
$obj->ornaments( 0 );
|
||||
$obj;
|
||||
};
|
||||
|
||||
while ( 1 ) { # Iterate indefinitely
|
||||
|
||||
# Read the input into the topic variable, localized to prevent
|
||||
# Spooky Action at a Distance. We exit on undef, which signals
|
||||
# end-of-file.
|
||||
exit unless defined( local $ARG = $term->readline( $prompt ) );
|
||||
|
||||
# Return the input if it is valid.
|
||||
return $ARG if my $rslt = $validate->();
|
||||
|
||||
# Issue the warning, and go around the merry-go-round again.
|
||||
warn $warning if defined $rslt;
|
||||
}
|
||||
}
|
||||
|
||||
# NOTE the following is unused, but left in place in case someone wants
|
||||
# to add a 'Do you want instructions?'
|
||||
#
|
||||
# Get a yes-or-no answer. The argument is the prompt, which will have
|
||||
# '? [y/n]: ' appended. The donkey work is done by get_input(), which is
|
||||
# requested to validate the response as beginning with 'y' or 'n',
|
||||
# case-insensitive. The return is a true value for 'y' and a false value
|
||||
# for 'n'.
|
||||
sub get_yes_no {
|
||||
my ( $prompt ) = @ARG;
|
||||
state $map_answer = {
|
||||
n => 0,
|
||||
y => 1,
|
||||
};
|
||||
my $resp = lc get_input(
|
||||
"$prompt? [y/n]: ",
|
||||
sub { m/ \A [yn] /smxi },
|
||||
"Please respond 'y' or 'n'\n",
|
||||
);
|
||||
return $map_answer->{ substr $resp, 0, 1 };
|
||||
}
|
||||
|
||||
__END__
|
||||
|
||||
=head1 TITLE
|
||||
|
||||
mastermind - Play the game 'Mastermind' from Basic Computer Games
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
mastermind.pl
|
||||
|
||||
=head1 DETAILS
|
||||
|
||||
This Perl script is a port of mastermind, which is the 60th
|
||||
entry in Basic Computer Games.
|
||||
|
||||
This is pretty much a re-implementation of the BASIC, taking advantage
|
||||
of Perl's array functionality and working directly with the alphabetic
|
||||
color codes.
|
||||
|
||||
=head1 PORTED BY
|
||||
|
||||
Thomas R. Wyant, III F<wyant at cpan dot org>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
Copyright (C) 2022 by Thomas R. Wyant, III
|
||||
|
||||
This program is free software; you can redistribute it and/or modify it
|
||||
under the same terms as Perl 5.10.0. For more details, see the Artistic
|
||||
License 1.0 at
|
||||
L<https://www.perlfoundation.org/artistic-license-10.html>, and/or the
|
||||
Gnu GPL at L<http://www.gnu.org/licenses/old-licenses/gpl-1.0.txt>.
|
||||
|
||||
This program is distributed in the hope that it will be useful, but
|
||||
without any warranty; without even the implied warranty of
|
||||
merchantability or fitness for a particular purpose.
|
||||
|
||||
=cut
|
||||
|
||||
# ex: set expandtab tabstop=4 textwidth=72 :
|
||||
426
83_Stock_Market/java/StockMarket.java
Normal file
426
83_Stock_Market/java/StockMarket.java
Normal file
@@ -0,0 +1,426 @@
|
||||
import java.util.ArrayList;
|
||||
import java.util.InputMismatchException;
|
||||
import java.util.List;
|
||||
import java.util.Random;
|
||||
import java.util.Scanner;
|
||||
|
||||
/**
|
||||
* Stock Market Simulation
|
||||
*
|
||||
* Some of the original program's variables' documentation and their equivalent in this program:
|
||||
* A-MRKT TRND SLP; marketTrendSlope
|
||||
* B5-BRKRGE FEE; brokerageFee
|
||||
* C-TTL CSH ASSTS; cashAssets
|
||||
* C5-TTL CSH ASSTS (TEMP); tmpCashAssets
|
||||
* C(I)-CHNG IN STK VAL; changeStockValue
|
||||
* D-TTL ASSTS; assets
|
||||
* E1,E2-LRG CHNG MISC; largeChange1, largeChange2
|
||||
* I1,I2-STCKS W LRG CHNG; randomStockIndex1, randomStockIndex2
|
||||
* N1,N2-LRG CHNG DAY CNTS; largeChangeNumberDays1, largeChangeNumberDays2
|
||||
* P5-TTL DAYS PRCHSS; totalDaysPurchases
|
||||
* P(I)-PRTFL CNTNTS; portfolioContents
|
||||
* Q9-NEW CYCL?; newCycle
|
||||
* S4-SGN OF A; slopeSign
|
||||
* S5-TTL DYS SLS; totalDaysSales
|
||||
* S(I)-VALUE/SHR; stockValue
|
||||
* T-TTL STCK ASSTS; totalStockAssets
|
||||
* T5-TTL VAL OF TRNSCTNS; totalValueOfTransactions
|
||||
* W3-LRG CHNG; bigChange
|
||||
* X1-SMLL CHNG(<$1); smallChange
|
||||
* Z4,Z5,Z6-NYSE AVE.; tmpNyseAverage, nyseAverage, nyseAverageChange
|
||||
* Z(I)-TRNSCT transactionQuantity
|
||||
*
|
||||
* new price = old price + (trend x old price) + (small random price
|
||||
* change) + (possible large price change)
|
||||
*
|
||||
* Converted from BASIC to Java by Aldrin Misquitta (@aldrinm)
|
||||
*/
|
||||
public class StockMarket {
|
||||
|
||||
private static final Random random = new Random();
|
||||
|
||||
public static void main(String[] args) {
|
||||
|
||||
Scanner scan = new Scanner(System.in);
|
||||
|
||||
printIntro();
|
||||
printGameHelp(scan);
|
||||
|
||||
final List<Stock> stocks = initStocks();
|
||||
|
||||
double marketTrendSlope = Math.floor((random.nextFloat() / 10) * 100 + 0.5)/100f;
|
||||
double totalValueOfTransactions;
|
||||
int largeChangeNumberDays1 = 0;
|
||||
int largeChangeNumberDays2 = 0;
|
||||
|
||||
//DAYS FOR FIRST TREND SLOPE (A)
|
||||
var t8 = randomNumber(1, 6);
|
||||
|
||||
//RANDOMIZE SIGN OF FIRST TREND SLOPE (A)
|
||||
if (random.nextFloat() <= 0.5) {
|
||||
marketTrendSlope = -marketTrendSlope;
|
||||
}
|
||||
|
||||
// INITIALIZE CASH ASSETS:C
|
||||
double cashAssets = 10000;
|
||||
boolean largeChange1 = false;
|
||||
boolean largeChange2 = false;
|
||||
double tmpNyseAverage;
|
||||
double nyseAverage = 0;
|
||||
boolean inProgress = true;
|
||||
var firstRound = true;
|
||||
|
||||
while (inProgress) {
|
||||
|
||||
/* Original documentation:
|
||||
RANDOMLY PRODUCE NEW STOCK VALUES BASED ON PREVIOUS DAY'S VALUES
|
||||
N1,N2 ARE RANDOM NUMBERS OF DAYS WHICH RESPECTIVELY
|
||||
DETERMINE WHEN STOCK I1 WILL INCREASE 10 PTS. AND STOCK
|
||||
I2 WILL DECREASE 10 PTS.
|
||||
IF N1 DAYS HAVE PASSED, PICK AN I1, SET E1, DETERMINE NEW N1
|
||||
*/
|
||||
int randomStockIndex1 = 0;
|
||||
int randomStockIndex2 = 0;
|
||||
|
||||
if (largeChangeNumberDays1 <= 0) {
|
||||
randomStockIndex1 = randomNumber(0, stocks.size());
|
||||
largeChangeNumberDays1 = randomNumber(1, 6);
|
||||
largeChange1 = true;
|
||||
}
|
||||
if (largeChangeNumberDays2 <= 0) {
|
||||
randomStockIndex2 = randomNumber(0, stocks.size());
|
||||
largeChangeNumberDays2 = randomNumber(1, 6);
|
||||
largeChange2 = true;
|
||||
}
|
||||
adjustAllStockValues(stocks, largeChange1, largeChange2, marketTrendSlope, stocks.get(randomStockIndex1), stocks.get(randomStockIndex2));
|
||||
|
||||
//reset largeChange flags
|
||||
largeChange1 = false;
|
||||
largeChange2 = false;
|
||||
largeChangeNumberDays1--;
|
||||
largeChangeNumberDays2--;
|
||||
|
||||
//AFTER T8 DAYS RANDOMLY CHANGE TREND SIGN AND SLOPE
|
||||
t8 = t8 - 1;
|
||||
if (t8 < 1) {
|
||||
marketTrendSlope = newMarketTrendSlope();
|
||||
t8 = randomNumber(1, 6);
|
||||
}
|
||||
|
||||
//PRINT PORTFOLIO
|
||||
printPortfolio(firstRound, stocks);
|
||||
|
||||
tmpNyseAverage = nyseAverage;
|
||||
nyseAverage = 0;
|
||||
double totalStockAssets = 0;
|
||||
for (Stock stock : stocks) {
|
||||
nyseAverage = nyseAverage + stock.getStockValue();
|
||||
totalStockAssets = totalStockAssets + stock.getStockValue() * stock.getPortfolioContents();
|
||||
}
|
||||
nyseAverage = Math.floor(100 * (nyseAverage / 5) + .5) / 100f;
|
||||
double nyseAverageChange = Math.floor((nyseAverage - tmpNyseAverage) * 100 + .5) / 100f;
|
||||
|
||||
// TOTAL ASSETS:D
|
||||
double assets = totalStockAssets + cashAssets;
|
||||
if (firstRound) {
|
||||
System.out.printf("\n\nNEW YORK STOCK EXCHANGE AVERAGE: %.2f", nyseAverage);
|
||||
} else {
|
||||
System.out.printf("\n\nNEW YORK STOCK EXCHANGE AVERAGE: %.2f NET CHANGE %.2f", nyseAverage, nyseAverageChange);
|
||||
}
|
||||
|
||||
totalStockAssets = Math.floor(100 * totalStockAssets + 0.5) / 100d;
|
||||
System.out.printf("\n\nTOTAL STOCK ASSETS ARE $ %.2f", totalStockAssets);
|
||||
cashAssets = Math.floor(100 * cashAssets + 0.5) / 100d;
|
||||
System.out.printf("\nTOTAL CASH ASSETS ARE $ %.2f", cashAssets);
|
||||
assets = Math.floor(100 * assets + .5) / 100d;
|
||||
System.out.printf("\nTOTAL ASSETS ARE $ %.2f\n", assets);
|
||||
|
||||
if (!firstRound) {
|
||||
System.out.print("\nDO YOU WISH TO CONTINUE (YES-TYPE 1, NO-TYPE 0)? ");
|
||||
var newCycle = readANumber(scan);
|
||||
if (newCycle < 1) {
|
||||
System.out.println("HOPE YOU HAD FUN!!");
|
||||
inProgress = false;
|
||||
}
|
||||
}
|
||||
|
||||
if (inProgress) {
|
||||
boolean validTransaction = false;
|
||||
// TOTAL DAY'S PURCHASES IN $:P5
|
||||
double totalDaysPurchases = 0;
|
||||
// TOTAL DAY'S SALES IN $:S5
|
||||
double totalDaysSales = 0;
|
||||
double tmpCashAssets;
|
||||
while (!validTransaction) {
|
||||
//INPUT TRANSACTIONS
|
||||
readStockTransactions(stocks, scan);
|
||||
totalDaysPurchases = 0;
|
||||
totalDaysSales = 0;
|
||||
|
||||
validTransaction = true;
|
||||
for (Stock stock : stocks) {
|
||||
stock.setTransactionQuantity(Math.floor(stock.getTransactionQuantity() + 0.5));
|
||||
if (stock.getTransactionQuantity() > 0) {
|
||||
totalDaysPurchases = totalDaysPurchases + stock.getTransactionQuantity() * stock.getStockValue();
|
||||
} else {
|
||||
totalDaysSales = totalDaysSales - stock.getTransactionQuantity() * stock.getStockValue();
|
||||
if (-stock.getTransactionQuantity() > stock.getPortfolioContents()) {
|
||||
System.out.println("YOU HAVE OVERSOLD A STOCK; TRY AGAIN.");
|
||||
validTransaction = false;
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
//TOTAL VALUE OF TRANSACTIONS:T5
|
||||
totalValueOfTransactions = totalDaysPurchases + totalDaysSales;
|
||||
// BROKERAGE FEE:B5
|
||||
var brokerageFee = Math.floor(0.01 * totalValueOfTransactions * 100 + .5) / 100d;
|
||||
// CASH ASSETS=OLD CASH ASSETS-TOTAL PURCHASES
|
||||
//-BROKERAGE FEES+TOTAL SALES:C5
|
||||
tmpCashAssets = cashAssets - totalDaysPurchases - brokerageFee + totalDaysSales;
|
||||
if (tmpCashAssets < 0) {
|
||||
System.out.printf("\nYOU HAVE USED $%.2f MORE THAN YOU HAVE.", -tmpCashAssets);
|
||||
validTransaction = false;
|
||||
} else {
|
||||
cashAssets = tmpCashAssets;
|
||||
}
|
||||
}
|
||||
|
||||
// CALCULATE NEW PORTFOLIO
|
||||
for (Stock stock : stocks) {
|
||||
stock.setPortfolioContents(stock.getPortfolioContents() + stock.getTransactionQuantity());
|
||||
}
|
||||
|
||||
firstRound = false;
|
||||
}
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
/**
|
||||
* Random int between lowerBound(inclusive) and upperBound(exclusive)
|
||||
*/
|
||||
private static int randomNumber(int lowerBound, int upperBound) {
|
||||
return random.nextInt((upperBound - lowerBound)) + lowerBound;
|
||||
}
|
||||
|
||||
private static double newMarketTrendSlope() {
|
||||
return randomlyChangeTrendSignAndSlopeAndDuration();
|
||||
}
|
||||
|
||||
private static void printPortfolio(boolean firstRound, List<Stock> stocks) {
|
||||
//BELL RINGING-DIFFERENT ON MANY COMPUTERS
|
||||
if (firstRound) {
|
||||
System.out.printf("%n%-30s\t%12s\t%12s", "STOCK", "INITIALS", "PRICE/SHARE");
|
||||
for (Stock stock : stocks) {
|
||||
System.out.printf("%n%-30s\t%12s\t%12.2f ------ %12.2f", stock.getStockName(), stock.getStockCode(),
|
||||
stock.getStockValue(), stock.getChangeStockValue());
|
||||
}
|
||||
System.out.println("");
|
||||
} else {
|
||||
System.out.println("\n********** END OF DAY'S TRADING **********\n\n");
|
||||
System.out.printf("%n%-12s\t%-12s\t%-12s\t%-12s\t%-20s", "STOCK", "PRICE/SHARE",
|
||||
"HOLDINGS", "VALUE", "NET PRICE CHANGE");
|
||||
for (Stock stock : stocks) {
|
||||
System.out.printf("%n%-12s\t%-12.2f\t%-12.0f\t%-12.2f\t%-20.2f",
|
||||
stock.getStockCode(), stock.getStockValue(), stock.getPortfolioContents(),
|
||||
stock.getStockValue() * stock.getPortfolioContents(), stock.getChangeStockValue());
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
private static void readStockTransactions(List<Stock> stocks, Scanner scan) {
|
||||
System.out.println("\n\nWHAT IS YOUR TRANSACTION IN");
|
||||
for (Stock stock : stocks) {
|
||||
System.out.printf("%s? ", stock.getStockCode());
|
||||
|
||||
stock.setTransactionQuantity(readANumber(scan));
|
||||
}
|
||||
}
|
||||
|
||||
private static int readANumber(Scanner scan) {
|
||||
int choice = 0;
|
||||
|
||||
boolean validInput = false;
|
||||
while (!validInput) {
|
||||
try {
|
||||
choice = scan.nextInt();
|
||||
validInput = true;
|
||||
} catch (InputMismatchException ex) {
|
||||
System.out.println("!NUMBER EXPECTED - RETRY INPUT LINE");
|
||||
} finally {
|
||||
scan.nextLine();
|
||||
}
|
||||
}
|
||||
|
||||
return choice;
|
||||
}
|
||||
|
||||
private static void adjustAllStockValues(List<Stock> stocks, boolean largeChange1,
|
||||
boolean largeChange2,
|
||||
double marketTrendSlope,
|
||||
Stock stockForLargeChange1, Stock stockForLargeChange2
|
||||
) {
|
||||
//LOOP THROUGH ALL STOCKS
|
||||
for (Stock stock : stocks) {
|
||||
double smallChange = random.nextFloat();
|
||||
|
||||
if (smallChange <= 0.25) {
|
||||
smallChange = 0.25;
|
||||
} else if (smallChange <= 0.5) {
|
||||
smallChange = 0.5;
|
||||
} else if (smallChange <= 0.75) {
|
||||
smallChange = 0.75;
|
||||
} else {
|
||||
smallChange = 0;
|
||||
}
|
||||
|
||||
//BIG CHANGE CONSTANT:W3 (SET TO ZERO INITIALLY)
|
||||
var bigChange = 0;
|
||||
if (largeChange1) {
|
||||
if (stock.getStockCode().equals(stockForLargeChange1.getStockCode())) {
|
||||
//ADD 10 PTS. TO THIS STOCK; RESET E1
|
||||
bigChange = 10;
|
||||
}
|
||||
}
|
||||
|
||||
if (largeChange2) {
|
||||
if (stock.getStockCode().equals(stockForLargeChange2.getStockCode())) {
|
||||
//SUBTRACT 10 PTS. FROM THIS STOCK; RESET E2
|
||||
bigChange = bigChange - 10;
|
||||
}
|
||||
}
|
||||
|
||||
stock.setChangeStockValue(Math.floor(marketTrendSlope * stock.stockValue) + smallChange +
|
||||
Math.floor(3 - 6 * random.nextFloat() + .5) + bigChange);
|
||||
stock.setChangeStockValue(Math.floor(100 * stock.getChangeStockValue() + .5) / 100d);
|
||||
stock.stockValue += stock.getChangeStockValue();
|
||||
|
||||
if (stock.stockValue > 0) {
|
||||
stock.stockValue = Math.floor(100 * stock.stockValue + 0.5) / 100d;
|
||||
} else {
|
||||
stock.setChangeStockValue(0);
|
||||
stock.stockValue = 0;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
private static double randomlyChangeTrendSignAndSlopeAndDuration() {
|
||||
// RANDOMLY CHANGE TREND SIGN AND SLOPE (A), AND DURATION
|
||||
var newTrend = Math.floor((random.nextFloat() / 10) * 100 + .5) / 100d;
|
||||
var slopeSign = random.nextFloat();
|
||||
if (slopeSign > 0.5) {
|
||||
newTrend = -newTrend;
|
||||
}
|
||||
return newTrend;
|
||||
}
|
||||
|
||||
private static List<Stock> initStocks() {
|
||||
List<Stock> stocks = new ArrayList<>();
|
||||
stocks.add(new Stock(100, "INT. BALLISTIC MISSILES", "IBM"));
|
||||
stocks.add(new Stock(85, "RED CROSS OF AMERICA", "RCA"));
|
||||
stocks.add(new Stock(150, "LICHTENSTEIN, BUMRAP & JOKE", "LBJ"));
|
||||
stocks.add(new Stock(140, "AMERICAN BANKRUPT CO.", "ABC"));
|
||||
stocks.add(new Stock(110, "CENSURED BOOKS STORE", "CBS"));
|
||||
return stocks;
|
||||
}
|
||||
|
||||
private static void printGameHelp(Scanner scan) {
|
||||
System.out.print("DO YOU WANT THE INSTRUCTIONS (YES-TYPE 1, NO-TYPE 0) ? ");
|
||||
int choice = scan.nextInt();
|
||||
if (choice >= 1) {
|
||||
System.out.println("");
|
||||
System.out.println("THIS PROGRAM PLAYS THE STOCK MARKET. YOU WILL BE GIVEN");
|
||||
System.out.println("$10,000 AND MAY BUY OR SELL STOCKS. THE STOCK PRICES WILL");
|
||||
System.out.println("BE GENERATED RANDOMLY AND THEREFORE THIS MODEL DOES NOT");
|
||||
System.out.println("REPRESENT EXACTLY WHAT HAPPENS ON THE EXCHANGE. A TABLE");
|
||||
System.out.println("OF AVAILABLE STOCKS, THEIR PRICES, AND THE NUMBER OF SHARES");
|
||||
System.out.println("IN YOUR PORTFOLIO WILL BE PRINTED. FOLLOWING THIS, THE");
|
||||
System.out.println("INITIALS OF EACH STOCK WILL BE PRINTED WITH A QUESTION");
|
||||
System.out.println("MARK. HERE YOU INDICATE A TRANSACTION. TO BUY A STOCK");
|
||||
System.out.println("TYPE +NNN, TO SELL A STOCK TYPE -NNN, WHERE NNN IS THE");
|
||||
System.out.println("NUMBER OF SHARES. A BROKERAGE FEE OF 1% WILL BE CHARGED");
|
||||
System.out.println("ON ALL TRANSACTIONS. NOTE THAT IF A STOCK'S VALUE DROPS");
|
||||
System.out.println("TO ZERO IT MAY REBOUND TO A POSITIVE VALUE AGAIN. YOU");
|
||||
System.out.println("HAVE $10,000 TO INVEST. USE INTEGERS FOR ALL YOUR INPUTS.");
|
||||
System.out.println("(NOTE: TO GET A 'FEEL' FOR THE MARKET RUN FOR AT LEAST");
|
||||
System.out.println("10 DAYS)");
|
||||
System.out.println("-----GOOD LUCK!-----");
|
||||
}
|
||||
System.out.println("\n\n");
|
||||
}
|
||||
|
||||
private static void printIntro() {
|
||||
System.out.println(" STOCK MARKET");
|
||||
System.out.println(" CREATIVE COMPUTING MORRISTOWN, NEW JERSEY");
|
||||
System.out.println("\n\n");
|
||||
}
|
||||
|
||||
/**
|
||||
* Stock class also storing the stock information and other related information for simplicity
|
||||
*/
|
||||
private static class Stock {
|
||||
|
||||
private final String stockName;
|
||||
private final String stockCode;
|
||||
private double stockValue;
|
||||
private double portfolioContents = 0;
|
||||
private double transactionQuantity = 0;
|
||||
private double changeStockValue = 0;
|
||||
|
||||
public Stock(double stockValue, String stockName, String stockCode) {
|
||||
this.stockValue = stockValue;
|
||||
this.stockName = stockName;
|
||||
this.stockCode = stockCode;
|
||||
}
|
||||
|
||||
public String getStockName() {
|
||||
return stockName;
|
||||
}
|
||||
|
||||
public String getStockCode() {
|
||||
return stockCode;
|
||||
}
|
||||
|
||||
public double getStockValue() {
|
||||
return stockValue;
|
||||
}
|
||||
|
||||
public double getPortfolioContents() {
|
||||
return portfolioContents;
|
||||
}
|
||||
|
||||
public void setPortfolioContents(double portfolioContents) {
|
||||
this.portfolioContents = portfolioContents;
|
||||
}
|
||||
|
||||
public double getTransactionQuantity() {
|
||||
return transactionQuantity;
|
||||
}
|
||||
|
||||
public void setTransactionQuantity(double transactionQuantity) {
|
||||
this.transactionQuantity = transactionQuantity;
|
||||
}
|
||||
|
||||
public double getChangeStockValue() {
|
||||
return changeStockValue;
|
||||
}
|
||||
|
||||
public void setChangeStockValue(double changeStockValue) {
|
||||
this.changeStockValue = changeStockValue;
|
||||
}
|
||||
|
||||
@Override
|
||||
public String toString() {
|
||||
return "Stock{" +
|
||||
"stockValue=" + stockValue +
|
||||
", stockCode='" + stockCode + '\'' +
|
||||
", portfolioContents=" + portfolioContents +
|
||||
", transactionQuantity=" + transactionQuantity +
|
||||
", changeStockValue=" + changeStockValue +
|
||||
'}';
|
||||
}
|
||||
}
|
||||
|
||||
}
|
||||
@@ -1,3 +1,20 @@
|
||||
Original source downloaded [from Vintage Basic](http://www.vintage-basic.net/games.html)
|
||||
|
||||
Conversion to [Perl](https://www.perl.org/)
|
||||
|
||||
I have replaced the manual date logic with Perl built-ins to the extent
|
||||
possible. Unfortunately the kind of date math involved in the "time
|
||||
spent doing ..." functionality is not well-defined, so I have been
|
||||
forced to retain the original logic here. Sigh.
|
||||
|
||||
You can use any punctuation character you please in the date
|
||||
input. So something like 2/29/2020 is perfectly acceptable.
|
||||
|
||||
It would also have been nice to produce a localized version that
|
||||
supports day/month/year or year-month-day input, but that didn't happen.
|
||||
|
||||
Also nice would have been language-specific output -- especially if it
|
||||
could have accommodated regional differences in which day of the week or
|
||||
month is unlucky.
|
||||
|
||||
Tom Wyant
|
||||
|
||||
249
95_Weekday/perl/weekday.pl
Executable file
249
95_Weekday/perl/weekday.pl
Executable file
@@ -0,0 +1,249 @@
|
||||
#!/usr/bin/env perl
|
||||
|
||||
use 5.010; # To get 'state' and 'say'
|
||||
|
||||
use strict; # Require explicit declaration of variables
|
||||
use warnings; # Enable optional compiler warnings
|
||||
|
||||
use English; # Use more friendly names for Perl's magic variables
|
||||
use Term::ReadLine; # Prompt and return user input
|
||||
use Time::Local qw{ timelocal }; # date-time to epoch
|
||||
# FIXME timelocal() is too smart for its own good in the interpretation
|
||||
# of years, and caused a bunch of Y2020 problems in Perl code that used
|
||||
# it. I believe that this script avoids these problems (which only occur
|
||||
# if the year is less than 1000), but it is probably safer in general to
|
||||
# use timelocal_modern() or timelocal_posix(). These are also exported
|
||||
# by Time::Local, but only by versions 1.28 and 1.30 respectively. This
|
||||
# means that they only come (by default) with Perl 5.30 and 5.34
|
||||
# respectively. Now, Time::Local is a dual-life module, meaning it can
|
||||
# be upgraded from the version packaged with older Perls. But I did not
|
||||
# want to assume that it HAD been upgraded. Caveat coder.
|
||||
use Time::Piece; # O-O epoch to date-time, plus formatting
|
||||
|
||||
our $VERSION = '0.000_01';
|
||||
|
||||
print <<'EOD';
|
||||
|
||||
WEEKDAY
|
||||
Creative Computing Morristown, New Jersey
|
||||
|
||||
|
||||
|
||||
WEEKDAY is a computer demonstration that
|
||||
gives facts about a date of interest to you.
|
||||
|
||||
EOD
|
||||
|
||||
my $now = localtime;
|
||||
my $default_date = join ',', map { $now->$_() } qw{ mon mday year };
|
||||
|
||||
my $today = get_date(
|
||||
"Enter today's date in the form month,day,year (default: $default_date): ",
|
||||
"Please enter month,day,year or return for default\n",
|
||||
$default_date,
|
||||
);
|
||||
|
||||
my $birthday = get_date(
|
||||
'Ender day of birth (or other day of interest): ',
|
||||
"Please enter month,day,year\n",
|
||||
);
|
||||
|
||||
say '';
|
||||
printf "%d/%d/%d %s a %s\n", $birthday->mon, $birthday->mday,
|
||||
$birthday->year, tense( $today, $birthday),
|
||||
( $birthday->mday == 13 && $birthday->wday == 6 ) ?
|
||||
$birthday->fullday . ' the thirteenth --- Beware!' :
|
||||
$birthday->fullday . '.';
|
||||
|
||||
if ( $birthday->epoch <= $today->epoch ) {
|
||||
|
||||
say '*** Happy Birthday! ***'
|
||||
if $birthday->mon == $today->mon &&
|
||||
$birthday->mday == $today->mday;
|
||||
|
||||
print <<'EOD';
|
||||
Years Months Days
|
||||
----- ------ ----
|
||||
EOD
|
||||
|
||||
my @delta = map { $today->$_() - $birthday->$_() } qw{ year mon mday };
|
||||
if ( $delta[2] < 0 ) {
|
||||
$delta[2] += 30;
|
||||
$delta[1] -= 1;
|
||||
}
|
||||
if ( $delta[1] < 0 ) {
|
||||
$delta[1] += 12;
|
||||
$delta[0] -= 1;
|
||||
}
|
||||
my @residue = @delta;
|
||||
|
||||
my $delta_days = 365 * $delta[0] + 30 * $delta[1] + $delta[2];
|
||||
|
||||
display_ymd( 'Your age (if birthdate)', compute_ymd( $delta_days ) );
|
||||
display_ymd( 'You have slept', compute_ymd( $delta_days, 0.35,
|
||||
\@residue ) );
|
||||
display_ymd( 'You have eaten', compute_ymd( $delta_days, 0.17,
|
||||
\@residue ) );
|
||||
display_ymd(
|
||||
$residue[0] > 9 ? 'You have worked/played' :
|
||||
$residue[0] > 3 ? 'You have played/studied' :
|
||||
'You have played',
|
||||
compute_ymd( $delta_days, 0.23,
|
||||
\@residue ) );
|
||||
display_ymd( 'You have relaxed', \@residue );
|
||||
|
||||
say '';
|
||||
say "\t\t*** You may retire in @{[ $birthday->year + 65 ]} ***";
|
||||
}
|
||||
|
||||
say '';
|
||||
|
||||
sub compute_ymd {
|
||||
my ( $delta_days, $fract, $residue ) = @ARG;
|
||||
my $days = defined $fract ? int ( $delta_days * $fract ) : $delta_days;
|
||||
my $years = int( $days / 365 );
|
||||
$days -= $years * 365;
|
||||
my $months = int( $days / 30 );
|
||||
$days -= $months * 30;
|
||||
|
||||
if ( $residue ) {
|
||||
$residue->[2] -= $days;
|
||||
if ( $residue->[2] < 0 ) {
|
||||
$residue->[2] += 30;
|
||||
$residue->[1] -= 1;
|
||||
}
|
||||
$residue->[1] -= $months;
|
||||
if ( $residue->[1] < 0 ) {
|
||||
$residue->[1] += 12;
|
||||
$residue->[0] -= 1;
|
||||
}
|
||||
$residue->[0] -= $years;
|
||||
}
|
||||
|
||||
return [ $years, $months, $days ];
|
||||
}
|
||||
|
||||
sub display_ymd {
|
||||
my ( $label, $ymd ) = @ARG;
|
||||
printf "%-24s%4d%6d%8d\n", $label, @{ $ymd };
|
||||
return;
|
||||
}
|
||||
|
||||
sub get_date {
|
||||
my ( $prompt, $warning, $default ) = @ARG;
|
||||
my ( $month, $day, $year ) = split qr< [[:punct:]] >smx, get_input(
|
||||
$prompt,
|
||||
sub {
|
||||
return 0 unless m/ \A (?: [0-9]+ [[:punct:]] ){2} ( [0-9]+ ) \z /smx;
|
||||
return 1 if $1 >= 1582;
|
||||
warn "Not prepared to give day of week prior to MDLXXXII.\n";
|
||||
return 0;
|
||||
},
|
||||
$warning,
|
||||
$default,
|
||||
);
|
||||
return localtime timelocal( 0, 0, 0, $day, $month - 1, $year );
|
||||
}
|
||||
|
||||
sub tense {
|
||||
my ( $today, $birthday ) = @ARG;
|
||||
my $cmp = $birthday->epoch <=> $today->epoch
|
||||
or return 'is';
|
||||
return $cmp < 0 ? 'was' : 'will be';
|
||||
}
|
||||
|
||||
# Get input from the user. The arguments are:
|
||||
# * The prompt
|
||||
# * A reference to validation code. This code receives the response in
|
||||
# $ARG and returns true for a valid response.
|
||||
# * A warning to print if the response is not valid. This must end in a
|
||||
# return.
|
||||
# * A default to return if the user simply presses <return>.
|
||||
# The first valid response is returned. An end-of-file terminates the
|
||||
# script.
|
||||
sub get_input {
|
||||
my ( $prompt, $validate, $warning, $default ) = @ARG;
|
||||
|
||||
# If no validator is passed, default to one that always returns
|
||||
# true.
|
||||
$validate ||= sub { 1 };
|
||||
|
||||
# Create the readline object. The 'state' causes the variable to be
|
||||
# initialized only once, no matter how many times this subroutine is
|
||||
# called. The do { ... } is a compound statement used because we
|
||||
# need to tweak the created object before we store it.
|
||||
state $term = do {
|
||||
my $obj = Term::ReadLine->new( 'reverse' );
|
||||
$obj->ornaments( 0 );
|
||||
$obj;
|
||||
};
|
||||
|
||||
while ( 1 ) { # Iterate indefinitely
|
||||
|
||||
# Read the input into the topic variable, localized to prevent
|
||||
# Spooky Action at a Distance. We exit on undef, which signals
|
||||
# end-of-file.
|
||||
exit unless defined( local $ARG = $term->readline( $prompt ) );
|
||||
|
||||
# Return the default if it exists AND we got an empty line
|
||||
return $default if defined( $default ) && $ARG eq '';
|
||||
|
||||
# Return the input if it is valid.
|
||||
return $ARG if $validate->();
|
||||
|
||||
# Issue the warning, and go around the merry-go-round again.
|
||||
warn $warning;
|
||||
}
|
||||
}
|
||||
|
||||
__END__
|
||||
|
||||
=head1 TITLE
|
||||
|
||||
weekday - Play the game 'Weekday' from Basic Computer Games
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
weekday.pl
|
||||
|
||||
=head1 DETAILS
|
||||
|
||||
This Perl script is a port of weekday.bas, which is the 95th entry in
|
||||
Basic Computer Games.
|
||||
|
||||
I have replaced the manual date logic with Perl built-ins to the extent
|
||||
possible. Unfortunately the kind of date math involved in the "time
|
||||
spent doing ..." functionality is not well-defined, so I have been
|
||||
forced to retain the original logic here. Sigh.
|
||||
|
||||
You can use any punctuation character you please in the date
|
||||
input. So something like 2/29/2020 is perfectly acceptable.
|
||||
|
||||
It would also have been nice to produce a localized version that
|
||||
supports day/month/year or year-month-day input, but that didn't happen.
|
||||
|
||||
Also nice would have been language-specific output -- especially if it
|
||||
could have accommodated regional differences in which day of the week or
|
||||
month is unlucky.
|
||||
|
||||
=head1 PORTED BY
|
||||
|
||||
Thomas R. Wyant, III F<wyant at cpan dot org>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
Copyright (C) 2022 by Thomas R. Wyant, III
|
||||
|
||||
This program is free software; you can redistribute it and/or modify it
|
||||
under the same terms as Perl 5.10.0. For more details, see the Artistic
|
||||
License 1.0 at
|
||||
L<https://www.perlfoundation.org/artistic-license-10.html>, and/or the
|
||||
Gnu GPL at L<http://www.gnu.org/licenses/old-licenses/gpl-1.0.txt>.
|
||||
|
||||
This program is distributed in the hope that it will be useful, but
|
||||
without any warranty; without even the implied warranty of
|
||||
merchantability or fitness for a particular purpose.
|
||||
|
||||
=cut
|
||||
|
||||
# ex: set expandtab tabstop=4 textwidth=72 :
|
||||
Reference in New Issue
Block a user