{$C-,U-}
program login(input,output);

(* Lesen von fremden Formaten unter CP/M+ auf dem CPC 6128 und dem JOYCE *)

type XDPB = record
              SPT : integer;
              BSH,
              BLM,
              EXM : byte;
              DSM,
              DRM : integer;
              AL0,AL1 : byte;
              CKS,
              OFF : integer;
              PSH,
              PHM,
              SIDE,
              TPSi,
              SePT,
              FIRST : byte;
              Size : integer;
              GAP3_RW,
              GAP3_FMT,
              MODE,
              Freeze : byte;
            end;

var     ein : XDPB;
        patch_a,
        patch_b : ^XDPB;
        datei   : file of XDPB;
        name    : string[10];
        wahl,
        drive,
        drive_1,
        drive_2 : char;
        ok      : boolean;
        aktdisk : byte;

function scan_key:char;
var taste : char;
begin
  read(kbd,taste);
  scan_key := upcase(taste)
end;

procedure intro;
begin
  clrscr;
  writeln('---------------------------------------':60);
  lowvideo;
  writeln('*** DISK-Login fuer CP/M+ (Amstrad) ***':60);
  normvideo;
  writeln('---------------------------------------':60);
  writeln;writeln
end;

procedure frage;
begin
  writeln;
  write('Abspeichern (J/N)? ');
  repeat
    wahl := scan_key
  until (wahl='J') or (wahl='N');
  writeln
end;

procedure einlesen;
begin
  assign(datei,name+'.FRM');
  reset(datei);
  read(datei,ein);
  close(datei)
end;

procedure abspeichern;
begin
  writeln;writeln;
  write('Abspeichern als: ');
  readln(name);
  assign(datei,name+'.FRM');
  rewrite(datei);
  write(datei,ein);
  close(datei)
end;

procedure eingeben;
begin
  write('HEX-Werte mit ''$'' davor eingeben!');
  with ein do begin
    write('Records per Track     (SPT): '); readln(spt);
    write('Blockverschiebefaktor (BSH): '); readln(bsh);
    write('Blockmaske            (BLM): '); readln(blm);
    write('Extentmaske           (EXM): '); readln(exm);
    write('Blockanzahl-1         (DSM): '); readln(dsm);
    write('Directory entries-1   (DRM): '); readln(drm);
    write('Allocationbyte 0      (AL0): '); readln(al0);
    write('Allocationbyte 1      (AL1): '); readln(al1);
    write('Checksumvector        (CKS): '); readln(cks);
    write('Reserved tracks       (OFF): '); readln(off);
    write('Phys. Record Shift    (PSH): '); readln(psh);
    write('Phys. Record Mask     (PHM): '); readln(phm);
    write('Seitenverteilung     (side): '); readln(side);
    write('Tracks per Seite     (TPSi): '); readln(tpsi);
    write('Sectors per track    (SePT): '); readln(sept);
    write('First sector number (first): '); readln(first);
    write('Sector size in bytes (size): '); readln(size);
    write('1.GAP3 Length R/W (GAP3_RW): '); readln(gap3_RW);
    write('2.GAP3 Len FMT  (GAP3_FMT2): '); readln(gap3_FMT);
    write('Modus                (mode): '); readln(mode);
    write('Freeze 0 or <> 0   (freeze): '); readln(freeze)
  end
end;

procedure ausgeben;
begin
  with ein do begin
    writeln('Records per Track     (SPT): ',spt);
    writeln('Blockverschiebefaktor (BSH): ',bsh);
    writeln('Blockmaske            (BLM): ',blm);
    writeln('Extentmaske           (EXM): ',exm);
    writeln('Blockanzahl-1         (DSM): ',dsm);
    writeln('Directory entries-1   (DRM): ',drm);
    writeln('Allocationbyte 0      (AL0): ',al0);
    writeln('Allocationbyte 1      (AL1): ',al1);
    writeln('Checksumvector        (CKS): ',cks);
    writeln('Reserved tracks       (OFF): ',off);
    writeln('Phys. Record Shift    (PSH): ',psh);
    writeln('Phys. Record Mask     (PHM): ',phm);
    writeln('Seitenverteilung     (side): ',side);
    writeln('Tracks per Seite     (TPSi): ',tpsi);
    writeln('Sectors per track    (SePT): ',sept);
    writeln('First sector number (first): ',first);
    writeln('Sector size in bytes (size): ',size);
    writeln('1.GAP3 Length R/W (GAP3_RW): ',gap3_RW);
    writeln('2.GAP3 Len FMT   (GAP3_FMT): ',gap3_fmt);
    writeln('Modus                (mode): ',mode);
    writeln('Freeze 0 or <> 0   (freeze): ',freeze);
    while not keypressed do
 end
