program Disk3;  { DIREKTER DISKETTENZUGRIFF UNTER CP/M 3.0 }
                { (c) 1984 by Gerhard Strube, Muenchen     }
const MaxSize = 1024;   { maximale physische Sektorgroesse }
      Version = $0031;  { Versionsnummer von CP/M 3.0 }

type  DPB = record                       { CP/M 3.0 Disk Parameter Block: }
                SPT:           integer;  { Anzahl log. Sektoren je Spur }
                BSH, BLM, EXM: byte;     { Block Shift & Mask / Extent Mask }
                DSM, DRM:      integer;  { Kapazitaet v. Diskette & Directory }
                AL0, AL1:     byte;      { Directory reservierte Bloecke }
                CKS, OFF:     integer;   { Pruefvektor / Anz. reserv. Spuren }
                PSH, PHM:     byte       { Physical Record Shift & Mask }
            end;
      RWtype = (ReadSector, WriteSector);  { Art des Diskettenzugriffs }
var  Drive, Track,
     Sector, Lsector, Psector,
     Part, Psize,
     MaxSector,  MaxTrack,
     Cmd, DefaultDrive,
     i, j, k:                   integer;
     ptr:                       ^DPB absolute i;
     DPH:                       ^integer absolute   i;
     PhySecBuf:                 array [1..MaxSize] of byte;
     LogSecBuf:                 array [1..128] of byte;
{$I UBIOS.PAS }  { externe Funktion UBIOS f. BIOS-Aufrufe }
{$I HEXIO.PAS }  { ext. Funkt. HEXVAL, ext. Prozedur WRITEHEX }

procedure Error (no: integer); { Abbruch u. Ausgabe einer Fehlermeldung }
begin
    GotoXY (10, 18);
    case no of
         0: write ('PROGRAMM LAEUFT NUR UNTER CP/M 3.0 (CP/M PLUS).');
         1: write ('FEHLER: UNGUELTIGE LAUFWEHKSNUMMER.');
         2: write ('FEHLER BEIM SUCHEN / LESEN / SCHREIBEN.')
    end;
    Bdos (14, DefaultDrive);
    Halt
end;

procedure UserFrame (Mode: RWtype); {Bildschirm-Maske u.  Dateneingabe }
begin
    ClrScr;
    GotoXY ( 6, 1); write ('DIREKTER DISKETTEN-ZUGRIFF UNTER CP/M PLUS');
    GotoXY (50,24); write ('(c) 1984 by Gerhard Strube');
    GotoXY ( 1, 3); write ('Modus:');
    GotoXY ( 1, 4); LowVideo;
    case Mode of
       ReadSector: write ('LESEN ');
      WriteSector: write ('SCHREIBEN ')
    end;
   HighVideo;
   repeat
       GotoXY (13, 3);
       write ('LAUFWERKSNUMMER (0=A, 1=B): ', Drive:1, chr(8));
       readln (Drive)
   until (Drive in [0..15]);
   i := UBIOS (9, 0, Drive, 0, 0);   { Laufwerk selektieren }
   if (i = 0) then Error (1);
   Bdos (14, Drive);
   i := BdosHL (31);   { Adresse des DPB; i und ptr haben dieselbe Adresse! }
   with ptr^ do begin
        Psize := 128 shl PSH;
        GotoXY (50, 2); write (Psize:5, ' phys.Sektorgroesse');
        if (Psize = 128) then begin
           write (' *)'); GotoXY (1,24);
           write ('*) wie es dem Betriebssystem erscheint.')
        end;
        Psize := 1 shl PSH;
        MaxSector := SPT;
        GotoXY (50, 3); write (SPT:5, ' log.Sektoren/Spur');
        GotoXY (50, 5); write (OFF:5, ' reserv. Spur(en)');
        k := (DSM + 1) * ((BLM + 1) div 8);
        GotoXY (50, 6); write (k:5, ' kB Kapazitaet');
        MaxTrack := round ((k / SPT) * 8 + OFF);
        GotoXY (50, 4); write (MaxTrack:5, ' Spuren insgesamt');
        repeat
           GotoXY (13, 4);
           write ('SPURNUMMER      (0 ..', (MaxTrack -1):4, '): ');
           write (Track, chr(8));
           if (Track > 9)  then write (chr(8));
           if (Track > 99) then write (chr(8));
           readln (Track)
        until (Track >= 0) and (Track < MaxTrack);
        Sector := Lsector;
        repeat
           GotoXY (13, 5);
           write ('SEKTORNUMMER    (0 ..', (SPT - 1):4, '): ');
           write (Sector, chr(8));
           if (Sector > 9)  then write (chr(8));
           if (Sector > 99) then write (chr(8));
           readln (Sector)
        until (Sector >= 0) and (Sector < SPT);
        Lsector := Sector
   end;
   Part := Sector mod Psize;     { make logical to phyaical }
   Sector := Sector div Psize;   { sector size translation  }
end;

