Sub-Programs with Parameters - Solutions

1.	Procedure WriteTo(fred : integer);
		{accepts upper limit and outputs all numbers from 1 up to that number}
		var loopything : integer;
		begin
			for loopything := 1 to fred do
				write(loopything:5)
		end; {writeTo}

2.	Procedure DrawSquare(howbig : integer);
		{accepts a size, then draws a solid asterisk box of that size}
		var row, col : integer;
		begin
			for row := 1 to howbig do
				begin
					for col := 1 to howbig do
						write('*');
					writeln
				end
		end; {DrawSquare}

3.	Function Cube(thing:integer):integer;
		{accepts an integer and returns it cubed}
		begin
			cube := thing*thing*thing
		end; {cube}

4.	Function AverageOf(upperALimit, numElements : integer):real;
		{accepts numElements of 0..upperLimit range numbers, averages them
		and returns the average}
		var	tally : real;
			inputtedNum,
			loop : integer;
		begin
			tally := 0.0;
			for loop := 1 to numElements do
				begin
					repeat
						write('Enter integer ',loop,' of ',numElements,' : ');
						readln(inputtedNum)
					until inputtedNum in [0..upperLimit]
				end
		end; {AverageOf}

5.	type days = (SUN, MON, TUE, WED, THU, FRI, SAT);
	Function DayAfter(day:days):days;
		{returns the name of the day after the supplied day)
		begin
			if day = SAT
				then DayAfter := 'SUN'
				else DayAfter := succ(day)
		end;(dayAfter}

	Procedure WriteThe(which:days);
		{outputs the long day name of a day}
		begin
			case day of
				SUN : writeln('Sunday');
				MON : writeln('Monday');
				TUE : writeln('Tuesay');
				WED : writeln('Wednesday');
				THU : writeln('Thursday');
				FRI : writeln('Friday');
				SAT : writeln('Saturday')
			case {day}
		end; {WriteThe}


6.	Procedure FetchRandomCoordinates(var objectX, objectY:byte);
		{returns random coordinates 1..80 for objectx and 1..25 for objecty}
		begin
			objectx := random(80)+1;
			objecty := random(25)+1
		end; {FetchRandomCoordiantes}
	Begin
		FetchRandomCoordinates(HoneyX,HoneyY);
		gotoxy(honeyX,honeyY); write('H');
		repeat
			FetchRandomCoordinates(beeX,beeY);
			gotoxy(beeX,beeY); write('B')
		until (HoneyX=BeeX) and (BeeX=BeeY)

7.	Function EarlierOf(var ken, barbie : char):char;
		{accepts 2 characters, places them in alphabetical order, and returns 
		the earliest of the two}
		var temp: char;
		begin
			if ken > barbie
				then	begin
							temp := ken; 
							ken := barbie; 
							barbie := temp
					end;
			EarlierOf := ken
		end;{EarlierOf)

8.	Procedure Sort(var a,b,c : integer);
		{arranges a,b and c numerically}

		procedure swap(var ken,barbie: integer);
			var temp : integer;
			begin
				temp := ken; ken := barbie; barbie := temp
			end;(swap}

		begin {sort}
			if a > b			{8,7,3}
				then swap(a,b);		{7,8,3}
			if b > c
				then swap(b,c);		{7,3,8}
			if a > b
				then swap(a,b)		{3,7,8}
		end;{sort}

9.	Type 	cards = 0..51;
		suits = 0..3;
		values = 0..12;
	var	card : cards;
	Function CardValue(ken : cards):values;
		{returns the face value of the card}
		begin
			CardValue := ken mod 13
		end; {CardValue}

	Function CardSuit(ken : cards):suits;
		{returns the suit of the card}
		begin
			CardSuit := ken div 13
		end; {CardSuit}

	Procedure PrintCard (barbie : card);
		{outputs the card value and suit}
		begin
			case CardValue(barbie) of
				0   		: 	write('ACE ');
				1..9		:	write(CardValue(barbie)+1,' ');
				10		:	write('JACK ');
				11		:	write('QUEEN ')
				else			write('KING ')
			end; {case cardvalue}
			case CardSuit(barbie) of
				0		: 	writeln('of HEARTS');
				1		: 	writeln('of DIAMONDS');
				2		: 	writeln('of CLUBS')
				else			writeln('of SPADES')
			end; {case CardSuit}
		end; {PrintCard}