Sound, Music & MIDI Collection 2/SMMVOL2.bin/DOS/SS_PLAY/VTSRC12B.ZIP/VTPLAY.PAS

Pascal/Delphi Source File | 1993-03-21 | 20.6 KB | 811 lines

UNIT VTPlay;

INTERFACE

USES VTGlobal, VTWins, VTStrConst, StrConst,
     SongUnit, SongElements, PlayMod,
     Output43, vid43,
     Filters, Debugging;




{----------------------------------------------------------------------------}
{ Definiciones generales                                                     }
{____________________________________________________________________________}

PROCEDURE InitPlayData(VAR Song: TSong);




{----------------------------------------------------------------------------}
{ Definiciones para la ventana de información de posición.                   }
{____________________________________________________________________________}

VAR
  LastFilterOn,
  LastFilterOff : TFilterMethod;
  LastFilter    : BOOLEAN;

PROCEDURE UpdateRunInfo(spd, patt, pos, seq, PSize: WORD);




{----------------------------------------------------------------------------}
{ Definiciones para las barras de vúmetros.                                  }
{____________________________________________________________________________}

VAR
  barlen         : ARRAY[1..MaxChannels] OF BYTE;
  barofs         : ARRAY[1..4]           OF WORD;

PROCEDURE UpdateBars;

PROCEDURE ParseBarInit(VAR nt: TFullNote; i: WORD);




{----------------------------------------------------------------------------}
{ Definiciones para las ventanas de información de notas.                    }
{____________________________________________________________________________}

VAR
  SampleStrings : ARRAY[1..99] OF STRING[24];
  VolumeStrings : ARRAY[0..64] OF STRING[2];

  DispVolumes   : ARRAY[1..MaxChannels] OF BYTE;
  DispNotes     : ARRAY[1..MaxChannels] OF TFullNote;
  RealVolumes   : ARRAY[1..MaxChannels] OF BYTE;
  RealNotes     : ARRAY[1..MaxChannels] OF TFullNote;

  DispSplName   : ARRAY[1..MaxChannels] OF BYTE;

PROCEDURE UpdateNoteInfo(VAR Song: TSong; VAR nt: TFullNote; i: WORD);

PROCEDURE Update2ndLine(NewNote: BOOLEAN);




{----------------------------------------------------------------------------}
{ Definiciones para las ventanas de información de samples.                  }
{____________________________________________________________________________}

VAR
  DispSamples   : ARRAY[1..31] OF BYTE;
  RealSamples   : ARRAY[1..31] OF BYTE;

  siPermiso     : BOOLEAN;                  { Sample information }
  siTickForce   : BOOLEAN;
  siCounter     : BYTE;

CONST
  sfNoSample = 0;
  sfNotUsed  = 1;
  sfUsed     = 2;
  sfNowUsed  = 3;
  sfFlashing = 4;

PROCEDURE UpdateSampleInfo(VAR Song: TSong; VAR nt: TFullNote; i: WORD);

PROCEDURE TickSampleInfo;

PROCEDURE SampleAttr(s, a: BYTE);




{----------------------------------------------------------------------------}
{ Definiciones para la ventana de osciloscopio.                              }
{____________________________________________________________________________}

VAR
  OscWinBuff    : ARRAY[1..16, 1..51*2] OF CHAR;
  OscSamples    : ARRAY[1..700] OF INTEGER;

PROCEDURE UpdateOscilloscInfo;




{----------------------------------------------------------------------------}
{ Definiciones para la ventana de canal on/off.                              }
{____________________________________________________________________________}

VAR
  DispPermisos   : ARRAY[1..4] OF BOOLEAN;

PROCEDURE UpdateOnOff;




IMPLEMENTATION

USES SongUtils;




{----------------------------------------------------------------------------}
{ Implementación de la ventana de información de posición.                   }
{____________________________________________________________________________}

