{@@@@@@@@@@@ copyright (C) 1984 by Neil J. Rubenking @@@@@@@@@@@@@@@@@@@@@@@@
The purchaser of these procedures and functions may include them in COMPILED
programs freely, but may not sell or give away the source text.

    This is a fancy demonstration of the procedure GetSector, contained
    in the $INCLUDE file GETSECTR.LIB.  It is modeled on a BASIC program
    called DISKMODF, by John VanderGrift.
        GetSector simply reads the specified sector from the disk into
    your buffer.  In this program, the buffer is just an array of bytes,
    but you could declare the buffer to be an array of records of the
    same "shape" as a directory entry--that would be one way to get
    directory info from the disk.

    You may want to select SIDE 0, TRACK 0, SECTOR 6 --this is where the
    directory begins.  Use the arrow keys to move around in the sector,
    PgUp and PgDn to change sectors.  If you type alphanumeric keys, or
    the special characters produced by <Alt><number>, the sector buffer
    will be changed.  Then if you press F1, the changes will be written
    to disk.

         NOTE that chr(3) and chr(27) cannot be treated like the other
    characters.  Chr(3) is <Ctrl><Break>, and it will halt the program
    if you try to enter Alt-3.  F9 has been set up to safely input chr(3).
    Since <Esc> is the signal to QUIT, chr(27) is also unavailable as
    itself -- F10 has been set up for it.

         This is not a refined program--you may want to experiment on a
    copy.  Try renaming a file by changing its name in the directory
    sector.

}

program DiskModify;
type
  HexByte = string[2];
var
  Buffer             : array[0..511] of byte;
  HX                 :  array[0..255] of HexByte;
  AS                 :  array[0..255] of char;
  drive, YorN, sides : char;
  sector, track, side,
  maxSides, MaxSectors  : byte;
  TByte                 : integer;
  didRead               : boolean;

{$I regpack.typ}
{$I disktyp.lib}
{$I getsectr.lib}
{$I monitor.lib}
{$I screen.lib}
{$I getkeys.lib}

{OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO}
procedure ByteAtt(WhichByte : integer; attribute:byte);
var
  col, row : byte;
begin
  row := (WhichByte div 24) + 2;               { This procedure lights }
  col := (WhichByte mod 24);                   { up the locations on   }
  ScreenAttribute(col*2+1, row, attribute);    { the screen that go    }
  ScreenAttribute(col*2+2, row, attribute);    { with the byte being   }
  ScreenAttribute(col + 51, row, attribute);   { pointed at in the     }
end;                                           { buffer.               }
{OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO}
procedure initialize;
var
  N, temp : byte;
begin
  CheckColor;
  for N := 0 to 255 do
    begin
      case N of
        7..13 : AS[N] := chr(N + 64);      { The array AS consists of    }
           28 : AS[N] := '\';              { a PRINTABLE character for   }
           29 : AS[N] := ']';              { each byte 0 to 255.  Some   }
           30 : AS[N] := chr(24);          { of the characters are not   }
           31 : AS[N] := chr(25);          { normally printable, because }
      else      AS[N] := chr(N);           { they change the display     }
      end;  {case}
      HX[N] := '00';
      temp := N mod 16;
      if temp <= 9 then HX[N][2] := chr(temp + 48)    { I use an array here }
                   else HX[N][2] := chr(temp + 55);   { rather than making  }
      temp := N div 16;                               { a function in order }
      if temp <= 9 then HX[N][1] := chr(temp + 48)    { to save calculation }
                   else HX[N][1] := chr(temp + 55);   { time.               }
    end;   {for N}
  DidRead := false;
