Basics of Raku
Descripción del contenido de la página
Conversión de antiguos programas de BASIC a Raku para aprender los rudimentos de este lenguaje.
Etiquetas:
3D Plot
# 3D Plot
# Original version in BASIC:
# Creative Computing (Morristown, New Jersey, USA), ca. 1980.
# This version in Raku:
# Copyright (c) 2024, Marcos Cruz (programandala.net)
# SPDX-License-Identifier: Fair
# Written on 2024-12-02.
# Last modified: 20241211T1232+0100.
constant $WIDTH = 56;
sub clear_screen {
print "\e[0;0H\e[2J";
}
sub print_credits {
put "3D Plot\n";
put 'Original version in BASIC:';
put " Creative computing (Morristown, New Jersey, USA), ca. 1980.\n";
put 'This version in Raku:';
put ' Copyright (c) 2024, Marcos Cruz (programandala.net)';
put " SPDX-License-Identifier: Fair\n";
put 'Press Enter to start the program.';
prompt '';
}
sub a($z) {
30 * exp(-$z * $z / 100);
}
sub draw {
for -30, -28.5 ... 30 -> $x {
my $line = ' ' x $WIDTH;
my $l = 0;
my $y1 = 5 * (sqrt(900 - $x * $x) / 5).Int;
for $y1, $y1 - 5 ... -$y1 -> $y {
my $z = (25 + a(sqrt($x * $x + $y * $y)) - .7 * $y).Int;
if $z > $l {
$l = $z;
$line.substr-rw($z, 1) = '*';
}
}
put $line;
}
}
clear_screen;
print_credits;
clear_screen;
draw;
Bagels
# Bagels
# Original version in BASIC:
# D. Resek, P. Rowe, 1978.
# Creative Computing (Morristown, New Jersey, USA), 1978.
# This version in Raku:
# Copyright (c) 2024, Marcos Cruz (programandala.net)
# SPDX-License-Identifier: Fair
#
# Written in 2024-12.
#
# Last modified: 20241211T1933+0100.
sub clear_screen {
print "\e[0;0H\e[2J";
}
sub print_credits {
clear_screen;
put "Bagels";
put "Number guessing game\n";
put "Original source unknown but suspected to be:";
put " Lawrence Hall of Science, U.C. Berkely.\n";
put "Original version in BASIC:";
put " D. Resek, P. Rowe, 1978.";
put " Creative computing (Morristown, New Jersey, USA), 1978.\n";
put "This version in Raku:";
put " Copyright (c) 2024, Marcos Cruz (programandala.net)";
put " SPDX-License-Identifier: Fair\n";
prompt "Press Enter to read the instructions. ";
}
sub print_instructions {
clear_screen;
put "Bagels";
put "Number guessing game\n";
put "I am thinking of a three-digit number that has no two digits the same.";
put "Try to guess it and I will give you clues as follows:\n";
put " PICO - one digit correct but in the wrong position";
put " FERMI - one digit correct and in the right position";
put " BAGELS - no digits correct";
prompt "\nPress Enter to start. ";
}
constant $DIGITS = 3;
# Return three random digits in an integer array.
sub random_number(--> Array) {
my Int @random_digit = ();
while @random_digit.elems < $DIGITS {
loop {
@random_digit.push((0 .. 9).pick);
if @random_digit.unique.elems == @random_digit.elems {
last;
}
@random_digit.pop
}
}
return @random_digit;
}
# Print the given prompt and get a three-digit number from the user.
sub input(Str $prompt --> Array) {
my Int @user_digit = ();
PROMPT: loop {
my $input = prompt($prompt);
if $input.chars != $DIGITS {
put "Remember it's a {$DIGITS}-digit number.";
next PROMPT;
}
for $input.comb -> $digit {
try {
@user_digit.push(+$digit);
CATCH {
default {
put "What?";
next PROMPT;
}
}
}
}
if @user_digit.unique.elems < $DIGITS {
put "Remember my number has no two digits the same.";
next PROMPT;
}
last;
}
return @user_digit;
}
# Return `True` if the given string is "yes" or a synonym.
sub is_yes(Str $answer --> Bool ) {
return $answer.lc (elem) ["ok", "y", "yeah", "yes"]
}
# Return `True` if the given string is "no" or a synonym.
sub is_no(Str $answer --> Bool) {
return $answer.lc (elem) ["n", "no", "nope"];
}
# Print the given prompt, wait until the user enters a valid yes/no
# string, and return `True` for "yes" or `False` for "no".
sub yes(Str $prompt --> Bool) {
loop {
my $answer = prompt($prompt);
if is_yes($answer) { return True };
if is_no($answer) { return False };
}
}
# Init and run the game loop.
sub play {
constant $TRIES = 20;
my Int $score = 0;
my Int $fermi; # counter
my Int $pico; # counter
loop {
clear_screen;
my @computer_number = random_number;
put "O.K. I have a number in mind.";
for 1 .. $TRIES -> $guess {
my @user_number = input(sprintf("Guess #%02d: ", $guess));
$fermi = 0;
$pico = 0;
for 0 ..^ $DIGITS -> $i {
for 0 ..^ $DIGITS -> $j {
if @user_number[$i] == @computer_number[$j] {
if $i == $j {
$fermi += 1;
} else {
$pico += 1;
}
}
}
}
print "PICO " x $pico;
print "FERMI " x $fermi;
if $pico + $fermi == 0 { print "BAGELS" };
put "";
if $fermi == $DIGITS { last };
}
if $fermi == $DIGITS {
put "You got it!!!";
$score += 1;
} else {
put "Oh well.";
put "That's $TRIES guesses. My number was {@computer_number.join}.";
}
if !yes("Play again? ") { last };
}
if $score != 0 {
put "A {$score}-point bagels, buff!!";
}
put "Hope you had fun. Bye.";
}
print_credits;
print_instructions;
play;
Bug
# Bug
# Original version in BASIC:
# Brian Leibowitz, 1978.
# Creative Computing (Morristown, New Jersey, USA), 1978.
# This version in Raku:
# Copyright (c) 2024, Marcos Cruz (programandala.net)
# SPDX-License-Identifier: Fair
#
# Written in 2024-12-11/12.
#
# Last modified: 20241212T1012+0100.
class Bug {
has Bool $.body is rw = False;
has Bool $.neck is rw = False;
has Bool $.head is rw = False;
has Int $.feelers is rw = 0;
has Str $.feeler_type is rw = '';
has Bool $.tail is rw = False;
has Int $.legs is rw = 0;
}
class Player {
has Str $.pronoun is rw = '';
has Str $.possessive is rw = '';
has Bug $.bug is rw = Bug.new();
}
my Player $computer = Player.new;
my Player $human = Player.new;
# Bug body parts.
#
constant $BODY = 0;
constant $NECK = 1;
constant $HEAD = 2;
constant $FEELER = 3;
constant $TAIL = 4;
constant $LEG = 5;
constant @PART_NAME = ('body', 'neck', 'head', 'feeler', 'tail', 'leg');
constant @PART_QUANTITY = (1, 1, 1, 2, 1, 6);
# Bug body attributes.
#
constant $BODY_HEIGHT = 2;
constant $FEELER_LENGTH = 4;
constant $LEG_LENGTH = 2;
constant $MAX_FEELERS = 2;
constant $MAX_LEGS = 6;
constant $NECK_LENGTH = 2;
# Move the cursor to the home position.
#
sub move_cursor_home {
print "\e[H";
}
# Erase the screen.
#
sub erase_screen {
print "\e[2J";
}
# Set the color.
#
sub set_color(Int $color) {
print "\e[{$color}m";
}
# Reset the attributes.
#
sub reset_attributes {
constant $RESET_ALL = 0;
set_color($RESET_ALL);
}
# Erase the screen, reset the attributes and move the cursor to the home position.
sub clear_screen {
erase_screen;
reset_attributes;
move_cursor_home;
}
# Move the cursor up the given number of positions (1 by default).
sub move_cursor_up(Int $n = 1) {
print "\e[{$n}A";
}
# Erase the entire current line and move the cursor to the start of the line.
#
sub erase_line {
print "\e[2K";
}
# Move the cursor to the previous row, without changing the column position,
# and erase its line.
#
sub erase_previous_line {
move_cursor_up;
erase_line;
}
# Clear the screen, display the credits and wait for a keypress.
#
sub print_credits {
clear_screen;
put "Bug\n";
put 'Original version in BASIC:';
put ' Brian Leibowitz, 1978.';
put " Creative computing (Morristown, New Jersey, USA), 1978.\n";
put 'This version in Raku:';
put ' Copyright (c) 2024, Marcos Cruz (programandala.net)';
put " SPDX-License-Identifier: Fair\n";
prompt 'Press Enter to read the instructions. ';
}
constant $INSTRUCTIONS = '
The object is to finish your bug before I finish mine. Each number
stands for a part of the bug body.
I will roll the die for you, tell you what I rolled for you, what the
number stands for, and if you can get the part. If you can get the
part I will give it to you. The same will happen on my turn.
If there is a change in either bug I will give you the option of
seeing the pictures of the bugs. The numbers stand for parts as
follows:
';
# Return the given string padded with the given char at the right, up to the
# given width.
#
sub left_justify(Str $s, Int $width, Str $char --> Str) {
return $s ~ (' ' x ($width - $s.chars));
}
# Print a table with the bug parts' description.
#
sub print_parts_table {
constant $COLUMNS = 3;
constant $COLUMN_WIDTH = 8;
constant $COLUMN_SEPARATION = 2;
# Headers
my $header = ('Number', 'Part', 'Quantity');
for 0 ..^ $COLUMNS -> $i {
print left_justify($header[$i], $COLUMN_WIDTH + $COLUMN_SEPARATION, ' ');
}
put '';
# Rulers
for 0 ..^ $COLUMNS -> $i {
print '-' x $COLUMN_WIDTH;
print $i == $COLUMNS ?? '' !! ' ' x $COLUMN_SEPARATION;
}
put '';
# Data
for $BODY .. $LEG -> $part {
print left_justify(($part + 1).Str, $COLUMN_WIDTH + $COLUMN_SEPARATION, ' ');
print left_justify(@PART_NAME[$part].tc, $COLUMN_WIDTH + $COLUMN_SEPARATION, ' ');
put @PART_QUANTITY[$part];
}
}
# Clear the screen, print the instructions and wait for a keypress.
#
sub print_instructions {
clear_screen;
put 'Bug';
put $INSTRUCTIONS;
print_parts_table;
prompt "\nPress Enter to start. ";
}
# Print a bug head.
#
sub print_head {
put ' HHHHHHH';
put ' H H';
put ' H O O H';
put ' H H';
put ' H V H';
put ' HHHHHHH';
}
# Print the given bug.
#
sub print_bug(Bug $bug) {
if $bug.feelers > 0 {
for 0 ..^ $FEELER_LENGTH {
print ' ';
for 0 ..^ $bug.feelers {
print ' ', $bug.feeler_type;
}
put '';
}
}
if $bug.head {
print_head;
}
if $bug.neck {
for 0 ..^ $NECK_LENGTH {
put ' N N';
}
}
if $bug.body {
put ' BBBBBBBBBBBB';
for 0 ..^ $BODY_HEIGHT -> $i {
put ' B B';
}
if $bug.tail {
put 'TTTTTB B';
}
put ' BBBBBBBBBBBB';
}
if $bug.legs > 0 {
for 0 ..^ $LEG_LENGTH -> $i {
print ' ';
for 0 ..^ $bug.legs -> $j {
print ' L';
}
put '';
}
}
}
# Return `True` if the given bug is finished; otherwise return `False`.
#
sub finished(Bug $bug --> Bool) {
return ($bug.feelers == $MAX_FEELERS and $bug.tail and $bug.legs == $MAX_LEGS);
}
# Array to convert a number to its equilavent text.
#
constant @AS_TEXT = (
'no',
'a',
'two',
'three',
'four',
'five',
'six' ); # $MAX_LEGS
# Return a string containing the given number and noun in their proper form.
#
sub plural(Int $number, Str $noun --> Str) {
return "@AS_TEXT[$number] $noun {($number > 1) ?? 's' !! ''}";
}
# Add the given part to the given player's bug.
#
sub add_part(Int $part, Player $player --> Bool) {
my Bool $changed = False;
given ($part) {
when $BODY {
if $player.bug.body {
put ", but {$player.pronoun} already have a body.";
} else {
put "; {$player.pronoun} now have a body:";
$player.bug.body = True;
$changed = True;
}
}
when $NECK {
if $player.bug.neck {
put ", but {$player.pronoun} already have a neck.";
} elsif not $player.bug.body {
put ", but {$player.pronoun} need a body first.";
} else {
put "; {$player.pronoun} now have a neck:";
$player.bug.neck = True;
$changed = True;
}
}
when $HEAD {
if $player.bug.head {
put ", but {$player.pronoun} already have a head.";
} elsif not $player.bug.neck {
put ", but {$player.pronoun} need a a neck first.";
} else {
put "; {$player.pronoun} now have a head:";
$player.bug.head = True;
$changed = True;
}
}
when $FEELER {
if $player.bug.feelers == $MAX_FEELERS {
put ", but {$player.pronoun} have two feelers already.";
} elsif not $player.bug.head {
put ", but {$player.pronoun} need a head first.";
} else {
$player.bug.feelers += 1;
put "; {$player.pronoun} now have {plural($player.bug.feelers, 'feeler')}:";
$changed = True;
}
}
when $TAIL {
if $player.bug.tail {
put ", but {$player.pronoun} already have a tail.";
} elsif not $player.bug.body {
put ", but {$player.pronoun} need a body first.";
} else {
put "; {$player.pronoun} now have a tail:";
$player.bug.tail = True;
$changed = True;
}
}
when $LEG {
if $player.bug.legs == $MAX_LEGS {
put ", but {$player.pronoun} have {@AS_TEXT[$MAX_LEGS]} feet already.";
} elsif not $player.bug.body {
put ", but, {$player.pronoun} need a body first.";
} else {
$player.bug.legs += 1;
put "; {$player.pronoun} now have {plural($player.bug.legs, 'leg')}:";
$changed = True;
}
}
}
return $changed;
}
# Ask the user to press the Enter key, wait for the input, then erase the
# prompt text.
#
sub prompt_dice {
prompt('Press Enter to roll the dice. ');
erase_previous_line;
}
# Play one turn for the given player, rolling the dice and updating his bug.
#
sub turn(Player $player) {
prompt_dice;
my Int $part = (0 .. 5).pick;
print "{$player.pronoun.tc} rolled a {$part + 1} ({@PART_NAME[$part]})";
if add_part($part, $player) {
put '';
print_bug($player.bug);
}
put '';
}
# Print a message about the winner.
#
sub print_winner {
if finished($human.bug) and finished($computer.bug) {
put 'Both of our bugs are finished in the same number of turns!';
} elsif finished($human.bug) {
put "{$human.possessive} bug is finished.";
} elsif finished($computer.bug) {
put "{$computer.possessive} bug is finished.";
}
}
# Return `True` if either bug is finished, i.e. the game ending condition.
#
sub game_over(--> Bool) {
return finished($human.bug) or finished($computer.bug);
}
# Execute the game loop.
#
sub play {
clear_screen;
while not game_over() {
turn($human);
turn($computer);
};
print_winner;
}
# Init the players' data before a new game.
#
sub init {
$human.pronoun = 'you';
$human.possessive = 'Your';
$human.bug.feeler_type = 'A';
$computer.pronoun = 'I';
$computer.possessive = 'My';
$computer.bug.feeler_type = 'F';
}
init;
print_credits;
print_instructions;
play;
put 'I hope you enjoyed the game, play it again soon!!';
Bunny
# Bunny
#
# Original version in BASIC:
# Creative Computing (Morristown, New Jersey, USA), 1978.
#
# This version in Raku:
# Copyright (c) 2024, Marcos Cruz (programandala.net)
# SPDX-License-Identifier: Fair
#
# Written on 2024-12-03.
#
# Last modified: 20241211T1235+0100.
sub clear_screen {
print "\e[0;0H\e[2J";
}
sub print_credits {
put "Bunny\n";
put 'Original version in BASIC:';
put " Creative Computing (Morristown, New Jersey, USA), 1978.\n";
put 'This version in Raku:';
put ' Copyright (c) 2024, Marcos Cruz (programandala.net)';
put " SPDX-License-Identifier: Fair\n";
prompt 'Press Enter to start the program. ';
}
constant $WIDTH = 53;
my $line = ' ' x $WIDTH;
constant LETTER = 'B', 'U', 'N', 'N', 'Y';
constant LETTERS = LETTER.elems;
constant EOL = -1; # end of line identifier;
constant DATA =
1, 2, EOL, 0, 2, 45, 50, EOL, 0, 5, 43, 52, EOL, 0, 7, 41, 52, EOL,
1, 9, 37, 50, EOL, 2, 11, 36, 50, EOL, 3, 13, 34, 49, EOL, 4, 14,
32, 48, EOL, 5, 15, 31, 47, EOL, 6, 16, 30, 45, EOL, 7, 17, 29, 44,
EOL, 8, 19, 28, 43, EOL, 9, 20, 27, 41, EOL, 10, 21, 26, 40, EOL,
11, 22, 25, 38, EOL, 12, 22, 24, 36, EOL, 13, 34, EOL, 14, 33, EOL,
15, 31, EOL, 17, 29, EOL, 18, 27, EOL, 19, 26, EOL, 16, 28, EOL,
13, 30, EOL, 11, 31, EOL, 10, 32, EOL, 8, 33, EOL, 7, 34, EOL, 6,
13, 16, 34, EOL, 5, 12, 16, 35, EOL, 4, 12, 16, 35, EOL, 3, 12, 15,
35, EOL, 2, 35, EOL, 1, 35, EOL, 2, 34, EOL, 3, 34, EOL, 4, 33,
EOL, 6, 33, EOL, 10, 32, 34, 34, EOL, 14, 17, 19, 25, 28, 31, 35,
35, EOL, 15, 19, 23, 30, 36, 36, EOL, 14, 18, 21, 21, 24, 30, 37, 37,
EOL, 13, 18, 23, 29, 33, 38, EOL, 12, 29, 31, 33, EOL, 11, 13, 17,
17, 19, 19, 22, 22, 24, 31, EOL, 10, 11, 17, 18, 22, 22, 24, 24, 29,
29, EOL, 22, 23, 26, 29, EOL, 27, 29, EOL, 28, 29, EOL;
constant DATA_LEN = DATA.elems;
my $data_pointer = 0;
sub datum(--> Int) {
$data_pointer += 1;
return DATA[$data_pointer - 1];
}
sub draw {
while $data_pointer < DATA_LEN {
my $first_column = datum;
if $first_column == EOL {
put $line;
$line = ' ' x $WIDTH;
} else {
my $last_column = datum;
for $first_column .. $last_column -> $column {
$line.substr-rw($column, 1) = LETTER[$column % LETTERS];
}
}
}
}
clear_screen;
print_credits;
clear_screen;
draw;
Diamond
# Diamond
# Original version in BASIC:
# Example included in Vintage BASIC 1.0.3.
# http://www.vintage-basic.net
# This version in Raku:
# Copyright (c) 2024, Marcos Cruz (programandala.net)
# SPDX-License-Identifier: Fair
# Written on 2024-12-02.
# Last modified: 20241211T1235+0100.
constant $LINES = 17;
for 1..($LINES / 2 + 1) -> $i {
for 1 .. ($LINES + 1) / 2 - $i + 1 -> $j {
print ' ';
}
for 1 .. $i * 2 - 1 -> $j {
print '*';
}
put '';
}
for 1 .. $LINES / 2 -> $i {
for 1 .. $i + 1 -> $j {
print ' ';
}
for 1 .. (($LINES + 1) / 2 - $i) * 2 - 1 -> $j {
print '*';
}
put '';
}
Hammurabi
# Hammurabi
#
# Description:
# A simple text-based simulation game set in the ancient kingdom of Sumeria.
#
# Original program:
# Written in FOCAL on a DEP PDP-8 by Rick Merrill, 1969.
#
# BASIC port:
# Ported from FOCAL and modified for Edusystem 70 by David Ahl, c. 1973.
# Modified for 8K Microsoft BASIC by Peter Turnbull, c. 1978.
#
# More details:
# - https://en.wikipedia.org/wiki/Hamurabi_(video_game)
# - https://www.mobygames.com/game/22232/hamurabi/
#
# This improved remake in Raku:
# Copyright (c) 2025, Marcos Cruz (programandala.net)
# SPDX-License-Identifier: Fair
#
# Written on 2025-03-23, 2025-04-17, 2025-07-31.
#
# Last modified: 20250731T1922+0200.
#
# Acknowledgment:
# The following Python port was used as a reference of the original
# variables: <https://github.com/jquast/hamurabi.py>.
#
# ==============================================================================
constant $BLACK = 0;
constant $RED = 1;
constant $GREEN = 2;
constant $YELLOW = 3;
constant $BLUE = 4;
constant $MAGENTA = 5;
constant $CYAN = 6;
constant $WHITE = 7;
constant $DEFAULT = 9;
constant $STYLE_OFF = +20;
constant $FOREGROUND = +30;
constant $BACKGROUND = +40;
constant $BRIGHT = +60;
constant $NORMAL = 0;
constant $RESET_ALL = $NORMAL;
constant $BOLD = 1;
constant $DIM = 2;
constant $ITALIC = 3;
constant $UNDERLINE = 4;
constant $UNDERSCORE = $UNDERLINE;
constant $BLINK = 5;
constant $OVERLINE = 6;
constant $RAPID_BLINK = $OVERLINE;
constant $INVERT = 7;
constant $REVERSE = $INVERT;
constant $HIDDEN = 8;
constant $CROSSED_OUT = 9;
constant $STRIKE = $CROSSED_OUT;
constant $NO_STYLE = $STYLE_OFF;
sub move_cursor_home {
print "\e[H";
}
sub erase_screen {
print "\e[2J";
}
sub set_style(Int $style) {
print "\e[{$style}m";
}
sub reset_attributes {
set_style $RESET_ALL;
}
sub clear_screen {
erase_screen;
#reset_attributes;
move_cursor_home;
}
sub hide_cursor {
print "\e[?25l";
}
sub show_cursor {
print "\e[?25h";
}
constant $ACRES_A_BUSHEL_CAN_SEED = 2; # yearly
constant $ACRES_A_PERSON_CAN_SEED = 10; # yearly
constant $ACRES_PER_PERSON = 10; # to calculate the initial acres of the city
constant $BUSHELS_TO_FEED_A_PERSON = 20; # yearly
constant $IRRITATION_LEVELS = 5; # after the switch in `show_irritation`
constant $MAX_IRRITATION = 16;
constant $IRRITATION_STEP = $MAX_IRRITATION / $IRRITATION_LEVELS;
constant $MIN_HARVESTED_BUSHELS_PER_ACRE = 17;
constant $RANGE_OF_HARVESTED_BUSHELS_PER_ACRE = 10;
constant $MAX_HARVESTED_BUSHELS_PER_ACRE = $MIN_HARVESTED_BUSHELS_PER_ACRE + $RANGE_OF_HARVESTED_BUSHELS_PER_ACRE - 1;
constant $PLAGUE_CHANCE = 0.15; # 15% yearly
constant $YEARS = 10; # goverment period
constant $DEFAULT_INK = $WHITE + $FOREGROUND;
constant $INPUT_INK = $BRIGHT + $GREEN + $FOREGROUND;
constant $INSTRUCTIONS_INK = $YELLOW + $FOREGROUND;
constant $RESULT_INK = $BRIGHT + $CYAN + $FOREGROUND;
constant $SPEECH_INK = $BRIGHT + $MAGENTA + $FOREGROUND;
constant $TITLE_INK = $BRIGHT + $WHITE + $FOREGROUND;
constant $WARNING_INK = $BRIGHT + $RED + $FOREGROUND;
enum Result <Very_Good, Not_Too_Bad, Bad, Very_Bad>;
my Int $acres;
my Int $bushels_eaten_by_rats;
my Int $bushels_harvested;
my Int $bushels_harvested_per_acre;
my Int $bushels_in_store;
my Int $bushels_to_feed_with;
my Int $dead;
my Int $infants;
my Int $irritation; # counter (0 .. 99)
my Int $population;
my Int $starved_people_percentage;
my Int $total_dead;
constant $INSTRUCTIONS =
"Hammurabi is a simulation game in which you, as the ruler of the ancient;
kingdom of Sumeria, Hammurabi, manage the resources.
You may buy and sell land with your neighboring city-states for bushels of;
grain ― the price will vary between %d and %d bushels per acre. You also must;
use grain to feed your people and as seed to plant the next year's crop.
You will quickly find that a certain number of people can only tend a certain;
amount of land and that people starve if they are not fed enough. You also;
have the unexpected to contend with such as a plague, rats destroying stored;
grain, and variable harvests.
You will also find that managing just the few resources in this game is not a;
trivial job. The crisis of population density rears its head very rapidly.
Try your hand at governing ancient Sumeria for a %d-year term of office.";
sub instructions(--> Str) {
return sprintf($INSTRUCTIONS,
$MIN_HARVESTED_BUSHELS_PER_ACRE, $MAX_HARVESTED_BUSHELS_PER_ACRE, $YEARS);
}
sub print_instructions {
set_style($INSTRUCTIONS_INK);
put instructions;
set_style($DEFAULT_INK);
}
sub pause(Str $prompt = '> ') {
set_style($INPUT_INK);
my $s = prompt $prompt;
set_style($DEFAULT_INK);
}
# Print the given prompt and wait until the user enters an integer.
sub input(Str $prompt --> Int) {
my Int $n;
set_style($INPUT_INK);
loop {
try {
$n = +prompt $prompt;
CATCH {
default {
put 'Integer expected.';
next;
}
}
}
last;
}
set_style($DEFAULT_INK);
return floor $n;
}
constant $CREDITS =
"Hammurabi
Original program:
Written in FOCAL on a DEP PDP-8 by Rick Merrill, 1969.
BASIC port:
Ported from FOCAL and modified for Edusystem 70 by David Ahl, c. 1973.
Modified for 8K Microsoft BASIC by Peter Turnbull, c. 1978.
This improved remake in Raku:
Copyright (c) 2025, Marcos Cruz (programandala.net)
SPDX-License-Identifier: Fair";
sub print_credits {
set_style($TITLE_INK);
put $CREDITS;
set_style($DEFAULT_INK);
}
sub ordinal_suffix(Int $n --> Str) {
given $n {
when 1 { return 'st'; }
when 2 { return 'nd'; }
when 3 { return 'rd'; }
default { return 'th'; }
}
}
# Return the description of the given year as the previous one.
#
sub previous(Int $year --> Str) {
if $year == 0 {
return 'the previous year';
} else {
return sprintf("your %d%s year", $year, ordinal_suffix($year));
}
}
# Return the proper wording for `n` persons, using the given or default words
# for singular and plural forms.
#
sub persons(Int $n, Str $singular = 'person', Str $plural = 'people' --> Str) {
given $n {
when 0 { return 'nobody'; }
when 1 { return 'one ' ~ $singular; }
default { return "$n " ~ $plural; }
}
}
sub print_annual_report(Int $year) {
clear_screen;
set_style($SPEECH_INK);
put 'Hammurabi, I beg to report to you.';
set_style($DEFAULT_INK);
put sprintf(
"\nIn %s, %s starved and %s %s born.",
previous($year),
persons($dead),
persons($infants, 'infant', 'infants'),
$infants > 1 ?? 'were' !! 'was'
);
$population += $infants;
if $year > 0 and rand <= $PLAGUE_CHANCE {
$population = ($population / 2).Int;
set_style($WARNING_INK);
put 'A horrible plague struck! Half the people died.';
set_style($DEFAULT_INK);
}
put "The population is $population.";
put "The city owns $acres acres.";
put "You harvested $bushels_harvested bushels ($bushels_harvested_per_acre per acre).";
if $bushels_eaten_by_rats > 0 {
put "The rats ate $bushels_eaten_by_rats bushels.";
}
put "You have $bushels_in_store bushels in store.";
$bushels_harvested_per_acre =
($RANGE_OF_HARVESTED_BUSHELS_PER_ACRE * rand).Int +
$MIN_HARVESTED_BUSHELS_PER_ACRE;
put "Land is trading at $bushels_harvested_per_acre bushels per acre.\n";
}
sub say_bye {
set_style($DEFAULT_INK);
put "\nSo long for now.\n";
}
sub quit_game {
say_bye;
exit(0);
}
sub relinquish {
set_style($SPEECH_INK);
put "\nHammurabi, I am deeply irritated and cannot serve you anymore.";
put 'Please, get yourself another steward!';
set_style($DEFAULT_INK);
quit_game;
}
sub increase_irritation {
$irritation += 1 + (0 .. $IRRITATION_STEP).pick;
if $irritation >= $MAX_IRRITATION { relinquish; } # this never returns
}
sub print_irritated(Str $adverb) {
printf("The steward seems %s irritated.\n", $adverb);
}
sub show_irritation {
given True {
when $irritation < $IRRITATION_STEP { }
when $irritation < $IRRITATION_STEP * 2 { print_irritated('slightly'); }
when $irritation < $IRRITATION_STEP * 3 { print_irritated('quite'); }
when $irritation < $IRRITATION_STEP * 4 { print_irritated('very'); }
default { print_irritated('profoundly'); }
}
}
# Print a message begging to repeat an ununderstandable input.
#
sub beg_repeat {
increase_irritation; # this may never return
set_style($SPEECH_INK);
put 'I beg your pardon? I did not understand your order.';
set_style($DEFAULT_INK);
show_irritation;
}
# Print a message begging to repeat a wrong input, because there's only `n`
# items of `name`.
#
sub beg_think_again(Int $n, Str $name) {
increase_irritation; # this may never return
set_style($SPEECH_INK);
printf("I beg your pardon? You have only %d %s. Now then…\n", $n, $name);
set_style($DEFAULT_INK);
show_irritation;
}
# Buy or sell land.
#
sub trade {
my Int $acres_to_buy;
my Int $acres_to_sell;
my Bool $ok;
loop {
$acres_to_buy = input('How many acres do you wish to buy? (0 to sell): ');
if $acres_to_buy < 0 {
beg_repeat; # this may never return
next;
}
if $bushels_harvested_per_acre * $acres_to_buy <= $bushels_in_store { last; }
beg_think_again($bushels_in_store, 'bushels of grain');
}
if $acres_to_buy != 0 {
printf("You buy %d acres.\n", $acres_to_buy);
$acres += $acres_to_buy;
$bushels_in_store -= $bushels_harvested_per_acre * $acres_to_buy;
printf("You now have %d acres and %d bushels.\n", $acres, $bushels_in_store);
} else {
loop {
$acres_to_sell = input('How many acres do you wish to sell?: ');
if $acres_to_sell < 0 {
beg_repeat; # this may never return
next;
}
if $acres_to_sell < $acres { last; }
beg_think_again($acres, 'acres');
}
if $acres_to_sell > 0 {
put sprintf("You sell %d acres.", $acres_to_sell);
$acres -= $acres_to_sell;
$bushels_in_store += $bushels_harvested_per_acre * $acres_to_sell;
printf("You now have %d acres and %d bushels.\n", $acres, $bushels_in_store);
}
}
}
# Feed the people.
#
sub feed {
my Bool $ok;
loop {
$bushels_to_feed_with = input('How many bushels do you wish to feed your people with?: ');
if $bushels_to_feed_with < 0 {
beg_repeat; # this may never return
next;
}
# Trying to use more grain than is in silos?
if $bushels_to_feed_with <= $bushels_in_store { last; }
beg_think_again($bushels_in_store, 'bushels of grain');
}
printf("You feed your people with %d bushels.\n", $bushels_to_feed_with);
$bushels_in_store -= $bushels_to_feed_with;
printf("You now have %d bushels.\n", $bushels_in_store);
}
# Seed the land.
#
sub seed {
my Int $acres_to_seed;
my Bool $ok;
loop {
$acres_to_seed = input('How many acres do you wish to seed?: ');
if $acres_to_seed < 0 {
beg_repeat; # this may never return
next;
}
if $acres_to_seed == 0 { last; }
# Trying to seed more acres than you own?
if $acres_to_seed > $acres {
beg_think_again($acres, 'acres');
next;
}
# Enough grain for seed?
if ($acres_to_seed / $ACRES_A_BUSHEL_CAN_SEED).Int > $bushels_in_store {
beg_think_again(
$bushels_in_store,
sprintf(
"bushels of grain,\nand one bushel can seed %d acres",
$ACRES_A_BUSHEL_CAN_SEED
);
);
next;
}
# Enough people to tend the crops?
if $acres_to_seed <= $ACRES_A_PERSON_CAN_SEED * $population { last; }
beg_think_again(
$population,
sprintf(
"people to tend the fields,\nand one person can seed %d acres",
$ACRES_A_PERSON_CAN_SEED
);
);
}
my $bushels_used_for_seeding = ($acres_to_seed / $ACRES_A_BUSHEL_CAN_SEED).Int;
printf("You seed %d acres using %d bushels.\n", $acres_to_seed, $bushels_used_for_seeding);
$bushels_in_store -= $bushels_used_for_seeding;
printf("You now have %d bushels.\n", $bushels_in_store);
# A bountiful harvest!
$bushels_harvested_per_acre = (1 .. 5).pick;
$bushels_harvested = $acres_to_seed * $bushels_harvested_per_acre;
$bushels_in_store += $bushels_harvested;
}
sub is_even(Int $n --> Bool) {
return $n %% 2 == 0;
}
sub check_rats {
my $rat_chance = (1 .. 5).pick;
$bushels_eaten_by_rats = is_even($rat_chance) ?? ($bushels_in_store / $rat_chance).Int !! 0;
$bushels_in_store -= $bushels_eaten_by_rats;
}
# Set the variables to their values in the first year.
#
sub init {
$dead = 0;
$total_dead = 0;
$starved_people_percentage = 0;
$population = 95;
$infants = 5;
$acres = $ACRES_PER_PERSON * ($population + $infants);
$bushels_harvested_per_acre = 3;
$bushels_harvested = $acres * $bushels_harvested_per_acre;
$bushels_eaten_by_rats = 200;
$bushels_in_store = $bushels_harvested - $bushels_eaten_by_rats;
$irritation = 0;
}
sub print_result(Result $result) {
set_style($RESULT_INK);
given $result {
when <Very_Good> {
put 'A fantastic performance! Charlemagne, Disraeli and Jefferson combined could';
put 'not have done better!';
}
when <Not_Too_Bad> {
put "Your performance could have been somewat better, but really wasn't too bad at";
printf(
"all. %d people would dearly like to see you assassinated, but we all have our\n",
Int($population * .8 * rand)
);
put 'trivial problems.';
}
when <Bad> {
put 'Your heavy-handed performance smacks of Nero and Ivan IV. The people';
put '(remaining) find you an unpleasant ruler and, frankly, hate your guts!';
}
when <Very_Bad> {
put 'Due to this extreme mismanagement you have not only been impeached and thrown';
put 'out of office but you have also been declared national fink!!!';
}
}
set_style($DEFAULT_INK);
}
sub print_final_report {
clear_screen;
if $starved_people_percentage > 0 {
printf(
"In your %d-year term of office, %d percent of the\n",
$YEARS,
$starved_people_percentage
);
printf(
"population starved per year on the average, i.e., a total of %d people died!\n\n",
$total_dead
);
}
my $acres_per_person = $acres / $population;
printf(
"You started with %d acres per person and ended with %d.\n\n",
$ACRES_PER_PERSON,
$acres_per_person
);
given True {
when $starved_people_percentage > 33, $acres_per_person < 7 { print_result(Result::<Very_Bad>); }
when $starved_people_percentage > 10, $acres_per_person < 9 { print_result(Result::<Bad>); }
when $starved_people_percentage > 3, $acres_per_person < 10 { print_result(Result::<Not_Too_Bad>); }
default { print_result(Result::<Very_Good>); }
}
}
sub check_starvation(Int $year) {
# How many people has been fed?
my $fed_people = ($bushels_to_feed_with / $BUSHELS_TO_FEED_A_PERSON).Int;
if $population > $fed_people {
$dead = $population - $fed_people;
$starved_people_percentage = floor((($year - 1) * $starved_people_percentage + $dead * 100 / $population) / $year);
$population -= $dead;
$total_dead += $dead;
# Starve enough for impeachment?
if $dead > (.45 * $population).Int {
set_style($WARNING_INK);
put "\nYou starved $dead people in one year!!!\n";
set_style($DEFAULT_INK);
print_result(Result::<Very_Bad>);
quit_game;
}
}
}
sub govern {
init;
print_annual_report(0);
for 1 .. $YEARS -> $year {
trade;
feed;
seed;
check_rats;
# Let's have some babies
$infants = ((1 .. 5).pick * (20 * $acres + $bushels_in_store) / $population / 100 + 1).Int;
check_starvation($year);
pause("\nPress the Enter key to read the annual report. ");
print_annual_report($year);
}
}
clear_screen;
print_credits;
pause("\nPress the Enter key to read the instructions. ");
clear_screen;
print_instructions;
pause("\nPress the Enter key to start. ");
govern;
pause('Press the Enter key to read the final report. ');
print_final_report;
say_bye;
High Noon
# High Noon
#
# Original version in BASIC:
# Designed and programmed by Chris Gaylo, Syosset High School, New York, 1970-09-12.
# http://mybitbox.com/highnoon-1970/
# http://mybitbox.com/highnoon/
#
# Transcriptions:
# https://github.com/MrMethor/Highnoon-BASIC/
# https://github.com/mad4j/basic-highnoon/
#
# Version modified for QB64:
# By Daniele Olmisani, 2014.
# https://github.com/mad4j/basic-highnoon/
#
# This improved remake in Raku:
# Copyright (c) 2025, Marcos Cruz (programandala.net)
# SPDX-License-Identifier: Fair
#
# Written in 2025-01-23/24.
#
# Last modified: 20250731T1726+0200.
# Terminal {{{1
# ==============================================================
constant $BLACK = 0;
constant $RED = 1;
constant $GREEN = 2;
constant $YELLOW = 3;
constant $BLUE = 4;
constant $MAGENTA = 5;
constant $CYAN = 6;
constant $WHITE = 7;
constant $DEFAULT = 9;
constant $STYLE_OFF = +20;
constant $FOREGROUND = +30;
constant $BACKGROUND = +40;
constant $BRIGHT = +60;
constant $NORMAL = 0;
constant $RESET_ALL = $NORMAL;
constant $BOLD = 1;
constant $DIM = 2;
constant $ITALIC = 3;
constant $UNDERLINE = 4;
constant $UNDERSCORE = $UNDERLINE;
constant $BLINK = 5;
constant $OVERLINE = 6;
constant $RAPID_BLINK = $OVERLINE;
constant $INVERT = 7;
constant $REVERSE = $INVERT;
constant $HIDDEN = 8;
constant $CROSSED_OUT = 9;
constant $STRIKE = $CROSSED_OUT;
constant $NO_STYLE = $STYLE_OFF;
# Move the cursor to the home position.
sub move_cursor_home {
print "\e[H";
}
# Erase the screen.
sub erase_screen {
print "\e[2J";
}
# Reset the attributes.
sub reset_attributes {
set_color $RESET_ALL;
}
# Erase the screen, reset the attributes and move the cursor to the home position.
sub clear_screen {
erase_screen;
reset_attributes;
move_cursor_home;
}
# Set the color.
sub set_color(Int $color) {
print "\e[{$color}m";
}
# Set the attribute.
sub set_attribute(Int $attr) {
print "\e[0;{$attr}m";
}
# Make the cursor invisible.
sub hide_cursor {
print "\e[?25l";
}
# Make the cursor visible.
sub show_cursor {
print "\e[?25h";
}
# Global variables and constants {{{1
# =============================================================
constant DEFAULT_INK = $FOREGROUND + $WHITE;
constant INPUT_INK = $FOREGROUND + $BRIGHT + $GREEN;
constant INSTRUCTIONS_INK = $FOREGROUND + $YELLOW;
constant TITLE_INK = $FOREGROUND + $BRIGHT + $RED;
constant INITIAL_DISTANCE = 100;
constant INITIAL_BULLETS = 4;
constant MAX_WATERING_TROUGHS = 3;
my $distance = 0; # distance between both gunners, in paces
my $strategy = ''; # player's strategy
my $player_bullets = 0;
my $opponent_bullets = 0;
# User input {{{1
# =============================================================
# Print the given prompt and wait until the user enters an integer.
#
sub input_int(Str $prompt = '' --> Int) {
my Int $n;
set_color INPUT_INK;
loop {
try {
$n = +prompt $prompt;
CATCH {
default {
put 'Integer expected.';
next;
}
}
}
last;
}
set_color DEFAULT_INK;
return floor $n;
}
# Print the given prompt and wait until the user enters a string.
#
sub input_string(Str $prompt = '' --> Str) {
set_color INPUT_INK;
my $result = prompt $prompt;
set_color DEFAULT_INK;
return $result;
}
# Print the given prompt and wait until the user presses Enter.
#
sub press_enter(Str $prompt) {
input_string($prompt);
}
# Return `True` if the given string is 'yes' or a synonym.
#
sub is_yes(Str $s --> Bool) {
return $s.lc (elem) ["ok", "y", "yeah", "yes"]
}
# Return `True` if the given string is 'no' or a synonym.
#
sub is_no(Str $s --> Bool) {
return $s.lc (elem) ["n", "no", "nope"];
}
# Print the given prompt, wait until the user enters a valid yes/no string,
# and return `True` for 'yes' or `False` for 'no'.
#
sub yes(Str $prompt --> Bool) {
loop {
my $answer = input_string prompt;
if is_yes $answer { return True; }
if is_no $answer { return False; }
}
}
# Title, instructions and credits {{{1
# =============================================================
# Print the title at the current cursor position.
#
sub print_title {
set_color TITLE_INK;
put 'High Noon';
set_color DEFAULT_INK;
}
sub print_credits {
print_title;
put "\nOriginal version in BASIC:";
put ' Designed and programmend by Chris Gaylo, 1970.';
put ' http://mybitbox.com/highnoon-1970/';
put ' http://mybitbox.com/highnoon/';
put 'Transcriptions:';
put ' https://github.com/MrMethor/Highnoon-BASIC/';
put ' https://github.com/mad4j/basic-highnoon/';
put 'Version modified for QB64:';
put ' By Daniele Olmisani, 2014.';
put ' https://github.com/mad4j/basic-highnoon/';
put 'This improved remake in Raku:';
put ' Copyright (c) 2025, Marcos Cruz (programandala.net)';
put ' SPDX-License-Identifier: Fair';
}
sub print_instructions {
print_title;
set_color INSTRUCTIONS_INK;
put "\nYou have been challenged to a showdown by Black Bart, one of";
put 'the meanest desperadoes west of the Allegheny mountains.';
put "\nWhile you are walking down a dusty, deserted side street,";
put 'Black Bart emerges from a saloon one hundred paces away.';
printf "\nBy agreement, you each have %i bullets in your six-guns.", INITIAL_BULLETS;
put "\nYour marksmanship equals his. At the start of the walk nei-";
put 'ther of you can possibly hit the other, and at the end of';
put 'the walk, neither can miss. the closer you get, the better';
put 'your chances of hitting black Bart, but he also has beter';
put 'chances of hitting you.';
set_color DEFAULT_INK;
}
# Game loop {{{1
# =============================================================
sub plural_suffix(Int $n --> Str) {
given $n {
when 1 { return ''; }
default { return 's'; }
}
}
sub print_shells_left {
if $player_bullets == $opponent_bullets {
printf("Both of you have %i bullets.\n", $player_bullets);
} else {
printf(
"You now have %i bullet%s to Black Bart's %i bullet%s.\n",
$player_bullets,
plural_suffix($player_bullets),
$opponent_bullets,
plural_suffix($opponent_bullets));
}
}
sub print_check {
put '******************************************************';
put '* *';
put '* BANK OF DODGE CITY *';
put "* CASHIER'S RECEIT *";
put '* *';
printf("* CHECK NO. %04i AUGUST %iTH, 1889 *\n",
(0 .. 1000).pick,
10 + (0 .. 10).pick);
put '* *';
put '* *';
put '* PAY TO THE BEARER ON DEMAND THE SUM OF *';
put '* *';
put '* TWENTY THOUSAND DOLLARS-------------------$20,000 *';
put '* *';
put '******************************************************';
}
sub get_reward {
put 'As mayor of Dodge City, and on behalf of its citizens,';
put 'I extend to you our thanks, and present you with this';
put "reward, a check for $20,000, for killing Black Bart.\n\n";
print_check;
put "\n\nDon't spend it all in one place.";
}
sub move_the_opponent {
my $paces = 2 + (0 .. 8).pick;
printf("Black Bart moves %s paces.\n", $paces);
$distance -= $paces;
}
# Maybe move the opponent; if so, return `True`, otherwise return `False`. A
# true `silent` flag allows to omit the message when the opponent doesn't
# move.
#
sub maybe_move_the_opponent(Int $silent = False --> Bool) {
if (0 .. 2).pick == 0 {; # 50% chances
move_the_opponent;
return True;
} else {
if not $silent {
put 'Black Bart stands still.';
}
return False;
}
}
sub missed_shot(--> Bool) {
return 1.rand * 10 <= $distance / 10;
}
# Handle the opponent's shot and return a flag with the result: if the
# opponent kills the player, return `True`; otherwise return `False`.
#
sub the_opponent_fires_and_kills(--> Bool) {
put 'Black Bart fires…';
$opponent_bullets -= 1;
if missed_shot() {
put 'A miss…';
given $opponent_bullets {
}
when 3 {
put 'Whew, were you lucky. That bullet just missed your head.';
}
when 2 {
put 'But Black Bart got you in the right shin.';
}
when 1 {
put 'Though Black Bart got you on the left side of your jaw.';
}
when 0 {
put 'Black Bart must have jerked the trigger.';
}
} else {
if $strategy == 'j' {
put "That trick just saved yout life. Black Bart's bullet";
put 'was stopped by the wood sides of the trough.';
} else {
put 'Black Bart shot you right through the heart that time.';
put "You went kickin' with your boots on.";
return True;
}
}
return False;
}
# Handle the opponent's strategy and return a flag with the result: if the
# opponent runs or kills the player, return `True`; otherwise return `False`.
#
sub the_opponent_kills_or_runs(--> Bool) {
if $distance >= 10 or $player_bullets == 0 {
if maybe_move_the_opponent(True) { return False; }
}
if $opponent_bullets > 0 {
return the_opponent_fires_and_kills;
} else {
if $player_bullets > 0 {
if (0 .. 2).pick == 0 {; # 50% chances
put 'Now is your chance, Black Bart is out of bullets.';
} else {
put 'Black Bart just hi-tailed it out of town rather than face you';
put 'without a loaded gun. You can rest assured that Black Bart';
put "won't ever show his face around this town again.";
return True;
}
}
}
return False;
}
sub play {
$distance = INITIAL_DISTANCE;
my $watering_troughs = 0;
$player_bullets = INITIAL_BULLETS;
$opponent_bullets = INITIAL_BULLETS;
SHOWDOWN:
loop {
printf("You are now %i paces apart from Black Bart.\n", $distance);
print_shells_left;
set_color INSTRUCTIONS_INK;
put "\nStrategies:";
put ' [A]dvance';
put ' [S]tand still';
put ' [F]ire';
put ' [J]ump behind the watering trough';
put ' [G]ive up';
put ' [T]urn tail and run';
set_color DEFAULT_INK;
$strategy = input_string('What is your strategy? ').lc;
given $strategy {
when 'a' { # advance
loop {
my $paces = input_int('How many paces do you advance? ');
if $paces < 0 {
put 'None of this negative stuff, partner, only positive numbers.';
} elsif $paces > 10 {
put 'Nobody can walk that fast.';
} else {
$distance -= $paces;
last;
}
}
}
when 's' { # stand still
put 'That move made you a perfect stationary target.';
}
when 'f' { # fire
if $player_bullets == 0 {
put "You don't have any bullets left.";
} else {
$player_bullets -= 1;
if missed_shot() {
given $player_bullets {
}
when 2 {
put 'Grazed Black Bart in the right arm.';
}
when 1 {
put "He's hit in the left shoulder, forcing him to use his right";
put 'hand to shoot with.';
}
put 'What a lousy shot.';
if $player_bullets == 0 {
put "Nice going, ace, you've run out of bullets.";
if $opponent_bullets != 0 {
put "Now Black Bart won't shoot until you touch noses.";
put 'You better think of something fast (like run).';
}
}
} else {
put 'What a shot, you got Black Bart right between the eyes.';
press_enter("\nPress the Enter key to get your reward. ");
clear_screen;
get_reward;
last SHOWDOWN;
}
}
}
when 'j' { # jump
if $watering_troughs == MAX_WATERING_TROUGHS {
put 'How many watering troughs do you think are on this street?';
$strategy = '';
} else {
$watering_troughs += 1;
put 'You jump behind the watering trough.';
put "Not a bad maneuver to threw Black Bart's strategy off.";
}
}
when 'g' { # give up
put "Black Bart accepts. The conditions are that he won't shoot you";
put 'if you take the first stage out of town and never come back.';
if yes('Agreed? ') {
put 'A very wise decision.';
last SHOWDOWN;
} else {
put 'Oh well, back to the showdown.';
}
}
when 't' { # turn tail and run
# The more bullets of the opponent, the less chances to escape.
if (0 .. $opponent_bullets + 2).pick == 0 {
put "Man, you ran so fast even dogs couldn't catch you.";
} else {
given $opponent_bullets {
when 0 {
put 'You were lucky, Black Bart can only throw his gun at you, he';
put "doesn't have any bullets left. You should really be dead.";
}
when 1 {
put 'Black Bart fires his last bullet…';
put "He got you right in the back. That's what you deserve, for running.";
}
when 2 {
put 'Black Bart fires and got you twice: in your back';
put "and your ass. Now you can't even rest in peace.";
}
when 3 {
put 'Black Bart unloads his gun, once in your back';
put "and twice in your ass. Now you can't even rest in peace.";
}
when 4 {
put 'Black Bart unloads his gun, once in your back';
put "and three times in your ass. Now you can't even rest in peace.";
}
}
$opponent_bullets = 0;
}
last SHOWDOWN;
}
default {
put "You sure aren't going to live very long if you can't even follow directions.";
}
} # strategy given
if the_opponent_kills_or_runs() { last; }
if $player_bullets + $opponent_bullets == 0 {
put 'The showdown must end, because nobody has bullets left.';
last;
}
put '';
} # showdown loop
}
# Main {{{1
# =============================================================
clear_screen;
print_credits;
press_enter "\nPress the Enter key to read the instructions. ";
clear_screen;
print_instructions;
press_enter "\nPress the Enter key to start. ";
clear_screen;
play;
Math
# Math
#
# Original version in BASIC:
# Example included in Vintage BASIC 1.0.3.
# http://www.vintage-basic.net
#
# This version in Raku:
# Copyright (c) 2024, Marcos Cruz (programandala.net)
# SPDX-License-Identifier: Fair
#
# Written in 2024-12-03.
#
# Last modified: 20241203T1812+0100.
my $n;
loop {
try {
$n = +prompt 'Enter a number: ';
CATCH {
default {
put 'Number expected.';
next;
}
}
}
last;
}
put "ABS($n) -> abs($n) -> ", abs($n);
put "ATN($n) -> atan($n) -> ", atan($n);
put "COS($n) -> cos($n) -> ", cos($n);
put "EXP($n) -> exp($n) -> ", exp($n);
put "INT($n) -> floor($n) -> ", floor($n);
put "LOG($n) -> log($n) -> ", log($n);
put "SGN($n) -> sign($n) -> ", sign($n);
put "SQR($n) -> sqrt($n) -> ", sqrt($n);
put "TAN($n) -> tan($n) -> ", tan($n);
Mugwump
# Mugwump
#
# Original version in BASIC:
# Written by Bud Valenti's students of Project SOLO (Pittsburg, Pennsylvania, USA).
# Slightly modified by Bob Albrecht of People's Computer Company.
# Published by Creative Computing (Morristown, New Jersey, USA), 1978.
# - https://www.atariarchives.org/basicgames/showpage.php?page=114
# - http://vintage-basic.net/games.html
#
# This version in Raku:
# Copyright (c) 2024, Marcos Cruz (programandala.net)
# SPDX-License-Identifier: Fair
#
# Written on 2024-12-07/11.
#
# Last modified: 20241211T1237+0100.
sub clear_screen {
print "\e[0;0H\e[2J";
}
constant $GRID_SIZE = 10;
constant $TURNS = 10;
constant $MUGWUMPS = 4;
class Mugwump {
has Int $.x is rw = 0;
has Int $.y is rw = 0;
has Bool $.hidden is rw = False;
}
my @mugwump of Mugwump;
for 0 ..^ $MUGWUMPS {
push @mugwump, Mugwump.new;
}
my Int $found; # counter
# Print the given prompt, wait until the user enters a valid integer and
# return it.
#
sub prompt_number(Str $prompt --> Int) {
my Int $n;
my Str $s = '';
constant $ERROR = 'Valid integer expected.';
loop {
loop {
$s = prompt($prompt);
if not $s eq '' {
last;
}
put $ERROR;
}
try {
$n = (+$s).Int;
CATCH {
default {
put $ERROR;
next;
}
}
}
last;
}
return $n;
}
# Return `True` if the given string is "yes" or a synonym.
#
sub is_yes(Str $answer --> Bool) {
return $answer.lc (elem) ["ok", "y", "yeah", "yes"]
}
# Return `True` if the given string is "no" or a synonym.
#
sub is_no(Str $answer --> Bool) {
return $answer.lc (elem) ["n", "no", "nope"];
}
# Print the given prompt, wait until the user enters a valid yes/no string,
# and return `True` for "yes" or `False` for "no".
#
sub yes(Str $prompt --> Bool) {
loop {
my $answer = prompt($prompt);
if is_yes($answer) { return True };
if is_no($answer) { return False };
}
}
# Clear the screen, print the credits and ask the user to press enter.
#
sub print_credits {
clear_screen;
put "Mugwump\n";
put 'Original version in BASIC:';
put " Written by Bud Valenti's students of Project SOLO (Pittsburg, Pennsylvania, USA).";
put " Slightly modified by Bob Albrecht of People's Computer Company.";
put ' Published by Creative Computing (Morristown, New Jersey, USA), 1978.';
put ' - https://www.atariarchives.org/basicgames/showpage.php?page=114';
put " - http://vintage-basic.net/games.html\n";
put 'This version in Raku:';
put ' Copyright (c) 2024, Marcos Cruz (programandala.net)';
put " SPDX-License-Identifier: Fair\n";
prompt 'Press Enter to read the instructions. ';
}
# Clear the screen, print the instructions and ask the user to press enter.
#
sub print_instructions {
clear_screen;
put "Mugwump\n";
put 'The object of this game is to find four mugwumps';
put 'hidden on a 10 by 10 grid. Homebase is position 0,0.';
put 'Any guess you make must be two numbers with each';
put 'number between 0 and 9, inclusive. First number';
put 'is distance to right of homebase and second number';
put "is distance above homebase.\n";
put "You get $TURNS tries. After each try, you will see";
put "how far you are from each mugwump.\n";
prompt 'Press Enter to start. ';
}
# Init the mugwumps' positions, `hidden` flags and count.
#
sub hide_mugwumps {
#say @mugwump[0]; # XXX TMP --> Mugwump.new
for 0 ..^ $MUGWUMPS -> $m {
@mugwump[$m].x = (0 ..^ $GRID_SIZE).pick;
@mugwump[$m].y = (0 ..^ $GRID_SIZE).pick;
@mugwump[$m].hidden = True;
}
$found = 0 ; # counter
}
# Print the given prompt, wait until the user enters a valid coord and return
# it.
#
sub get_coord(Str $prompt --> Int) {
my Int $coord;
loop {
$coord = prompt_number($prompt);
if $coord < 0 or $coord >= $GRID_SIZE {
put "Invalid value $coord: not in range [0, {$GRID_SIZE - 1}].";
} else {
last;
}
}
return $coord;
}
# Return `True` if the given mugwump is hidden in the given coords.
#
sub is_here(Int $m, Int $x, Int $y --> Bool) {
return (@mugwump[$m].hidden and @mugwump[$m].x == $x and @mugwump[$m].y == $y);
}
# Return the distance between the given mugwump and the given coords.
#
sub distance(Int $m, Int $x, Int $y --> Int) {
return Int(sqrt(((@mugwump[$m].x - $x) ** 2) + ((@mugwump[$m].y - $y) ** 2)));
}
# Return a plural ending (default: "s") if the given number is greater than 1;
# otherwise return a singular ending (default: an empty string).
#
sub plural(Int $n, $plural = 's', $singular = '' --> Str) {
return $n > 1 ?? $plural !! $singular;
}
# Run the game.
#
sub play {
my Int $x;
my Int $y;
my Int $turn; # counter
loop { # game
clear_screen;
hide_mugwumps;
TURNS_LOOP: for 1 ..^ $TURNS -> $t {
$turn = $t;
put "Turn number $turn\n";
put "What is your guess (in range [0, {$GRID_SIZE - 1}])?";
$x = get_coord('Distance right of homebase (x-axis): ');
$y = get_coord('Distance above homebase (y-axis): ');
put "\nYour guess is ($x, $y).";
for 0 ..^ $MUGWUMPS -> $m {
if is_here($m, $x, $y) {
@mugwump[$m].hidden = False;
$found += 1;
put "You have found mugwump $m!";
if $found == $MUGWUMPS {
last TURNS_LOOP;
}
}
}
for 0 ..^ $MUGWUMPS -> $m {
if @mugwump[$m].hidden {
put "You are {distance($m, $x, $y)} units from mugwump $m.";
}
}
put '';
} # turns
if $found == $MUGWUMPS {
put "You got them all in $turn turn{plural($turn)}!\n";
put "That was fun! let's play again…";
put 'Four more mugwumps are now in hiding.';
} else {
put "Sorry, that's $TURNS tr{plural($TURNS, "ies", "y")}.\n";
put "Here is where they're hiding:";
for 0 ..^ $MUGWUMPS -> $m {
if @mugwump[$m].hidden {
put "Mugwump $m is at ({@mugwump[$m].x}, {@mugwump[$m].y}).";
}
}
}
put '';
if not yes('Do you want to play again? ') {
last;
}
} # game
}
print_credits;
print_instructions;
play;
Name
# Name
# Original version in BASIC:
# included in Vintage BASIC 1.0.3.
# http://www.vintage-basic.net
# This version in Raku:
# Copyright (c) 2024, Marcos Cruz (programandala.net)
# SPDX-License-Identifier: Fair
# Written on 2024-12-02.
# Last modified: 20241203T1831+0100.
my $name = prompt 'What is your name? ';
my Int $number;
loop {
try {
$number = +prompt 'Enter a number: ';
CATCH {
default {
put 'Number expected.';
next;
}
}
}
last;
}
for 1 .. $number {
put "Hello, $name!";
}
Poetry
# Poetry
# Original version in BASIC:
# Unknown author.
# Modified and reworked by Jim Bailey, Peggy Ewing, and Dave Ahl at DEC.
# Published in "BASIC Computer Games", Creative Computing (Morristown, New Jersey, USA), 1978.
# https://archive.org/details/Basic_Computer_Games_Microcomputer_Edition_1978_Creative_Computing
# https://github.com/chaosotter/basic-games/tree/master/games/BASIC%20Computer%20Games/Poetry
# http://vintage-basic.net/games.html
# This improved remake in Raku:
# Copyright (c) 2024, Marcos Cruz (programandala.net)
# SPDX-License-Identifier: Fair
#
# Written in 2024-12-12/13.
#
# Last modified: 20241213T1544+0100.
# Terminal {{{1
# ==============================================================
constant $BLACK = 0;
constant $RED = 1;
constant $GREEN = 2;
constant $YELLOW = 3;
constant $BLUE = 4;
constant $MAGENTA = 5;
constant $CYAN = 6;
constant $WHITE = 7;
constant $DEFAULT = 9;
constant $STYLE_OFF = +20;
constant $FOREGROUND = +30;
constant $BACKGROUND = +40;
constant $BRIGHT = +60;
constant $NORMAL = 0;
constant $RESET_ALL = $NORMAL;
# Move the cursor to the home position.
sub move_cursor_home {
print "\e[H";
}
# Erase the screen.
sub erase_screen {
print "\e[2J";
}
# Set the color.
sub set_color(Int $color) {
print "\e[{$color}m";
}
# Reset the attributes.
sub reset_attributes {
set_color($RESET_ALL);
}
# Erase the screen, reset the attributes and move the cursor to the home position.
sub clear_screen {
erase_screen;
reset_attributes;
move_cursor_home;
}
# Globals {{{1
# =============================================================
constant $DEFAULT_INK = $FOREGROUND + $WHITE;
constant $INPUT_INK = $FOREGROUND + $BRIGHT + $GREEN;
constant $TITLE_INK = $FOREGROUND + $BRIGHT + $RED;
# Title and credits {{{1
# =============================================================
sub print_title {
set_color($TITLE_INK);
put 'Poetry';
set_color($DEFAULT_INK);
}
sub print_credits {
print_title;
put "\nOriginal version in BASIC:";
put ' Unknown author.';
put " Published in \"BASIC Computer Games\",";
put " Creative Computing (Morristown, New Jersey, USA), 1978.\n";
put 'This improved remake in Raku:';
put ' Copyright (c) 2024, Marcos Cruz (programandala.net)';
put ' SPDX-License-Identifier: Fair';
}
sub press_enter {
set_color($INPUT_INK);
prompt "\nPress the Enter key to start. ";
set_color($DEFAULT_INK);
}
# Main {{{1
# =============================================================
# Is the given integer even?
#
sub is_even(Int $n --> Bool ) {
return $n % 2 == 0;
}
sub play {
constant $MAX_PHRASES_AND_VERSES = 20;
my $action = 0;
my $phrase = 0;
my $phrases_and_verses = 0;
my $verse_chunks = 0;
VERSE: loop {
my $manage_the_verse_continuation = True;
my $maybe_add_comma = True;
given $action {
when 0 .. 1 {
given $phrase {
when 0 { print 'MIDNIGHT DREARY' }
when 1 { print 'FIERY EYES' }
when 2 { print 'BIRD OR FIEND' }
when 3 { print 'THING OF EVIL' }
when 4 { print 'PROPHET' }
}
}
when 2 {
given $phrase {
when 0 { print 'BEGUILING ME'; $verse_chunks = 2 }
when 1 { print 'THRILLED ME' }
when 2 { print 'STILL SITTING…'; $maybe_add_comma = False }
when 3 { print 'NEVER FLITTING'; $verse_chunks = 2 }
when 4 { print 'BURNED' }
}
}
when 3 {
given $phrase {
when 0 { print 'AND MY SOUL' }
when 1 { print 'DARKNESS THERE' }
when 2 { print 'SHALL BE LIFTED' }
when 3 { print 'QUOTH THE RAVEN' }
when 4 { if $verse_chunks != 0 { print 'SIGN OF PARTING' } }
}
}
when 4 {
given $phrase {
when 0 { print 'NOTHING MORE' }
when 1 { print 'YET AGAIN' }
when 2 { print 'SLOWLY CREEPING' }
when 3 { print '…EVERMORE' }
when 4 { print 'NEVERMORE' }
}
}
when 5 {
$action = 0;
put '';
if $phrases_and_verses > $MAX_PHRASES_AND_VERSES {
put '';
$verse_chunks = 0;
$phrases_and_verses = 0;
$action = 2;
next VERSE;
} else {
$manage_the_verse_continuation = False;
}
}
}
if $manage_the_verse_continuation {
sleep 0.250; # 250 ms
if $maybe_add_comma and not ($verse_chunks == 0 or rand > 0.19) {
print ',';
$verse_chunks = 2;
}
if rand > 0.65 {
put '';
$verse_chunks = 0;
} else {
print ' ';
$verse_chunks += 1;
}
}
$action += 1;
$phrase = (0 .. 4).pick;
$phrases_and_verses += 1;
if not ($verse_chunks > 0 or is_even($action)) {
print ' ';
}
} # verse loop
}
clear_screen;
print_credits;
press_enter;
clear_screen;
play;
Russian Roulette
# Russian Roulette
#
# Original version in BASIC:
# Creative Computing (Morristown, New Jersey, USA), ca. 1980.
#
# This version in Raku:
# Copyright (c) 2024, Marcos Cruz (programandala.net)
# SPDX-License-Identifier: Fair
#
# Written in 2024-12.
#
# Last modified: 20241210T1323+0100.
sub clear_screen {
print "\e[0;0H\e[2J";
}
sub press_enter_to_start {
prompt 'Press Enter to start. ';
}
sub print_credits {
clear_screen;
put "Russian Roulette\n";
put 'Original version in BASIC:';
put " Creative Computing (Morristown, New Jersey, USA), ca. 1980.\n";
put 'This version in Raku:';
put ' Copyright (c) 2024, Marcos Cruz (programandala.net)';
put " SPDX-License-Identifier: Fair\n";
press_enter_to_start;
}
sub print_instructions {
clear_screen;
put 'Here is a revolver.';
put "Type 'f' to spin chamber and pull trigger.";
put "Type 'g' to give up, and play again.";
put "Type 'q' to quit.\n";
}
sub play {
clear_screen;
my $times = 0;
loop { # game loop
print_instructions;
$times = 0;
PLAY_LOOP: loop {
given (prompt '> ').lc {
when 'f' { # fire
if (0 .. 99).pick > 83 {
put "Bang! You're dead!";
put 'Condolences will be sent to your relatives.';
last PLAY_LOOP;
} else {
$times += 1;
if $times > 10 {
put 'You win!';
put 'Let someone else blow his brains out.';
last PLAY_LOOP;
} else {
put 'Click.';
}
}
}
when 'g' { # give up
put 'Chicken!';
last PLAY_LOOP;
}
when 'q' { # quit
return;
}
}
} # play loop
press_enter_to_start;
} # game loop
}
print_credits;
play;
put 'Bye!';
Seance
# Seance
# Original version in BASIC:
# By Chris Oxlade, 1983.
# https://archive.org/details/seance.qb64
# https://github.com/chaosotter/basic-games
# This version in Raku:
# Copyright (c) 2024, Marcos Cruz (programandala.net)
# SPDX-License-Identifier: Fair
#
# Written on 2024-12-14.
#
# Last modified: 20241214T1104+0100.
# Terminal {{{1
# ==============================================================
constant $BLACK = 0;
constant $RED = 1;
constant $GREEN = 2;
constant $YELLOW = 3;
constant $BLUE = 4;
constant $MAGENTA = 5;
constant $CYAN = 6;
constant $WHITE = 7;
constant $DEFAULT = 9;
constant $STYLE_OFF = +20;
constant $FOREGROUND = +30;
constant $BACKGROUND = +40;
constant $BRIGHT = +60;
constant $NORMAL = 0;
constant $RESET_ALL = $NORMAL;
# Move the cursor to the home position.
#
sub move_cursor_home {
print "\e[H";
}
# Erase the screen.
#
sub erase_screen {
print "\e[2J";
}
# Set the color.
#
sub set_color(Int $color) {
print "\e[{$color}m";
}
# Reset the attributes.
#
sub reset_attributes {
set_color($RESET_ALL);
}
# Erase the screen, reset the attributes and move the cursor to the home position.
#
sub clear_screen {
erase_screen;
reset_attributes;
move_cursor_home;
}
# Erase from the current cursor position to the end of the current line.
#
sub erase_line_right {
print "\e[K";
}
# Erase the given line to the right of the given column.
#
sub erase_line_right_from(Int $line, Int $column) {
set_cursor_position($line, $column);
erase_line_right;
}
# Make the cursor invisible.
#
sub hide_cursor {
print "\e[?25l";
}
# Make the cursor visible.
#
sub show_cursor {
print "\e[?25h";
}
# Set the cursor position to the given coordinates (the top left position is 1, 1).
#
sub set_cursor_position(Int $line, Int $column) {
print "\e[$line;{$column}H";
}
# Globals {{{1
# =============================================================
constant $TITLE = 'Seance';
constant $MAX_SCORE = 50;
constant $MAX_MESSAGE_LENGTH = 6;
constant $MIN_MESSAGE_LENGTH = 3;
constant $BASE_CHARACTER = ord('@');
constant $PLANCHETTE = '*';
constant $FIRST_LETTER_NUMBER = 1;
constant $LAST_LETTER_NUMBER = 26;
constant $BOARD_INK = $FOREGROUND + $BRIGHT + $CYAN;
constant $DEFAULT_INK = $FOREGROUND + $WHITE;
constant $INPUT_INK = $FOREGROUND + $BRIGHT + $GREEN;
constant $INSTRUCTIONS_INK = $FOREGROUND + $YELLOW;
constant $MISTAKE_EFFECT_INK = $FOREGROUND + $BRIGHT + $RED;
constant $PLANCHETTE_INK = $FOREGROUND + $YELLOW;
constant $TITLE_INK = $FOREGROUND + $BRIGHT + $RED;
constant $MISTAKE_EFFECT_PAUSE = 3; # seconds
constant $BOARD_WIDTH = 8; # characters displayed on the top and bottom borders
constant $BOARD_PAD = 1; # blank characters separating the board from its left and right borders
constant $BOARD_ACTUAL_WIDTH = $BOARD_WIDTH + 2 * $BOARD_PAD; # screen columns
constant $BOARD_HEIGHT = 5; # characters displayed on the left and right borders
constant $BOARD_BOTTOM_Y = $BOARD_HEIGHT + 1; # relative to the board
constant $BOARD_X = 29; # screen column
constant $BOARD_Y = 5; # screen line
constant $INPUT_X = $BOARD_X;
constant $INPUT_Y = $BOARD_Y + $BOARD_BOTTOM_Y + 4;
constant $MESSAGES_Y = $INPUT_Y;
# Input {{{1
# =============================================================
# Print the given prompt and wait until the user enters a string.
#
sub input(Str $prompt = '' --> Str) {
set_color($INPUT_INK);
my $result = prompt $prompt;
set_color($DEFAULT_INK);
return $result;
}
# Board {{{1
# =============================================================
# Return the x coordinate to print the given text centered on the board.
#
sub board_centered_x(Str $text --> Int) {
return ($BOARD_X + ($BOARD_ACTUAL_WIDTH - $text.chars) / 2).Int;
}
# Print the given text on the given row, centered on the board.
#
sub print_board_centered(Str $text, Int $y) {
set_cursor_position($y, board_centered_x($text));
put $text;
}
# Print the title at the current cursor position.
#
sub print_title {
set_color($TITLE_INK);
put $TITLE;
set_color($DEFAULT_INK);
}
# Print the title on the given row, centered on the board.
#
sub print_board_centered_title(Int $y) {
set_color($TITLE_INK);
print_board_centered($TITLE, $y);
set_color($DEFAULT_INK);
}
# Info {{{1
# =============================================================
sub print_credits {
print_title;
put "\nOriginal version in BASIC:";
put ' Written by Chris Oxlade, 1983.';
put ' https://archive.org/details/seance.qb64';
put ' https://github.com/chaosotter/basic-games';
put '';
put 'This version in Raku:';
put ' Copyright (c) 2024, Marcos Cruz (programandala.net)';
put " SPDX-License-Identifier: Fair";
}
sub print_instructions {
print_title;
set_color($INSTRUCTIONS_INK);
put "\nMessages from the Spirits are coming through, letter by letter. They want you";
put 'to remember the letters and type them into the computer in the correct order.';
put 'If you make mistakes, they will be angry ― very angry…';
put '';
put "Watch for stars on your screen ― they show the letters in the Spirits'";
put 'messages.';
set_color($DEFAULT_INK);
}
# Board {{{1
# =============================================================
# Print the given character at the given board coordinates.
#
sub print_character(Int $y, Int $x, Str $a) {
set_cursor_position($y + $BOARD_Y, $x + $BOARD_X);
print $a;
}
sub print_board {
set_color($BOARD_INK);
for 1 .. $BOARD_WIDTH -> $i {
print_character(0, $i + 1, ($BASE_CHARACTER + $i).chr); # top border
print_character($BOARD_BOTTOM_Y, $i + 1, ($BASE_CHARACTER + $LAST_LETTER_NUMBER - $BOARD_HEIGHT - $i + 1).chr); # bottom border
}
for 1 .. $BOARD_HEIGHT -> $i {
print_character($i , 0, ($BASE_CHARACTER + $LAST_LETTER_NUMBER - $i + 1).chr); # left border
print_character($i , 3 + $BOARD_WIDTH, ($BASE_CHARACTER + $BOARD_WIDTH + $i).chr); # right border
}
put '';
set_color($DEFAULT_INK);
}
# Output {{{1
# =============================================================
# Print the given mistake effect, wait a configured number of seconds and
# finally erase it.
#
sub print_mistake_effect(Str $effect) {
my $x = board_centered_x($effect);
hide_cursor;
set_cursor_position($MESSAGES_Y, $x);
set_color($MISTAKE_EFFECT_INK);
put $effect;
set_color($DEFAULT_INK);
sleep $MISTAKE_EFFECT_PAUSE;
erase_line_right_from($MESSAGES_Y, $x);
show_cursor;
}
# Return a new message of the given length, after marking its letters on the
# board.
#
sub message(Int $length --> Str) {
my Int $y;
my Int $x;
my Str $message = '';
hide_cursor;
for 1 .. $length -> $i {
my $letter_number = ($FIRST_LETTER_NUMBER .. $LAST_LETTER_NUMBER).pick;
my $letter = ($BASE_CHARACTER + $letter_number).chr;
$message = "$message$letter";
given True {
when $letter_number <= $BOARD_WIDTH {
# top border;
$y = 1;
$x = $letter_number + 1;
}
when $letter_number <= $BOARD_WIDTH + $BOARD_HEIGHT {
# right border;
$y = $letter_number - $BOARD_WIDTH;
$x = 2 + $BOARD_WIDTH;
}
when $letter_number <= $BOARD_WIDTH + $BOARD_HEIGHT + $BOARD_WIDTH {
# bottom border;
$y = $BOARD_BOTTOM_Y - 1;
$x = 2 + $BOARD_WIDTH + $BOARD_HEIGHT + $BOARD_WIDTH - $letter_number;
}
default {
# left border;
$y = 1 + $LAST_LETTER_NUMBER - $letter_number;
$x = 1;
}
}
set_color($PLANCHETTE_INK);
print_character($y, $x, $PLANCHETTE);
set_color($DEFAULT_INK);
sleep 1;
print_character($y, $x, ' ');
}
show_cursor;
return $message;
}
# Accept a string from the user, erase it from the screen and return it.
#
sub message_understood(--> Str) {
set_cursor_position($INPUT_Y, $INPUT_X);
my $result = (prompt '? ').uc;
erase_line_right_from($INPUT_Y, $INPUT_X);
return $result;
}
# Main {{{1
# =============================================================
sub play {
my $score = 0;
my $mistakes = 0;
print_board_centered_title(1);
print_board;
loop {
my $message_length = ($MIN_MESSAGE_LENGTH .. $MAX_MESSAGE_LENGTH).pick;
if message($message_length) ne message_understood() {
$mistakes += 1;
given $mistakes {
when 1 {
print_mistake_effect('The table begins to shake!');
}
when 2 {
print_mistake_effect('The light bulb shatters!');
}
when 3 {
print_mistake_effect('Oh, no! A pair of clammy hands grasps your neck!');
return;
}
}
} else {
$score += $message_length;
if $score >= $MAX_SCORE {
print_board_centered('Whew! The spirits have gone!', $MESSAGES_Y);
print_board_centered('You live to face another day!', $MESSAGES_Y + 1);
return;
}
}
}
}
set_color($DEFAULT_INK);
clear_screen;
print_credits;
prompt "\nPress the Enter key to read the instructions. ";
clear_screen;
print_instructions;
prompt "\nPress the Enter key to start. ";
clear_screen;
play;
put "\n";
Sine Wave
# Sine Wave
# Original version in BASIC:
# Creative Computing (Morristown, New Jersey, USA), ca. 1980.
# This version in Raku:
# Copyright (c) 2024, Marcos Cruz (programandala.net)
# SPDX-License-Identifier: Fair
# Written on 2024-12-03.
# Last modified: 20241203T1832+0100.
sub clear_screen {
print "\e[0;0H\e[2J";
}
my @word = '', '';
sub get_words {
my @order = 'first', 'second';
for 0, 1 -> $n {
while @word[$n] == '' {
@word[$n] = prompt "Enter the @order[$n] word: ";
}
}
}
sub print_credits {
put "Sine Wave\n";
put 'Original version in BASIC:';
put " Creative Computing (Morristown, New Jersey, USA, ca. 1980.\n";
put 'This version in Raku:';
put ' Copyright (c 2024, Marcos Cruz (programandala.net)';
put " SPDX-License-Identifier: Fair\n";
prompt 'Press Enter to start the program. ';
}
sub draw {
my $even = False;
loop (my $angle = 0.0; $angle <= 40.0; $angle += 0.25) {
print ' ' x (26 + 25 * sin($angle)).Int;
put @word[$even.Int];
$even = not $even;
}
}
clear_screen;
print_credits;
clear_screen;
get_words;
clear_screen;
draw;
Slots
# Slots
# A slot machine simulation.
#
# Original version in BASIC:
# Creative Computing (Morristown, New Jersey, USA).
# Produced by Fred Mirabelle and Bob Harper on 1973-01-29.
#
# This version in Raku:
# Copyright (c) 2024, Marcos Cruz (programandala.net)
# SPDX-License-Identifier: Fair
#
# Written in 2024-12.
#
# Last modified: 20241211T1519+0100.
# Terminal {{{1
# ==============================================================
constant $BLACK = 0;
constant $RED = 1;
constant $GREEN = 2;
constant $YELLOW = 3;
constant $BLUE = 4;
constant $MAGENTA = 5;
constant $CYAN = 6;
constant $WHITE = 7;
constant $DEFAULT = 9;
constant $STYLE_OFF = +20;
constant $FOREGROUND = +30;
constant $BACKGROUND = +40;
constant $BRIGHT = +60;
constant $NORMAL = 0;
constant $RESET_ALL = $NORMAL;
constant $BOLD = 1;
constant $DIM = 2;
constant $ITALIC = 3;
constant $UNDERLINE = 4;
constant $UNDERSCORE = $UNDERLINE;
constant $BLINK = 5;
constant $OVERLINE = 6;
constant $RAPID_BLINK = $OVERLINE;
constant $INVERT = 7;
constant $REVERSE = $INVERT;
constant $HIDDEN = 8;
constant $CROSSED_OUT = 9;
constant $STRIKE = $CROSSED_OUT;
constant $NO_STYLE = $STYLE_OFF;
# Move the cursor to the home position.
sub move_cursor_home {
print "\e[H";
}
# Erase the screen.
sub erase_screen {
print "\e[2J";
}
# Reset the attributes.
sub reset_attributes {
set_color($RESET_ALL);
}
# Erase the screen, reset the attributes and move the cursor to the home position.
sub clear_screen {
erase_screen;
reset_attributes;
move_cursor_home;
}
# Set the color.
sub set_color(Int $color) {
print "\e[{$color}m";
}
# Set the attribute.
sub set_attribute(Int $attr) {
print "\e[0;{$attr}m";
}
# Make the cursor invisible.
sub hide_cursor {
print "\e[?25l";
}
# Make the cursor visible.
sub show_cursor {
print "\e[?25h";
}
# Globals {{{1
# ==============================================================
constant @image = (' BAR ', ' BELL ', 'ORANGE', 'LEMON ', ' PLUM ', 'CHERRY');
constant $BAR = 0; # position of "BAR" in `image`.
constant @color = (
$FOREGROUND + $WHITE,
$FOREGROUND + $CYAN,
$FOREGROUND + $YELLOW,
$FOREGROUND + $BRIGHT + $YELLOW,
$FOREGROUND + $BRIGHT + $WHITE,
$FOREGROUND + $BRIGHT + $RED);
constant $MAX_BET = 100;
constant $MIN_BET = 1;
# Info {{{1
# ==============================================================
sub print_credits {
clear_screen;
put 'Slots';
put "A slot machine simulation.\n";
put 'Original version in BASIC:';
put ' Creative computing (Morristown, New Jersey, USA).';
put " Produced by Fred Mirabelle and Bob Harper on 1973-01-29.\n";
put 'This version in Raku:';
put ' Copyright (c) 2024, Marcos Cruz (programandala.net)';
put " SPDX-License-Identifier: Fair\n";
prompt 'Press Enter for instructions.';
}
sub print_instructions {
clear_screen;
put 'You are in the H&M casino, in front of one of our';
put "one-arm bandits. Bet from $MIN_BET to $MAX_BET USD (or 0 to quit).\n\n";
prompt 'Press Enter to start.';
}
# Main {{{1
# ==============================================================
sub won(Int $prize, Int $bet --> Int) {
given $prize {
when 2 { put 'DOUBLE!' };
when 5 { put '*DOUBLE BAR*' };
when 10 { put '**TOP DOLLAR**' };
when 100 { put '***JACKPOT***' };
};
put 'You won!';
return ($prize + 1) * $bet;
}
sub show_standings(Int $usd) {
print "Your standings are $usd USD.\n";
}
sub print_reels(@reel) {
move_cursor_home;
for @reel -> $r {
set_color(@color[$r]);
print "[@image[$r]]";
}
set_attribute($NORMAL);
put '';
}
sub init_reels(@reel) {
my $images = @image.elems;
for 0 ..^ @reel.elems -> $i {
@reel[$i] = (0 ..^ $images).pick;
}
}
sub spin_reels(@reel) {
constant $SECONDS = 2;
my $first_second = now;
hide_cursor;
while (now - $first_second) < $SECONDS {
init_reels(@reel);
print_reels(@reel);
sleep 0.1
}
show_cursor;
}
# Return the number of repeated elements in the given list.
#
sub repeated(@list) {
my $count = @list.repeated.elems;
return $count > 0 ?? $count + 1 !! 0;
}
# Return the number of equals and bars in the given `reel` array.
#
sub prize(@reel) {
my $equals = repeated(@reel);
my $bars = repeated(grep $BAR, @reel);
return ($equals, $bars);
}
sub prompt_number(Str $prompt --> Int) {
my Int $n;
loop {
try {
$n = (+prompt $prompt).Int;
CATCH {
default {
return 0;
}
}
}
last;
}
return $n;
}
sub play {
my $standings = 0;
my $bet = 0;
my @reel = (0, 0, 0);
my $equals = 0;
my $bars = 0;
init_reels(@reel);
PLAY: loop {
BET: loop {
clear_screen;
print_reels(@reel);
$bet = prompt_number('Your bet (or 0 to quit): ');
if $bet > $MAX_BET {
print "House limits are $MAX_BET USD.\n";
prompt 'Press Enter to try again.';
} elsif $bet < $MIN_BET {
if (prompt "Type \"q\" to confirm you want to quit.").lc eq 'q' {
last PLAY;
}
} else {
last BET;
}
}
clear_screen;
spin_reels(@reel);
($equals, $bars) = prize(@reel);
given $equals {
when 3 {
if $bars == 3 {
$standings += won(100, $bet);
} else {
$standings += won(10, $bet);
}
}
when 2 {
if $bars == 2 {
$standings += won(5, $bet);
} else {
$standings += won(2, $bet);
}
}
default {
put 'You lost.';
$standings -= $bet;
}
} # prize check
show_standings($standings);
prompt 'Press Enter to continue.';
} # play loop
show_standings($standings);
if $standings < 0 {
put 'Pay up! Please leave your money on the terminal.';
} elsif $standings == 0 {
put 'Hey, you broke even.';
} elsif $standings > 0 {
put 'Collect your winnings from the H&M cashier.';
}
}
print_credits;
print_instructions;
play;
Stars
# Stars
#
# Original version in BASIC:
# Example included in Vintage BASIC 1.0.3.
# http://www.vintage-basic.net
#
# This version in Raku:
# Copyright (c) 2024, Marcos Cruz (programandala.net)
# SPDX-License-Identifier: Fair
#
# Written on 2024-12-03.
#
# Last modified: 20241203T1833+0100.
my $name = prompt 'What is your name? ';
print "Hello, $name.\n";
STARS: loop {
my Int $number;
loop {
try {
$number = +prompt 'How many stars do you want? ';
CATCH {
default {
put 'Number expected.';
next;
}
}
}
last;
}
put '*' x $number;
my $answer = (prompt 'Do you want more stars? ').lc;
if not $answer ∈ ('ok', 'y', 'yeah', 'yes') {
last STARS;
}
}
Strings
# Strings
#
# Original version in BASIC:
# Example included in Vintage BASIC 1.0.3.
# http://www.vintage-basic.net
#
# This version in Raku:
# Copyright (c) 2024, 2025, Marcos Cruz (programandala.net)
# SPDX-License-Identifier: Fair
#
# Written in 2024-12.
#
# Last modified: 20250731T1726+0200.
sub prompt_number(Str $prompt --> Int) {
my Int $n;
loop {
try {
$n = +prompt $prompt;
CATCH {
default {
put 'Integer expected.';
next;
}
}
}
last;
}
return floor $n;
}
my $s = prompt 'Enter a string: ';
my $n = prompt_number 'Enter an integer: ';
put "";
put "ASC(\"$s\") --> ord(\"$s\") --> $(ord($s))";
put "CHR\$($n) --> $n.chr --> \"", $n.chr, '"';
put "LEFT\$(\"$s\", $n) --> \"$s\".comb.head($n).join --> '", $s.comb.head($n).join, "'";
put "MID\$(\"$s\", $n) --> \"$s\".comb[$n - 1 .. *].join --> '", $s.comb[$n - 1 .. *].join, "'";
put "MID\$(\"$s\", $n, 3) --> \"$s\".comb[$n - 1 .. $n -1 + 3 - 1].join --> '", $s.comb[$n - 1 .. $n - 1 + 3 - 1].join, "'";
put "RIGHT\$(\"$s\", $n) --> \"$s\".comb.tail($n).join --> '", $s.comb.tail($n).join, "'";
put "LEN(\"$s\") --> \"$s\".chars --> ", $s.chars;
put "VAL(\"$s\") --> val(\"$s\") --> ", val($s);
sub val_or_0(Str $s) {
my Any $n;
try { $n = +$s; CATCH { default { $n = 0 } } }
return $n
}
put "VAL(\"$s\") --> val_or_0(\"$s\") --> ", val_or_0($s), " # custom subroutine with `try`";
put "STR$($n) --> $n.Str --> \"", $n.Str, '"';
put "SPC($n) --> ' ' x $n --> '", ' ' x $n, "'";