{$a-}
{$f+}
program agenda;   { }
{$define sorts}
{define mult_mod}
{define cus_stampe}
{define zap}
{define no_ord_file} {dice di compilare le procedure che controllano l'ordine dell'archivio}
{define shortname}
{define cus_concetrate}
{define cus_input}
{define auto_input}
{define cus_output}
{$define sort}
{define addata}
{define strc}  {dice al compilatore di compilare le routine per le strc}
{$define too5g2} {dice al compilatore di non includere le routine perchŠ
                    sono gi… comprese nella unit}
{define pr_ix} {dice al compilatore di compilare la parte riguardante il pr_ix
 perchŠ siamo in resenza di record con chiave  di tipo array}
{$define epson}  {dice al compilatore di compilare le routine per la
                 gestione stampante}
{define stampe} {dice al compilatore se va' compilata la parte riguardante la
                     stampa su carta dei record o no (comprendo quindi .l10 o no)}
uses prgidu,dos,crt,recun,strdef,too5b,too5s,{$ifdef too5g2} too5g2,{$endif} conf2,
                         {$ifdef epson}epson,{$endif}
			 {$ifndef epson} smepson,{$endif} lpt,printer,business
			 {$ifdef sorts} ,sorts {$endif}
			 {$ifndef cus_stampe} ,procprun {$endif};

const


{U+}

{$ifndef cus_stampe}
      maxarg=14;
      maxvar=12;
{$endif}

TYPE
   st1=string[1];
{$ifndef too5g2}
  charset=set of char; {serve in too4proc}
{$endif}

{$ifndef cus_stampe}
  arg_st=array[1..maxarg]of str120;{array per le stampe short}
  arg_n=array[1..maxarg]of integer;{come sopra}
{$endif}


{$ifdef strc}
    strc=string[stlen];
{$endif}

var

    speed,dom,ff:boolean;
    co:integer;{code per input name;pu• essere usato da tutti}
    dataem,localita:string;
    day,month,year,dweek:word;

    baso:file of fatt;
    {tabella tipo argomento:
                                         se arg_v[n] e' | allora arg[n] e'
                                         --------------------------------
                                             0            tipo generico (comando o nome campo)
                                             1            stringa da stampare   }
{$ifdef addata}
     ni:string;{nuova istruzione serve in out da un elaborazione per creare un processo secondo}
{$endif}

{$ifndef too5g2}

{$i too5set}

{$endif}



{$i  \tp\stand\comp1}

{$ifndef cus_input}
{$Endif}
{$ifdef cus_input}
{$Endif}

procedure stampa_large(x,y:integer;buff:fatt);
begin
  gotoxy(x,y);
  clreop;
  stampa_buff(buff);
  wait;
end;
procedure fromtext;
var st2:string;
   c2:integer;
begin
  if present('agenda') then begin
    assign(config,'agenda');
    reset(config);
    assign(base,st_name);
    reset(base);
    seek(base,filesize(base));
    while not(eof(config)) do begin
      azzera_buff(buff);
      readln(config,st);
      while pos(chr(9),st)>0 do begin
        azzera_buff(buff);
        with buff do begin
	  nome:=cutlr(copy(st,1,15));
	  cognome:=cutlr(copy(st,16,13));
	  tel:=cutlr(copy(st,29,12));
	  info:=cutlr(copy(st,41,31));
	  compl:=cutlr(copy(st,72,11));
	  telwork:=cutlr(copy(st,83,25));
	end;
	clrscr;
	stampa_buff(buff);
	c2:=0;
	gets(10,22,120,'',st,c2);
      end;
      azzera_buff(buff);

      with buff do begin
	nome:=cutlr(copy(st,1,15));
	cognome:=cutlr(copy(st,16,13));
	tel:=cutlr(copy(st,29,12));
	info:=cutlr(copy(st,41,31));
	compl:=cutlr(copy(st,72,11));
	telwork:=cutlr(copy(st,83,25));
      end;
      write(base,buff);
    end;
    close(config);
    close(base);
  end;
end;



{$i  \tp\stand\proc0}
{$i  \tp\stand\proc1}

