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

{1.1}
program One1T91;
{ -- This program will display a phrase as a rectangle. }
uses Crt;
const
A = 'COMPUTER CONTEST 1991';
var
I, L: Byte;

begin
ClrScr;
Writeln(A);
L := Length(A);
for I := 2 to L - 1 do begin
GotoXY(1, I);  Write (Copy(A, I, 1));
GotoXY(L, I);  Write (Copy(A, L-I+1, 1));
end;
Writeln;
for I := L downto 1 do
Write (Copy(A, I, 1));
end.

{1.2}
program One2T91;
{ -- This program will display 2 random #s and their sum. }
var
X, Y: Integer;

begin
Randomize;
X := Random(19) - 9;
Y := Random(19) - 9;
Writeln (X, ' + ', Y, ' = ', X + Y);
end.

{1.3}
program One3T91;
{ -- This program prints the total point score for a team. }
var
I, P, Sum: Byte;
Nam:       String[20];

begin
Sum := 0;
Write ('Enter name: ');  Readln (Nam);
for I := 1 to 3 do begin
Write ('Enter # of ', I, ' point programs: ');
Sum := Sum + P * I;
end;
Writeln (Nam, ' SCORED ', Sum, ' POINTS');
end.

{1.4}
program One4T91;
{ -- This program displays a spreadsheet. }
uses Crt;
var
I: Byte;

begin
ClrScr;
Writeln ('   A B C D E F G H I J K L M N O P Q R S T');
for I := 1 to 20 do
Writeln (I:2);
end.

{1.5}
program One5T91;
{ -- This program determines the number of teams competing. }
var
X: Integer;

begin
Write ('Enter number of students: '); Readln (X);
Writeln (X div 4, ' TEAMS');
end.

{1.6}
program One6T91;
{ -- This program displays a word twice intersecting at a letter.}
uses Crt;
var
A:    String[12];
L:    String[1];
X, I: Byte;

begin
Write ('Enter word: ');  Readln (A);
Write ('Enter letter: ');  Readln (L);
X := Pos(L, A);
ClrScr;
GotoXY (1, X);  Writeln (A);
for I := 1 to Length(A) do begin
GotoXY (X, I);  Write (Copy(A, I, 1));
end;
end.

{1.7}
program One7T91;
{ -- This program displays fields from an account key. }
var
A: String[20];

begin
Write ('Enter account key: ');  Readln (A);
Writeln ('ORGANIZATION ', Copy(A, 1, 3));
Writeln ('BRANCH ',       Copy(A, 4, 3));
Writeln ('DEALER ',       Copy(A, 7, 4));
Writeln ('CLASS ',        Copy(A, 11, 3));
Writeln ('UNIT ',         Copy(A, 14, 6));
end.

{1.8}
program One8T91;
{ -- This program displays the # of job steps in JCL. }
var
L: String[5];
S: Byte;

begin
Write ('Enter line: ');  Readln (L);  S := 0;
while L <> '//' do begin
if L = 'EXEC' then Inc(S);
Write ('Enter line: ');  Readln (L);
end;
Writeln (S, ' JOB STEPS');
end.

{1.9}
program One9T91;
{ -- This program will replace MAN with PERSON. }
var
S: String[100];
M: String[3];
I: Byte;

begin
Write ('Enter sentence: ');  Readln (S);
for I := 1 to Length(S) do begin
M := Copy(S, I, 3);
if M = 'MAN' then begin
Write ('PERSON');  I := I + 2;  end
else if M = 'MEN' then begin
Write ('PERSONS');  I := I + 2; end
else
Write (Copy(S, I, 1));
end;
end.

{1.10}
program One10T91;
{ -- This program determines the winner of two computer teams. }
var
N1, N2: String[20];
T1, T2, TI1, TI2: Integer;
P1, P2, Pen1, Pen2, H1, H2, M1, M2: Byte;

begin
Write ('Enter team name: ');  Readln (N1);
Write ('Enter points, time, penalties: ');
Write ('Enter team name: ');  Readln (N2);
Write ('Enter points, time, penalties: ');

if P1 > P2 then
Write (N1)
else if P2 > P1 then
Write (N2)
else begin
H1 := T1 div 100;  M1 := T1 mod 100;
H2 := T2 div 100;  M2 := T2 mod 100;
TI1 := H1 * 60 + M1 + Pen1 * 5;
TI2 := H2 * 60 + M2 + Pen2 * 5;
if TI1 < TI2 then
Write (N1)
else
Write (N2);
end;
Writeln (' WINS');
end.

{2.1}
program Two1T91;
{ -- This program displays a pyramid of consecutive numbers. }
var
N, S, I, J: Byte;

begin
Write ('Enter N: ');  Readln (N);
S := 1;  I := 0;
while S < N do begin
Inc(I);
Write (' ': 20 - I * 2);
for J := 1 to I do begin
if S < 10 then Write ('0');
Write (S, '  ');
Inc(S);
end;
Writeln;
end;
end.

{2.2}
program Two2T91;
{ -- This program will line up numbers with decimal points. }
var
I, X, Code: Integer;
A:          Array [1..5] of String[9];
Y, Sum:     Real;

begin
for I := 1 to 5 do begin
Write ('Enter #: ');  Readln (A[I]);
end;
Sum := 0;
for I := 1 to 5 do begin
X := Pos('.', A[I]);
Writeln (' ': 6 - X, A[I]);
Val(A[I], Y, Code);
Sum := Sum + Y;
end;
Writeln (' ---------');
Writeln (Sum: 10:4);
end.

{2.3}
program Two3T91;
{ -- This program will convert BASIC to COBOL. }
var
S:  String[80];
M:  String[1];
MN: String[2];
I:  Byte;

begin
Write ('Enter statement: ');  Readln (S);
for I := 1 to Length(S) do begin
M  := Copy(S, I, 1);
MN := Copy(S, I, 2);
if (MN = '<=') or (MN = '=<') then
begin
Write ('IS NOT GREATER THAN');
Inc(I);
end
else if (MN = '>=') or (MN = '=>') then
begin
Write ('IS NOT LESS THAN');
Inc(I);
end
else if (MN = '<>') or (MN = '><') then
begin
Write ('IS NOT EQUAL TO');
Inc(I);
end
else if (M = '>') then
Write ('IS GREATER THAN')
else if (M = '<') then
Write ('IS LESS THAN')
else if (M = '=') then
Write ('IS EQUAL TO')
else
Write (M);
end;
end.

{2.4}
program Two4T91;
{ -- This program ranks teams in a league. }
var
N, I, J, R, X: Integer;
Na:   Array [1..9] of String[20];
W, L: Array [1..9] of Integer;
T:    String[20];

begin
Write ('Enter N: ');  Readln (N);
for I := 1 to N do begin
Write ('Enter wins, losses: ');  Readln (W[I], L[I]);
end;
for I := 1 to N - 1 do
for J := I + 1 to N do
if (W[I] < W[J]) or ((W[I] = W[J]) and (Na[I] > Na[J])) then
begin
X := W[I];  W[I] := W[J];  W[J] := X;
X := L[I];  L[I] := L[J];  L[J] := X;
T := Na[I]; Na[I]:=Na[J]; Na[J] := T;
end;
for I := 1 to N do begin
if W[I] = W[I - 1] then
Write (R)
else begin
Writeln;  Write(I);  R := I;
end;
Write (' ', Na[I], ' ': 14 - Length(Na[I]), W[I]);
Writeln (' , ', L[I]);
end;
end.

{2.5}
program Two5T91;
{ -- This program will guess a secret number within 7 tries. }
var
Increment, Guess, G: Byte;
A: Char;

begin
Increment := 64;  Guess := 64;  G := 0; A := ' ';
while A <> 'R' do begin
Inc(G);
Writeln ('GUESS ', G, ': ', Guess);
Write ('Enter H, L, or R: ');  Readln (A);
Increment := Increment div 2;
if A = 'L' then
Dec(Guess, Increment);
if A = 'H' then
Inc(Guess, Increment);
end;
end.

{2.6}
program Two6T91;
{ -- This program prints text in pyramid form. }
var
A, Lin:   String[255];
I, L, PL: Byte;
MD:       String[1];

begin
Write ('Enter text: ');  Readln (A);
L := Length(A);  I := 1;  PL := 0; Lin := '';
while I <= L do begin
MD := Copy(A, I, 1);
if MD <> ' ' then
Lin := Lin + MD
else if Length(Lin) < PL + 2 then
Lin := Lin + MD
else begin
PL := Length(Lin);
Writeln (' ': 20 - (PL div 2), Lin);
Lin := '';
end;
Inc(I);
end;
PL := Length(Lin);
Writeln (' ': 20 - (PL div 2), Lin);
end.

{2.7}
program Two7T91;
{ -- This program displays a rectangle of asterisks. }
uses Crt;
var
L, W, I, Row, Col: Byte;

begin
Write ('Enter length, width: '); Readln (L, W);
ClrScr;
Col := (80 - L) div 2;  Row := (24 - W) div 2;
GotoXY (Col, Row);
for I := 1 to L do Write ('*');
for I := 1 to W - 2 do begin
GotoXY (Col, Row + I);  Write ('*');
GotoXY (Col + L - 1, Row + I);  Write ('*');
end;
GotoXY (Col, Row + W - 1);
for I := 1 to L do Write ('*');
end.

{2.8}
program Two8T91;
{ -- This program displays a bar graph for lengths. }
uses Crt;
var
A:    Array [0..11] of Integer;
I, J: Byte;
Max:  Integer;
Inc:  Real;
T:    String[40];

begin
Write ('Enter title: ');  Readln (T);  Max := 0;
for I := 0 to 11 do begin
Write ('Enter # for ', 1980 + I, ': ');  Readln (A[I]);
if A[I] > Max then Max := A[I];
end;
Inc := Max / 20.0;
ClrScr;
Writeln (' ': 3, T, ' ': 3, 'ASTERISK = ', Inc: 7:2);
for I := 20 downto 1 do Writeln (I: 2);
for I := 1 to 12 * 3 + 2 do Write ('-');
Writeln;  Write (' ': 2);
for I := 0 to 11 do Write (80 + I: 3);
for I := 0 to 11 do
for J := 1 to Trunc(A[I] / Inc) do begin
GotoXY (I * 3 + 5, 22 - J);  Write ('*');
end;
GotoXY(1, 22);
end.

{2.9}
program Two9T91;
{ -- This program displays a store maintenance list. }
var
I, I1, I2, F1, F2: Byte;
AN, CN, DN:        Byte;
A, C, D:           Array [1..9] of String[10];
ID1, ID2:          Array [1..9] of String[4];
Item1, Item2:      Array [1..9] of Char;

begin
Write ('Enter # of entries in yesterday''s file: ');
for I := 1 to F1 do begin
Write ('Enter ID: ');  Readln (ID1[I]);
Write ('Enter item: ');  Readln (Item1[I]);
end;
Write ('Enter # of entries in today''s file: ');
for I := 1 to F2 do begin
Write ('Enter ID: ');  Readln (ID2[I]);
Write ('Enter item: ');  Readln (Item2[I]);
end;
ID2[F2 + 1] := 'ZZZZ';  ID1[F1 + 1] := '    ';
I1 := 1;  I2 := 1;  AN := 0;  CN := 0;  DN := 0;
while (I1 <= F1) or (I2 <= F2) do
if ID1[I1] = ID2[I2] then
if Item1[I1] <> Item2[I2] then  { -- Changed }
begin
Inc(CN);
C[CN] := ID1[I1] + ' ' + Item1[I1] + ' ' + Item2[I2];
Inc(I1);  Inc(I2);
end
else  { -- No change }
begin
Inc(I1);  Inc(I2);
end
else
if (ID1[I1] < ID2[I2]) and (I1 <= F1) then  { -- Deleted }
begin
Inc(DN);
D[DN] := ID1[I1] + ' ' + Item1[I1];
Inc(I1);
end
else
Inc(AN);
A[AN] := ID2[I2] + ' ' + Item2[I2];
Inc(I2);
end;

for I := 1 to AN do Writeln (A[I]);
Writeln;  Writeln ('CHANGED');
for I := 1 to CN do Writeln (C[I]);
Writeln;  Writeln ('DELETED');
for I := 1 to DN do Writeln (D[I]);
Writeln;
Writeln ('TOTAL ADDED = ', AN);
Writeln ('TOTAL CHANGED = ', CN);
Writeln ('TOTAL DELETED = ', DN);
end.

{2.10}
program Two10T91;
{ -- This program displays the contents of contest diskettes. }
uses Crt;
const
Z: Array [1..6] of String[3] =
('PRB', 'JDG', 'PG1', 'PG2', 'BAS', 'PAS');
X: Array [1..3] of String[3] = ('ONE', 'TWO', 'THR');
var
I, J, K, P, Y, Tot: Byte;
Year: String[4];
YY:   String[2];
Ch:   Char;

begin
Write ('Enter year: ');  Readln (Year);
YY := Copy(Year, 3, 2);
for I := 1 to 4 do
for J := 1 to 3 do
Writeln ('FHS', YY, '-', J, '.', Z[I]);

Tot := 12;
for I := 5 to 6 do
for J := 1 to 3 do begin
P := 10;
if (YY = '80') and (J = 3) then P := 12;
if (YY = '81') then P := 5;
if (YY = '82') and (J = 2) then P := 12;
if (YY = '82') and (J = 3) then P := 8;
for K := 1 to P do begin
Writeln (X[J], K, 'T', YY, '.', Z[I]);
Inc(Tot);
if Tot = 20 then begin
Tot := 0;
end;
end;
end;  { -- for J }

end.

{3.1}
program Thr1T91;
{ -- This program simulates a baseball game. }
uses Crt;
var
I, Inn, T, S, B, W, R, O, Wtot, Otot: Byte;
Stot, Btot: Integer;
Run:        Array [1..2] of Byte;

begin
Randomize;  ClrScr;  Writeln;  Write (' ': 7);
for I := 1 to 9 do Write (I:3);
Writeln ('  SCORE');
Write (' ': 8);
for I := 1 to 34 do Write ('-');
Writeln;
Writeln ('TEAM A !', ' ': 27, '!');
Writeln ('TEAM B !', ' ': 27, '!');
Stot := 0;  Btot := 0;  Otot := 0;  Wtot := 0;
Run[1] := 0;  Run[2] := 0;

for Inn := 1 to 9 do
for T := 1 to 2 do begin
S := 0;  B := 0;  W := 0;  R := 0;  O := 0;
while O < 3 do begin
if Random < 0.4 then begin
Inc(S);  Inc(Stot);  end
else begin
Inc(B);  Inc(Btot);
end;
if S = 3 then begin
Inc(O);  Inc(Otot);  S := 0;  W := 0;
end;
if B = 4 then begin
Inc(W);  Inc(Wtot);  B := 0;  S := 0
end;
if W = 4 then begin
Inc(R);  Inc(Run[T]);  W := 3;
end;
end;
GotoXY (6 + Inn * 3, 3 + T);  Write (R:2);
end;  { -- for T }

GotoXY (38, 4);  Writeln (Run[1]: 3);
GotoXY (38, 5);  Writeln (Run[2]: 3);
Writeln;
Writeln ('TOTAL # OF STRIKES: ', Stot);
Writeln ('TOTAL # OF BALLS: ', Btot);
Writeln ('TOTAL # OF WALKS: ', Wtot);
Writeln ('TOTAL # OF STRIKE OUTS: ', Otot);
end.

{3.2}
program Thr2T91;
{ -- This program displays the units digit in a power expression.}
var
A, X: Array [1..3] of Integer;
I, J, Pow, Sum, C:    Integer;

begin
Write ('Enter A, X: ');  Readln (A[1], X[1]);
Write ('Enter B, Y: ');  Readln (A[2], X[2]);
Write ('Enter C, Z: ');  Readln (A[3], X[3]);
Sum := 0;
for I := 1 to 3 do begin
Pow := 1;
for J := 1 to X[I] do begin
Pow := Pow * A[I];
C := Pow div 10;
Pow := Pow - C * 10;
end;
Sum := Sum + Pow;
end;
C := Sum div 10;
Writeln (Sum - C * 10);
end.

{3.3}
program Thr3T91;
{ -- This program displays all digits in X ^ Y. }
var
A: Array [1..200] of Integer;
X, Y, I, J, Dig, C, CC: Integer;

begin
Write ('Enter X, Y: ');  Readln (X, Y);
Dig := 1;  A[1] := 1;  C := 0;
for I := 1 to Y do begin
for J := 1 to Dig do begin
A[J] := A[J] * X + C;
C := A[J] div 10;
A[J] := A[J] - C * 10;
end;
while C > 0 do begin
CC := C div 10;
Dig := Dig + 1;
A[Dig] := C - CC * 10;
C := CC;
end;
end;
for I := Dig downto 1 do Write (A[I]);
end.

{3.4}
program Thr4T91;
{ -- This program assigns user LOGON IDs to names. }
var
N, Fn, Mn, Ln, Init, In2, N2: Array [1..9] of String[20];
T, I, J, M, F, Y, A, B:       Byte;
C:                            Array [1..9] of Byte;
MD:                           String[1];
W, X:                         String[20];

begin
Write ('Enter name: ');  Readln (N[1]);  T := 1;
while N[T] <> 'END' do begin
Inc(T);
Write ('Enter name: ');  Readln (N[T]);
end;
{ -- Extract parts of name for initials }
Dec(T);
for I := 1 to T do begin
W := '';  M := 0;  F := 0;
for J := 1 to Length(N[I]) do begin
MD := Copy (N[I], J, 1);
if MD <> ' ' then
W := W + MD
else
if F = 1 then begin
Mn[I] := W;  M := 1; W := '';  end
else begin
Fn[I] := W;  F := 1; W := ''; end;
end;  { -- for J }
if M = 0 then Mn[I] := 'X';
Ln[I] := W;
Init[I] := Copy(Fn[I],1,1) + Copy(Mn[I],1,1) + Copy(Ln[I],1,1);
In2[I] := Init[I];  N2[I] := Ln[I] + ' ' + Fn[I];  C[I] := I;
end;  { -- for I }
{ -- Sort Initials }
for I := 1 to T - 1 do
for J := I + 1 to T do
if In2[I] > In2[J] then begin
X := In2[I];  In2[I] := In2[J];  In2[J] := X;
X := N2[I];   N2[I]  := N2[J];   N2[J]  := X;
Y := C[I];    C[I]   := C[J];    C[J]   := Y;
end;
{ -- Sort names within same initials and assign numbers. }
J := 0;
while J < T - 1 do begin
I := J + 1;  J := I + 1;
while (In2[I] <> In2[J]) and (I < T) do begin
Inc(I);  Inc(J);
end;
while (In2[I] = In2[J]) do  Inc(J);
Dec(J);
for A := I to J - 1 do
for B := A + 1 to J do
if N2[A] > N2[B] then begin
X := N2[A];  N2[A] := N2[B];  N2[B] := X;
Y := C[A];   C[A]  := C[B];   C[B]  := Y;
end;
{ -- Assign numbers for middle initial }
for A := I to J do
Init[C[A]] := Copy(Init[C[A]],1,1) + Chr(48 + (A - I + 1))
+ Copy(Init[C[A]],3,1);
end;  { -- while }
for I := 1 to T do
Writeln (N[I], ' ': 19 - Length(N[I]), 'SD', Init[I], '1');
end.

{3.5}
program Thr5T91;
{ -- This program displays the digits 0 - 9 in enlarged form. }
{    1    The data contains the         }
{   2 3   line segment #s (on the left) }
{    4    that need to be displayed to  }
{   5 6   produce the corresponding     }
{    7    digits: 0,1,2,3,4,5,6,7,8,9.  }
uses Crt;
const
A: Array [0..9] of String[7] =
('123567', '36', '13457', '13467', '2346',
'12467', '124567', '136', '1234567', '12346');
var
N, I, J, X: Byte;

begin
for N := 0 to 9 do begin
ClrScr;
for J := 1 to Length(A[N]) do begin
X := Ord(A[N,J]) - Ord('0');
Case X of
1: begin
GotoXY (1,1); for I := 1 to 11 do Write ('*');
end;
2: for I := 1 to 8 do begin
GotoXY (1, I);  Write ('*');
end;
3: for I := 1 to 8 do begin
GotoXY (11, I);  Write ('*');
end;
4: begin
GotoXY (1,8); for I := 1 to 11 do Write ('*');
end;
5: for I := 1 to 8 do begin
GotoXY (1, I+7);  Write ('*');
end;
6: for I := 1 to 8 do begin
GotoXY (11, I+7);  Write ('*');
end;
7: begin
GotoXY (1, 15);  for I := 1 to 11 do Write ('*');
end;
end;  { -- case }
end;  { -- next J }
Delay (1000);
end;  { -- next N }
end.

{3.6}
program Thr6T91;
{ -- This program will evaluate an expression with (). }
var
I, J, N, S, P: Byte;
A:       String[50];
Ch:      Char;
P1, Num: Array [1..10] of Integer;
SY:      Array [1..9]  of String[1];

begin
Write ('Enter expression: ');  Readln (A);
P := 0;  S := 0;  N := 0;
for I := 1 to Length(A) do begin
Ch := A[I];
if Ch = '(' then begin
Inc(P);  P1[P] := S + 1;  end
else if (Ch = '+') or (Ch = '-') then begin
Inc(S);  SY[S] := Ch; end
else if (Ch >= '0') and (Ch <= '9') then begin
Inc(N);  Num[N] := Ord(Ch) - 48;  end
else if Ch = ')' then begin
for J := P1[P] to S do begin
if SY[J] = '-' then Num[J+1] := Num[J] - Num[J+1];
if SY[J] = '+' then Num[J+1] := Num[J] + Num[J+1];
end;
N := P1[P];  Num[N] := Num[S + 1];
S := P1[P] - 1;  Dec(P);
end;
end;
for I := 1 to S do begin
if SY[I] = '-' then Num[I+1] := Num[I] - Num[I+1];
if SY[I] = '+' then Num[I+1] := Num[I] + Num[I+1];
end;
Writeln (Num[N]);
end.

{3.7}
program Thr7T91;
{ -- This program displays the two pay days for a given month. }
const
Mname: Array [1..12] of String[9] = ('JANUARY', 'FEBRUARY',
'MARCH', 'APRIL', 'MAY', 'JUNE', 'JULY,', 'AUGUST',
'SEPTEMBER', 'OCTOBER', 'NOVEMBER', 'DECEMBER');
Mon: Array [1..12] of Byte =
(31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
Dname: Array [1..7] of String[9] = ('MONDAY', 'TUESDAY',
'WEDNESDAY', 'THURSDAY', 'FRIDAY', 'SATURDAY', 'SUNDAY');
var
I, T, H, Hol, Wkend, X, MNum: Byte;
Mhol, Dhol: Array [1..12] of Byte;
Day, Days:  Array [1..2]  of Integer;

begin
H := 1;
Write ('Enter holiday MM, DD: ');  Readln (Mhol[H], Dhol[H]);
while Mhol[H] > 0 do begin
Inc(H);
Write ('Enter holiday MM, DD: ');  Readln (Mhol[H], Dhol[H]);
end;
Dec(H);  Writeln;
Write ('Enter month #: ');  Readln (MNum);  Writeln;
while MNum > 0 do begin
Days[1] := 0;
for I := 1 to MNum - 1 do
Days[1] := Days[1] + Mon[I];
Day[1] := 15;  Day[2] := Mon[MNum];
Days[2] := Days[1] + Day[2];
Days[1] := Days[1] + Day[1];
for T := 1 to 2 do begin
Hol := 1;  Wkend := 1;
{ -- Decrement days counter if holiday or weekend. }
while (Hol = 1) or (Wkend = 1) do begin
Hol := 0;  Wkend := 0;
for I := 1 to H do
if (Mhol[I] = MNum) and (Dhol[I] = Day[T]) then begin
Dec(Day[T]);
Dec(Days[T]);  Hol := 1;
end;
X := Days[T] mod 7;
if (X = 5) or (X = 6) then begin  { -- Sat. or Sun. }
Dec(Day[T]);
Dec(Days[T]);  Wkend := 1;
end;
end;  { -- while }
Writeln (Dname[X+1], ' ', Mname[MNum], ' ', Day[T]);
end;  { -- for T }
Writeln;  Write ('Enter month #: ');  Readln (Mnum);  Writeln;
end;  { -- while }
end.

{3.8}
program Thr8T91;
{ -- This program will display 3 x 3 magic squares. }
var
Dig, Row, Col, I, J, P, Rot, X: Byte;
A: Array [1..3,1..3] of Byte;

begin
A[1,1] := 6;  A[1,2] := 7;  A[1,3] := 2;
A[2,1] := 1;  A[2,2] := 5;  A[2,3] := 9;
A[3,1] := 8;  A[3,2] := 3;  A[3,3] := 4;
Write ('Enter digit: ');  Readln (Dig);
Write ('Enter row, col: ');  Readln (Row, Col);
Rot := 1;
while (A[Row,Col] <> Dig) and (Rot < 4) do begin
{ -- Rotate outer numbers clockwise, at most 3 times }
X := A[1,1];  A[1,1] := A[3,1];  A[3,1] := A[3,3];
A[3,3] := A[1,3];  A[1,3] := X;
X := A[1,2];  A[1,2] := A[2,1];  A[2,1] := A[3,2];
A[3,2] := A[2,3];  A[2,3] := X;
Inc(Rot);
end;
if A[Row,Col] <> Dig then begin
Writeln ('NO SOLUTION');  Exit;
end;
for P := 1 to 2 do begin
for I := 1 to 3 do begin
for J := 1 to 3 do
Write (A[I,J], '  ');
Writeln;
end;
Writeln;
if P = 1 then begin
if (Row = 1) and (Col = 3) or (Row = 3) and (Col = 1) then
begin
X := A[2,1];  A[2,1] := A[3,2];  A[3,2] := X;
X := A[1,1];  A[1,1] := A[3,3];  A[3,3] := X;
X := A[1,2];  A[1,2] := A[2,3];  A[2,3] := X;
end;
if (Row = 1) and (Col = 1) or (Row = 3) and (Col = 3) then
begin
X := A[1,2];  A[1,2] := A[2,1];  A[2,1] := X;
X := A[1,3];  A[1,3] := A[3,1];  A[3,1] := X;
X := A[3,2];  A[3,2] := A[2,3];  A[2,3] := X;
end;
if (Row = 1) and (Col = 2) or (Row = 3) and (Col = 2) then
begin
X := A[1,1];  A[1,1] := A[1,3];  A[1,3] := X;
X := A[2,1];  A[2,1] := A[2,3];  A[2,3] := X;
X := A[3,1];  A[3,1] := A[3,3];  A[3,3] := X;
end;
if (Row = 2) and (Col = 1) or (Row = 2) and (Col = 3) then
begin
X := A[1,1];  A[1,1] := A[3,1];  A[3,1] := X;
X := A[1,2];  A[1,2] := A[3,2];  A[3,2] := X;
X := A[1,3];  A[1,3] := A[3,3];  A[3,3] := X;
end;
end;
end;  { -- for P }
end.

{3.9}
program Thr9T91;
{ -- This program will display a pie graph. }
uses Crt;
const
L:  Array [1..3] of Char = ('A', 'D', 'N');
PI: Real = 3.1415926;
var
A:  Array[1..21, 1..21] of Byte;
P:  Array[1..3] of Byte;
I:  Real;
Ch: Char;
J, K, R, X, Y, S, Sum, LSum: Integer;

begin
Write ('Enter 3 percentages: ');  Readln (P[1], P[2], P[3]);
ClrScr;
for J := 1 to 21 do
for K := 1 to 21 do
A[J, K] := 0;
{ -- Draw Circle }
I := -PI / 2.0;
while I < 3 / 2 * PI do begin
X := Trunc(Cos(I) * 10);  Y := Trunc(Sin(I) * 10);
GotoXY (11 + X, 11 + Y);  Write ('*');
A[11 + X, 11 + Y] := 1;  I := I + 0.1;
end;
{ -- Draw 3 line segments from center }
Sum := 0;
for S := 0 to 2 do begin
Sum := Sum + P[S];
I := -PI / 2 + 2 * PI * Sum / 100.0;
for R := 0 to 10 do begin
X := Trunc(Cos(I) * R);  Y := Trunc(Sin(I) * R);
GotoXY (11 + X, 11 + Y);  Write ('*');
A[11 + X, 11 + Y] := 1;
end;
end;
Ch := ReadKey;  Sum := 0;
{ -- fill regions with letters }
for S := 1 to 3 do begin
LSum := Sum;  Sum := Sum + P[S];  J := LSum;
while J < Sum do begin
I := -PI / 2 + 2 * PI * J / 100.0;
for R := 1 to 9 do begin
X := Trunc(Cos(I) * R);  Y := Trunc(Sin(I) * R);
if A[11 + X, 11 + Y] = 0 then begin
GotoXY (11 + X, 11 + Y);  Write (L[S]);
end;
end;
Inc(J);
end;
end;
end.

{3.10}
program Thr10T91;
{ -- This program will convert large numbers in base 2,4,8,16. }
var
A:     Array [1..255] of Byte;
D:     String[1];
NumSt: String[65];
I, J, K, L, M, N, X, Num, DigN,
DigM, Pad, Ind, Pow, LInd, Zero, Sum: Byte;

begin
Write ('Enter numeral: ');  Readln (NumSt);
Write ('Enter base M: ');   Readln (M);
Write ('Enter base N: ');   Readln (N);
L := Length (NumSt);
DigM := Trunc (Ln (M) / Ln (2) + 0.001);
DigN := Trunc (Ln (N) / Ln (2) + 0.001);
Pad := DigN - (DigM * L mod DigN);
for I := 1 to Pad do  A[I] := 0;
{ -- Convert from base M to base 2 }
for I := 1 to L do begin
D := Copy (NumSt, I, 1);
Num := Pos (D, '0123456789ABCDEF') - 1;
for J := DigM - 1 downto 0 do begin
Pow := 1;
for K := 1 to J do Pow := Pow * 2;
X := Num div Pow;
Ind := I * DigM - J + Pad;
A[Ind] := X;
Num := Num - X * Pow;
end;
end;
{ -- Convert from base 2 to base N }
LInd := DigM * L + Pad;  Zero := 1;
for I := 0 to (Lind div Dign) - 1 do begin
Sum := 0;
for J := 1 to DigN do begin
Ind := I * DigN + J;
Pow := 1;
for K := 1 to (DigN - J) do  Pow := Pow * 2;
Sum := Sum + A[Ind] * Pow;
end;
if (Zero = 0) or (Sum > 0) then begin
Zero := 0;
Write (Copy ('0123456789ABCDEF', Sum + 1, 1));
end;
end;
end.

```