Metropoli BBS
VIEWER: playing.pas MODE: TEXT (CP437)
{
 following effects are NOT supported
   Effect 8xy (Pan)
   Effect E0x (Set Filter)
   Effect EDx (Delay Note)
   Effect EFx (Invert Loop)
 glissando has never been tested, so it sucks as well.
}

const minporta:word=56;
      maxporta:word=27392;

const notecut=0;
      portatonote=1;
      arpeggio=2;
      porta=3;
      vibrato=4;
      tremolo=5;
      retrignote=6;
      nothing=255;

type effectrec=record
                notecut:record
                         ontick:byte;
                        end;
                portanote:record
                           portaspeed:word;
                           notetoportato:word;
                           period:word;
                          end;
                volumeslide:record
                             add:shortint;
                            end;
                arpeggio:record
                          note:word;
                          xfine:word;
                          yfine:word;
                         end;
                porta:record
                       add:integer;
                      end;
                vibrato:record
                         speed:byte;
                         depth:word;
                         vibepos:shortint;
                        end;
                tremolo:record
                         speed:byte;
                         depth:word;
                         vibepos:shortint;
                        end;
                retrignote:record
                            ontick:byte;
                            sample:byte;
                           end;
               end;

const vibe:array[0..31] of integer=(0,24,49,74,97,120,141,161,
                                    180,197,212,224,235,244,250,253,
                                    255,253,250,244,235,224,212,197,
                                    180,161,141,120,97,74,49,24);

const effyt:array[0..16] of string[8]=(
'Arpeggio','Porta Up','Porta Dn','Porta Nt','Vibrato ',
'Prt+Vsld','Vib+Vsld','Tremolo ','Pan     ','S.Offset',
'Vol Slid','Ptrn jmp','Set Vol.','Ptrn brk','Extended',
'Set spd ','        ');

type channarec=record
                lastinstru:byte;
                lastnote:byte;
                period:longint;
                whicheffect:byte;
                vslide:boolean;
                pattern_loop:record
                              row:word;
                              loop:byte;
                             end;
                effect:effectrec;
                lastsampleoffset:byte;
                volume:integer;

                note:word;
                effy:word;
                instru:word;
               end;

{$I playrec.pas}

var oldkello:pointer;
    channa:array[1..32] of channarec;
    waveform:record
              tremolo:byte;
              retrigtre:boolean;
              vibrato:byte;
              retrigvib:boolean;
             end;
    glissando:boolean;
    timspeed:word;
    counter:word;

var clk:word;

{$S-}
procedure settimer(hz:word);
begin
 clk:=1193181 div hz;
 timspeed:=clk;
 asm pushf; cli; end;
 port[$43]:=$36;
 port[$40]:=lo(clk);
 port[$40]:=hi(clk);
 asm popf; end;
end;

{$S-}
procedure setbpm(bpm:word);
begin
 if bpm<46 then bpm:=46;
 play.bpm:=bpm;
 clk:=longint(1193181*5) div (2*bpm);
 timspeed:=clk;
 asm pushf; cli; end;
 port[$43]:=$36;
 port[$40]:=lo(clk);
 port[$40]:=hi(clk);
 asm popf; end;
end;

{$S-}
procedure update_effect;
var c,temp:byte;
    i,d:integer;
    w:word;
