home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / mbug / mbug165.arc / TRAKCOPY.PAS < prev   
Pascal/Delphi Source File  |  1979-12-31  |  11KB  |  363 lines
  1. program disk_track_copy;
  2.  
  3. const
  4.     version = '2';
  5.     revision = '0';
  6.  
  7.     gc_num = 12;
  8.     track_mem_start = $3800;
  9.  
  10.     seldsk = 8;
  11.     settrk = 9;
  12.     setsec = 10;
  13.     setdma = 11;
  14.     read_r = 12;
  15.     write_r = 13;
  16.     selectdrive = 14;
  17.     getdefault = 25;
  18.  
  19. type
  20.     graphics_array = array [1..gc_num,0..15] of byte;
  21.     string_40 = string [40];
  22.  
  23. const
  24.     graphics_definition : graphics_array =
  25.       ({A} ($00,$00,$00,$00,$00,$3F,$7F,$70,$70,$70,$70,$00,$00,$00,$00,$00),
  26.        {B} ($00,$00,$00,$00,$00,$FF,$FF,$00,$00,$00,$00,$00,$00,$00,$00,$00),
  27.        {C} ($00,$00,$00,$00,$00,$F0,$F8,$38,$3C,$3E,$3E,$00,$00,$00,$00,$00),
  28.        {D} ($70,$70,$70,$70,$70,$70,$70,$70,$70,$70,$70,$00,$00,$00,$00,$00),
  29.        {E} ($3E,$3E,$3E,$3E,$3E,$3E,$3E,$3E,$3E,$3E,$3E,$00,$00,$00,$00,$00),
  30.        {F} ($70,$70,$70,$70,$7F,$3F,$01,$00,$00,$00,$00,$00,$00,$00,$00,$00),
  31.        {G} ($00,$00,$00,$00,$FF,$FF,$FF,$55,$00,$00,$00,$00,$00,$00,$00,$00),
  32.        {H} ($3E,$3E,$3E,$3E,$FE,$FE,$FC,$50,$00,$00,$00,$00,$00,$00,$00,$00),
  33.        {I} ($00,$00,$03,$0F,$3F,$FF,$3F,$0F,$03,$00,$00,$00,$00,$00,$00,$00),
  34.        {J} ($00,$00,$00,$00,$FF,$FF,$FF,$00,$00,$00,$00,$00,$00,$00,$00,$00),
  35.        {K} ($00,$00,$FF,$FF,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00),
  36.        {L} ($00,$00,$C0,$F0,$FC,$FF,$FC,$F0,$C0,$00,$00,$00,$00,$00,$00,$00));
  37.  
  38. var
  39.     track_mem : array [1..10,0..5119] of byte absolute track_mem_start;
  40.     graphics_characters : graphics_array absolute $FC10;
  41.     space_pcg : array [0..15] of byte absolute $FA00;
  42.     bdos_start : integer absolute 6;
  43.     source_num, destination_num, track, t_track, tr, max_track, i,
  44.       record_number, trans_record, dph_s, dph_d, track_mem_add
  45.         : integer;
  46.     default_drive, result : byte;
  47.     key : char;
  48.     disk_error, abort : boolean;
  49.  
  50. procedure load_inverse;
  51. begin
  52.     port[11]:=1;
  53.     for i:=$F000 to $F7FF do
  54.       mem[i+$800]:=not mem[i];
  55.     port[11]:=0;
  56. end;
  57.  
  58. procedure underline;
  59. begin
  60.     for i:=$FE10 to $FFA0 do
  61.       mem[i]:=not mem[i];
  62.     i:=$FE1A;
  63.     repeat
  64.       mem[i]:=$FF;
  65.       i:=i+16;
  66.     until i>$FFA0;
  67. end;
  68.  
  69. procedure cursor_off;
  70. begin
  71.     fillchar(space_pcg,16,0);
  72. end;
  73.  
  74. procedure write_pointer(at_x, at_y : integer; left : boolean);
  75. begin
  76.     gotoxy(at_x,at_y);
  77.     if left then write(^[')IJ'^['(')
  78.     else write(^[')JL'^['(');
  79. end;
  80.  
  81. procedure kill_pointer(at_x, at_y : integer);
  82. begin
  83.     gotoxy(at_x,at_y);
  84.     write('  ');
  85. end;
  86.  
  87. procedure border(at_x, at_y, l_x, l_y : integer);
  88. begin
  89.     lowvideo;
  90.     gotoxy(at_x,at_y); write('A');
  91.     for i:=3 to l_x do write('B');
  92.     write('C');
  93.     for i:=succ(at_y) to at_y+l_y-2 do
  94.       begin
  95.         gotoxy(at_x,i); write('D');
  96.         gotoxy(pred(at_x+l_x),i); write('E');
  97.       end;
  98.     gotoxy(at_x,pred(at_y+l_y)); write('F');
  99.     for i:=3 to l_x do write('G');
  100.     write('H');
  101.     normvideo;
  102. end;
  103.  
  104. procedure clr_section;
  105. begin
  106.     for i:=17 to 22 do
  107.       begin
  108.         gotoxy(17,i); write(' ':48);
  109.       end;
  110. end;
  111.  
  112. procedure check_kbd;
  113. var
  114.      test : byte;
  115. begin
  116.     test:=48;  { code for ESC key }
  117.     port[12]:=18;
  118.     port[13]:=test shr 4 and 3;
  119.     port[12]:=19;
  120.     port[13]:=test shl 4;
  121.     port[11]:=1;
  122.     port[12]:=16;
  123.     test:=port[13];
  124.     port[12]:=31;
  125.     port[13]:=31;
  126.     repeat
  127.       test:=port[12];
  128.     until test and $80<>0;
  129.     if test and $40<>0 then abort:=true;
  130.     port[11]:=0;
  131. end;
  132.  
  133. procedure error(message : string_40);
  134. begin
  135.     abort:=true;
  136.     clr_section;
  137.     gotoxy(18,17);
  138.     write(message);
  139.     gotoxy(18,19);
  140.     write('Press <RETURN> to continue ...');
  141.     repeat read(kbd,key); until key=^M;
  142. end;
  143.  
  144. procedure exit;
  145. begin
  146.     bdos(selectdrive,default_drive);
  147.     clr_section;
  148.     gotoxy(18,17);
  149.     write('If you have changed disks insert origional');
  150.     gotoxy(18,18);
  151.     write('disks and press <RETURN>.');
  152.     repeat read(kbd,key); until key=^M;
  153.     clrscr;
  154.     load_inverse;
  155.     halt;
  156. end;
  157.  
  158. procedure sectran(var dph : integer);
  159. begin
  160.     inline($21/*+$13/               {LD      HL,L0}
  161.            $E5/                     {PUSH    HL}
  162.            $2A/1/0/                 {LD      HL,(1)}
  163.            $11/$2D/0/               {LD      DE,2DH}
  164.            $19/                     {ADD     HL,DE}
  165.            $ED/$4B/record_number/   {LD      BC,(record_number)}
  166.            $ED/$5B/dph/             {LD      DE,(dph)}
  167.            $E9/                     {JP      (HL)}
  168.            $22/trans_record         {L0:LD   (trans_record),HL});
  169. end;
  170.  
  171. procedure read_track;
  172. begin
  173.     bios(seldsk,source_num);
  174.     bios(settrk,track);
  175.     track_mem_add:=0;
  176.     record_number:=0;
  177.     repeat
  178.       bios(setdma,addr(track_mem[tr,track_mem_add]));
  179.       sectran(dph_s);
  180.       bios(setsec,trans_record);
  181.       result:=bios(read_r);
  182.       if result<>0 then
  183.         error('Error in read from drive '+char(65+source_num)+'.');
  184.       record_number:=succ(record_number);
  185.       track_mem_add:=track_mem_add+128;
  186.     until (record_number>39) or abort;
  187. end;
  188.  
  189. procedure write_track;
  190. begin
  191.     bios(seldsk,destination_num);
  192.     bios(settrk,track);
  193.     track_mem_add:=0;
  194.     record_number:=0;
  195.     repeat
  196.       bios(setdma,addr(track_mem[tr,track_mem_add]));
  197.       sectran(dph_d);
  198.       bios(setsec,trans_record);
  199.       if record_number=39 then bios(write_r,1)
  200.       else if record_number and 3=0 then bios(write_r,2)
  201.       else bios(write_r,0);
  202.       record_number:=succ(record_number);
  203.       track_mem_add:=track_mem_add+128;
  204.     until (record_number>39) or abort;
  205. end;
  206.  
  207. begin
  208.     graphics_characters:=graphics_definition;
  209.     underline;
  210.     max_track:=trunc(((65536.0+bdos_start)-track_mem_start) / 5120);
  211.     default_drive:=bdos(getdefault);
  212.     repeat
  213.       repeat
  214.         clrscr;
  215.         cursor_off;
  216.         border(2,1,78,24);
  217.         gotoxy(14,3);
  218.         write('MicroBee TRAKCOPY v'+version+'.'+revision+
  219.               '   Written by Peter Broughton.');
  220.         gotoxy(13,4);
  221.         write(^[')KKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKK'+
  222.               ^['(');
  223.         border(11,6,20,9);
  224.         gotoxy(18,7); write('SOURCE');
  225.         gotoxy(13,8); write(^[')KKKKKKKKKKKKKKKK'^['(');
  226.         border(51,6,20,9);
  227.         gotoxy(55,7); write('DESTINATION');
  228.         gotoxy(53,8); write(^[')KKKKKKKKKKKKKKKK'^['(');
  229.         gotoxy(32,10); write(^[')JJJJJJJJJJJJJJJJJL'^['(');
  230.         border(16,16,50,8);
  231.         gotoxy(18,17); write('Press : <E> to move up.');
  232.         gotoxy(26,18); write('<X> to move down.');
  233.         gotoxy(26,19); write('<RETURN> to select device.');
  234.         gotoxy(26,20); write('<ESC> to quit.');
  235.         for i:=1 to 4 do
  236.           begin
  237.             gotoxy(15,8+i); write('drive ',char(i+64));
  238.           end;
  239.         i:=0;
  240.         repeat
  241.           write_pointer(25,i+9,true);
  242.           read(kbd,key);
  243.           case upcase(key) of
  244.             'E' : if i>0 then begin kill_pointer(25,i+9); i:=pred(i); end;
  245.             'X' : if i<3 then begin kill_pointer(25,i+9); i:=succ(i); end;
  246.             ^[  : exit;
  247.           end;
  248.         until key=^M;
  249.         source_num:=i;
  250.         for i:=0 to 3 do
  251.           begin
  252.             gotoxy(59,i+9); write('drive ',char(i+65));
  253.           end;
  254.         i:=0;
  255.         repeat
  256.           write_pointer(54,i+9,false);
  257.           read(kbd,key);
  258.           case upcase(key) of
  259.             'E' : if i>0 then begin kill_pointer(54,i+9); i:=pred(i); end;
  260.             'X' : if i<3 then begin kill_pointer(54,i+9); i:=succ(i); end;
  261.             ^[  : exit;
  262.           end;
  263.         until key=^M;
  264.         destination_num:=i;
  265.         clr_section;
  266.         gotoxy(18,17);
  267.         write('Copying from drive ',char(source_num+65),
  268.               ' to drive ',char(destination_num+65),' :');
  269.         gotoxy(18,18); write('Press : <RETURN> to start copying.');
  270.         gotoxy(26,19); write('<ESC> to quit.');
  271.         gotoxy(26,20); write('<SPACE> to change.');
  272.         repeat read(kbd,key); until key in [^M,^[,' '];
  273.         if key=^[ then exit;
  274.         if key=^M then
  275.           begin
  276.             clr_section;
  277.             if source_num<>destination_num then
  278.               begin
  279.                 gotoxy(18,17); write('Insert disks and press <RETURN>.');
  280.                 repeat read(kbd,key); until key=^M;
  281.                 gotoxy(18,19);
  282.                 write('Warning! Data on disk in drive ',
  283.                        char(destination_num+65),' will be lost.');
  284.               end
  285.             else
  286.               begin
  287.                 gotoxy(18,19);
  288.                 write('Warning! Data on destination disk will be lost.');
  289.               end;
  290.             gotoxy(18,20); write('Continue ( Y/N ) ?');
  291.             repeat
  292.               read(kbd,key);
  293.               key:=upcase(key);
  294.             until key in ['N','Y'];
  295.             if key<>'N' then key:=^M;
  296.           end;
  297.       until key=^M;
  298.       clr_section;
  299.       gotoxy(18,22); write('Hold down <ESC> to abort copy.');
  300.       abort:=false;
  301.       gotoxy(1,1);
  302.       dph_s:=bios(seldsk,source_num);
  303.       if dph_s=0 then
  304.         error('Illegal source disk specification.');
  305.       if (source_num<>destination_num) and not abort then
  306.         begin
  307.           dph_d:=bios(seldsk,destination_num);
  308.           if dph_d=0 then
  309.             error('Illegal destination disk specification.');
  310.           end;
  311.       track:=0;
  312.       while (track<80) and not abort do
  313.         begin
  314.           gotoxy(28,19); write('Reading track  --  ',track:2);
  315.           if source_num=destination_num then
  316.             begin
  317.               gotoxy(18,17);
  318.               write('Insert '^[')source'^['( disk and press <RETURN>.     ');
  319.               repeat read(kbd,key); until (key=^M) or (key=^[);
  320.               if key=^[ then exit;
  321.             end;
  322.           t_track:=track;
  323.           tr:=1;
  324.           repeat
  325.             check_kbd;
  326.             gotoxy(47,19); write(track:2);
  327.             read_track;
  328.             track:=succ(track);
  329.             tr:=succ(tr);
  330.           until (tr>max_track) or (track>79) or abort;
  331.           track:=t_track;
  332.           tr:=1;
  333.           if not abort then
  334.             begin
  335.               gotoxy(28,19); write('Writing track  --  ',track:2);
  336.               if source_num=destination_num then
  337.                 begin
  338.                   gotoxy(18,17);
  339.                   write('Insert '^[')destination'^['( disk and '+
  340.                         'press <RETURN>.');
  341.                   repeat read(kbd,key); until (key=^M) or (key=^[);
  342.                   if key=^[ then exit;
  343.                 end;
  344.               repeat
  345.                 check_kbd;
  346.                 gotoxy(47,19); write(track:2);
  347.                 write_track;
  348.                 track:=succ(track);
  349.                 tr:=succ(tr);
  350.               until (tr>max_track) or (track>79) or abort;
  351.             end;
  352.         end;
  353.       clr_section;
  354.       gotoxy(18,17); write('Copy ');
  355.       if abort then write('aborted.')
  356.       else write('completed.');
  357.       gotoxy(18,18); write('Press : <RETURN> for another copy.');
  358.       gotoxy(26,19); write('<ESC> to quit.');
  359.       repeat read(kbd,key); until (key=^M) or (key=^[);
  360.     until key=^[;
  361.     exit;
  362. end.
  363.