home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / PASCAL / IOSTUFF.ZIP / DISKREAD.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-12-28  |  7.3 KB  |  361 lines
  1. {$INCLUDE: 'IOSTUFF.INC'}
  2. PROGRAM READ_DISK(INPUT,OUTPUT);
  3. USES IOSTUFF;
  4.  
  5. const    hexes = '0123456789ABCDEF';
  6.  
  7. type    Base = (Hex,Decimal);
  8.     Numstr = Lstring(5);
  9.     Disksize = (Single,Double);
  10.  
  11. var    Title,Strg,Prompt : LString(80);
  12.     Footer : array [1..2] of Lstring(80);
  13.     Offset,i,j,k,x,y : integer;
  14.     Buffer : SecBuf;
  15.     Trk : Track;
  16.     Sect: Sector;
  17.     Side: Head;
  18.     Drv,Default : Drive;
  19.     Mode : Modes;
  20.     BufPtr : BuffAddr;
  21.     DspPtr : BuffAddr;
  22.     a,b,temp : word;
  23.     Screen : Adsmem;
  24.     Display : Array [0..3999] of Byte;
  25.     Keypress,Scancode,Shiftstatus : Byte;
  26.     Radix : Base;
  27.     Bite : 0..511;
  28.     Size : Disksize;
  29.     FAT : array [0..511] of byte;
  30.     DskSz : string(12);
  31.  
  32. PROCEDURE Draw_Header;
  33.  
  34. var    error : boolean;
  35.     temp : Lstring(5);
  36.     a : integer;
  37.  
  38. BEGIN
  39.     Title[9] := chr(ord(Drv)+65);
  40.     error := encode(temp,Side:1);
  41.     movel(adr temp[1],adr Title[22],1);
  42.      if Radix = Decimal then
  43.     a := 10 else a := 16;
  44.      error := encode(temp,ord(Trk):2:a);
  45.      movel(adr temp[1],adr Title[36],2);
  46.      error := encode(temp,ord(Sect):1);
  47.      movel(adr temp[1],adr Title[51],1);
  48.      error := encode(temp,ord(Bite):3:a);
  49.      movel(adr temp[1],adr Title[65],3);
  50.      if size = single then
  51.        begin
  52.        dsksz := 'Single Sided';
  53.        movel(adr dsksz,adr Title[65],12)
  54.        end;
  55.      else
  56.        begin
  57.        dsksz := 'Double Sided';
  58.        movel(adr dsksz,adr Title[65],12);
  59.        end
  60. END;
  61.  
  62. PROCEDURE Make_Template;
  63.  
  64. var i : integer;
  65.  
  66. BEGIN
  67.     fillc(adr Display[0],4000,'');    {Fill display buffer with blanks}
  68.     fillc(adr Display[0],160,'x');     {Make first line reverse video  }
  69.     fillc(adr Display[3680],160,'x');  {Make next to bottom line reverse.}
  70.     fillc(adr Display[3966],34,' ');   {Lower-right is high-intensity.}
  71.                        {for error prompts.}
  72.     for i := 0 to 1999 do
  73.     DspPtr^[2*i] := ord(' ');
  74.  
  75.     for i := 0 to 79 do
  76.     begin
  77.       DspPtr^[2*i] := ord(Title[i+1]);      {Move titles and footers into}
  78.       DspPtr^[2*i+3680] := ord(chr(32));
  79.       DspPtr^[2*i+3840] := ord(Footer[2,i+1]);
  80.     end;
  81. END;
  82.  
  83. PROCEDURE Display_Sector;
  84.  
  85. var i,j,k,x,y : integer;
  86.     temp,a,b  : word;
  87.  
  88. BEGIN
  89. Draw_Header;
  90. Make_Template;
  91. for i := 0 to 511 do
  92.   begin
  93.   j := i mod 24;
  94.   y := (I DIV 24);
  95.   x := 56+j;
  96.   k := 2*(y*80+x)+Offset;           {Put characters into right side}
  97.   DspPtr^[k] := BufPtr^[i];            {of the display buffer.       }
  98.   temp := wrd(BufPtr^[i]);
  99.   a := (lobyte(temp) AND 2#11110000) DIV 16;        {Fill the display }
  100.   b := lobyte(temp) AND 2#00001111;            {buffer with the  }
  101.   k := 4*(y*40+j)+2*(j DIV 4)+Offset;            {hex values of the}
  102.   DspPtr^[k] := ord(hexes[a+1]);            {characters in the}
  103.   DspPtr^[k+2] := ord(hexes[b+1]);            {sector buffer.   }
  104.   end;
  105. i := 268;
  106. repeat
  107.   DspPtr^[i] := ord('║');
  108.   i := i+160;
  109. until i > 3630;
  110. movesl(ads Display[0],screen,4000);
  111. putcursor(24,1);
  112. Write(' ');
  113. end;
  114.  
  115.  
  116. PROCEDURE Read_FAT;
  117.  
  118. BEGIN
  119.     Trk := 0;
  120.     Side := 0;
  121.     Sect := 3;
  122.     BufPtr := adr FAT;
  123.     ReadSector(Drv,Side,Trk,Sect,BufPtr);
  124. END;
  125.  
  126.  
  127. PROCEDURE Get_Size;
  128.  
  129. BEGIN
  130.      GetDefault(Default);
  131.      Drv := Default;
  132.      Read_FAT;
  133.      if FAT[0] <> #FF then
  134.        Size := Single
  135.      else
  136.        Size := Double;
  137.  
  138. END;
  139.  
  140. PROCEDURE Next_Sector;
  141.  
  142. BEGIN
  143.     if Sect = 8 then
  144.     begin
  145.       Sect := 1;
  146.       if Size = Double then
  147.          if Side = 1 then begin
  148.         Side := 0;
  149.         if Trk = 39 then Trk := 0
  150.         else Trk := succ(Trk)
  151.           end;
  152.          else side := 1;
  153.       else if Size = Single then
  154.          if Trk = 39 then Trk := 0
  155.          else Trk := succ(Trk)
  156.     end;
  157.     else Sect := Succ(Sect);
  158.     ReadSector(Drv,Side,Trk,Sect,Bufptr);
  159. END;
  160.  
  161. PROCEDURE Previous_Sector;
  162.  
  163. BEGIN
  164.     if Sect = 1 then begin
  165.        Sect := 8;
  166.          if Size = Double then
  167.       if Side = 0 then begin
  168.          Side := 1
  169.          if Trk = 0 then Trk := 39
  170.          else Trk := Pred(Trk);
  171.       end;
  172.       else Side := 0;
  173.     else if Size = Single then
  174.           if Trk = 0 then Trk := 39
  175.           else Trk := Pred(Trk);
  176.         end;
  177.     else Sect := Pred(Sect);
  178.      ReadSector(Drv,Side,Trk,Sect,BufPtr);
  179. END;
  180.  
  181. PROCEDURE Change_Sector;
  182.  
  183. VAR    a,x,y : integer;
  184.     Instrg : Lstring(5);
  185.  
  186. BEGIN
  187.     if radix = hex then
  188.       a := 16 else a := 10;
  189.     if mode = 7 then
  190.     Cursorsize(2,12)
  191.     else Cursorsize (1,6);
  192.     y := 1;  x := 9;
  193.     Putcursor(y,x);
  194.     Instrg := null;
  195.     Readln(Instrg);
  196.     if ord(Instrg[1]) > 96 then
  197.       Instrg[1] := chr(ord(Instrg[1])-32);
  198.     Instrg[1] := chr(ord(Instrg[1])-17);
  199.     if instrg <> null then
  200.       begin
  201.         if not decode(Instrg,Drv) then
  202.           repeat
  203.         Putcursor(25,64);
  204.         Write('Invalid Response');
  205.         Putcursor(y,x);
  206.         Readln(Instrg);
  207.         if ord(Instrg[1]) >96 then
  208.           Instrg[1] := chr(ord(Instrg[1])-32);
  209.         Instrg[1] := chr(ord(Instrg[1])-17);
  210.         Putcursor(25,64);
  211.         Write('                ');
  212.           until decode(Instrg,Drv);
  213.       end;
  214.     Putcursor(y,x);
  215.     Write('     ');
  216.     Putcursor(y,x);
  217.     Write(chr(ord(Drv)+65));
  218.     x := 22;
  219.     Putcursor(y,x);
  220.     Instrg := null;
  221.     Readln(Instrg);
  222.     if instrg <> null then
  223.       begin
  224.         if not decode(Instrg,Side) then
  225.           repeat
  226.         Putcursor(25,64);
  227.         Write('Invalid Number');
  228.         Putcursor(y,x);
  229.         Readln(Instrg);
  230.         Putcursor(25,64);
  231.         Write('                ');
  232.           until decode(Instrg,Side);
  233.       end;
  234.     if size = single then
  235.     Side := 0;
  236.     Putcursor(y,x);
  237.     Write(ord(Side):1);
  238.     x := 36;
  239.     Putcursor(y,x);
  240.     Instrg := null;
  241.     Readln(Instrg);
  242.     if instrg <> null then
  243.       begin
  244.         if not decode(Instrg,Trk) then
  245.           repeat
  246.         Putcursor(25,64);
  247.         Write('Invalid #');
  248.         Putcursor(y,x);
  249.         Readln(Instrg);
  250.         Putcursor(25,64);
  251.         Write('                ');
  252.           until decode(Instrg,Trk);
  253.       end;
  254.     Putcursor(y,x);
  255.     Write('     ');
  256.     Putcursor(y,x);
  257.     Write(ord(Trk):2:a);
  258.     x := 51;
  259.     Putcursor(y,x);
  260.     Instrg := null;
  261.     Readln(Instrg);
  262.     if instrg <> null then
  263.       begin
  264.         if not decode(Instrg,Sect) then
  265.           repeat
  266.         Putcursor(25,64);
  267.         Write('Invalid Number');
  268.         Readln(Instrg);
  269.         Putcursor(25,64);
  270.         Write('                ');
  271.           until decode(Instrg,Sect);
  272.       end;
  273.     Putcursor(y,x);
  274.     Write('     ');
  275.     PutCursor(y,x);
  276.     Write(ord(Sect):1);
  277.     ReadSector(Drv,Side,Trk,Sect,BufPtr);
  278.     CursorOff;
  279. END;
  280.  
  281.  
  282.  
  283. PROCEDURE  Set_Radix;
  284.  
  285. BEGIN
  286.     if Radix = Decimal then
  287.       Radix := Hex
  288.     else
  289.       Radix := Decimal;
  290. END;
  291.  
  292. PROCEDURE Test_Pattern;
  293.  
  294. var    i : integer;
  295.  
  296. BEGIN
  297.     for i := 0 to 511 do
  298.        BufPtr^[i] := i mod 256;
  299. END;
  300.  
  301.  
  302.  
  303. PROCEDURE Set_Display;
  304.  
  305. BEGIN
  306.     Screen.s := #B000;
  307.     GetMode(Mode);
  308.     if mode <> 7 then Screen.r := #8000
  309.     else Screen.r := #0000;
  310. END;
  311.  
  312.  
  313.  
  314. PROCEDURE Init;
  315.  
  316. BEGIN
  317.     ClearScreen;
  318.     Title := 'IBM Pascal Disk Sector Examination Program';
  319.     Writeline(1,20,Title);
  320.     Title := 'by Brian Irvine';
  321.     CursorOff;
  322.     Writeline(5,32,Title);
  323.     Title := 'Press [Enter] to begin...';
  324.     Writeline(20,5,Title);
  325.     Readln;
  326.     ClearScreen;
  327.     Bite := 0;
  328.     Radix := Decimal;
  329.     Offset := 160;
  330.     Set_Display;
  331.     Bufptr := adr Buffer[0];
  332.     DspPtr := adr Display[0];
  333.     Footer[2] := ' - Prev Sector  Next Sector -     «F10» Quit                                  ';
  334.     Title := ' Drive:        Side:        Track:        Sector:                               ';
  335.     clearscreen;
  336.     Get_Size;
  337.     Display_Sector;
  338. END;
  339.  
  340.  
  341. BEGIN    {Disk_Read}
  342.     Init;
  343.     Repeat
  344.       GetKey(Keypress,Scancode);
  345.       case Scancode of
  346.         20 : Test_Pattern;
  347.         59 : Change_Sector;
  348.         60 : Set_Radix;
  349.         75 : Previous_Sector;
  350.         77 : Next_Sector;
  351.       otherwise
  352.         if Scancode <> 68 then
  353.         Putcursor(25,68);
  354.         Write('Wrong key...');
  355.       end;
  356.       Display_Sector;
  357.     until Scancode = 68;
  358.     ClearScreen;
  359.     CursorSize(0,1);
  360. END.
  361.