Output of file : KING.LIS contained in archive : DDJ0988.ZIP
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
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;

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
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;

begin
return 360.0 * Radians / Two_Pi;

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
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

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

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;



### 3 Responses to “Category : Files from MagazinesArchive   : DDJ0988.ZIPFilename : KING.LIS”

1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/