CP/M/CPM_CDROM.iso/lambda/soundpot/p/probe12.lbr/PROBE2.PZS/PROBE2.PAS

Pascal/Delphi Source File | 1993-10-25 | 9.6 KB | 348 lines

{ Include file PROBE2.PAS          (c) Copyright September 1985 by Rick Ryall }

PROCEDURE DisplaySector( Track, Sector: integer );
begin
  gotoXY(1,5);
  BlockNumber:= Block( Track, Sector );
  write( CursorOff,'Track: ', Track,'   Logical Sector: ' );
  write( Sector, '   Logical Block: ' );
  if BlockNumber >= 0 then
  begin
    write( BlockNumber,'   [', hex( hi( BlockNumber )));
    write( hex( lo( BlockNumber )),' hex]' );
  end else write( 'not defined.' );
  writeln( LineErase );
  writeln;
  for Row:= 0 to 7 do
  begin
    for i:= 0 to 15 do
    begin
      write( Hex( Sectr.Buffer[i+Row shl 4] ), Space );
      if i mod 8 = 7 then write( Space );
    end;
    for i:= 0 to 15 do write( ASCII( Sectr.Buffer[i+Row shl 4] ));
    writeln;
  end;
  writeln( CursorOn );
  if BlockNumber >= 0 then
  begin
    write('Logical block ', BlockNumber,' is ' );
    if Allocated( BlockNumber ) then write('reserved.') else write('free.    ');
  end;
  ClrEol;
  if ReadError then Accent('    (READ ERROR: data displayed is invalid.)' );
end;  { DisplaySector }

PROCEDURE ComputeSector( var Track, Sector: integer; Direction: boolean );
begin
  with DPB^ do
  begin
    if MoveBySectors then
    begin
      if Direction = Forwards then Sector:= succ( Sector )
        else Sector:= pred( Sector );
    end else  { move by blocks }
    begin
      if Direction = Forwards then BlockNumber:= succ( BlockNumber )
        else BlockNumber:= pred( BlockNumber );
      if BlockNumber < 0 then BlockNumber:= MaxBlock
        else if BlockNumber > MaxBlock then BlockNumber:= 0;
      BlockToSector( BlockNumber, Track, Sector );
    end;
    if  ( Sector >= SectorsPerTrack ) or ( Block( Track, Sector ) > MaxBlock ) then
    begin
      Sector:= 0;
      Track:= succ( Track );
      if  Track >= MaxTracks then Track:= 0;
    end else
    if  Sector < 0 then
    begin
      Sector:= pred( SectorsPerTrack );
      Track:= pred( Track );
      if  Track < 0 then
      begin
        Track:= pred( MaxTracks );
        while Block( Track, Sector ) <> MaxBlock do Sector:= pred( Sector );
      end;
    end;
  end;
end;  { ComputeSector }

PROCEDURE FlushSector( Track, Sector: integer );
begin
  WriteSector( Track, Sector );
  if WriteError then
  begin
    EraseLine(20);
    write('Write error at track ', Track, ', sector ', Sector,'.' );
    Pause( NoEscape );
  end;
  for i:= 1 to 16 do
  begin
    ComputeSector( Track, Sector, Forwards );
    ReadSector( Track, Sector );
  end;
  for i:= 1 to 16 do
  begin
    ComputeSector( Track, Sector, Reverse );
    ReadSector( Track, Sector );
  end;
end;  { FlushSector }

PROCEDURE SelectSector;
label Exit;
begin
  with DPB^ do
  begin
    ClrScr;
    if MoveBySectors then
    begin
      ReadInteger( Track, 0, pred( MaxTracks ), 'What is the track number' );
      if Interrupted then goto Exit;
      GetSector( Track, Sector );
      if Interrupted then goto Exit;
    end else { move by blocks }
    begin
      ReadInteger( BlockNumber, 0, MaxBlock, 'Which block' );
      if Interrupted then goto Exit;
      BlockToSector( BlockNumber, Track, Sector );
    end;
  end;
  ReadSector( Track, Sector );
  Exit:
