Category : Files from Magazines
Archive   : DDJ0988.ZIP
Filename : KING.LIS

_ADA FOR PASCAL PROGRAMMERS_
by
Kim King


Example 1: A Pascal program that counts occurrences of letters
in the input stream

program CountLetters(input, output);
{ counts occurrences of letters in the input stream }
var Counts: array ['a'..'z'] of integer;
Ch: char;
begin
for Ch := 'a' to 'z' do
Counts[Ch] := 0;
while not eof do
begin
read(Ch);
if ('a' <= Ch) and (Ch <= 'z') then
Counts[Ch] := Counts[Ch] + 1
else if ('A' <= Ch) and (Ch <= 'Z') then
begin
Ch := chr(ord(Ch) - ord('A') + ord('a'));
Counts[Ch] := Counts[Ch] + 1
end
end;
for Ch := 'a' to 'z' do
writeln(Ch, Counts[Ch]:6)
end.


Example 2: An Ada program that counts occurrences of letters in
the input stream


1. with Text_IO; use Text_IO;
2. procedure Count_Letters is
3. -- counts occurrences of letters in the input stream
4. package Int_IO is new Integer_IO(Integer);
5. use Int_IO;
6. Counts: array ('a'..'z') of Integer := (others => 0);
7. Ch: Character;
8. begin
9. while not End_Of_File loop
10. Get(Ch);
11. if 'a' <= Ch and Ch <= 'z' then
12. Counts(Ch) := Counts(Ch) + 1;
13. elsif 'A' <= Ch and Ch <= 'Z' then
14. Ch := Character'Val(Character'Pos(Ch) -
15. Character'Pos('A') +
16. Character'Pos('a'));
17. Counts(Ch) := Counts(Ch) + 1;
18. end if;
19. end loop;
20. for Ch in 'a'..'z' loop
21. Put(Ch);
22. Put(Counts(Ch), 6);
23. New_Line;
24. end loop;
25. end Count_Letters;



Example 3: Overloading the Put procedure

procedure Put(File: File_Type; Item: Character);
procedure Put(Item: Character);
procedure Put(File: File_Type; Item: String);
procedure Put(Item: String);


Example 4: The specification of the Length_Conversions package

package Length_Conversions is
Feet_To_Meters: constant := 0.3048;
Inches_To_Centimeters: constant := 2.54;
Miles_To_Kilometers: constant := 1.6093;
Yards_To_Meters: constant := 0.9144;
end Length_Conversions;


Example 5: A program that uses the Length_Conversions package

with Text_IO, Length_Conversions;
use Text_IO, Length_Conversions;
procedure Convert_To_Meters is
package Int_IO is new Integer_IO(Integer);
use Int_IO;
Feet: Integer;
begin
Put("Enter a measurement in feet: ");
Get(Feet);
Skip_Line;
Put("The equivalent measurement in meters is: ");
Put(Integer(Float(Feet)*Feet_To_Meters), 1);
New_Line;
end Convert_To_Meters;


Example 6: The specification of the Angle_Conversions package

package Angle_Conversions is
function Degrees_To_Radians(Degrees: Float) return Float;
function Radians_To_Degrees(Radians: Float) return Float;
end Angle_Conversions;



Example 7: The body of the Angle_Conversions package

package body Angle_Conversions is

Two_Pi: constant := 2.0 * 3.14159;

function Degrees_To_Radians(Degrees: Float) return Float is
begin
return Two_Pi * Degrees / 360.0;
end Degrees_To_Radians;

function Radians_To_Degrees(Radians: Float) return Float is
begin
return 360.0 * Radians / Two_Pi;
end Radians_To_Degrees;

end Angle_Conversions;


Example 8: The specification of the Char_Stack package

package Char_Stack is

procedure Push(X: Character);
-- pushes X onto the stack

procedure Pop(X: out Character);
-- stores the top stack element into X, then pops the stack

function Is_Empty return Boolean;
-- returns True if the stack is empty, False otherwise

end Char_Stack;



Example 9: The body of the Char_Stack package

package body Char_Stack is

Stack_Size: constant := 100; --maximum size of stack
Stack_Array: array (1..Stack_Size) of Character;
Top_Of_Stack: Integer range 0..Stack_Size := 0;

procedure Push(X: Character) is
begin
Top_Of_Stack := Top_Of_Stack + 1;
Stack_Array(Top_Of_Stack) := X;
end Push;

procedure Pop(X: out Character) is
begin
X := Stack_Array(Top_Of_Stack);
Top_Of_Stack := Top_Of_Stack - 1;
end Pop;

function Is_Empty return Boolean is
begin
return Top_Of_Stack = 0;
end Is_Empty;

end Char_Stack;


Example 10: A program that uses the Char_Stack package to reverse
a string

with Text_IO, Char_Stack;
use Text_IO, Char_Stack;
procedure Reverse_String is
Ch: Character;
begin
Put("Enter string to be reversed: ");
while not End_Of_Line loop
Get(Ch);
Push(Ch);
end loop;
Skip_Line;

Put("The reversal is: ");
while not Is_Empty loop
Pop(Ch);
Put(Ch);
end loop;
New_Line;
end Reverse_String;


Example 11: The specification of the Char_Stacks package;
Char_Stack is an ordinary type

package Char_Stacks is

Stack_Size: constant := 100;
type Array_Type is array (1..Stack_Size) of Character;
type Char_Stack is
record
Stack_Array: Array_Type;
Top_Of_Stack: Integer range 0..Stack_Size := 0;
end record;

procedure Push(S: in out Char_Stack; X: Character);
-- pushes X onto stack S

