```{ -- FLORIDA HIGH SCHOOLS COMPUTING COMPETITION '82 }
{ -- PASCAL PROGRAM SOLUTIONS }

{1.1}
program One1T82;
{ -- This program will allow a user to guess a generated #. }
var
X, I, G: Byte;

begin
Randomize;
X := Random(100) + 1;  I := 1;
while (I <= 7) and (G <> X) do begin
Write ('I AM THINKING OF A NUMBER. WHAT IS IT? ');
if G < X then
Writeln ('TOO LOW')
else if G > X then
Writeln ('TOO HIGH')
else
Writeln ('RIGHT');
Inc(I);
end;
end.

{1.2}
program One2T82;
{ -- This program will find #s that are the sum of 2 squares. }
var
I, J: Byte;
A:    Array[1..50] of Boolean;

begin
for I := 1 to 50 do A[I] := False;
for I := 1 to 5 do
for J := I to 7 do
if I*I + J*J < 50 then A[I*I + J*J] := True;

for I := 1 to 50 do
if A[I] then Write (I, ',');
Writeln;
end.

{1.3}
program One3T82;
{ -- This program will sum numbers divisible by 14. }
var
I: Integer;
S: LongInt;

begin
for I := 100 to 1000 do
if I mod 14 = 0 then S := S + I;
Writeln (S);
end.

{1.4}
program One4T82;
{ -- This program will add 2 random times. }
var
I, M, H:   Byte;
Min, Hour: Array [1..2] of Byte;

begin
Randomize;
for I := 1 to 2 do begin
Hour[I] := Random(12) + 1;
Min[I]  := Random(60);
Write (Hour[I], ':');
if Min[I] < 10 then Write ('0');
Writeln (Min[I]);
end;
Writeln ('-----');
M := Min + Min;  H := 0;
if M > 59 then begin
M := M - 60;  H := 1;
end;
H := H + Hour + Hour;
if H > 12 then H := H - 12;
Write (H, ':');
if M < 10 then Write ('0');
Writeln (M);  Writeln;
end.

{1.5}
program One5T82;
{ -- This program will compute roots of equation. }
var
A, B, C, S: Integer;

begin
Write ('Enter a, b, c: ');  Readln (A, B, C);
S := B*B - 4*A*C;
if S < 0 then
Writeln ('COMPLEX')
else begin
Write ( (-B - Sqrt(S)) / (2 * A) : 4:2, '  ');
Writeln ( (-B + Sqrt(S)) / (2 * A) : 4:2);
end;
end.

{1.6}
program One6T82;
{ -- This program will print prime factors. }
var
N, I, J: Byte;
Prime:   Boolean;

begin
Write ('Enter number: ');  Readln (N);
for I := 2 to N do
if N mod I = 0 then begin
J := 2;  Prime := True;
while (J <= Trunc(Sqrt(I))) and Prime do begin
if I mod J = 0 then Prime := False;
Inc(J);
end;
if Prime then Write(I, '  ');
end;
Writeln;
end.

{1.7}
program One7T82;
{ -- This program will calculate future value of investment. }
var
P, i:    Real;
J, N, Y: Integer;

begin
Write ('Enter P, i, N, Y: ');  Readln (P, i, N, Y);
for J := 1 to N * Y do
P := P + P * i / N;
Writeln ('\$', Round(P * 100) / 100 :5:2);
end.

{1.8}
program One8T82;
{ -- Ths program will find 3 #s whose sum is 43. }
var
I, J, K: LongInt;

begin
for I := 1 to 41 do
for J := 1 to 42 - I do begin
K := 43 - I - J;
if I*I*I + J*J*J + K*K*K = 17299 then begin
Writeln (I, '  ', J, '  ', K);  Exit;
end;
end;
end.

{1.9}
program One9T82;
{ -- This program will print a symbol for 45 seconds. }
uses Crt;
var
Ch: Char;

begin
Write ('Enter a symbol: ');  Readln (Ch);
ClrScr;  Write(Ch);
Delay (45000);
ClrScr;
end.

{1.10}
program One10T82;
{ -- This program will convert decimal to fraction. }
var
Dec:              String;
L, N, D, I, Code: Integer;

begin
Write ('Enter decimal: ');  Readln (Dec);
L   := Length(Dec) - 1;
Dec := Copy (Dec, 2, L);
Val (Dec, N, Code);  D := 1;
for I := 1 to L do   D := D * 10;
for I := N downto 1 do
if (N mod I = 0) and (D mod I = 0) then begin
Writeln (N div I, '/', D div I);  Exit;
end;
end.

{1.11}
program One11T82;
{ -- This program will move an asterisk by pressing keys. }
uses Crt;
var
R, C: Integer;
Ch:   Char;

begin
ClrScr;  R := 10;  C := 40;
while Ch <> ' ' do begin
GotoXY (C, R);  Write ('*');
if Ch in ['U', 'D', 'L', 'R'] then begin
GotoXY (C, R);  Write (' ');
if Ch = 'U' then Dec(R);
if Ch = 'D' then Inc(R);
if Ch = 'L' then Dec(C);
if Ch = 'R' then Inc(C);
end;
end;
end.

{2.1}
program Two1T82;
{ -- This program will print day of week of a date. }
const
M: Array [1..12] of Integer =
(31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
var
I, Mo, Da, S, X: Integer;

begin
Write ('Enter month, day: ');  Readln (Mo, Da);
S := 0;
for I := 1 to Mo - 1 do S := S + M[I];
S := S + Da;
X := S mod 7;
Writeln ( Copy('THUFRISATSUNMONTUEWED', X*3 + 1, 3) );
end.

{2.2}
program Two2T82;
{ -- This program will calculate the area of a polygon. }
var
N, I, Sum: Integer;
X, Y:      Array[1..9] of Integer;

begin
Write ('Enter n: ');  Readln (N);
for I := 1 to N do begin
Write ('Enter vertex (X, Y): ');  Readln (X[I], Y[I]);
end;
X[N+1] := X;  Y[N+1] := Y;  Sum := 0;
for I := 1 to N do
Sum := Sum + X[I] * Y[I+1] - Y[I] * X[I+1];
Writeln ('AREA = ', Abs(Sum) / 2  :4:1);
end.

{2.3}
program Two3T82;
{ -- This program will find 5 digit number. }
{ -- Strategy:  # is less than 25000 because 4 * # would be
a 6 digit # otherwise.
# can't be 1XXXY since 4 * Y can't give us
a 1 in the units place.
# must therefore begin with 2 and end with
8 since 4*8 = 32.  So we can step 10.   }
var
I:     LongInt;
J:     Integer;
N, S:  String;
Found: Boolean;

begin
I := 20008;
repeat
Str (I, N);  Str (I*4, S);  Found := True;
for J := 1 to 5 do
if Copy(N, J, 1) <> Copy(S, 6-J, 1) then
Found := False;
if Found then
Writeln (I)
else
I := I + 10;
until (I >= 24998) or Found;
end.

{2.4}
program Two4T82;
{ -- This program will find interesting numbers. }
var
I, J, K, Num, Pow: Integer;

begin
for I := 1 to 9 do
for J := 0 to 9 do
for K := 0 to 9 do begin
Num := I * 100 + J * 10 + K;
Pow := I*I*I + J*J*J + K*K*K;
if (Num = Pow) and (Num <> 153) then
Write (Num :5);
end;
Writeln;
end.

{2.5}
program Two5T82;
{ -- This program will make user's name zig zag. }
uses Crt;
var
I, X, L, S: Byte;
Nam:        String;
Ch:         Char;

begin
Write ('Enter name: ');  Readln (Nam);  ClrScr;
L := Length (Nam);
X := Trunc(159 / (L-1));
for I := 1 to L do begin
Ch := Nam[I];
S := (I - 1) * X;
if S > 79 then S := 159 - S;
Writeln (' ': S, Ch);
end;
end.

{2.6}
program Two6T82;
{ -- This program will print a stick figure. }
uses Crt;
var
R, C, I, K: Byte;
Inc:        Real;
A:          Char;

begin
R := 5;  C := 12;
repeat
for I := 0 to 5 do begin
ClrScr;
Writeln (' *     ***** ');
Writeln ('  *    *   * ');
Writeln ('   *   ***** ');
Writeln ('    **   *   ');
Writeln ('      *****  ');
Writeln ('         *   ');
Writeln ('         *   ');
Writeln ('        * *  ');
Writeln ('       *   * ');
Writeln ('      *     *');
Inc := (R - I) / 7;
For K := 0 to 6 do begin
GotoXY (C+K, R-Trunc(Inc*K));  Write ('*');
end;
Delay(100);
end;
until A = Char(27);
end.

{2.7}
program Two7T82;
{ -- This program will display permutations of letters. }
uses Crt;
var
N, I, X: Integer;
A:       Array [1..8] of Char;
Temp:    Char;

begin
Randomize;
Write ('How many letters: ');  Readln (N);
for I := 1 to N do begin
Write ('Enter letter: ');  Readln (A[I]);
end;
repeat
for I := 1 to N do begin
X := Random(N) + 1;
Temp := A[X];  A[X] := A[I];  A[I] := Temp;
end;
for I := 1 to N do Write (A[I]);
Writeln; Delay(100);
until Keypressed;
end.

{2.8}
program Two8T82;
{ -- This program will drill typying skills. }
uses Crt;
var
I, X, J: Integer;
S:       LongInt;
A, B:    Array[1..4] of Char;
Ch:      Char;
Wrong:   Boolean;

begin
Randomize;
for I := 1 to 4 do begin
X := Random(58) + 33;
A[I] := Chr(X);
Write (A[I], ' ');
end;
Writeln;  J := 1;  S := 0;
while J < 5 do begin
repeat
Inc(S);
until Keypressed;
Ch := ReadKey;  B[J] := Ch;
Write (Ch, ' ');
Inc(J);
end;
Writeln;  Writeln;  Wrong := False;
for I := 1 to 4 do
if A[I] <> B[I] then begin
Writeln (A[I], ' --- ', B[I], '  NO');
Wrong := True;
end;
if Not Wrong then Writeln (S div 30000, ' SECONDS');
end.

{2.9}
program Two9T82;
{ -- This program will return change in fewest coins. }
const
Nam: Array [1..8] of String =
('\$20', '\$10', '\$5', 'DOLLARS', 'QUARTERS', 'DIMES',
'NICKELS', 'PENNIES');
Amount: Array [1..8] of Integer =
(2000, 1000, 500, 100, 25, 10, 5, 1);
var
P: Real;
N, D, I, X: Integer;

begin
Write ('Enter price \$: ');  Readln (P);
Write ('Enter denomination \$: ');  Readln (D);
N := D * 100 - Trunc(P * 100 + 0.1);
for I := 1 to 8 do begin
X := N div Amount[I];
if X > 0 then Writeln (X, ' ', Nam[I]);
N := N - X * Amount[I];
end;
end.

{2.10}
program Two10T82;
{ -- This program will make unit conversions. }
const
A: Array[1..5] of String =
('IN', 'FT', 'FT', 'YD', 'MI');
B: Array[1..5] of String =
('CM', 'CM', 'M ', 'M ', 'KM');
var
I, X: Byte;
N, S: Real;

begin
for I := 1 to 5 do
Writeln (I, '  ', A[I], ' -> ', B[I]);
Write ('Enter Choice #: ');  Readln (X);
Write ('Enter ', A[X], ': ');  Readln (N);
S := N * 2.54;
if X = 1 then Write (S :6:2);
if X = 2 then Write (S * 12 :6:2);
if X = 3 then Write (S * 12 / 100 :6:2);
if X = 4 then Write (S * 36 / 100 :6:2);
if X = 5 then Write (S * 5280 * 12 / 100000.0 :6:2);
Writeln (' ', B[X]);
end.

{2.11}
program Two11T82;
{ -- This program will find A^B x C^D = ABCD }
var
A, B, C, D, J, APow, CPow, Num: LongInt;

begin
for A := 1 to 9 do
for B := 0 to 9 do
for C := 0 to 9 do
for D := 0 to 9 do begin
APow := 1;  CPow := 1;
for J := 1 to B do APow := APow * A;
for J := 1 to D do CPow := CPow * C;
Num := A*1000 + B*100 + C*10 + D;
if APow * CPow = Num then begin
Writeln ('A=', A, '  B=', B, '  C=', C, '  D=',D);
Exit;
end;
end;
end.

{2.12}
program Two12T82;
{ -- This program calculates days between 2 dates. }
const
Days: Array[1..12] of Integer =
(31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
var
M1, D1, M2, D2, I, S: Integer;

begin
Write ('Enter Month1, Day1: ');  Readln (M1, D1);
Write ('Enter Month2, Day2: ');  Readln (M2, D2);
S := 0;
for I := M1 to M2-1 do S := S + Days[I];
Writeln (S + D2 - D1, ' DAYS');
end.

{2.13}
program Two13T82;
{ -- This program will print a check. }
uses Crt;
const
Mo: Array [1..12] of String =
('JAN.', 'FEB.', 'MAR.', 'APRIL', 'MAY', 'JUNE',
'JULY', 'AUG.', 'SEPT.', 'OCT.', 'NOV.', 'DEC.');
Words: Array[1..27] of String =
('ONE', 'TWO', 'THREE', 'FOUR', 'FIVE', 'SIX', 'SEVEN',
'EIGHT', 'NINE', 'TEN', 'ELEVEN', 'TWELVE', 'THIRTEEN',
'FOURTEEN', 'FIFTEEN', 'SIXTEEN', 'SEVENTEEN',
'EIGHTEEN', 'NINETEEN', 'TWENTY-', 'THIRTY-', 'FOURTY-',
'FIFTY-', 'SIXTY-', 'SEVENTY-', 'EIGHTY-', 'NINETY-');
var
I, M, D, Y, S, T, X, Cent: Integer;
Nam: String;
N:   Real;

begin
Write ('Enter month, day, year: ');  Readln (M, D, Y);
Write ('Enter amount \$:');  Readln (N);
Write ('Enter payee: ');    Readln (Nam);
{ -- Display check border }
ClrScr;
for I := 1 to 60 do Write ('*');
for I := 1 to 7 do begin
GotoXY (1, I+1);  Write ('*');
GotoXY (60,I+1);  Write ('*');
end;
Writeln;
for I := 1 to 60 do Write ('*');
{ -- Display date, Name, and amount }
GotoXY (45, 2);  Write (Mo[M], ' ', D, ', 19', Y);
GotoXY (5, 4);   Write ('PAY TO THE');
GotoXY (5, 5);   Write ('ORDER OF  ', Nam);
GotoXY (50, 5);  Write ('\$', N:5:2);
GotoXY (3, 7);
{ -- Display amount in words }
Cent := Trunc( (N - Int(N)) * 100 + 0.1);  S := 1000;  T := 0;
for I := 2 downto 0 do begin
S := S div 10;  X := Trunc(N/S + 0.001);
if (I = 2) and (X > 0) then
Write (Words[X], ' HUNDRED ');
if (I = 1) and (X > 1) then
Write (Words[18+X]);
if (I = 1) and (X = 1) then T := 1 else T := 0;
if I = 0 then
Write (Words[T*10+X]);
N := Int(N - X * S + 0.001);
end;
Write (' AND ', Cent, '/100 DOLLARS');
end.

{3.1}
program Thr1T82;
{ -- This program will play mastermind. }
{ -- The computer will randomly select four of the six colors.  }
{ -- The user must guess this combination of four colors.       }
{ -- BLACK indicates that a color is in the right position.     }
{ -- WHITE indicates a color is right but in the wrong position.}
uses Crt;
const
Co: Array [1..6] of String =
('W', 'Y', 'R', 'G', 'BL', 'BK');
var
I, J, K, W, Bk, X: Integer;
A, B, C:           Array[1..6] of String;

begin
Randomize;
for I := 1 to 4 do begin
X := Random(6) + 1;  A[I] := Co[X];
end;

ClrScr;  Writeln ('GUESS: W, Y, R, G, BL, BK');
for K := 1 to 10 do begin
W := 0;  Bk := 0;
for I := 1 to 4 do begin
end;
for I := 1 to 4 do C[I] := A[I];
for I := 1 to 4 do
if C[I] = B[I] then begin
Inc(Bk);  B[I] := '';  C[I] := ' ';
end;
for I := 1 to 4 do
for J := 1 to 4 do
if C[I] = B[J] then begin
Inc(W);  B[J] := '';  C[I] := ' ';
end;
{ -- Black pegs = Correct color and correct position }
{ -- White pegs = Correct color but wrong position }
GotoXY (40, K*2);
Write ('BLACKS = ', Bk, '   WHITES = ', W);
if Bk = 4 then begin
Writeln; Writeln ('YOU WIN IN ', K, ' TURNS');  Exit;
end;
end;  { -- for K }
Writeln;  Writeln ('YOU LOSE');
for I := 1 to 4 do Write (A[I], ' ');
end.

{3.2}
program Thr2T82;
{ -- This program will plot points on a new axis. }
uses Crt;
var
X1, Y1, X2, Y2, IT, N, I, R, C: Integer;
X, Y:                           Array[1..9] of Integer;

begin
Write ('Enter end point of x-axis: ');  Readln (X1, Y1);
Write ('Enter end point of y-axis: ');  Readln (X2, Y2);
Write ('Enter increment: ');  Readln (IT);
Write ('How many points: ');  Readln (N);
for I := 1 to N do begin
Write ('Enter point: ');  Readln (X[I], Y[I]);
end;
ClrScr;  R := 3;  C := 1;
Writeln ('INTERSECTION AT (', X2, ',', Y1, ')');
Writeln;
I := Y1;
repeat
Write ('*');  I := I + IT;
until I > Y2;
I := X2 + IT; Writeln;
repeat
Writeln ('*');  I := I + IT;
until I > X1;
for I := 1 to N do begin
GotoXY (C + (Y[I]-Y1) div IT, R + (X[I]-X2) div IT);
Write ('+');
end;
end.

{3.3}
program Thr3T82;
{ -- This program will generate magic squares. }
{ -- Correctly for odd matrices and for a 4 x 4. }
uses Crt;
var
N, X, Y, I, J, S: Integer;
A: Array [1..12, 1..12] of Integer;

begin
ClrScr;
Write ('Enter size: ');  Readln (N);
Writeln;  S := 0;
if N mod 2 = 1 then begin  { -- routine for odd Matrix }
for X := 1 to N do
for Y := 1 to N do
A[X,Y] := 0;
X := 1;  Y := (N+1) div 2;  A[X,Y] := 1;
for I := 2 to N*N do begin
Dec(X);  Dec(Y);
if X = 0 then X := N;
if Y = 0 then Y := N;
if A[X,Y] = 0 then
A[X,Y] := I
else begin
X := X + 2;  Inc(Y);
if X > N then X := X - N;
if Y > N then Y := 1;
A[X,Y] := I;
end;
end;  { -- for I }
end   { -- begin }
else    { -- Routine for Even Matrix (4x4) }
for I := 1 to N do
for J := 1 to N do begin
S := S + 1;
if (I = J) or (I = N+1-J) then
A[I,J] := S
else
A[I,J] := N*N + 1 - S;
end;

for I := 1 to N do
for J := 1 to N do begin
GotoXY (J*4, I*2);  Write (A[I,J]);
end;
Writeln;  Writeln ('MAGIC NUMBER = ', (N*N*N + N) div 2);
end.

{3.4}
program Thr4T82;
{ -- This program will add and multiply 2 Roman Numerals. }
const
RN: Array[1..7] of Char =
('M', 'D', 'C', 'L', 'X', 'V', 'I');
RV: Array[1..7] of Integer =
(1000, 500, 100, 50, 10, 5, 1);
var
I, E, L, Ar, I1, I2, J, K, XX, Num: Integer;
Rom, R:  Array [1..2] of String;
A, N:    Array [1..2] of Integer;
Ch, NCh: String;
X:       Real;

begin
for E := 1 to 2 do begin
Write ('Enter Roman Numeral: ');  Readln (Rom[E]);
L := Length(Rom[E]);  I := 1;  Ar := 0;
while I < L do begin
Ch := Copy (Rom[E], I, 1);
I1 := 1;  while Ch <> RN[I1] do Inc(I1);
NCh:= Copy (Rom[E], I+1, 1);
I2 := 1;  while NCh <> RN[I2] do Inc(I2);
if I1 <= I2 then
Ar := Ar + RV[I1]
else begin
Ar := Ar + RV[I2] - RV[I1];  Inc(I);  end;
Inc(I);
end;
if I <= L then begin  { -- Last numeral not done }
Ch := Copy (Rom[E], I, 1);
I1 := 1;  while Ch <> RN[I1] do Inc(I1);
Ar := Ar + RV[I1];
end;
A[E] := Ar;
end;  { -- for E }
{ -- Convert Arabic numbers to Roman Numerals }
N := A + A;  N := A * A;
R := '';  R := '';
for K := 1 to 2 do begin
Num := N[K];
for I := 1 to 7 do begin
X := Num / RV[I];
if (X<2) and (X>=9/5) and (I in [2,4,6]) then { -- next }
else begin
XX := Trunc(X);
if XX = 9 then R[K] := R[K] + RN[I] + RN[I-2]
else
if XX = 4 then R[K] := R[K] + RN[I] + RN[I-1]
else
if XX > 0 then
for J := 1 to XX do
R[K] := R[K] + RN[I];
Num := Num - RV[I] * XX;
end;
end;  { -- for I }
end;  { -- for K }
{ -- Display sum and product }
Writeln (Rom, ' + ', Rom, ' = ', R);
Writeln (A, ' + ', A, ' = ', N);
Writeln (Rom, ' * ', Rom, ' = ', R);
Writeln (A, ' * ', A, ' = ', N);
end.

{3.5}
program Thr5T82;
{ -- This program will find 4 digit squumbers. }
var
I, L, R, X, Code: Integer;
Ist:              String;

begin
for I := 1000 to 9999 do begin
Str (I, Ist);
Val (Copy(Ist, 1, 2), L, Code);
Val (Copy(Ist, 3, 2), R, Code);
X := L + R;
if X * X = I then Writeln (I);
end;
end.

{3.6}
program Thr6T82;
{ -- This program should play Nim with a user.           }
{ -- HOWEVER, since the rules are not given with this    }
{ -- problem, it is very difficult to write the program. }
begin
end.

{3.7}
program Thr7T82;
{ -- This program will determine where a # falls in a list. }
var
A:      Array [1..16] of Integer;
I, Num: Integer;

begin
for I := 1 to 16 do begin
Write ('Enter #: ');  Readln (A[I]);
end;
Write ('Enter another number: ');  Readln (Num);
I := 1;
while A[I] <> Num do Inc(I);
Writeln ('BETWEEN ', A[I-1], ' AND ', A[I+1]);
end.

{3.8}
program Thr8T82;
{ -- This BONUS program will guess the user's state. }
const
State: Array[1..50] of String =
'HAWAII','IDAHO','ILLINIOS','INDIANA','IOWA','KANSAS',
'KENTUCKY','LOUISIANA','MAINE','MARYLAND','MASSACHUSETTS',
'MICHIGAN','MINNESOTA','MISSISSIPPI','MISSOURI','MONTANA',
'NEW MEXICO','NORTH CAROLINA','NORTH DAKOTA','OHIO',
'OKLAHOMA','OREGON','SOUTH CAROLINA','SOUTH DAKOTA',
'PENNSYLVANIA','RHODE ISLAND','TENNESSEE','TEXAS','UTAH',
'VERMONT','VIRGINIA','WASHINGTON','WEST VIRGINIA',
'WISCONSIN','WYOMING');
var
I, G, B, M, E: Integer;
A:             String;

begin
G := 1;  B := 1;  M := 25;  E := 50;
repeat
Write (G, '- IS YOUR STATE ALPHABETICALLY BEFORE ', State[M]);
Writeln;
Write ('Enter YES or NO: ');  Readln (A);
if (A = 'YES') and (B+1 = M) then begin
Writeln (State[B], ' IS IT');  Exit;  end;
if (A = 'NO') and (M = E) then begin
Writeln (State[M], ' IS IT');  Exit;  end;
if A = 'YES' then begin
E := M - 1;  M := M - Round((M - B) / 2);  end
else begin
B := M;      M := M + Round((E - M) / 2);  end;
Inc(G);
until G > 12;
end.

```