begin
for c:=1 to module.channels do begin
 if channa[c].vslide=true then begin
  i:=integer(channa[c].volume)+integer(channa[c].effect.volumeslide.add);
  if i<0 then i:=0 else if i>64 then i:=64;
  channa[c].volume:=byte(i);
  setvolume(c,byte(i));
 end;
 case channa[c].whicheffect of
  notecut:if (channa[c].effect.notecut.ontick=play.tick) then begin
           setvolume(c,0);
           channa[c].volume:=0;
           channa[c].whicheffect:=nothing;
          end;
  retrignote:with channa[c].effect.retrignote do if (play.tick mod ontick=0) then
              playvoice(sample,samples[sample].offset,c);
  portatonote:with channa[c] do begin
               if effect.portanote.notetoportato>effect.portanote.period then begin
                inc(effect.portanote.period,longint(effect.portanote.portaspeed));
                if effect.portanote.period>effect.portanote.notetoportato then
                 effect.portanote.period:=effect.portanote.notetoportato;
                if not(glissando) then period:=effect.portanote.period else begin
                 i:=131;
                 while (periods[i]<effect.portanote.period) and (i>0) do dec(i);
                 period:=periods[i];
                end;
               end else
               if effect.portanote.notetoportato<effect.portanote.period then begin
                dec(effect.portanote.period,longint(effect.portanote.portaspeed));
                if effect.portanote.period<effect.portanote.notetoportato then
                 effect.portanote.period:=effect.portanote.notetoportato;
                if not(glissando) then period:=effect.portanote.period else begin
                 i:=0;
                 while (periods[i]>effect.portanote.period) and (i<131) do inc(i);
                 period:=periods[i];
                end;
               end else channa[c].whicheffect:=nothing;
               setamigafreq(c,period);
              end;
  arpeggio:with channa[c] do begin
            case (play.tick) mod 3 of
             0:w:=periods[effect.arpeggio.note];
             1:w:=periods[effect.arpeggio.note+effect.arpeggio.xfine];
             2:w:=periods[effect.arpeggio.note+effect.arpeggio.yfine];
            end;
            setamigafreq(c,longint(longint(8363)*longint(w))
                         div longint(samples[channa[c].lastinstru].c2spd));
           end;
  porta:with channa[c] do begin
         inc(period,integer(effect.porta.add));
         if period<minporta then period:=minporta else
          if period>maxporta then period:=maxporta;
         if (period=minporta) or (period=maxporta) then whicheffect:=nothing;
         setamigafreq(c,period);
        end;
 vibrato:with channa[c] do begin
           temp:=effect.vibrato.vibepos and 31;
           case waveform.vibrato of
            0,3:d:=integer(vibe[temp]);
            1:begin
               temp:=temp*8;
               if (effect.vibrato.vibepos<0) then temp:=255-temp;
               d:=temp;
              end;
            2:d:=255;
           end;

           d:=longint(longint(d)*longint(effect.vibrato.depth)) div 128;
           case (effect.vibrato.vibepos) of
            -128..-1:setamigafreq(c,period-d);
            0..127:setamigafreq(c,period+d);
           end;
           with effect.vibrato do begin
            inc(vibepos,byte(speed));
            if vibepos>31 then dec(vibepos,64);
           end;
          end;
  tremolo:with channa[c] do begin
           temp:=byte(effect.tremolo.vibepos) and 31;
           case waveform.tremolo of
            0,3:d:=vibe[temp];
            1:begin
               temp:=temp*8;
               if effect.tremolo.vibepos<0 then temp:=255-temp;
               d:=temp;
              end;
            2:d:=255;
           end;

           d:=(d*integer(effect.tremolo.depth)) div 64;
           case (effect.tremolo.vibepos) of
            -128..-1:d:=integer(channa[c].volume)-d;
            0..127:d:=integer(channa[c].volume)+d;
           end;
           if d<0 then d:=0 else if d>64 then d:=64;
           setvolume(c,byte(d));
           with effect.vibrato do begin
            inc(vibepos,byte(speed));
            if vibepos>31 then dec(vibepos,64);
           end;
          end;
 end;
end;
end;

var pat:word;
    roffs:word;
    rc:word;
    j:longint;
    row:record
         note:byte;
         samp:byte;
         effe:byte;
         epar:byte;
         volu:byte;
        end;

{$S-}
procedure update_row;

{$S-}
procedure setupvslide(cha:byte; efpara:byte);
begin {volume slide. tehty eri tavalla, että samaa voi käyttää iisisti}
      {yhdistettyjen efektien kanssa.(vibrato+vslide ja porta+vslide)}
if ((efpara shr 4=0) or (efpara and $0F=0)) and
   ((efpara shr 4>0) or (efpara and $0F>0)) then
  begin
   if (efpara shr 4>0) then
    channa[cha].effect.volumeslide.add:=shortint(byte(efpara shr 4))
   else
   if (efpara and $0F>0) then
    channa[cha].effect.volumeslide.add:=-shortint(byte(efpara and $0F));

   channa[rc].vslide:=true;
  end;