end;
{OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO}
procedure choices;
   {ooooooooooooooooooooooooooooooooooooooooooooooooooooooooo}
   procedure selections;
   var
     okay : boolean;
     begin
       repeat
         Write('Select drive: '); read(drive)
         until UpCase(drive) in ['A'..'D'];
         GotoXY(1,4);
         case DiskType(drive) of
           160: begin
                  maxSides := 1;
                  MaxSectors  := 8;
                  Write('Single');
                end;
           180: begin
                  maxSides := 1;
                  MaxSectors  := 9;
                  Write('Single');
                end;
           320: begin
                  MaxSides := 2;
                  MaxSectors  := 8;
                  write('Double');
                end;
           360: begin
                  maxSides := 2;
                  MaxSectors  := 9;
                  write('Double');
                end;
           else
             WriteLn('Wierd disk.  Can''t deal with it!');
             halt;
           end;
       Write('-sided, ',MaxSectors,' sectors.');
       GotoXY(1,6);
       WriteLn('Select track (0-39)');
       WriteLn('Select sector (1-',MaxSectors:1,')');
       if maxSides = 2 then
       WriteLn('Select side   (0-1)');
       repeat
         GotoXY(22,6); read(track);
         until track in [0..39];
       repeat
         GotoXY(22,7);  read(sector);
         until sector in [1..MaxSectors];
       if maxSides = 2 then
         repeat
           GotoXY(22,8);  read(side);
           until side in [0..1]
         else side := 0;
      end;
   {ooooooooooooooooooooooooooooooooooooooooooooooooooooooooo}
begin
  repeat
    ClrScr;
    Selections;
    gotoXY(22,10);
    Write('Selections OK? ');read(YorN);
  until UpCase(YorN) = 'Y';
end;
{OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO}
procedure BigShow;
var
  N : integer;
  col, row : byte;
begin
  if DidRead then
    begin
      ClrScr;
      Write('Drive: ',drive,'  Side: ',side,'  Track: ',track);
      WriteLn('        Sector: ',Sector,'   Byte: ',TByte);
      for N := 0 to 511 do
        begin
          row := (N div 24) + 2;
          col := (N mod 24);
          GotoXY(2*col+1,row);
          write(HX[buffer[N]]);
          GotoXY(col + 51,row);
          Write(AS[buffer[N]]);
        end;
      GotoXY(17,23); write('                                ');
      GotoXY(59,23); write('                ');
      TextColor(blue);  {blue = underline in monochrome}
      GotoXY(1,24); write('  F1 to modify disk. <Esc> to quit.');
      TextColor(white);
    end;
end;
{OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO}
procedure ShowChar;
var
  TheChar : byte;
begin
  GotoXY(54,1);
  ClrEOL;
  write(TByte);
  TheChar := buffer[TByte];
  GotoXY(45,24);
  ClrEOL;
  TextColor(black);TextBackGround(white);
  write(HX[TheChar],' ',chr(TheChar),' ');
  TextColor(white);TextBackGround(black);