end;  { SelectSector }

PROCEDURE ChangeSector;
const
  FirstHexColumn    = 0;
  MidHexColumn      = 25;
  LastHexColumn     = 47;
  FirstASCIIcolumn  = 50;
  LastASCIIcolumn   = 65;
  FirstRow          = 0;
  LastRow           = 7;
var
  Key: char;

  PROCEDURE MoveRight;
  begin
    if Column < pred( FirstASCIIcolumn ) then
    begin
      write( CursorRight );
      Column:= succ( Column );
      ScreenPosition:= succ( ScreenPosition );
      if ScreenPosition = 2 then
      begin
        write( CursorRight );
        ScreenPosition:= 0;
        Column:= succ( Column );
      end;
      if Column in [ pred( MidHexColumn ), pred( FirstASCIIcolumn ) ] then
      begin
        write( CursorRight );
        Column:= succ( Column );
      end;
    end else { column > FirstASCIIcolumn - 2 } if Column < LastASCIIcolumn then
    begin
      write( CursorRight );
      Column:= succ( Column );
    end else  { column = LastASCIIcolumn }
    begin
      Tab( FirstHexColumn );
      Column:= FirstHexColumn;
      ScreenPosition:= 0;
    end;
  end;  { MoveRight }

  PROCEDURE MoveLeft;
  begin
    if Column > FirstASCIIcolumn then
    begin
      write( BackSpace );
      Column:= pred( Column );
    end else  { column <= FirstASCIIcolumn }  if Column > FirstHexColumn then
    begin
      write( BackSpace );
      Column:= pred( Column );
      ScreenPosition:= pred( ScreenPosition );
      if ScreenPosition < 0 then
      begin
        write( BackSpace );
        ScreenPosition:= 1;
        Column:= pred( Column );
      end;
      if Column in [ MidHexColumn - 2, FirstASCIIcolumn - 2 ] then
      begin
        write( BackSpace );
        Column:= pred( Column );
      end;
    end else  { column = FirstHexColumn }
    begin
      Tab( LastASCIIcolumn );
      ScreenPosition:= 0;
      Column:= LastASCIIcolumn;
    end;
  end;  { MoveLeft }

  PROCEDURE MoveDown;
  begin
    if Row < LastRow then
    begin
      write( CursorDown );
      Row:= succ( Row );
    end else  { row = LastRow }
    begin
      write( TabUp );
      Row:= FirstRow;
    end;
  end;  { MoveDown }

  PROCEDURE MoveUp;
  begin
    if Row > FirstRow then
    begin
      write( CursorUp );
      Row:= pred( Row );
    end else  {  row = FirstRow }
    begin
      write( TabDown );
      Row:= LastRow;
    end;
  end;  { MoveUp }

  PROCEDURE ChangeASCIIValue( Key : char );
  var
    ByteNumber, NewColumn: byte;
  begin
    write( CursorOff, Key );
    ByteNumber:= ( Row*16 ) + ( Column - FirstASCIIcolumn );
    NewColumn:= ( Column - FirstASCIIcolumn ) * 3;
    if NewColumn >= MidHexColumn - 2 then NewColumn:= succ( NewColumn );
    Tab( NewColumn );
    write( Hex( ord( Key )));
    Tab( Column );
    MoveRight;
    write( CursorOn );
    Sectr.Buffer[ ByteNumber]:= ord( Key );
    SectorChanged:= true;
  end;  { ChangeASCIIValue }

  PROCEDURE ChangeHexValue( Key : char );
  label Exit;
  var
    HexString: string[2];
    ErrorCode, Value: integer;
    Offset, ByteNumber, NewColumn: byte;
  begin
    Key:= Upcase( Key );
    if not( Key in ['0'..'9','A'..'F'] ) then goto Exit;
    write( CursorOff, Key );
    if Column > pred( MidHexColumn ) then Offset:= 1 else Offset:= 0;
    ByteNumber:= ( Row*16 ) + ( Column - Offset ) div 3;
    HexString:= Hex( Sectr.Buffer[ ByteNumber] );
    HexString[ succ( ScreenPosition )]:= Key;
    val( '$' + HexString, Value, ErrorCode );
    Sectr.Buffer[ ByteNumber]:= Value;
    NewColumn:= ( Column - Offset ) div 3 + FirstASCIIcolumn;
    Tab( NewColumn );
    write( ASCII( Sectr.Buffer[ ByteNumber] ));
    Tab( Column );
    MoveRight;
    write( CursorOn );
    SectorChanged:= true;
    Exit:
  end;  { ChangeHexValue }

