program demoProgram(input, output);

{ Comments either in this sort of brace }
(* or in this sort; both can span multiple lines. *)

const
	{It's good practice to declare all numeric constants other than 0
	and 1.}
	maxArray = 3;
	strLength = 30;

type 
	myArray = array [0 .. maxArray-1] of integer;
	strRange = 1 .. strLength;
	myString = packed array [strRange] of char;

var
	array1, array2 : myArray;

procedure writeString(message: myString);
var index : integer;
begin
	for index := 1 to strLength do
		write(output, message[index]);
	writeln(output);
end; { writeString }

procedure readData(message : myString; var here : myArray);
var index : integer;
begin
	writeString(message);
	for index := 0 to maxArray-1 do
	begin
		read(input, here[index]);
	end; { each index }
end { readData};

procedure writeData(theData : myArray);
type arrayIndex = 0 .. maxArray-1;
var index : arrayIndex;
begin
	for index := 0 to maxArray-1 do
	begin
		write(output, theData[index]:0, ' ')
	end;
	writeln(output); { just a new line }
	{ write(chr(10)); } { just a cryptic new line }
end { writeData };

procedure binSort;
type setRange = 1 .. 1000;
var smallSet : set of setRange;
	arrayIndex : integer;
	setIndex : setRange;
begin
	smallSet := [ ]; { empty set }
	for arrayIndex := 0 to maxArray-1 do
		if array1[arrayIndex] in [1 .. 1000] then
		{ if (array1[arrayIndex] >= 1) and
			(array1[arrayIndex] <= 1000) then }
		begin
			{ writeln('debug: adding ', array1[arrayIndex]); }
			smallSet := smallSet + [array1[arrayIndex]];
			{ if not(array1[arrayIndex] in smallSet) then
				writeln('  error: ', array1[arrayIndex]:0,
					' didn''t go in');
			}
		end;
	writeln(output,
		'Sorted values, omitting duplicates and those out of range:');
	for setIndex := 1 to 1000 do
		if setIndex in smallSet then
			write(output, setIndex:0, ' ');
	writeln(output);
end; { binSort }

function sumUp(var thisArray : myArray) : real;
var index : integer;
	answer : real;
begin
	answer := 0.0;
	for index := 0 to maxArray-1 do
		answer := answer + thisArray[index];
	sumUp := answer;
end; { sumUp }

procedure useRecords(var thisArray : myArray);
type
	myStruct = record
		value : integer;
		next : ^myStruct;
		case large : boolean of 
			true: (
				piece1, piece2 : integer;
			);
			false: (
				expanded: real;
			)
	end;
var
	header, tmpNode, walker : ^myStruct;
	index : integer;
begin
	{ push elements onto list whose handle is 'header'}
	header := nil;
	for index := 0 to maxArray-1 do
	begin
		new(tmpNode);
		with tmpNode^ do
		begin
			value := thisArray[index];
			next := header;
			large := value > 50;
			case large of
			false: expanded := sqrt(value);
			true: begin
				piece1 := value div 50;
				piece2 := value mod 50;
				end;
			end;
		end; {with tmpNode^}
		header := tmpNode;
	end; { each element of array }
	{print the list}
	writeln(output, 'List contains:');
	walker := header;
	while (walker <> nil) do
	begin
		write(output, walker^.value:1, ' ');
		if walker^.large then 
			write(output, '(', walker^.piece1:1, 
				',', walker^.piece2:1, ') ')
		else
			write(output, '(', walker^.expanded:1:1, ') ');
		walker := walker^.next;
	end; { each element of list }
	writeln(output);
end; { useRecords }

begin { main }
	writeln('Arrays hold ', maxArray:5, ' integers.');
	readData('Give me some data:           ...', array1);
	writeData(array1);
	binSort;
	writeln('Sum of all the data is ', sumUp(array1):5:1,
		' averaging ', (sumUp(array1)/maxArray):5:5);
	useRecords(array1);
end . { main }
{ other issues:
	modularity: should array1, array2 be global?
	should 1000 be a manifest constant?
	multi-dim arrays
	nested procedures
	dynamic-sized types
	exercise: bignums
}
{ vim:nospell tw=70:
}
