Basics of 8th
Descripción del contenido de la página
Conversión de antiguos programas de BASIC a 8th para aprender los rudimentos de este lenguaje.
Etiquetas:
Bunny
\ Bunny
\ Original version in BASIC:
\ Anonymous, 1978.
\ Creative Computing's BASIC Games.
\ - http://vintage-basic.net/games.html
\ - http://vintage-basic.net/bcg/bunny.bas
\ - http://www.retroarchive.org/cpm/games/ccgames.zip
\ This version in 8th:
\ Copyright (c) 2023, Marcos Cruz (programandala.net)
\ SPDX-License-Identifier: Fair
\ Written in 2023-03-11/12, 2023-08-31.
\ Last modified 20251204T2247+0100.
13 constant enter_key_code
: press_enter \ --
repeat con:key enter_key_code n:= until! ;
\ Wait for the Enter key be pressed.
: print_credits \ --
con:cls
"Bunny\n\n" .
"Original version in BASIC:\n" .
" Creative Computing (Morristown, New Jersey, USA), 1978.\n\n" .
"This version in 8th:\n" .
" Copyright (c) 2023, Marcos Cruz (programandala.net)\n" .
" SPDX-License-Identifier: Fair\n\n" .
"Press Enter to start the program.\n" .
press_enter ;
\ Clear the screen, print the credits and wait for a keypress.
"BUNNY" constant letter
letter s:len constant letters
-1 constant EOL
depth >r
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
depth r> - dup constant data_len \ number of data
a:close var, data \ make array out of data in stack
0 var, d \ data index
: next_datum \ -- n|null
data @ d @ a:@ nip
d @ n:1+ d ! ;
\ Return the next element _n_ from the `data` array;
\ if there are no elements left, return `null` instead.
: tab \ col --
con:getxy drop swap con:gotoxy ;
\ Set the console cursor position to column _col_ of the current row.
: print_letter \ col --
letters n:mod letter swap s:@ putc drop ;
\ Print the letter from the `letter` string correspondent to column _col_.
: draw \ --
con:cls
repeat
next_datum null? if
2drop break
else
dup EOL n:= if
drop cr
else
n:1+ dup >r tab \ set column position
r> next_datum n:1+ ' print_letter -rot loop \ print letters
then
then
again ;
\ Draw the graphic out of the `data` array and the `letter` string.
: app:main \ --
print_credits draw ;
Diamond
\ Diamond
\ Original version in BASIC:
\ Example included in Vintage BASIC 1.0.3.
\ http://www.vintage-basic.net
\ This version in 8th:
\ Copyright (c) 2023, Marcos Cruz (programandala.net)
\ SPDX-License-Identifier: Fair
\ Written on 2023-03-09.
\ Last modified 20251204T2247+0100.
17 constant lines
: star \ --
"*" . ;
\ Print a star.
: diamond_top \ n --
>r ' space 1 lines 1 n:+ 2 / r@ n:- 1 + loop
' star 1 r> 2 * 1 n:- loop cr ;
\ Print the diamond top part, _n_ lines high.
: diamond_bottom \ n --
>r ' space 1 r@ 1 n:+ loop
' star 1 lines 1 + 2 / r> n:- 2 * 1 n:- loop cr ;
\ Print the diamond bottom part, _n_ lines high.
: app:main \ --
' diamond_top 1 lines 2 / 1 + loop
' diamond_bottom 1 lines 2 / loop ;
Math
\ Math
\ Original version in BASIC:
\ Example included in Vintage BASIC 1.0.3.
\ http://www.vintage-basic.net
\ This version in 8th:
\ Copyright (c) 2023, Marcos Cruz (programandala.net)
\ SPDX-License-Identifier: Fair
\ Written on 2023-03-09.
\ Last modified 20251204T2247+0100.
32 constant number_max_len
: input \ -- n
null
repeat drop
"Enter a number" .
number_max_len null con:accept >n
null? while! ;
\ Ask the user to enter a number. If the entry cannot be converted to a number,
\ ask again.
: function \ n w s --
. "(" . 2 pick . ") = " . w:exec . cr ;
\ Print the BASIC function in string _s_ and its result, which is obtained
\ by executing word _w_ with parameter _n_.
: app:main \ --
input
dup ' n:abs "ABS" function
dup ' n:atan "ATN" function
dup ' n:cos "COS" function
dup ' n:exp "EXP" function
dup ' n:int "INT" function
dup ' n:ln "LOG" function
dup ' n:sgn "SGN" function
dup ' n:sqrt "SQR" function
' n:tan "TAN" function
;
Name
\ Name
\ Original version in BASIC:
\ Example included in Vintage BASIC 1.0.3.
\ http://www.vintage-basic.net
\ This version in 8th:
\ Copyright (c) 2023, Marcos Cruz (programandala.net)
\ SPDX-License-Identifier: Fair
\ Written on 2023-03-09.
\ Last modified 20231103T2334+0100.
64 constant entry_max_len
: input_number \ -- n
null
repeat drop
"Enter a number" .
entry_max_len null con:accept >n
null? while! ;
\ Ask the user to enter a number. If the entry cannot be converted to a number,
\ ask again.
: input_name \ -- s
null
repeat drop
"What is your name?" .
entry_max_len null con:accept
s:len 0 = while! ;
\ Ask the user to enter a name. If the entry is empty, ask again.
: app:main \ --
input_name
input_number
repeat
"Hello, " . over . "!" . cr
n:1- while
2drop ;
Sine Wave
\ Sine Wave
\ Original version in BASIC:
\ Anonymous, 1978.
\ Creative Computing's BASIC Games.
\ - https://www.atariarchives.org/basicgames/showpage.php?page=146
\ - http://vintage-basic.net/games.html
\ - http://vintage-basic.net/bcg/sinewave.bas
\ - http://www.retroarchive.org/cpm/games/ccgames.zip
\ This version in 8th:
\ Copyright (c) 2023, Marcos Cruz (programandala.net)
\ SPDX-License-Identifier: Fair
\ Written in 2023-03, 2023-09.
\ Last modified 20251204T2247+0100.
needs console/loaded
13 constant enter_key_code
: press_enter \ --
repeat con:key enter_key_code n:= until! ;
\ Wait for the Enter key be pressed.
var word0
var word1
32 constant max_word_len
: get_words \ --
con:cls
"Enter the first word: " .
max_word_len null con:accept word0 !
"Enter the second word: " .
max_word_len null con:accept word1 ! ;
\ Clear the screen, ask the user to enter two words and store them.
: print_credits \ --
con:cls
"Sine Wave\n\n" .
"Original version in BASIC:\n" .
" Creative computing (Morristown, New Jersey, USA), ca. 1980.\n\n" .
"This version in 8th:\n" .
" Marcos Cruz (programandala.net), 2023.\n\n" .
"Press Enter to start the program.\n" .
press_enter ;
\ Clear the screen, print the credits and wait for a keypress.
\ Print _n_ spaces.
: spaces \ n --
repeat space n:1- while drop ;
var even \ flag used to select the word
: draw \ --
con:cls
true even !
0.0 \ angle
repeat
dup n:sin 25.0 * 26.0 + n:int spaces
even @ dup if word0 else word1 then @ . cr
not even !
0.25 + dup 40.0 n:> not
while! ;
\ Draw the sine wave.
: app:main \ --
print_credits get_words draw ;