PROCEDURE UpdateRunInfo(spd, patt, pos, seq, PSize: WORD);
  CONST
    s    : STRING   = '';
    aon  : BYTE     = 0;
    aoff : BYTE     = 0;
  BEGIN

    WITH wRunInfo DO
      IF wTopLine.vis AND wTopLine.act THEN BEGIN
        IF pos > 99 THEN pos := 1;
        STR(seq   : 3, s); DirectWrite (ParseCoords(x+wriX1,   y+1), s);
        STR(patt  : 3, s); DirectWrite (ParseCoords(x+wriX1,   y+2), s);
        STR(pos   : 3, s); DirectWrite (ParseCoords(x+wriX1,   y+3), s);
        STR(PSize : 3, s); DirectWrite (ParseCoords(x+wriX2,   y+3), s);
        STR(spd   : 3, s); DirectWrite (ParseCoords(x+wriX1,   y+4), s);

        IF (LastFilter    <> FilterIsOn) OR
           (LastFilterOn  <> FilterOn)   OR
           (LastFilterOff <> FilterOff)  OR wTopLine.forz THEN BEGIN
          IF FilterIsOn THEN BEGIN
            aon  := BYTE(col[4]);
            aoff := BYTE(col[2]);
          END ELSE BEGIN
            aon  := BYTE(col[2]);
            aoff := BYTE(col[4]);
          END;
          s[0] := #1;
          s[1] := CHAR(ORD(FilterOn)  + ORD('0'));
          DirectWriteAttr(ParseCoords(x+wriX2+1, y+4), s, aon);
          s[1] := CHAR(ORD(FilterOff) + ORD('0'));
          DirectWriteAttr(ParseCoords(x+wriX2+2, y+4), s, aoff);
          LastFilter    := FilterIsOn;
          LastFilterOn  := FilterOn;
          LastFilterOff := FilterOff;
        END;

      END;

  END;




{----------------------------------------------------------------------------}
{ Implementación de las barras de vúmetros.                                  }
{____________________________________________________________________________}

PROCEDURE MyWriteBar; ASSEMBLER;
  ASM
        MOV     BH,w2ndLine.act
        AND     BH,w2ndLine.vis
        AND     BH,BH
        JZ      @@fin

        MOV     BL,BYTE PTR [wPlayBars.col+1]
        MOV     AX,WORD PTR [wPlayBars.col+2]
        MOV     CL,BarVal

        MOV     DH,13
        MOV     CH,16
        AND     DL,DL
        JZ      @@floop
@@gloop: MOV    BYTE PTR [ES:SI+1],AL
         MOV    BYTE PTR [ES:SI],CL
         DEC    DL
         JNZ    @@nofr1

         INC    BYTE PTR [ES:SI]
         INC    SI
         INC    SI
         DEC    CH
         JMP    @@floop

@@nofr1: INC    SI
         INC    SI
         DEC    CH
         DEC    DL
         JZ     @@floop
         DEC    DH
         JNZ     @@gloop

@@rloop: MOV    BYTE PTR [ES:SI+1],AH
         MOV    BYTE PTR [ES:SI],CL
         DEC    DL
         JNZ    @@nofr2

         INC    BYTE PTR [ES:SI]
         INC    SI
         INC    SI
         DEC    CH
         JZ     @@fin
         JMP    @@floop

@@nofr2: INC    SI
         INC    SI
         DEC    CH
         JZ     @@fin
         DEC    DL
         JNZ     @@rloop

@@floop: MOV    BYTE PTR [ES:SI],CL
         INC    SI
         MOV    BYTE PTR [ES:SI],BL
         INC    SI
         DEC    CH
         JNZ     @@floop
@@fin:
  END;




PROCEDURE WriteBar(i: WORD); ASSEMBLER;
  ASM
        MOV     AX,i
        DEC     AX
        MOV     BX,OFFSET barlen
        ADD     BX,AX
        MOV     DL,[BX]
        INC     AL
        SUB     AL,[FirstChannel]
        JC      @@Fin
        CMP     AL,4
        JAE     @@Fin
        MOV     SI,ScrSegment
        CMP     SI,$A000
        JC      @@Fin
        MOV     ES,SI
        MOV     SI,OFFSET barofs
        ADD     SI,AX
        ADD     SI,AX
        MOV     SI,[SI]
        CALL    MyWriteBar
@@Fin:
  END;




PROCEDURE InitBar(i, l: WORD);
  BEGIN
    IF l > 32 THEN l := 32;
    barlen[i] := l+1;
    IF Permisos[i] THEN WriteBar(i);
  END;



