Basics of FreeBASIC
Descrition del contenete del págine
Conversion de old BASIC-programas a FreeBASIC por aprender lu elementari de ti-ci lingue.
Etiquettes:
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: 20241120T2343+0100.
'/
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: 20250509T1728+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
' Return `true` if any of the given numbers is repeated; otherwise return
' `false`.
'
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
' Return `true` if the given string is "yes" or a synonym.
'
function is_yes(s as string) as boolean
select case lcase(s)
case "ok", "y", "yeah", "yes"
return true
case else
return false
end select
end function
' Return `true` if the given string is "no" or a synonym.
'
function is_no(s as string) as boolean
select case lcase(s)
case "n", "no", "nope"
return true
case else
return false
end select
end function
' Print the given prompt, wait until the user enters a valid yes/no string,
' and return `true` for "yes" or `false` for "no".
'
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
' Init and run the game loop.
'
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
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: 20250505T2350+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
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: 20241120T1840+0100.
'/
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
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: 20250503T1904+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 while TRUE ' 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: 20250505T2350+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 while TRUE ' game loop
cls
print_instructions()
times = 0
do while TRUE ' 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: 20260527T1748+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
'' Erase from the given cursor position to the end of the line.
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
'' Print the given prompt and wait until the user enters a string.
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
'' Print the given text on the given row, centered on the board, with the given
'' or default color.
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
'' Print the given mistake effect, wait a configured number of milliseconds and
'' finally erase it.
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
'' Accept a string from the user, erase it from the screen and return it.
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!")
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 20250505T2350+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