{ CAFET.PAS                                                         }
{ Allow to command different things (pizza, bevarages) in a school  }
{ cafeteria (open at lunch time) using uniquely the arrows of the   }
{ keyboard and make the total to pay automatically.                 }

{                                                                   }
{ At the end of the week, recapitulate all the totals of the week   }
{ (before year 2000 !)                                              }
{                                                                   }
{ Author: Unknown                                                   }
{ Datum: 20.01.2009                            http://www.trsek.com }

program caf44cga;
uses crt,dos;
const
  max = 40;
var
  col0, col1, col14, col15            : integer;
  t1, t2, ch, cat                     : char;
  n, no, col, lig, x, y, code, fl, i  : integer;
  tot, ben, total, benef              : real;
  totsem, bensem, num                 : real;
  strn                                : string;
  mot_p, pw                           : string[5];
  nom_f, jjmm                         : string[6];
  des                                 : string[16];
  fic                                 : text;
  suite                               : boolean;
  nbr                                 : array [1..max] of real;
  totj, benj                          : array[1..10] of real;
  datjour, totjour, benjour           : array[1..10] of string;
  ch1, ch2, ch3                       : array [0..max] of string[16];
  fich                                : array [0..10] of string[6];
  regs                                : registers;
  keyflag                             : byte absolute $40:$17;

Function Frs(rl:real):real;
var
  i:longint;  s:string;
begin
  i :=round(rl);
  str(i,s);
  case length(s) of
    1 :  s:=' 0.0'+s;
    2 :  s:=' 0.'+s;
    else s:=copy(s,1,length(s)-2)+'.'+copy(s,length(s)-1,2);
  end;
  write(' ':8-length(s),s);
end;

Function Chfr(ch:string):string;
begin
write(' ':6-length(ch));
if length(ch)=2 then write('0')else write(' ');
write(copy(ch,1,length(ch)-2),',');
write(copy(ch,length(ch)-1,2));
end;

Function FFrs(rl:real):real;
var  i:longint;  s:string;
begin
  write(Fic,'FS ');
  i :=round(rl);
  str(i,s);
  case length(s) of
    1 :  s:=' 0.0'+s;
    2 :  s:=' 0.'+s;
    else s:=copy(s,1,length(s)-2)+'.'+copy(s,length(s)-1,2);
  end;
  writeln(Fic,' ':8-length(s),s);
end;

Procedure CursOff;
Begin
  FillChar(Regs,SizeOf(Regs),0);
  With Regs Do
    Begin
    AH:=$01;
    CH:=20;
    CL:=0;
    End;
  Intr($10,Regs);
End;

Procedure CursOn;
Begin
  FillChar(Regs,SizeOf(Regs),0);
  With Regs Do
    Begin
    CH:=6;
    CL:=7;
    AH:=$01;
    End;
  Intr($10,Regs);
End;

procedure mot_de_passe;
begin
  ch := ' ';
  gotoxy(15,19);
  writeln('Veuillez taper le mot de passe ( ESC pour terminer )');
  writeln;
  mot_p := '';
  gotoxy(37,21);
  ch:=upcase(readkey);
  if ch <> #27 then
  repeat
    mot_p := mot_p + ch;write('.');
    gotoxy(37,21);
    for n:= 1 to 4 do
    begin
      gotoxy(37+2*n,21);
      ch:=upcase(readkey);
      mot_p := mot_p + ch;write('.');
    end;
    if mot_p <> pw then
    begin
      write(#7); write('.'); gotoxy(37,21);clreol;
      mot_p := '';
      ch := upcase(readkey);
    end;
  until mot_p = pw
  else
  begin
    curson;
    clrscr; writeln; writeln;
    write('Avec le bonjour de Jean-Daniel Greub !');
    writeln; writeln;
  end;
  gotoxy(37,21);clreol;
end;

procedure saisir_nom_fichier;
{seuls noms de fichiers admis: DATES DU TYPE JJMMAA}
begin
  ch := ' ';
  while ch <> 'O' do
    begin
    nom_f:='';
    gotoxy(57,19);write('      ');gotoxy(57,19);
    repeat ch:=readkey until ch in ['0'..'3'];
    write(ch); nom_f:=nom_f + ch;
    repeat ch:=readkey until ch in ['0'..'9'];
    write(ch); nom_f:=nom_f + ch;
    repeat ch:=readkey until ch in ['0'..'1'];
    write(ch); nom_f:=nom_f + ch;
    repeat ch:=readkey until ch in ['0'..'9'];
    write(ch); nom_f:=nom_f + ch;
    repeat ch:=readkey until ch = '9';
    write(ch); nom_f:=nom_f + ch;
    repeat ch:=readkey until ch in ['5'..'9'];
    write(ch); nom_f:=nom_f + ch;
    gotoxy(15,21);write('Cette date est-elle correcte  ( O / N )  ? ');
    repeat ch :=upcase(readkey) until ch in['O','N']; writeln(ch);
    gotoxy(14,21);clreol;
    end;
  clrscr;
end;

procedure ouvrir_fichier;
var i     : integer;
    ch    : char;
begin
  gotoxy (15,19);clreol; curson;
  write('Veuillez taper la date au format JJMMAA  [      ]');
  textcolor(col15);
  saisir_nom_fichier; cursoff;
  assign(fic,nom_f);
  {$I-}
    reset(fic);
    i := ioresult;
  {$I+}
  if i<>0 then rewrite(fic);
  gotoxy(1,24);clreol;
  gotoxy(76,23);
end;

Procedure lire_fichier_donnees;
(***
Cette proc‚dure commence par lire les donn‚es du fichier < CAFET.LST >
qui fichier DOIT ˆtre constitu‚ de 40 groupes de 3 ‚l‚ments :
LIGNE 1  : d‚signation (doit contenir 16 caractŠres ou espaces)
LIGNE 2  : prix en centimes (min = 0), suivi imm‚diatement d'un <return>
LIGNE 3  : b‚n‚fice en centimes (min = 0), suivi imm‚diatement d'un <return>
***)
begin
clrscr;
  no := 1;
  Assign(Fic, 'cafet.lst');  { Standard output }
  Reset(Fic);
  des := ' ';
  for n:= 1 to max do
  begin
    Readln(Fic,des); ch1[no] := des;
    Readln(Fic,des); ch2[no] := des;
    Readln(Fic,des); ch3[no] := des;
    inc(no);
  end;
  Close(Fic);
end;

procedure titre;
begin
cursoff;
ch:=' ';
textcolor(col14);
textbackground(col1);
clrscr;
gotoxy(28,05);writeln('COLLEGE  DE  LA  FLORENCE');
gotoxy(32,07);writeln('Jean-Daniel Greub');
gotoxy(14,09);write(#218);for n:=1 to 51 do write(#196);writeln(#191);
gotoxy(14,10);write(#179);for n:=1 to 51 do write(#032);writeln(#179);
gotoxy(14,11);writeln(#179,'    ÛÛÛÛÛÛ±  ÛÛÛÛÛÛ±  ÛÛÛÛÛÛ±  ÛÛÛÛÛÛ±  ÛÛÛÛÛÛ±    ',#179);
gotoxy(14,12);writeln(#179,'    ÛÛ±      ÛÛ± ÛÛ±  ÛÛ±      ÛÛ±        ÛÛ±      ',#179);
gotoxy(14,13);writeln(#179,'    ÛÛ±      ÛÛÛÛÛÛ±  ÛÛÛÛ±    ÛÛÛÛ±      ÛÛ±      ',#179);
gotoxy(14,14);writeln(#179,'    ÛÛ±      ÛÛ± ÛÛ±  ÛÛ±      ÛÛ±        ÛÛ±      ',#179);
gotoxy(14,15);writeln(#179,'    ÛÛÛÛÛÛ±  ÛÛ± ÛÛ±  ÛÛ±      ÛÛÛÛÛÛ±    ÛÛ±      ',#179);
gotoxy(14,16);write(#179);for n:=1 to 51 do write(#032);writeln(#179);
gotoxy(14,17);write(#192);for n:=1 to 51 do write(#196);writeln(#217);
gotoxy(31,19);textcolor(col14);
pw := #84+#69+#70+#65+#67;
end;

procedure enregistrer;
{sauvegarde des donn‚es sur disque dans un fichier ayant une date pour titre}
begin
  Assign(Fic,nom_f);
  Rewrite(Fic);
  Writeln(Fic,'------------------------------');
  Writeln(Fic,'Date du jour     : ',nom_f);
  Writeln(Fic,'------------------------------');
  Write(Fic,'Total des ventes : '); FFrs(Total);
  Write(Fic,'B‚n‚fice total   : '); FFrs(Benef);
  Writeln(Fic,'------------------------------');
  num := 1;
  for n := 1 to 40 do
  begin
    if nbr[trunc(num)] > 0 then
    Writeln(Fic,ch1[trunc(num)],'  ',nbr[trunc(num)]:3:0);
    num := num + 1;
  end;
  Writeln(Fic,'------------------------------');
  Close(Fic);
  clrscr;
  gotoxy(01,4);
  for n:=1 to 79 do write('-');
  gotoxy(01,6);
  writeln('Le nom du fichier de sauvegarde est < ',nom_f,' >');
  writeln('                                      ------');
  writeln;
  writeln('Il peut ˆtre ais‚ment visualis‚ en tapant < L > pour L.COM');
  writeln;
  for n:=1 to 79 do write('-');
  gotoxy(01,13); writeln ('avec le bonjour de Jean-Daniel Greub !');
  textcolor(col15);textbackground(col1);
end;

procedure recap;
begin

  { ENTREE DES NOMS DES n FICHIERS }
  curson;
  n:=1; clrscr; gotoxy(1,2);
  writeln('R‚capitulation des r‚sultats de plusieurs journ‚es');
  writeln('--------------------------------------------------');
  write('Taper  0000  pour terminer !            ');
  writeln('Ann‚e 19',copy(nom_f,5,2));
  while jjmm <> '0000' do
  begin
    writeln;
    write('Taper sous la forme JJMM la date du ');
    write ('fichier num‚ro ',n,'   [    ]');
    gotoxy(57,wherey);
    jjmm := '';
    repeat ch:=readkey until ch in ['0'..'3']; write(ch);jjmm := jjmm + ch;
    repeat ch:=readkey until ch in ['0'..'9']; write(ch);jjmm := jjmm + ch;
    repeat ch:=readkey until ch in ['0'..'1']; write(ch);jjmm := jjmm + ch;
    repeat ch:=readkey until ch in ['0'..'9']; write(ch);jjmm := jjmm + ch;
    fich[n] := jjmm + copy(nom_f,5,2);
    assign(fic,fich[n]);
    {$I-}
    reset(fic);
    i := ioresult;
    {$I+}
    if i<>0 then rewrite(fic);
    if i=2 then begin gotoxy(63,wherey); write(' N''EXISTE PAS !'); end;
    if i= 0 then
      begin
        if eof(fic) = true then
          begin
            gotoxy(63,wherey); write(' FICHIER VIDE !');
          end;
        inc(n);
      end;
    close(fic);
  end;


  gotoxy(01,5+n);clreol;writeln;
  clrscr;
  totsem := 0; bensem := 0;
  writeln('R‚capitulation des r‚sultats de la semaine');
  writeln('------------------------------------------'); writeln;
  writeln('Date         Total    B‚n‚fice'); writeln;


  { LECTURE LIGNE PAR LIGNE DES NOMS DES n FICHIERS }
  for n := 1 to n - 1 do
  begin
    assign(fic,fich[n]);
    {$I-}
    reset(fic);
    i := ioresult;
    {$I+}
    strn := '';
    Readln(Fic,strn);                                           {LIGNE 1}
    Readln(Fic,strn);                                           {LIGNE 2}
    datjour[n]:=copy(strn,length(strn)-5,6);                    {LIGNE 3}
    Readln(Fic,strn);                                           {LIGNE 4}
    Readln(Fic,strn);                                           {LIGNE 5}
    totjour[n]:=copy(strn,length(strn)-7,5) + copy(strn,length(strn)-1,2);
    { writeln; writeln(totjour[n]) }
    Readln(Fic,strn);                                           {LIGNE 7}
    benjour[n]:=copy(strn,length(strn)-7,5) + copy(strn,length(strn)-1,2);
    val(totjour[n],totj[n],code); totj[n] := totj[n]/100;
    val(benjour[n],benj[n],code); benj[n] := benj[n]/100;
    gotoxy (01,wherey); write(datjour[n]);
    gotoxy (12,wherey); write(totj[n]:8:2);
    gotoxy (24,wherey); write(benj[n]:7:2); writeln;
    totsem := totsem + totj[n];
    bensem := bensem + benj[n];
  close(Fic);
  end;
  writeln('------------------------------');
  gotoxy (12,wherey); write(totsem:8:2);
  gotoxy (24,wherey); write(bensem:7:2); writeln;
  curson;
  writeln; writeln;
  write('Avec le bonjour de Jean-Daniel Greub !');
  writeln; writeln;
end;

procedure lire_nombre;
begin
strn := '';
ch := ' ';
while ch <> #13 do
  begin
    repeat ch:= readkey until ch in ['0'..'9',#13];
    if ch <> #13 then begin write(ch); strn:=strn + ch; end;
  end;
val(strn,n, Code);
{les caractŠres num‚riques de la chaŒne passe dans l'integer n}
end;

procedure saisie;
begin
fl := 0; cursoff; clrscr;

{ affichage des articles … choisir }
textcolor(col15); textbackground(col1); clrscr; no := 1; lig:=1;
repeat
  gotoxy(01,lig); write(ch1[no]); inc(no);
  gotoxy(21,lig); write(ch1[no]); inc(no);
  gotoxy(41,lig); write(ch1[no]); inc(no);
  gotoxy(61,lig); write(ch1[no]); inc(no);
  lig := lig + 2;
until no > max;
gotoxy(01,22);
writeln('Utiliser les flŠches pour choisir puis presser < RETURN >');
GOTOXY(01,24);
writeln('Presser la touche < ESC > quand tout est saisi');

{*********************************************************************}

{SAISIES MULTIPLES, SORITE AVEC <ESC>}

no := 1; col := 01; lig := 01; gotoxy(col,lig);
t1:=' ';t2:=' ';
while t1 <> #27 do
begin
  repeat t1:=readkey until t1 in [#0,#13,#27];
  if ord(t1)= 0 then
  begin
    t2 := readkey;
    textcolor(col15); textbackground(col1); writeln(ch1[trunc(num)]);
    if ord(t2)=72 then fl:=1; if ord(t2)=75 then fl:=1;
    if ord(t2)=77 then fl:=1; if ord(t2)=80 then fl:=1;
    if (ord(t2)=72) and (lig > 01) then lig := lig - 02;
    if (ord(t2)=75) and (col > 01) then col := col - 20;
    if (ord(t2)=77) and (col < 60) then col := col + 20;
    if (ord(t2)=80) and (lig < 19) then lig := lig + 02;
    num := (col + 19) / 20 + (lig-1) * 2; gotoxy(col, lig);
    x := wherex; y := wherey;
    textcolor(col1); textbackground(col15); writeln(ch1[trunc(num)]);
    gotoxy(01,23);clreol;{write('col ',col,'  lig ',lig,'  num ',num:3:0);}
    gotoxy(x,y);
  end else
  if (ord(t1)=13) and (fl = 1) then
  begin
    des := ch1[trunc(num)]; n := 0; gotoxy(01,22); clreol;
    writeln('Taper le nombre d''articles, puis presser < RETURN >');
    gotoxy(1,23); clreol;
    curson; write('Nb de < ',des,'>  ');
    lire_nombre; cursoff;
    gotoxy(1,23); clreol; gotoxy(01,22); clreol;
    writeln('Utiliser les flŠches pour choisir puis presser < RETURN >');
    nbr[trunc(num)] := n;
  end;
end;
clrscr; total := 0; benef := 0;
for n:=1 to 79 do write('-'); writeln;

{affichage des valeurs venant d'ˆtre saisies}
textcolor(col15); textbackground(col1); clrscr;
num := 1;          {real}
lig := 1;
for n := 1 to 40 do
begin
  if (nbr[trunc(num)] > 0) and (ch2[trunc(num)] <> '0') then
  begin
    write(nbr[trunc(num)]:3:0,' ',ch1[trunc(num)],' … ');
    chfr(ch2[trunc(num)]);
    val(ch2[trunc(num)], Tot, Code); gotoxy(34,wherey);
    write (' Prix total : '); Frs(Tot * nbr[trunc(num)]);
    val(ch3[trunc(num)], Ben, Code); gotoxy(60,wherey);
    write ('B‚n‚fice : ');   Frs(Ben * nbr[trunc(num)]);
    writeln;
    Total := Total + Tot * nbr[trunc(num)];
    Benef := Benef + Ben * nbr[trunc(num)];
    inc(lig);
  end;
  num := num + 1;
  IF lig = 21 THEN
  BEGIN
  WRITELN; WRITE('Presser une touche pour continuer !');
  READKEY; WRITELN; WRITELN;
  END;
end;

for n:=1 to 79 do write('-'); writeln;
gotoxy(01,wherey); write('DATE  : ',nom_f);
gotoxy(35,wherey); write('TOTAL      : '); Frs(Total);
gotoxy(60,wherey); write('BENEFICE : ');   Frs(Benef);
writeln;
ch := ' ';
curson;
writeln;
write('Les donn‚es ci-dessus sont-elles correctes (O / N) ? ');
ch := upcase(readkey);
if upcase(ch) = 'O' then
begin write (ch);enregistrer;end
else begin write (ch);saisie;end;
end;

procedure choix;
begin
clrscr;
gotoxy(16,09);write('Voulez-vous...');
gotoxy(16,12);write('1. Enr‚gistrer les r‚sultats d''une journ‚e ?');
gotoxy(16,14);write('2. R‚capituler les r‚sultats de plusieurs journ‚es ?');
gotoxy(16,18);write('Taper  1  ou  2');
repeat ch:=readkey until ch in ['1'..'2'];
if ch = '1' then saisie;
if ch = '2' then recap;
end;

procedure choix_ecran;
begin

col0 := 0;
col1 := 0;
col14:= 2;
col15:= 3;

{0, 1, 14, 15 pour ‚cran VGA 16 couleurs }
{0, 0,  2,  3 pour ‚cran CGA monochrome  }

{ en VGA 16 couleurs text=14 back=1  ... jaune sur fond bleu  }
{ en VGA 16 couleurs text=15 back=0  ... blanc sur fond noir  }
{ en VGA 16 couleurs text=0  back=15 ... noir  sur fond blanc }

end;

begin
choix_ecran;
lire_fichier_donnees;
titre;
mot_de_passe;
  if ch <> #27 then
  begin
    ouvrir_fichier;
    choix;
    curson;
  end;
end.