(* N *)
(*$include:'SETDIR.INT'*)
(*$include:'SETDOS.INT'*)
(*$include:'SETGRAPH.INT'*)

(**********************************************************************)
(*  Setcopy program for use with logcopy.  Manages database that log  *)
(*  copy reads in when invoked.                                       *)
(**********************************************************************)

Program Setcopy(input,output);
  uses SETDIR,SETDOS,SETGRAPH;
  Const
    Program_name         = 'SETCOPY version 3.00 by Keith P. Robison';
    Copyright            = 'copyright Syracuse University 1988';
    data_drive           = '^';
    data_path            = 'SYS:PUBLIC';
    data_filename        = data_drive*':LOG&COPY.DAT';
    max_programs         = 100;
    program_name_length  = 80;
    server_name_length   = 48;

    VER = 'VeRsIoN=SETCOPY Version 3.00 by Keith P. Robison'*chr(0)*'$';
  Type
    pointers_type = Array [1 .. max_programs] of Word;
    program_info  = Record
                      Copies : Byte;
                      logit  : Byte;
                      name   : Lstring(program_name_length);
                      server : Lstring(server_name_length);
                    End;
    programs_type = Array [1 .. max_programs] of program_info;

  Var
    pointer : pointers_type;
    info    : programs_type;
    count   : Integer;
    fout    : file of byte;
    fin     : file of byte;
    version : Lstring(80);
    logging : Boolean;

  Value
    version := VER;
    logging := FALSE;

(**********************************************************************)
(*                                                                    *)
(*                                                                    *)
(**********************************************************************)

  Procedure cls;
    Begin
      scroll_screen_up(0,0,0,24,79,31);
      gotoxy(0,0);
    End; (* cls *)

(**********************************************************************)
(*                                                                    *)
(*                                                                    *)
(**********************************************************************)

  Procedure key_press;
    Begin
      gotoxy(24,20);
      Write('Press ENTER to continue');
      readln;
    End; (* key_press *)

(**********************************************************************)
(*                                                                    *)
(*                                                                    *)
(**********************************************************************)

  Procedure upper_case(Var s : Lstring);
    Var
      i : Integer;
    Begin
      if s.len > 0 then for i:= 1 to ord(s.len) Do
        if (s[i] >= 'a') and (s[i] <= 'z') Then s[i]:=chr(ord(s[i])-32);
    End; (* upper_case *)

(**********************************************************************)
(*                                                                    *)
(*                                                                    *)
(**********************************************************************)

  Procedure Calc_pointers;
    Var
      i : Integer;
    Begin
      pointer[1]:=wrd(count*2+2);
      if count > 1 Then
        for i:= 2 to count Do
          pointer[i]:=pointer[i-1]+3+info[i-1].name.len+1+
            info[i-1].server.len;
    End; (* Calc_pointers *)

(**********************************************************************)
(*                                                                    *)
(*                                                                    *)
(**********************************************************************)

  Procedure write_pointers;
    Var
      i : Integer;
    Begin
      if count > 0 Then
        for i:= 1 to count do
          write(fout,lobyte(pointer[i]),hibyte(pointer[i]));
      Write(fout,0,0);
    End; (* write_pointers *)

(**********************************************************************)
(*                                                                    *)
(*                                                                    *)
(**********************************************************************)

  Procedure write_info;
    Var
      i,j : Integer;
    Begin
      for i:= 1 to count do
        Begin
          write(fout,info[i].copies,info[i].logit,info[i].name.len);
          if info[i].name.len > 0 Then
            for j:= 1 to ord(info[i].name.len) Do
              Write(fout,wrd(info[i].name[j]));
          write(fout,info[i].server.len);
          if info[i].server.len > 0 Then
            for j:= 1 to ord(info[i].server.len) Do
              Write(fout,wrd(info[i].server[j]));
        End;
    End; (* write_info *)

(**********************************************************************)
(*                                                                    *)
(*                                                                    *)
(**********************************************************************)

  Procedure read_pointers;
    Var
      bl,bh : Byte;
    Begin
      count:=0;
      Repeat
        count:=count+1;
        Read(fin,bl,bh);
        pointer[count]:=byword(bh,bl);
      Until pointer[count] = 0;
      count:=count-1;
    End; (* read_pointers *)

