program intabtab;                 {display the intersection of a (mod m)
                                   with b (mod n)}
{$N+,E+}
uses crt, nothy, printer;

{$I GetInput.i }

const
MaxMod = 9999.0;

var
a, b,                             {position of table}
a0, b0,                           {North-West entry of table}
m, n,                             {moduli}
v,                                {value to be entered}
q,                                {[m, n]}
q0                                {modulus returned by crthm}
              : comp;
i,                                {index for rows, running from 0 to 19}
i0,                               {upper limit of i}
j,                                {index for columns, running from 0 to db}
j0,                               {upper limit of j}
db,                               {maximum deviation from b0}
l, l1,                            {lengths strings}
ind,                              {amount to indent by}
fw0,                              {field width of column (mod m)}
fw                                {field width of remaining columns}
              : integer;
OriginalMode
              : word;
InputOk,
FuncKey       : Boolean;
Ch            : char;
St,
Stm,                              {modulus m as a string}
Stn,                              {modulus n as a string}
Stq,                              {[m, n] as a string}
Stq0                              {blank string of same length}

              : string[80];

procedure Display;                {display table on screen}

begin
  TextColor(15);
  TextBackground(0);
  ClrScr;
  St := 'INTERSECTION OF ARITHMETIC PROGRESSIONS (mod ';
  St := St + Stm + ') AND (mod ' + Stn + ')';
  l := length(St);
  ind := (80 - l) div 2;
  for i := 1 to ind do St := ' ' + St;
  WriteLn(St);
  if m > 0
  then
    begin
      St := '';
      for i := 1 to ((fw0-5) div 2) do St := St + ' ';
      St := St + 'a mod';
      while length(St) < fw0+1 do St := St + ' ';
      Write(St)
    end
  else
    begin
      St := '';
      for i := 1 to fw0+1 do St := St + ' ';
      Write(St)
    end;
  St := 'b mod ' + Stn;
  ind := (79 - fw0 - length(St)) div 2;
  for i := 1 to ind do St := ' ' + St;
  WriteLn(St);
  if m > 0
  then Write(m:fw0:0, ' ')
  else Write('a mod m ');
  if n > 0
  then
    begin
      for j := 0 to j0 do
        if gcd(b0 + j, n) = 1
        then Write((b0 + j):fw:0)
        else
          begin
            TextColor(14);
            Write((b0 + j):fw:0);
            TextColor(15)
          end;
      WriteLn
    end
  else WriteLn;
  if m > 0
  then for i := 0 to i0 do
    begin
      TextBackground(0);
      if gcd((a0+i), m) = 1
      then Write((a0+i):fw0:0, ' ')
      else
        begin
          TextColor(14);
          Write((a0+i):fw0:0, ' ');
          TextColor(15)
        end;
      if n > 0
      then
        begin
          TextBackground(1);
          for j := 0 to j0 do
            begin
              crthm(a0+i, m, b0+j, n, v, q0);
              if q0 = 0
              then Write(Stq0)
              else
                if gcd(v, q) = 1
                then Write(v:fw:0)
                else
                  begin
                    TextColor(14);
                    Write(v:fw:0);
                    TextColor(15)
                  end;
            end;
          TextBackground(0)
        end;
      WriteLn
    end;
  if q > 0
  then
    begin
      St := 'ENTRIES REPRESENT RESIDUE CLASSES (mod ' + Stq + ')';
      ind := (80 - length(St)) div 2;
      for i := 1 to ind do St := ' ' + St;
      WriteLn(St)
    end;
  TextBackground(7);
  GoToXY(1, 25);
  ClrEoL;
  if a0 > 0
  then TextColor(4)
  else TextColor(15);
  Write('    ', #24);
  if a0 + 20 < m
  then TextColor(4)
  else TextColor(15);
  Write('     ', #25);
  if b0 > 0
  then TextColor(4)
  else TextColor(15);
  Write('     ', #27);
  if b0 + db + 1 < n
  then TextColor(4)
  else TextColor(15);
  Write('     ', #26);
  if m > 20
  then TextColor(4)
  else TextColor(15);
  Write('       a');
  if n > j0 + 1
  then TextColor(4)
  else TextColor(15);
  Write('       b');
  TextColor(4);
  Write('       m       n       ');
  if (m > 0) and (n > 0) and (j0 + 1 >= n) and ( m < 500)
  then
    begin
      TextColor(4);
      Write('P');
      TextColor(0);
      Write('rint       ')
    end
  else
    begin
      TextColor(15);
      Write('Print      ')
    end;
  TextColor(4);
  Write('Esc');
  GoToXY(1, 25);                                    {hide the cursor}
  TextColor(7);
  Write(' ');
  GoToXY(1, 25);
  TextColor(0);
end;                              {of procedure Display}

procedure Printab;                {print the table}

begin
  ClrEoL;
  TextColor(4);
  Write('                             Printing the table . . . ');
  WriteLn(lst);
  St := 'INTERSECTION OF ARITHMETIC PROGRESSIONS (mod ';
  St := St + Stm + ') AND (mod ' + Stn + ')';
  l := length(St);
  ind := (80 - l) div 2;
  for i := 1 to ind do St := ' ' + St;
  WriteLn(lst, St);
  WriteLn(lst);
  St := '';
  for i := 1 to ((fw0-5) div 2) do St := St + ' ';
  St := St + 'a mod';
  while length(St) < fw0+1 do St := St + ' ';
  Write(lst, St);
  St := 'b mod ' + Stn;
  ind := (79 - fw0 - length(St)) div 2;
  for i := 1 to ind do St := ' ' + St;
  WriteLn(lst, St);
  Write(lst, m:fw0:0, ' ');
  for j := 0 to j0 do Write(lst, j:fw);
  WriteLn(lst);
  for i := 0 to round(m-1) do
    begin
      Write(lst, i:fw0, ' ');
      for j := 0 to j0 do
        begin
          crthm(i, m, j, n, v, q0);
          if q0 = 0
          then Write(lst, Stq0)
          else Write(lst, v:fw:0)
        end;
      WriteLn(lst);
    end;
  WriteLn(lst);
  St := 'ENTRIES REPRESENT RESIDUE CLASSES (mod ' + Stq + ')';
  ind := (80 - length(St)) div 2;
  for i := 1 to ind do St := ' ' + St;
  WriteLn(lst, St);
  WriteLn(lst)
end;                              {of procedure PrinTab}

begin                             {main body}
  OriginalMode := LastMode;
  FuncKey := False;
  TextColor(14);
  TextBackground(1);
  ClrScr;
  GoToXY(20, 5);
  WriteLn('INTERSECTION OF ARITHMETIC PROGRESSIONS');
  GoToXY(1, 7);
  WriteLn('           For given values of m and n, will display the');
  WriteLn('      intersection of two arithmetic progressions a (mod m)');
  WriteLn('      and b (mod n).  This intersection is either an arithmetic');
  WriteLn('      progression (mod [m, n]), or else is empty.  Rows are');
  WriteLn('      indexed by a, and columns by b.  The row label a (mod m)');
  WriteLn('      is printed in white if (a, m) = 1, otherwise in yellow,');
  WriteLn('      and similarly for the column labels b (mod n).  Also, an');
  WriteLn('      entry c in the body of the table is printed in white if');
  WriteLn('      (c, [m,n]) = 1, otherwise in yellow.  A missing entry in');
  Write('      table indicates that ');
  WriteLn('the intersection in question is empty.');
  str(MaxMod:1:0, St);
  St := '       (1 ó m ó ' + St + ')';
  m := GetInput(7, 19, 'Enter m = ', St, 1, MaxMod);
  str(MaxMod:1:0, St);
  St := '       (1 ó n ó '+ St + ')';
  n := GetInput(7, 20, 'Enter n = ', St, 1, MaxMod);
  str(m:1:0, Stm);
  fw0 := length(Stm) + 2;
  a0 := 0;
  q := m*n/gcd(m, n);
  str(q:1:0, Stq);
  fw := length(Stq) + 2;
  Stq0 := '';
  for i := 1 to fw do Stq0 := Stq0 + ' ';
  db := ((78 - fw0) div fw) - 1;
  if n >= db + 1
  then j0 := db
  else j0 := round(n-1);
  if m >= 20
  then i0 := 19
  else i0 := round(m-1);
  str(n:1:0, Stn);
  b0 := 0;
  Ch := 'F';
  repeat
    if (FuncKey) and (Ch = #72)   {UpArrow}
    then
      begin
        a0 := a0 - 20;
        if a0 < 0
        then a0 := 0;
      end;
    if (FuncKey) and (Ch = #80)   {DownArrow}
    then
      begin
        a0 := a0 + 20;
        if a0 + 20 > m
        then a0 := m - 20;
      end;
    if (FuncKey) and (Ch = #77)   {RightArrow}
    then
      begin
        b0 := b0 + db + 1;
        if b0 + db + 1 > n
        then b0 := n - db - 1;
      end;
    if (FuncKey) and (Ch = #75)   {Left Arrow}
    then
      begin
        b0 := b0 - db - 1;
        if b0 < 0
        then b0 := 0;
      end;
    if (not FuncKey) and (UpCase(Ch) = 'A')
    then
      begin
        St := '       (0 ó a < '+ Stm + ')';
        a0 := GetInput(1, 24, '      Enter a = ', St, 1, m-1);
        if a0 + i0 >= m
        then a0 := m - i0 - 1
      end;
    if (not FuncKey) and (UpCase(Ch) = 'B')
    then
      begin
        St := '       (0 ó b < ' + Stn + ')';
        b0 := GetInput(1, 24, '      Enter b = ', St, 1, n-1);
        if b0 + j0 >= n
        then b0 := n - j0 - 1
      end;
    if (not FuncKey) and (UpCase(Ch) = 'M')
    then
      begin
        str(MaxMod:1:0, St);
        St := '       (1 ó m ó ' + St + ')';
        m := GetInput(1, 24, '      Enter m = ', St, 1, MaxMod);
        str(m:1:0, Stm);
        fw0 := length(Stm) + 2;
        a0 := 0;
        q := m*n/gcd(m, n);
        str(q:1:0, Stq);
        fw := length(Stq) + 2;
        Stq0 := '';
        for i := 1 to fw do Stq0 := Stq0 + ' ';
        db := ((78 - fw0) div fw) - 1;
        if n >= db + 1
        then j0 := db
        else j0 := round(n-1);
        if m >= 20
        then i0 := 19
        else i0 := round(m-1)
      end;                        {new m has been entered}
    if (not FuncKey) and (Upcase(Ch) = 'N')
    then
      begin
        str(MaxMod:1:0, St);
        St := '       (1 ó n ó ' + St + ')';
        n := GetInput(1, 24, '      Enter n = ', St, 1, MaxMod);
        str(n:1:0, Stn);
        b0 := 0;
        q := m*n/gcd(m, n);
        str(q:1:0, Stq);
        fw := length(Stq) + 2;
        Stq0 := '';
        for i := 1 to fw do Stq0 := Stq0 + ' ';
        db := ((78 - fw0) div fw) - 1;
        if n >= db + 1
        then j0 := db
        else j0 := round(n-1)
      end;                        {new n has been entered}
    if (not FuncKey) and (UpCase(Ch) = 'P')
    then PrinTab;
    Display;
    repeat
      Ch := ReadKey;
      if Ch <> #0
      then FuncKey := False
      else
        begin
          FuncKey := True;
          Ch := ReadKey
        end;
      InputOk := False;
      if FuncKey and (Ch = #72) and (a0 > 0)
      then InputOk := True;
      if FuncKey and (Ch = #80) and (a0 + 20 < m)
      then InputOk := True;
      if FuncKey and (Ch = #77) and (b0 + db + 1 < n)
      then InputOk := True;
      if FuncKey and (Ch = #75) and (b0 > 0)
      then InputOk := True;
      if (not FuncKey) and (Ch IN [#27, 'm', 'M', 'n', 'N'])
      then InputOk := True;
      if (not FuncKey) and (UpCase(Ch) = 'A') and (m > 20)
      then InputOk := True;
      if (not FuncKey) and (UpCase(Ch) = 'B') and (n > j0 + 1)
      then InputOk := True;
      if (not FuncKey) and (UpCase(Ch) = 'P') and
         (m > 0) and (n > 0) and (j0 + 1 >= n) and ( m < 500)
      then InputOk := True
    until InputOk;
  until (not FuncKey) and (Ch = #27);
  TextMode(OriginalMode)
end.