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

{1.1}
program One1T95;
{ -- This program displays title of contest forward/backward. }
const
A: String =
'FLORIDA HIGH SCHOOLS COMPUTING COMPETITION ''95';
var
I, J: Integer;

begin
for I := 1 to 4 do begin
Writeln (A);
for J := Length(A) downto 1 do
Write(Copy(A, J, 1));
Writeln;
end;
end.

{1.2}
program One2T95;
{ -- This program generates comments in different languages. }
var
C: String;

begin
Write ('Enter comment: ');  Readln (C);
Writeln ('BASIC: '' ', C);
Writeln ('PASCAL: { ', C, ' }');
Writeln ('C: /* ', C, ' */');
Writeln ('C++: // ', C);
end.

{1.3}
program One3T95;
{ -- This program either increments or decrements N by 1. }
var
N:  Integer;
Op: String;

begin
Write ('Enter N: ');  Readln (N);
Write ('Enter operator: ');  Readln (Op);
if Op = '++' then
Writeln (N + 1)
else
Writeln (N - 1);
end.

{1.4}
program One4T95;
{ -- This program rounds to three places by break point. }
var
BP:  Integer;
Num: Real;

begin
Write ('Enter break point: ');  Readln (BP);
Write ('Enter number: ');  Readln (Num);
Writeln ( Trunc((Num * 1000 + (10 - BP) / 10)) / 1000 :5:3);
end.

{1.5}
program One5T95;
{ -- This program determines if a program is a REXX or a CLIST. }
var
C: String;

begin
Write ('Enter comment: ');  Readln (C);
if Pos('REXX', C) > 0 then
Writeln ('REXX')
else
Writeln ('CLIST');
end.

{1.6}
program One6T95;
{ -- This program displays the number of times variables appear.}
var
Num, Init, Init0: Integer;

begin
Write ('Enter number of variables: ');  Readln (Num);
Write ('Enter number initialized: ');   Readln (Init);
Write ('Enter number initialized to 0: ');  Readln (Init0);
Writeln ('BASIC = ', Init - Init0);
Writeln ('PASCAL = ', Num + Init);
Writeln ('C/C++ = ', Num);
end.

{1.7}
program One7T95;
{ -- This program displays last qualifier of a data set name. }
var
DSN:  String;
Last: String;
I:    Integer;
Ch:   Char;

begin
Write ('Enter data set name: ');  Readln (DSN);
Last := '';
for I := Length(DSN) downto 1 do begin
Ch := DSN[I];
if Ch = '.' then begin
Writeln (Last); Exit; end
else
Last := Ch + Last;
end;
end.

{1.8}
program One8T95;
{ -- This program displays real numbers in reverse order. }
var
I, N: Byte;
A:    Array[1..10] of String;

begin
Write ('Enter N: ');  Readln (N);
for I := 1 to N do begin
Write ('Enter #: ');  Readln (A[I]);
end;
Writeln;
for I := N downto 1 do
Writeln (A[I]);
end.

