unit Generate;

interface

uses Cables;

procedure ManualEnter(var C: Cable);
procedure ReadCable(var C: Cable);
procedure WriteCable(const C: Cable);
procedure GenerateCable(var C: Cable);
procedure RndInjection(var C: Cable);

implementation

procedure ManualEnter(var C: Cable) ;
  var a: Wire; b: Switch; ch: char;
  begin
  with C do begin
    if MequN then begin
      write('Give M:') ;
      readln(M) ; N := M
      end { then }
    else begin
      write('Give M, N: ') ;
      readln(M, ch, N)
      end { else } ;
    for a := 1 to M do begin
      write('Wire ', a:3, ' is connected to switch: ') ;
      readln(f[a])
      end { for a }
    end { with C }
  end { ManualEnter } ;

procedure ReadCable(var C: Cable) ;
  var
    fname: string;
    inp: text;
    a: Wire;
  begin
  write('Read cable from file named: ') ;
  readln(fname) ;
  assign(inp, fname) ;
  reset(inp) ;
  with C do begin
    readln(inp, M, N) ; { M < 0 means teasing }
    if MequN and (abs(M) <> N) then
      writeln('WARNING: using cable file with M <> N') ;
    for a := 1 to M do readln(inp, f[a]) { noting if M < 0 }
    end { with C } ;
  if not eof(inp) then writeln('WARNING: spurious data at end of cable file')
  end { ReadCable } ;

procedure WriteCable(const C: Cable);
  var
    fname: string;
    out: text;
    a: Wire;
  begin
  write('Write cable to file named (RETURN to cancel): ') ;
  readln(fname) ;
  if fname = '' then Exit ;
  assign(out, fname) ;
  rewrite(out) ;
  with C do begin
    writeln(out, M, ' ', N) ;
    for a := 1 to M do writeln(out, f[a])
    end { with C } ;
  close(out)
  end { WriteCable } ;

procedure AllToOne(var C: Cable);
  var a: Wire; b: Switch;
  begin
  with C do begin
    write('How many wires: ') ; readln(M) ;
    if MequN then N := M
    else begin write('How many switches: ') ; readln(N) end ;
    write('All wires connected to switch: ') ; readln(b) ;
    for a := 1 to M do f[a] := b
    end { with C }
  end { AllToOne } ;

procedure Straight(var C: Cable);
  var a: Wire;
  begin
  with C do
    for a := 1 to M do f[a] := a
  end { Straight } ;

procedure Inverted(var C: Cable);
  var a: Wire;
  begin
  with C do
    for a := 1 to M do f[a] := M-a+1
  end { Inverted } ;

procedure Cyclic(var C: Cable);
  var a, k: Wire;
  begin
  write('Shift over: ') ; readln(k) ;
  with C do
    for a := 1 to M do f[a] := (a+k) mod M + 1
  end { Cyclic } ;

procedure Permutation(var C: Cable);
  var ch: char;
  begin
  with C do begin
    write('How many wires: ') ; readln(M) ; N := M ;
    repeat
      write('S(traight, I(nverted, C(yclic, R(andom: ') ;
      readln(ch) ; ch := UpCase(ch)
      until ch in ['S', 'I', 'C', 'R'] ;
    case ch of
      'S': Straight(C) ;
      'I': Inverted(C) ;
      'C': Cyclic(C) ;
      'R': RndInjection(C) ;
      end { case }
    end { with C }
  end { Permutation } ;

procedure Arbitrary(var C: Cable);
  var a: Wire;
  begin
  with C do
    for a := 1 to M do f[a] := Random(N)+1
  end { Arbitrary } ;

function Pick(const s: SwitchSet; i: integer): Switch;
  { pre: # s >= i }
  { ret: element with rank i from s }
  var b: Switch;
  begin
  b := 1 ; while not(b in s) do inc(b) ;
  while i <> 1 do begin
    repeat inc(b) until b in s ;
    dec(i)
    end { while } ;
  Pick := b
  end { Pick } ;

procedure RndInjection(var C: Cable);
  var a: Wire; s: SwitchSet; k: integer; { k = # s }
  begin
  with C do begin
    s := [1..N] ; k := N ;
    for a := 1 to M do begin
      f[a] := Pick(s, Random(k)+1) ;
      Exclude(s, f[a]) ; dec(k)
      end { for a }
    end { with C }
  end { RndInjection } ;

procedure RndSurjection(var C: Cable);
  var a: Wire;
  begin
  with C do
    writeln('Not yet implemented') ;
  GenerateCable(C)
  end { RndSurjection } ;

procedure Randomized(var C: Cable);
  var ch: char; options: set of char;
  begin
  with C do begin
    write('How many wires: ') ; readln(M) ;
    if MequN then N := M
    else begin write('How many switches: ') ; readln(N) end ;
    Randomize ;
    repeat
      write('A(rbitrary') ;
      options := ['A'] ;
      if M < N then begin
        write(', I(njection') ;
        Include(options, 'I')
        end
      else if M > N then begin
        write(', S(urjection') ;
        Include(options, 'S')
        end
      else begin
        write(', B(ijection') ;
        Include(options, 'B')
        end ;
      write(': ') ;
      readln(ch) ; ch := UpCase(ch)
      until ch in options ;
    case ch of
      'A': Arbitrary(C) ;
      'I': RndInjection(C) ;
      'S': RndSurjection(C) ;
      'B': RndInjection(C) ; { in this case I = S = B }
      end { case }
    end { with C }
  end { Randomized } ;

procedure GenerateCable(var C: Cable);
  var ch: char;
  begin
  repeat
    write('M(anualEnter, A(ll-to-one, P(ermutation, R(andom, Q(uit: ') ;
    readln(ch) ; ch := UpCase(ch)
    until ch in ['M', 'A', 'P', 'R', 'Q'] ;
  case ch of
    'M': ManualEnter(C) ;
    'A': AllToOne(C) ;
    'P': Permutation(C) ;
    'R': Randomized(C) ;
    'Q': with C do begin M := 0 ; N := 0 end ;
    end { case }
  end { GenerateCable } ;

begin
end.