procedure DoDisk (Mode: RWtype); { Diskettenoperation ausfuehren }
begin
    UserFrame (Mode);
    i := UBIOS (9, 0, Drive, 1, 0); { Diskette  selektieren }
    { i = Adresse der Uebersetzungstabelle log.> phys. Sektoren }
    Psector := UBIOS (16, 0, Sector, DPH^, 0); { phys. Sektor berechnen }
    GotoXY (23, 6); write ('phys. Sektor Nr.: ', Psector);
    if (Psize > 1) then begin GotoXY (13, 6); write ('Teil: ', Part:1) end;
    i := UBIOS (23, 0, 1, 0, 0);               { nur 1 Sektor bearbeiten }
    i := UBIOS (10, 0, Track, 0, 0);           { Spur vorwaehlen }
    i := UBIOS (11, 0, Psector, 0, 0);         { Sektor vorwaehlen }
    i := UBIOS (12, 0, Addr(PhySecBuf), 0, 0); { DMA-Adresse  vorwaehlen }
    i := UBIOS (28, 1, 0, 0, 0);               { Speicherbank vorwaehlen }
    case Mode of
     ReadSector:  begin
                   i := UBIOS (13, 0, 0, 0, 0); { phys. Sektor lesen }
                   if (i <> 0) then Error (2);
                   for i := 1 to 128 do         { log.  Sektor auswaehlen }
                       LogSecBuf [i] := PhySecBuf [i + Part * 128]
                  end;
     WriteSector: begin
                   i := UBIOS (13, 0, 0, 0, 0); { phys. Sektor lesen }
                   if (i <> 0) then Error (2);
                   for i := 1 to 128 do         { log. Sektor "einarbeiten" }
                       PhySecBuf [i + Part * 128] := LogSecBuf [i];
                   i:= UBIOS (14, 0, 0, 0, 0);  { phys.  Sektor schreiben }
                   if (i <> 0) then Error (2)
                  end;
    end
end;

procedure DisplaySector; { Inhalt d. log. Sektors auf Bildschirm anzeigen }
begin
    for i := 20 to 23 do begin GotoXY (1, i); ClrEol end;
    GotoXY (1, 8);
    LowVideo; write ('   ');
    for i := 0 to 15 do begin write (' '); WriteHex (i) end;
    HighVideo; writeln;
    for i := 1 to 8 do begin
        LowVideo; WriteHex ((i-1) * 16); write (':'); HighVideo;
        for j := 1 to 16 do begin
            k := LogSecBuf [16 * (i - 1) + j];
            write (' '); WriteHex (k)          { (1) als Hexadezimalzahlen }
        end;
        write ('   ');
        for j := 1 to 16 do begin
            k := LogSecBuf [16 * (i - 1) + j];
            if (k > 128) then LowVideo;
            k := k mod 128;
            if (k < 32) then write ('.')       { (2) als ASCII-Zeichen;  }
                        else write (chr(k));   { Control-Char. als Punkt }
            HighVideo
        end;
        writeln
    end;
end;

procedure ChangeSector; { Aenderungen am Inhalt d. log. Sektors vornehmen }
var st:     string[80];
    s:      string[2];
    NewHex: boolean;
begin { ChangeSector }
    repeat
        GotoXY (1,20); ClrEol;
        write ('INHALT VERAENDERN AB ADRESSE (in Hex): 0', chr(8)); readln (st);
        i := 0; if (length (st) in [1..2]) then i := HexVal (st)
    until (i in [$00..$7F]);
   i := i + 1; { umrechnen auf Indizierung $01..$00 }
   GotoXY (1,21);
   writeln ('NEUEN INHALT EINGEBEN (1) in Hex (mit Leerzeichen trennen), ');
   writeln ('                 oder (2) "''" mit nachfolgendem ASCII-String:');
   readln (st);
   if (st[1] = '''') then begin
      for j := 2 to length (st) do
          if (i in [$01..$80]) then begin
             LogSecBuf [i] := ord (st [j]);
             i := i + 1
          end
   end
   else begin
        j := 1; NewHex := false;
        while (j <= length (st) + 1) do begin
              if (j = length (st) + 1) or (st [j] = ' ') then begin
                 if NewHex then begin
                    NewHex := false; 
                    if (i in [$01..$80]) then
                       if (HexVal (s) < 256) then begin
                          LogSecBuf [i] := HexVal (s);
                          i := i + 1
                       end
                       else j := length (st) { terminate }
                    end;
                    s := ' ' end
                 else begin
                      NewHex := true;
                      case ord (s[0]) of
                           0: s := st[j];
                           1: s := s + st[j];
                           2: s := s[2] + st[j]
                      end
                 end;
                 j := j + 1;
        end
    end
end;

begin { HAUPTPROGRAMM }
    i := BdosHL (12); { Funktion 12: Versionsnummer des Betriebssystems }
    if (i <> Version) then Error (0);
    DefaultDrive := Bdos (25);  { Funktion 25: aktuelle Laufwerksnummer }
    Track := 0; Lsector := 0; Drive := DefaultDrive;
    DoDisk (ReadSector);
    repeat
        DisplaySector;
        Cmd := -1; { damit spaeter ueberfluessige Returns ignoriert werden }
        repeat
            GotoXY (1,18); ClrEol;
            write  ('Gib Kommando:  0=ENDE,  1=LESEN, 2=AENDERN, 3=SCHREIBEN: ');
            readln (Cmd)
        until (Cmd in [0..3]);
        case  Cmd of
              1: begin { Voreinstellung: jeweils naechsten Sektor lesen }
                     Lsector := Lsector +  1;
                     if (Lsector = MaxSector) then begin
                        Lsector := 0; Track := Track + 1;
                        if (Track = MaxTrack) then Track := 0
                     end;
                     DoDisk (ReadSector)
                 end;
              2: ChangeSector;
              3: DoDisk (WriteSector)
        end
     until (Cmd = 0);
     CrtExit;
     Bdos (14,  DefaultDrive)
     { d.h. Zustand  vor Aufruf des Programms wiederherstellen }
end.