{1.9}
program One9T95;
{ -- This program displays a large X made up of letter X's. }
uses Crt;
var
Num, I: Byte;

begin
Write ('Enter number of X''s: ');  Readln (Num);
ClrScr;
for I := 1 to Num do begin
GotoXY (I, I);  Write ('X');
GotoXY (Num - I + 1, I);  Write ('X');
end;
end.

{1.10}
program One10T95;
{ -- This program will display the savings in postage. }
const
Cost = 23.33333;
var
PS, SS, Oz1, Oz2, Page1, Page2: Integer;

begin
Write ('Enter # of printed sides: ');  Readln (PS);
Write ('Enter # of single sided pages: ');  Readln (SS);
{ -- Calculate # of pages and wieght for 1st bill }
Page1 := PS - 6;  Oz1 := 1;
Oz1 := Oz1 + (Page1 + 8) div 9;
{ -- Calculate # of pages and wight for 2nd bill }
Page2 := SS + ((PS - SS + 1) div 2) - 6;
Oz2 := 1;
Oz2 := Oz2 + (Page2 + 8) div 9;
Writeln ((Oz1 - Oz2) * Cost :6:2, ' CENTS SAVED');
end.

{2.1}
program Two1T95;
{ -- This program finds integral solutions of (X,Y) for AX+BY=C }
var
A, B, C, X: Integer;
Y:          Real;

begin
Write ('Enter A, B, C: ');  Readln (A, B, C);
X := 1;
repeat
Y := (C - A * X) / B;
if Abs(Y - Trunc(Y)) < 0.001 then begin
Writeln ('(', X, ',', Y :1:0, ')');  Exit;
end;
Inc(X);
until X > 10000;
end.

{2.2}
program Two2T95;

{ -- This program verifies a number by validating check digit. }
var
Part:            String;
Prod, Sum, Code: Integer;
I, L, Digit, ChkDigit, LastDigit: Byte;

begin
Write ('Enter part number: ');  Readln (Part);
L := Length(Part);  Prod := 1;
for I := 1 to L - 1 do begin
Val(Copy(Part, I, 1), Digit, Code);
Sum := Sum + Digit * ((I mod 2) + 1);
end;
{ -- Subtract units digit of Sum from 9 for check digit }
ChkDigit := 9 - (Sum mod 10);
Val(Copy(Part, L, 1), LastDigit, Code);
if ChkDigit = LastDigit then
Writeln ('OKAY')
else
Writeln ('ERROR -- CHECK DIGIT SHOULD BE ', ChkDigit);
end.

{2.3}
program Two3T95;
{ -- This program determines # of prizes given of \$13 million. }
var
Prize: LongInt;
Pow:   Array[0..7] of LongInt;
A:     Array[0..6] of Byte;
I:     Byte;

begin
Prize := 13000000;
{ -- Same algorithm is used as converting # to base 13 #. }
Pow := 1;
for I := 1 to 7 do Pow := Pow * 13;
for I := 6 downto 0 do begin
Pow[I] := Pow[I+1] div 13;
A[I]   := Prize div Pow[I];
Prize  := Prize mod Pow[I];
end;
for I := 0 to 6 do
Writeln ('\$', Pow[I], ' = ', A[I]);
end.

{2.4}
program Two4T95;
{ -- This program determines the cost of Directory Assistance. }
var
DAC, Area:      String;
I, N, LocalDAC: Byte;
Tot, Cost:      Real;

begin
Write ('Enter number of DACs: ');  Readln (N);
for I := 1 to N do begin
Write ('Enter DAC: ');  Readln (DAC);
if DAC = '00' then
Cost := 3.00
else if DAC = '1411' then begin
Inc(LocalDAC);  Cost := 0;  end
else begin
Area := Copy(DAC, 2, 3);
if Area = '813' then
Cost := 0.25
else
if (Area = '305') or (Area = '407') or (Area = '904') then
Cost := 0.40
else
Cost := 0.65;
end;
Tot := Tot + Cost;
end;  { -- for I }
{ -- Every local DAC after the third cost 25 cents }
if LocalDAC > 3 then
Tot := Tot + (LocalDAC - 3) * 0.25;
Writeln (Tot: 5:2, ' DOLLARS');
end.

{2.5}
program Two5T95;
{ -- This program will display the heading of even/odd pages. }
const
PNum: Array [1..4] of Integer = (180, 140, 200, 260);
P:    Array [1..4] of String =
('PROBLEMS', 'JUDGING CRITERIA',
'BASIC SOLUTIONS', 'PASCAL SOLUTIONS');
var
I, Pag, Page, Chapter: Integer;

begin
Write ('Enter page number: ');  Readln (Page);
if Page mod 2 = 0 then begin
Write (Page, '  FLORIDA HIGH SCHOOLS COMPUTING COMPETITION');
Writeln (' 1985 - 1994');
end
else begin
Write ('FHSCC ''');
I := 1;  Pag := Page;
while Pag > PNum[I] do begin
Pag := Pag - PNum[I];  Inc(I);
end;
Chapter := Trunc(Pag / (PNum[I] / 10));
Writeln (85 + Chapter, ' ', P[I], '  ', Page);
end;
end.

{2.6}
program Two6T95;
{ -- This program computes total ESTIMATED PREPARATION TIME. }
const
Form: Array[1..6] of String = ('1040','A','B','C','D','E');
Hr  : Array[1..6,1..4] of Integer = ((3,2,4,0), (2,0,1,0),
(0,0,0,0), (6,1,2,0), (0,0,1,0), (2,1,1,0));
Min : Array[1..6,1..4] of Integer = ((8,53,41,53),
(32,26,10,27), (33,8,17,20), (26,10,5,35),
(51,42,1,41), (52,7,16,35));
var
I, J, TotHr, TotMin: Integer;
F: String;

begin
I := 0;
repeat
Write ('Enter form: ');  Readln (F);
I := 1;
while (I < 7) and (F <> Form[I]) do Inc(I);
if I < 7 then
for J := 1 to 4 do begin
Inc(TotHr, Hr[I,J]);
Inc(TotMin, Min[I,J]);

end;
until I > 6;

Inc(TotHr, TotMin div 60);
TotMin := TotMin mod 60;
Writeln (TotHr, ' HR., ', TotMin, ' MIN.');
end.

{2.7}
program Two7T95;
{ -- This program will calculate investments at GTE. }
const
BegPrice: Real = 27.20;
Return401K: Real = 0.14;
var
Salary, Percent, EndPrice, StockGain: Real;
CompCont, EmpCont, K401, TotalGain:   Real;
MaxShares, Shares:                    Integer;

begin
Write ('Enter salary: ');  Readln (Salary);
Write ('Enter 401K %: ');  Readln (Percent);
Percent := Percent / 100;
MaxShares := Trunc(Salary / 100);
Writeln ('YOU CAN PURCHASE UP TO ', MaxShares, ' SHARES');
Write ('Enter number of shares: ');  Readln (Shares);
Write ('Enter end of year price: '); Readln (EndPrice);

EmpCont := Salary * Percent;
if Percent >= 0.06 then
CompCont := (Salary * 0.06) * 0.75
else
CompCont := (Salary * Percent) * 0.75;
K401 := (EmpCont + CompCont) * Return401K;
StockGain := Shares * (EndPrice - BegPrice);
TotalGain := CompCont + K401 + StockGain;

Writeln ('COMPANY CONTRIBUTION: ', CompCont  :8:2);
Writeln ('         401K RETURN: ', K401      :8:2);
Writeln ('          STOCK GAIN: ', StockGain :8:2);
Writeln ('          TOTAL GAIN: ', TotalGain :8:2);
end.

{2.8}
program Two8T95;
{ -- This program will produce loops of a spiral using letters. }
uses Crt;
var
Num, Row, Col, Incr, LoopNum, I: Byte;
Let: Char;

begin
Write ('Enter number of spiral loops: ');  Readln (Num);
Write ('Enter first letter: ');  Readln (Let);
ClrScr;
Row := 12;  Col := 40;  Incr := 1;
while LoopNum < Num do begin
Incr := Incr + 2;
{ -- Go right }
GotoXY (Col, Row);  for I := 1 to Incr do Write (Let);
Col := Col + Incr - 1;
{ -- Go down }
for I := 1 to Incr - 1 do begin
GotoXY (Col, Row + I);  Write (Let);
end;
Row := Row + Incr - 1;  Incr := Incr + 2;
{ -- Go left }
Col := Col - Incr + 1;
GotoXY (Col, Row);  for I := 1 to Incr do Write (Let);
{ -- Go up }
for I := 1 to Incr - 2 do begin
GotoXY (Col, Row - I);  Write (Let);
end;
Row := Row - Incr + 1;
if Let = 'Z' then
Let := 'A'
else
Let := Chr(Ord(Let) + 1);
Inc(LoopNum);
end;
end.

{2.9}
program Two9T95;
{ -- This program shows all possible moves for a Queen in chess.}
uses Crt;
var
Col, Row, I, J, Code: Integer;
RC:    String;
R, C:  Array[1..4] of Integer;

begin
Write ('Enter column and row: ');  Readln (RC);
Col := Ord(RC) - Ord('A') + 1;
Val(Copy(RC, 2, 1), Row, Code);
Row := 9 - Row;
ClrScr;
for I := 8 downto 1 do Writeln (I);
Writeln ('  A B C D E F G H');
{ -- Horizontal moves }
GotoXY (3, Row);  Writeln ('* * * * * * * *');
{ -- Vertical moves }
for I := 1 to 8 do begin
GotoXY (Col * 2 + 1, I);  Write ('*');
end;
{ -- Diagonal moves }
for I := 1 to 7 do begin
R := Row - I;  C := Col - I;
R := Row + I;  C := Col + I;
R := Row - I;  C := Col + I;
R := Row + I;  C := Col - I;
for J := 1 to 4 do
if (R[J] > 0) and (R[J] < 9) and (C[J] > 0) and (C[J] < 9)
then begin
GotoXY (C[J] * 2 + 1, R[J]);  Write ('*');
end;
end;
GotoXY (Col * 2 + 1, Row);  Write('Q');
end.

{2.10}
program Two10T95;
{ -- This program tabulates information during a pre-election. }
const
A: Array[1..10] of String = ('MALE', 'FEMALE',
'50 AND BELOW', 'OVER 50', 'WHITE', 'OTHERS',
'ABOVE \$25000', '\$25000 AND BELOW',
'WHITE MALE OVER 50 AND ABOVE \$25000', 'OTHER');
var
Sex, Race, Party:         Char;
Income:                   LongInt;
Row, Col, Age, Total:     Byte;
Sum: Array[1..10,1..2] of Byte;

begin
Total := 0;
for Row := 1 to 10 do
for Col := 1 to 2 do
Sum[Row, Col] := 0;
Write ('Enter sex: ');  Readln (Sex);
while (Sex <> 'E') do begin
Write ('Enter age: ');    Readln (Age);
Write ('Enter race: ');   Readln (Race);
Write ('Enter income: '); Readln (Income);
Write ('Enter party: ');  Readln (Party);
if Party = 'D' then Col := 1 else Col := 2;
if Sex = 'M'   then Row := 1 else Row := 2;
Inc(Sum[Row,Col]);
if Age <= 50   then Row := 3 else Row := 4;
Inc(Sum[Row,Col]);
if Race = 'W'  then Row := 5 else Row := 6;
Inc(Sum[Row,Col]);
if Income > 25000 then Row := 7 else Row := 8;
Inc(Sum[Row,Col]);
if (Race = 'W') and (Sex = 'M') and (Age > 50) and (Row = 7)
then Row := 9 else Row := 10;
Inc(Sum[Row,Col]);
Inc(Total);
Writeln;
Write ('Enter sex: ');  Readln (Sex);
end;
Write (' ':32, 'DEMOCRATIC  REPUBLICAN');
for Row := 1 to 10 do begin
if Row mod 2 = 1 then Writeln;
Write (A[Row], ' ': 37 - Length(A[Row]));
Write (Sum[Row, 1] / Total * 100 :5:1);
Writeln (' ':7, Sum[Row,2] / Total * 100 :5:1);
end;
end.

{3.1}
program Thr1T95;
{ -- This program will determine how much IRS owes/pays. }
const
Amount:    Array[0..5] of Real =
(0, 22750, 55100, 115000, 250000, 9999999);
Rate:      Array[0..5] of Real =
(0, 0.15, 0.28, 0.31, 0.36, 0.396);
StDeduct:  Real = 3800;
Exemption: Real = 2450;
var
Gross, Deductions, FedTax, Income, TaxInc, Tax: Real;
I, J: Byte;

begin
Write ('Enter adjusted gross income: ');  Readln (Gross);
Write ('Enter itemized deductions: ');  Readln (Deductions);
Write ('Enter federal income tax withheld: ');
if Deductions > StDeduct then
Income := Gross - Deductions
else
Income := Gross - StDeduct;
TaxInc := Income - Exemption;

Tax := 0;
for I := 1 to 5 do
if TaxInc <= Amount[I] then begin
for J := 1 to I - 1 do
Tax := Tax + (Amount[J] - Amount[J-1]) * Rate[J];
Tax := Tax + (TaxInc - Amount[I-1]) * Rate[I];
Write (Abs(Tax - FedTax) :9:2, ' DOLLARS ');
if FedTax < Tax then
Writeln ('YOU OWE')
else
Writeln ('WILL BE REFUNDED TO YOU');
Exit;
end;
end.

{3.2}
program Thr2T95;
{ -- This program will display a simplified phone bill. }
var
I, L, HH, Code:          Integer;
Rate1, Rate2, Tot, Disc: Real;
Min:     Array[1..10] of Byte;
Tim:     Array[1..10] of String;
Charge:  Array[1..10] of Real;
AM, Day: String;
Midday:  Boolean;

begin
L := 1;  Tot := 0;
Write ('Enter MIN: ');  Readln (Min[L]);
while Min[L] > 0 do begin
Write ('Enter time: ');  Readln (Tim[L]);
Inc(L);
Write ('Enter MIN: ');   Readln (Min[L]);
end;
Dec(L);
{ -- Display bill }
Writeln ('  BOB SMITH  (813) 555-1234');  Writeln;
Writeln ('  TIME OF DAY  MIN.  CHARGE');
for I := 1 to L do begin
if Copy(Tim[I], 1, 1) = '0' then
Write (' ', Copy (Tim[I], 2, 12))
else
Write (Tim[I]);
{ -- Calculate charge }
Val(Copy(Tim[I], 1, 2), HH, Code);
AM := Copy(Tim[I], 7, 2);
Day := Copy(Tim[I], 11, 3);
Midday := (  (HH > 7)  and (HH < 12) and (AM = 'AM')
or (HH = 12) and (AM = 'PM')
or (HH < 5)  and (AM = 'PM') );
if (HH > 4) and (HH < 11) and (AM = 'PM') and (Day <> 'SAT')
then
begin
Rate1 := 0.21;  Rate2 := 0.16;
end
else if Midday and (Day <> 'SAT') and (Day <> 'SUN') then
begin
Rate1 := 0.28;  Rate2 := 0.21;
end
else
begin
Rate1 := 0.14;  Rate2 := 0.11;
end;
Charge[I] := Rate1 + Rate2 * (Min[I] - 1);
Writeln (Min[I] :5, '   ', Charge[I]: 6:2);
Tot := Tot + Charge[I];
end;
if Tot > 20 then Disc := Tot * 0.20;
Writeln;
Writeln ('TOTAL CHARGES', ' ': 8,  Tot: 6:2);
Writeln ('DISCOUNT',      ' ': 13, Disc: 6:2);
Writeln ('CHARGES - DISCOUNT   ',  Tot - Disc :6:2);
end.

{3.3}
program Thr3T95;
{ -- 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 := 0;  Run := 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: 3);
GotoXY (38, 5);  Writeln (Run: 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.4}
program Thr4T95;
{ -- This program will produce all possible subsets of letters. }
var
Sub:       Array[1..1024] of String;
Let, XSub: String;
A:         Array[1..10] of Char;
X:         Char;
I, J, L, Col, SubLen, Bit: Byte;
N, Num, Two2L, Power:      Integer;

begin
Write ('Enter letters: ');  Readln (Let);
L := Length(Let);
for I := 1 to L do A[I] := Let[I];
{ -- Sort letters in A[] }
for I := 1 to L - 1 do
for J := I + 1 to L do
if A[I] > A[J] then begin
X := A[I]; A[I] := A[J]; A[J] := X;
end;
{ -- Generate binary numbers to produce all subsets }
Two2L := 1;
for I := 1 to L do Two2L := Two2L * 2;
for N := 0 to Two2L - 1 do begin
Num := N; Power := Two2L;  Sub[N] := '';
for J := L - 1 downto 0 do begin
Power := Power div 2;
Bit := Num div Power;
if Bit = 1 then begin
Sub[N] := Sub[N] + A[L - J];  Num := Num - Power;
end;
end;
end;
{ -- Bubble sort subsets }
for I := 0 to Two2L - 2 do
for J := I + 1 to Two2L - 1 do
if Sub[I] > Sub[J] then begin
XSub := Sub[I];  Sub[I] := Sub[J];  Sub[J] := XSub;
end;
{ -- Display subsets }
Col := 0;
for I := 0 to Two2L - 1 do begin
SubLen := Length(Sub[I]) + 3;
if Col + SubLen > 50 then begin
Writeln;  Col := 0;
end;
Write ('{', Sub[I], '} ');
Col := Col + SubLen;
end;
Writeln;  Writeln('TOTAL SUBSETS = ', Two2L);
end.

{3.5}
program Thr5T95;
{ -- This program will sum big integers from 1 to N. }
{ -- Gauss's formula: SUM = N * (N+1) / 2.           }
var
A, B, Prod, D:              Array[1..80] of Byte;
I, J, S, Carry, LenA, LenB: Byte;
N:                          String;
Code:                       Integer;

begin
Write ('Enter N: ');  Readln (N);
{ -- Store digits of N in A[] and B[] }
LenA := Length(N);  LenB := LenA;
for I := 1 to LenA do begin
Val(Copy(N, LenA - I + 1, 1), A[I], Code);
B[I] := A[I];
end;
{ -- Add 1 to number in B[] }
Inc(B);  I := 1;
while (B[I] = 10) do begin
B[I] := 0;  Inc(I);  Inc(B[I]);
end;
if I > LenB then LenB := I;
{ -- Multiply A[] by B[] }
for I := 1 to LenA do begin
Carry := 0;
for J := 1 to LenB do begin
S := I + J - 1;
Prod[S] := Prod[S] + A[I] * B[J] + Carry;
Carry := Prod[S] div 10;
Prod[S] := Prod[S] - Carry * 10;
end;
if Carry > 0 then Prod[S+1] := Carry;
end;
if Carry > 0 then Inc(S);
{ -- Divide product Prod[] by 2 }
if Prod[S] = 1 then begin
Dec(S);  Carry := 10;
end;
for I := S downto 1 do begin
D[I] := (Prod[I] + Carry) div 2;
Carry := (Prod[I] mod 2) * 10;
end;
{ -- Display answer in D[] }
for I := S downto 1 do  Write (D[I]);
Writeln;
end.

{3.6}
program Thr6T95;
{ -- This program will assign values to variables in BASIC code.}
var
L, I, PosV, PosV2, PosV3, Num1, Num2, Code: Integer;
A: Array[1..12] of String;
B: Array[1..12] of Integer;
V, Ch, Op: Char;
AllV: String;

begin
L := 0;
repeat
Inc(L);
Write ('Enter line: ');  Readln (A[L]);
until A[L] = 'END';
Dec(L);

AllV := '';
for I := 1 to L do begin
{ -- Determine if first variable is new or old }
V := A[I,1];
PosV := Pos(V, AllV);
if PosV = 0 then begin
AllV := AllV + V;
PosV := Length(AllV);
end;
{ -- Assign value for first number }
Ch := A[I,3];
if (Ch in ['0'..'9']) then
Val(Ch, Num1, Code)
else begin
PosV2 := Pos(Ch, AllV);
Num1 := B[PosV2];
end;

if Length(A[I]) = 3 then
{ -- Assign first number to current variable }
B[PosV] := Num1
else begin
{ -- Assign value for second number }
Ch := A[I,5];
if Ch in ['0'..'9'] then
Val(Ch, Num2, Code)
else begin
PosV3 := Pos(Ch, AllV);
Num2 := B[PosV3];
end;
{ -- Perform operation with 1st and 2nd num, place in var }
Op := A[I,4];
Case Op of
'+': B[PosV] := Num1 + Num2;
'-': B[PosV] := Num1 - Num2;
'*': B[PosV] := Num1 * Num2;
'/': B[PosV] := Num1 div Num2;
end;
end;
end;  { -- for I }
{ -- Display the variables in order of appearance with values }
for I := 1 to Length(AllV) do
Writeln (Copy(AllV, I, 1), '=', B[I]);
end.

{3.7}
program Thr7T95;
{ -- This program finds three 3-digit primes having digits 1-9. }
var
A:           Array[1..200] of LongInt;
Digits:      String;
Prime, Good: Boolean;
I, J, K, L, H, T, One, P, Sum, PNum: Integer;
begin      { -- Generate primes into A[] }
P := 0; I := 101;
repeat
J := 3;  Prime := True;
while (J <= Sqrt(I)) and Prime do begin
if I mod J = 0 then Prime := False;
J := J + 2;
end;
if prime then begin
{ -- Ensure that Digits are unique and not 0 }
H := I div 100;  T := (I - H * 100) div 10;
One := I - H * 100 - T * 10;
if (T > 0) and (H <> T) and (T <> One) and (H <> One) then
begin  Inc(P);  A[P] := I;  end;
end;
Inc(I, 2);
until I > 997;
{ -- Add the different combinations of 3 primes }
for I := 1 to P - 2 do
for J := I + 1 to P - 1 do
for K := J + 1 to P do begin
Sum := A[I] + A[J] + A[K];
{ -- Check if Sum has 4 digits in ascending order }
if Sum >= 1234 then begin
Str(Sum, Digits);  Good := True;  L := 1;
repeat
if Digits[L] >= Digits[L+1] then Good := False;
Inc(L);
until (L = 4) or not Good;
{ -- Check all 3-digit primes for digits 1 through 9 }
if Good then begin
Str((((A[I] * 1000 + A[J]) * 1000) + A[K]), Digits);
L := 1;
while (L <= 9) and Good do begin
if Pos(Chr(48+L), Digits) = 0 then Good := False;

Inc(L);
end;
if Good then begin
Writeln (A[I],' + ',A[J],' + ',A[K],' = ', Sum);
Inc(PNum);  If PNum = 7 then Exit;
end;
end;
end;
end;  { -- for K }
end.

{3.8}
program Thr8T95;
{ -- This program will display time in MM:SS in block letters. }
uses Crt;
const
B: Array[1..5] of String = (
'****     *  ****  ****  *  *  ****  *     ****  ****  ****',
'*  *     *     *     *  *  *  *     *        *  *  *  *  *',
'*  *     *  ****  ****  ****  ****  ****     *  ****  ****',
'*  *     *  *        *     *     *  *  *     *  *  *     *',
'****     *  ****  ****     *  ****  ****     *  ****     *'
);
{ -- Maximum units for MM:SS }
Max: Array[1..4] of Byte = (6, 10, 6, 10);
{ -- Columns to start blocks }
Col: Array[1..4] of Byte = (1, 7, 18, 24);
var
I, J: Byte;
Dig:  Array[0..9] of Byte;
A:    Array[1..5,0..9] of String;
MMSS: String;
Code: Integer;
Ch:   String;

begin
for I := 1 to 5 do
for J := 0 to 10 do
A[I,J] := Copy(B[I], J * 6 + 1, 4);
Write ('Enter MM:SS: '); Readln (MMSS);
for I := 1 to 4 do
if I < 3 then
Val(Copy(MMSS, I, 1), Dig[I], Code)
else
Val(Copy(MMSS, I+1, 1), Dig[I], Code);

ClrScr;
GotoXY (14,2); Write('*');  GotoXY (14,4);  Write('*');
Ch := '';
repeat
for I := 1 to 4 do
for J := 1 to 5 do begin
GotoXY (Col[I], J);  Write (A[J, Dig[I]]);
end;
Inc(Dig);
for J := 4 downto 1 do
if Dig[J] = Max[J] then begin
Inc(Dig[J-1]);  Dig[J] := 0;
end;
Delay(1000);
if KeyPressed then Ch := ReadKey;
until Ch <> ''
end.

{3.9}
program Thr9T95;
{ -- This program will calculate the area of a polygon room. }
var
I, L, Sides, Code, Sum, Area: Integer;
Mov:  String;
Dir:  Array[1..10] of String;
Dist: Array[1..10] of Integer;

begin
Write ('Enter number of sides: ');  Readln (Sides);
for I := 1 to Sides do begin
Write ('Enter movement: ');  Readln (Mov);
Dir[I] := Copy(Mov, 1, 1);
L := Length(Mov);
Mov := Copy(Mov, 2, L - 1);
Val(Mov, Dist[I], Code);
{ -- Subtract Down and Left directions }
if (Dir[I] = 'D') or (Dir[I] = 'L') then
Dist[I] := -Dist[I];
end;
{ -- Multiply length by width to obtain rectangle area, }
{ -- then add or subtract area from overall area. }
I := 1;  Sum := 0;  Area := 0;
repeat
Sum := Sum + Dist[I];
Area := Area + (Sum * Dist[I+1]);
Inc(I, 2);
until (I > Sides);
Writeln ('AREA = ', Abs(Area), ' SQUARE FEET');
end.

{3.10}
program Thr10T95;
{ -- This program displays versions of libraries on a graph. }
uses Crt;
var
Vers, FirstWk, FWkDisp, WkNum, LWkDisp, LastWk, Backup,
I, Min, Max, TestArea, FirstPreWk, LastPreWk: Integer;

begin
Write ('Enter version #: ');  Readln (Vers);
Write ('Enter first week in test: ');  Readln (FirstWk);
Write ('Enter first week to display, # of weeks: ');
ClrScr;
LWkDisp := FWkDisp + WkNum - 1;
{ -- Display week #s at top (units first, then tens) }
Write (' ': 9);
for I := FWkDisp to LWkDisp do  Write (I div 10);
Writeln;  Write (' ': 9);
for I := FWkDisp to LWkDisp do  Write (I mod 10);
Writeln;  Writeln;
LastWk := FirstWk + 17;
{ -- Compute # of versions to backup from Vers input }
Backup := (LastWk - FWkDisp) div 6;
Vers := Vers - Backup;
FirstWk := FirstWk - 6 * Backup;
LastWk  := LastWk  - 6 * Backup;
repeat
{ -- Display Version and indent }
Write ('R1V');  if Vers < 10 then Write ('0');
Write(Vers, 'L01 ');
if FWkDisp <= FirstWk then begin
Min := FirstWk;
Write (' ': FirstWk - FWkDisp); end
else
Min := FWkDisp;
if LWkDisp >= LastWk then Max := LastWk else Max := LWkDisp;
{ -- Display TestArea of 1 if Vers even, 2 if odd; P = Prod }
TestArea := (Vers mod 2) + 1;
for I := Min to Max do
if I < FirstWk + 12 then
Write (TestArea)
else
Write ('P');
Writeln;
{ -- Display Pre-Production Version }
FirstPreWk := FirstWk + 5;  LastPreWk := FirstWk + 10;
if (LastPreWk >= FWkDisp) and (FirstPreWk <= LWkDisp) then
begin
Write ('R1V');  if Vers - 1 < 10 then Write ('0');
Write (Vers - 1, 'L88 ');
if FirstPreWk > FWkDisp then begin
Min := FirstPreWk;

Write (' ': FirstPreWk - FWkDisp); end
else
Min := FWkDisp;
if LWkDisp >= LastPreWk then
Max := LastPreWk
else
Max := LWkDisp;
for I := 1 to Max - Min + 1 do Write ('*');
Writeln;
end; { -- if }
FirstWk := FirstWk + 6;  LastWk := LastWk + 6;
Inc(Vers);
until FirstWk > LWkDisp;
end.

```