(**********************************************************************)
(*                                                                    *)
(*                                                                    *)
(**********************************************************************)

  Procedure read_info;
    Var
      i,j : Integer;
      b   : Byte;
    Begin
      for i:= 1 to count Do
        Begin
          read(fin,info[i].copies,info[i].logit,info[i].name.len);
          if info[i].name.len > 0 Then
            for j:= 1 to ord(info[i].name.len) Do
              Begin
                read(fin,b);
                info[i].name[j]:=chr(b);
              End;
          read(fin,info[i].server.len);
          if info[i].name.len > 0 Then
            for j:= 1 to ord(info[i].server.len) Do
              Begin
                read(fin,b);
                info[i].server[j]:=chr(b);
              End;
        End;
    End; (* read_info *)

(**********************************************************************)
(*                                                                    *)
(*                                                                    *)
(**********************************************************************)

  Procedure read_file;
    Var
      b : Byte;
    Begin
      assign(fin,data_filename);
      fin.trap:=TRUE;
      reset(fin);
      if fin.errs = 0 Then
        Begin
          read(fin,b);
          If b = 0 then logging:=TRUE
          Else if b = 255 then logging:=FALSE;
          read_pointers;
          read_info;
          close(fin);
        End;
    End; (* read_file *)

(**********************************************************************)
(*                                                                    *)
(*                                                                    *)
(**********************************************************************)

  Procedure write_file;
    Var
      temp : Lstring(64);
      rc   : Integer;
    Begin
      assign(fout,data_filename);
      fin.trap:=TRUE;
      rewrite(fout);
      if fout.errs = 0 Then
        Begin
          if logging then write(fout,0)
          Else write(fout,255);
          calc_pointers;
          write_pointers;
          write_info;
          close(fout);
          copylst(data_filename,temp);
          concat(temp,chr(0));
          rc:=attrib(ads temp,128);
        End
      Else writeln('Unable to write file');
    End; (* Write_file *)

(**********************************************************************)
(*                                                                    *)
(*                                                                    *)
(**********************************************************************)

  Procedure initialize;
    Var
      rc   : Integer;
      base : Integer;
      mask : integer;
    Begin
      rc:=net_alloc_temp_base(data_drive,0,data_path,base,mask);
      count:=0;
    End; (* initialize *)


(**********************************************************************)
(*                                                                    *)
(*                                                                    *)
(**********************************************************************)

  Procedure add_item;
    Var
      ch : Char;
    Begin
      cls;
      count:=count+1;
      Write('Enter program name:');
      readln(info[count].name);
      upper_case(info[count].name);
      Write('Log executions ? (Y/N):');
      readln(ch);
      if ch in ['Y','y'] Then info[count].logit:=0
      Else info[count].logit:=1;
      Write('Limited number of copies ? (Y/N) :');
      readln(ch);
      if ch in ['Y','y'] Then
        Begin
          Write('How Many Copies:');
          readln(info[count].copies);
          Write('Enter Server:');
          readln(info[count].server);
          upper_case(info[count].server);
        End
      Else
        Begin
          info[count].copies:=0;
          info[count].server.len:=0;
        End;
      key_press;
    End; (* add_item *)

(**********************************************************************)
(*                                                                    *)
(*                                                                    *)
(**********************************************************************)

 Procedure change_logging;
   Begin
     cls;
     gotoxy(12,10);
     if logging then
       Begin
         logging:=FALSE;
         Writeln('Default logging set to OFF');
       End
     Else
       Begin
         logging:=TRUE;
         Writeln('Default logging set to ON');
       End;
     key_press;
   End; (* change_logging *)

(**********************************************************************)
(*                                                                    *)
(*                                                                    *)
(**********************************************************************)

  Procedure delete_item;
    Var
      item : Integer;
      i,j  : Integer;
    Begin
      cls;
      Writeln;
      Write('Enter number of item to delete (0=Quit):');
      Readln(item);
      if item > 0 then
        Begin
          if item <> count then
            for i:= item+1 to count do info[i-1]:=info[i];
          count:=count-1;
        End;
      key_press;
    End; (* delete_item *)

(**********************************************************************)
(*                                                                    *)
(*                                                                    *)
(**********************************************************************)

  Procedure list_items;
    Var
      i    : Integer;
      temp : Lstring(80);
    Begin
      cls;
      Writeln;
      writeln('Item ',' ':20,'Program Name',' ':12,'Logging  Copies  Server');
      for i:= 1 to 80 do temp[i]:='=';
      temp.len:=80;
      Write(temp);
      if count = 0 then writeln('File is empty or does not exist')
      Else for i:= 1 to count do
        Begin
          write(i:3,' | ',info[i].name:40,'  |');
          if info[i].logit = 1 then write('   OFF  ')
          Else write('   ON   ');
          If info[i].copies = 0 then write('|  ALL  ')
          Else write('|  ',info[i].copies:3,'  ');
          if info[i].server.len > 0 then write('| ',info[i].server)
          Else write('|');
          Writeln;
        End;
      Write(temp);
      key_press;
    End; (* list_items *)

