{$INCLUDE: 'IOSTUFF.INC'}
PROGRAM READ_DISK(INPUT,OUTPUT);
USES IOSTUFF;

const	hexes = '0123456789ABCDEF';

type	Base = (Hex,Decimal);
	Numstr = Lstring(5);
	Disksize = (Single,Double);

var	Title,Strg,Prompt : LString(80);
	Footer : array [1..2] of Lstring(80);
	Offset,i,j,k,x,y : integer;
	Buffer : SecBuf;
	Trk : Track;
	Sect: Sector;
	Side: Head;
	Drv,Default : Drive;
	Mode : Modes;
	BufPtr : BuffAddr;
	DspPtr : BuffAddr;
	a,b,temp : word;
	Screen : Adsmem;
	Display : Array [0..3999] of Byte;
	Keypress,Scancode,Shiftstatus : Byte;
	Radix : Base;
	Bite : 0..511;
	Size : Disksize;
	FAT : array [0..511] of byte;
	DskSz : string(12);

PROCEDURE Draw_Header;

var	error : boolean;
	temp : Lstring(5);
	a : integer;

BEGIN
	Title[9] := chr(ord(Drv)+65);
	error := encode(temp,Side:1);
	movel(adr temp[1],adr Title[22],1);
     if Radix = Decimal then
	a := 10 else a := 16;
	 error := encode(temp,ord(Trk):2:a);
	 movel(adr temp[1],adr Title[36],2);
	 error := encode(temp,ord(Sect):1);
	 movel(adr temp[1],adr Title[51],1);
	 error := encode(temp,ord(Bite):3:a);
	 movel(adr temp[1],adr Title[65],3);
	 if size = single then
	   begin
	   dsksz := 'Single Sided';
	   movel(adr dsksz,adr Title[65],12)
	   end;
	 else
	   begin
	   dsksz := 'Double Sided';
	   movel(adr dsksz,adr Title[65],12);
	   end
END;

PROCEDURE Make_Template;

var i : integer;

BEGIN
	fillc(adr Display[0],4000,'');    {Fill display buffer with blanks}
	fillc(adr Display[0],160,'x');     {Make first line reverse video  }
	fillc(adr Display[3680],160,'x');  {Make next to bottom line reverse.}
	fillc(adr Display[3966],34,'');   {Lower-right is high-intensity.}
					   {for error prompts.}
	for i := 0 to 1999 do
	DspPtr^[2*i] := ord(' ');

	for i := 0 to 79 do
	begin
	  DspPtr^[2*i] := ord(Title[i+1]);	  {Move titles and footers into}
	  DspPtr^[2*i+3680] := ord(chr(32));
	  DspPtr^[2*i+3840] := ord(Footer[2,i+1]);
	end;
END;

PROCEDURE Display_Sector;

var i,j,k,x,y : integer;
    temp,a,b  : word;

