home *** CD-ROM | disk | FTP | other *** search
/ Chip 1998 March / Chip_1998-03_cd.bin / hry / Sinclair / SimDOS3 / ZX2PC.PAS < prev    next >
Pascal/Delphi Source File  |  1996-09-24  |  2KB  |  127 lines
  1. {$r-,s-,c-,v-,a+}
  2. uses crt;
  3. var pport:word;
  4.     p:array[0..50000]of byte;
  5.     f:file;
  6.     ii,a,b:byte;
  7.     lenp,len,i:word;
  8.     koniec:boolean;
  9.  
  10. function btt:byte;
  11. var i,bt,vl:byte;
  12. begin
  13.   if port[$60]=$1d then
  14.     koniec:=true
  15.   else
  16.   begin
  17.   bt:=0;
  18.   asm cli end;
  19.   for i:=0 to 7 do
  20.   begin
  21.    port[pport]:=255;
  22.    repeat
  23.     asm
  24.      mov dx,pport
  25.      add dx,1
  26.      in al,dx
  27.      and al,10100000b
  28.      xor al,128
  29.      mov vl,al
  30.      in al,$60
  31.      cmp al,$1d
  32.      jnz @dl
  33.      mov koniec,1
  34.      @dl:
  35.     end;
  36.  
  37.    until ((vl and 128)<>0) or koniec;
  38.    port[pport]:=0;
  39.    if koniec then exit;
  40. {   bt:=(bt shr 1) or  ((vl and 32)shl 2);}
  41.    bt:=(bt shl 1)or ((vl and 32)shr 5);
  42.    repeat
  43.     asm
  44.      mov dx,pport
  45.      add dx,1
  46.      in al,dx
  47.      and al,10100000b
  48.      xor al,128
  49.      mov vl,al
  50.     end;
  51.    until (vl and 128)=0;
  52.  
  53.   end;
  54. btt:=bt;
  55.  end;
  56. end;
  57.  
  58.  
  59. begin
  60.   koniec:=false;
  61.   assign(f,'c:\zxtape.ltp');
  62.   rewrite(f,1);
  63.   pport:=memw[0:$408];
  64.   write(#10#13'Run ZX program and press Enter :');
  65.   port[pport]:=0;
  66.   readln;
  67.   asm cli end;
  68.  repeat
  69.   asm cli end;
  70.  
  71.   a:=btt;
  72.   if koniec then
  73.   begin
  74.     close(f);
  75.     halt;
  76.   end;
  77.   b:=btt;
  78.   len:=word(a)+(word(b) shl 8);
  79.   writeln;
  80.   write(len-2:6,' ');
  81.   for i:=0 to len-1 do
  82.     p[i]:=btt;
  83.   lenp:=len-2;
  84.       a:=p[0];
  85.       if (a=0)and(lenp=17)then
  86.       begin
  87.            a:=p[1];
  88.            case a of
  89.             3:write('Bytes: ');
  90.             1:write('Number array: ');
  91.             2:write('Character array: ');
  92.             0:write('Program: ');
  93.             else writeln('░░░░░░░░░░░░░░░░');
  94.            end;
  95.            if a<4 then
  96.            begin
  97.             for i:=2 to 11 do
  98.             begin
  99.               write(chr(p[i]));
  100.             end;
  101.             case a of
  102.              0:begin
  103.                 ii:=p[15] and $c0;
  104.                 if ii=0 then write('  LINE ',p[14]+word(p[15]) shl 8);
  105.                end;
  106.              3:begin
  107.                 write('    CODE ',p[14]+word(p[15]) shl 8,',',p[12]+word(p[13]) shl 8);
  108.                end;
  109.             end;
  110.            end;
  111.       end else
  112.           writeln('▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒');
  113.  
  114.   blockwrite(f,lenp,2);
  115.   blockwrite(f,p,len);
  116.   asm sti end;
  117.   sound(1000);
  118.   delay(10);
  119.   nosound;
  120.  until koniec;
  121.   close(f);
  122.  
  123.  
  124.  
  125. end.
  126.  
  127.