(**********************************************************************)
(*                                                                    *)
(*                                                                    *)
(**********************************************************************)

  Procedure modify_item;
    Var
      ch : Char;
      item : Integer;
      i,j  : Integer;
      temp : Lstring(80);
    Begin
      cls;
      Writeln;
      Write('Enter number of item to modify (0=Quit):');
      Readln(item);
      if (item > 0) and (item <= count) then
        Begin
          write('Item ',' ':20,'Program Name',' ':12);
          writeln('Logging  Copies  Server');
          for i:= 1 to 80 do temp[i]:='=';
          temp.len:=80;
          Write(temp);
          write(item:3,' | ',info[item].name:40,'  |');
          if info[item].logit = 1 then write('   OFF  ')
          Else write('   ON   ');
          If info[item].copies = 0 then write('|  ALL  ')
          Else write('|  ',info[item].copies:3,'  ');
          if info[item].server.len > 0 then write('| ',info[item].server)
          Else write('|');
          Writeln;
          Write(temp);
          Writeln;
          Write('Enter program name [',info[item].name,']:');
          readln(temp);
          if temp.len > 0 then copylst(temp,info[item].name);
          upper_case(info[item].name);
          Write('Log executions ? (Y/N) [');
          if info[item].logit=0 then write('Y]:')
          Else write('N]:');
          readln(temp);
          if temp.len > 0 then
            Begin
              ch:=temp[1];
              if ch in ['Y','y'] Then info[item].logit:=0
              Else info[item].logit:=1;
            End;
          Write('Limited number of copies ? (Y/N) [');
          if info[item].copies > 0 then write('Y]:')
          Else write('N]:');
          readln(temp);
          if temp.len > 0 then ch:=temp[1]
          Else
            Begin
              if  info[item].copies > 0 then ch:= 'Y'
              Else ch:='N'
            End;
          if ch in ['Y','y'] Then
            Begin
              Write('How Many Copies [',info[item].copies:3,']:');
              readln(temp);
              if temp.len > 0 then
                Begin
                  if NOT decode(temp,info[item].copies) Then
                  info[item].copies:=0;
                End;
              if info[item].copies > 0 Then
                Begin
                  Write('Enter Server [',info[item].server,']:');
                  readln(temp);
                  if temp.len > 0 then copylst(temp,info[item].server);
                  while (info[item].server.len > 0 ) and
                    (info[item].server[1]=' ') do
                      delete(info[item].server,1,1);
                  upper_case(info[item].server);
                End;
            End
          Else
            Begin
              info[item].copies:=0;
              info[item].server.len:=0;
           End;
        End;
      key_press;
    End; (* Modify_item *)

(**********************************************************************)
(*                                                                    *)
(*                                                                    *)
(**********************************************************************)

  Procedure exit;
    Begin
      write_file;
    End;

(**********************************************************************)
(*                                                                    *)
(*                                                                    *)
(**********************************************************************)

  Procedure quit;
    Begin
    End;

(**********************************************************************)
(*                                                                    *)
(*                                                                    *)
(**********************************************************************)

  Procedure menu;
    Var
      s  : Lstring(1);
      ch : Char;
    Begin
      Repeat
        cls;
        Writeln(program_name);
        Writeln(copyright);
        Writeln;
        Writeln;
        Write('Default logging is ');
        if logging then Writeln('ON') Else Writeln('OFF');
        Writeln;
        Writeln('A)dd a item');
        Writeln('C)hanged default logging');
        Writeln('D)elete an item');
        Writeln('L)ist items');
	Writeln('M)odify an item');
        Writeln;
        Writeln('Q)uit and Do NOT update file');
        Writeln('E)xit and update file');
        Writeln;
        Write('Enter letter of choice :');
        readln(s);
        If s.len > 0 then
          Begin
            ch := s[1];
            writeln;
            Case ch of
              'A','a' : add_item;
              'C','c' : change_logging;
              'D','d' : delete_item;
              'E','e' : exit;
              'L','l' : list_items;
              'M','m' : modify_item;
              'Q','q' : quit;
              otherwise;
            End;
          End;
      Until ch in ['q','Q','e','E']
    End;

(**********************************************************************)
(*                                                                    *)
(*                                                                    *)
(**********************************************************************)

Begin
  initialize;
  read_file;
  menu;
End.
(* O *)
