{
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;