home *** CD-ROM | disk | FTP | other *** search
/ Intermedia 1998 January / inter1_98.iso / www / rozi / POLI_SMP.ZIP / POLY.PAS < prev    next >
Pascal/Delphi Source File  |  1993-11-25  |  7KB  |  318 lines
  1. program PolyPlayer;
  2.  
  3. { Polifoniczne odtwarzanie próbek d½wi⌐kowych }
  4.  
  5. {$G+} { Instrukcje 286 }
  6.  
  7. uses Dos;
  8.  
  9. const
  10.  
  11.   {Tablica cz⌐stotliwoÿci d½wi⌐ków poszczególnych klawiszy}
  12.  
  13.   keyboard : array[1..50] of word =
  14.   (   0,    0, 9441,10597,    0,
  15.   12602,14145,15877,    0,18881,
  16.   21193,    0,    0,    0,    0, 
  17.    8911,10002,11227,11894,13351,
  18.   14986,16821,17821,20004,22453,
  19.       0,    0,    0,    0,    0,
  20.    4720, 5298,    0, 6301, 7072, 
  21.    7939,    0,    0,    0,    0,
  22.       0,    0,    0, 4455, 5001, 
  23.    5613, 5947, 6675, 7493, 8411);
  24.  
  25. type
  26.   smp = array[1..65535] of byte;
  27.  
  28. var
  29.   f : file;
  30.   basefrq : word;
  31.  
  32.   c1pos,c2pos,c3pos,c4pos : longint;
  33.   cmax : longint;
  34.   c1frq,c2frq,c3frq,c4frq : longint;
  35.   c1val,c2val,c3val,c4val : byte;
  36.  
  37.   sample : ^smp;
  38.   old8 : pointer;
  39.   p60,akey : byte;
  40.  
  41. procedure EnableIrq0; assembler;
  42. { WêÑczenie przerwania IRQ0 }
  43. asm
  44.   in al,21h
  45.   and al,254
  46.   out 21h,al
  47. end;
  48.  
  49. procedure DisableIrq0; assembler;
  50. { WyêÑczenie przerwania IRQ0 }
  51. asm
  52.   in al,21h
  53.   or al,1
  54.   out 21h,al
  55. end;
  56.  
  57. procedure EnableIrq1; assembler;
  58. { WêÑczenie przerwania IRQ1 }
  59. asm
  60.   in al,21h
  61.   and al,253
  62.   out 21h,al
  63. end;
  64.  
  65. procedure DisableIrq1; assembler;
  66. { WyêÑczenie przerwania IRQ1 }
  67. asm
  68.   in al,21h
  69.   or al,2
  70.   out 21h,al
  71. end;
  72.  
  73. procedure TimerInit; assembler;
  74. { Inicjacja timera }
  75. asm
  76.   mov al,34h
  77.   out 43h,al
  78. end;
  79.  
  80. procedure InitFreq(frq : word); assembler;
  81. { Ustalenie cz⌐stotliwoÿci }
  82. asm
  83.   mov ax,[frq]
  84.   out 40h,al
  85.   mov al,ah
  86.   out 40h,al
  87. end;
  88.  
  89. {$F+}
  90. procedure Play; interrupt;
  91. begin
  92.   asm
  93.     cli
  94.     les ax,sample            { adres sampla do ES:DI }
  95.     mov bx,es
  96.     mov dx,ax
  97.     and ax,15
  98.     mov di,ax
  99.     shr dx,4
  100.     add bx,dx
  101.     mov es,bx
  102.     mov ax,word ptr c1pos+2  { C1POS<C1MAX ? }
  103.     cmp ax,word ptr cmax+2
  104.     ja @ToBig1               { tak - za du╛y }
  105.     jne @Ok1
  106.     mov ax,word ptr c1pos
  107.     cmp ax,word ptr cmax
  108.     ja @ToBig1               { tak - za du╛y }
  109. @Ok1:                        { ok }
  110.     mov ax,word ptr c1pos    { obliczamy pozycj⌐ }
  111.     mov dx,word ptr c1pos+2  { C1POS => DX:AX }
  112.     shr ax,14                { DX:AX / 16384 }
  113.     shl dx,2
  114.     add ax,dx
  115.     mov si,di
  116.     add si,ax
  117.     mov al,[es:si]           { pobieramy próbk⌐ }
  118.     mov [c1val],al
  119.     mov ax,word ptr c1frq    { C1POS := C1POS + C1FRQ }
  120.     add word ptr c1pos,ax
  121.     adc word ptr c1pos+2,0
  122. @ToBig1:
  123.     mov ax,word ptr c2pos+2  { i tak samo dla 
  124.                                dalszych 3 kanaêów }
  125.     cmp ax,word ptr cmax+2
  126.     ja @ToBig2
  127.     jne @Ok2
  128.     mov ax,word ptr c2pos
  129.     cmp ax,word ptr cmax
  130.     ja @ToBig2
  131. @Ok2:
  132.     mov ax,word ptr c2pos
  133.     mov dx,word ptr c2pos+2
  134.     shr ax,14
  135.     shl dx,2
  136.     add ax,dx
  137.     mov si,di
  138.     add si,ax
  139.     mov al,[es:si]
  140.     mov [c2val],al
  141.     mov ax,word ptr c2frq
  142.     add word ptr c2pos,ax
  143.     adc word ptr c2pos+2,0
  144. @ToBig2:
  145.     mov ax,word ptr c3pos+2
  146.     cmp ax,word ptr cmax+2
  147.     ja @ToBig3
  148.     jne @Ok3
  149.     mov ax,word ptr c3pos
  150.     cmp ax,word ptr cmax
  151.     ja @ToBig3
  152. @Ok3:
  153.     mov ax,word ptr c3pos
  154.     mov dx,word ptr c3pos+2
  155.     shr ax,14
  156.     shl dx,2
  157.     add ax,dx
  158.     mov si,di
  159.     add si,ax
  160.     mov al,[es:si]
  161.     mov [c3val],al
  162.     mov ax,word ptr c3frq
  163.     add word ptr c3pos,ax
  164.     adc word ptr c3pos+2,0
  165. @ToBig3:
  166.     mov ax,word ptr c4pos+2
  167.     cmp ax,word ptr cmax+2
  168.     ja @ToBig4
  169.     jne @Ok4
  170.     mov ax,word ptr c4pos
  171.     cmp ax,word ptr cmax
  172.     ja @ToBig4
  173. @Ok4:
  174.     mov ax,word ptr c4pos
  175.     mov dx,word ptr c4pos+2
  176.     shr ax,14
  177.     shl dx,2
  178.     add ax,dx
  179.     mov si,di
  180.     add si,ax
  181.     mov al,[es:si]
  182.     mov [c4val],al
  183.     mov ax,word ptr c4frq
  184.     add word ptr c4pos,ax
  185.     adc word ptr c4pos+2,0
  186. @ToBig4:
  187.     xor bh,bh
  188.     mov ax,0                 { sumujemy wartoÿci 
  189.                                z czerech kanaêów }
  190.     mov bl,c1val
  191.     add ax,bx
  192.     mov bl,c2val
  193.     add ax,bx
  194.     mov bl,c3val
  195.     add ax,bx
  196.     mov bl,c4val
  197.     add ax,bx
  198.     shr ax,2                 { i dzielimy przez 4 }
  199.  
  200. { tu mo╛e byå umieszczona procedura do obsêugi }
  201. { urzÑdzenia wyjÿciowego }
  202.  
  203.     mov dx,378h
  204.     out dx,al                { do portu LPT1 ("Covox") }
  205.  
  206.     mov al,20h               { zakoΣczenie obsêugi przerwania }
  207.     out 20h,al
  208.     sti
  209.   end;
  210. end;
  211. {$F-}
  212.  
  213. begin
  214.   new(sample);
  215.  
  216.   writeln('Polifoniczne odtwarzanie sampli.');
  217.  
  218.   if paramstr(1)='' then
  219.   begin
  220.     writeln('U╛ycie: POLYPLAY <nazwa_sampla>'); halt;
  221.   end;
  222.  
  223.   basefrq := 16384;
  224.  
  225.   assign(f,paramstr(1));
  226.   {$I-}
  227.   reset(f,1);
  228.   {$I+}
  229.   if ioresult<>0 then
  230.   begin
  231.     writeln('U╛ycie: POLYPLAY <nazwa_sampla>'); halt;
  232.   end;
  233.  
  234.   if filesize(f)>65535 then
  235.   begin
  236.     writeln('Maksymalna dêugoÿå próbki 65535 bajtów.'); 
  237.     halt;
  238.   end;
  239.  
  240.   cmax := filesize(f)*basefrq;
  241.  
  242.   {$I-}
  243.   blockread(f,sample^,filesize(f));
  244.   close(f);
  245.   {$I+}
  246.   if ioresult<>0 then
  247.   begin
  248.     writeln('BêÑd odczytu !'); halt;
  249.   end;
  250.  
  251.   c1pos := 1;  c2pos := 1;
  252.   c3pos := 1;  c4pos := 1;
  253.  
  254.   c1frq := 0;  c2frq := 0;
  255.   c3frq := 0;  c4frq := 0;
  256.  
  257.   akey := 0;
  258.  
  259.   write('Escape - przerwanie odtwarzania.');
  260.  
  261.   DisableIrq1;          { wyêÑczamy klawiatur⌐ }
  262.   GetIntVec(8,old8);    { pobieramy wektor IRQ0 }
  263.   DisableIrq0;          { wyêÑczamy IRQ 0 }
  264.   SetIntVec(8,@Play);   { ustawiamy wektor na Play }
  265.   TimerInit;            { inicjujemy licznik }
  266.   InitFreq(trunc(1193180/basefrq));  
  267.                         { ustalamy cz⌐stotliwoÿå }
  268.   EnableIrq0;           { wêÑczamy IRQ0 }
  269.  
  270.   repeat
  271.  
  272.     p60 := port[$60];   { pobierz waroÿå bezpoÿr. 
  273.                           z portu klawiatury }
  274.  
  275.     while port[$60]=p60 do; { czekaj na zmian⌐ warotÿci }
  276.  
  277.     p60 := port[$60];   { pobierz jÑ }
  278.  
  279.     if (p60>1)and(p60<50)and(keyboard[p60]<>0) then 
  280.                         { czy któryÿ }
  281.     begin               { z wêaÿciwych klawiszy ? }
  282.       inc(akey);        { akey - numer kanaêu, 
  283.                           zmieniany cyklicznie }
  284.       if akey=5 then akey := 1;
  285.       case akey of
  286.         1 : begin
  287.               c1frq := keyboard[p60]; 
  288.                         { ustalamy cz⌐stotliwoÿå }
  289.               c1pos := longint(c1frq); 
  290.                         { i poczÑtkowÑ pozycj⌐ }
  291.             end;
  292.         2 : begin
  293.               c2frq := keyboard[p60];
  294.               c2pos := longint(c2frq);
  295.             end;
  296.         3 : begin
  297.               c3frq := keyboard[p60];
  298.               c3pos := longint(c3frq);
  299.             end;
  300.         4 : begin
  301.               c4frq := keyboard[p60];
  302.               c4pos := longint(c4frq);
  303.             end;
  304.       end;
  305.     end;
  306.   until p60=1; { Escape (kod 1) - koniec }
  307.   asm cli end;
  308.   DisableIrq0; { odtworzenie poczÑtkowych wartoÿci IRQ0 }
  309.   asm sti end;
  310.   TimerInit;
  311.   InitFreq(0);
  312.   SetIntVec(8,old8);
  313.   EnableIrq0;
  314.   EnableIrq1;
  315.   dispose(sample);
  316.   writeln;
  317. end.
  318.