begin  { ChangeSector }
  Row:= FirstRow;
  Column:= FirstHexColumn;
  ScreenPosition:= 0;
  EraseLine(20);
  write( 'Use arrow keys to move cursor over the byte you wish to change, ESC to exit.');
  gotoXY(1,7);
  repeat
    read( Kbd, Key );
    case Key of
      Space..'~'  :
        if Column > pred( FirstASCIIcolumn ) then ChangeASCIIValue( Key )
          else ChangeHexValue( Key );
      CursorRight :  MoveRight;
      Backspace   :  MoveLeft;
      CursorDown  :  MoveDown;
      CursorUp    :  MoveUp;
      ScreenPrint :  PrintScreen;
    end;  { of case statement }
  until Key = ESC;
  if SectorChanged then
  begin
    EraseLine(20);
    write('Do you wish to write these changes to disk (Y or N)?  ' );
    if Response = 'Y' then FlushSector( Track, Sector ) else ReadSector( Track, Sector );
    DisplaySector( Track, Sector );
  end;
  SectorChanged:= false;
end;  { ChangeSector }

PROCEDURE ViewSector;
label Exit;
var
  Key : char;
  Displays : integer;
begin
  Range:= 1;
  Key:= Space;
  SelectSector;
  if Interrupted then goto Exit;
  ClrScr;
  DisplaySector( Track, Sector );
  while Key <> ESC do
  begin
    Interrupted:= false;
    gotoXY(1,20);
    Accent('(F)orward, (B)ackward, (R)ange, (J)ump, (C)hange, (M)ovement, (ESC)ape?  ');
    ClrEol;
    repeat
      read( Kbd, Key );
      if Key = ScreenPrint then PrintScreen;
    until UpCase( Key ) in ['B','C','F','J','M','R',ESC];
    Key:= UpCase( Key );
    case Key of
      'B': Direction:= Reverse;
      'C': ChangeSector;
      'F': Direction:= Forwards;
      'J': begin
             SelectSector;
             if Interrupted then goto Exit;
             EraseLine(1);
             EraseLine(2);
             DisplaySector( Track, Sector );
           end;
      'M': begin
             EraseLine(1);
             MoveBySectors:= not( MoveBySectors );
             write( 'Viewing movement is now in ' );
             if MoveBySectors then write( 'sector' ) else write( 'block' );
             write(' increments.' );
           end;
      'R': begin
             EraseLine(20);
             ReadInteger( Range, 1, 600, 'How many sectors or blocks displayed each time' );
             EraseLine(20);
           end;
    end;
    Displays:= 0;
    if Key in ['F','B'] then while ( Displays < Range ) and not Interrupted do
    begin
      Displays:= succ( Displays );
      ComputeSector( Track, Sector, Direction );
      ReadSector( Track, Sector );
      DisplaySector( Track, Sector );
      if KeyPressed and ( Range > 4 ) then AbortCommand;
    end;
  end;
  Exit:
  MoveBySectors:= true;
end;  { ViewSector }