program VideoDataBase;
(*$A+,C-,R-,V-*)


(****************************************************************)
(*                                                              *)
(*                  VIDEOCASSETTENVERWALTUNG                    *)
(*                                                              *)
(****************************************************************)



const
  f1 = #201;
  f2 = #202;
  f3 = #203;
  f4 = #204;
  f5 = #205;
  f6 = #206;
  f7 = #207;
  f8 = #208;
  f9 = #209;
  f10 = #210;
  f11 = #211;
  f12 = #212;
  f13 = #213;
  f14 = #214;
  f15 = #215;
  f16 = #216;
  f17 = #217;
  f18 = #218;
  f19 = #219;
  f20 = #220;


  MaxAnzCass = 100;
  Leer = -1;

        schwarz='0';
        rot='1';
        gruen='2';
        gelb='3';
        blau='4';
        violett='5';
        hellblau='6';
        weiss='7';




(*  data record Size definition *)
  TitelrecSize  =  80;               (*   record Size *)

(*  TURBO-access constants *)
  MaxDataRecSize  =  TitelRecSize;  (*  max record Size *)
  MaxKeyLen       =  40;            (*  max key Size *)
  PageSize        =  16;            (*  page Size *)
  Order           =  8;             (*  half page Size *)
  PageStackSize   =  15;            (*  page buffer Size *)
  MaxHeight       =  5;             (*  max B-tree height *)


var
  NoOfRecs      : Integer;

(*  include TURBO-access modules *)


(*$I A:ACCESS.BOX*)
(*$I A:GETKEY.BOX*)
(*$I A:ADDKEY.BOX*)
(*$I A:DELKEY.BOX*)


type
  Str2    =  string[2];
  Str3    =  string[3];
  Str4    =  string[4];
  Str5    =  string[5];
  Str6    =  string[6];
  Str8    =  string[8];
  Str10   =  string[10];
  Str20   =  string[20];
  Str40   =  string[40];
  Str80   =  string[80];
  AnyStr  =  string[255];

(*  character set type *)
  CharSet=  set of Char;


  VidRec  = record
              titel: Str40;
              datum: Str8;
              min:   Str3;
              lp:    Str2;
              zwanf: Str4;
              zwend: Str4;
              cassette: integer;
            end;
  cassrec = record
              cassart:   Str20;
              titelref:  array [1..12] of integer;
            end;
  tcassrecfile = file of cassrec;


var

(*  global variables *)
  DatF           : DataFile;
  IndexF         : IndexFile;
  Ch             : Char;

  cassrecF       : tcassrecfile;



(*$I VINC *)



procedure EditCass(Nummer:integer;
                   var nextcass:integer;
                   var result:integer);

var   wahl,wahl2: char;
      strnextcass:string[15];
      i:          integer;
      aktcass:    cassrec;
      akttitel:   integer;
      datsatz:    array[1 .. 12] of vidrec;
      adatsatz:   vidrec;
      schluessel: str40;

      dataref:    integer;
      cart:       str20;
      caend:      boolean;
      term:       charset;
      termch:     char;
      tref:       integer;
      datbuffer:  vidrec;
      titeldoppelt: boolean;

procedure editline(l:integer);
var  pos: integer;
     posalt:integer;
     term: charset;
     termch: char;
     korrekt: boolean;