procedure Pop(S: in out Char_Stack; X: out Character);
-- stores the top element of S into X, then pops S

function Is_Empty(S: Char_Stack) return Boolean;
-- returns True if S is empty, False otherwise

end Char_Stacks;


Example 12: The specification of the Char_Stacks package;
Char_Stack is a private type


package Char_Stacks is

type Char_Stack is private;

procedure Push(S: in out Char_Stack; X: Character);
-- pushes X onto stack S

procedure Pop(S: in out Char_Stack; X: out Character);
-- stores the top element of S into X, then pops S

function Is_Empty(S: Char_Stack) return Boolean;
-- returns True if S is empty, False otherwise

private
Stack_Size: constant := 100;
type Array_Type is array (1..Stack_Size) of Character;
type Char_Stack is
record
Stack_Array: Array_Type;
Top_Of_Stack: Integer range 0..Stack_Size := 0;
end record;
end Char_Stacks;


Example 13: The body of the Char_Stacks package

package body Char_Stacks is

procedure Push(S: in out Char_Stack; X: Character) is
begin
S.Top_Of_Stack := S.Top_Of_Stack + 1;
S.Stack_Array(S.Top_Of_Stack) := X;
end Push;

procedure Pop(S: in out Char_Stack; X: out Character) is
begin
X := S.Stack_Array(S.Top_Of_Stack);
S.Top_Of_Stack := S.Top_Of_Stack - 1;
end Pop;

function Is_Empty(S: Char_Stack) return Boolean is
begin
return S.Top_Of_Stack = 0;
end Is_Empty;

end Char_Stacks;


Example 14: A program that uses the Char_Stacks package to
reverse a string

with Text_IO, Char_Stacks;
use Text_IO, Char_Stacks;
procedure Reverse_String is
S: Char_Stack;
Ch: Character;
begin
Put("Enter string to be reversed: ");
while not End_Of_Line loop
Get(Ch);
Push(S, Ch);
end loop;
Skip_Line;

Put("The reversal is: ");
while not Is_Empty(S) loop
Pop(S, Ch);
Put(Ch);
end loop;
New_Line;
end Reverse_String;



Example 15: The specification of the Char_Stacks package with
exceptions added

package Char_Stacks is

type Char_Stack is private;

procedure Push(S: in out Char_Stack; X: Character);
-- pushes X onto stack S; raises Overflow if S is full

procedure Pop(S: in out Char_Stack; X: out Character);
-- stores the top element of S into X, then pops S
-- raises Underflow if S is empty

function Is_Empty(S: Char_Stack) return Boolean;
-- returns True if S is empty, False otherwise

Overflow, Underflow: exception;

private
Stack_Size: constant := 100;
type Array_Type is array (1..Stack_Size) of Character;
type Char_Stack is
record
Stack_Array: Array_Type;
Top_Of_Stack: Integer range 0..Stack_Size := 0;
end record;
end Char_Stacks;




Example 16: The body of the Char_Stacks package with exceptions
added

package body Char_Stacks is

procedure Push(S: in out Char_Stack; X: Character) is
begin
if S.Top_Of_Stack = Stack_Size then
raise Overflow;
end if;
S.Top_Of_Stack := S.Top_Of_Stack + 1;
S.Stack_Array(S.Top_Of_Stack) := X;
end Push;

procedure Pop(S: in out Char_Stack; X: out Character) is
begin
if S.Top_Of_Stack = 0 then
raise Underflow;
end if;
X := S.Stack_Array(S.Top_Of_Stack);
S.Top_Of_Stack := S.Top_Of_Stack - 1;
end Pop;

function Is_Empty(S: Char_Stack) return Boolean is
begin
return S.Top_Of_Stack = 0;
end Is_Empty;

end Char_Stacks;


Example 17: A program that uses the Char_Stacks package to
reverse a string (with exception handling added)


with Text_IO, Char_Stacks;
use Text_IO, Char_Stacks;
procedure Reverse_String is
S: Char_Stack;
Ch: Character;
begin
Put("Enter string to be reversed: ");
begin
while not End_Of_Line loop
Get(Ch);
Push(S, Ch);
end loop;
exception
when Overflow => null; -- ignore overflow
end;
Skip_Line;

Put("The reversal is: ");
while not Is_Empty(S) loop
Pop(S, Ch);
Put(Ch);
end loop;
New_Line;
end Reverse_String;


Example 18: The specification of the generic Stacks package

generic
type Element is private;
package Stacks is

type Stack is private;

procedure Push(S: in out Stack; X: Element);
-- pushes X onto stack S; raises Overflow if S is full

procedure Pop(S: in out Stack; X: out Element);
-- stores the top element of S into X, then pops S
-- raises Underflow if S is empty

function Is_Empty(S: Stack) return Boolean;
-- returns True if S is empty, False otherwise

Overflow, Underflow: exception;

private
Stack_Size: constant := 100;
type Array_Type is array (1..Stack_Size) of Element;
type Stack is
record
Stack_Array: Array_Type;
Top_Of_Stack: Integer range 0..Stack_Size := 0;
end record;
end Stacks;


Example 19: A program that uses the generic Stacks package to
reverse a string

with Text_IO, Stacks;
use Text_IO;
procedure Reverse_String is

package Char_Stacks is new Stacks(Character);
use Char_Stacks;

S: Stack;
Ch: Character;

begin
Put("Enter string to be reversed: ");
begin
while not End_Of_Line loop
Get(Ch);
Push(S, Ch);
end loop;
exception
when Overflow => null;
end;
Skip_Line;

Put("The reversal is: ");
while not Is_Empty(S) loop
Pop(S, Ch);
Put(Ch);
end loop;
New_Line;
end Reverse_String;