PROCEDURE UpdateBars;
  CONST
    i : WORD = 0;
  BEGIN
    FOR i := 1 TO MaxChannels DO
      BEGIN
      IF barlen[i] > 0 THEN
        BEGIN
          DEC(barlen[i]);
          IF Permisos[i] AND wPlayBars.act AND wPlayBars.vis THEN
            WriteBar(i);
        END
      ELSE
        IF wPlayBars.act AND wPlayBars.vis THEN
          WriteBar(i);
      END;
  END;

(*
PROCEDURE UpdateBars; ASSEMBLER;
  ASM
        MOV     ES,ScrSegment

        MOV     CX,4
        MOV     BX,OFFSET Permisos
        MOV     SI,OFFSET barlen
        MOV     DI,OFFSET barofs
@@loop:  XOR    DL,DL
         MOV    AL,[BX]
         AND    AL,AL
         JZ     @@DoWrite
         MOV    DL,[SI]
         AND    DL,DL
         JNZ    @@dodec

         MOV    AL,[wPlayBars.forz]
         OR     AL,[w2ndLine.forz]
         OR     AL,AL
         JNZ    @@DoWrite
         JMP    @@next

@@dodec:  DEC   BYTE PTR [SI]
          DEC   DL
@@DoWrite:PUSH  BX
          PUSH  CX
          PUSH  SI
          MOV   SI,[DI]
          CALL  MyWriteBar
          POP   SI
          POP   CX
          POP   BX
@@next:  INC    SI
         INC    DI
         INC    DI
         INC    BX
         DEC    CL
         JNZ    @@loop
  END;
*)



PROCEDURE ParseBarInit(VAR nt: TFullNote; i: WORD);
  BEGIN

    IF      nt.Command     = mcSetVolume THEN InitBar(i, nt.Parameter      SHR 1)
    ELSE IF nt.Instrument <> 0           THEN InitBar(i, Canales[i].Volume SHR 1)
    ELSE IF nt.Period     <> 0           THEN InitBar(i, RealVolumes[i]    SHR 1);

  END;




{----------------------------------------------------------------------------}
{ Implementación de las ventanas de información de notas.                    }
{____________________________________________________________________________}