end;

label skip_effyt;
begin
 pat:=song.order[play.order];
 play.physpatta:=pat;
 roffs:=(play.row-1)*module.channels*5;
 play.patternjump:=false;
 for rc:=1 to module.channels do begin
  inc(roffs,5);
  row.samp:=mem[seg(song.pattern[pat]^):ofs(song.pattern[pat]^)+roffs+0];
  row.note:=mem[seg(song.pattern[pat]^):ofs(song.pattern[pat]^)+roffs+1];
  row.effe:=mem[seg(song.pattern[pat]^):ofs(song.pattern[pat]^)+roffs+2];
  row.epar:=mem[seg(song.pattern[pat]^):ofs(song.pattern[pat]^)+roffs+3];
  row.volu:=mem[seg(song.pattern[pat]^):ofs(song.pattern[pat]^)+roffs+4];

  if (row.samp>0) and (row.samp<module.maxsamples) then begin
   channa[rc].lastinstru:=row.samp;
   if row.volu=255 then channa[rc].volume:=samples[row.samp].volume
    else channa[rc].volume:=row.volu;
  end;

  if (row.note<>$ff) then begin
   if (waveform.retrigvib) then channa[rc].effect.vibrato.vibepos:=0;
   if (waveform.retrigtre) then channa[rc].effect.tremolo.vibepos:=0;

   if (row.effe<>$3) and (row.effe<>$5) then
    channa[rc].period:=longint(longint(8363)*longint(periods[row.note]))
                       div longint(samples[channa[rc].lastinstru].c2spd);

   channa[rc].lastnote:=row.note;
  end;

  if row.note<>$ff then channa[rc].note:=row.note else channa[rc].note:=132;
  channa[rc].effy:=16;
  if (row.samp>0) and (row.samp<module.maxsamples) then
   channa[rc].instru:=row.samp;

  channa[rc].whicheffect:=nothing;
  channa[rc].vslide:=false;

