program FctrlTab;  {Display factorials (mod m)}
{$N+,E+}
uses CRT, Printer, nothy;
{$I GetInput.i }

const
  PrinterLimit = 60; {Limit on the number of lines in the printed table}
  MaxMod = 999999;   {Must have m < 1E6 so that entries fit on the screen}

var
m                      {modulus}
     :  comp;
x    :  extended;
i, j, k                {indices of the factorials}
     :  longint;
fcl                    {fcl[i] = i! (mod m)}
     :  array[0..10100] of single;
OriginalMode         {Save original screen mode for restoration}
         : word;
Ch       : char;     {Answer to prompt}
funckey,             {was a function key pressed?}
inputok              {is the input acceptable?}
         : boolean;

procedure Display(j : longint);   {display the factorials, starting at 10j}

var
f                      {factorial entered in table}
     :  comp;
St   :  string[20];
h, i, k,               {indices}
l,                     {length of a string}
ind                    {amount to indent by}
     :  integer;

begin
  TextColor(15);
  TextBackground(0);
  ClrScr;
  Str(m:1:0, St);
  l := Length(St);
  ind := (63 - l) div 2;   {amount to indent by, to center title}
  GoToXY(ind, 1);
  WriteLn('FACTORIALS (MOD ', m:1:0, ')');
  WriteLn;
  Write('    j       10j  10j+1  10j+2  10j+3  10j+4  10j+5');
  WriteLn('  10j+6  10j+7  10j+8  10j+9');
  WriteLn;
  k := 10*j;
  for i := 0 to 9 do
    begin
      Write((j+i):6);
      TextColor(14);
      Write('  ');
      TextBackground(1);
      for h := 0 to 9 do
        begin
          if k <= m
          then f := fcl[k]
          else f := 0;
          k := k + 1;
          Write(f:7:0)
        end;
      Write('  ');
      if i < 9
      then
        begin
          GoToXY(9, WhereY);
          ClrEoL
        end;
      TextColor(15);
      TextBackground(0);
      WriteLn
    end;
  TextBackground(7);
  GoToXY(1, 25);
  ClrEoL;
  if j > 1
  then TextColor(4)
  else TextColor(15);
  Write('    PgUp');
  if j < 999
  then TextColor(4)
  else TextColor(15);
  Write('         PgDn');
  TextColor(4);
  Write('         J');
  TextColor(0);
  Write('ump         ');
  TextColor(4);
  Write('M');
  TextColor(0);
  Write('odulus         ');
  TextColor(4);
  Write('P');
  TextColor(0);
  Write('rint         ');
  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 factorials up to PrinterLimit lines}

var
  St      :  string[12];
  f       :  single;      {factorial}
  h, i, j, ind,           {indices}
  l,                      {length of string}
  n,                      {upper limit of entries}
  r                       {index of last row}
          :  integer;

begin
  GoToXY(1, 25);
  ClrEoL;
  GoToXY(1, 24);
  ClrEoL;
  GoToXY(1, 25);
  if m < 10*PrinterLimit
  then n := round(m)
  else n := 10*PrinterLimit - 1;
  r := trunc(n/10);
  Write('Sending j! (mod ', m:1:0);
  Write(') to the printer, for 0 ó j < ', n:1, ' . . . ');
  Str(m:1:0, St);
  l := length(St);
  ind := (63 - l) div 2;   {amount to indent by, to center title}
  WriteLn(lst);
  for i := 1 to ind do Write(Lst, ' ');
  WriteLn(Lst, 'FACTORIALS (MOD ', m:1:0, ')');
  WriteLn(Lst);
  Write(Lst, '    j       10j  10j+1  10j+2  10j+3  10j+4  10j+5');
  WriteLn(Lst, '  10j+6  10j+7  10j+8  10j+9');
  WriteLn(Lst);
  j := 0;
  f := 1;
  i := 0;
  while (f > 0) and (j <= n) do
    begin
      Write(Lst, i:6);
      i := i + 1;
      Write(Lst, '  ');
      for h := 0 to 9 do
        begin
          if j <= n
          then
            begin
              f := fcl[j];
              Write(Lst, f:7:0)
            end;
          j := j + 1
        end;
      WriteLn(Lst)
    end;
  WriteLn(Lst);
  Write('done.');
  Delay(2000)
end;                                  {of procedure PrinTab}

procedure CalcArray;

var
i, n       : integer;
f          : comp;

begin
  if m < 10100
  then n := round(m)
  else n := 10100;
  f := 1;
  fcl[0] := 1;
  for i := 1 to n do
    begin
      f := condition(f*i, m);
      fcl[i] := f
    end
end;

begin                             {main body}
  OriginalMode := LastMode;
  Ch := 'F';
  funckey := false;
  TextColor(14);
  TextBackground(1);
  ClrScr;
  GoToXY(30, 8);
  WriteLn('FACTORIALS (mod m)');
  m := GetInput(1, 14, '                       Enter initial modulus, m = ',
                '                                         (0 < m ó 999999)',
                1, MaxMod);
  GoToXY(32, 20);
  Write('Calculating values . . . ');
  CalcArray;
  j := 0;
  repeat
    if (not funckey) and (UpCase(Ch) = 'J')
    then
        j := round(GetInput(1, 24, '            Jump to row j = ',
                            '                   (0 ó j ó 999)', 0, 999));
    if (not funckey) and (UpCase(Ch) = 'M')
      then
        begin
          m := GetInput(1, 24, '      Enter new modulus m = ',
                        '                   (0 < m ó 999999)', 1, MaxMod);
          GoToXY(1, 25);
          ClrEoL;
          Write('                           Calculating values . . . ');
          CalcArray
        end;
      if (funckey) and (Ch = #73)          {PgUp}
      then
        begin
          j := j - 10;
          if j < 0 then j := 0
        end;
      if (funckey) and (Ch = #81)          {PgDn}
      then
        begin
          j := j + 10;
          if j > 999
          then j := 999;
        end;
      Display(j);
      repeat
        Ch := ReadKey;
        if Ch <> #0
        then funckey := false
        else
          begin
            funckey := true;
            Ch := ReadKey
          end;
        inputok := false;
        if funckey and (Ch = #73) and (j > 1)
        then inputok := true;
        if FuncKey and (Ch = #81) and (j < 999)
        then InputOk := True;
        if (not funckey)
          and (Ch in [#27, 'j', 'J', 'm', 'M', 'p', 'P'])
        then inputok := true;
      until inputok;
      if (Ch = 'P') or (Ch = 'p') then PrinTab;
  Until (not funckey) and (ch = #27);
TextMode(OriginalMode)
end.