Basics of FreeBASIC
Priskribo de la ĉi-paĝa enhavo
Konverto de malnovaj BASIC-programoj al FreeBASIC por lerni la fundamentojn de ĉi-tiu lingvo.
Etikedoj:
3D Plot
/'
3D Plot
Original version in BASIC:
Creative Computing (Morristown, New Jersey, USA), ca. 1980.
This version in FreeBASIC:
Copyright (c) 2024, Marcos Cruz (programandala.net)
SPDX-License-Identifier: Fair
Written on 2024-11-20.
Last modified: 20260901T1346+0200.
'/
sub print_credits()
print !"3D Plot\n"
print "Original version in BASIC:"
print !" Creative computing (Morristown, New Jersey, USA), ca. 1980.\n"
print "This version in FreeBASIC:"
print " Copyright (c) 2024, Marcos Cruz (programandala.net)"
print !" SPDX-License-Identifier: Fair\n"
print "Press any key to start the program. ";
sleep
end sub
function a(z as single) as single
return 30 * exp(-z * z / 100)
end function
function repeat(s as string, n as integer) as string
' source: https://rosettacode.org/wiki/Repeat_a_string#FreeBASIC
if n < 1 then return ""
if n = 1 then return s
var size = len(s)
if size = 0 then return s ' empty string
if size = 1 then return string(n, s[0]) ' repeated single character
var buffer = space(size * n) ' create buffer for size > 1
for i as integer = 0 to n - 1
for j as integer = 0 to size - 1
buffer[i * size + j] = s[j]
next j
next i
return buffer
end function
sub do_draw()
const size as integer = 56
dim x as single
dim l as integer
dim l1 as integer
dim y as single
dim y1 as integer
dim z as single
for x = -30 to 30 step 1.5
dim row as string = repeat(" ", size)
l = 0
y1 = 5 * int(sqr(900 - x * x) / 5)
for y = y1 to -y1 step -5
z = int((25 + a(sqr(x * x + y * y)) - .7 * y))
if z > l then
l = z
row = mid(row, 1, z) + "*" + mid(row, z+2)
end if
next
print row
next
end sub
cls
print_credits()
cls
do_draw()
' vim: filetype=freebasic
Bagels
/'
Bagels
Original version in BASIC:
D. Resek, P. Rowe, 1978.
Creative Computing (Morristown, New Jersey, USA), 1978.
This version in FreeBASIC:
Copyright (c) 2025, Marcos Cruz (programandala.net)
SPDX-License-Identifier: Fair
Written on 2025-05-09.
Last modified: 20260902T2307+0200.
'/
sub press_enter(prompt as string)
print prompt;
sleep
do while inkey <> ""
loop
end sub
sub print_credits()
cls
print "Bagels"
print !"Number guessing game\n"
print "Original source unknown but suspected to be:"
print !" Lawrence Hall of Science, U.C. Berkely.\n"
print "Original version in BASIC:"
print " D. Resek, P. Rowe, 1978."
print !" Creative computing (Morristown, New Jersey, USA), 1978.\n"
print "This version in FreeBASIC:"
print " Copyright (c) 2025, Marcos Cruz (programandala.net)"
print !" SPDX-License-Identifier: Fair\n"
press_enter("Press Enter to read the instructions. ")
end sub
sub print_instructions()
cls
print "Bagels"
print !"Number guessing game\n"
print "I am thinking of a three-digit number that has no two digits the same."
print !"Try to guess it and I will give you clues as follows:\n"
print " PICO - one digit correct but in the wrong position"
print " FERMI - one digit correct and in the right position"
print " BAGELS - no digits correct"
press_enter(!"\nPress Enter to start. ")
end sub
const number_of_digits = 3
const first_digit_index = 0
const last_digit_index = number_of_digits - 1
sub fill_with_random_digits(d() as integer)
for i as integer = lbound(d) to ubound(d)
do while true
d(i) = int(rnd * 10)
for j as integer = 0 to i - 1
if i <> j and d(i) = d(j) then
goto choose_again
end if
next
exit do
choose_again:
loop
next
end sub
function is_any_repeated(n() as integer) as boolean
for i0 as integer = lbound(n) to ubound(n)
for i1 as integer = i0 + 1 to ubound(n)
if n(i0) = n(i1) then
return true
end if
next
next
return false
end function
' Print the given prompt and update the given array with a three-digit number
' from the user.
sub get_input(prompt as string, user_digit() as integer)
' XXX TODO Create a local array, appending every digit after checking the
' contents, making `is_any_repeated` unnecessary.
do while true
get_loop:
dim user_input as string
print prompt;
line input user_input
if len(user_input) <> number_of_digits then
print "Remember it's a " & number_of_digits & "-digit number."
goto get_loop
end if
for i as integer = 1 to len(user_input)
dim digit as string = mid(user_input, i, 1)
if instr("0123456789", digit) > 0 then
user_digit(i - 1) = valint(digit)
else
print "What?"
goto get_loop
end if
next
if is_any_repeated(user_digit()) then
print "Remember my number has no two digits the same."
else
exit do
end if
loop
end sub
function is_yes(s as string) as boolean
select case lcase(trim(s))
case "ok", "y", "yeah", "yes"
return true
case else
return false
end select
end function
function is_no(s as string) as boolean
select case lcase(trim(s))
case "n", "no", "nope"
return true
case else
return false
end select
end function
function yes(prompt as string) as boolean
do while true
dim answer as string
line input prompt, answer
if is_yes(answer) then
return true
end if
if is_no(answer) then
return false
end if
loop
end function
sub play()
randomize
const tries = 20
var score = 0
dim fermi as integer ' counter
dim pico as integer ' counter
dim user_number(first_digit_index to last_digit_index) as integer
do while true
cls
dim computer_number(first_digit_index to last_digit_index) as integer
fill_with_random_digits(computer_number())
print "O.K. I have a number in mind."
for guess as integer = 1 to tries
' XXX TMP
/'
print "My number: "
for i as integer = first_digit_index to last_digit_index
print computer_number(i);
next
print
'/
get_input("Guess #" & guess & ": ", user_number())
fermi = 0
pico = 0
for i as integer = first_digit_index to last_digit_index
for j as integer = first_digit_index to last_digit_index
if user_number(i) = computer_number(j) then
if i = j then
fermi += 1
else
pico += 1
end if
end if
next
next
if pico + fermi = 0 then
print "BAGELS"
else
for i as integer = 1 to pico
print "PICO ";
next
for i as integer = 1 to fermi
print "FERMI ";
next
print
end if
if fermi = number_of_digits then
exit for
end if
next
if fermi = number_of_digits then
print "You got it!!!"
score += 1
else
print "Oh well."
print "That's " & tries & " guesses. My number was "
for i as integer = first_digit_index to last_digit_index
print computer_number(i);
next
print "."
end if
if not yes("Play again? ") then
exit do
end if
loop
if score <> 0 then
print "A " & score & "-point bagels, buff!!"
end if
print "Hope you had fun. Bye."
end sub
print_credits()
print_instructions()
play()
' vim: filetype=freebasic
Bug
/'
Bug
Original version in BASIC:
Brian Leibowitz, 1978.
Creative Computing (Morristown, New Jersey, USA), 1978.
This version in FreeBASIC:
Copyright (c) 2026, Marcos Cruz (programandala.net)
SPDX-License-Identifier: Fair
Written on 2026-09-02.
Last modified: 20260903T0010+0200.
'/
type bug_type
body as boolean
neck as boolean
head as boolean
feelers as integer
feeler_type as string
tail as boolean
legs as integer
end type
type player_type
pronoun as string
possessive as string
bug as bug_type
end type
dim shared computer as player_type
computer.pronoun => "I"
computer.possessive => "My"
computer.bug.feeler_type => "F"
dim shared human as player_type
human.pronoun => "you"
human.possessive => "Your"
human.bug.feeler_type => "A"
const parts as integer => 6
const first_part as integer => 1
const last_part as integer => parts
enum part_id
body => first_part
neck
head
feeler
tail
leg
end enum
assert(part_id.leg = last_part)
' Bug body attributes
const body_height => 2
const feeler_length => 4
const leg_length => 2
const max_feelers => 2
const max_legs => 6
const neck_length => 2
' XXX TODO replace `part_quantity` and `part_name` with a user-defined type
dim shared part_quantity(first_part to last_part) as integer = {1, 1, 1, 2, 1, 6}
' XXX somehow the declarations of string arrays cannot have an initializer
dim shared part_name(first_part to last_part) as string
part_name(part_id.body) => "body"
part_name(part_id.neck) => "neck"
part_name(part_id.head) => "head"
part_name(part_id.feeler) => "feeler"
part_name(part_id.tail) => "tail"
part_name(part_id.leg) => "leg"
function screen_width() as integer
return loword(width)
end function
sub move_cursor_up()
locate(csrlin - iif(csrlin > 1, 1, 0), pos)
end sub
const first_column as integer => 1
sub erase_current_line()
locate(csrlin, first_column)
print space(screen_width());
end sub
sub erase_previous_line()
move_cursor_up()
erase_current_line()
end sub
const default_prompt as string => "> "
sub pause(prompt as string => default_prompt)
print prompt;
do
loop until inkey = chr$(13)
end sub
sub print_credits()
cls
print !"Bug\n"
print "Original version in BASIC:"
print " Brian Leibowitz, 1978."
print !" Creative computing (Morristown, New Jersey, USA), 1978.\n"
print "This version in FreeBASIC:"
print " Copyright (c) 2026, Marcos Cruz (programandala.net)"
print !" SPDX-License-Identifier: Fair\n"
pause("Press Enter to read the instructions. ")
end sub
function left_justified(s as string, width_ as integer, char as string => " ") as string
assert(len(char) = 1)
return s + string(width_ - len(s), char)
end function
function with_uppercase_initial(text as string) as string
return ucase(left(text, 1)) & mid(text, 2)
end function
sub print_parts_table()
const columns => 3
const column_width => 8
const column_separation => 2
' Headers
dim header(3) as string => {"Number", "Part", "Quantity"}
for i as integer => 0 to columns - 1
print left_justified(header(i), column_width + column_separation);
next
print
' Rulers
var ruler => string(column_width, "-")
var padding => string(column_separation, " ")
for i as integer => 0 to columns - 1
print ruler & iif(i = columns - 1, "", padding);
next
print
' Data
for part as part_id => first_part to last_part
print _
left_justified(str(part), column_width + column_separation);
print _
left_justified _
( _
with_uppercase_initial(part_name(part)), _
column_width + column_separation _
);
print _
left_justified _
( _
str(part_quantity(part)), _
column_width + column_separation _
)
next
end sub
sub print_instructions()
cls
print "Bug"
print
print "The object is to finish your bug before I finish mine. Each number"
print "stands for a part of the bug body."
print
print "I will roll the die for you, tell you what I rolled for you, what the"
print "number stands for, and if you can get the part. If you can get the"
print "part I will give it to you. The same will happen on my turn."
print
print "If there is a change in either bug I will give you the option of"
print "seeing the pictures of the bugs. The numbers stand for parts as"
print "follows:"
print
print_parts_table()
pause(!"\nPress Enter to start. ")
end sub
sub print_head()
print " HHHHHHH"
print " H H"
print " H O O H"
print " H H"
print " H V H"
print " HHHHHHH"
end sub
sub print_feelers(bug as bug_type)
for _i as integer => 0 to feeler_length - 1
print " ";
for _i as integer => 0 to bug.feelers - 1
print " " & bug.feeler_type;
next
print
next
end sub
sub print_neck()
for _i as integer => 0 to neck_length - 1
print " N N"
next
end sub
sub print_body(bug as bug_type)
print " BBBBBBBBBBBB"
for _i as integer => 0 to body_height - 1
print " B B"
next
if bug.tail then
print "TTTTTB B"
end if
print " BBBBBBBBBBBB"
end sub
sub print_legs(bug as bug_type)
for _i as integer => 0 to leg_length - 1
print " ";
for _i as integer => 0 to bug.legs - 1
print " L";
next
print
next
end sub
sub print_bug(bug as bug_type)
if bug.feelers > 0 then
print_feelers(bug)
end if
if bug.head then
print_head()
end if
if bug.neck then
print_neck()
end if
if bug.body then
print_body(bug)
end if
if bug.legs > 0 then
print_legs(bug)
end if
end sub
function is_finished(bug as bug_type) as boolean
return bug.feelers = max_feelers and bug.tail and bug.legs = max_legs
end function
function dice() as integer
return int(rnd * 6) + 1
end function
' XXX somehow freebasic does not allow declaring string-type fixed-length
' arrays with initializers. as a workaround, a function is used instead.
function as_text(n as integer) as string
select case n
case 0
return "no"
case 1
return "a"
case 2
return "two"
case 3
return "three"
case 4
return "four"
case 5
return "five"
case 6 ' max legs
return "six"
case else
assert(false)
end select
end function
function plural(number as integer, noun as string) as string
return as_text(number) & " " & noun & iif(number > 1, "s", "")
end function
function add_part(part as part_id, player as player_type) as boolean
dim changed as boolean => false
select case (part)
case part_id.body
if player.bug.body then
print ", but " & player.pronoun & " already have a body."
else
print "; " & player.pronoun & " now have a body:"
player.bug.body => true
changed => true
end if
case part_id.neck
if player.bug.neck then
print ", but " & player.pronoun & " already have a neck."
elseif not player.bug.body then
print ", but " & player.pronoun & " need a body first."
else
print "; " & player.pronoun & " now have a neck:"
player.bug.neck => true
changed => true
end if
case part_id.head
if player.bug.head then
print ", but " & player.pronoun & " already have a head."
elseif not player.bug.neck then
print ", but " & player.pronoun & " need a a neck first."
else
print "; " & player.pronoun & " now have a head:"
player.bug.head => true
changed => true
end if
case part_id.feeler
if player.bug.feelers = max_feelers then
print ", but " & player.pronoun & " have two feelers already."
elseif not player.bug.head then
print ", but " & player.pronoun & " need a head first."
else
player.bug.feelers += 1
print _
"; " _
& player.pronoun _
& " now have " _
& plural(player.bug.feelers, "feeler") _
& ":"
changed => true
end if
case part_id.tail
if player.bug.tail then
print ", but " & player.pronoun & " already have a tail."
elseif not player.bug.body then
print ", but " & player.pronoun & " need a body first."
else
print "; " & player.pronoun & " now have a tail:"
player.bug.tail => true
changed => true
end if
case part_id.leg
if player.bug.legs = max_legs then
print ", but " & player.pronoun & " have " & as_text(max_legs) & " feet already."
elseif not player.bug.body then
print ", but " & player.pronoun & " need a body first."
else
player.bug.legs += 1
print _
"; " _
& player.pronoun _
& " now have " _
& plural(player.bug.legs, "leg") _
& ":"
changed => true
end if
end select
return changed
end function
sub prompt()
pause("Press Enter to roll the dice. ")
erase_previous_line()
end sub
sub play_turn(player as player_type)
prompt()
dim part as integer => dice()
print _
with_uppercase_initial(player.pronoun) _
& " rolled a " & part _
& " (" & part_name(part) & ")";
if add_part(part, player) then
print
print_bug(player.bug)
end if
print
end sub
sub print_winner()
if is_finished(human.bug) and is_finished(computer.bug) then
print "Both of our bugs are finished in the same number of turns!"
elseif is_finished(human.bug) then
print human.possessive & " bug is finished."
elseif is_finished(computer.bug) then
print computer.possessive & " bug is finished."
end if
end sub
function game_over() as boolean
return is_finished(human.bug) or is_finished(computer.bug)
end function
sub play()
cls
do while not game_over()
play_turn(human)
play_turn(computer)
loop
print_winner()
end sub
print_credits()
print_instructions()
play()
print "I hope you enjoyed the game, play it again soon!!"
' vim: filetype=freebasic
Bunny
/'
Bunny
Original version in BASIC:
Creative Computing (Morristown, New Jersey, USA), 1978.
This version in FreeBASIC:
Copyright (c) 2024, Marcos Cruz (programandala.net)
SPDX-License-Identifier: Fair
Written on 2024-11-21.
Last modified: 20260901T1347+0200.
'/
sub print_credits()
dim void as string
print !"Bunny\n"
print "Original version in BASIC:"
print !" Creative Computing (Morristown, New Jersey, USA), 1978.\n"
print "This version in FreeBASIC:"
print " Copyright (c) 2024, Marcos Cruz (programandala.net)"
print !" SPDX-License-Identifier: Fair\n"
input "Press Enter to start the program. ", void
end sub
sub do_draw()
const EOL as integer = -1 ' end of line identifier
const picture_data_count as integer = 226
const letters as integer = 5
dim letter(1 to letters) as string = {"B", "U", "N", "N", "Y"}
dim picture_data(picture_data_count) as integer = { _
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 }
const line_buffer_size as integer = 53
dim line_buffer(1 to line_buffer_size) as string
for i as integer = 1 to line_buffer_size
line_buffer(i) = " "
next
dim picture_data_index as integer = 0
do while picture_data_index <= picture_data_count
var first_column = picture_data(picture_data_index)
picture_data_index += 1
if first_column = EOL then
for i as integer = 1 to line_buffer_size
print line_buffer(i);
line_buffer(i) = " "
next
print
else
var last_column = picture_data(picture_data_index)
picture_data_index += 1
for column as integer = first_column to last_column
line_buffer(column + 1) = letter(column mod letters + 1)
next
end if
loop
end sub
cls
print_credits()
cls
do_draw()
' vim: filetype=freebasic
Chase
/'
Chase
Original version in BASIC:
Anonymous.
Published in 1977 in "The Best of Creative Computing", Volume 2.
https://www.atariarchives.org/bcc2/showpage.php?page=253
Version in Oberon-07:
Copyright (c) 2022, 2023, Marcos Cruz (programandala.net)
SPDX-License-Identifier: Fair
Version in Odin:
Copyright (c) 2023, 2025, Marcos Cruz (programandala.net)
SPDX-License-Identifier: Fair
This version in FreeBASIC:
Copyright (c) 2026, Marcos Cruz (programandala.net)
SPDX-License-Identifier: Fair
Written on 2026-09-03
.
Last modified 20260903T1700+0200.
'/
' Globals {{{1
' =============================================================
const bright => 8
' XXX TODO make an `enum`
const black => 0
const dark_grey => bright + black
const blue => 1
const bright_blue => bright + blue
const green => 2
const bright_green => bright + green
const cyan => 3
const bright_cyan => bright + cyan
const red => 4
const bright_red => bright + red
const pink => 5
const bright_pink => bright + pink
const yellow => 6
const bright_yellow => bright + yellow
const grey => 7
const white => bright + grey
const default_ink => white
const input_ink => bright_green
const instructions_ink => yellow
const title_ink => bright_red
const arena_width => 20
const arena_height => 10
const arena_last_x => arena_width - 1
const arena_last_y => arena_height - 1
const arena_row => 3
dim shared arena(arena_height, arena_width) as string
const empty => " "
const fence_symbol => "X"
const machine_symbol => "m"
const human_symbol => "@"
const fences => 15 ' inner obstacles, not the border
enum end_id explicit
not_yet
quit
electrified
killed
victory
end enum
dim shared the_end as end_id
const machines => 5
const machines_drag => 2 ' probability not moving: 0=0%, 1=50%, 2=66%, 3=75%, etc.
type machine_type
y as integer
x as integer
operative as boolean
end type
dim shared machine(machines) as machine_type
dim shared destroyed_machines as integer ' counter
dim shared human_x as integer
dim shared human_y as integer
' User input {{{1
' =============================================================
function get_string(prompt as string => "") as string
print prompt;
dim result as string
line input result
return result
end function
sub pause(prompt as string)
print prompt;
do
loop until inkey = chr(13)
end sub
function is_yes(s as string) as boolean
select case lcase(trim(s))
case "ok", "y", "yeah", "yes"
return true
case else
return false
end select
end function
function is_no(s as string) as boolean
select case lcase(trim(s))
case "n", "no", "nope"
return true
case else
return false
end select
end function
function yes(prompt as string) as boolean
do
var answer => get_string(prompt)
if is_yes(answer) then
return true
end if
if is_no(answer) then
return false
end if
loop
end function
' Title, credits and instructions {{{1
' =============================================================
const title => "Chase"
sub print_title()
color(title_ink)
print title
color(default_ink)
end sub
sub print_credits()
print_title()
print !"\nOriginal version in BASIC:"
print " Anonymous."
print !" Published in \"The Best of Creative Computing\" Volume 2 & 1977."
print " https://www.atariarchives.org/bcc2/showpage.php?page=253"
print "This version in FreeBASIC:"
print " Copyright (c) 2026, Marcos Cruz (programandala.net)"
print " SPDX-License-Identifier: Fair"
end sub
sub print_instructions()
print_title()
color(instructions_ink)
print !"\nYou (" & human_symbol & ") are in a high voltage maze with " & machines
print "security machines (" & machine_symbol & ") trying to kill you."
print "You must maneuver them into the maze (" & fence_symbol & !") to survive.\n"
print !"Good luck!\n"
print !"The movement commands are the following:\n"
print " ↖ ↑ ↗"
print " NW N NE"
print " ← W E →"
print " SW S SE"
print " ↙ ↓ ↘"
print !"\nPlus 'Q' to end the game."
color(default_ink)
end sub
' Arena {{{1
' =============================================================
sub print_arena()
locate(arena_row, 1)
for y as integer => 0 to arena_last_y
for x as integer => 0 to arena_last_x
print arena(y, x);
next
print
next
end sub
function is_border(y as integer, x as integer) as boolean
return (y = 0) orelse (x = 0) orelse (y = arena_last_y) orelse (x = arena_last_x)
end function
function random_integer_in_inclusive_range(min as integer, max as integer) as integer
return int(rnd * (max - min) + min)
end function
sub place overload (s as string, byref y as integer, byref x as integer)
do
y => random_integer_in_inclusive_range(1, arena_last_y - 1)
x => random_integer_in_inclusive_range(1, arena_last_x - 1)
if arena(y, x) = empty then
exit do
end if
loop
arena(y, x) => s
end sub
sub place overload (s as string)
dim dummy_y as integer
dim dummy_x as integer
place(s, dummy_y, dummy_x)
end sub
sub inhabit_arena()
for m as integer => 0 to machines - 1
place(machine_symbol, machine(m).y, machine(m).x)
machine(m).operative => true
next
for i as integer => 1 to fences
place(fence_symbol)
next
place(human_symbol, human_y, human_x)
end sub
sub clean_arena()
for y as integer => 0 to arena_last_y
for x as integer => 0 to arena_last_x
arena(y, x) => iif(is_border(y, x), fence_symbol, empty)
next
next
end sub
' Game {{{1
' =============================================================
sub init_game()
clean_arena()
inhabit_arena()
destroyed_machines => 0
the_end => end_id.not_yet
end sub
sub move_machine(m as integer)
dim maybe as integer
arena(machine(m).y, machine(m).x) => empty
maybe => random_integer_in_inclusive_range(0, 2)
if machine(m).y > human_y then
machine(m).y -= maybe
elseif machine(m).y < human_y then
machine(m).y += maybe
end if
maybe => random_integer_in_inclusive_range(0, 2)
if machine(m).x > human_x then
machine(m).x -= maybe
elseif machine(m).x < human_x then
machine(m).x += maybe
end if
if arena(machine(m).y, machine(m).x) = empty then
arena(machine(m).y, machine(m).x) => machine_symbol
elseif arena(machine(m).y, machine(m).x) = fence_symbol then
machine(m).operative => false
destroyed_machines += 1
if destroyed_machines = machines then
the_end => end_id.victory
end if
elseif arena(machine(m).y, machine(m).x) = human_symbol then
the_end => end_id.killed
end if
end sub
sub maybe_move_machine(m as integer)
if random_integer_in_inclusive_range(0, machines_drag) = 0 then
move_machine(m)
end if
end sub
sub move_machines()
for m as integer => 0 to machines - 1
if machine(m).operative then
maybe_move_machine(m)
end if
next
end sub
function screen_width() as integer
return loword(width)
end function
const first_column as integer => 1
sub erase_current_line_right()
print space(screen_width() - pos + first_column);
locate(csrlin, first_column)
end sub
sub set_move(byref y_inc as integer, byref x_inc as integer)
print
erase_current_line_right()
dim command_ as string => lcase(get_string("Command: "))
select case command_
case "q"
the_end => end_id.quit
case "sw"
y_inc => +1
x_inc => -1
case "s"
y_inc => +1
x_inc => 0
case "se"
y_inc => +1
x_inc => +1
case "w"
y_inc => 0
x_inc => -1
case "e"
y_inc => 0
x_inc => +1
case "nw"
y_inc => -1
x_inc => -1
case "n"
y_inc => -1
x_inc => 0
case "ne"
y_inc => -1
x_inc => +1
end select
end sub
sub play()
dim y_inc as integer
dim x_inc as integer
do ' game loop
cls
print_title()
init_game()
do ' action loop
print_arena()
set_move(y_inc, x_inc)
if the_end = end_id.not_yet then
if y_inc <> 0 or x_inc <> 0 then
arena(human_y, human_x) => empty
if arena(human_y + y_inc, human_x + x_inc) = fence_symbol then
the_end => end_id.electrified
elseif arena(human_y + y_inc, human_x + x_inc) = machine_symbol then
the_end => end_id.killed
else
arena(human_y, human_x) => empty
human_y => human_y + y_inc
human_x => human_x + x_inc
arena(human_y, human_x) => human_symbol
print_arena()
move_machines()
end if
end if
end if
if the_end <> end_id.not_yet then
exit do
end if
loop ' action loop
select case the_end
case end_id.quit
print !"\nSorry to see you quit."
case end_id.electrified
print !"\nZap! You touched the fence!"
case end_id.killed
print !"\nYou have been killed by a lucky machine."
case end_id.victory
print !"\nYou are lucky, you destroyed all machines."
end select
loop until not yes(!"\nDo you want to play again? ")
print !"\nHope you don't feel fenced in."
print "Try again sometime."
end sub
' Main {{{1
' =============================================================
randomize
color(default_ink)
cls
print_credits()
pause(!"\nPress the Enter key to read the instructions. ")
cls
print_instructions()
pause(!"\nPress the Enter key to start. ")
play()
' vim: filetype=freebasic
Diamond
/'
Diamond
Original version in BASIC:
Example included in Vintage BASIC 1.0.3.
http://www.vintage-basic.net
This version in FreeBASIC:
Copyright (c) 2024, Marcos Cruz (programandala.net)
SPDX-License-Identifier: Fair
Written on 2024-11-20.
Last modified: 20260901T1347+0200.
'/
const lines as integer = 17
dim i as integer = 0
dim j as integer = 0
for i = 1 to lines / 2 + .5
for j = 1 to (lines + 1) / 2 - i + 1
print " ";
next
for j = 1 to i * 2 - 1
print "*";
next
print
next
for i = 1 to lines / 2
for j = 1 to i + 1
print " ";
next
for j = 1 to ((lines + 1) / 2 - i) * 2 - 1
print "*";
next
print
next
' vim: filetype=freebasic
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 FreeBASIC:
Copyright (c) 2026, Marcos Cruz (programandala.net)
SPDX-License-Identifier: Fair
Written on 2026-09-02.
Last modified: 20260902T2307+0200.
Acknowledgment:
The following Python port was used as a reference of the original
variables: <https://github.com/jquast/hamurabi.py>.
'/
const bright as integer => 8
' XXX TODO make an `enum`
const black as integer => 0
const dark_grey as integer => bright + black
const blue as integer => 1
const green as integer => 2
const cyan as integer => 3
const red as integer => 4
const pink as integer => 5
const yellow as integer => 6
const grey as integer => 7
const white as integer => bright + grey
const acres_a_bushel_can_seed as integer => 2 ' yearly
const acres_a_person_can_seed as integer => 10 ' yearly
const initial_acres_per_person as integer => 10 ' to calculate the initial acres of the city
const bushels_to_feed_a_person as integer => 20 ' yearly
const irritation_levels as integer => 5 ' after the switch in `show_irritation`
const max_irritation as integer => 16
const irritation_step as integer => max_irritation / irritation_levels
const range_of_harvested_bushels_per_acre as integer => 10
const min_harvested_bushels_per_acre as integer => 17
const max_harvested_bushels_per_acre as integer => min_harvested_bushels_per_acre + range_of_harvested_bushels_per_acre - 1
const plague_chance as integer => 0.15 ' 15% yearly
const years as integer => 10 ' goverment period
const default_ink as integer => white
const input_ink as integer => bright + green
const instructions_ink as integer => yellow
const result_ink as integer => bright + cyan
const speech_ink as integer => pink
const title_ink as integer => white
const warning_ink as integer => bright + red
enum Result
Very_Good
Not_Too_Bad
Bad
Very_Bad
end enum
dim shared acres as integer
dim shared bushels_eaten_by_rats as integer
dim shared bushels_harvested as integer
dim shared bushels_harvested_per_acre as integer
dim shared bushels_in_store as integer
dim shared bushels_to_feed_with as integer
dim shared dead as integer
dim shared infants as integer
dim shared irritation as integer ' counter (0 .. => 99)
dim shared population as integer
dim shared starved_people_percentage as integer
dim shared total_dead as integer
function random_in_inclusive_range(first as integer, last as integer) as integer
return int(rnd * (last - first) + first)
end function
function random_1_to_5() as integer
return random_in_inclusive_range(1, 5)
end function
function persons _
( _
n as integer, _
singular as string => "person", _
plural as string => "people" _
) as string
select case n
case 0
return "nobody"
case 1
return "one " & singular
case else
return "" & n & " " & plural
end select
end function
sub print_instructions()
color(instructions_ink)
print "Hammurabi is a simulation game in which you, as the ruler of the ancient "
print "kingdom of Sumeria, Hammurabi, manage the resources."
print
print "You may buy and sell land with your neighboring city-states for bushels of"
print "grain ― the price will vary between " & min_harvested_bushels_per_acre
print " and " & max_harvested_bushels_per_acre & " bushels per acre. You also must"
print "use grain to feed your people and as seed to plant the next year's crop."
print
print "You will quickly find that a certain number of people can only tend a certain"
print "amount of land and that people starve if they are not fed enough. You also"
print "have the unexpected to contend with such as a plague, rats destroying stored"
print "grain, and variable harvests."
print
print "You will also find that managing just the few resources in this game is not a"
print "trivial job. The crisis of population density rears its head very rapidly."
print
print "Try your hand at governing ancient Sumeria for a " & years & "-year term of office."
color(default_ink)
end sub
const default_prompt as string => "> "
function get_string(prompt as string => default_prompt) as string
dim typed as string
color(input_ink)
print prompt;
line input typed
color(default_ink)
return typed
end function
sub pause(prompt as string => default_prompt)
color(input_ink)
print prompt;
do
loop until inkey = chr(13)
color(default_ink)
end sub
function is_sign(character as string) as boolean
assert(len(character) = 1)
return character = "+" orelse character = "-"
end function
function is_digit(character as string) as boolean
assert(len(character) = 1)
return character >= "0" andalso character <= "9"
end function
function is_integer(s as string) as boolean
for character_position as integer => 1 to len(s)
dim character as string => mid(s, character_position, 1)
if character_position = 1 then
if not is_sign(character) andalso not is_digit(character) then
return false
end if
elseif not is_digit(character) then
return false
end if
next
return true
end function
function get_number(prompt as string => "") as integer
dim number as integer
do
dim s as string => get_string(prompt)
if is_integer(s) then
number => val(s)
exit do
else
print "Integer expected."
end if
loop
return number
end function
sub print_credits()
color(title_ink)
print "Hammurabi"
print
print "Original program:"
print " Written in FOCAL on a DEP PDP-8 by Rick Merrill, 1969."
print
print "BASIC port:"
print " Ported from FOCAL and modified for Edusystem 70 by David Ahl, c. 1973."
print " Modified for 8K Microsoft BASIC by Peter Turnbull, c. 1978."
print
print "This improved remake in FreeBASIC:"
print " Copyright (c) 2026, Marcos Cruz (programandala.net)"
print " SPDX-License-Identifier: Fair"
color(default_ink)
end sub
function ordinal_suffix(n as integer) as string
select case n
case 1
return "st"
case 2
return "nd"
case 3
return "rd"
case else
return "th"
end select
end function
function previous(year as integer) as string
if year = 0 then
return "the previous year"
else
return "your " & year & ordinal_suffix(year) & " year"
end if
end function
sub print_annual_report(year as integer)
cls
color(speech_ink)
print "Hammurabi, I beg to report to you."
color(default_ink)
print
print _
"In " & previous(year) & " " _
& persons(dead) & " starved and " _
& persons(infants, "infant", "infants") _
& " " & iif(infants > 1, "were", "was") & " born."
print
population += infants
if year > 0 and rnd <= plague_chance then
population => int(population / 2)
color(warning_ink)
print "A horrible plague struck! Half the people died."
color(default_ink)
end if
print "The population is " & population & "."
print "The city owns " & acres & " acres."
print _
"You harvested " _
& bushels_harvested _
& " bushels (" & bushels_harvested_per_acre & " per acre)."
print
if bushels_eaten_by_rats > 0 then
print "The rats ate " & bushels_eaten_by_rats & " bushels."
end if
print "You have " & bushels_in_store & " bushels in store."
bushels_harvested_per_acre => _
int(rnd * range_of_harvested_bushels_per_acre) + _
min_harvested_bushels_per_acre
print "Land is trading at " & bushels_harvested_per_acre & " bushels per acre."
print
end sub
sub say_bye()
color(default_ink)
print !"\nSo long for now.\n"
end sub
sub quit_game()
say_bye()
end
end sub
sub relinquish()
color(speech_ink)
print !"\nHammurabi, I am deeply irritated and cannot serve you anymore."
print "Please, get yourself another steward!"
color(default_ink)
quit_game()
end sub
sub increase_irritation()
irritation += random_in_inclusive_range(1, irritation_step)
if irritation >= max_irritation then
relinquish() ' this never returns
assert(false)
end if
end sub
sub print_irritated(adverb as string)
print "The steward seems " & adverb & " irritated."
end sub
sub show_irritation()
select case true
case irritation < irritation_step
exit select
case irritation < irritation_step * 2
print_irritated("slightly")
case irritation < irritation_step * 3
print_irritated("quite")
case irritation < irritation_step * 4
print_irritated("very")
case else
print_irritated("profoundly")
end select
end sub
sub beg_repeat()
increase_irritation() ' this may never return
color(speech_ink)
print "I beg your pardon? I did not understand your order."
color(default_ink)
show_irritation()
end sub
sub beg_think_again(quantity as integer, item as string)
increase_irritation() ' this may never return
color(speech_ink)
print "I beg your pardon? You have only " & quantity & " " & item & ". Now then…"
color(default_ink)
show_irritation()
end sub
sub buy_or_sell_land()
dim acres_to_buy as integer
dim acres_to_sell as integer
do
acres_to_buy => get_number("How many acres do you wish to buy? (0 to sell): ")
if acres_to_buy < 0 then
beg_repeat() ' this may never return
continue do
end if
if bushels_harvested_per_acre * acres_to_buy <= bushels_in_store then
exit do
end if
beg_think_again(bushels_in_store, "bushels of grain")
loop
if acres_to_buy <> 0 then
print "You buy " & acres_to_buy & " acres."
acres += acres_to_buy
bushels_in_store -= bushels_harvested_per_acre * acres_to_buy
print "You now have " & acres & " acres and " & bushels_in_store & " bushels."
else
do
acres_to_sell => get_number("How many acres do you wish to sell?: ")
if acres_to_sell < 0 then
beg_repeat() ' this may never return
continue do
end if
if acres_to_sell < acres then
exit do
end if
beg_think_again(acres, "acres")
loop
if acres_to_sell > 0 then
print "You sell " & acres_to_sell & " acres."
acres -= acres_to_sell
bushels_in_store += bushels_harvested_per_acre * acres_to_sell
print "You now have " & acres & " acres and " & bushels_in_store & " bushels."
end if
end if
end sub
sub feed_people()
do
bushels_to_feed_with => get_number("How many bushels do you wish to feed your people with?: ")
if bushels_to_feed_with < 0 then
beg_repeat() ' this may never return
continue do
end if
' Trying to use more grain than is in silos?
if bushels_to_feed_with <= bushels_in_store then
exit do
end if
beg_think_again(bushels_in_store, "bushels of grain")
loop
print "You feed your people with " & bushels_to_feed_with & " bushels."
bushels_in_store -= bushels_to_feed_with
print "You now have " & bushels_in_store & " bushels."
end sub
sub seed_land()
dim acres_to_seed as integer
do
acres_to_seed => get_number("How many acres do you wish to seed?: ")
if acres_to_seed < 0 then
beg_repeat() ' this may never return
continue do
end if
if acres_to_seed = 0 then
exit do
end if
' Trying to seed more acres than you own?
if acres_to_seed > acres then
beg_think_again(acres, "acres")
continue do
end if
' Enough grain for seed?
if int(acres_to_seed / acres_a_bushel_can_seed) > bushels_in_store then
beg_think_again _
( _
bushels_in_store, _
!"bushels of grain,\nand one bushel can seed " _
& acres_a_bushel_can_seed & " acres" _
)
continue do
end if
' Enough people to tend the crops?
if acres_to_seed <= acres_a_person_can_seed * population then
exit do
end if
beg_think_again _
( _
population, _
"people to tend the fields,\nand one person can seed " _
& acres_a_person_can_seed & " acres" _
)
loop
dim bushels_used_for_seeding as integer => acres_to_seed \ acres_a_bushel_can_seed
print "You seed " & acres_to_seed & " acres using " & bushels_used_for_seeding & " bushels."
bushels_in_store -= bushels_used_for_seeding
print "You now have " & bushels_in_store & " bushels."
' A bountiful harvest!
bushels_harvested_per_acre => random_1_to_5()
bushels_harvested => acres_to_seed * bushels_harvested_per_acre
bushels_in_store += bushels_harvested
end sub
function is_even(n as integer) as boolean
return (n mod 2) = 0
end function
sub check_rats()
dim rat_chance as integer => random_1_to_5()
bushels_eaten_by_rats => iif(is_even(rat_chance), int(bushels_in_store / rat_chance), 0)
bushels_in_store -= bushels_eaten_by_rats
end sub
sub init_first_year()
dead => 0
total_dead => 0
starved_people_percentage => 0
population => 95
infants => 5
acres => initial_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
end sub
sub print_result(the_result as integer)
color(result_ink)
select case the_result
case .Very_Good
print "A fantastic performance! Charlemagne, Disraeli and Jefferson combined could"
print "not have done better!"
case .Not_Too_Bad
print "Your performance could have been somewat better, but really wasn't too bad at"
print _
"all. " _
& int(population * 0.8 * rnd) _
& !" people would dearly like to see you assassinated, but we all have our\n"
print "trivial problems."
case .Bad
print "Your heavy-handed performance smacks of Nero and Ivan IV. The people"
print "(remaining) find you an unpleasant ruler and, frankly, hate your guts!"
case .Very_Bad
print "Due to this extreme mismanagement you have not only been impeached and thrown"
print "out of office but you have also been declared national fink!!!"
end select
color(default_ink)
end sub
sub print_final_report()
cls
if starved_people_percentage > 0 then
print _
"In your " & years & "-year term of office, " _
& starved_people_percentage & !" percent of the\n" _
"population starved per year on the average, i.e., a total of " _
& total_dead & !" people died!\n\n"
end if
dim acres_per_person as integer => acres \ population
print _
"You started with " _
& initial_acres_per_person _
& " acres per person and ended with " _
& acres_per_person & !"!\n\n"
select case true
case starved_people_percentage > 33, acres_per_person < 07
print_result(.Very_Bad)
case starved_people_percentage > 10, acres_per_person < 09
print_result(.Bad)
case starved_people_percentage > 03, acres_per_person < 10
print_result(.Not_Too_Bad)
case else
print_result(.Very_Good)
end select
end sub
sub check_starvation(year as integer)
dim fed_people as integer => bushels_to_feed_with \ bushels_to_feed_a_person
if population > fed_people then
dead => population - fed_people
starved_people_percentage => ((year - 1) * starved_people_percentage + dead * 100 / population) / year
population -= dead
total_dead += dead
' Starve enough for impeachment?
if dead > int(0.45 * population) then
color(warning_ink)
print !"\nYou starved " & dead & !"people in one year!!!\n"
color(default_ink)
print_result(.Very_Bad)
quit_game()
end if
end if
end sub
sub govern()
init_first_year()
print_annual_report(0)
for year as integer => 1 to years
buy_or_sell_land()
feed_people()
seed_land()
check_rats()
infants => int(random_1_to_5() * (20 * acres + bushels_in_store) / population / 100 + 1)
check_starvation(year)
pause("\nPress the Enter key to read the annual report. ")
print_annual_report(year)
next
end sub
randomize
cls
print_credits()
pause("\nPress the Enter key to read the instructions. ")
cls
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()
' vim: filetype=freebasic
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 FreeBASIC:
Copyright (c) 2026, Marcos Cruz (programandala.net)
SPDX-License-Identifier: Fair
Written on 2026-09-02.
Last modified: 20260902T2310+0200.
'/
' Terminal {{{1
' ==============================================================================
const bright as integer => 8
' XXX TODO make an `enum`
const black as integer => 0
const dark_grey as integer => bright + black
const blue as integer => 1
const bright_blue as integer => bright + blue
const green as integer => 2
const bright_green as integer => bright + green
const cyan as integer => 3
const bright_cyan as integer => bright + cyan
const red as integer => 4
const bright_red as integer => bright + red
const pink as integer => 5
const bright_pink as integer => bright + pink
const yellow as integer => 6
const bright_yellow as integer => bright + yellow
const grey as integer => 7
const white as integer => bright + grey
' Global variables and constants {{{1
' ==============================================================================
const DEFAULT_INK => WHITE
const INPUT_INK => BRIGHT_GREEN
const INSTRUCTIONS_INK => YELLOW
const TITLE_INK => BRIGHT_RED
const INITIAL_DISTANCE => 100
const INITIAL_BULLETS => 4
const MAX_WATERING_TROUGHS => 3
dim shared distance as integer ' distance between both gunners, in paces
dim shared player_bullets as integer
dim shared opponent_bullets as integer
' User input {{{1
' ==============================================================================
function get_string(prompt as string => "") as string
color(input_ink)
print prompt;
dim result as string
line input result
color(default_ink)
return result
end function
function is_sign(character as string) as boolean
assert(len(character) = 1)
return character = "+" orelse character = "-"
end function
function is_digit(character as string) as boolean
assert(len(character) = 1)
return character >= "0" andalso character <= "9"
end function
function is_integer(s as string) as boolean
for character_position as integer => 1 to len(s)
dim character as string => mid(s, character_position, 1)
if character_position = 1 then
if not is_sign(character) andalso not is_digit(character) then
return false
end if
elseif not is_digit(character) then
return false
end if
next
return true
end function
function get_number(prompt as string => "") as integer
dim result as integer
do
dim s as string => get_string(prompt)
if is_integer(s) then
result => val(s)
exit do
else
print "Integer expected."
end if
loop
return result
end function
function pressed(prompt as string) as string
dim key as string
print prompt;
do
key => inkey
loop until key <> ""
return key
end function
sub press_enter(prompt as string)
pressed(prompt)
end sub
function is_yes(s as string) as boolean
select case lcase(trim(s))
case "ok", "y", "yeah", "yes"
return true
case else
return false
end select
end function
function is_no(s as string) as boolean
select case lcase(trim(s))
case "n", "no", "nope"
return true
case else
return false
end select
end function
function yes(prompt as string) as boolean
do
dim answer as string => get_string(prompt)
if is_yes(answer) then
return true
end if
if is_no(answer) then
return false
end if
loop
end function
' Title, instructions and credits {{{1
' ==============================================================================
' Print the title at the current cursor position.
'
sub print_title()
color(TITLE_INK)
print "High Noon"
color(DEFAULT_INK)
end sub
sub print_credits()
print_title()
print !"\nOriginal version in BASIC:"
print " Designed and programmend by Chris Gaylo, 1970."
print " http://mybitbox.com/highnoon-1970/"
print " http://mybitbox.com/highnoon/"
print "Transcriptions:"
print " https://github.com/MrMethor/Highnoon-BASIC/"
print " https://github.com/mad4j/basic-highnoon/"
print "Version modified for QB64:"
print " By Daniele Olmisani, 2014."
print " https://github.com/mad4j/basic-highnoon/"
print "This improved remake in FreeBASIC:"
print " Copyright (c) 2026, Marcos Cruz (programandala.net)"
print " SPDX-License-Identifier: Fair"
end sub
sub print_instructions()
print_title()
color(INSTRUCTIONS_INK)
print !"\nYou have been challenged to a showdown by Black Bart, one of"
print "the meanest desperadoes west of the Allegheny mountains."
print !"\nWhile you are walking down a dusty, deserted side street,"
print "Black Bart emerges from a saloon one hundred paces away."
print !"\nBy agreement, you each have " & INITIAL_BULLETS & " bullets in your six-guns."
print !"\nYour marksmanship equals his. At the start of the walk nei-"
print "ther of you can possibly hit the other, and at the end of"
print "the walk, neither can miss. the closer you get, the better"
print "your chances of hitting black Bart, but he also has beter"
print "chances of hitting you."
color(DEFAULT_INK)
end sub
' Game loop {{{1
' ==============================================================================
' Return a random number in the given inclusive range.
function random_in_range(first as integer, last as integer) as integer
return int(rnd * (last - first) + first)
end function
function plural_suffix(n as integer) as string
return iif(n = 1, "", "s")
end function
sub print_shells_left()
if player_bullets = opponent_bullets then
print "Both of you have " & player_bullets & " bullets."
else
print _
"You now have " _
& player_bullets _
& " bullet" & plural_suffix(player_bullets) _
& " to Black Bart's " _
& opponent_bullets _
& " bullet" & plural_suffix(opponent_bullets) & !".\n"
end if
end sub
function day() as integer
return random_in_range(10, 20)
end function
function check() as string
return left("000" & random_in_range(0, 1000), 4)
end function
sub print_check()
print "******************************************************"
print "* *"
print "* BANK OF DODGE CITY *"
print "* CASHIER'S RECEIT *"
print "* *"
print "* CHECK NO. " & check() & " AUGUST " & day() & "TH, 1889 *"
print "* *"
print "* *"
print "* PAY TO THE BEARER ON DEMAND THE SUM OF *"
print "* *"
print "* TWENTY THOUSAND DOLLARS-------------------$20,000 *"
print "* *"
print "******************************************************"
end sub
sub get_reward()
print "As mayor of Dodge City, and on behalf of its citizens,"
print "I extend to you our thanks, and present you with this"
print !"reward, a check for $20,000, for killing Black Bart.\n\n"
print_check()
print !"\n\nDon't spend it all in one place."
end sub
sub move_the_opponent()
dim paces as integer => random_in_range(2, 10)
print "Black Bart moves " & paces & " paces."
distance -= paces
end sub
const silently as boolean = true
function maybe_move_the_opponent(silent as boolean => false) as boolean
if random_in_range(0, 1) = 0 then
move_the_opponent()
return true
else
if not silent then
print "Black Bart stands still."
end if
return false
end if
end function
function missed_shot() as boolean
return rnd * 10 <= distance / 10
end function
function does_the_opponent_fire_and_kill(strategy as string) as boolean
print "Black Bart fires…"
opponent_bullets -= 1
if missed_shot() then
print "A miss…"
select case opponent_bullets
case 3
print "Whew, were you lucky. That bullet just missed your head."
case 2
print "But Black Bart got you in the right shin."
case 1
print "Though Black Bart got you on the left side of your jaw."
case 0
print "Black Bart must have jerked the trigger."
end select
else
if strategy = "j" then
print "That trick just saved yout life. Black Bart's bullet"
print "was stopped by the wood sides of the trough."
else
print "Black Bart shot you right through the heart that time."
print "You went kickin' with your boots on."
return true
end if
end if
return false
end function
function does_the_opponent_kill_or_run(strategy as string) as boolean
if distance >= 10 or player_bullets = 0 then
if maybe_move_the_opponent(silently) then
return false
end if
end if
if opponent_bullets > 0 then
return does_the_opponent_fire_and_kill(strategy)
else
if player_bullets > 0 then
if random_in_range(0, 1) = 0 then ' 50% chances
print "Now is your chance, Black Bart is out of bullets."
else
print "Black Bart just hi-tailed it out of town rather than face you"
print "without a loaded gun. You can rest assured that Black Bart"
print "won't ever show his face around this town again."
return true
end if
end if
end if
return false
end function
sub print_strategies()
color(INSTRUCTIONS_INK)
print !"\nStrategies:"
print " [A]dvance"
print " [S]tand still"
print " [F]ire"
print " [J]ump behind the watering trough"
print " [G]ive up"
print " [T]urn tail and run"
color(DEFAULT_INK)
end sub
sub play()
distance => INITIAL_DISTANCE
dim watering_troughs as integer => 0
player_bullets => INITIAL_BULLETS
opponent_bullets => INITIAL_BULLETS
do ' showdown
print "You are now " & distance & " paces apart from Black Bart."
print_shells_left()
print_strategies()
dim strategy as string => lcase(get_string("What is your strategy? "))
select case strategy
case "a" ' advance
do
dim paces as integer => get_number("How many paces do you advance? ")
if paces < 0 then
print "None of this negative stuff, partner, only positive numbers."
elseif paces > 10 then
print "Nobody can walk that fast."
else
distance -= paces
exit do
end if
loop
case "s" ' stand still
print "That move made you a perfect stationary target."
case "f" ' fire
if player_bullets = 0 then
print "You don't have any bullets left."
else
player_bullets -= 1
if missed_shot() then
select case player_bullets
case 2
print "Grazed Black Bart in the right arm."
case 1
print "He's hit in the left shoulder, forcing him to use his right"
print "hand to shoot with."
end select
print "What a lousy shot."
if player_bullets = 0 then
print "Nice going, ace, you've run out of bullets."
if opponent_bullets <> 0 then
print "Now Black Bart won't shoot until you touch noses."
print "You better think of something fast (like run)."
end if
end if
else
print "What a shot, you got Black Bart right between the eyes."
press_enter("!\nPress the Enter key to get your reward. ")
cls
get_reward()
exit do ' showdown
end if
end if
case "j" ' jump
if watering_troughs = MAX_WATERING_TROUGHS then
print "How many watering troughs do you think are on this street?"
strategy => ""
else
watering_troughs += 1
print "You jump behind the watering trough."
print "Not a bad maneuver to threw Black Bart's strategy off."
end if
case "g" ' give up
print "Black Bart accepts. The conditions are that he won't shoot you"
print "if you take the first stage out of town and never come back."
if yes("Agreed? ") then
print "A very wise decision."
exit do ' showdown
else
print "Oh well, back to the showdown."
end if
case "t" ' turn tail and run
' The more bullets of the opponent, the less chances to escape.
if random_in_range(0, opponent_bullets + 2) = 0 then
print "Man, you ran so fast even dogs couldn't catch you."
else
select case opponent_bullets
case 0
print "You were lucky, Black Bart can only throw his gun at you, he"
print "doesn't have any bullets left. You should really be dead."
case 1
print "Black Bart fires his last bullet…"
print "He got you right in the back. That's what you deserve, for running."
case 2
print "Black Bart fires and got you twice: in your back"
print "and your ass. Now you can't even rest in peace."
case 3
print "Black Bart unloads his gun, once in your back"
print "and twice in your ass. Now you can't even rest in peace."
case 4
print "Black Bart unloads his gun, once in your back"
print "and three times in your ass. Now you can't even rest in peace."
end select
opponent_bullets => 0
end if
exit do ' showdown
case else
print "You sure aren't going to live very long if you can't even follow directions."
end select ' strategy switch
if does_the_opponent_kill_or_run(strategy) then
exit do
elseif player_bullets + opponent_bullets = 0 then
print "The showdown must end, because nobody has bullets left."
exit do
else
print
end if
loop ' showdown
end sub
' Main {{{1
' ==============================================================================
randomize
cls
print_credits()
press_enter(!"\nPress the Enter key to read the instructions. ")
cls
print_instructions()
press_enter(!"\nPress the Enter key to start. ")
cls
play()
' vim: filetype=freebasic
Math
' Math
' Original version in BASIC:
' Example included in Vintage BASIC 1.0.3.
' http://www.vintage-basic.net
' This version in FreeBASIC:
' Copyright (c) 2026, Marcos Cruz (programandala.net)
' SPDX-License-Identifier: Fair
'
' Written on 2026-09-01.
'
' Last modified: 20260901T1341+0200.
function get_string(prompt as string => "") as string
print prompt;
dim result as string
line input result
return result
end function
function is_sign(character as string) as boolean
assert(len(character) = 1)
return character = "+" orelse character = "-"
end function
function is_digit(character as string) as boolean
assert(len(character) = 1)
return character >= "0" andalso character <= "9"
end function
function is_decimal_point(character as string) as boolean
assert(len(character) = 1)
return character = "."
end function
function is_floating_number(s as string) as boolean
dim as boolean is_decimal_point_found => false
for character_position as integer => 1 to len(s)
dim character as string => mid(s, character_position, 1)
if character_position = 1 then
if is_sign(character) then
elseif is_decimal_point(character) then
if is_decimal_point_found then
return false
else
is_decimal_point_found = true
end if
elseif is_digit(character) then
else
return false
end if
elseif is_digit(character) then
elseif is_decimal_point(character) then
if is_decimal_point_found then
return false
else
is_decimal_point_found = true
end if
else
return false
end if
next
return true
end function
function get_number(prompt as string => "") as double
dim result as double
do
dim s as string => get_string(prompt)
if is_floating_number(s) then
result => val(s)
exit do
else
print "Number expected."
end if
loop
return result
end function
dim n as double => get_number("Enter a number: ")
print "ABS(" & n & ") = "; abs(n)
print "ATN(" & n & ") = "; atn(n)
print "COS(" & n & ") = "; cos(n)
print "EXP(" & n & ") = "; exp(n)
print "INT(" & n & ") = "; int(n)
print "LOG(" & n & ") = "; log(n)
print "SGN(" & n & ") = "; sgn(n)
print "SQR(" & n & ") = "; sqr(n)
print "TAN(" & n & ") = "; tan(n)
' vim: filetype=freebasic
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 FreeBASIC:
Copyright (c) 2026, Marcos Cruz (programandala.net)
SPDX-License-Identifier: Fair
Written on 2026-09-01.
Last modified: 20260902T2310+0200.
'/
const grid_size => 10
const turns => 10
const mugwumps => 4
type mugwump_struct
x as integer
y as integer
hidden as boolean
end type
dim shared mugwump(mugwumps) as mugwump_struct
dim shared found as integer ' counter
function get_string(prompt as string => "") as string
print prompt;
dim result as string
line input result
return result
end function
function is_sign(character as string) as boolean
assert(len(character) = 1)
return character = "+" orelse character = "-"
end function
function is_digit(character as string) as boolean
assert(len(character) = 1)
return character >= "0" andalso character <= "9"
end function
function is_integer(s as string) as boolean
for character_position as integer => 1 to len(s)
dim character as string => mid(s, character_position, 1)
if character_position = 1 then
if not is_sign(character) andalso not is_digit(character) then
return false
end if
elseif not is_digit(character) then
return false
end if
next
return true
end function
function get_number(prompt as string => "") as integer
dim result as integer
do
dim s as string => get_string(prompt)
if is_integer(s) then
result => val(s)
exit do
else
print "Integer expected."
end if
loop
return result
end function
function pressed(prompt as string) as string
dim key as string
print prompt;
do
key => inkey
loop until key <> ""
return key
end function
sub press_enter(prompt as string)
pressed(prompt)
end sub
function is_yes(s as string) as boolean
select case lcase(trim(s))
case "ok", "y", "yeah", "yes"
return true
case else
return false
end select
end function
function is_no(s as string) as boolean
select case lcase(trim(s))
case "n", "no", "nope"
return true
case else
return false
end select
end function
function yes(prompt as string) as boolean
do
var answer => get_string(prompt)
if is_yes(answer) then
return true
end if
if is_no(answer) then
return false
end if
loop
end function
sub print_credits()
cls
print !"Mugwump\n"
print "Original version in BASIC:"
print " Written by Bud Valenti's students of Project SOLO (Pittsburg, Pennsylvania, USA)."
print " Slightly modified by Bob Albrecht of People's Computer Company."
print " Published by Creative Computing (Morristown, New Jersey, USA), 1978."
print " - https://www.atariarchives.org/basicgames/showpage.php?page=114"
print !" - http://vintage-basic.net/games.html\n"
print "This version in FreeBASIC:"
print " Copyright (c) 2026, Marcos Cruz (programandala.net)"
print !" SPDX-License-Identifier: Fair\n"
press_enter("Press Enter to read the instructions. ")
end sub
sub print_instructions()
cls
print !"Mugwump\n"
print "The object of this game is to find four mugwumps"
print "hidden on a 10 by 10 grid. Homebase is position 0,0."
print "Any guess you make must be two numbers with each"
print "number between 0 and 9, inclusive. First number"
print "is distance to right of homebase and second number"
print !"is distance above homebase.\n"
print "You get " & turns & " tries. After each try, you will see"
print !"how far you are from each mugwump.\n"
press_enter("Press Enter to start. ")
end sub
sub hide_mugwumps()
for m as integer => 0 to mugwumps - 1
mugwump(m).x => int(rnd * grid_size)
mugwump(m).y => int(rnd * grid_size)
mugwump(m).hidden => true
next
found => 0 ' counter
end sub
function get_coord(prompt as string) as integer
dim coord as integer
do
coord => get_number(prompt)
if coord < 0 or coord >= grid_size then
print "Invalid value " & coord & ": not in range [0, " & grid_size - 1 & "]."
else
exit do
end if
loop
return coord
end function
function is_here(m as integer, x as integer, y as integer) as boolean
return mugwump(m).hidden andalso mugwump(m).x = x andalso mugwump(m).y = y
end function
function distance(m as integer, x as integer, y as integer) as integer
return int(sqr((mugwump(m).x - x) ^ 2 + (mugwump(m).y - y) ^ 2))
end function
function plural(n as integer, plural_ending as string => "s", singular_ending as string => "") as string
return iif(n > 1, plural_ending, singular_ending)
end function
sub play()
dim x as integer
dim y as integer
dim turn as integer ' counter
do
cls
hide_mugwumps()
for turn as integer => 1 to turns
print "Turn number " & turn & !"\n"
print "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): ")
print !"\nYour guess is (" & x & ", " & y & ")."
for m as integer => 0 to mugwumps - 1
if is_here(m, x, y) then
mugwump(m).hidden => false
found += 1
print "You have found mugwump " & m & "!"
if found = mugwumps then
exit for, for
end if
end if
next
for m as integer => 0 to mugwumps - 1
if mugwump(m).hidden then
print "You are " & distance(m, x, y) & " units from mugwump " & m & "."
end if
next
print
next ' turn
if found = mugwumps then
print "\nYou got them all in " & turn & " turn" & plural(turn) & !"!\n"
print "That was fun! let's play again…"
print "Four more mugwumps are now in hiding."
else
print "Sorry, that's " & turns & " tr" & plural(turns, "ies", "y") & !".\n"
print "Here is where they're hiding:"
for m as integer => 0 to mugwumps - 1
if mugwump(m).hidden then
print "Mugwump " & m & " is at (" & mugwump(m).x & ", " & mugwump(m).y & ")."
end if
next
end if
loop until not yes(!"\nDo you want to play again? ")
end sub
print_credits()
print_instructions()
play()
' vim: filetype=freebasic
Name
' Name
' Original version in BASIC:
' Example included in Vintage BASIC 1.0.3.
' http://www.vintage-basic.net
' This version in FreeBASIC:
' Copyright (c) 2026, Marcos Cruz (programandala.net)
' SPDX-License-Identifier: Fair
'
' Written on 2026-09-01.
'
' Last modified: 20260901T1347+0200.
function get_string(prompt as string => "") as string
print prompt;
dim result as string
line input result
return result
end function
function is_sign(character as string) as boolean
assert(len(character) = 1)
return character = "+" orelse character = "-"
end function
function is_digit(character as string) as boolean
assert(len(character) = 1)
return character >= "0" andalso character <= "9"
end function
function is_integer(s as string) as boolean
for character_position as integer => 1 to len(s)
dim character as string => mid(s, character_position, 1)
if character_position = 1 then
if not is_sign(character) andalso not is_digit(character) then
return false
end if
elseif not is_digit(character) then
return false
end if
next
return true
end function
function get_number(prompt as string => "") as integer
dim result as integer
do
dim s as string => get_string(prompt)
if is_integer(s) then
result => val(s)
exit do
else
print "Integer expected."
end if
loop
return result
end function
dim name_ as string => get_string("What is your name? ")
dim n as integer => get_number("Enter a number: ")
for i as integer => 1 to n
print "Hello, " & name_ & "!"
next
' vim: filetype=freebasic
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 FreeBASIC:
' Copyright (c) 2025, Marcos Cruz (programandala.net)
' SPDX-License-Identifier: Fair
'
' Written on 2025-05-02.
'
' Last modified: 20260902T2310+0200.
const default_ink = 7 ' white
const input_ink = 10 ' bright green
const title_ink = 12 ' bright red
const max_phrases_and_verses = 20
sub print_colored(s as string, c as integer)
color(c)
print s;
color(default_ink)
end sub
function input_string(prompt as string = "") as string
dim s as string
print_colored(prompt, input_ink)
line input s
return s
end function
sub print_credits()
print_colored(!"Poetry\n\n", title_ink)
print "Original version in BASIC:"
print " Unknown author."
print !" Published in \"BASIC Computer Games\","
print !" Creative Computing (Morristown, New Jersey, USA), 1978.\n"
print "This improved remake in Julia:"
print " Copyright (c) 2024, Marcos Cruz (programandala.net)"
print " SPDX-License-Identifier: Fair"
end sub
function is_even(n as integer) as boolean
return (n mod 2) = 0
end function
sub play()
dim action as integer = 0
dim phrase as integer = 0
dim phrases_and_verses as integer = 0
dim verse_chunks as integer = 0
do ' verse loop
dim manage_the_verse_continuation as integer = true
dim maybe_add_comma as integer = true
select case action
case 0, 1
select case phrase
case 0
print "MIDNIGHT DREARY";
case 1
print "FIERY EYES";
case 2
print "BIRD OR FIEND";
case 3
print "THING OF EVIL";
case 4
print "PROPHET";
end select
case 2
select case phrase
case 0
print "BEGUILING ME";
verse_chunks = 2
case 1
print "THRILLED ME";
case 2
print "STILL SITTING…";
maybe_add_comma = false
case 3
print "NEVER FLITTING";
verse_chunks = 2
case 4
print "BURNED";
end select
case 3
select case phrase
case 0
print "AND MY SOUL";
case 1
print "DARKNESS THERE";
case 2
print "SHALL BE LIFTED";
case 3
print "QUOTH THE RAVEN";
case 4 and verse_chunks <> 0
print "SIGN OF PARTING";
end select
case 4
select case phrase
case 0
print "NOTHING MORE";
case 1
print "YET AGAIN";
case 2
print "SLOWLY CREEPING";
case 3
print "…EVERMORE";
case 4
print "NEVERMORE";
end select
case 5
action = 0
print
if phrases_and_verses > max_phrases_and_verses then
print
verse_chunks = 0
phrases_and_verses = 0
action = 2
continue do
else
manage_the_verse_continuation = false
end if
end select
if manage_the_verse_continuation then
sleep(250) ' ms
if maybe_add_comma and not (verse_chunks = 0 or rnd > 0.19) then
print ",";
verse_chunks = 2
end if
if rnd > 0.65 then
print
verse_chunks = 0
else
print " ";
verse_chunks += 1
end if
end if
action += 1
phrase = int(rnd * 5)
phrases_and_verses += 1
if not (verse_chunks > 0 or is_even(action)) then
print " ";
end if
loop ' verse loop
end sub
cls
print_credits()
input_string(!"\nPress the Enter key to start. ")
cls
play()
' vim: filetype=freebasic
Russian Roulette
/'
Russian Roulette
Original version in BASIC:
Creative Computing (Morristown, New Jersey, USA), ca. 1980.
This version in FreeBASIC:
Copyright (c) 2024, Marcos Cruz (programandala.net)
SPDX-License-Identifier: Fair
Written in 2024-11-20/21.
Last modified: 20260901T1348+0200.
'/
sub press_enter_to_start()
dim void as string
input "Press Enter to start. ", void
end sub
sub print_credits()
print !"Russian Roulette\n"
print "Original version in BASIC:"
print !" Creative Computing (Morristown, New Jersey, USA), ca. 1980\n"
print "This version in FreeBASIC:"
print " Copyright (c) 2024, Marcos Cruz (programandala.net)"
print !" SPDX-License-Identifier: Fair\n"
press_enter_to_start()
end sub
sub print_instructions()
print "Here is a revolver."
print "Type 'f' to spin chamber and pull trigger."
print "Type 'g' to give up, and play again."
print !"Type 'q' to quit.\n"
end sub
function play() as boolean
dim times as integer
dim order as string
do ' game loop
cls
print_instructions()
times = 0
do ' play loop
input "> ", order
if order = "f" then ' fire
if 100 * rnd > 83 then
print "Bang! You're dead!"
print "Condolences will be sent to your relatives."
exit do
else
times += 1
if times = 10 then
print "You win!"
print "Let someone else blow his brains out."
exit do
else
print "Click."
end if
end if
elseif order = "g" then ' give up
print "Chicken!"
exit do
elseif order = "q" then ' quit
return false
end if
loop ' play
press_enter_to_start()
loop ' game
return true ' play again, do not quit
end function
cls
print_credits()
do while play()
loop
print "Bye!"
' vim: filetype=freebasic
Seance
/'
Seance
Original version in BASIC:
By Chris Oxlade, 1983.
https://archive.org/details/seance.qb64
https://github.com/chaosotter/basic-games
rhis version in FreeBASIC:
Copyright (c) 2026, Marcos Cruz (programandala.net)
SPDX-License-Identifier: Fair
Written on 2026-05-27.
Last modified: 20260902T0103+0200.
'/
const max_score => 50
const max_message_length => 6
const min_message_length => 3
const base_character => asc("@")
const planchette => "*"
const first_letter_number => 1
const last_letter_number => 26
const bright => 8
' XXX TODO make an `enum`
const black => 0
const dark_grey => bright + black
const blue => 1
const bright_blue => bright + blue
const green => 2
const bright_green => bright + green
const cyan => 3
const bright_cyan => bright + cyan
const red => 4
const bright_red => bright + red
const pink => 5
const bright_pink => bright + pink
const yellow => 6
const bright_yellow => bright + yellow
const grey => 7
const white => bright + grey
const board_ink => bright_cyan
const default_ink => white
const input_ink => bright_green
const instructions_ink => yellow
const mistake_effect_ink => bright_red
const planchette_ink => yellow
const title_ink => bright_red
const mistake_effect_pause => 3000 ' milliseconds
const board_width => 8 ' characters displayed on the top and bottom borders
const board_height => 5 ' characters displayed on the left and right borders
const board_pad => 1 ' blank characters separating the board from its left and right borders
const board_x => 29 ' screen column
const board_y => 5 ' screen line
const board_actual_width => board_width + 2 * board_pad ' screen columns
const board_bottom_y => board_height + 1 ' relative to the board
const input_x => board_x
const input_y => board_y + board_bottom_y + 4
const messages_y => input_y
' Erase from the current cursor position to the end of the line.
sub erase_line_right()
dim current_row as integer => csrlin
dim current_col as integer => pos
dim screen_width as integer => loword(width)
print space(screen_width - current_col);
locate(current_row, current_col)
end sub
sub erase_line_right_from(row as integer, col as integer)
locate(row, col)
erase_line_right()
end sub
sub hide_cursor()
locate(, , 0)
end sub
sub show_cursor()
locate(, , 1)
end sub
sub print_in_color(text as string, color_ as integer)
color color_
print text;
color default_ink
end sub
function typed(prompt as string => "") as string
print_in_color(prompt, input_ink)
dim result as string
line input result
return result
end function
sub pause(prompt as string)
print prompt;
getkey()
end sub
' Return the x coordinate to print the given text centered on the board.
function board_centered_x(text as string) as integer
return int(board_x + (board_actual_width - len(text)) / 2)
end function
sub print_board_centered(text as string, y as integer, color_ as integer => default_ink)
locate(y, board_centered_x(text))
print_in_color(text, color_)
end sub
const title => "Seance"
sub print_title()
print_in_color(title, title_ink)
print
end sub
sub print_credits()
print_title()
print
print "Original version in BASIC:"
print " Written by Chris Oxlade, 1983."
print " https://archive.org/details/seance.qb64"
print " https://github.com/chaosotter/basic-games"
print "This version in FreeBASIC:"
print " Copyright (c) 2026, Marcos Cruz (programandala.net)"
print " SPDX-License-Identifier: Fair"
print
end sub
sub print_instructions()
print_title()
color instructions_ink
print
print "Messages from the Spirits are coming through, letter by letter. They want you"
print "to remember the letters and type them into the computer in the correct order."
print "If you make mistakes, they will be angry -- very angry..."
print
print "Watch for stars on your screen -- they show the letters in the Spirits'"
print "messages."
print
color default_ink
end sub
sub print_character(y as integer, x as integer, s as string, color_ as integer => default_ink)
locate(y + board_y, x + board_x)
print_in_color(s, color_)
end sub
sub print_board()
for x as integer => 1 to board_width
print_character(0, x + 1, chr(base_character + x), board_ink) ' top border
print_character(board_bottom_y, x + 1, chr(base_character + last_letter_number - board_height - x + 1), board_ink) ' bottom border
next
for y as integer => 1 to board_height
print_character(y , 0, chr(base_character + last_letter_number - y + 1), board_ink) ' left border
print_character(y , 3 + board_width, chr(base_character + board_width + y), board_ink) ' right border
next
print
end sub
sub print_mistake_effect(effect as string)
dim x as integer => board_centered_x(effect)
hide_cursor()
locate(messages_y, x)
print_in_color(effect, mistake_effect_ink)
sleep(mistake_effect_pause)
erase_line_right_from(messages_y, x)
show_cursor()
end sub
' Return a random number in the given inclusive range.
function random_in_range(first as integer, last as integer) as integer
return int(rnd * (last - first) + first)
end function
' Return a new message of the given length, after marking its letters on the
' board.
function message(length as integer) as string
dim y as integer => 0
dim x as integer => 0
dim text as string => ""
dim letter_number as integer
dim letter as string
hide_cursor()
for i as integer => 1 to length
letter_number => random_in_range(first_letter_number, last_letter_number)
letter => chr(base_character + letter_number)
text += letter
if letter_number <= board_width then
' top border
y => 1
x => letter_number + 1
elseif letter_number <= board_width + board_height then
' right border
y => letter_number - board_width
x => 2 + board_width
elseif letter_number <= board_width + board_height + board_width then
' bottom border
y => board_bottom_y - 1
x => 2 + board_width + board_height + board_width - letter_number
else
' left border
y => 1 + last_letter_number - letter_number
x => 1
end if
print_character(y, x, planchette, planchette_ink)
sleep(1000)
print_character(y, x, " ")
next
show_cursor()
return text
end function
function message_understood() as string
locate(input_y, input_x)
dim user_input as string => ucase(typed("? "))
erase_line_right_from(input_y, input_x)
return user_input
end function
sub play()
dim score as integer => 0
dim mistakes as integer => 0
dim message_length as integer
dim actual_message as string
print_board_centered(title, 1, title_ink)
print_board()
randomize
do
message_length => random_in_range(min_message_length, max_message_length)
' XXX FIXME somehow calling the `message` function in the `if`
' expression does not execute its code at the expected time; an
' intermediate variable is required:
actual_message => message(message_length)
if actual_message <> message_understood() then
mistakes += 1
select case mistakes
case 1
print_mistake_effect("The table begins to shake!")
case 2
print_mistake_effect("The light bulb shatters!")
case 3
print_mistake_effect("Oh, no! A pair of clammy hands grasps your neck!")
return
end select
else
score += message_length
if score >= max_score then
print_board_centered("Whew! The spirits have gone!", messages_y)
print_board_centered("You live to face another day!", messages_y + 1)
exit do
end if
end if
loop
end sub
cls
print_credits()
pause(!"\nPress any key to read the instructions. ")
cls
print_instructions()
pause(!"\nPress any key to start. ")
cls
play()
print
' vim: filetype=freebasic
Sine Wave
/'
Sine Wave
Original version in BASIC:
Creative Computing (Morristown, New Jersey, USA), ca. 1980.
This version in FreeBASIC:
Copyright (c) 2023, 2024, Marcos Cruz (programandala.net)
SPDX-License-Identifier: Fair
Written in 2023-02, 2024-11.
Last modified 20260901T1055+0200.
'/
cls
print "Sine Wave"
print
print "Original version in BASIC:"
print tab(4);"Creative computing (Morristown, New Jersey, USA), ca. 1980."
print
print "This version in FreeBASIC:"
print tab(4);"Copyright (c) 2023, Marcos Cruz (programandala.net)"
print tab(4);"SPDX-License-Identifier: Fair"
print
print "Press any key to start the program."
sleep
do while inkey <> ""
loop
cls
dim word(0 to 1) as string
input "Enter the first word: ", word(0)
input "Enter the second word: ", word(1)
cls
dim dot as integer = 0
for angle as single = 0 to 40 step .25
print tab(int(26 + 25 * sin(angle)));word(dot and 1)
dot += 1
next angle
' vim: filetype=freebasic
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 FreeBASIC:
' Copyright (c) 2026, Marcos Cruz (programandala.net)
' SPDX-License-Identifier: Fair
'
' Written in 2026-05-27/28.
'
' Last modified: 20260902T2304+0200.
' Config {{{1
' ==============================================================================
const reels => 3
const images => 6
const min_bet => 1
const max_bet => 100
dim shared image(images) as string
for i as integer => 0 to images - 1
read image(i)
next
data " BAR ", " BELL ", "ORANGE", "LEMON ", " PLUM ", "CHERRY"
const bar_position => 0 ' position of "BAR" in `image`.
dim shared reel(reels) as integer
' Terminal {{{1
' ==============================================================================
const bright => 8 ' color modifier
const black => 0
const dark_grey => bright + black
const blue => 1
const green => 2
const cyan => 3
const red => 4
const pink => 5
const yellow => 6
const grey => 7
const white => bright + grey
const default_ink => white
sub hide_cursor()
locate(, , 0)
end sub
sub show_cursor()
locate(, , 1)
end sub
' User Input {{{1
' ==============================================================================
function typed(prompt as string => "") as string
print prompt;
dim result as string
line input result
return result
end function
function pressed(prompt as string) as string
dim key as string
print prompt;
do
key => inkey
loop until key <> ""
return key
end function
sub pause(prompt as string)
pressed(prompt)
end sub
' Credits and instructions {{{1
' ==============================================================================
sub print_credits()
cls
print "Slots"
print !"A slot machine simulation.\n"
print "Original version in BASIC:"
print " Creative computing (Morristown, New Jersey, USA)."
print !" Produced by Fred Mirabelle and Bob Harper on 1973-01-29.\n"
print "This version in FreeBASIC:"
print " Copyright (c) 2026, Marcos Cruz (programandala.net)"
print !" SPDX-License-Identifier: Fair\n"
pause("Press any key for instructions. ")
end sub
sub print_instructions()
cls
print "You are in the H&M casino, in front of one of our one-arm bandits."
print "Bet from " & min_bet & " to " & max_bet & !" USD (or 0 to quit).\n"
pause("Press any key to start. ")
end sub
' Main {{{1
' ==============================================================================
const prize_1 => 100
const prize_2 => 10
const prize_3 => 5
const prize_4 => 2
function won(prize as integer, bet as integer) as integer
select case prize
case prize_4
print "DOUBLE!"
case prize_3
print "*DOUBLE BAR*"
case prize_2
print "**TOP DOLLAR**"
case prize_1
print "***JACKPOT***"
end select
print "You won!"
return (prize + 1) * bet
end function
sub show_standings(usd as integer)
print !"\nYour standings are " & usd & " USD."
end sub
dim shared color_(images) as integer => _
{white, cyan, yellow, bright + yellow, bright + white, bright + red}
sub print_reels()
locate(1, 1)
for r as integer => 0 to reels - 1
color(color_(reel(r)))
print "[" + image(reel(r)) + "] ";
next
color(default_ink)
print
end sub
sub init_reels()
for r as integer => 0 to reels - 1
reel(r) => cast(integer, rnd * (images - 1))
next
end sub
sub spin_reels()
const seconds => 2
dim start as double => timer
hide_cursor()
do
init_reels()
print_reels()
loop until (timer - start) > seconds
show_cursor()
end sub
type prize_type
equals as integer
bars as integer
end type
function max(n1 as integer, n2 as integer) as integer
if n1 > n2 then
return n1
else
return n2
end if
end function
function prize() as prize_type
dim result as prize_type
dim count as integer
for i as integer => 0 to images - 1
count => 0
for r as integer => 0 to reels - 1
count += abs(reel(r) = i)
next
result.equals => max(result.equals, count)
next
for r as integer => 0 to reels - 1
result.bars += abs(reel(r) = bar_position)
next
return result
end function
sub play()
randomize
dim standings as integer => 0
dim equals as integer => 0
dim bars as integer => 0
init_reels()
dim betting as boolean => true
dim playing as boolean => true
dim the_prize as prize_type
dim bet as integer
do while playing
bet => 0
do while playing andalso betting
cls
print_reels()
bet => valint(typed("Your bet (or 0 to quit): "))
if bet > max_bet then
print "House limits are " & max_bet & " USD."
pause("Press any key to try again. ")
elseif bet < min_bet then
if lcase(pressed("Press ""q"" to confirm you want to quit. ")) = "q" then
playing => false
betting => false
end if
else
betting => false
end if
loop
if playing then
cls
spin_reels()
the_prize => prize()
select case the_prize.equals
case reels
if the_prize.bars = reels then
standings += won(prize_1, bet)
else
standings += won(prize_2, bet)
end if
case reels - 1
if the_prize.bars = 2 then
standings += won(prize_3, bet)
else
standings += won(prize_4, bet)
end if
case else
print "You lost."
standings -= bet
end select
show_standings(standings)
pause("Press any key to continue. ")
betting => true
end if
loop ' playing
show_standings(standings)
if standings < 0 then
print "Pay up! Please leave your money on the terminal."
elseif standings = 0 then
print "Hey, you broke even."
elseif standings > 0 then
print "Collect your winnings from the H&M cashier."
end if
end sub
print_credits()
print_instructions()
play()
' vim: filetype=freebasic
Stars
' Stars
' Original version in BASIC:
' Example included in Vintage BASIC 1.0.3.
' http://www.vintage-basic.net
' This version in FreeBASIC:
' Copyright (c) 2026, Marcos Cruz (programandala.net)
' SPDX-License-Identifier: Fair
'
' Written on 2026-09-01.
'
' Last modified: 20260902T2310+0200.
function get_string(prompt as string => "") as string
print prompt;
dim result as string
line input result
return result
end function
function is_sign(character as string) as boolean
assert(len(character) = 1)
return character = "+" orelse character = "-"
end function
function is_digit(character as string) as boolean
assert(len(character) = 1)
return character >= "0" andalso character <= "9"
end function
function is_integer(s as string) as boolean
for character_position as integer => 1 to len(s)
dim character as string => mid(s, character_position, 1)
if character_position = 1 then
if not is_sign(character) andalso not is_digit(character) then
return false
end if
elseif not is_digit(character) then
return false
end if
next
return true
end function
function get_number(prompt as string => "") as integer
dim result as integer
do
dim s as string => get_string(prompt)
if is_integer(s) then
result => val(s)
exit do
else
print "Integer expected."
end if
loop
return result
end function
function is_yes(s as string) as boolean
select case lcase(trim(s))
case "ok", "y", "yeah", "yes"
return true
case else
return false
end select
end function
dim name_ as string => get_string("What is your name? ")
print "Hello, " & name_
do
dim n as integer => get_number("How many stars do you want? ")
print string(n, "*")
loop until not is_yes(get_string("Do you want more stars? "))
print "Goobye " & name_
' vim: filetype=freebasic
Strings
' Strings
' Original version in BASIC:
' Example included in Vintage BASIC 1.0.3.
' http://www.vintage-basic.net
' This version in FreeBASIC:
' Copyright (c) 2026, Marcos Cruz (programandala.net)
' SPDX-License-Identifier: Fair
'
' Written on 2026-09-01.
'
' Last modified: 20260901T1349+0200.
function get_string(prompt as string => "") as string
print prompt;
dim result as string
line input result
return result
end function
function is_sign(character as string) as boolean
assert(len(character) = 1)
return character = "+" orelse character = "-"
end function
function is_digit(character as string) as boolean
assert(len(character) = 1)
return character >= "0" andalso character <= "9"
end function
function is_integer(s as string) as boolean
for character_position as integer => 1 to len(s)
dim character as string => mid(s, character_position, 1)
if character_position = 1 then
if not is_sign(character) andalso not is_digit(character) then
return false
end if
elseif not is_digit(character) then
return false
end if
next
return true
end function
function get_number(prompt as string => "") as integer
dim result as integer
do
dim s as string => get_string(prompt)
if is_integer(s) then
result => val(s)
exit do
else
print "Integer expected."
end if
loop
return result
end function
dim a as string => get_string("Enter a string: ")
dim n as integer => get_number("Enter a number: ")
print !"ASC(\"" & a & !"\") --> ";
print !"asc(\"" & a & !"\") --> " & asc(a)
print "CHR$(" & n & ") --> ";
print "chr(" & n & !") --> \"" & chr(n) & !"\""
print !"LEFT$(\"" & a & !"\", " & n & ") --> ";
print !"left(\"" & a & !"\", " & n & ") --> " & left(a, n)
print !"MID$(\"" & a & !"\", " & n & ") --> ";
print !"mid(\"" & a & !"\", " & n & ") --> " & mid(a, n)
print !"MID$(\"" & a & !"\", " & n & ", 3) --> ";
print !"mid(\"" & a & !"\", " & n & ", 3) --> " & mid(a, n, 3)
print !"RIGHT$(\"" & a & !"\", " & n & ") --> ";
print !"right(\"" & a & !"\", " & n & ") --> " & right(a, n)
print !"LEN(\"" & a & !"\") --> ";
print !"len(\"" & a & !"\") --> " & len(a)
print !"VAL(\"" & a & !"\") --> ";
print !"val(\"" & a & !"\") --> " & val(a)
print "STR$(" & n & ") --> ";
print "str(" & n & !") --> \"" & str(n) & !"\""
print "SPC(" & n & ") --> ";
print "space(" & n & !") --> \"" & space(n) & !"\""
' vim: filetype=freebasic
Xchange
/'
Xchange
Original version in BASIC:
Written by Thomas C. McIntire, 1979.
Published in "The A to Z Book of Computer Games", 1979.
https://archive.org/details/The_A_to_Z_Book_of_Computer_Games/page/n269/mode/2up
https://github.com/chaosotter/basic-games
This improved remake in FreeBASIC:
Copyright (c) 2026, Marcos Cruz (programandala.net)
SPDX-License-Identifier: Fair
Written in 2026-09-01/02.
Last modified: 20260902T1457+0200.
'/
' Terminal {{{1
' =============================================================
const bright as integer => 8
' XXX TODO make an `enum`
const black as integer => 0
const dark_grey as integer => bright + black
const blue as integer => 1
const bright_blue as integer => bright + blue
const green as integer => 2
const bright_green as integer => bright + green
const cyan as integer => 3
const bright_cyan as integer => bright + cyan
const red as integer => 4
const bright_red as integer => bright + red
const pink as integer => 5
const bright_pink as integer => bright + pink
const yellow as integer => 6
const bright_yellow as integer => bright + yellow
const grey as integer => 7
const white as integer => bright + grey
function screen_height() as integer
return hiword(width)
end function
function screen_width() as integer
return loword(width)
end function
const first_column as integer => 1
sub erase_current_line_right()
print space(screen_width() - pos + first_column);
end sub
sub erase_line(y as integer)
locate(y, first_column)
print space(screen_width());
end sub
sub erase_screen_down()
for y as integer => csrlin to screen_height()
erase_line(y)
next
end sub
' Globals {{{1
' =============================================================
const board_ink as integer => bright_cyan
const default_ink as integer => white
const input_ink as integer => bright_green
const instructions_ink as integer => yellow
const title_ink as integer => bright_red
const blank as string => "*"
const grid_height as integer => 3 ' rows
const grid_width as integer => 3 ' columns
const cells as integer => grid_width * grid_height
const first_cell as integer => 1
const last_cell as integer => cells
dim shared pristine_grid(first_cell to cells) as string
const grids_y as integer => 3 ' row where the grids are printed
const grids_x as integer => 5 ' column where the left grid is printed
const cells_gap as integer => 2 ' distance between the grid cells
const grids_gap as integer => 16 ' distance between equivalent cells of the grids
const first_player as integer => 1
const max_players as integer => 4
dim shared players as integer
dim shared last_player as integer
dim shared grid(first_player to max_players, first_cell to cells) as string
dim shared is_playing(first_player to max_players) as boolean
const quit_command as string => "X"
' User input {{{1
' =============================================================
function get_string(prompt as string => "") as string
color(input_ink)
print prompt;
dim result as string
line input result
color(default_ink)
return result
end function
function is_sign(character as string) as boolean
assert(len(character) = 1)
return character = "+" orelse character = "-"
end function
function is_digit(character as string) as boolean
assert(len(character) = 1)
return character >= "0" andalso character <= "9"
end function
function is_integer(s as string) as boolean
for character_position as integer => 1 to len(s)
dim character as string => mid(s, character_position, 1)
if character_position = 1 then
if not is_sign(character) andalso not is_digit(character) then
return false
end if
elseif not is_digit(character) then
return false
end if
next
return true
end function
function get_number(prompt as string => "") as integer
dim result as integer
do
dim s as string => get_string(prompt)
if is_integer(s) then
result => val(s)
exit do
else
print "Integer expected."
end if
loop
return result
end function
function pressed(prompt as string) as string
dim key as string
print prompt;
do
key => inkey
loop until key <> ""
return key
end function
sub press_enter(prompt as string)
pressed(prompt)
end sub
function is_yes(s as string) as boolean
select case lcase(trim(s))
case "ok", "y", "yeah", "yes"
return true
case else
return false
end select
end function
function is_no(s as string) as boolean
select case lcase(trim(s))
case "n", "no", "nope"
return true
case else
return false
end select
end function
function yes(prompt as string) as boolean
do
dim answer as string => get_string(prompt)
if is_yes(answer) then
return true
end if
if is_no(answer) then
return false
end if
loop
end function
' Title, instructions and credits {{{1
' =============================================================
sub print_title()
color(title_ink)
print "Xchange"
color(default_ink)
end sub
sub print_credits()
print_title()
print !"\nOriginal version in BASIC:"
print " Written by Thomas C. McIntire, 1979."
print !" Published in \"The A to Z Book of Computer Games\", 1979."
print " https://archive.org/details/The_A_to_Z_Book_of_Computer_Games/page/n269/mode/2up"
print " https://github.com/chaosotter/basic-games"
print "This improved remake in FreeBASIC:"
print " Copyright (c) 2026, Marcos Cruz (programandala.net)"
print " SPDX-License-Identifier: Fair"
end sub
sub print_instructions()
print_title()
color(instructions_ink)
print !"\nOne or two may play. If two, you take turns. A grid looks like this:\n"
color(board_ink)
print " F G D"
print " A H " & blank
print !" E B C\n"
color(instructions_ink)
print !"But it should look like this:\n"
color(board_ink)
print " A B C"
print " D E F"
print " G H " & blank & !"\n"
color(instructions_ink)
print "You may exchange any one letter with the '" & blank & "', but only one that's adjacent:"
print "above, below, left, or right. Not all puzzles are possible, and you may enter"
print "'" & quit_command & !"' to give up.\n"
print "Here we go…"
color(default_ink)
end sub
' Grids {{{1
' =============================================================
sub print_grid_title(player as integer)
locate(grids_y, grids_x + ((player - first_player) * grids_gap))
print "Player " & player;
end sub
sub locate_at_cell(player as integer, cell as integer)
dim cell_y_in_grid as integer => (cell - first_cell) \ grid_height
dim cell_x_in_grid as integer => (cell - first_cell) mod grid_width
dim title_gap as integer => iif(players > 1, 2, 0)
locate _
grids_y + title_gap + cell_y_in_grid, _
grids_x + (cells_gap * cell_x_in_grid) + (grids_gap * (player - first_player))
end sub
function grid_prompt_y(player as integer) as integer
dim grid_y as integer => cells / grid_height
dim title_margin as integer => iif(players > 1, 2, 0)
return grids_y + title_margin + grid_y + 1
end function
function grid_prompt_x(player as integer) as integer
dim grid_x as integer => cells mod grid_width
return grids_x + (grid_x * cells_gap) + ((player - first_player) * grids_gap)
end function
sub locate_at_grid_prompt(player as integer)
locate(grid_prompt_y(player), grid_prompt_x(player))
end sub
sub print_grid(player as integer, color_ as integer => board_ink)
if players > 1 then
print_grid_title(player)
end if
color(color_)
for cell as integer => first_cell to last_cell
locate_at_cell(player, cell)
print grid(player, cell);
next
color(default_ink)
end sub
sub print_grids()
for player as integer => first_player to players
if is_playing(player) then
print_grid(player)
end if
next
print
erase_screen_down()
end sub
sub scramble_grid(player as integer)
for cell as integer => first_cell to last_cell
dim random_cell as integer => int(rnd * cells + first_cell)
swap grid(player, cell), grid(player, random_cell)
next
end sub
sub make_grid_pristine(player as integer)
for cell as integer => first_cell to last_cell
grid(player, cell) => pristine_grid(cell)
next
end sub
sub copy_grid(from_player as integer, to_player as integer)
for cell as integer => first_cell to last_cell
grid(to_player, cell) => grid(from_player, cell)
next
end sub
sub init_grids()
make_grid_pristine(first_player)
scramble_grid(first_player)
for player as integer => first_player + 1 to last_player
copy_grid(first_player, player)
next
end sub
' Messages {{{1
' =============================================================
function player_prefix(player as integer) as string
return iif(players > 1, "Player " & player & ": ", "")
end function
sub locate_at_message(player as integer, y_inc as integer => 0)
locate(grid_prompt_y(player) + 2 + y_inc, 1)
end sub
sub print_message(message as string, player as integer, y_inc as integer => 0)
locate_at_message(player)
print player_prefix(player) & message;
erase_current_line_right()
print
end sub
sub erase_message(player as integer)
locate_at_message(player)
erase_current_line_right()
end sub
' Game loop {{{1
' =============================================================
function players_range_message() as string
return iif(max_players = 2, "1 or 2", "from 1 to " & max_players)
end function
sub set_number_of_players()
print_title()
print
if max_players = 1 then
players => 1
else
do
players => get_number("Number of players (" & players_range_message() & "): ")
loop until players >= first_player and players <= max_players
end if
last_player => players
end sub
function is_first_cell_of_a_grid_row(cell as integer) as boolean
return cell mod grid_width = first_cell
end function
function is_last_cell_of_a_grid_row(cell as integer) as boolean
return (cell + first_cell) mod grid_width = first_cell
end function
function are_cells_adjacent(cell_1 as integer, cell_2 as integer) as boolean
return _
((cell_2 = cell_1 + 1) and (not is_first_cell_of_a_grid_row(cell_2))) _
orelse (cell_2 = cell_1 + grid_width) _
orelse ((cell_2 = cell_1 - 1) and (not is_last_cell_of_a_grid_row(cell_2))) _
orelse (cell_2 = cell_1 - grid_width)
end function
' Is the given player's target cell valid, i.e. is it adjacent to the blank
' one? If so, set the blank cell of the grid and return `true`; otherwise
' return `false`.
function is_legal_move _
( _
player as integer, _
target_cell as integer, _
byref blank_cell as integer _
) as boolean
const nowhere as integer => -1
for cell as integer => first_cell to last_cell
if grid(player, cell) = blank then
if are_cells_adjacent(target_cell, cell) then
blank_cell = cell
return true
else
exit for
end if
end if
next
print_message(!"Illegal move \"" & grid(player, target_cell) & !"\".", player)
blank_cell = nowhere
return false
end function
' If the given player's command is valid, i.e. a grid character, set its target
' cell position in the grid and return `true`; otherwise print an error message
' and return `false`.
function is_valid_command _
( _
player as integer, _
command_ as string, _
byref target_cell as integer _
) as boolean
assert(len(command_) = 1)
const nowhere as integer => -1
if command_ <> blank then
for cell as integer => first_cell to last_cell
dim cell_content as string => grid(player, cell)
if cell_content = command_ then
target_cell => cell
return true
end if
next
end if
print_message(!"Invalid character \"" & command_ & !"\".", player)
target_cell = nowhere
return false
end function
sub forget_player(player as integer)
is_playing(player) => false
print_grid(player, default_ink)
end sub
sub do_play_turn(player as integer)
dim target_cell as integer
dim blank_cell as integer
do
dim command_ as string
do
erase_line(grid_prompt_y(player))
locate_at_grid_prompt(player)
command_ => ucase(trim(get_string("Move: ")))
if command_ = quit_command then
forget_player(player)
return
end if
loop until is_valid_command(player, command_, target_cell)
loop until is_legal_move(player, target_cell, blank_cell)
erase_message(player)
grid(player, blank_cell) => grid(player, target_cell)
grid(player, target_cell) => blank
end sub
sub play_turn(player as integer)
if is_playing(player) then
do_play_turn(player)
end if
end sub
sub play_turns()
for player as integer => first_player to last_player
play_turn(player)
next
end sub
function is_someone_playing() as boolean
for player as integer => first_player to last_player
if is_playing(player) then
return true
end if
next
return false
end function
function is_grid_pristine(player as integer) as boolean
for cell as integer => first_cell to last_cell
if grid(player, cell) <> pristine_grid(cell) then
return false
end if
next
return true
end function
' If someone has won print a message for every winner and return `true`;
' otherwise just return `false`.
function has_someone_won() as boolean
dim winners as integer => 0
for player as integer => first_player to last_player
if is_playing(player) then
if is_grid_pristine(player) then
winners += 1
if winners > 0 then
print_message( _
"You're the winner" & iif(winners > 1, ", too!", "!"), _
player, _
winners - 1)
end if
end if
end if
next
return winners > 0
end function
sub init_game()
cls
set_number_of_players()
for player as integer => first_player to last_player
is_playing(player) => true
next
cls
print_title()
init_grids()
print_grids()
end sub
sub play()
init_game()
do while is_someone_playing()
play_turns()
print_grids()
if has_someone_won() then
exit do
end if
loop
end sub
' Main {{{1
' =============================================================
sub init_pristine_grid()
const first_char_code as integer => asc("A")
for cell as integer => first_cell to last_cell - 1
pristine_grid(cell) => chr(first_char_code + cell - first_cell)
next
pristine_grid(last_cell) => blank
end sub
sub init_once()
randomize
init_pristine_grid()
end sub
function enough() as boolean
locate_at_grid_prompt(first_player)
return not yes("Another game? ")
end function
init_once()
cls
print_credits()
press_enter(!"\nPress the Enter key to read the instructions. ")
cls
print_instructions()
press_enter(!"\nPress the Enter key to start. ")
do
play()
loop until enough()
print "So long…"
' vim: filetype=freebasic
Z-End
' Z-End
' Original version in BASIC:
' A to Z Book of Computer Games, by Thomas C. McIntire, 1979.
' - https://archive.org/details/A_to_Z_Book_of_Computer_Games_1979_Thomas_C_McIntire/page/n293/mode/2up
' - https://github.com/chaosotter/basic-games/tree/master/games/A%20to%20Z%20Book%20of%20Computer%20Games/Z-End
' This version in FreeBASIC:
' Copyright (c) 2026, Marcos Cruz (programandala.net)
' SPDX-License-Identifier: Fair
'
' Written in 2026-09-03/04.
'
' Last modified: 20260904T0024+0200.
const bright as integer => 8
' XXX TODO make an `enum`
const black as integer => 0
const dark_grey as integer => bright + black
const blue as integer => 1
const green as integer => 2
const cyan as integer => 3
const red as integer => 4
const pink as integer => 5
const magenta as integer => bright + pink
const yellow as integer => 6
const grey as integer => 7
const white as integer => bright + grey
const default_ink as integer => white
const alphabet_ink as integer => magenta
const input_ink as integer => bright + green
const instructions_ink as integer => yellow
const title_ink as integer => red
function get_string(prompt as string) as string
dim typed as string
color(input_ink)
print prompt;
line input typed
color(default_ink)
return typed
end function
function is_sign(character as string) as boolean
assert(len(character) = 1)
return character = "+" orelse character = "-"
end function
function is_digit(character as string) as boolean
assert(len(character) = 1)
return character >= "0" andalso character <= "9"
end function
function is_integer(s as string) as boolean
for character_position as integer => 1 to len(s)
dim character as string => mid(s, character_position, 1)
if character_position = 1 then
if not is_sign(character) andalso not is_digit(character) then
return false
end if
elseif not is_digit(character) then
return false
end if
next
return true
end function
function get_number(prompt as string => "") as integer
dim number as integer
do
dim s as string => get_string(prompt)
if is_integer(s) then
number => val(s)
exit do
else
print "Integer expected."
end if
loop
return number
end function
function is_yes(answer as string) as boolean
select case lcase(trim(answer))
case "ok", "y", "yeah", "yes"
return true
case else
return false
end select
end function
enum player_id explicit
computer
human
end enum
sub print_rules()
cls
color(title_ink)
print !"Z-End\n"
dim answer as string => get_string("Skip the rules? (Y/N) ")
if not is_yes(answer) then
color(instructions_ink)
print
print "I'll print the alphabet, and you're first. You type the number of letters"
print "that I should omit next time. We take turns, and the limit per turn is five."
print "The one that gets the 'Z' is the loser, and that's Z-End!"
print
print "Good luck, cuz I'm clever..."
color(default_ink)
end if
print
end sub
function random_in_inclusive_range(first as integer, last as integer) as integer
return int(rnd * (last - first) + first)
end function
const alphabet as string => "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
dim shared first_letter as integer => 1
function computer_pick() as integer
dim picked as integer
dim remaining_letters as integer => len(alphabet) - first_letter + 1
if remaining_letters < 6 then
picked => remaining_letters - 1
elseif remaining_letters > 10 then
picked => random_in_inclusive_range(1, 5)
else
picked => 1
end if
print "My pick is " & picked & "."
return picked
end function
function human_pick() as integer
dim picked as integer
do
picked => get_number("Your turn (1-5) ")
if picked < 1 or picked > 5 then
print "Illegal entry -- must be in range 1 to 5!"
else
exit do
end if
loop
return picked
end function
function game_over() as boolean
return first_letter = len(alphabet)
end function
sub print_alphabet(omitted_letters as integer => 0)
first_letter += omitted_letters
color(alphabet_ink)
print mid(alphabet, first_letter)
print
color(default_ink)
end sub
sub print_result(player as player_id)
print "Z-End -- ";
select case player
case player_id.computer
print "Ha ha!"
case player_id.human
print "Oops!"
end select
end sub
function pick(player as player_id) as integer
select case player
case player_id.computer
return computer_pick()
case player_id.human
return human_pick()
end select
end function
function playing(player as player_id) as boolean
print_alphabet(pick(player))
if game_over() then
print_result(player)
end if
return not game_over()
end function
sub play()
first_letter => 1
print_alphabet()
do while playing(player_id.human) andalso playing(player_id.computer)
loop
end sub
function again() as boolean
print
dim answer as string => get_string("Do it again (Y/N) ")
return is_yes(answer)
end function
print_rules()
do
play()
loop while again()
print !"\nGoodbye."
' vim: filetype=freebasic