[Back to SOUND SWAG index] [Back to Main SWAG index] [Original]

    {
    Small Eastern gift, divided into several messages. Whole source can be freqed
    from my system under magic 'MODPLAY' (or will be in next few minutes, if I'll
    not forget :).
                                                    Borek

    ---------
    }
    {$A+,B-,D+,E+,F-,G+,I-,L+,N-,O-,P-,Q-,R-,S-,T-,V+,X+,Y+}
    {$M 16384,0,655360}

    program modplay;

    uses mixer,dos,crt;

    { Program by Borek (Marcin Borkowski), Warsaw, Poland.
      You can find me in a Top Secret BBS, +48 2 6788783
      Fido 2:480/25, Pascal Net 115:4804/104

      This program needs fast machine, as it is written in
      plain vanilla Pascal. If you are looking for proffesional
      quality implementation of MOD player, keep trying
      (I'm sure you'll have to paid for that). If you are looking
      for a source to understand and start work by yourself -
      you've got what you are looking for! You may freely copy
      and use this source, as long as it is unchanged and states my
      name in the begining. If you find more profitable use of this
      code, feel free to share your profits with me! At least - let
      me know you were able to use it for your own purposes.

      This program should be accompanied by the MIXER unit source.

      Attention - this implementation of playing MOD's is BAD
      and will probably not work on some MOD's with changed
      order of playing patterns, also MOD's based on effects
      will not be played properly. Effects (and many other things -
      as sample volumes, finetuning) aren't implemented, and in
      fact that's only a sketch. Program is probably bugged, but
      for sure it plays 40% MOD's from my BBS in an acceptable way.

      Parts of code ripped from PCPGE, various sources from
      Ethan Brodsky and probably from SWAG. I can't remember
      source of every byte, but for sure 95% of code is mine. }

    const
      TIMERINTR = 8;
      PIT_FREQ  = $1234DD;

    type
      sampledata = array[0..65533]of byte;
      pattern    = array[0..63,0..15]of byte;
      patptr     = ^pattern;

    var
      BIOSTimerHandler    : procedure;
      clock_ticks,counter : longint;

      playend : boolean;
      ticks,speed : word;
      divplayed : word;
      patplayed : word;
      patterns : array[0..255]of patptr;
      patternorder : array[0..127]of byte;
      fmod    : file;
      hdr     : array[1..1084]of byte;
      nofsamples : word;
      nofpatterns : word;
      OldExit : pointer;
      samples : array[1..31]of record
                                 sname : string[22];
                                 length : word;
                                 finet  : byte;
                                 volume : byte;
                                 repst,repend : word;
                               end;

    function amiword(w : word): word;
    { Data in MOD files are usually in 68000 format. }
    assembler;
    asm
      mov ax,w
      xchg ah,al
    end;

    procedure nextdivision;
    var
    { Sometimes data have to be treated as bytes,
      sometimes as words. Let's use some tricks! }
      divis : array[0..15]of byte;
      diwis : array[0..7]of word absolute divis;
      smp,tmp,freq : word;
      eff,arg : byte;
      i       : integer;
    begin
      if divplayed=64 then
      begin
        divplayed:=0;
        inc(patplayed);
      end;
      if patplayed>=hdr[951] then
      begin
        playend:=true;
        EXIT
      end;

      gotoxy(1,21);
      write('Pattern: ',patplayed+1:2,'/',hdr[951],
            '    division: ',divplayed:2);
      move(patterns[patternorder[patplayed]]^[divplayed,0],divis,16);

      for i:=0 to 3 do
      begin
        smp:=(divis[4*i+0] and $F0)+divis[4*i+2] shr 4;  {sample number}
        tmp:=(amiword(diwis[2*i]) and $0FFF);      {sample period}
        if tmp<>0 then freq:=3546895 div tmp;
        if smp<>0 then startchannel(i+1,smp,64,freq)
                  else if tmp<>0 then setchannelfrequency(i+1,freq);

        gotoxy(1,22+i);
        write(' channel ',i,': ',samples[smp].sname:22,' freq: ',freq:5,' ':20);
        gotoxy(50,22+i);

        eff:=divis[4*i+2] and $0F;                 {effect number}
        arg:=divis[4*i+3];                           {effect argument}
        case eff of
          $0C : begin
                  setchannelvolume(i+1,arg);
                  write('  volume change');
                end;
          $0F : if arg<>0 then
                begin
                  speed:=arg;
                  write('  speed change');
                end;
          $0B : begin
                  divplayed:=63;
                  patplayed:=arg-1;
                  write('  pattern break');
                end;
          $0D : begin
                  inc(patplayed);
                  divplayed:=10*(arg shr 4)+arg and $0F-1;
                  write('  pattern jump');
                end;
        end;
      end;
      inc(divplayed);
    end;

    procedure play;
    interrupt;
    begin
      inc(ticks);
      if ticks=speed then
      begin
        ticks:=0;
        nextdivision;
      end;
      clock_ticks := clock_ticks + counter;
      if clock_ticks >= $10000 then
        begin
          clock_ticks := clock_ticks - $10000;
          asm pushf end;
          BIOSTimerHandler;
        end
      else Port[$20] := $20;
    end;

    procedure CleanUpTimer;
    begin
      Port[$43] := $34;
      Port[$40] := 0;
      Port[$40] := 0;
      SetIntVec(TIMERINTR, @BIOSTimerHandler);
    end;

    procedure SetTimer(TimerHandler : pointer; frequency : word);
    begin
      clock_ticks := 0;
      counter := $1234DD div frequency;
      GetIntVec(TIMERINTR, @BIOSTimerHandler);
      SetIntVec(TIMERINTR, TimerHandler);
      Port[$43] := $34;
      Port[$40] := counter mod 256;
      Port[$40] := counter div 256;
    end;

    {$F+}
    procedure shutdown;
    begin
      CleanUpTimer;
      exitproc:=oldexit
    end;
    {$F-}

    procedure error(s : string);
    begin
      writeln(s);
      close(fmod);
      HALT
    end;

    procedure openmod;
    var
      s : string;
    begin
      if paramcount=0 then error('Needs filename (*.mod) as parameter');
      assign(fmod,paramstr(1));
      reset(fmod,1);
      if IOResult<>0 then error('Can''t open file: '+paramstr(1));
      blockread(fmod,hdr,1084);
      move(hdr[1081],s[1],4);
      s[0]:=#4;
      if not((s='M.K.') or (s='M!K!') or (s='FLT4') or (s='4CHN')) then
        error('Invalid mod file format tag: '+s);
      nofsamples:=31;
      move(hdr[1],s[1],20);
      s[0]:=#1;
      while s[ord(s[0])]<>#0 do inc(s[0]);
      writeln('Song name: ',s);
    end;

    procedure getsamples;
    var
      i : integer;
      s : string;
      w : word;
      totalsamplength : longint;
      p : pointer;
    begin
      totalsamplength:=0;
      for i:=1 to nofsamples do with samples[i] do
      begin
        move(hdr[21+(i-1)*30],sname[1],21);
        sname[0]:=#1;
        while sname[ord(sname[0])]<>#0 do inc(sname[0]);
        move(hdr[43+30*(i-1)],w,2);    length:=amiword(w) shl 1;
        inc(totalsamplength,length);
        volume:=hdr[46+30*(i-1)];
        move(hdr[47+30*(i-1)],w,2);    repst:=amiword(w) shl 1;
        move(hdr[49+30*(i-1)],w,2);    repend:=repst+amiword(w) shl 1;
        if length>2 then
          writeln(' sample ',i:2,': ',sname:22,length:6,
                  volume:3,repst:6,repend-2:6);
      end;
      nofpatterns:=(filesize(fmod)-1084-totalsamplength) div 1024;
      writeln('Number of different patterns in song: ',nofpatterns);
      seek(fmod,filesize(fmod)-totalsamplength);
      for i:=1 to nofsamples do
        with samples[i] do
          if length>2 then
          begin
            getmem(p,length);
            blockread(fmod,w,2);
            blockread(fmod,p^,length-2,w);
            if IOResult<>0 then error('Can''t read samples, file is to short!');
          { Convert sample to appropriate format. }
            for w:=0 to length-3 do inc(sampledata(p^)[w],128);
            addvoice(i,length-2,repst,repend-2,p)
          end;
    end;

    procedure getpatterns;
    var
      i : integer;
    begin
      seek(fmod,1084);
      for i:=0 to nofpatterns-1 do
      begin
        new(patterns[i]);
        blockread(fmod,patterns[i]^,1024)
      end;
      seek(fmod,952);
      blockread(fmod,patternorder,128);
      close(fmod);
    end;

    procedure startplay;
    begin
      speed:=6;
      divplayed:=0;
      patplayed:=0;
      SetTimer(@play,50);
      playend:=false;
    end;

    begin
      clrscr;
      OldExit:=ExitProc;
      ExitProc:=@ShutDown;
      openmod;
      getsamples;
      getpatterns;
      startplay;
      repeat until keypressed or playend;
    end.

    {  -----------------------  UNIT FILES ----------------------- }

    {$A+,B-,D+,E-,F-,G+,I-,L+,N-,O-,P-,Q-,R-,S-,T-,V+,X+,Y+}
    {$M 16384,0,655360}

    unit mixer;

    { Program by Borek (Marcin Borkowski), Warsaw, Poland.
      You can find me in a Top Secret BBS, +48 2 6788783
      Fido 2:480/25, Pascal Net 115:4804/104

      You may freely copy and use this source, as long it is
      unchanged and states my name in the begining. If you find
      more profitable use of this code, fell free to share your
      profits with me! At least - let me know you were able to
      use it for your own purposes.

      This unit should be accompanied by the MODPLAY source.

      This version of mixing (even at 44 kHz) works OK on my
      UMC 40 MHz machine (that's a little bit less than 486 50 MHz).
      If you want to make it work on 386DX 33MHz, you must 'unroll'
      the main loop and put used there data into 'hardcoded' variables.
      Such a version works on my old 386 and on several other
      computers of the same class, even with QEMM.

      If you stop this program by ctrl break, you may not be able to
      restart it without resetting your computer - and that's not the
      only one bug I know in the code.

      Parts of code ripped from PCPGE, various sources from
      Ethan Brodsky and probably from SWAG. I can't remember
      source of every byte, but for sure 95% of code is mine. }

    interface

    procedure addvoice(voice,_samplesize,_loopstart,_loopend : word;
                       sample : pointer);
    procedure startchannel(channel,voice,volume,frequency : word);
    procedure stopchannel(channel : word);
    procedure setchannelfrequency(channel,frequency : word);
    procedure setchannelvolume(channel,volume : word);

    implementation

    uses crt,dos;

    const
    { Mixer data }
      max_num_voices = 32; { number of voices }
      max_num_channels = 4; { number of channels }
      PlayFreq = 22222; { samples played at, at 11111 sound is very bad. }
      playbufsize = 512; { Size of play buffer}
    { SB data - change it for your card settings. }
      SBIO    : word = 2;  { 2x0 }
      SBIRQ   : word = 7;

    type
      sampledata = array[0..65533]of byte;
      _channel   = record
                     nvoice,position,increment,subposition,vol : word;
                     inloop,active : boolean
                   end;

    var
    { Pointers to samples. }
      voicesdata : array[1..max_num_voices]of ^sampledata;
    { Sizes of voices }
      voicessize : array[1..max_num_voices]of word;
    { Those two defines begining and end of loop in sample }
      voicesloopstart : array[1..max_num_voices]of word;
      voicesloopend : array[1..max_num_voices]of word;
    { Voice ready to use? }
      voicesdefined : array[1..max_num_voices]of boolean;
    { Which voice played in this channel? }
      channelsnvoice : array[1..max_num_channels]of word;
    { Which position in sample? }
      channelsposition : array[1..max_num_channels]of word;
    { How to increment subposition? }
      channelsincrement : array[1..max_num_channels]of word;
    { Which subposistion in position - it allows to change frequencies,
      as one byte of sample can be played several times. It gives not a
      perfect sound, but it works. To improove sound quality, one should
      use interpolation (and assembler :-) }
      channelssubposition : array[1..max_num_channels]of word;
    { Volume of channel }
      channelsvol : array[1..max_num_channels]of word;
    { Is sample in this channel loop? }
      channelsinloop : array[1..max_num_channels]of boolean;
    { Channel being played? }
      channelsactive : array[1..max_num_channels]of boolean;

    { SB addresses }
      DSP_RESET        : word;
      DSP_READ_DATA    : word;
      DSP_WRITE_DATA   : word;
      DSP_WRITE_STATUS : word;
      DSP_DATA_AVAIL   : word;

      timeconst        : byte;
      playbuf          : pointer;
      oldint,oldexit   : pointer;
      firstbuff        : boolean;

    function carry : boolean;
    inline($B0/$01/     {  mov al,01 }
           $72/$02/     {  jc @carryset }
           $30/$C0);    {  xor al,al }
                        { @carryset: }

    function ResetDSP(base : word) : boolean;
    begin
      base := base * $10;
      DSP_RESET := base + $206;
      DSP_READ_DATA := base + $20A;
      DSP_WRITE_DATA := base + $20C;
      DSP_WRITE_STATUS := base + $20C;
      DSP_DATA_AVAIL := base + $20E;
      Port[DSP_RESET] := 1;
      Delay(1);
      Port[DSP_RESET] := 0;
      Delay(1);
      if (Port[DSP_DATA_AVAIL] And $80 = $80) And (Port[DSP_READ_DATA] = $AA)
         then ResetDSP := true
         else ResetDSP := false;
    end;

    procedure WriteDSP(value : byte);
    begin
      while Port[DSP_WRITE_STATUS] And $80 <> 0 do;
      Port[DSP_WRITE_DATA] := value;
    end;

    function ReadDSP : byte;
    begin
      while Port[DSP_DATA_AVAIL] and $80 = 0 do;
      ReadDSP := Port[DSP_READ_DATA];
    end;

    function SpeakerOn: byte;
    begin
      WriteDSP($D1);
    end;

    function SpeakerOff: byte;
    begin
      WriteDSP($D3);
    end;

    procedure Playback;
    var
      page,offset,size   : word;
    begin
    { SB and DMA are working in autoinit modes - but DMA buffer is
      twice as long as SB buffer. Each time SB buffer is finished an
      IRQ is generated - a signal that next part of samples should be
      mixed. Play buffer has two parts - when one is played, second
      is being filled. Simple, uh? This version of procedure was checked
      on AWE 32, on SB 16 and on several clones of SB, but for sure
      it'll not work on some cards - especially on older versions
      that are not supporting autoinit mode. }
      firstbuff:=true;
      size := playbufsize-1;
      offset := Seg(playbuf^) Shl 4 + Ofs(playbuf^);
      page := (Seg(playbuf^) + Ofs(playbuf^) shr 4) shr 12;
    { DMA programming }
      Port[$0A] := 5;
      Port[$0C] := 0;
      Port[$0B] := $59; { DMA autoinit }
      Port[$02] := Lo(offset);
      Port[$02] := Hi(offset);
      Port[$83] := page;
      Port[$03] := Lo(size);
      Port[$03] := Hi(size);
      Port[$0A] := 1;
    { SB programming }
      WriteDSP($40);
      WriteDSP(timeconst);
      WriteDSP($48); { 8-bit sample type with autoinit}
      WriteDSP(Lo(playbufsize shr 1-1));
      WriteDSP(Hi(playbufsize shr 1-1));
      WriteDSP($1C) {???? I don't know why, but it is necessary }
    end;

    procedure mix;
    { Main procedure - mixes samples with appropriate frequencies and
      puts mixed signal into play buffer. If it's too slow for your
      computer, don't blame me - but translate procedure into assembler
      (or buy something faster :-) }
    var
      i,j : integer;
      nvoice,sw  : word;
      pombuf : ^sampledata;
    begin
    { Pointer to play buffer - is it first, or second part? }
      if firstbuff then pombuf:=@sampledata(playbuf^)[playbufsize div 2]
                   else pombuf:=playbuf;
      for i:=0 to playbufsize div 2-1 do
      begin
        sw:=0;
        for j:=1 to max_num_channels do
          if channelsactive[j] then
          begin
            nvoice:=channelsnvoice[j];
    { That's mixing - without interpolation. }
            inc(sw, voicesdata[nvoice]^[channelsposition[j]] * channelsvol[j]);
    { Here is the most important thing - next two lines (excluding
      remarks:) are responsible for output frequency of sample.  }
            inc(channelssubposition[j],channelsincrement[j]);
    { That's a nasty trick - but it works. You can do it other ways,
      in Pascal, Assembler and so on. }
            if carry then inc(channelsposition[j]);
    { Now work with looped samples. }
            if channelsinloop[j] then
              if channelsposition[j] > voicesloopend[nvoice] then
                     channelsposition[j] := voicesloopstart[nvoice];
    { Maybe we should stop playing this sample? Or put it in a loop mode? }
            if channelsposition[j] > voicessize[nvoice] then
              if voicesloopstart[nvoice]<>0 then
              begin
                channelsposition[j] := voicesloopstart[nvoice];
                channelsinloop[j]:=true
              end
              else channelsactive[j]:=false;
          end;
        pombuf^[i]:=Lo(sw shr 6);
      end;
    end;

    procedure inthandler;
    interrupt;
    var
      w : word;
    begin
      w:=Port[DSP_DATA_AVAIL];
      port[$20]:=$20;
      firstbuff:=not firstbuff;
      mix;
    end;

    procedure enableIRQ(n : byte);
    begin
      port[$21]:=port[$21] and not (1 shl n)
    end;

    procedure disableIRQ(n : byte);
    begin
      port[$21]:=port[$21] or (1 shl n)
    end;

    procedure allocmem(var p : pointer);
    var
      adr : longint;
    begin
    { Allocates memory not crossing page boundary ($X0000) }
      repeat
        getmem(p,playbufsize);
        adr:=longint(Seg(p^)) Shl 4 + Ofs(p^);
      until (adr and $FFFF)<$FFFF-playbufsize
    end;

    {$F+ }
    procedure MixerExit;
    begin
      ExitProc:=OldExit;
      WriteDSP($D0); { ??? }
      speakeroff;
      disableIRQ(SBIRQ);
      setintvec(8+SBIRQ,oldint);
      ResetDSP(SBIO);
    end;
    {$F- }

    procedure initplayloop;
    begin
      if not ResetDSP(SBIO) then HALT;
      allocmem(playbuf);
      getintvec(8+SBIRQ,oldint);
      setintvec(8+SBIRQ,@inthandler);
      enableIRQ(SBIRQ);
      speakeron;
      timeconst:=256-1000000 div PlayFreq;
      fillchar(playbuf^,playbufsize,#0);
      playback;
      OldExit:=ExitProc;
      ExitProc:=@MixerExit
    end;

    procedure addvoice(voice,_samplesize,_loopstart,_loopend : word;
                       sample : pointer);
    begin
      voicesdata[voice]:=sample;
      voicessize[voice]:=_samplesize;
      voicesloopstart[voice]:=_loopstart;
      voicesloopend[voice]:=_loopend;
      voicesdefined[voice]:=true
    end;

    procedure startchannel(channel,voice,volume,frequency : word);
    begin
      asm cli end;
      if not channelsactive[channel] then channelsactive[channel]:=true;
      channelsinloop[channel]:=false;
      channelsnvoice[channel]:=voice;
      channelsincrement[channel]:=(longint(frequency) shl 16-1) div PlayFreq;
      if (volume>=0) and (volume<=16) then channelsvol[channel]:=volume
                                      else channelsvol[channel]:=16;
      channelssubposition[channel]:=0;
      channelsposition[channel]:=0;
      asm sti end;
    end;

    procedure stopchannel(channel : word);
    begin
      channelsactive[channel]:=false;
      channelsinloop[channel]:=false
    end;

    procedure setchannelfrequency(channel,frequency : word);
    begin
      asm cli end;
      channelsincrement[channel]:=(longint(frequency) shl 16-1) div PlayFreq;
      asm sti end;
    end;

    procedure setchannelvolume(channel,volume : word);
    begin
      asm cli end;  {}
      if (volume>=0) and (volume<=16) then channelsvol[channel]:=volume;
      asm sti end;  {}
    end;

    begin
      fillchar(voicesdata,sizeof(voicesdata),#0);
      fillchar(voicessize,sizeof(voicessize),#0);
      fillchar(voicesloopstart,sizeof(voicesloopstart),#0);
      fillchar(voicesloopend,sizeof(voicesloopend),#0);
      fillchar(voicesdefined,sizeof(voicesdefined),#0);
      fillchar(channelsnvoice,sizeof(channelsnvoice),#0);
      fillchar(channelsposition,sizeof(channelsposition),#0);
      fillchar(channelsincrement,sizeof(channelsincrement),#0);
      fillchar(channelssubposition,sizeof(channelssubposition),#0);
      fillchar(channelsvol,sizeof(channelsvol),#0);
      fillchar(channelsinloop,sizeof(channelsinloop),#0);
      fillchar(channelsactive,sizeof(channelsactive),#0);
      initplayloop
    end.

[Back to SOUND SWAG index] [Back to Main SWAG index] [Original]