{  if (row.samp>0) and (row.samp<module.maxsamples) then
   samples[row.samp].offset:=0;}
  if (channa[rc].lastinstru>0) and (channa[rc].lastinstru<module.maxsamples)
   then samples[channa[rc].lastinstru].offset:=0;

  if (row.effe=0) and (row.epar=0) then goto skip_effyt;
  channa[rc].effy:=row.effe;
  case row.effe of
   $C:begin {set volume}
       if row.epar>$40 then row.epar:=$40;
       channa[rc].volume:=row.epar;
      end;
   $F:case row.epar of {set speed/bpm}
       $00..$1F:play.speed:=row.epar;
       $20..$FF:setbpm(row.epar);
      end;
   $9:if (channa[rc].lastinstru>0) and (channa[rc].lastinstru<module.maxsamples){ and (row.note<>$ff)} then begin
{set sample offset}
       if row.epar>0 then channa[rc].lastsampleoffset:=row.epar;
       j:=longint(channa[rc].lastsampleoffset) shl 8;
{       j:=longint(row.epar) shl 8;}
       if j>samples[channa[rc].lastinstru].length then
        j:=samples[channa[rc].lastinstru].length;
       samples[channa[rc].lastinstru].offset:=j;
      end;
   $B:begin {jump to pattern}
       play.patternjump:=true;
       inc(row.epar,1);
       if row.epar>song.length then row.epar:=1;
       play.order:=row.epar;
       play.row:=0;
      end;
   $D:begin {pattern break}
       row.epar:=(row.epar shr 4)*10+(row.epar and $0F)+1;
       if row.epar>=65 then row.epar:=1;
       play.row:=row.epar-1;
       if play.patternjump=false then inc(play.order,1);
       play.patternjump:=true;
       if play.order>song.length then play.order:=1;
      end;
   $E:case (row.epar shr 4) of {extended commands}
        $3:begin
            byte(glissando):=(row.epar and 1); {glissando control}
            mwrite('GLISSANDO USED, NOT TESTED!!',0,0,15);
           end;
        $C:begin {note cut / cut note}
            channa[rc].effect.notecut.ontick:=(row.epar and $0F);
            if (row.epar and $0F)>0 then channa[rc].whicheffect:=notecut;
           end;
        $9:begin {retrig note}
            if (row.note<>$ff) and (row.samp>0) and (row.samp<module.maxsamples)
             then begin
              if (row.epar and $0F)>0 then channa[rc].whicheffect:=retrignote;
              channa[rc].effect.retrignote.sample:=row.samp;
              channa[rc].effect.retrignote.ontick:=(row.epar and $0F);
             end;
           end;
        $4:begin {set vibrato waveform}
            waveform.vibrato:=(row.epar and $0F) mod 4;
            if (row.epar and $0f)>=4 then waveform.retrigvib:=false
             else waveform.retrigvib:=true;
           end;
        $7:begin {set tremolo waveform}
            waveform.tremolo:=(row.epar and $0F) and 3;
            if (row.epar and $0f)>=4 then waveform.retrigtre:=false
             else waveform.retrigtre:=true;
           end;
        $5:{set finetune}
           samples[channa[rc].lastinstru].c2spd:=finetunes[row.epar and $0F];
        $6:begin {pattern loop}
            if (row.epar and $0F=0) then channa[rc].pattern_loop.row:=play.row
            else begin
             if channa[rc].pattern_loop.loop=0 then channa[rc].pattern_loop.loop:=(row.epar and $0F)
              else dec(channa[rc].pattern_loop.loop);
             if channa[rc].pattern_loop.loop>0 then play.row:=channa[rc].pattern_loop.row-1;
            end;
           end;
        $A:inc(channa[rc].volume,(row.epar and $0F)); {fine volume slide up}
        $B:dec(channa[rc].volume,(row.epar and $0F)); {fine volume slide down}
        $E:play.patterndelay:=row.epar and $0F; {pattern delay}
      end;
   $3:begin {porta to note / tone portamento}
       channa[rc].whicheffect:=portatonote;

       if (row.epar>0) then
        channa[rc].effect.portanote.portaspeed:=
         word(word(row.epar shr 4)*10+word(row.epar and $0F))*4;
       channa[rc].effect.portanote.period:=channa[rc].period;
        channa[rc].effect.portanote.notetoportato:=
         longint(longint(8363)*longint(periods[channa[rc].lastnote])) div longint(samples[channa[rc].lastinstru].c2spd);
      end;
   $A,$5,$6:setupvslide(rc,row.epar); {volume slide,porta+volume slide,vibrato+volume slide}
   $0:if (channa[rc].lastnote<>$ff) then with channa[rc] do begin {arpeggio}
       whicheffect:=arpeggio;
       effect.arpeggio.note:=lastnote;
       if row.epar<>0 then begin
        effect.arpeggio.xfine:=word(row.epar shr 4);
        effect.arpeggio.yfine:=word(row.epar and $0F);
       end;
      end;
   $1:begin {porta up}
       channa[rc].whicheffect:=porta;
       channa[rc].effect.porta.add:=-integer(row.epar)*4;
      end;
   $2:begin {porta down}
       channa[rc].whicheffect:=porta;
       channa[rc].effect.porta.add:=integer(row.epar)*4;
      end;
   $4:begin {vibrato}
       channa[rc].whicheffect:=vibrato;
       if row.epar and $F0>0 then channa[rc].effect.vibrato.speed:=row.epar shr 4;
       if row.epar and $0F>0 then channa[rc].effect.vibrato.depth:=integer(row.epar and $0F)*4;
      end;
   $7:begin {tremolo}
       channa[rc].whicheffect:=tremolo;
       if row.epar and $f0>0 then channa[rc].effect.tremolo.speed:=row.epar shr 4;
       if row.epar and $0f>0 then channa[rc].effect.tremolo.depth:=row.epar and $0F;
      end;
  end;