begin
with datsatz[l] do
begin
  term:=[^X,^E,#13,#27];
  pos:=1;
  repeat
    case pos of
      1:  begin
            inputstr(titel,40,5,4+l,term,termch,'.');
          end;
      2:  begin
            inputstr(datum,6,48,4+l,term,termch,'.');
          end;
      3:  begin
            inputstr(min,3,57,4+l,term,termch,'.');
          end;
      4:  begin
            inputstr(lp,2,63,4+l,term,termch,'.');
          end;
      5:  begin
            inputstr(zwanf,4,68,4+l,term,termch,'.');
          end;
      6:  begin
            inputstr(zwend,4,75,4+l,term,termch,'.');
          end;

    end; (* case *)

    korrekt:=((titel='') and (zwanf='') and (zwend='') and (datum='') and
              (min='') and (lp=''))
             or (titel<>'');

    posalt:=pos;
    if termch=^X then
        if pos<6 then pos:=pos+1 else pos:=1
    else
        if termch=^E then
            if pos>1 then pos:=pos-1 else pos:=6
        else
            if termch=#13 then
                if pos<6 then pos:=pos+1;

  until korrekt and (((termch=#13) and (posalt=6)) or (termch=#27));
end;
end;


begin
  nextcass:=nummer;
  result:=0;
  caend:=false;
  gotoxy(41,2);
  write(Nummer:3);

  holecassrec(nummer,aktcass);

  gotoxy(47,2);

  cart:=aktcass.cassart;
  color(hellblau);
  write(cart);

  for i:=1 to 12 do
    begin
      with datsatz[i] do
        begin
          titel:='';
          datum:='';
          min:='';
          lp:='';
          zwanf:='';
          zwend:='';
          cassette:=Nummer;
        end;
      tref:=aktcass.titelref[i];
      if tref<>Leer then
        begin
          GetRec(DatF,tref,datbuffer);
          datsatz[i]:=datbuffer;
          with datsatz[i] do
            begin
              gotoxy(6,5+i);
              write(titel);
              gotoxy(49,5+i);
              write(datum);
              gotoxy(58,5+i);
              write(min);
              gotoxy(64,5+i);
              write(lp);
              gotoxy(69,5+i);
              write(zwanf);
              gotoxy(76,5+i);
              write(zwend);
            end;
        end;
    end;

  color(gruen);


  repeat
    gotoxy(2,22);
    color(weiss);
    write(' Bitte w{hlen! ');
    color(gruen);
    read(kbd,wahl);
    gotoxy(2,22);
    write('               ');
    case wahl of
      f1,f2,f3,f4,f5,f6,f7,f8,f9,f10,f11,f12:
          begin
            akttitel:=ord(wahl)-200;

            if datsatz[akttitel].titel='' then
              begin
                titeldoppelt:=false;
                repeat
                  editline(akttitel);
                  if titeldoppelt then
                    begin
                      clrerrormess;
                      titeldoppelt:=false;
                    end;
                  if datsatz[akttitel].titel<>'' then
                    begin
                      schluessel:=upcasestr(datsatz[akttitel].titel);
                      addrec(datf,dataref,datsatz[akttitel]);
                      addkey(indexf,dataref,schluessel);
                      if ok then
                        begin
                          aktcass.titelref[akttitel]:=dataref;
                          caend:=true;
                        end
                      else
                        begin
                          titeldoppelt:=true;
                          errormess('Titel doppelt, bitte {ndern! ');
                          deleterec(datf,dataref);
                        end;
                    end
                until not titeldoppelt;
              end
            else
              begin
                adatsatz:=datsatz[akttitel];
                editline(akttitel);
                if datsatz[akttitel].titel='' then
                  begin
                    schluessel:=upcasestr(adatsatz.titel);
                    deletekey(indexf,dataref,schluessel);
                    deleterec(datf,dataref);
                    aktcass.titelref[akttitel]:=leer;
                    caend:=true;
                  end
                else
                  if adatsatz.titel=datsatz[akttitel].titel then
                    begin
                      if (adatsatz.zwanf<>datsatz[akttitel].zwanf) or
                         (adatsatz.zwend<>datsatz[akttitel].zwend) or
                         (adatsatz.datum<>datsatz[akttitel].datum) then
                        putrec(datf,aktcass.titelref[akttitel],
                                    datsatz[akttitel]);
                    end
                  else
                    begin
                      schluessel:=upcasestr(adatsatz.titel);
                      deletekey(indexf,dataref,schluessel);
                      deleterec(datf,dataref);
                      schluessel:=upcasestr(datsatz[akttitel].titel);
                      addrec(datf,dataref,datsatz[akttitel]);
                      addkey(indexf,dataref,schluessel);
                      if ok then
                        begin
                          aktcass.titelref[akttitel]:=dataref;
                          caend:=true;
                        end
                      else
                        begin
                          deleterec(datf,dataref);
                          titeldoppelt:=true;
                          errormess('Titel doppelt, bitte {ndern! ');
                          repeat
                            editline(akttitel);
                            clrerrormess;
                            titeldoppelt:=false;
                            if datsatz[akttitel].titel<>'' then
                              begin
                                schluessel:=upcasestr(datsatz[akttitel].titel);
                                addrec(datf,dataref,datsatz[akttitel]);
                                addkey(indexf,dataref,schluessel);
                                if ok then
                                  begin
                                    aktcass.titelref[akttitel]:=dataref;
                                    caend:=true;
                                  end
                                else
                                  begin
                                    titeldoppelt:=true;
                                    errormess('Titel doppelt, bitte {ndern! ');
                                    deleterec(datf,dataref);
                                  end;
                              end
                            else
                              begin
                                aktcass.titelref[akttitel]:=leer;
                                caend:=true;
                              end;
                          until not titeldoppelt;

                        end;
                    end;
              end;

          end;
     'l','L':
          begin
            read(kbd,wahl2);
            if wahl2 in [f1,f2,f3,f4,f5,f6,f7,f8,f9,f10,f11,f12] then
              begin
                akttitel:=ord(wahl2)-200;
                if datsatz[akttitel].titel<>'' then
                  begin
                    schluessel:=upcasestr(datsatz[akttitel].titel);
                    deletekey(indexf,dataref,schluessel);
                    deleterec(datf,dataref);
                    aktcass.titelref[akttitel]:=leer;
                    caend:=true;
                    with datsatz[akttitel] do
                      begin
                        titel:='';
                        datum:='';
                        min:='';
                        lp:='';
                        zwanf:='';
                        zwend:='';
                      end;
                    gotoxy(6,5+akttitel);
                    write('........................................ ! ...... ! ... ! .. ! .... - ....');
                  end;
              end;
          end;
     f13: begin
            term:=[#13];
            inputstr(cart,20,46,1,term,termch,'.');
            aktcass.cassart:=cart;
            caend:=true;
          end;
     f14: begin
          end;
     f15: begin
            if nextcass>1 then nextcass:=nextcass-1
                          else nextcass:=maxanzcass;
            result:=1;
          end;
     f16: begin
            if nextcass<maxanzcass then nextcass:=nextcass+1
                                   else nextcass:=1;
            result:=1;
          end;
     f17: begin
            repeat
              gotoxy(2,22);
              color(weiss);
              write(' Neue Cassettennummer: ');
              readln(strnextcass);
              val(strnextcass,nextcass,i);
              if i<>0 then nextcass:=0;
              (* Zahl fehlerhaft *)
              gotoxy(2,22);
              write('                                              ');
            until (nextcass>=1) and (nextcass<=maxanzcass);
            color(gruen);
            result:=1;
          end;
     f18: begin
          (* Suchen *)
          end;
     f19: begin
            Ausdruck;
          end;
     f20: begin
          (* Ende *)
            result:=2;
          end;
    end; (* case wahl *)
  until (result=2) or (result=1);
  if caend then schreibecassrec(nummer,aktcass);
end;




procedure main;
var   cnr:    integer;
      result: integer;
      nextc:  integer;
begin
  cnr:=1;
  repeat
    maske;
    editcass(cnr,nextc,result);
    if result=1 then cnr:=nextc
      else if result=0 then writeln('error');
  until result=2;

end;


(*  Main program *)

begin
  ClrScr ;
  keys;

  openfiles;

  main;

  closefiles;

end.
