home *** CD-ROM | disk | FTP | other *** search
/ Intermedia 1998 January / inter1_98.iso / www / rozi / CMF.ZIP / CMF.PAS next >
Pascal/Delphi Source File  |  1996-01-22  |  9KB  |  399 lines
  1.  
  2. unit CMF; 
  3.  
  4. interface 
  5.  
  6. type CMozliweBledy=(COk, 
  7.                     CMaloPamieci, 
  8.                     CBladZwalniania, 
  9.                     CNieInstalowany, 
  10.                     CBrakPlikuCMF, 
  11.                     CZlyNaglowek, 
  12.                     CZaDuzoInstr, 
  13.                     CAktywnyUtwor, 
  14.                     CNieGral, 
  15.                     CNieByloPauzy); 
  16.  
  17. var CMFStatus:byte; 
  18.     CMF_blad:CMozliweBledy; 
  19.     CSBFMZainstalowany:boolean; 
  20.  
  21. procedure CInicjalizujSBFM; 
  22. function  CNumerWersjiSBFM:word; 
  23. procedure CUstawBajtStatusowySBFM; 
  24. function  CZaladujPlikCMF(spec:string):pointer; 
  25. procedure CUstawInstrumenty(start:pointer); 
  26. procedure CNastawZegarSBFM(czest:word); 
  27. procedure CTranspozycjaUtworu(polt:word); 
  28. procedure CZagrajCMF(g:pointer); 
  29. procedure CZakonczCMF; 
  30. procedure CResetujSBFM; 
  31. procedure CPauzaCMF; 
  32. procedure CWznowCMF; 
  33. procedure CZwolnijPamiecCMF(g:pointer); 
  34. function  CTytulCMF(g:pointer):string; 
  35. function  CKompozytorCMF(g:pointer):string; 
  36. function  CKomentarzCMF(g:pointer):string; 
  37. function  COpisBledu:string; 
  38.  
  39. implementation 
  40.  
  41. uses dos; 
  42.  
  43. type Naglowek=record 
  44.                Identyfikator:array[0..3] of char; 
  45.                Wersja       :word; 
  46.                Poloz_Instr  :word; 
  47.                Poloz_Muz    :word; 
  48.                Cwiercnuta   :word; 
  49.                Czestotliwosc:word; 
  50.                Poloz_Tytulu :word; 
  51.                Poloz_Kompoz :word; 
  52.                Poloz_Koment :word; 
  53.                Tab_kanalow  :array[0..15] of char; 
  54.                Instrumentow :word; 
  55.                Podst_Tempo  :word; 
  56.              end; 
  57.  
  58. var Int_CMF:byte; 
  59.     CStaraProcWyjscia:pointer; 
  60.  
  61.  
  62. function Istnieje(Plik:string):boolean; 
  63. var f:file; 
  64. begin 
  65.      assign(f,Plik); 
  66.      {$I-} 
  67.      reset(f); 
  68.      close(f); 
  69.      {$I+} 
  70.      Istnieje:=(IOresult=0) 
  71. end; 
  72.  
  73. procedure Zarezerwuj_pamiec(var gdzie:pointer;ile:longint); 
  74. var r:registers; 
  75.     ilosc:word; 
  76. begin 
  77.      ilosc:=(ile+15) shr 4; 
  78.      r.ah:=$48; 
  79.      r.bx:=ilosc; 
  80.      MsDos(r); 
  81.      if (r.bx<>ilosc) then CMF_blad:=CMaloPamieci 
  82.         else begin 
  83.                   CMF_blad:=COk; 
  84.                   gdzie:=ptr(r.ax,0) 
  85.              end 
  86.  
  87. end; 
  88.  
  89. procedure Zwolnij_pamiec(gdzie:pointer); 
  90. var r:registers; 
  91. begin 
  92.      r.ah:=$49; 
  93.      r.es:=seg(gdzie^); 
  94.      msdos(r); 
  95.      if (r.ax=7)or(r.ax=9) then CMF_blad:=CBladZwalniania 
  96. end; 
  97.  
  98. procedure CInicjalizujSBFM; 
  99.  
  100.  function Jest_sygnatura(p:pointer):boolean; 
  101.    type Sign=array[0..4] of char; 
  102.    const Znak:Sign='FMDRV'; 
  103.   begin 
  104.        Jest_sygnatura:=(Sign(p^)=Znak) 
  105.   end; 
  106.  
  107. var przerwanie:byte; 
  108.     wskaznik:pointer; 
  109.     rej:registers; 
  110.  
  111. begin 
  112.      CSBFMZainstalowany:=false; 
  113.      przerwanie:=$7F; 
  114.      repeat 
  115.            inc(przerwanie); 
  116.            getintvec(przerwanie,wskaznik); 
  117.            wskaznik:=ptr(seg(wskaznik^),$103); 
  118.      until 
  119.      (Jest_sygnatura(wskaznik))or(przerwanie=$C0); 
  120.      if Jest_sygnatura(wskaznik) 
  121.         then 
  122.             Int_CMF:=przerwanie 
  123.         else 
  124.             CMF_blad:=CNieInstalowany; 
  125.      if przerwanie=$C0 then exit; 
  126.      CSBFMZainstalowany:=true; 
  127.      rej.bx:=8; 
  128.      intr(Int_CMF,rej); 
  129.      if rej.ax<>0 then begin 
  130.                          CMF_blad:=CAktywnyUtwor; 
  131.                          exit 
  132.                        end 
  133.                        else CMF_blad:=COk 
  134. end; 
  135.  
  136. function CNumerWersjiSBFM:word; 
  137. var 
  138.      rej:registers; 
  139. begin 
  140.      rej.bx:=0; 
  141.      intr(Int_CMF,rej); 
  142.      CNumerWersjiSBFM:=rej.ax 
  143. end; 
  144.  
  145. procedure CUstawBajtStatusowySBFM; 
  146. var 
  147.      rej:registers; 
  148. begin 
  149.      rej.bx:=1; 
  150.      rej.dx:=seg(CMFStatus); 
  151.      rej.ax:=ofs(CMFStatus); 
  152.      intr(Int_CMF,rej) 
  153. end; 
  154.  
  155. function CZaladujPlikCMF(spec:string):pointer; 
  156. var 
  157.     f:file; 
  158.     rozmiar_pliku,blokow,wynik:word; 
  159.     wsk,miejsce:pointer; 
  160.     ident:string[4]; 
  161. begin 
  162.      if not(Istnieje(spec)) then 
  163.         begin 
  164.              CMF_blad:=CBrakPlikuCMF; 
  165.              exit 
  166.         end; 
  167.      assign(f,spec); 
  168.      reset(f,1); 
  169.      ident[0]:=#4; 
  170.      blockread(f,ident[1],4); 
  171.      seek(f,0); 
  172.      if ident<>'CTMF' then 
  173.         begin 
  174.              close(f); 
  175.              CMF_Blad:=CZlyNaglowek; 
  176.              exit 
  177.         end; 
  178.      rozmiar_pliku:=filesize(f); 
  179.      Zarezerwuj_pamiec(wsk,rozmiar_pliku); 
  180.      if CMF_blad<>COk then 
  181.         begin 
  182.              close(f); 
  183.              exit 
  184.         end; 
  185.       blokow:=0; 
  186.       repeat 
  187.        miejsce:=Ptr(seg(wsk^)+blokow*4096,ofs(wsk^)); 
  188.        blockread(f,miejsce^,$FFFF,wynik); 
  189.        Inc(Blokow) 
  190.       until wynik=0; 
  191.       close(f); 
  192.       CZaladujPlikCMF:=wsk; 
  193.       CMF_blad:=COk 
  194. end; 
  195.  
  196. procedure CUstawInstrumenty(start:pointer); 
  197. var 
  198.     rej:registers; 
  199. begin 
  200.     if Naglowek(start^).Instrumentow>128 
  201.        then begin 
  202.                  CMF_Blad:=CZaDuzoInstr; 
  203.                  exit 
  204.             end; 
  205.     rej.bx:=2; 
  206.     rej.cx:=Naglowek(start^).Instrumentow; 
  207.     rej.dx:=seg(start^); 
  208.     rej.ax:=ofs(start^)+Naglowek(start^).Poloz_instr; 
  209.     intr(Int_CMF,rej) 
  210. end; 
  211.  
  212. procedure CNastawZegarSBFM(czest:word); 
  213. var 
  214.     rej:registers; 
  215. begin 
  216.     rej.bx:=4; 
  217.     rej.ax:=1193180 div czest; 
  218.     intr(Int_CMF,rej) 
  219. end; 
  220.  
  221. procedure CTranspozycjaUtworu(polt:word); 
  222. var 
  223.     rej:registers; 
  224. begin 
  225.     rej.bx:=5; 
  226.     rej.bx:=polt; 
  227.     intr(Int_CMF,rej) 
  228. end; 
  229.  
  230. procedure CZagrajCMF(g:pointer); 
  231. var rej:registers; 
  232. begin 
  233.     CNastawZegarSBFM(Naglowek(g^).Czestotliwosc); 
  234.     CUstawInstrumenty(g); 
  235.     if CMF_blad<>COk then exit; 
  236.     rej.bx:=6; 
  237.     rej.dx:=seg(g^); 
  238.     rej.ax:=ofs(g^)+Naglowek(g^).Poloz_muz; 
  239.     intr(Int_CMF,rej); 
  240.     if rej.ax<>0 then CMF_blad:=CAktywnyUtwor
  241. end; 
  242.  
  243. procedure CZakonczCMF; 
  244. var 
  245.     rej:registers; 
  246. begin 
  247.     rej.bx:=7; 
  248.     intr(Int_CMF,rej); 
  249.     if rej.ax<>0 then CMF_blad:=CNieGral 
  250. end; 
  251.  
  252. procedure CResetujSBFM; 
  253. var 
  254.     rej:registers; 
  255. begin 
  256.     rej.bx:=8; 
  257.     intr(Int_CMF,rej); 
  258.     if rej.ax<>0 then CMF_blad:=CAktywnyUtwor 
  259.        else CMF_blad:=COk 
  260. end; 
  261.  
  262. procedure CPauzaCMF; 
  263. var 
  264.      rej:registers; 
  265. begin 
  266.     rej.bx:=9; 
  267.     intr(Int_CMF,rej); 
  268.     if rej.ax<>0 then CMF_blad:=CNieGral 
  269.        else CMF_blad:=COk 
  270. end; 
  271.  
  272. procedure CWznowCMF; 
  273. var 
  274.     rej:registers; 
  275. begin 
  276.     rej.bx:=10; 
  277.     intr(Int_CMF,rej); 
  278.     if rej.ax<>0 then CMF_blad:=CNieGral 
  279.        else CMF_blad:=COk 
  280. end; 
  281.  
  282. procedure CZwolnijPamiecCMF(g:pointer); 
  283. begin 
  284.     Zwolnij_pamiec(g) 
  285. end; 
  286.  
  287. function CTytulCMF(g:pointer):string; 
  288. var 
  289.     rob:string; 
  290.     licz:byte; 
  291.     pol_t_s,pol_t_o:word; 
  292. begin 
  293.   rob:=''; 
  294.   if Naglowek(g^).Poloz_tytulu>0 
  295.    then begin 
  296.     pol_t_s:=seg(g^); 
  297.     pol_t_o:=ofs(g^); 
  298.     pol_t_o:=pol_t_o+Naglowek(g^).Poloz_tytulu; 
  299.     licz:=0; 
  300.     repeat 
  301.       rob:=rob+chr(Mem[pol_t_s:pol_t_o+licz]); 
  302.       inc(licz) 
  303.     until 
  304.       chr(Mem[pol_t_s:pol_t_o+licz])=#0
  305.    end;
  306.    CTytulCMF:=rob
  307. end; 
  308.  
  309. function  CKompozytorCMF(g:pointer):string; 
  310. var 
  311.     rob:string; 
  312.     licz:byte; 
  313.     pol_k_s,pol_k_o:word; 
  314. begin 
  315.   rob:=''; 
  316.   if Naglowek(g^).Poloz_kompoz>0 
  317.    then begin 
  318.     pol_k_s:=seg(g^); 
  319.     pol_k_o:=ofs(g^); 
  320.     pol_k_o:=pol_k_o+Naglowek(g^).Poloz_kompoz; 
  321.     licz:=0; 
  322.     repeat 
  323.       rob:=rob+chr(Mem[pol_k_s:pol_k_o+licz]); 
  324.       inc(licz) 
  325.     until 
  326.       chr(Mem[pol_k_s:pol_k_o+licz])=#0
  327.    end; 
  328.   CKompozytorCMF:=rob 
  329. end; 
  330.  
  331. function  CKomentarzCMF(g:pointer):string; 
  332. var 
  333.     rob:string; 
  334.     licz:byte; 
  335.     pol_k_s,pol_k_o:word; 
  336. begin 
  337.   rob:=''; 
  338.   if Naglowek(g^).Poloz_koment>0 
  339.    then begin 
  340.     pol_k_s:=seg(g^); 
  341.     pol_k_o:=ofs(g^); 
  342.     pol_k_o:=pol_k_o+Naglowek(g^).Poloz_koment; 
  343.     licz:=0; 
  344.     repeat 
  345.       rob:=rob+chr(Mem[pol_k_s:pol_k_o+licz]); 
  346.       inc(licz) 
  347.     until 
  348.       chr(Mem[pol_k_s:pol_k_o+licz])=#0
  349.   end; 
  350.   CKomentarzCMF:=rob
  351. end; 
  352.  
  353. function COpisBledu:string; 
  354. begin 
  355.  case CMF_blad of 
  356.   COk            
  357.      :CopisBledu:='Ok'; 
  358.   CMaloPamieci   
  359.      :CopisBledu:='BÆZd allokacji pami■ci'; 
  360.   CBladZwalniania
  361.      :CopisBledu:='BÆZd zwalniania pami■ci'; 
  362.   CNieInstalowany
  363.      :CopisBledu:='Brak sterownika SBFM'; 
  364.   CBrakPlikuCMF  
  365.      :CopisBledu:='Brak wskazanego pliku'; 
  366.   CZlyNaglowek   
  367.      :CopisBledu:='ZÆy nagÆúwek pliku'; 
  368.   CZaDuzoInstr   
  369.      :CopisBledu:='Za du┐o instrumentúw'; 
  370.   CAktywnyUtwor  
  371.      :CopisBledu:='SBFM odtwarza utwúr'; 
  372.   CNieGral       
  373.      :CopisBledu:='Utwúr nie jest odtwarzany'; 
  374.   CNieByloPauzy  
  375.      :CopisBledu:='Utwúr nie byÆ zatrzymany'
  376.  end 
  377. end; 
  378.  
  379. {$F+} 
  380. procedure Procedura_wyjscia_CMF; 
  381. begin 
  382.      if CSBFMZainstalowany then 
  383.         begin 
  384.              CZakonczCMF; 
  385.              CResetujSBFM 
  386.         end;
  387.      ExitProc:=CStaraProcWyjscia
  388. end; 
  389. {$F-} 
  390.  
  391. begin 
  392.   CStaraProcWyjscia:=ExitProc; 
  393.   ExitProc:=@Procedura_wyjscia_CMF; 
  394.   CInicjalizujSBFM; 
  395.   CMFStatus:=0; 
  396.   if CMF_blad=COk then 
  397.      CUstawBajtStatusowySBFM
  398. end.
  399.