home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 17 / CD_ASCQ_17_101194.iso / dos / prg / demosrce / plasma / nonaliza.pas next >
Encoding:
Pascal/Delphi Source File  |  1994-04-11  |  12.8 KB  |  518 lines
  1. {$R-,V-,A+}
  2. UNIT NONALIZA;
  3.  
  4. INTERFACE
  5.  
  6. USES DOS;
  7.  
  8. FUNCTION  AdLib_Test:Boolean;
  9. FUNCTION  Load_Music(Filename:String):Byte;
  10. PROCEDURE Start_Music;
  11. PROCEDURE Pause_Music;
  12. PROCEDURE Continue_Music;
  13. PROCEDURE Stop_Music;
  14.  
  15. IMPLEMENTATION
  16.  
  17. CONST
  18.  
  19.    AdLib_Port=$388;
  20.  
  21.    Notes :Array[1..12] Of Word=
  22.    ($157,$16B,$181,$198,$1B0,$1CA,$1EA,$202,$220,$241,$263,$287);
  23.  
  24.    DecOp :Array[1..18] Of Byte=
  25.    (0,1,2,3,4,5,8,9,10,11,12,13,16,17,18,19,20,21);
  26.  
  27.    DecOp9:Array[1..9]  Of Byte=
  28.    (1,2,3,7,8,9,13,14,15);
  29.  
  30. TYPE
  31.  
  32.   SBIFormat =RECORD
  33.                Sound_Params,Level,Attack_Rate,
  34.                Release_Rate,Wave_Form         :Array[0..1] Of Byte;
  35.                Feedback                       :Byte;
  36.              END;
  37.  
  38.   NoteFormat=RECORD
  39.                Inst_Num,Sound_Num,Note_Num,Octa_Num:Byte;
  40.                Duration_Num:Word;
  41.              END;
  42.  
  43.   Mus       =^Data;
  44.   Data      =Array[1..65018] Of Byte;
  45.  
  46.  VAR
  47.    Load,
  48.    Start,
  49.    Pause,
  50.    Continue,
  51.    Stop           :Boolean;
  52.    I              :Byte;
  53.    Freq           :Word;
  54.    Int08,
  55.    OldInt08       :Pointer;
  56.    Activate_Music :Boolean;
  57.    File1          :File;
  58.    Filename       :String;
  59.    L_Inst         :Array[1..64] Of SBIFormat;
  60.    L_Note         :Array[1..9]  Of NoteFormat;
  61.    Max_Vol        :Array[1..9,0..2] Of Byte;
  62.    Len_VoiceH,
  63.    Len_VoiceL     :Byte;
  64.    Len_Voice,
  65.    Csr_Gene       :Word;
  66.    Csr_Beg,
  67.    Csr_End        :Array[1..9]  Of Word;
  68.    Csr_Voice      :Array[1..9]  Of LongInt;
  69.    Music          :Mus;
  70.    N_Inst,N_Sound,
  71.    N_Note,N_Octa  :Byte;
  72.    N_Duration     :Word;
  73.    Nber_Inst,
  74.    Nber_Voice,
  75.    Nber_Tick      :Byte;
  76.    Busy,AdLib_OK  :Boolean;
  77.    Name_Inst      :Array[1..64] Of String[8];
  78.    Nothing        :Array[1..100] Of Byte;
  79.    Cptr           :Byte;
  80.    Regs           :Registers;
  81.  
  82.  
  83.   PROCEDURE Write_FM(Reg,Val:Byte);
  84.    BEGIN
  85.      ASM
  86.        mov   dx, 388h
  87.        mov   al, Reg
  88.        out   dx, al
  89.        in    al, dx
  90.        in    al, dx
  91.        in    al, dx
  92.        in    al, dx
  93.        in    al, dx
  94.        in    al, dx
  95.        inc   dx
  96.        mov   al, Val
  97.        out   dx, al
  98.        in    al, dx
  99.        in    al, dx
  100.        in    al, dx
  101.        in    al, dx
  102.        in    al, dx
  103.        in    al, dx
  104.        in    al, dx
  105.        in    al, dx
  106.        in    al, dx
  107.        in    al, dx
  108.        in    al, dx
  109.        in    al, dx
  110.        in    al, dx
  111.        in    al, dx
  112.        in    al, dx
  113.        in    al, dx
  114.        in    al, dx
  115.        in    al, dx
  116.        in    al, dx
  117.        in    al, dx
  118.        in    al, dx
  119.        in    al, dx
  120.        in    al, dx
  121.        in    al, dx
  122.        in    al, dx
  123.        in    al, dx
  124.        in    al, dx
  125.        in    al, dx
  126.        in    al, dx
  127.        in    al, dx
  128.        in    al, dx
  129.        in    al, dx
  130.        in    al, dx
  131.        in    al, dx
  132.        in    al, dx
  133.      END;
  134.    END;
  135.  
  136.  
  137.   FUNCTION Read_FM:Byte;
  138.    BEGIN
  139.      ASM
  140.        mov  dx, 388h
  141.        in   al, dx
  142.        mov  @result, al
  143.      END;
  144.    END;
  145.  
  146.  
  147.   FUNCTION AdLib_Test:Boolean;
  148.    VAR
  149.      Res1,Res2,I:Byte;
  150.    BEGIN
  151.      Write_FM($01,$00);
  152.      Write_FM($04,$60);
  153.      Write_FM($04,$80);
  154.      Res1:=Read_FM;
  155.      Write_FM($02,$FF);
  156.      Write_FM($04,$21);
  157.      FOR I:=0 TO 200 DO;
  158.        Res2:=Read_FM;
  159.      Write_FM($04,$60);
  160.      Write_FM($04,$80);
  161.      IF (((Res1 AND $E0)=0) AND ((Res2 AND $E0)=$C0))
  162.      THEN AdLib_Test:=True
  163.      ELSE AdLib_Test:=False;
  164.    END;
  165.  
  166.  
  167.   PROCEDURE Initialization_9voices;
  168.    BEGIN
  169.      Write_FM($08,$00);
  170.      Write_FM($01,$20);
  171.      Write_FM($BD,$DF);
  172.    END;
  173.  
  174.  
  175.   PROCEDURE Stop_Note(Voice:Byte);
  176.    VAR
  177.      Reg:Byte;
  178.    BEGIN
  179.      Reg:=$B0+Voice-1;
  180.      Write_FM(Reg,0);
  181.    END;
  182.  
  183.  
  184.   PROCEDURE Play_Note(Voice:Byte;Code:Word;Octave:Byte);
  185.    VAR
  186.      Reg,Aux:Byte;
  187.    BEGIN
  188.      Reg:=$A0+Voice-1;
  189.      Write_FM(Reg,Notes[Code] And $FF);
  190.      Reg:=$B0+Voice-1;
  191.      Aux:=(Notes[Code] SHR 8) OR (Octave SHL 2) OR $20;
  192.      Write_FM(Reg,Aux);
  193.    END;
  194.  
  195.  
  196.   PROCEDURE Volume(Voice,Vol:Byte);
  197.    VAR
  198.      Reg   :Byte;
  199.      KSL,
  200.      TL    :Byte;
  201.    BEGIN
  202.      KSL:=Max_Vol[Voice,1] AND 192;
  203.      TL :=63-Vol;
  204.      Reg:=$40+DecOp[DecOp9[Voice]+3];
  205.      Write_FM(Reg,KSL OR TL);
  206.      IF Max_Vol[Voice,2]=1
  207.        THEN BEGIN
  208.               KSL:=Max_Vol[Voice,0] AND 192;
  209.               TL :=63-Vol;
  210.               Reg:=$40+DecOp[DecOp9[Voice]];
  211.               Write_FM(Reg,KSL OR TL);
  212.             END
  213.        ELSE Write_FM($40+DecOp[DecOp9[Voice]],Max_Vol[Voice,0]);
  214.    END;
  215.  
  216.  
  217.   PROCEDURE Change_Instrument(Voice:Byte; VAR Instrument:SBIFormat);
  218.    VAR
  219.      Operator:Byte;
  220.    BEGIN
  221.      Operator:=DecOP[DecOP9[Voice]];
  222.      Write_FM(Operator+$20,Instrument.Sound_Params[0]);
  223.      Max_Vol[Voice,0]:=Instrument.Level[0];
  224.      Write_FM(Operator+$60,Instrument.Attack_Rate[0]);
  225.      Write_FM(Operator+$80,Instrument.Release_Rate[0]);
  226.      Write_FM(Operator+$E0,Instrument.Wave_Form[0]);
  227.      Write_FM(Voice-1+$C0,Instrument.Feedback);
  228.      Max_Vol[Voice,2]:=Instrument.Feedback AND 1;
  229.      Operator:=DecOP[DecOP9[Voice]+3];
  230.      Write_FM(Operator+$20,Instrument.Sound_Params[1]);
  231.      Max_Vol[Voice,1]:=Instrument.Level[1];
  232.      Write_FM(Operator+$60,Instrument.Attack_Rate[1]);
  233.      Write_FM(Operator+$80,Instrument.Release_Rate[1]);
  234.      Write_FM(Operator+$E0,Instrument.Wave_Form[1]);
  235.    END;
  236.  
  237.  
  238.   FUNCTION Load_Music(Filename:String):Byte;
  239.    VAR
  240.      I     :Byte;
  241.      ChAux :String[4];
  242.    BEGIN
  243.      IF ((Load=False) OR (AdLib_OK=False))  {Chargement impossible}
  244.        THEN BEGIN
  245.               Load_Music:=1;
  246.               Exit;
  247.             END;
  248.      {$I-}
  249.      New(Music); {Pas assez de mémoire}
  250.      {$I+}
  251.      IF IOResult<>0
  252.      THEN BEGIN
  253.             Load_Music:=2;
  254.             Exit;
  255.           END;
  256.      Assign(File1,Filename);
  257.      {$I-}
  258.      Reset(File1,1);
  259.      {$I+}
  260.      IF IOResult<>0
  261.      THEN BEGIN
  262.             Dispose(Music);
  263.             Load_Music:=3; {Module non trouvé}
  264.             Exit;
  265.           END;
  266.      IF FileSize(File1)<129
  267.      THEN BEGIN
  268.             Dispose(Music);
  269.             Close(File1);
  270.             Load_Music:=4; {Taille du module incorrecte}
  271.             Exit;
  272.           END;
  273.      BlockRead(File1,Nothing[1],100);
  274.      IF ((Nothing[1]<>70) OR (Nothing[2]<>77) OR 
  275.          (Nothing[3]<>57) OR (Nothing[4]<>64))
  276.      THEN BEGIN
  277.             Dispose(Music);
  278.             Close(File1);
  279.             Load_Music:=5; {Signature FM9 non trouvée}
  280.             Exit;
  281.           END;
  282.      BlockRead(File1,Nber_Inst,1);
  283.      BlockRead(File1,Nber_Voice,1);
  284.      BlockRead(File1,Nber_Tick,1);
  285.      FOR I:=1 TO Nber_Inst DO
  286.        BEGIN
  287.          {$I-}
  288.          BlockRead(File1,Name_Inst[I][1],8);
  289.          BlockRead(File1,L_Inst[I],11);
  290.          {$I+}
  291.          IF IOResult<>0
  292.          THEN BEGIN
  293.                 Dispose(Music);
  294.                 Close(File1);
  295.                 Load_Music:=6; {Erreur dans instrument}
  296.                 Exit;
  297.               END;
  298.        END;
  299.      Csr_Gene:=1;
  300.      FOR I:=1 TO Nber_Voice DO
  301.       BEGIN
  302.         {$I-}
  303.         BlockRead(File1,Len_VoiceH,1);
  304.         BlockRead(File1,Len_VoiceL,1);
  305.         {$I+}
  306.         IF IOResult<>0
  307.         THEN BEGIN
  308.                Dispose(Music);
  309.                Close(File1);
  310.                Load_Music:=7; {Erreur dans taille voix}
  311.                Exit;
  312.              END;
  313.         Len_Voice:=Len_VoiceH*256+Len_VoiceL;
  314.         {$I-}
  315.         BlockRead(File1,Music^[Csr_Gene],Len_Voice);
  316.         {$I+}
  317.         IF IOResult<>0
  318.         THEN BEGIN
  319.                Dispose(Music);
  320.                Close(File1);
  321.                Load_Music:=8; {Erreur dans événement}
  322.                Exit;
  323.              END;
  324.         Csr_Beg[I]:=Csr_Gene;
  325.         Csr_End[I]:=Len_Voice+Csr_Gene-1;
  326.         Csr_Gene  :=Csr_End[I]+1;
  327.       END;
  328.      Close(File1);
  329.      Load_Music:=0;
  330.      Load      :=False;
  331.      Start     :=True;
  332.      Pause     :=False;
  333.      Continue  :=False;
  334.      Stop      :=False;
  335.      FOR I:=1 TO Nber_Voice DO
  336.       BEGIN
  337.         Csr_Voice[I]:=Csr_Beg[I]-5;
  338.         L_Note[I].Inst_Num    :=0;
  339.         L_Note[I].Sound_Num   :=64;
  340.         L_Note[I].Note_Num    :=15;
  341.         L_Note[I].Octa_Num    :=9;
  342.         L_Note[I].Duration_Num:=1;
  343.       END;
  344.    END;
  345.  
  346.  
  347.   {LE DRIVER JOUANT JUSQU'A 9 VOIX DE MUSIQUE FM EN TACHE DE FOND EN ETANT
  348.    APPELE PAR LE TIMER "FREQ" FOIS PAR SECONDE...}
  349.   PROCEDURE Driver_FM9;Interrupt; { DRIVER }
  350.    VAR
  351.      I:Byte;
  352.    BEGIN
  353.      Dec(Cptr);
  354.      IF Cptr=0
  355.      THEN BEGIN
  356.             Intr(103,Regs);
  357.             Cptr:=Nber_Tick Div 18;
  358.           END
  359.      ELSE Port[$20]:=$20;
  360.      IF ((Activate_Music=True) AND (Busy=False))
  361.      THEN BEGIN
  362.             Busy:=True;
  363.             FOR I:=1 TO Nber_Voice DO
  364.              BEGIN
  365.                Dec(L_Note[I].Duration_Num);
  366.                IF L_Note[I].Duration_Num<1
  367.                THEN BEGIN
  368.                       Inc(Csr_Voice[I],5);
  369.                       IF Csr_Voice[I]>Csr_End[I]
  370.                         THEN Csr_Voice[I]:=Csr_Beg[I];
  371.                       N_Inst    :=Music^[Csr_Voice[I]];
  372.                       N_Sound   :=Music^[Csr_Voice[I]+1];
  373.                       N_Note    :=Music^[Csr_Voice[I]+2] AND 15;
  374.                       N_Octa    :=Music^[Csr_Voice[I]+2] SHR 4;
  375.                       N_Duration:=Music^[Csr_Voice[I]+3]*256+
  376.                                   Music^[Csr_Voice[I]+4];
  377.                       Stop_Note(I);
  378.                       IF N_Inst<>L_Note[I].Inst_Num
  379.                       THEN BEGIN
  380.                              L_Note[I].Inst_Num:=N_Inst;
  381.                              L_Note[I].Sound_Num:=N_Sound;
  382.                              Change_Instrument(I,L_Inst[N_Inst]);
  383.                              Volume(I,N_Sound);
  384.                            END;
  385.                       IF N_Sound<>L_Note[I].Sound_Num
  386.                       THEN BEGIN
  387.                              L_Note[I].Sound_Num:=N_Sound;
  388.                              Volume(I,N_Sound);
  389.                            END;
  390.                       L_Note[I].Duration_Num:=N_Duration;
  391.                       IF N_Note<>13
  392.                         THEN Play_Note(I,N_Note,N_Octa);
  393.                     END;
  394.              END;
  395.           END;
  396.           Busy:=False;
  397.    END; { DRIVER }
  398.  
  399.  
  400.   PROCEDURE Load_FM9_Driver;
  401.    BEGIN
  402.      Freq:=1193180 Div Nber_Tick;
  403.      Cptr:=1;
  404.      InLine($FA);
  405.      Port[$43]:=$34;
  406.      Port[$40]:=Lo(Freq);
  407.      Port[$40]:=Hi(Freq);
  408.      GetIntVec($08,OldInt08);
  409.      Int08:=Ptr(Seg(Driver_FM9),Ofs(Driver_FM9));
  410.      SetIntVec(103,OldInt08);
  411.      SetIntVec($08,Int08);
  412.      Inline($FB);
  413.    END;
  414.  
  415.  
  416.   PROCEDURE Unload_FM9_Driver;
  417.    BEGIN
  418.      IF Stop=True
  419.      THEN BEGIN
  420.             InLine($FA);
  421.             Port[$43]:=$34;
  422.             Port[$40]:=0;
  423.             Port[$40]:=0;
  424.             GetIntVec(103,OldInt08);
  425.             SetIntVec($08,OldInt08);
  426.             InLine($FB);
  427.           END;
  428.      Dispose(Music);
  429.      Stop:=False;
  430.    END;
  431.  
  432.  
  433.   PROCEDURE Start_Music;
  434.    BEGIN
  435.      IF ((AdLib_OK=True) AND (Start=True))
  436.      THEN BEGIN
  437.             Load    :=False;
  438.             Start   :=False;
  439.             Pause   :=True;
  440.             Continue:=False;
  441.             Stop    :=True;
  442.             Initialization_9voices;
  443.             Load_FM9_Driver;
  444.             Activate_Music:=True;
  445.           END;
  446.    END;
  447.  
  448.  
  449.   PROCEDURE Stop_Music;
  450.    VAR
  451.      I:Byte;
  452.    BEGIN
  453.      IF AdLib_OK=True
  454.      THEN BEGIN
  455.             Activate_Music:=False;
  456.             IF Stop=True
  457.             THEN BEGIN
  458.                    FOR I:=1 TO Nber_Voice DO
  459.                     BEGIN
  460.                       Volume(I,0);
  461.                       Stop_Note(I);
  462.                     END;
  463.                     Unload_FM9_Driver;
  464.                   END;
  465.             Start   :=False;
  466.             Pause   :=False;
  467.             Continue:=False;
  468.             Load    :=True;
  469.           END;
  470.    END;
  471.  
  472.  
  473.   PROCEDURE Pause_Music;
  474.   VAR
  475.     I:Byte;
  476.    BEGIN
  477.      IF ((Adlib_OK=True) AND (Pause=True))
  478.      THEN BEGIN
  479.             Activate_Music:=False;
  480.             Load          :=False;
  481.             Start         :=False;
  482.             Pause         :=False;
  483.             Continue      :=True;
  484.             Stop          :=True;
  485.             FOR I:=1 TO Nber_Voice DO
  486.               Stop_Note(I);
  487.           END;
  488.    END;
  489.  
  490.  
  491.   PROCEDURE Continue_Music;
  492.    BEGIN
  493.      IF ((Adlib_OK=True) AND (Continue=True))
  494.      THEN BEGIN
  495.             Activate_Music:=True;
  496.             Load          :=False;
  497.             Start         :=False;
  498.             Pause         :=True;
  499.             Continue      :=False;
  500.             Stop          :=True;
  501.           END;
  502.    END;
  503.  
  504.  
  505.  
  506. BEGIN
  507.   AdLib_OK      :=False;
  508.   Activate_Music:=False;
  509.   Busy          :=False;
  510.   Load          :=True;
  511.   Start         :=False;
  512.   Pause         :=False;
  513.   Continue      :=False;
  514.   Stop          :=False;
  515.   IF AdLib_Test=True
  516.     THEN AdLib_OK:=True;
  517. END.
  518.