skip_effyt:
  if channa[rc].volume<0 then channa[rc].volume:=0 else
   if channa[rc].volume>64 then channa[rc].volume:=64;

  setvolume(rc,byte(channa[rc].volume));

  if (channa[rc].period>0) then setamigafreq(rc,channa[rc].period);

{  if (row.note<>$ff) and (row.samp>0) and (row.samp<module.maxsamples)
   and (row.effe<>$3) and (row.effe<>$5) then
    playvoice(row.samp,samples[row.samp].offset,c) else
     if c=4 then mwrite(strr(row.samp),0,0,15);}
  if (row.note<>$ff) and (channa[rc].lastinstru>0)
   and (channa[rc].lastinstru<module.maxsamples)
   and (row.effe<>$3) and (row.effe<>$5) then
    playvoice(channa[rc].lastinstru,samples[channa[rc].lastinstru].offset,rc);
 end;
end;

var rekisterit2:array[0..6*4] of byte;

{$S-}
procedure saver2; assembler;
asm
 db $66; mov [rekisterit2].word[0],ax
 db $66; mov [rekisterit2].word[4],bx
 db $66; mov [rekisterit2].word[8],cx
 db $66; mov [rekisterit2].word[12],dx
 db $66; mov [rekisterit2].word[16],si
 db $66; mov [rekisterit2].word[20],di
end;

{$S-}
procedure restr2; assembler;
asm
 db $66; mov ax,[rekisterit2].word[0]
 db $66; mov bx,[rekisterit2].word[4]
 db $66; mov cx,[rekisterit2].word[8]
 db $66; mov dx,[rekisterit2].word[12]
 db $66; mov si,[rekisterit2].word[16]
 db $66; mov di,[rekisterit2].word[20]
end;


{$F+}
{$S-}
procedure modplay; interrupt;
begin
 asm cli; cli; end;
 saver2;
 inc(play.tick,1);
 if play.tick>=play.speed then begin
  play.tick:=0;
  if (play.patterndelay=0) then begin
   update_row;
   inc(play.row,1);
   if play.row>64 then begin
    play.row:=1;
    inc(play.order,1);
    if play.order>song.length then begin
     play.order:=1;
     play.row:=1;
     play.speed:=song.speed;
     play.bpm:=song.bpm;
{     play.tick:=play.speed;}
     play.patterndelay:=0;
     waveform.retrigvib:=true;
     waveform.retrigtre:=true;
     waveform.vibrato:=0;
     waveform.tremolo:=0;
     glissando:=false;
     setbpm(play.bpm);
    end;
   end;
  end else dec(play.patterndelay,1);
 end else update_effect;
 asm
  mov ax,[timspeed];
  add [counter],ax;
  jnc @eivanhaa;
  pushf;
  call oldkello;
  jmp @end;
 @eivanhaa:
  mov al,$20;
  out $20,al;
 @end:
 end;
 restr2;
end;
{$F-}

{$S-}
procedure initplaying;
var i:byte;
begin
 play.speed:=song.speed;
 play.bpm:=song.bpm;
 play.tick:=play.speed;
 play.order:=1;
 play.row:=1;
 play.patterndelay:=0;
 for i:=1 to 32 do begin
  fillchar(channa[i],sizeof(channa[i]),0);
  channa[i].whicheffect:=nothing;
  channa[i].lastnote:=$ff;
  channa[i].lastinstru:=0;
  channa[i].vslide:=false;
  channa[i].volume:=0;
 end;
 waveform.retrigvib:=true;
 waveform.retrigtre:=true;
 waveform.vibrato:=0;
 waveform.tremolo:=0;
 glissando:=false;
 for i:=1 to module.maxsamples-1 do samples[i].offset:=0;
 counter:=0;
 asm cli; end;
 oldkello:=getintvek($08);
 setintvek($08,@modplay);
 setbpm(play.bpm);
 asm sti; end;
end;

{$S-}
procedure deinitplaying;
begin
 asm cli; end;
 port[$43]:=$36;
 port[$40]:=0;
 port[$40]:=0;
 setintvek($08,oldkello);
 asm sti; end;
end;
[ RETURN TO DIRECTORY ]