Program TrackdiskDemo;

Uses ExecIO;

{$incl 'devices/trackdisk.h' }


Var port  : ^MsgPort;  { Zeiger auf Message-Port }
    ioreq : ^IOExtTD;  { Zeiger auf erweiterte IO-Request-Struktur }


Procedure OpenTrackdisk (Laufwerksnummer : integer);
  Begin
    port := CreatePort ('Disk-Device', 0);
    ioreq := CreateExtIO (port, SizeOf(IOExtTD));
    Open_Device ('trackdisk.device', Laufwerksnummer, ioreq, 0)
  End;


Procedure CloseTrackdisk;
  Begin
    Close_Device (ioreq);
    DeleteExtIO (ioreq);
    DeletePort (port)
  End;


Procedure MotorOn;
  Var err: integer;
  Begin
    With ioreq^.iotd_req Do
      Begin
        io_Command := TD_MOTOR;
        io_Length := 1;
      End;
    err := DoIO (PTR(ioreq));
  End;


Procedure MotorOff;
  Var err: integer;
  Begin
    With ioreq^.iotd_req Do
      Begin
        io_Command := TD_MOTOR;
        io_Length := 0;
      End;
    err := DoIO (PTR(ioreq));
  End;


Function DiskImLaufwerk : Boolean;
  { Stellt fest, ob Disk in dem Laufwerk, für das das Device
    geöffnet wurde. }
  Var err : integer;
  Begin
    { Nur ein Befehl ohne Parameter: }
    ioreq^.iotd_req.io_Command := TD_CHANGESTATE;
    err := DoIO (PTR(ioreq));
    { Rückgabe erfolgt in "io_Actual": }
    DiskImLaufwerk := ioreq^.iotd_req.io_Actual = 0
  End;


Function Schreibschutz : Boolean;
  { true, wenn Disk schreibgeschützt }
  Var err : integer;
  Begin
    { Nur ein Befehl ohne Parameter: }
    ioreq^.iotd_req.io_Command := TD_PROTSTATUS;
    err := DoIO (PTR(ioreq));
    { Rückgabe erfolgt in "io_Actual": }
    Schreibschutz := ioreq^.iotd_req.io_Actual <> 0
  End;


Function Diskwechsel : Long;
  { Gibt Anzahl der bisherigen Diskettenwechsel an. Der Zähler wird
    sowohl beim Einlegen als auch beim Entnehmen einer Disk
    hochgezählt! }
  Var err : integer;
  Begin
    { Nur ein Befehl ohne Parameter: }
    ioreq^.iotd_req.io_Command := TD_CHANGENUM;
    err := DoIO (PTR(ioreq));
    { Rückgabe erfolgt in "io_Actual": }
    Diskwechsel := ioreq^.iotd_req.io_Actual
  End;


Procedure WriteHex (n: Long; digits:integer);
  { Hexzahl n mit gewünschter Ziffernanzahl ausgeben }
  Begin
    If digits > 1 Then WriteHex (n shr 4, digits-1);
    Write ('0123456789abcdef'.[n and 15 + 1])
  End;


Procedure LiesBlock (nr: integer);
  { Einen Block lesen, z. B. 0 für Bootblock, 880 für Root..., und
    als kombinierten Hex- und Asciidump ausgeben. }
  Type
    BufferTyp = Array[1..512] Of Byte;  { 1 Block = 512 Bytes }
  Var
    Buffer : ^Buffertyp;
    i, j   : integer;
    err    : integer;
  Begin
    Buffer := Ptr(Alloc_Mem(SizeOf(BufferTyp),2));  { Chip-RAM }
    With ioreq^.iotd_req Do
      Begin
        io_Command := CMD_READ;
        io_Data    := Buffer;
        io_Length  := 512;
        io_Offset  := 512 * nr  { Blockposition in Bytes }
      End;
    err := DoIO(PTR(ioreq));

    { Ergebnis ausgeben: }
    If err <> 0 Then
      Writeln ('Fehler: ', err)
    Else
      Begin
        Writeln ('Inhalt von Block ', nr, ':');
        Writeln;
        For i:=0 to 31 Do     { 32 Zeilen zu 16 Bytes }
          Begin
            WriteHex (16*i,4); Write(': ');
            For j:=1 to 16 Do
              Begin WriteHex (Buffer^[16*i+j], 2); Write (' ') End;
            Write ('  ');
            For j:=1 to 16 Do
              If Buffer^[16*i+j] in [32..127, 160..255] Then
                Write (Chr(Buffer^[16*i+j]))  { druckbare Zeichen ausgeben }
              Else
                Write ('.');                  { sonst Punkt }
            Writeln
          End;
      End;
    Free_Mem (Long(Buffer), SizeOf(BufferTyp))
  End;


Var drive, block : integer;

Begin
  Write ('Laufwerksnummer: '); Readln(drive);
  OpenTrackDisk (drive);
  If DiskImLaufwerk Then
    Begin
      Write ('Blocknummer:     '); Readln(block);
      Writeln;
      LiesBlock (block)
    End
  Else
    Writeln ('Bedaure, da ist keine Disk ''drin!');
  CloseTrackdisk
End.