end;  




procedure change_a;
begin
  einlesen;
  if ein.side<>0
    then begin
      writeln('DS-Formate auf A: nicht moeglich!');
      ok := false
    end
    else patch_a^ := ein
end;

procedure change_b;
begin
  einlesen;
  patch_b^ := ein
end;

procedure B_oder_F;
begin
  name := paramstr(1);
  if (name<>'FREEZE') and (name<>'NOFREEZE')
    then change_B
    else if name='FREEZE'
           then begin
             patch_a^.freeze := $FF;
             patch_b^.freeze := $FF
           end
           else begin
             patch_a^.freeze := 0;
             patch_b^.freeze := 0
           end
end;

procedure A_oder_B;
  begin
  drive:=upcase(paramstr(1));
   name:=paramstr(2);
   if (drive='A') or (drive='B')
     then begin
      case Drive of
        'A' : change_a;
        'B' : change_b
      end
   end
   else begin
     writeln(^G,' Parameterfehler... Laufwerk und Format waren gefragt..');
     ok:=false
   end
end;

  

procedure A_und_B;
  begin
  drive_1:=upcase(paramstr(1));
  drive_2:=upcase(paramstr(3));
   if (drive_1=drive_2) or 
     (not ((drive_1='A') or (drive_1='B'))) or
     (not ((drive_2='A') or (drive_2='B'))) 
    then begin
     writeln(^G,' Parameterfehler... Laufwerk und Format waren gefragt..');
     ok:=false
    end
else begin
     name:=upcase(paramstr(2));
      case Drive_1 of
        'A' : change_a;
        'B' : change_b
      end;
     name:=upcase(paramstr(4));
      case Drive_2 of
        'A' : change_a;
        'B' : change_b
      end
   end
end;

procedure Aktuell_anzeigen;
begin
  intro;
  writeln('Parameter fuer Drive A:');
  ein := patch_a^;
  Ausgeben;
  frage;
  if wahl='J' then abspeichern;
  intro;
  WriteLn('Parameter fuer Drive B:');
  ein := patch_b^;
  Ausgeben;
  Frage;
  if wahl='J' then abspeichern
end;

procedure file_anzeigen;
begin
  intro;
  writeln;
  write('Name des Files: ');
  readln(name);
  einlesen;
  Intro;
  writeln('Parameter von ',name,'.FRM: ');
  ausgeben;
  while not keypressed do
end;

procedure erstellen;
begin
  Intro;
  Eingeben;
  abspeichern
end;

procedure menu;
begin
  repeat
    intro;
    writeln;
    writeln('1: Aktuelle Parameter anzeigen');
    writeln;
    writeln('2: Parameterfile anzeigen');
    writeln;
    writeln('3: Parameterfile erstellen');
    writeln;Writeln;
    writeln('0: Programm verlassen');
    writeln;
    write('Ihre Wahl bitte:');
    repeat
      wahl := scan_key
    until wahl in ['0'..'3'];
    writeln(wahl);
    case wahl of
      '1':  Aktuell_anzeigen;
      '2':  File_anzeigen;
      '3':  erstellen
    end
  until wahl='0'
end;

procedure Modify;
begin
  case paramcount of
    1    : B_oder_F;
    2,
    3    : A_oder_B
    else   A_und_B
  end;
  if not ok
    then writeln('Operation nicht ganz erfolgreich...')
end;

begin (* main *)
  if bdoshl(12)=$31
  then begin
    aktdisk:=bdos(25);
    bdos(14,0);  (* Laufwerk A w{hlen *)
    patch_a := ptr(bdoshl(31)); (* Adresse des XDPB *)
    bdos(14,1);  (* Laufwerk B w{hlen *)
    patch_b := ptr(bdoshl(31));
    bdos(14,aktdisk);  (* wieder aktuelles Laufwerk w{hlen *)
    intro;
    ok := true;
   if paramcount=0
      then menu
   else modify
  end
else writeln('Dieses Programm laeuft nur unter CP/M Plus! ')
end.