PROCEDURE UpdateNoteInfo(VAR Song: TSong; VAR nt: TFullNote; i: WORD);
  CONST
    s        : STRING         = '';
    MySample : BYTE           = 0;
    vol      : WORD           = 0;
    f        : BOOLEAN        = FALSE;
    p        : PFullNote      = NIL;
    Instr    : PInstrumentRec = NIL;
  BEGIN
    IF w2ndLine.forz AND w2ndLine.vis AND w2ndLine.act AND
       (i >= FirstChannel) AND (i < FirstChannel+4)    THEN
      BEGIN
        STR(i : 2, s);
        WITH wChannelNum DO
          DirectWrite(ParseCoords(x+1, y+i-FirstChannel+1), s);

        IF NOT PlayMod.Permisos[i] THEN
          BEGIN
            WITH wInfoNote  DO DirectWrite(ParseCoords(x+1, y+i-FirstChannel+1), '                            ');
            WITH wRunSample DO DirectWrite(ParseCoords(x+1, y+i-FirstChannel+1), '                        ');
          END;
      END;

    p := @DispNotes[i];

    WITH RealNotes[i] DO BEGIN

      IF (nt.Period <> Period) AND (nt.Period <> 0) THEN
        Period := nt.Period
      ELSE
        Period := p^.Period;

      IF (nt.Instrument <> Instrument) AND (nt.Instrument <> 0) THEN
        Instrument := nt.Instrument
      ELSE
        Instrument := p^.Instrument;

      vol := $FFFF;

      IF (nt.Period <> 0) OR (nt.Instrument <> 0) THEN vol := Canales[i].Volume;
      IF nt.Command = mcSetVolume THEN vol := nt.Parameter;

      IF (vol <> $FFFF) AND (vol <> RealVolumes[i]) THEN
        RealVolumes[i] := vol
      ELSE
        vol := RealVolumes[i];

      IF w2ndLine.act AND w2ndLine.vis AND PlayMod.Permisos[i] THEN BEGIN
        IF w2ndLine.forz OR (p^.Period <> Period) THEN BEGIN
          IF Period <> 0 THEN
            BEGIN
              p^.Period := Period;

              IF (i >= FirstChannel) AND (i < FirstChannel+4) THEN
                BEGIN
                  NoteFreq(Period, s);
                  WITH wInfoNote DO DirectWrite(ParseCoords(x+winX1, y+i-FirstChannel+1), s);
                END;
            END;
        END;

        IF w2ndLine.forz OR (Instrument <> p^.Instrument) THEN BEGIN
          p^.Instrument := Instrument;
          IF (i >= FirstChannel) AND (i < FirstChannel+4) THEN
            WITH wInfoNote DO
              BEGIN
                Instr := PInstrument(Song.GetInstrument(p^.Instrument))^.Instr;
                IF Instr <> NIL THEN
                  BEGIN
                    STR(Instr^.reps : 6, s); DirectWrite(ParseCoords(x+winX3, y+i-FirstChannel+1), s);
                    STR(Instr^.repl : 6, s); DirectWrite(ParseCoords(x+winX4, y+i-FirstChannel+1), s);
                    STR(Instr^.len  : 6, s); DirectWrite(ParseCoords(x+winX5, y+i-FirstChannel+1), s);
                  END
                ELSE
                  BEGIN
                    DirectWrite(ParseCoords(x+winX3, y+i-FirstChannel+1), '      ');
                    DirectWrite(ParseCoords(x+winX4, y+i-FirstChannel+1), '      ');
                    DirectWrite(ParseCoords(x+winX5, y+i-FirstChannel+1), '     ');
                  END;
              END;
        END;

        IF w2ndLine.forz OR (Instrument <> DispSplName[i]) THEN BEGIN
          DispSplName[i]   := Instrument;
          IF (i >= FirstChannel) AND (i < FirstChannel+4) THEN
            WITH wRunSample DO
              IF Instrument <> 0 THEN
                DirectWrite(ParseCoords(x+1, y+i-FirstChannel+1), SampleStrings[Instrument])
              ELSE
                DirectWrite(ParseCoords(x+1, y+i-FirstChannel+1), '                        ');
        END;

        IF w2ndLine.forz OR (DispVolumes[i] <> vol) THEN BEGIN
          DispVolumes[i]   := vol;
          IF (i >= FirstChannel) AND (i < FirstChannel+4) THEN
            WITH wInfoNote DO
              IF DispVolumes[i] <> $FF THEN
                DirectWrite(ParseCoords(x+winX2, y+i-FirstChannel+1), VolumeStrings[vol])
              ELSE
                DirectWrite(ParseCoords(x+winX2, y+i-FirstChannel+1), '  ');
        END;

      END;
    END;
  END;




PROCEDURE SampleAttr(s, a: BYTE);
  BEGIN
    IF s > 15 THEN
      WITH wSamples2 DO RectAttr(ParseCoords(x+wsX1, y+s-15), 22, 1, a)
    ELSE
      WITH wSamples1 DO RectAttr(ParseCoords(x+wsX1, y+s),    22, 1, a);
  END;




PROCEDURE UpdateSampleInfo(VAR Song: TSong; VAR nt: TFullNote; i: WORD);
  CONST
    j      : WORD = 0;
  LABEL
    Passa;
  BEGIN
    IF i = 1 THEN BEGIN
      FOR j := 1 TO 31 DO
        IF RealSamples[j] >= sfNowUsed THEN
          RealSamples[j] := sfUsed;
    END;

    IF Permisos[i] AND (RealNotes[i].Instrument <> 0) THEN
      IF (nt.Instrument <> 0) OR (nt.Period <> 0) OR ((nt.Command = mcSetVolume) AND (nt.Parameter <> 0)) THEN
        RealSamples[RealNotes[i].Instrument] := sfFlashing
      ELSE
        IF RealSamples[RealNotes[i].Instrument] <> sfFlashing THEN
          RealSamples[RealNotes[i].Instrument] := sfNowUsed;

    IF i = Song.NumChannels THEN BEGIN
{
      siCounter := NoteSound^.Tempo-1;
      IF siCounter < 2 THEN siCounter := 2;
}
siCounter := 0;

      WITH wSamples DO BEGIN
        siPermiso := act AND vis;

        IF siPermiso AND forz THEN BEGIN
{          InitSampleWin(Song);}
          siTickForce := forz;
{          TickSampleInfo;}
        END;

        forz := FALSE;
      END;
    END;
  END;




