home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / UTILITY / DISK / ADAMDISK.ZIP / ADAMDISK.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-06-10  |  39.6 KB  |  708 lines
  1. Program DiskTalkCOM;  { DISKTALK.PAS September 21, 1989 }
  2.  
  3. { I have used a dense coding format, enabling complete subroutines fit on one
  4.   computer screen.  Using a more typical and readable format prevented this,
  5.   making it harder to understand subroutines while in the modification process.
  6.   Most variable declarations are at the top for editing, and sharing variables.
  7. }
  8.  
  9. {$R+}
  10.  TYPE       HexByte = STRING[2];
  11.  CONST  EF: Byte = 26;
  12.  VAR      Buffer: array[0..511]    of byte;
  13.           HX: array[0..255]        of HexByte;
  14.           AS: array[0..255]        of char;
  15.  
  16.      Atr, C, DIRn, Esum,Ebyt, F, First, N, R, S, SStart,
  17.      SUsed, TByte, Tb:        INTEGER;
  18.  
  19.      Block, Col, Ehi,Elo, Ml, Mr, Ps, Pe, Pt, Row, Sector, Sr, Start, TheChar,
  20.       Tr,Track, Used:        BYTE;
  21.  
  22.      DidRead, OK, SW, WP:     BOOLEAN;
  23.  
  24.      X, YorN, Z:              CHAR;
  25.  
  26.      FilVar:                  FILE OF BYTE;
  27.  
  28.      Name, Path, P, Pedit:    STRING[14];
  29.  
  30. {$I Regpack.typ}
  31. {$I ResetA.lib}
  32. {$I Getsectr.lib}
  33. {$I Monitor.lib}
  34. {$I Screen.lib}
  35. {$I Getkeys.lib}
  36.  
  37. procedure Initialize;    var  N, Temp : byte;
  38. BEGIN     CheckColor; { Check video display type.} for N := 0 to 255 do
  39.     BEGIN      case N of
  40.         7..13 : AS[N] := chr(N + 64);      { The array AS consists of    }
  41.            28 : AS[N] := '\';              { a PRINTABLE character for   }
  42.            29 : AS[N] := ']';              { each byte 0 to 255.  Some   }
  43.            30 : AS[N] := chr(24);          { of the characters are not   }
  44.            31 : AS[N] := chr(25);          { normally printable, because }
  45.       else      AS[N] := chr(N);           { they change the display.    }
  46.     END;      {case}   HX[N] := '00';  Temp := N mod 16;
  47.       If Temp <= 9 then HX[N][2] := chr(Temp + 48)  {I use an array here }
  48.                    else HX[N][2] := chr(Temp + 55); {rather than making  }
  49.       Temp := N div 16;                             {a function in order }
  50.       If Temp <= 9 then HX[N][1] := chr(Temp + 48)  {to save calculation }
  51.                    else HX[N][1] := chr(Temp + 55); {time.               }
  52.     END; {for N}  DidRead := false;  { From Getsectr.lib }                 END;
  53.  
  54. procedure Beep; BEGIN Sound(660); Delay(30); NoSound; Delay(25);           END;
  55.  
  56. procedure BigCursor;      var   Regis : RegPack;   BEGIN
  57.   If mem[$0000:$0449] < 7 then  Regis.cx:= $0007   else  Regis.cx:= $010B;
  58.   Regis.ax:= $0100;       intr($10,Regis);                                 END;
  59.  
  60. procedure Increment(var Trak, Sek: byte);   BEGIN { 1:1 interleave made 5:1.}
  61.           If Sek = 4 then BEGIN Sek := 1;  { Sector 4 is last in Track.  }
  62.           Trak := Trak + 1;                { So we advance Tracks now.   }
  63.           If Trak > 39 then Trak := 0;     { The procedures "Increment"  }
  64.              END   else  BEGIN             { and "Decrement" codIfy Adam }
  65.          Sek := Sek + 5;                   { 5:1 Interleave.             }
  66.           If Sek > 8 then                  { This advances Sek 5 Sectors }
  67.            BEGIN Sek := Sek - 8; END;  END;  END;   { in the same Track. }
  68. procedure Decrement(var Trak, Sek: byte);   BEGIN {Opposite direction.}
  69.        If Sek = 1 then BEGIN Sek := 4;       If Trak = 0   then Trak := 39
  70.     else Trak := Trak - 1; END            else   BEGIN
  71.        If Sek < 6 then Sek := Sek + 3     else Sek := Sek - 5;  END;  END;
  72.  
  73.                        { REVEAL AND MODIFY PROCEDURES }
  74. procedure Choices;  BEGIN  GotoXY(1,2);  { "Reveal disk" intro screen.}
  75.           writeLn('**********************',
  76.      '*********************************************************');
  77.           writeLn('* Welcome to the Reveal',
  78.      ' and Modify Adam Disk Utility. Here you can examine or *');
  79.           writeLn('* change any part of t',
  80.      'he Adam disk.  Unless you use F10 and SAVE any changes, *');
  81.           writeLn('* nothing is changed. ',
  82.      ' So enjoy your exploration!  If you want to make a copy *');
  83.           writeLn('* of one or more ADAM ',
  84.      'Blocks, use this utility to find the Start Block.  Then *');
  85.           writeLn('* put a DOS disk in dr',
  86.      'ive B:, and use Alt-F4 to COPY BLOCK(S) onto that disk. *');
  87.           writeLn('* To copy an actual se',
  88.      'ctor from one ADAM disk to another,  display the sector *');
  89.           writeLn('* and put the target d',
  90.      'isk in drive A:,  then tap F10 to SAVE it onto the same *');
  91.           writeLn('* sector of the target',
  92.      ' disk.  *********************   Now, unless you already *');
  93.           writeLn('* know which sector yo',
  94.      'u want to see, just tap the Enter key to Reveal "DIR1." *');
  95.           writeLn('* Your selection is di',
  96.      'splayed in Hexadecimal on the left,  text on the right. *');
  97.           writeLn('* When you''re done, ju',
  98.      'st tap the F7 key to EXIT back to the Transfer program. *');
  99.           writeLn('***********************',
  100.      '*********************************************************');
  101. GotoXY(29,17);  write('For Adam DIR, Hit Enter.');
  102.   If DIRn=1 then Sector:=3 else Sector:=8; Track:=0;
  103.    REPEAT       GotoXY(29,16);  write('Select Track (0-39)        ');
  104.      GotoXY(49,16);  read(Track);   UNTIL Track in [0..39];
  105.  
  106. GotoXY(29,20);  write('For Adam DIR, Hit Enter.');
  107.    REPEAT       GotoXY(29,19);  write('Select Sector (1-8)        ');
  108.      GotoXY(49,19); read(Sector);  UNTIL Sector in [1..8];                 END;
  109.  
  110. procedure ByteAtt(WhichByte : integer; Attr : byte);  {Lights up the byte}
  111.  BEGIN  Row:=(WhichByte div 26)+2; Col:=(WhichByte mod 26);  { selected. }
  112.  ScreenAttribute(Col*2+1, Row, Attr); ScreenAttribute(Col*2+2, Row, attr);
  113.  ScreenAttribute(Col +54, Row, Attr);                                      END;
  114.  
  115. procedure BigShow;   BEGIN  If DidRead then    BEGIN  ClrScr; { Editing screen}
  116.   writeLn('      Reading A: ',0,':',Track,':',Sector);       { with sector of }
  117.   GotoXY(60,1); write('Byte:',TByte); for N:=0 to 511 do     { disk displayed }
  118.  BEGIN Row:= (N div 26)+2; Col:=(N mod 26);    GotoXY(2*Col+1,Row);
  119.   write(HX[Buffer[N]]);  GotoXY(Col + 54,Row); write(AS[Buffer[N]]);  END;
  120.   GotoXY(30,1);  Block:=(Track*4); case Sector of
  121.    3:Block:= Block+1;  8:Block:= Block+1;  5:Block:= Block+2;
  122.    2:Block:= Block+2;  7:Block:= Block+3;  4:Block:= Block+3; END; {case}
  123.   write('Block:',HX[Block]); If odd(Sector) then write('a')
  124.   else write('b');  TextColor(black); TextBackGround(white);
  125.  If Track = 0 then If Sector = 3 then BEGIN GotoXY(38,24); write('DIR 1');
  126.   GotoXY(25,1); write('A');     GotoXY(27,1);  write('SB');     DIRn:=1;
  127.   GotoXY(39,1); write('BU');          END      else
  128.                    If Sector = 8 then BEGIN GotoXY(38,24); write('DIR 2');
  129.   GotoXY(41,1); write('A');     GotoXY(43,1);  write('SB');     DIRn:=2;
  130.   GotoXY(3,1);  write('BU');          END;
  131.  GotoXY(1,22); TextBackGround(white); TextColor(blue);  { blue=Underline }
  132.  writeLn('    F1=RESET  *  F2=SB  *  F3=HELP  *  F4=$10 ',    { in mono. }
  133.    '(User A)  *  F5=DIR  * F6=$00    ');
  134.  writeLn('    F7=EXIT  *  F8=$03  *  F9=$14 (Del A)  *  ',
  135.    'F10=SAVE CHANGES  *  PgDn=NEXT   ');
  136.  write('** Alt-F2=SEEK SW FILE **');   GotoXY(57,24);
  137.  write('** Alt-F4=COPY BLOCK **');    TextColor(White);    END;            END;
  138.  
  139. procedure SmallShow; BEGIN R:=7; REPEAT GotoXY(1,R); ClrEOL; R:=R+1; UNTIL
  140.   R=17; for N:= 104 to 416 do BEGIN Row:=(N div 26)+2; Col:=(N mod 26);
  141.   GotoXY(2*Col+1,Row); write(HX[Buffer[N]]); GotoXY(Col + 54,Row);
  142.   write(AS[Buffer[N]]);       END;  { Fixes the DIR after Help }           END;
  143.  
  144. procedure NewChar(ch : char);  BEGIN Beep; GotoXY(48,25); { Update video & RAM.}
  145.    write('Last change:',HX[TheChar],'  to:  at BYTE:',(TByte));
  146.    WriteScreen(62,25,chr(Buffer[TByte]),112); WriteScreen(67,25,ch,112);
  147.    Buffer[TByte] := ord(ch);  WriteScreen((TByte mod 26) + 54,
  148.     (TByte div 26)+2,ch,112);  TextColor(black);TextBackGround(white);
  149.    GotoXY(2*(TByte mod 26)+1,(TByte div 26) + 2);  write(HX[ord(ch)]);
  150.         TextColor(white); TextBackGround(black);                           END;
  151.  
  152. procedure ShowChar;                                    { Displays Byte }
  153. BEGIN  GotoXY(65,1);  ClrEOL;  write(TByte);                { and Char }
  154.   TheChar := Buffer[TByte];  GotoXY(70,1); write('$');      { at Upper }
  155.      { run time error ^ 90 in Reveal using PgDn }
  156.   TextColor(black);TextBackGround(white);                   { Right of }
  157.   write(HX[TheChar],' = ',Buffer[TByte]); GotoXY(37,22);    { screen.  }
  158.   TextColor(white);TextBackGround(black);                                  END;
  159.  
  160. procedure SB; BEGIN  If (Sector+Row)=29 then BEGIN END  else    BEGIN
  161.  ByteAtt(TByte,15); TByte:=((Row-2)*26+S+13);Tb:=TByte; ByteAtt(TByte,112);
  162.   ShowChar; S:= (Buffer[TByte]*2); If (S>0) and (S<159) then BEGIN
  163.   Sector:=1;  REPEAT Increment(Track,Sector); S:=(S-1) { SB=ADAM Start Block.}
  164.               UNTIL S=0; GetSector('R','A',0,Sector,Track,DidRead);
  165.   If (Buffer[0]=0) and (Buffer[1]=1) then TByte:=259 else TByte:=0;
  166.   BigShow;  ShowChar;  ByteAtt(TByte,112);            END  else
  167.    BEGIN GotoXY(45,1); write('*INVALID SB*');  Beep; S:=$00; GetKeys(X,X);
  168.    GotoXY(45,1); write('              '); GotoXY(37,22); END;   END;       END;
  169.  
  170. procedure FileAttr; BEGIN If S*2+TByte<510 then BEGIN ByteAtt(TByte,15);
  171.   TByte:= ((Row-2)*26+S+12); ByteAtt(TByte,112); If F=1 then NewChar(#16)
  172.   else NewChar(#20); ShowChar; GotoXY(37,22);   END  else                  END;
  173.      { ADAM file attribute.}
  174. procedure RevealHelp; BEGIN GotoXY(1,6); ClrEOL; GotoXY(1,7); { Help for }
  175.   writeLn('* A 512 byte Sector ',         { the Reveal Adam Disk screen. }
  176. '(a or b of 2 Sector Adam Block) is shown in hex and text. *');
  177.   writeLn('* Top line "Reading"',
  178. ' displays Drive:Side:Track:Sector, Adam Block being read. *');
  179.   writeLn('* The SB and BU mark',
  180. 'ers show Start Block and Blocks Used column in both DIRs. *');
  181.   writeLn('* In DIR2 the BU for',
  182. ' each file is on the line BELOW the line of the filename. *');
  183.   writeLn('* The A marker befor',
  184. 'e SB in DIRs shows file Attribute (Deleted= 14 User= 10). *');
  185.   writeLn('* F1 lets you ',
  186. 'quickly RESET to another Track and Sector anywhere on the disk. *');
  187.   writeLn('* Type changes',
  188. ' in, or hold down "Alt" while using Num keys for Decimal value. *');
  189.   writeLn('* You MUST use',
  190. ' F6 or F8 to enter Hex 00 or Hex 03 respectively (NOT Alt-Num). *');
  191.   writeLn('* F2, F4, and ',
  192. 'F9 are for DIRs.  F2=Go to file, F4 or F9=User or Deleted file. *');
  193.   writeLn('** Alt-F2 Will',
  194. ' SEEK Adam SmartWriter files from here to the end of the disk. **');
  195.   ClrEOL;  GetKeys(X,X);  SmallShow;  ShowChar;  ByteAtt(TByte,112);       END;
  196.  
  197. procedure Advance; BEGIN If TByte < 511 then  BEGIN  ByteAtt(TByte,15);
  198.    TByte := TByte + 1;  ByteAtt(Tbyte,112); ShowChar;  END;           END;
  199.     { Advance to next character only if not at end of sector. }
  200.  
  201. procedure Seek;    { Seeks SmartWriter files (Hdr: 0001) to end of disk. }
  202.  
  203. procedure Find; BEGIN Increment(Track,Sector);  { Adam Blocks start on }
  204.     If odd(Sector) = false then BEGIN Seek; END else  BEGIN {odd Sectors.}
  205.     GetSector('R','A',0,Sector,Track,DidRead); If Buffer[1]=1 then
  206.     BEGIN  If Buffer[0]=0 then  BEGIN TByte:=259;  BigShow;  ShowChar;
  207.     ByteAtt(TByte,112); END else Seek; END else Seek; END;                 END;
  208. BEGIN If Track<39 then BEGIN Find; END else BEGIN Sector:=Sr; Track:=Tr; Beep;
  209. Beep; GotoXY(21,25); write('** No SmartWriter file found - TAP ENTER');Read(Z);
  210. GotoXY(1,25); ClrEOL; GetSector('R','A',0,Sector,Track,DidRead); ShowChar;
  211.   ByteAtt(TByte,112);                       END;                           END;
  212.  
  213. procedure ResetTrSr;BEGIN ClrScr;writeLn('RESET TRACK AND/OR SECTOR');
  214.  REPEAT               ClrEOL;  writeLn('Which Track (0-39)? ');
  215.  write('(Current setting:  TRACK ',Track,' - Tap Enter to retain it)');
  216.   Beep;  GotoXY(21,2); Read(Track);            UNTIL Track in [0..39];
  217.  REPEAT GotoXY(1,3);  ClrEOL;  writeLn('Which Sector (1-8)? ');
  218.  write('(Current setting: SECTOR ',Sector,' - Tap Enter to retain it)');
  219.   Beep;  GotoXY(21,3); Read(Sector);
  220.  UNTIL Sector in [1..8];  GetSector('R','A',0,Sector,Track,DidRead);
  221.   TByte := 0;  BigShow;  ShowChar;  ByteAtt(Tbyte,112);                    END;
  222.  
  223. procedure SaveChanges; BEGIN  GotoXY(1,25);   Beep;
  224.   write(' ** CAUTION **   Write changes? ');  Beep;
  225.   Getkeys(YorN,X);  If UpCase(YorN)='Y' then
  226.       BEGIN write('Y'); GetSector('W','A',0,Sector,Track,DidRead);
  227.              BigShow; ShowChar; ByteAtt(Tbyte,112); END
  228.  else BEGIN GotoXY(1,25); write('** Changes NOT written to disk.');
  229.                                      GotoXY(37,22); END;                   END;
  230.  
  231. procedure SectXfrWrite(var SU: integer);   { Set Name of file before calling.}
  232.         { Writes SU count of 512 byte SECTORS from current sector, to B:\Name.}
  233.  BEGIN GotoXY(17,16);
  234.      Assign(FilVar,Path+Name); {$I-} Rewrite(FilVar) {$I+};
  235.    OK:=(IOresult=0); If not OK then
  236.    BEGIN write('** DOS won''t accept ',Path+Name); Beep;               END else
  237.            BEGIN Beep; write('Working...');
  238.                 GetSector('R','A',0,Sr,Tr,DidRead);   If not DidRead then
  239.    BEGIN GotoXY(55,15); write('**READ ERROR - ABORTED**'); Beep; Beep; END else
  240.    BEGIN REPEAT For N:=0 to 511 do BEGIN write(FilVar,buffer[N]); END;
  241.        Increment(Tr,Sr);  GetSector('R','A',0,Sr,Tr,DidRead); SU:=(SU-1);
  242.          UNTIL (SU)=0; write(FilVar,EF); { DOS E.O.F marker.} write('** DONE');
  243.    END;    END; Sr:=Sector; Tr:=Track; Close(FilVar);
  244.          write(' - Tap Enter'); Beep; Read(X);                             END;
  245.  
  246. procedure BlockTransfer;    { Copies one or more 1k ADAM blocks to a DOS file.}
  247.  
  248. procedure BlkXfrInstruct; BEGIN
  249.      For N:=6 to 16 do BEGIN GotoXY(1,N); ClrEOL; END; GotoXY(1,7);
  250.   writeLn('* This utility will ',   { Adam BLOCK COPY (Transfer) Instructions.}
  251.      'COPY BLOCK(S) from an Adam disk to a DOS file starting at *');
  252.   writeLn('* the current Block:',HX[Block],
  253.       ' If the Block displayed now isn''t the right Start Block *');
  254.   writeLn('* on the Adam disk f',
  255.      'or the DOS file you want to create, just tap Enter alone. *');
  256.   writeLn('* NOTE:  The Block s',
  257.      'elected MUST end in a, indicating the Start of the Block. *');
  258. REPEAT  GotoXY(1,12);
  259. writeLn('  To continue, type in the number of BLOCKS TO COPY:     (160 Max.)');
  260. writeLn('                                                (Enter=ABORT)');
  261.   GotoXY(54,12); SUsed:=0; Read(SUsed); { Get Number of Blocks to Copy.}
  262. UNTIL SUsed in [0..160]; If (SUsed)=0 then
  263.   BEGIN Beep; Beep; write('**ABORTED - Enter again'); Read(X); END else
  264.   BEGIN Path:='B:\';                 { NOTE: Path input could be added here.}
  265.     BEGIN GotoXY(1,13); ClrEOL; GotoXY(47,15); write('(Enter=ABORT)');
  266.     GotoXY(36,14); Write('DOS FILE NAME ',Path);   Read(Name);
  267.     If Length(Name)=0  then
  268.      BEGIN Beep; Beep; write('**ABORTED - Enter again'); Read(X); END else
  269.      BEGIN GotoXY(17,15); ClrEOL; write('Preparing to COPY ',SUsed,
  270.                          ' BLOCK(s) starting at ',HX[Block],' to ',Path+Name);
  271.       SUsed:=(SUsed*2); { 2 Sect/Block }
  272.       SectXfrWrite(SUsed); END;
  273.     END;
  274.   END;                                                                     END;
  275.  
  276.                        { procedure BlockTransfer starts here }
  277. BEGIN   If not odd(Sector) then { Not odd Sector = we're in 2nd half of Block.}
  278.  BEGIN GotoXY(1,25); Beep; Write('**',HX[Block],'b selected - USE PgUp');
  279.        GotoXY(16,25); GetKeys(X,X);   { Display message & wait for keystroke. }
  280.  END else  BEGIN Sr:=Sector; Tr:=Track; BlkXfrInstruct;
  281.            GetSector('R','A',0,Sector,Track,DidRead); SmallShow;
  282.            END;  Beep; GotoXY(37,22);                                      END;
  283.  
  284. procedure DOSin2adam;
  285. var LB,BU:integer;  Q,SS,TT:byte;
  286.  
  287. procedure DOSinDONE;
  288. BEGIN  Beep;  write(' -  Adam BU:',BU,' LB:',LB); GotoXY(16,22);
  289.  write('** DONE - DOS file is copied to X on the Adam disk.'); GotoXY(16,23);
  290.  write('           (Note: only ASCII was copied.)  Tap Enter'); Read(X);  END;
  291.  
  292. procedure DOSinCOPY;
  293. BEGIN SS:=5; TT:=0; BU:=1;
  294.   GetSector('R','A',0,SS,TT,DidRead); { Copy Adam TABs - could eliminate this.}
  295.     Buffer[0]:=0; For N:=1 to 2 do Buffer[N]:=1; { 00 01 01 = SmartWriter Hdr.}
  296. { Put S.Writer margins on Adam disk - won't match srce. OR dest. file (elim?).}
  297.     Buffer[3]:=12; Buffer[4]:=120;   { Top & Bottom margins x2 in SmartWriter.}
  298.     Buffer[5]:=9; Buffer[6]:=69; { Left & Right margins.}    Buffer[7]:=2;
  299.     For N:=8 to 11 do Buffer[N]:=0; Buffer[12]:=1; { Buffer[12] is 1st TAB,   }
  300.     For N:=13 to 84 do Buffer[N]:=0;               { only 1 set - maybe wrong.}
  301. { Copy the source file, starting AFTER the Adam Header we just made.}
  302.     N:= 259;  LB:= 259;  { Xfer ASCII }
  303.   While not EOF (FilVar) do   BEGIN read(FilVar,Q); If (Q<32) and (Q<>13)
  304. { Copy CR - strip all other Lo/Hi ASCII (less than 32, more than 126).}
  305.    or (Q>126) then  BEGIN END else  BEGIN  Buffer[N]:=Q; N:=N+1; LB:=LB+1;
  306.    If N=512 then BEGIN N:=0; GetSector('W','A',0,SS,TT,DidRead);
  307.   Increment(TT,SS); If LB > 1023 then      BEGIN BU:=BU+1; LB:=1; END;
  308.                  END;         END;  END;                     { Fill end of }
  309.   Close(FilVar); REPEAT Buffer[N]:=$20; N:=N+1; UNTIL N=512; { Last Sector }
  310.   GetSector('W','A',0,SS,TT,DidRead);                        { with spaces.}
  311.   GetSector('R','A',0,3,0,DidRead);  Buffer[95]:=BU;   { Update Adam DIR }
  312.     Buffer[97]:=BU;  Buffer[99]:=Lo(LB);  Buffer[100]:=Hi(LB);
  313.     GetSector('W','A',0,3,0,DidRead); DOSinDONE;
  314.                                                                            END;
  315.  
  316. procedure NonAdamA; BEGIN GotoXY(9,24);
  317.  write('**ABORTED.  SPECIALLY PREPARED ADAM DISK MUST BE IN DRIVE A: ');
  318.  Beep;  Beep;  For N:=1 to 2 do BEGIN Delay(400); write('*'); END;         END;
  319.  
  320. procedure DOSinNote;     { A special note to the user, if DOS-IN won't work.}
  321. BEGIN GotoXY(1,13); ClrEOL; writeLn('NOTE:');
  322.      writeLn('* You may be able to force the copying ',
  323.      'of the DOS file to the disk in A:, IF: *');
  324.      writeLn('* 1) The disk in A: is an Adam disk.   ',
  325.      '2) You are willing to risk losing data *');
  326.      writeLn('* now on the disk in A:.   To do this, ',
  327.      'use the REVEAL utility to put an upper *');
  328.      writeLn('* case letter X at byte 78 of Track 0, ',
  329.      'Sector 2.  This is the first character *');
  330.      writeLn('* of the 1st file entry on the Adam dis',
  331.      'k. ** The safer method is to prepare a *');
  332.      writeLn('* new Adam DATA disk, with an empty fil',
  333.      'e named X as the only directory item.  *'); 
  334.                     write('Tap the Enter key to continue');  Read(X);      END;
  335. procedure NotFound; BEGIN GotoXY(25,25); Beep; Beep;
  336.   write('**  ',P,'-AX.TXT not found - Tap Enter'); P:='B:\'; Read(X);      END;
  337.  
  338. procedure NoDOSin;  BEGIN GotoXY(25,25); Beep; Beep; Close(FilVar);
  339.   write('**ABORTED - Tap Enter'); Read(X);                                 END;
  340.  
  341. procedure DOSinTEST;
  342. BEGIN  GetSector('R','A',0,2,0,DidRead);    { Sect.2, Track 0=DOS Media Descr.}
  343. If not DidRead then           BEGIN NonAdamA; { Disk error.}           END else
  344. If Buffer[0]=$FD then         BEGIN NonAdamA; { FD=DOS disk.}          END else
  345.        GetSector('R','A',0,3,0,DidRead);
  346. If Buffer[78]<>$58 then       BEGIN NonAdamA; DOSinNote; { 1st not X } END else
  347.  BEGIN                              GotoXY(18,15);    { Get Drive:\path\name. }
  348.  write('DOS drive and path of -AX.TXT source file: '); GotoXY(31,16);
  349.  write('(ie: C:\wp\stuff\  -  ENTER = ',P,' )');       GotoXY(54,18);
  350.                         write('** A = ABORT **');
  351.      GotoXY(61,15); Read(Path); C:=WhereX; { Get cursor position.}
  352.      GotoXY(31,16); ClrEOL; GotoXY(54,18); ClrEOL;
  353.       If Length(Path)=0 then Path:=P;  P:=Path; { P either old or new one now.}
  354.       If UpCase(P[1])='A' then BEGIN
  355.         GotoXY(28,20); Path:='B:\'; P:=Path;
  356.         write('** ABORTED - Tap Enter'); Beep; Beep; Read(X);          END else
  357.       BEGIN   If (P[Length(P)] <> '\') then  BEGIN
  358.         REPEAT  GotoXY(31,16); write('        ** PATH MUST END WITH "\" **');
  359.         Beep; Beep; Delay(900); GotoXY(C,15);  ClrEOL; Read(Pedit);
  360.         P:=P+Pedit; C:=WhereX;
  361.         UNTIL  (P[Length(P)] = '\');         END;
  362.    Assign(FilVar,P+'-AX.TXT'); {$I-}   Reset(FilVar)  {$I+};  OK:=(IOresult=0);
  363. If not OK then        BEGIN      NotFound;                             END else
  364.                  BEGIN   C:=FileSize(FilVar);
  365. GotoXY(16,19); write('FOUND ',P,'-AX.TXT file of ',C,' bytes.  Y=Continue');
  366. GetKeys(X,X); If UpCase(X) <> 'Y' then BEGIN NoDOSin;  { ABORTED }     END else
  367.            BEGIN  { Continue writing file.}
  368. GotoXY(16,19); write('WRITING ',P,'-AX.TXT to A:X (Adam SmartWriter format)');
  369. GotoXY(21,20); write('DOS ',C,' bytes ');
  370. DOSinCOPY; END;  END; { Adam 'X' file copied from DOS Drive:\path\-AX.TXT. }
  371.  END; END;                                        { DOSinTEST ends here.}  END;
  372.  
  373. procedure DOSinGREET;
  374. BEGIN  ClrScr; GotoXY(1,1);
  375. writeLn('* Welcome to the DOS-IN utility.   ',
  376. 'This feature allows you to copy a DOS file *');
  377. writeLn('* onto an ADAM disk.  WARNING: THIS',
  378. ' IS A LIMITED SAFETY UTILITY.  It does not *');
  379. writeLn('* perform many safety checks, and w',
  380. 'ill * OVER-WRITE DATA * on the disk in the *');
  381. writeLn('* A: drive if you proceed.   BEFORE',
  382. ' USING this utility, put a special "blank" *');
  383. writeLn('* ADAM DATA disk in drive A:, and m',
  384. 'ake a copy of the DOS target file with the *');
  385. writeLn('* name "-AX.TXT" (without quotes). ',
  386. ' That is, the DOS file you wish to copy to *');
  387. writeLn('* the Adam disk must be named -AX.T',
  388. 'XT,  and the Adam disk in drive A: must be *');
  389. writeLn('* blank (see documentation).  ONLY ',
  390. 'ONE SUCH FILE CAN BE COPIED PER ADAM DISK. *');
  391. writeLn('* That is, once the Adam disk has a',
  392. ' file on it, a different Adam disk will be *');
  393. writeLn('* needed to copy another DOS file. ',
  394. '  * NOTE: only ASCII 32-126, TAB, CR, & FF *');
  395. writeLn('* are copied by this utility. Put a',
  396. ' prepared Adam disk in A: now to continue. *');
  397. GotoXY(1,13);
  398.   write('**  TAP THE LETTER Y KEY TO CONTINUE',
  399. ' OR ENTER TO ABORT THE DOS-IN UTILITY.  **');
  400. GotoXY(20,13); Beep; GetKeys(X,X); DidRead:=False; GotoXY(1,13); ClrEOL;
  401. If UpCase(X)<>'Y' then       BEGIN GotoXY(47,13);  write('* ABORTED *'); Beep;
  402. Delay(50); Beep; Delay(750); END else
  403. DOSinTEST;                                                                END;
  404.                         { Main body of procedure DOSin2adam.}
  405. BEGIN     DOSinGREET; { Copy only if tests passed.}                       END;
  406.  
  407.  
  408. procedure TakeInstructions;   var   choice, EscChoice : char;
  409. BEGIN   { BEGIN TakeInstructions - Wait 'til a key is pressed.  If it's  }
  410.   REPEAT                         { a "special" key, check what action to }
  411.     GetKeys(choice,EscChoice);   { take.  If it's "ordinary", insert its }
  412.     If choice = chr(27) then     { value in the Buffer at the current    }
  413.       case EscChoice of          { place and display it.                 }
  414. #0 : BEGIN  NewChar(#27);  Advance;  END;  { Enters Esc Code       **Esc }
  415. 'I': {PgUp} BEGIN  Decrement(Track,Sector);                     { **PgUp }
  416.       GetSector('R','A',0,Sector,Track,DidRead); TByte := 0; Bigshow;
  417.                 ShowChar;  ByteAtt(TByte,112);             END;
  418. 'Q': {PgDn} BEGIN  Increment(Track,Sector);                     { **PgDn }
  419.       GetSector('R','A',0,Sector,Track,DidRead); TByte := 0; Bigshow;
  420.                 ShowChar;  ByteAtt(TByte,112);             END;
  421. 'G': {Home} BEGIN  ByteAtt(TByte,15);   TByte := 0;             { **Home }
  422.       ByteAtt(TByte,112);  ShowChar;                       END;
  423. 'O': {END}  BEGIN  ByteAtt(TByte,15);   If TByte < 494 then      { **END }
  424.       TByte := (TByte + (25 - ((TByte + 26) mod 26)))  else TByte:= 511;
  425.       ByteAtt(TByte,112);  ShowChar;                       END;  
  426. 'H': If (TByte div 26) > 0 then               BEGIN           { UP ARROW }
  427.       ByteAtt(TByte,15);    TByte := TByte - 26;       ByteAtt(Tbyte,112);
  428.                 ShowChar;                                  END;  
  429. 'P': If TByte < 486 then                      BEGIN         { DOWN ARROW }
  430.       ByteAtt(TByte,15);    TByte := TByte + 26;       ByteAtt(Tbyte,112);
  431.                 ShowChar;                                  END;
  432. 'K': If TByte > 0 then               BEGIN                  { LEFT ARROW }
  433.       ByteAtt(TByte,15);    TByte := TByte - 1;        ByteAtt(Tbyte,112);
  434.                 ShowChar;                                  END;
  435. 'M': BEGIN    Advance;     END;  { calls procedure Advance - RIGHT ARROW }
  436. ';': BEGIN    ResetTrSr;                                   END;{RESET*F1 }
  437.  
  438. '<': BEGIN If Track = 0 then  case Sector of                 { SEARCH*F2 }
  439.      3 : BEGIN S:= 0; SB;  END;
  440.      8 : BEGIN S:= 8; SB;  END else  END; {case}           END;
  441. 'i': BEGIN GotoXY(1,25); ClrEOL;  GotoXY(21,25);             { SEEK*Alt-F2 }
  442.      write('Seeking SmartWriter file to end of disk');
  443.      Tr:=Track; Sr:=Sector; Seek;                          END;
  444. '=': BEGIN RevealHelp;                                     END;{ HELP*F3 }
  445. '>': BEGIN If (Track=0) and (Sector=3) or (Sector=8) then  { USER*F4 }
  446.          BEGIN F:=1; S:=Sector; FileAttr; Beep; END  else  END;
  447. 'k': BEGIN  BlockTransfer;                END; {1k BLOCK XFR - **Alt-F4  }
  448. 'R': BEGIN If (Track=0) and (Sector=3) or (Sector=8) then  { USER*INS }
  449.          BEGIN F:=1; S:=Sector; FileAttr; Beep; END  else  END;
  450. '?': BEGIN Track:=0; If DIRn=1 then Sector:=3 else Sector:=8;   { DIR*F5 }
  451.           GetSector('R','A',0,Sector,0,DidRead);
  452.          TByte:=Tb; BigShow; ShowChar; ByteAtt(TByte,112); END;
  453. '@': BEGIN      NewChar(#00); Advance;                     END;{ $00 *F6 }
  454. 'B': BEGIN    { Enters a chr(3), equivalent to <Ctrl><Break>.    $03 *F8 }
  455.        NewChar(#3);          Advance;                      END;
  456. 'C': BEGIN If (Track=0) and (Sector=3) or (Sector=8) then  { DELETE*F9 }
  457.          BEGIN F:=0; S:=Sector; FileAttr; Beep; END  else  END;
  458. 'S': BEGIN If (Track=0) and (Sector=3) or (Sector=8) then  { DELETE*DEL }
  459.          BEGIN F:=0; S:=Sector; FileAttr; Beep; END  else  END;
  460. 'D': BEGIN SaveChanges;                                   { SAVE - **F10 }
  461. END; END { case }
  462. else BEGIN   NewChar(choice);  Advance;  END;        { For regular ASCII }
  463.  
  464.   UNTIL (choice = chr(27)) and (EscChoice = 'A');            { EXIT **F7 }
  465.                                              { Return to Main Loop }       END;
  466.                   { MAIN PROGRAM LOOP - TRANSFER PROCEDURES }
  467. procedure DiskCheck;           { Disk-related error checking & identification.}
  468.  
  469. procedure Data;  { Additional test for Adam DATA disk, after CASE below.}
  470. BEGIN GetSector('R','A',0,3,0,DidRead); If Buffer[0]=$46 then
  471.     BEGIN write('  Probable Adam SmartFiler DATA disk.');    END  else
  472. BEGIN Beep;write('** CAN''T IDENTIFY TYPE OF DISK IN A: **');END;          END;
  473.  
  474. BEGIN { DiskCheck starts here.}
  475.   GotoXY(9,6);  Beep;  write(' The ADAM DISK must be in Drive A:',
  476.     ' now, in order to continue.');  GotoXY(15,7);    write('Tap',
  477.   ' Y when ready to go, or any other key to ABORT.');   GetKeys(YorN,Z);
  478.  If UpCase(YorN)='Y'then BEGIN ResetA; GetSector('R','A',0,2,0,DidRead); END
  479.   else BEGIN writeLn(' ');writeLn(' ');Beep; write('**ABORTED**'); Halt; END;
  480.      If not DidRead then    {ResetA resets the drive}                BEGIN
  481.  Beep; writeLn(' '); write('**DISK ERROR - TERMINATED**');Beep;Halt; END else
  482.  { Next, use Buffer[0] (DOS disk descriptor byte) to check disk.} BEGIN
  483.                            GotoXY(20,16);   CASE Buffer[0] of
  484. $CB:BEGIN write('Probable Adam SmartFiler DISK MANAGER "DOS" disk.');  END;
  485. $75:If Buffer[4] =$DD then
  486.        BEGIN write('     Probable ADAMLINK system disk.');   END else
  487.              BEGIN Data; END;
  488. $52:If Buffer[20]=$D0 then { 75,52,20 are common ASCII, so do 2nd test.}
  489.        BEGIN write('     Probable AdamBASIC system disk.');  END else
  490.              BEGIN Data; END;
  491. $20:If Buffer[1] =$30 then
  492.        BEGIN write('     Probable AdamLOGO system disk.');   END else
  493.              BEGIN Data; END;
  494. $FF:BEGIN If Buffer[5]=$FF then
  495.     BEGIN write('     Probable Adam CP/M system disk.')      END else
  496.     BEGIN write('** A: May be NON-ADAM disk!  (DSDD 8) **'); END;      END;
  497. $FC:BEGIN write('** A: May be NON-ADAM disk!  (SSDD 9) **');           END;
  498. $FD:BEGIN write('** A: May be NON-ADAM disk!  (DSDD 9) **');           END;
  499.                                  else Data; END; { Case }         END;
  500.   GotoXY(24,17); write('Enter=CONTINUE  *  Ctrl-C=STOP'); Beep; Read(Z);   END;
  501.  
  502. procedure LiteName; BEGIN TextColor(black); { Lights up chosen filename.}
  503.  TextBackGround(white);   N:=Tbyte+First; Row:=N div 26+2; Col:=1;
  504.  Atr:=Buffer[N+12];
  505. REPEAT GotoXY(2*Col,Row);  write(AS[buffer[N]],' ');  N:=N+1; Col:=Col+1;
  506. UNTIL (Buffer[N]=3) or (Col>11);  N:=N-1; If UpCase(Buffer[N])='H' then
  507. SW:=true else SW:=false; { Determine if it's a SmartWriter file } If SW
  508.  then BEGIN GotoXY(55,11); write('** Adam SmartWriter file.'); END;
  509.  If Atr=$14 then BEGIN GotoXY(55,11); write('DELETED') END;
  510.  TextColor(white); TextBackGround(black);
  511.  GotoXY(2*Col-2,Row); write(AS[buffer[N]],' '); GotoXY(1,22);              END;
  512.  
  513. procedure DarkName; BEGIN GotoXY(55,11); ClrEOL; { Turn off lite when leaving.}
  514. N:=Tbyte+First; Row:=(N div 26)+2; Col:=1;
  515. REPEAT GotoXY(2*Col,Row);  write(AS[buffer[N]],' ');  N:=N+1; Col:=Col+1;
  516. UNTIL Col>11;                                                              END;
  517.  
  518. procedure Err; BEGIN Beep; GotoXY(59,2); ClrEOL; GotoXY(45,1);
  519.  write('** BAD SB, BU or LB **'); ClrEOL; Beep;  GotoXY(1,22);             END;
  520.   { For invalid selections by user.}
  521.  
  522. procedure XDIR;          { Displays Adam Transfer DIR in 26 byte lines. }
  523.  BEGIN  GetSector('R','A',0,Sector,0,DidRead);
  524.  If DidRead then     BEGIN  ClrScr; for N:= (First) to 511 do BEGIN
  525.     Row:=((N - First) div 26)+2; Col:=((N - First) mod 26)+1;
  526.     GotoXY(2*Col,Row);  If Col > 12 then write(HX[buffer[N]])
  527.     else write(AS[buffer[N]]);                                END;
  528.     TextColor(black); TextBackGround(white); GotoXY(40,1); write('BU');
  529.     GotoXY(1,22); write('** USE ARROWS TO SELECT FILE **'); GotoXY(38,22);
  530.     write('DIR ',DIRn); GotoXY(1,23);   TextColor(blue); {blue=Underline}
  531.      write(' ** F10=TRANSFER selected file  *  F3=HELP  * ');  {in mono. }
  532.      write(' F7=EXIT  *  '); If DIRn = 1 then
  533.        BEGIN write('PgDn = Next DIR  **'); END  else
  534.        BEGIN write('PgUp= First DIR  **'); END; GotoXY(1,24);
  535.      write(' ** HOLD DOWN Ctrl or Alt to start either:',
  536.            ' Ctrl-F5=DOS-IN  *  Alt-F3=REVEAL **');
  537.      GotoXY(1,22);   END                              else err;            END;
  538.  
  539. procedure FixDIR; BEGIN for R:=8 to 17 do { Restores Dir after HELP or BlockX.}
  540.   BEGIN GotoXY(1,R); ClrEOL; END;  for N:=(First)+156 to (First)+415 do
  541.     BEGIN Row:=((N - First) div 26)+2; Col:=((N - First) mod 26)+1;
  542.      GotoXY(2*Col,Row);  If Col > 12 then write(HX[buffer[N]])
  543.      else write(AS[buffer[N]]);
  544.     END;  LiteName; GotoXY(1,22);                                          END;
  545.  
  546. procedure Settings; BEGIN     { Get PageStart, PageEnd & Mgns. from SW Header }
  547.   {$R-}  Ps:=Buffer[3]; Pe:=Buffer[4]; Pt:=(Pe-Ps);    { and Save w/WP format.}
  548.   Buffer[4]:=Pt; Ml:=Buffer[5]; Ml:=Ml+1; Mr:=Buffer[6]; Mr:=Mr+1; {$R+}
  549. If Ps+Pe+Ml+Mr > 255 then  BEGIN    { Range Checking off reading Adam in case.}
  550.  GotoXY(55,5); write(' ** PROBABLE ERROR IN');
  551.  GotoXY(55,6); write(' ** ADAM FILE MARGINS');
  552.  GotoXY(55,7); write('     - continuing -'); Beep; END;
  553.   Buffer[9]:=Ml; Buffer[10]:=Mr; { Margins. }      Buffer[0]:=$D0; { them  }
  554.   Buffer[1]:=$42; Buffer[2]:=$78; Buffer[3]:=$42;  Buffer[5]:=$D0; { to WP }
  555.   Buffer[6]:=$C0; Buffer[7]:=$00; Buffer[8]:=$4E;  Buffer[11]:=$C0; { Hdr. }
  556.   for N:=0 to 11 do BEGIN write(FilVar,Buffer[N]); END;                    END;
  557.  
  558. procedure Transfer; { Translates and transfers an ADAM file to a DOS file.}
  559.  
  560. procedure OneSector; BEGIN If Esum>511 then Ebyt:= 511 else Ebyt:= Esum;
  561.   If SUsed>2 then Ebyt:=511;  If SUsed=1 then Ebyt:=Esum-512; If Ebyt<0
  562.    then BEGIN END else BEGIN  For N:= S to Ebyt do
  563.  BEGIN If SW then                     { SW is set in procedure LiteName. }
  564.    BEGIN If buffer[N]= $13 then buffer[N]:= $94;  { If SmartWriter file, }
  565.          If buffer[N]= $14 then buffer[N]:= $95;  { change Adam UL to WP }
  566.          If buffer[N]= $0D then buffer[N]:= $0A;  { and CR to LF.        }
  567.    END;  write(FilVar,buffer[N]); { Write character to DOS file }
  568.  END; Increment(Track,Sector); GetSector('R','A',0,Sector,Track,DidRead);
  569.                        END;    SUsed:=(SUsed-1);                           END;
  570.  
  571.  
  572.                   { The main TRANSFER procedure starts here }
  573. BEGIN  GetSector('R','A',0,Sector,Track,DidRead);   If not DidRead then
  574.  BEGIN Beep; GotoXY(59,2); write('**DISK ERROR**'); Beep; END else BEGIN
  575.      If WP=true then Settings; WP:=false;
  576.    OneSector;  S:=0; REPEAT OneSector; UNTIL SUsed<1;            END;      END;
  577. procedure SetUp;  BEGIN   N:=TByte; N:=(N+First+13);    { Read File Info. }
  578.   Start:=Buffer[N]; If (TByte=494) AND (DIRn=1) then BEGIN  { If the Last }
  579.    GetSector('R','A',0,8,0,DidRead); Used:=Buffer[1];    { file in DIR 1. }
  580.    Elo:=Buffer[3]; Ehi:=Buffer[4]; GetSector('R','A',0,3,0,DidRead); END
  581.  else { For all files but Last file in DIR 1 (If-AND above).}  BEGIN
  582.           N:=N+6; Used:=Buffer[N];            N:=N+2; Elo:=Buffer[N];
  583.           N:=N+1; Ehi :=Buffer[N];                             END;
  584.       Esum:= (Elo+(Ehi*256)-1);     GotoXY(1,1);  write('SB:',Start,
  585.     ' BU:',Used,' LB:',Esum,'   ');
  586.   If ((Start+Used)>159) or (Start>158) or (Used<1) or (Esum<1) then
  587.   BEGIN Err; END else
  588.  
  589. BEGIN {Start Xfr}     GotoXY(55,3); ClrEOL; GotoXY(55,2); ClrEOL;
  590.  write('  ENTER=',P); GotoXY(45,1); ClrEOL; write('DOS DRIVE:\PATH\ ');
  591.  Read(Path); C:=WhereX;          { Get cursor position to edit path if no "\".}
  592.        If UpCase(Path[1])='A'                                       then
  593.         BEGIN Beep; GotoXY(45,1); write('** CAN''T USE DRIVE A: **');
  594.         Path:=P; ClrEOL; END
  595.   else If (Length(Path)=1) or (Length(Path)>1) and (Path[2] <> ':') then
  596.         BEGIN Beep; GotoXY(45,1); write('** USE ":", AS IN C:\WP\ **');
  597.         Path:=P; ClrEOL; END                                      else  BEGIN
  598.        If (Length(Path)>0) and (Path[Length(Path)] <> '\')          then
  599.   BEGIN REPEAT GotoXY(55,2); write('** MUST END WITH "\" **');
  600.         Beep; Beep; Delay(900); GotoXY(C,1); Read(Pedit);
  601.         Path:=Path+Pedit; C:=WhereX;
  602.         UNTIL (length(Path) < 1) or (Path[Length(Path)] = '\');
  603.         GotoXY(55,2); ClrEOL;   { delete error message }
  604.   END;
  605.  
  606.        If length(Path)=0 then Path:=P else P:=Path;
  607.   GotoXY(55,2); write('** Enter DOS filename **');
  608.  ClrEOL; GotoXY(55,3); ClrEOL; write('  (ENTER alone=Cancel)');
  609.  SStart:=(Start*2); SUsed:=(Used*2); Sector:=1; Track:=0;
  610.  REPEAT Increment(Track,Sector); SStart:=(SStart-1); UNTIL (SStart)<1;
  611.  GotoXY(45,1); ClrEOL; write(Path);  Read(Name); GotoXY(55,2); ClrEOL;
  612.   GotoXY(55,3); ClrEOL; GotoXY(45,1); ClrEOL; If length(Name)=0 then
  613.   BEGIN  write('** NO TRANSFER');  Beep; END  else
  614.   BEGIN Assign(FilVar,Path+Name); {$I-} Rewrite(FilVar) {$I+};
  615.    OK:=(IOresult=0); If not OK then
  616.      BEGIN Beep; write(Path+Name); P:='B:\'; GotoXY(55,2);
  617.      write('** DOS PATH\NAME ERROR **'); Beep;                          END
  618.  
  619. else BEGIN write('WRITING: ',Path+Name);
  620.   If SW then BEGIN S:=259; GotoXY(55,3); write(' (Enter=TXT format)    ');
  621.     Beep; GotoXY(58,2); ClrEOL; write('WP 4.2 Output? '); GetKeys(YorN,Z);
  622.     GotoXY(55,3); ClrEOL; GotoXY(58,2); write('OUTPUT FORMAT: ');
  623.     If UpCase(YorN)='Y' then BEGIN WP:=true; write('WP');           END
  624.                         else BEGIN WP:=false; write('TXT'); ClrEOL; END
  625.               END   else
  626.  BEGIN S:=0; {Hdr} GotoXY(58,2); write('OUTPUT FORMAT: BIN'); ClrEOL; END;
  627.   Transfer; write(FilVar,EF); { DOS End Of File marker.}
  628.    GotoXY(55,3); write('    ** DONE **'); ClrEOL;   END; Close(FilVar); END;
  629.    For N:=5 to 7 do BEGIN GotoXY(55,N); ClrEOL; END; { Erase any error msg.}
  630.   END; GotoXY(1,22); If DIRn=1 then Sector:=3 else Sector:=8;
  631.   GetSector('R','A',0,Sector,0,DidRead);
  632. END;  Beep;                                                                END;
  633.  
  634. procedure Help; BEGIN GotoXY(1,8); ClrEOL; GotoXY(1,9); { For TRANSFER screen.}
  635.   writeLn('** File names vary in length.  The end',
  636.      's are marked with a letter and ',chr(3),' mark. **');
  637.   writeLn('** SmartWriter (H',chr(3),' or h',chr(3),' after',
  638.      ' name) & DELETED files are noted on the right. **');
  639.   writeLn('** The BU column shows the file sizes in',
  640.      ' number of 1k byte Adam Blocks used. **');
  641.   writeLn('** F10 will ask you for a DOS path for ',
  642.      'the new DOS file (the default = B:\). **');
  643.   writeLn('** Next, you are asked for a DOS file na',
  644.      'me.  Hit Enter (w/o name) to Cancel. **');
  645.   writeLn('** Files can be transferred to BIN (as ',
  646.      'is) TXT, or WP (with margins) format. **');
  647.   writeLn('** Only Smartwriter files (H',chr(3),') can use ',
  648.      'the TXT or WP format- others use BIN. **');
  649.   writeLn('** TXT & WP formats change the "CR" ',
  650.      'code Adam uses to end lines, into a "LF" **');      ClrEOL;          END;
  651.  
  652. procedure RevealAndModify; FORWARD;  {Body of procedure follows PickFile}
  653.  
  654. procedure PickFile;        FORWARD;  {Called by the next two procedures }
  655.  
  656.  
  657. { Dir 2 sector has 8 bytes of Dir 1, so needs a different display subroutine
  658.   than Dir 1.  TByte=1st useable file, First=sector offset of Dir entry.    }
  659.  
  660. procedure DirOne; BEGIN Sector:=3; Track:=0; DIRn:= 1;
  661.     GetSector('R','A',0,Sector,Track,DidRead); TByte:=78; Tb:=TByte;
  662.       First:=0;    XDIR;  LiteName;          PickFile;                     END;
  663.  
  664. procedure DirTwo; BEGIN Sector:=8; Track:=0; DIRn:= 2;
  665.     GetSector('R','A',0,Sector,Track,DidRead);  TByte:=0; Tb:=TByte;
  666.       First:= 8;   XDIR;  LiteName;          PickFile;                     END;
  667.  
  668. procedure PickFile; var doit, Choice, EscChoice:char;
  669.  
  670. BEGIN       REPEAT           REPEAT
  671.   GetKeys(Choice,EscChoice); UNTIL Choice = chr(27); CASE EscChoice of
  672. 'I': BEGIN  If DIRn = 2 then BEGIN DirOne; END else END;         { PgUp }
  673. 'Q': BEGIN  If DIRn = 1 then BEGIN DirTwo; END else END;         { PgDn }
  674. 'H': If (TByte div 26) > 0 then     BEGIN Beep; DarkName;    { UP ARROW }
  675.    TByte:=TByte-26; Tb:=TByte; LiteName;        END;
  676. 'P': If (TByte+First) < 469 then    BEGIN Beep; DarkName;  { DOWN ARROW }
  677.    TByte:=TByte+26; Tb:=TByte; LiteName;        END;
  678. '=': BEGIN  Help; GetKeys(Z,Z); FixDIR;         END;     { HELP - **F3  }
  679. 'j': BEGIN  RevealAndModify;             END; { REVEAL LOOP - **Alt-F3  }
  680. 'b': BEGIN  DOSin2adam; DirOne; END; { DOS > Adam   DOS-IN - **Ctrl-F5  }
  681. 'D': BEGIN  Beep; SetUp; END;                        { TRANSFER - **F10 }
  682. END; {case} UNTIL (Choice=chr(27)) and (EscChoice='A');  { EXIT - **F7  }
  683.      REPEAT Beep; GotoXY(60,5); write('********************');
  684.             Beep; GotoXY(60,6); write('** REMOVE A: DISK **');
  685.             Beep; GotoXY(60,7); write('** Then hit Y key **');
  686.             GotoXY(60,8); write('********************'); GetKeys(YorN,Z);
  687.      UNTIL  UpCase(YorN) = 'Y';  GotoXY(1,24);  halt;                      END;
  688.  
  689.  
  690. procedure MainScreen;  BEGIN  If DIRn=1 then DirOne else DirTwo;           END;
  691.  
  692. procedure RevealAndModify;   BEGIN    ClrScr;  Choices;
  693. GetSector('R','A',0,Sector,Track,DidRead);     BigShow;
  694.    ShowChar;  ByteAtt(Tbyte,112);  TakeInstructions;     MainScreen;       END;
  695.  
  696.  
  697.             { ** DISKTALK STARTS HERE with MAIN TRANSFER PROGRAM ** }
  698.  
  699. BEGIN  Initialize; BigCursor;  ClrScr;  GotoXY(12,20); writeLn
  700.    ('DISK TALK, version 2.4 * Copyright 8/89 by John L. Wiley.');
  701.   GotoXY(32,22); writeLn('USE DISKTALK TO:');
  702.   writeLn('* TRANSFER files between an ADAM ',
  703.   'disk in Drive A:, and DOS in another Drive or,');
  704.     write('* REVEAL ADAM disk inner secrets ',
  705.   'and contents to change or repair them at will.');
  706.  
  707.   DiskCheck;  P:='B:\'; { Default DOS Path }  DIRn:=1; MainScreen;         END.
  708.