{$ifndef cus_stampe}
{$i \tp\stand\conf_2}
{$i  \tp\stand\procpr10}
{$endif}
{$i  \tp\stand\proc2}
{i \tp\stand\get_arg}
procedure cref(var st_name:string);
var con,code:integer;
begin
          menu(1,'Creazione file '+atoms+' con nome numerico');
          ok:=false;

          repeat
            code:=3;
            get_name2(10,10,12,'Filename?',st_name,code);
            if present(st_name) and (code=0) then begin
              message('Esiste gi… un archivio con questo nome',1,0);
              tasto:='n';
              get_chr(20,20,'Continuo?',tasto);
              if tasto='s' then
                ok:=true;
            end;

          until not(present(st_name)) or ok or (code=3);
          if (code=0) and ok then begin
            get_int(10,12,'Quanti record devo creare?',i);
            message('1 per ordine ascendente,2 per casuale altro per discendente',1,0);
            get_int(10,14,'Inserire codice:',y);
            if i<>0 then begin
              assign(base,st_name);
              rewrite(base);
              azzera_buff(buff);
              mid('creo');
              if (y=1) or (y=2) then begin
                x:=1;
                con:=1;
                now:=1;
              end
              else begin
                x:=1;
                con:=-1;
                now:=i;
              end;
              while (x<>i) do begin
               if y<>2 then begin
                 buff.nome:=sts(now);
                   case now of
                     1..9:buff.nome:='00'+buff.nome;
                     10..99:buff.nome:='0'+buff.nome;
                   end;
                end
                else
                  buff.nome:=sts(random(i));
                write(base,buff);
                x:=x+1;
                writexy(1,24,'Creato record num.:'+sts(x));
                now:=now+con;
              end;
              close(base);
            end;
          end;
end;

{$i  \tp\stand\archivio}


procedure utility(var st_name:string);{questa procedure deve sempre essere presente
al limite nulla pa dichiarata (altrimkenti bisogna modificare il main program
uscendo dallo standard}
var code:integer;
begin {utility}
  repeat
    menu(1,'Utility');
    centre(6,rsped('1) Creazione svuotamento/archivio',50));
    centre(8,rsped('2) Creazione files '+atoms+' a codice numerico',50));
    centre(10,rsped('3) Ridimensionamento Descrizioni ',50));
    centre(12,rsped('4) Zap',50));
    centre(14,rsped('5) Recupero da archivio testo `agenda`',50));

    getrchrb(60,20,'0','9','Scelta?',tasto);
    case tasto of
      '1':begin
            archivio(st_name);
            assign(base,st_name);
            rewrite(base);
            close(base);
          end;
      '2':cref(st_name);
      {$ifdef zap }
      '4':zap(st_name,'\listini','conv','file','conv.rep');
      {$endif}
      '5':fromtext;


    end;
  until tasto='0';
end;

{i \tp\stand\main}


procedure menu1;
var code:integer;
begin

{  exec('\turbo4\exe\menu1.exe',' '+prgid+' '+relase+' '+atoms+' '+sts(men_w)+' '+st_name);}


  menu(1,'Gest '+atoms+' '+relase+ ' by Loris    prgid='+prgid);
  pub_arc(50,3);
  centre(07,rsped('1) Selezione archivio',men_w));
  centre(08,rsped('2) Lista '+atoms+' presenti in archivio',men_w));
  centre(09,rsped('3) Aggiunta '+atoms+' in fondo all`archivio',men_w));

  centre(11,rsped('5) Inserisci/Modifica/Cancella '{+atoms+' in archivio'},men_w));
  centre(12,rsped('6) Stampa '+atoms+' su carta',men_w));
  centre(13,rsped('7) Utilita`',men_w));
  {centre(14,rsped('8) Lista archivi '+atoms,men_w));}
  {$ifdef sorts}
  centre(15,rsped('9) Gestione archivio',men_w));
  {$endif}

  centre(17,rsped('0) Uscita dalla Gestione '+atoms,men_w));

  tasto:=' ';
  code:=3;
  getrchr(40,23,'0','A','Scelta? ',tasto,code);
  if code=3 then
    tasto:='0';
  val(tasto,i,pos_r);
end;


procedure main;
begin{per permettre l'include del programma principale esso viene messo in una procedura}
  load_conf(prgid);
  {config_printer(prgid);}
   x:=0;y:=0;i:=0;posit:=0;pos_r:=0;
   tasto:='_';
   {$ifdef strc}
   nome:='';
   {$endif}
  {$ifdef pr_ix}
  pr_ix:=1;
  {$endif}
  clrscr;
  repeat

    if not(present(st_name)) then
      archivio(st_name);

    if file_ord[0] and not(file_ord[1]) and present(st_name) then begin
      mid('L`archivio Š in disordine ;sarebbe opportuno ordinarlo.');
      message2('Premere un tasto',1,0);
    end;
  until present(st_name);
  st:='';
  repeat
    azzera_buff(buff);
    buff:=null_rec;

    posit:=-1;
    menu1;
    case i of
      1:archivio(st_name);
      2:operation(st_name,1);
      3:inserisci(st_name);
      5:menu_m_c(st_name);
      {$ifdef cus_stampe}  6:menu_stampe(st_name); {$endif}
      {$ifndef cus_stampe}  6:scan_fileprint(st_name,'','','','',false); {$endif}
      7:utility(st_name);
      {$ifdef sorts}
      9:menu_sorts(st_name);
      {$endif}
    end;
  until i=0;
  mid('arrivederci');
  save_conf(prgid);
end;
BEGIN {program}
  st:='';
  LPTNAME:='ldef';
  Localita:='';
  main;
end.
