Basics of Ada
Descripción del contenido de la página
Conversión de antiguos programas de BASIC a Ada para aprender los rudimentos de este lenguaje.
Etiquetas:
3D Plot
-- 3D Plot
--
-- Original version in BASIC:
-- 3-D Plot (by Mark Bramhall), 1978.
-- Creative Computing's BASIC Games.
-- - http://vintage-basic.net/games.html
-- - http://vintage-basic.net/bcg/3dplot.bas
-- - https://www.atariarchives.org/basicgames/showpage.php?page=167
--
-- This version in Ada:
-- Copyright (c) 2025, Marcos Cruz (programandala.net);
-- SPDX-License-Identifier: Fair
--
-- Written on 2025-03-19, 2025-03-29.
--
-- Last modified: 20251204T2259+0100.
with ada.numerics;
use ada.numerics;
with ada.numerics.elementary_functions;
use ada.numerics.elementary_functions;
with ada.text_io;
use ada.text_io;
procedure plot_3d is
procedure move_cursor_home is
escape : constant character := character'val (16#1B#); -- 0x1B
begin
put (escape & "[H");
end move_cursor_home;
procedure erase_screen is
escape : constant character := character'val (16#1B#); -- 0x1B
begin
put (escape & "[2J");
end erase_screen;
procedure clear_screen is
begin
erase_screen;
move_cursor_home;
end clear_screen;
procedure wait_for_keypress (expected_char : character) is
pressed_char : character;
is_a_char_available : boolean;
begin
loop
ada.text_io.get_immediate (pressed_char, is_a_char_available);
if (pressed_char = expected_char) then
exit;
end if;
end loop;
end wait_for_keypress;
procedure print_credits is
begin
put_line ("3D Plot");
new_line;
put_line ("Original version in BASIC:");
put_line (" Creative computing (Morristown, New Jersey, USA), ca. 1980.");
new_line;
put_line ("This version in Ada:");
put_line (" Copyright (c) 2025, Marcos Cruz (programandala.net)");
put_line (" SPDX-License-Identifier: Fair");
new_line;
put ("Press Enter to start the program. ");
wait_for_keypress (character'val (16#0a#)); -- 0x0a, the enter character
end print_credits;
function a (z : float) return float is
begin
return 30.0 * exp (-z * z / 100.0);
end a;
procedure draw is
space : constant character := ' ';
dot : constant character := '*';
width : constant integer := 56;
l : integer;
z : integer;
y : integer;
y1 : integer;
line : array (0 .. width - 1) of character;
x : float := -30.0;
begin
while x <= 30.0 loop
for c in 0 .. width - 1 loop
line (c) := space;
end loop;
l := 0;
y1 :=
5
* integer (
float'truncation (sqrt (900.0 - x * x) / 5.0)
);
y := y1;
while y >= -y1 loop
z := integer (
float'truncation (
25.0
+ a (sqrt (x * x + float (y * y)))
- 0.7 * float (y)
)
);
if z > l then
l := z;
line (z) := dot;
end if;
y := y - 5;
end loop;
for pos in 0 .. width - 1 loop
put (line (pos));
end loop;
new_line;
x := x + 1.5;
end loop;
end draw;
begin
clear_screen;
print_credits;
clear_screen;
draw;
end plot_3d;
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 Ada:
-- Copyright (c) 2025, Marcos Cruz (programandala.net)
-- SPDX-License-Identifier: Fair
--
-- Written on 2025-03-29, 2025-03-31, 2025-04-17.
--
-- Last modified: 20251204T2258+0100.
with ada.text_io;
use ada.text_io;
procedure bunny is
width : constant integer := 53;
type line_index is range 1 .. width;
type line_array is array (line_index) of character;
-- Clear the terminal and move the cursor to the top left position.
procedure clear_screen is
escape : constant character := character'val (16#1B#); -- 0x1B
begin
put (escape & "[0;0H" & escape & "[2J");
end clear_screen;
procedure wait_for_a_keypress is
char : character;
available : boolean := false;
begin
while not available loop
get_immediate (char, available);
end loop;
end wait_for_a_keypress;
procedure print_credits is
begin
put_line ("Bunny");
new_line;
put_line ("Original version in BASIC:");
put_line (" Creative Computing (Morristown, New Jersey, USA), 1978.");
new_line;
put_line ("This version in Ada:");
put_line (" Copyright (c) 2025, Marcos Cruz (programandala.net)");
put_line (" SPDX-License-Identifier: Fair");
new_line;
put ("Press Enter to start the program. ");
wait_for_a_keypress;
end print_credits;
procedure clear_line (line : in out line_array) is
begin
for i in line'range loop
line (i) := ' ';
end loop;
end clear_line;
procedure print_line (line : line_array) is
begin
for i in line'range loop
put (line (i));
end loop;
new_line;
end print_line;
procedure draw is
letters : constant integer := 5;
type letters_range is range 1 .. letters;
letter : constant array (letters_range) of character :=
('B', 'U', 'N', 'N', 'Y');
EOL : constant integer := -1; -- end of line identifier
data : array (0 .. 226) of 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 );
line : line_array;
data_index : integer;
first_column : integer;
last_column : integer;
begin
clear_line (line);
data_index := 0;
while data_index < data'length loop
first_column := data (data_index);
data_index := data_index + 1;
if first_column = EOL then
print_line (line);
clear_line (line);
else
last_column := data (data_index);
data_index := data_index + 1;
for column in first_column .. last_column loop
line (line_index (column + 1)) := letter (
letters_range (column mod letters + 1)
);
end loop;
end if;
end loop;
end draw;
begin
clear_screen;
print_credits;
clear_screen;
draw;
end bunny;
Diamond
-- Diamond
--
-- Original version in BASIC:
-- Example included in Vintage BASIC 1.0.3.
-- http://www.vintage-basic.net
--
-- This version in Ada:
-- Copyright (c) 2025, Marcos Cruz (programandala.net)
-- SPDX-License-Identifier: Fair
--
-- Written on 2025-03-19.
--
-- Last modified: 20251204T2258+0100.
with ada.text_io;
use ada.text_io;
procedure diamond is
lines : constant integer := 17;
begin
for i in 1 .. lines / 2 + 1 loop
for j in 1 .. (lines + 1) / 2 - i + 1 loop
put (" ");
end loop;
for j in 1 .. i * 2 - 1 loop
put ("*");
end loop;
new_line;
end loop;
for i in 1 .. lines / 2 loop
for j in 1 .. i + 1 loop
put (" ");
end loop;
for j in 1 .. ((lines + 1) / 2 - i) * 2 - 1 loop
put ("*");
end loop;
new_line;
end loop;
end diamond;
Math
-- Math
-- Original version in BASIC:
-- Example included in Vintage BASIC 1.0.3.
-- http://www.vintage-basic.net
-- This version in Ada:
-- Copyright (c) 2025, Marcos Cruz (programandala.net)
-- SPDX-License-Identifier: Fair
-- Written on 2025-05-13, 2025-07-28.
-- Last modified: 20251204T2259+0100.
with ada.numerics.elementary_functions;
use ada.numerics.elementary_functions;
with ada.text_io;
use ada.text_io;
with ada.float_text_io;
procedure math is
n : float;
result : float;
begin
n := 0.0;
put ("Enter a number: ");
ada.float_text_io.get (n);
result := abs n;
put_line ("ABS($n) --> abs $n --> " & result'image);
put_line ("ATN($n) --> arctan ($n) --> " & arctan (n)'image);
put_line ("COS($n) --> cos ($n) --> " & cos (n)'image);
put_line ("EXP($n) --> exp ($n) --> " & exp (n)'image);
put_line ("INT($n) --> integer ($n) --> " & integer (n)'image);
if n > 0.0 then
put_line ("LOG($n) --> log ($n) --> " & log (n)'image);
else
put_line ("LOG($n) --> log ($n) --> undefined");
end if;
put_line (
"SGN($n) --> integer (float'copy_sign (1.0, $n)) --> "
& integer (float'copy_sign (1.0, n))'image
);
if n >= 0.0 then
put_line ("SQR($n) --> sqrt ($n) --> " & sqrt (n)'image);
else
put_line ("SQR($n) --> sqrt ($n) --> math domyain error");
end if;
put_line ("TAN($n) --> tan ($n) --> " & tan (n)'image);
end math;
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 Ada:
-- Copyright (c) 2025, Marcos Cruz (programandala.net)
-- SPDX-License-Identifier: Fair
-- Written in 2025-03.
--
-- Last modified: 20251204T2300+0100.
with ada.numerics.elementary_functions;
use ada.numerics.elementary_functions;
with ada.strings.fixed;
use ada.strings.fixed;
with ada.strings.unbounded;
use ada.strings.unbounded;
with ada.text_io;
use ada.text_io;
procedure sine_wave is
type pair_of_words is array (0 .. 1) of unbounded_string;
procedure clear_screen is
escape : constant character := character'val (16#1B#); -- 0x1B
begin
put (escape & "[0;0H" & escape & "[2J");
end clear_screen;
procedure wait_for_a_keypress is
char : character;
available : boolean := false;
begin
while not available loop
get_immediate (char, available);
end loop;
end wait_for_a_keypress;
procedure print_credits is
begin
clear_screen;
put_line ("Sine Wave");
new_line;
put_line ("Original version in BASIC:");
put_line (" Creative computing (Morristown, New Jersey, USA), ca. 1980.");
new_line;
put_line ("This version in Ada:");
put_line (" Copyright (c) 2025, Marcos Cruz (programandala.net)");
put_line (" SPDX-License-Identifier: Fair");
new_line;
put ("Press Enter to start the program. ");
wait_for_a_keypress;
end print_credits;
procedure draw is
angle : float;
even : boolean := false;
words : pair_of_words;
procedure get_words is
begin
clear_screen;
for n in 0 .. 1 loop
put (
"Enter the "
& (if n = 0 then "first" else "second")
& " word: "
);
words (n) := to_unbounded_string (get_line);
end loop;
end get_words;
begin
clear_screen;
get_words;
clear_screen;
angle := 0.0;
while angle <= 40.0 loop
put (
integer (
float'floor (26.0 + 25.0 * sin (angle))
)
* " "
);
put_line (to_string (words (if even then 1 else 0)));
even := not even;
angle := angle + 0.25;
end loop;
end draw;
begin
print_credits;
draw;
end sine_wave;