BEGIN
Draw_Header;
Make_Template;
for i := 0 to 511 do
  begin
  j := i mod 24;
  y := (I DIV 24);
  x := 56+j;
  k := 2*(y*80+x)+Offset;		   {Put characters into right side}
  DspPtr^[k] := BufPtr^[i];		    {of the display buffer.	   }
  temp := wrd(BufPtr^[i]);
  a := (lobyte(temp) AND 2#11110000) DIV 16;		{Fill the display }
  b := lobyte(temp) AND 2#00001111;			{buffer with the  }
  k := 4*(y*40+j)+2*(j DIV 4)+Offset;			{hex values of the}
  DspPtr^[k] := ord(hexes[a+1]);			{characters in the}
  DspPtr^[k+2] := ord(hexes[b+1]);			{sector buffer.   }
  end;
i := 268;
repeat
  DspPtr^[i] := ord('º');
  i := i+160;
until i > 3630;
movesl(ads Display[0],screen,4000);
putcursor(24,1);
Write(' ');
end;


PROCEDURE Read_FAT;

BEGIN
	Trk := 0;
	Side := 0;
	Sect := 3;
	BufPtr := adr FAT;
	ReadSector(Drv,Side,Trk,Sect,BufPtr);
END;


PROCEDURE Get_Size;

BEGIN
	 GetDefault(Default);
	 Drv := Default;
	 Read_FAT;
	 if FAT[0] <> #FF then
	   Size := Single
	 else
	   Size := Double;

END;

PROCEDURE Next_Sector;

BEGIN
	if Sect = 8 then
	begin
	  Sect := 1;
	  if Size = Double then
	     if Side = 1 then begin
		Side := 0;
		if Trk = 39 then Trk := 0
		else Trk := succ(Trk)
	      end;
	     else side := 1;
	  else if Size = Single then
	     if Trk = 39 then Trk := 0
	     else Trk := succ(Trk)
	end;
	else Sect := Succ(Sect);
	ReadSector(Drv,Side,Trk,Sect,Bufptr);
END;

PROCEDURE Previous_Sector;

BEGIN
	if Sect = 1 then begin
	   Sect := 8;
	     if Size = Double then
	  if Side = 0 then begin
	     Side := 1
	     if Trk = 0 then Trk := 39
	     else Trk := Pred(Trk);
	  end;
	  else Side := 0;
	else if Size = Single then
	      if Trk = 0 then Trk := 39
	      else Trk := Pred(Trk);
	    end;
	else Sect := Pred(Sect);
	 ReadSector(Drv,Side,Trk,Sect,BufPtr);
END;

PROCEDURE Change_Sector;

VAR	a,x,y : integer;
	Instrg : Lstring(5);

BEGIN
	if radix = hex then
	  a := 16 else a := 10;
	if mode = 7 then
	Cursorsize(2,12)
	else Cursorsize (1,6);
	y := 1;  x := 9;
	Putcursor(y,x);
	Instrg := null;
	Readln(Instrg);
	if ord(Instrg[1]) > 96 then
	  Instrg[1] := chr(ord(Instrg[1])-32);
	Instrg[1] := chr(ord(Instrg[1])-17);
	if instrg <> null then
	  begin
	    if not decode(Instrg,Drv) then
	      repeat
		Putcursor(25,64);
		Write('Invalid Response');
		Putcursor(y,x);
		Readln(Instrg);
		if ord(Instrg[1]) >96 then
		  Instrg[1] := chr(ord(Instrg[1])-32);
		Instrg[1] := chr(ord(Instrg[1])-17);
		Putcursor(25,64);
		Write('                ');
	      until decode(Instrg,Drv);
	  end;
	Putcursor(y,x);
	Write('     ');
	Putcursor(y,x);
	Write(chr(ord(Drv)+65));
	x := 22;
	Putcursor(y,x);
	Instrg := null;
	Readln(Instrg);
	if instrg <> null then
	  begin
	    if not decode(Instrg,Side) then
	      repeat
		Putcursor(25,64);
		Write('Invalid Number');
		Putcursor(y,x);
		Readln(Instrg);
		Putcursor(25,64);
		Write('                ');
	      until decode(Instrg,Side);
	  end;
	if size = single then
	Side := 0;
	Putcursor(y,x);
	Write(ord(Side):1);
	x := 36;
	Putcursor(y,x);
	Instrg := null;
	Readln(Instrg);
	if instrg <> null then
	  begin
	    if not decode(Instrg,Trk) then
	      repeat
		Putcursor(25,64);
		Write('Invalid #');
		Putcursor(y,x);
		Readln(Instrg);
		Putcursor(25,64);
		Write('                ');
	      until decode(Instrg,Trk);
	  end;
	Putcursor(y,x);
	Write('     ');
	Putcursor(y,x);
	Write(ord(Trk):2:a);
	x := 51;
	Putcursor(y,x);
	Instrg := null;
	Readln(Instrg);
	if instrg <> null then
	  begin
	    if not decode(Instrg,Sect) then
	      repeat
		Putcursor(25,64);
		Write('Invalid Number');
		Readln(Instrg);
		Putcursor(25,64);
		Write('                ');
	      until decode(Instrg,Sect);
	  end;
	Putcursor(y,x);
	Write('     ');
	PutCursor(y,x);
	Write(ord(Sect):1);
	ReadSector(Drv,Side,Trk,Sect,BufPtr);
	CursorOff;
END;



PROCEDURE  Set_Radix;

BEGIN
	if Radix = Decimal then
	  Radix := Hex
	else
	  Radix := Decimal;
END;

PROCEDURE Test_Pattern;

var	i : integer;

BEGIN
	for i := 0 to 511 do
	   BufPtr^[i] := i mod 256;
END;



PROCEDURE Set_Display;

BEGIN
	Screen.s := #B000;
	GetMode(Mode);
	if mode <> 7 then Screen.r := #8000
	else Screen.r := #0000;
END;



PROCEDURE Init;

BEGIN
	ClearScreen;
	Title := 'IBM Pascal Disk Sector Examination Program';
	Writeline(1,20,Title);
	Title := 'by Brian Irvine';
	CursorOff;
	Writeline(5,32,Title);
	Title := 'Press [Enter] to begin...';
	Writeline(20,5,Title);
	Readln;
	ClearScreen;
	Bite := 0;
	Radix := Decimal;
	Offset := 160;
	Set_Display;
	Bufptr := adr Buffer[0];
	DspPtr := adr Display[0];
	Footer[2] := ' - Prev Sector  Next Sector -     ®F10¯ Quit                                  ';
	Title := ' Drive:        Side:        Track:        Sector:                               ';
	clearscreen;
	Get_Size;
	Display_Sector;
END;


BEGIN	{Disk_Read}
	Init;
	Repeat
	  GetKey(Keypress,Scancode);
	  case Scancode of
	    20 : Test_Pattern;
	    59 : Change_Sector;
	    60 : Set_Radix;
	    75 : Previous_Sector;
	    77 : Next_Sector;
	  otherwise
	    if Scancode <> 68 then
	    Putcursor(25,68);
	    Write('Wrong key...');
	  end;
	  Display_Sector;
	until Scancode = 68;
	ClearScreen;
	CursorSize(0,1);
END.