PROCEDURE TickSampleInfo;
  CONST
    i  : WORD = 0;
    vl : BYTE = 0;
  BEGIN
    WITH wSamples DO
      IF NOT (act AND vis) THEN EXIT;

    INC(siCounter);

    FOR i := 1 TO 31 DO BEGIN
      vl := RealSamples[i];
      IF (siCounter > NoteSound^.Tempo) AND (vl = sfFlashing) THEN
        BEGIN
          vl             := sfNowUsed;
          RealSamples[i] := sfNowUsed;
        END;

      IF (vl > sfNoSample) AND ((vl <> DispSamples[i]) OR siTickForce) THEN
        BEGIN
          DispSamples[i] := vl;

          IF siPermiso THEN
            SampleAttr(i, BYTE(wSamples1.col[vl+4]));
        END;
    END;

    siTickForce := FALSE;

  END;




PROCEDURE UpdateOnOff;
  CONST
    Strn : ARRAY[0..1] OF STRING[3] = ('OFF', 'ON ');
    i    : WORD = 0;
  BEGIN
    IF w2ndLine.act AND w2ndLine.vis THEN
      FOR i := 1 TO 4 DO
        IF w2ndLine.forz OR (Permisos[FirstChannel - 1 + i] <> DispPermisos[i]) THEN BEGIN
          DispPermisos[i] := Permisos[FirstChannel - 1 + i];
          WITH wVoiceOnOff DO DirectWrite(ParseCoords(x+1, y+i), Strn[ORD(Permisos[FirstChannel - 1 + i])]);
        END;
  END;




PROCEDURE Update2ndLine(NewNote: BOOLEAN);
  BEGIN

     UpdateOnOff;
     UpdateBars;

     IF NewNote THEN
       w2ndLine.forz := FALSE;

  END;




PROCEDURE PutStr(VAR Buf; VAR s: STRING; c: BYTE);
  CONST
    i : WORD = 0;
  VAR
    CBuf : ARRAY[1..32000, 1..2] OF BYTE ABSOLUTE Buf;
  BEGIN

    FOR i := 1 TO Length(s) DO BEGIN
      CBuf[i][1] := BYTE(s[i]);
      CBuf[i][2] := c;
    END;

  END;


(*
PROCEDURE InitOscilloscInfo;
  CONST
    EmptyStr : STRING[51] = '                                                   ';
    OscView  : STRING[30] = '';
    i        : WORD       = 0;
    j        : WORD       = 0;
    ofs      : WORD       = 0;
  VAR
    OscWinBuff    : ARRAY[1..16, 1..51*2] OF CHAR;
  BEGIN
    OscView := GetString(StrOscilloscView);
    WITH wOscillosc DO BEGIN
      FOR i := 1 TO 16 DO PutStr(OscWinBuff[i], EmptyStr, BYTE(col[1]));
      PutStr(OscWinBuff[1][21*2-1], OscView, BYTE(col[1]));
      FOR i := 3 TO 14 DO BEGIN
        OscWinBuff[i][4] := col[1];
        OscWinBuff[i][6] := col[1];
        OscWinBuff[i][8] := col[1];
        OscWinBuff[i][3] := ' ';
        OscWinBuff[i][5] := ' ';
        OscWinBuff[i][7] := #131;
        FOR j := 5 TO 50 DO BEGIN
          OscWinBuff[i][j*2]   := col[2];
          OscWinBuff[i][j*2-1] := #0;
        END;
      END;
      OscWinBuff[15][8] := col[1];
      OscWinBuff[15][7] := #150;
      FOR j := 5 TO 50 DO BEGIN
        OscWinBuff[15][j*2]   := col[1];
        OscWinBuff[15][j*2-1] := #148;
      END;

      Ofs := ParseCoords(x+1, y+1);
      FOR i := 1 TO 16 DO BEGIN
        Move(OscWinBuff[i], Ptr(ScrSegment, Ofs)^, SIZEOF(OscWinBuff[1]));
        INC(Ofs, ScreenBytesX);
      END;
    END;
  END;
*)


