{ -- 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? ');
    Readln (G);
    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[1] + Min[2];  H := 0;
  if M > 59 then begin
    M := M - 60;  H := 1;
  end;
  H := H + Hour[1] + Hour[2];
  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[12];
    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 ('*');
    Ch := ReadKey;
    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[1];  Y[N+1] := Y[1];  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[5];
    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[20];
    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;
    A := ReadKey;
  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[9] =
      ('$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[2] =
      ('IN', 'FT', 'FT', 'YD', 'MI');
    B: Array[1..5] of String[2] =
      ('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[5] =
      ('JAN.', 'FEB.', 'MAR.', 'APRIL', 'MAY', 'JUNE',
       'JULY', 'AUG.', 'SEPT.', 'OCT.', 'NOV.', 'DEC.');
    Words: Array[1..27] of String[10] =
      ('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[20];
    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[2] =
      ('W', 'Y', 'R', 'G', 'BL', 'BK');
  var
    I, J, K, W, Bk, X: Integer;
    A, B, C:           Array[1..6] of String[2];
 
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
      GotoXY (I*6, K*2);  Readln (B[I]);
    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[15];
    A, N:    Array [1..2] of Integer;
    Ch, NCh: String[1];
    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[1] := A[1] + A[2];  N[2] := A[1] * A[2];
  R[1] := '';  R[2] := '';
  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[1], ' + ', Rom[2], ' = ', R[1]);
  Writeln (A[1], ' + ', A[2], ' = ', N[1]);
  Writeln (Rom[1], ' * ', Rom[2], ' = ', R[2]);
  Writeln (A[1], ' * ', A[2], ' = ', N[2]);
end.
 
 
{3.5}
program Thr5T82;
{ -- This program will find 4 digit squumbers. }
  var
    I, L, R, X, Code: Integer;
    Ist:              String[4];
 
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[14] =
    ('ALABAMA','ALASKA','ARIZONA','ARKANSAS','CALIFORNIA',
    'COLORADO','CONNECTICUT','DELEWARE','FLORIDA','GEORGIA',
    'HAWAII','IDAHO','ILLINIOS','INDIANA','IOWA','KANSAS',
    'KENTUCKY','LOUISIANA','MAINE','MARYLAND','MASSACHUSETTS',
    'MICHIGAN','MINNESOTA','MISSISSIPPI','MISSOURI','MONTANA',
    'NEBRASKA','NEVADA','NEW HAMPSHIRE','NEW JERSEY','NEW YORK',
    '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[3];
 
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.