Basics of FreeBASIC
Descripción del contenido de la página
Conversión de antiguos programas de BASIC a FreeBASIC para aprender los rudimentos de este lenguaje.
Etiquetas:
3D Plot
/'
3D Plot
Original version in BASIC:
Creative Computing (Morristown, New Jersey, USA), ca. 1980.
This version in 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
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