end;
{OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO}
procedure TakeInstructions;
var
  doit, choice, EscChoice : char;
  {oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo}
   procedure increment(var Trak, Sek, Sid: byte);
   begin
     if maxSides = 1 then
       begin                              { The procedures "increment" }
         Sek := Sek + 1;                  { and "decrement" just take  }
         if Sek > MaxSectors then         { the IBM disk format ORDER  }
           begin                          { and codify it.  It turns   }
             Sek := 1;                    { out to be rather compli-   }
             Trak := Trak + 1;            { cated!                     }
             if Trak > 39 then Trak := 0;
           end;
       end
     else
       begin
         Sek := Sek + 1;
         if Sek > MaxSectors then
           begin
             Sek := 1;
             if Sid = 0 then Sid := 1
               else
                 begin
                   Sid := 0;
                   Trak := Trak + 1;
                   if Trak > 39 then Trak := 0;
                 end;
           end;
       end;
  end;
  {oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo}
   procedure decrement(var Trak, Sek, Sid: byte);
   begin
     if maxSides = 1 then
       begin
         Sek := Sek - 1;
         if Sek < 1 then
           begin
             Sek := MaxSectors;
             Trak := Trak - 1;
             if Trak < 0 then Trak := 39;
           end;
       end
     else
       begin
         Sek := Sek - 1;
         if Sek < 1 then
           begin
             Sek := MaxSectors;
             if Sid = 1 then Sid := 0
               else
                 begin
                   Sid := 1;
                   Trak := Trak - 1;
                   if Trak < 0 then Trak := 39;
                 end;
           end;
       end;
  end;
  {oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo}
    procedure Advance;
      begin
        if TByte < 511 then
          begin
            ByteAtt(TByte,15);
            TByte := TByte + 1;
            ByteAtt(Tbyte,112);
            ShowChar;
          end;
      end;
  {oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo}
    procedure NewChar(ch : char);
      begin
        WriteScreen(48,24,ch,112);
        Buffer[TByte] := ord(ch);
        WriteScreen((TByte mod 24) + 51, (TByte div 24)+2,ch,112);
        TextColor(black);TextBackGround(white);
        GotoXY(2*(TByte mod 24)+1,(TByte div 24) + 2);
        write(HX[ord(ch)]);
        TextColor(white);TextBackGround(black);
      end;
  {oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo}
begin                                { Wait 'til a key is pressed.  If it's  }
  repeat                             { a "special" key, check what action to }
    GetKeys(choice,EscChoice);       { take.  If it's "ordinary", insert its }
    if choice = chr(27) then         { value in the buffer at the current    }
      case EscChoice of              { place and display it.                 }
        'I': {PgUp} begin
                decrement(track,sector,side);
                GetSector('R',drive,side,sector,track,didRead);
                TByte := 0;
                Bigshow;
                ShowChar;
                byteAtt(TByte,112);
             end;
        'Q': {PgDn}  begin
                increment(track,sector,side);
                GetSector('R',drive,side,sector,track,didRead);
                TByte := 0;
                Bigshow;
                ShowChar;
                byteAtt(TByte,112);
             end;
        'O': { end};
        'H': if (TByte div 24) > 0 then
               begin
                 ByteAtt(TByte,15);
                 TByte := TByte - 24;
                 ByteAtt(Tbyte,112);
                 ShowChar;
               end;
        'P': if TByte < 488 then
               begin
                 ByteAtt(TByte,15);
                 TByte := TByte + 24;
                 ByteAtt(Tbyte,112);
                 ShowChar;
               end;
        'K': if TByte > 0 then
               begin
                 ByteAtt(TByte,15);
                 TByte := TByte - 1;
                 ByteAtt(Tbyte,112);
                 ShowChar;
               end;
        'M': Advance;
        ';': begin
               GotoXY(1,24); ClrEOL;
               WRite('Are you sure you want to change the disk? ');
               read(doit);
               if UpCase(doit) = 'Y' then
                  GetSector('W',drive,side,sector,track,didRead);
               GotoXY(1,24); ClrEOL;
               TextColor(blue);
               Write('  F1 to modify disk. <Esc> to quit.');
               TextColor(black);
             end;
        'C': begin             { Use F9 to enter a chr(3).  Chr(3) }
               newChar(#3);    { is equivalent to <Ctrl><Break>,   }
               Advance;        { so you can't enter it normally.   }
             end;
        'D': begin             { Use F10 to enter a chr(27) (<Esc>). }
               newChar(#27);   { Can't enter it directly OR thru the }
               Advance;        { Alt-# combination -- it's the QUIT  }
             end;              { signal, and it works.               }
      end { case}
    else
      begin
        newChar(choice);

        Advance;
      end;
  until (choice = chr(27)) and (EscChoice = #0);
end;
{OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO}
begin
  initialize;
  choices;
  GetSector('R',drive,side,sector,track,didRead);
  TByte := 0;
  BigShow;
  ShowChar;
  ByteAtt(Tbyte,112);
  TakeInstructions;
  ClrScr;
end.