PROCEDURE UpdateOscilloscInfo;
  CONST
    Count    : WORD = 0;
    Semaphor : BYTE = 0;
    i        : WORD = 0;
    j        : WORD = 0;
    ofs      : WORD = 0;
  LABEL
    Fin;
  BEGIN
    IF Semaphor > 0 THEN EXIT;

    INC(Semaphor);

    WITH wOscillosc DO BEGIN
      IF NOT (act AND vis) THEN GOTO Fin;
{
      IF forz THEN BEGIN
        InitOscilloscInfo;
      END;
}

      INC(Count);
      IF Count < 1 THEN GOTO Fin;

      Count := 0;

      FillWithSamples(OscSamples, 46*4);

      ASM
        CLD
        MOV     CX,12
        MOV     DI,OFFSET OscWinBuff + 51*2*2 + 8
        PUSH    DS
        POP     ES
        MOV     DX,51*2 - 46*2
        MOV     AH,BYTE PTR [wOscillosc.col[2]]
        XOR     AL,AL
@@lp1:   PUSH   CX
         MOV    CX,46
         REP STOSW
         POP    CX
         ADD    DI,DX
         LOOP   @@lp1
      END;

      ASM

        CLD
        MOV     CH,46
        MOV     SI,OFFSET OscSamples
        MOV     BX,OFFSET OscWinBuff + 51*2*2 + 8
@@lp1:   MOV    CL,4
@@lp2:    LODSW
          XOR   AH,$80

          XOR   DX,DX
          MOV   DI,1821
          DIV   DI

          MOV   DL,3
          DIV   DL
          MOV   DL,AH

          MOV   DI,CX
          DEC   CL
          ADD   CL,CL
          INC   DL
          SHL   DL,CL
          MOV   CX,DI

          MOV   DH,51*2
          MUL   DH
          ADD   AX,BX
          XCHG  BX,AX
          ADD   [BX],DL
          XCHG  BX,AX

          DEC   CL
          JNZ   @@lp2
         INC    BX
         INC    BX
         DEC    CH
         JNZ    @@lp1

      END;

      Ofs := ParseCoords(x+5, y+3);
      FOR i := 3 TO 14 DO BEGIN
        Move(OscWinBuff[i][9], Ptr(ScrSegment, Ofs)^, 46*2);
        INC(Ofs, ScreenBytesX);
      END;

    END;

Fin:
    wOscillosc.forz := FALSE;

    DEC(Semaphor);

  END;




PROCEDURE InitPlayData(VAR Song: TSong);
  CONST
    i     : WORD           = 0;
    j     : WORD           = 0;
    Instr : PInstrumentRec = NIL;
  BEGIN

    LastFilterOn  := fmNone;
    LastFilterOff := fmNone;
    LastFilter    := FALSE;

    FillChar(barlen, SizeOf(barlen), 0);
    WITH wPlayBars DO BEGIN
      FOR i := 1 TO 4 DO
        barofs[i] := ParseCoords(wPlayBars.x + 1, wPlayBars.y + i);
      forz := TRUE;
      act  := TRUE;
      vis  := TRUE;
    END;


    FOR i := 0 TO 64 DO
      STR(i : 2, VolumeStrings[i]);

    FillChar(DispVolumes, SIZEOF(DispVolumes), $FF);
    FillChar(DispNotes,   SIZEOF(DispNotes),   0);
    FillChar(RealVolumes, SIZEOF(RealVolumes), $FF);
    FillChar(RealNotes,   SIZEOF(RealNotes),   0);

    FillChar(DispSplName, SIZEOF(DispSplName), 0);

    FillChar(DispSamples, SIZEOF(DispSamples), sfNoSample);
    FillChar(RealSamples, SIZEOF(RealSamples), sfNoSample);

    FOR i := 1 TO Song.Instruments.Count DO BEGIN
      STR(i : 2, SampleStrings[i]);
      SampleStrings[i] := SampleStrings[i] + ' ' + Song.GetInstrument(i)^.GetName;
      Instr := Song.GetInstrument(i)^.Instr;
      IF (Instr <> NIL) AND (Instr^.Len <> 0) THEN
        BEGIN
          DispSamples[i] := sfNotUsed;
          RealSamples[i] := sfNotUsed;
        END;
    END;

    siTickForce    := FALSE;
    siPermiso      := TRUE;
    siCounter      := 0;

    FillChar(DispPermisos, SIZEOF(DispPermisos), 0);
  END;





END.