{$A+,B+,D-,E-,F-,G+,I-,L-,N-,O-,P-,Q-,R-,S-,T-,V-,X+,Y-}
{AdnMod 0.2 by Beta/Adrenalin.
GUS only
Thanks to:
flap / Capacala for sending me "some" info
Mark Feldham for PCGPE
Mark Dixon for his GUS669 source
Thunder for excellent info about MODs
Tran & Joshua C. Jensen for releasing ultradox
Greets:
Wihannes / Nordic vision
Solar / Hysteria
Psyko / Acidface software
TOP4.ZIP
All users of Metropoli & Starport
}
unit modunit;
interface
uses dos;
const
maxchn = 8; {max # of channels in mod. Lower this, if you run out
of memory}
amp_vol : byte = 14; {amplifying volume. Increasing by one doubles
the volume}
def_pan : byte = 4; {default panning. 0-7}
max_per = 1000; {Max & min period for Amiga limits}
min_per = 20; {not implemented anymore coz of extra octaves}
Base : word = $200; {GUS address}
mod_error : word = 0;
{0 = no error
1 = wrong number of channels
2 = load error
3 = out of pattern memory
255 = other error}
per_table : array[0..15,1..48 ] of word = (
(856,808,762,720,678,640,604,570,538,508,480,453,
428,404,381,360,339,320,302,285,269,254,240,226,
214,202,190,180,170,160,151,143,135,127,120,113,
107,101,95,90,85,80,75,71,67,63,60,56),
(850,802,757,715,674,637,601,567,535,505,477,450,{ : C-1 to B-1 Finetune +1}
425,401,379,357,337,318,300,284,268,253,239,225, { : C-2 to B-2 Finetune +1}
213,201,189,179,169,159,150,142,134,126,119,113, { : C-3 to B-3 Finetune +1}
106,100,94,89,84,79,75,71,67,83,59,56), { : C-4 to B-4 Finetune +1}
(844,796,752,709,670,632,597,563,532,502,474,447,{ : C-1 to B-1 Finetune +2}
422,398,376,355,335,316,298,282,266,251,237,224, { : C-2 to B-2 Finetune +2}
211,199,188,177,167,158,149,141,133,125,118,112, { : C-3 to B-3 Finetune +2}
105, 99, 94, 88, 83, 79, 74, 70, 66, 62, 59, 56),{ : C-4 to B-4 Finetune +2}
(838,791,746,704,665,628,592,559,528,498,470,444,{ : C-1 to B-1 Finetune +3}
419,395,373,352,332,314,296,280,264,249,235,222, { : C-2 to B-2 Finetune +3}
209,198,187,176,166,157,148,140,132,125,118,111, { : C-3 to B-3 Finetune +3}
104, 99, 93, 88, 83, 78, 74, 70, 66, 62, 59, 55),{ : C-4 to B-4 Finetune +3}
(832,785,741,699,660,623,588,555,524,495,467,441,{ : C-1 to B-1 Finetune +4}
416,392,370,350,330,312,294,278,262,247,233,220, { : C-2 to B-2 Finetune +4}
208,196,185,175,165,156,147,139,131,124,117,110, { : C-3 to B-3 Finetune +4}
104, 98, 92, 87, 82, 78, 73, 69, 65, 62, 58, 55), {; C-4 to B-4 Finetune +4}
(826,779,736,694,655,619,584,551,520,491,463,437,{ : C-1 to B-1 Finetune +5}
413,390,368,347,328,309,292,276,260,245,232,219, { : C-2 to B-2 Finetune +5}
206,195,184,174,164,155,146,138,130,123,116,109, { : C-3 to B-3 Finetune +5}
103, 97, 92, 87, 82, 77, 73, 69, 65, 61, 58, 54),{ ; C-4 to B-4 Finetune +5}
(820,774,730,689,651,614,580,547,516,487,460,434,{ : C-1 to B-1 Finetune +6}
410,387,365,345,325,307,290,274,258,244,230,217, { : C-2 to B-2 Finetune +6}
205,193,183,172,163,154,145,137,129,122,115,109, { : C-3 to B-3 Finetune +6}
102, 96, 91, 86, 81, 77, 72, 68, 64, 61, 57, 54),{ : C-4 to B-4 Finetune +6}
(814,768,725,684,646,610,575,543,513,484,457,431,{ : C-1 to B-1 Finetune +7}
407,384,363,342,323,305,288,272,256,242,228,216, { : C-2 to B-2 Finetune +7}
204,192,181,171,161,152,144,136,128,121,114,108, { : C-3 to B-3 Finetune +7}
102, 96, 90, 85, 80, 76, 72, 68, 64, 60, 57, 54),{ : C-4 to B-4 Finetune +7}
(907,856,808,762,720,678,640,604,570,538,504,480,{ : C-1 to B-1 Finetune -8 }
453,428,404,381,360,339,320,302,285,269,254,240, { : C-2 to B-2 Finetune -8 }
226,214,202,190,180,170,160,151,143,135,127,120, { : C-3 to B-3 Finetune -8 }
113,107,101, 95, 90, 85, 80, 75, 71, 67, 63, 60),{ : C-4 to B-4 Finetune -8}
(900,850,802,757,715,675,636,601,567,535,505,477,{ : C-1 to B-1 Finetune -7 }
450,425,401,379,357,337,318,300,284,268,253,238, { : C-2 to B-2 Finetune -7 }
225,212,200,189,179,169,159,150,142,134,126,119, { : C-3 to B-3 Finetune -7 }
112,106,100, 94, 89, 84, 79, 75, 71, 67, 63, 59),{ : C-4 to B-4 Finetune -7}
(894,844,796,752,709,670,632,597,563,532,502,474,{ : C-1 to B-1 Finetune -6 }
447,422,398,376,355,335,316,298,282,266,251,237, { : C-2 to B-2 Finetune -6 }
223,211,199,188,177,167,158,149,141,133,125,118, { : C-3 to B-3 Finetune -6 }
111,105, 99, 94, 88, 83, 79, 74, 70, 66, 62, 59),{ : C-4 to B-4 Finetune -6}
(887,838,791,746,704,665,628,592,559,528,498,470,{ : C-1 to B-1 Finetune -5 }
444,419,395,373,352,332,314,296,280,264,249,235, { : C-2 to B-2 Finetune -5 }
222,209,198,187,176,166,157,148,140,132,125,118, { : C-3 to B-3 Finetune -5 }
111,104, 99, 93, 88, 83, 78, 74, 70, 66, 62, 59),{ : C-4 to B-4 Finetune -5}
(881,832,785,741,699,660,623,588,555,524,494,467,{ : C-1 to B-1 Finetune -4 }
441,416,392,370,350,330,312,294,278,262,247,233, { : C-2 to B-2 Finetune -4 }
220,208,196,185,175,165,156,147,139,131,123,117, { : C-3 to B-3 Finetune -4 }
110,104, 98, 92, 87, 82, 78, 73, 69, 65, 61, 58),{ C-4 to H-4 Finetune -4}
(875,826,779,736,694,655,619,584,551,520,491,463,{ : C-1 to B-1 Finetune -3 }
437,413,390,368,347,338,309,292,276,260,245,232, { : C-2 to B-2 Finetune -3 }
219,206,195,184,174,164,155,146,138,130,123,116, { : C-3 to B-3 Finetune -3 }
109,103, 97, 92, 87, 82, 77, 73, 69, 65, 61, 58),{ C-4 to H-4 Finetune -3}
(868,820,774,730,689,651,614,580,547,516,487,460,{ : C-1 to B-1 Finetune -2 }
434,410,387,365,345,325,307,290,274,258,244,230, { : C-2 to B-2 Finetune -2 }
217,205,193,183,172,163,154,145,137,129,122,115, { : C-3 to B-3 Finetune -2 }
108,102, 96, 91, 86, 81, 77, 72, 68, 64, 61, 57),{ C-4 to H-4 Finetune -2}
(862,814,768,725,684,646,610,575,543,513,484,457,{ : C-1 to B-1 Finetune -1 }
431,407,384,363,342,323,305,288,272,256,242,228, { : C-2 to B-2 Finetune -1 }
216,203,192,181,171,161,152,144,136,128,121,114, { : C-3 to B-3 Finetune -1}
108,101, 96, 90, 85, 80, 76, 72, 68, 64, 60, 57));{ C-4 to H-4 Finetune -1}
gusvol : array[0..64] of word = {volume table}
(0,1750,2503,2701,2741,2781,2944,2964,2981,
3000,3017,3034,3052,3070,3207,3215,3224,
3232,3240,3248,3256,3263,3271,3279,3287,
3294,3303,3310,3317,3325,3458,3462,3466,
3469,3473,3478,3481,3484,3489,3492,3495,
3499,3502,3506,3509,3513,3517,3520,3524,
3528,3532,3534,3538,3543,3545,3549,3552,
3556,3558,3563,3565,3570,3573,3577,3580);
vib_tbl : array[0..2,0..63] of shortint =
((0,6,12,19,24,30,36,41,45,49,53,56,59,61,63,64,
64,64,63,61,59,56,53,49,45,41,36,30,24,19,12,6,
0,-6,-12,-19,-24,-30,-36,-41,-45,-49,-53,-56,-59,-61,-63,-64,
-64,-64,-63,-61,-59,-56,-53,-49,-45,-41,-36,-30,-24,-19,-12,-6),
(-63,-61,-59,-57,-55,-53,-51,-49,-47,-45,-43,-41,-39,-37,-35,-33,
-31,-29,-27,-25,-23,-21,-19,-17,-15,-13,-11,-9,-7,-5,-3,-1,
1,3,5,7,9,11,13,15,17,19,21,23,25,27,29,31,
33,35,37,39,41,43,45,47,49,51,53,55,57,59,61,63),
(-64,-64,-64,-64,-64,-64,-64,-64,-64,-64,-64,-64,-64,-64,-64,-64,
-64,-64,-64,-64,-64,-64,-64,-64,-64,-64,-64,-64,-64,-64,-64,-64,
64,64,64,64,64,64,64,64,64,64,64,64,64,64,64,64,
64,64,64,64,64,64,64,64,64,64,64,64,64,64,64,64));
type
t_memarray = array[0..2000] of word;
t_channel = record
Vol : byte; {current volume 0-64}
note : byte; {current note 1(C-1) to 48(B-4)}
Per,dper : word; {period & dest. period for tone portamentos}
Sample : byte; {current sample}
Pan : byte; {panning}
fx,fxdata : byte;
fx_sl2,fx_vib : byte; {slide to & vibrato fx-data}
vib_wave : byte; {vibrato waveform}
vib_cnt : byte; {vibrato counter}
trig_cnt : byte; {retrig counter}
arp1,arp2, {arpeggio params}
arp_cnt : byte; {arpeggio counter}
start_fx : byte; {tick to start do_fx for channel}
on : byte; {0 = channel is muted}
bar : byte; {volume bar}
hit : byte;
no_fx : byte {1 = do not get new fx}
end;
t_sample = record
Name : array[1..40] of char;
Addr : longint; {address in GUS mem}
Length : word;
LoopStart,
LoopEnd : word;
ftune : byte;
Volume : byte;
end;
t_note = record
per : word;
note,
sample,
fx,
fxdata : byte;
end;
t_row = array[0..maxchn-1] of t_note;
t_pattern = array[0..63] of t_row;
p_pattern = ^t_pattern;
mod_header = record
name : string[20];
Length : byte;
tag : array[0..3] of char; {M.K.}
chns : byte; {4..12}
samples : byte; {15 / 31}
end;
var
gus_addr : array[0..32] of longint;
periods : array[0..1100] of word;
channels : array[0..maxchn-1] of t_channel;
samples : array[0..32] of t_sample;
patterns : array[0..128] of p_pattern;
orders : array[0..255] of byte; {order list}
max_ptn : word; {# patterns in mod}
cur_ptn,cur_row,cur_tick : byte;
new_ptn,new_row,jump : byte; {used in jumps}
speed,nspeed,tempo : byte;
vblank : boolean; {true = do not use bpm tempos}
header : mod_header;
top_addr : longint; {Next free address in GUS mem}
time_counter : longint; {For syncing with demos. Increments
every 1/18.2 seconds}
time_counter2 : longint; {Increments every tick}
vrt_flag : byte; {if 1 then vertical retrace happened}
Procedure GUSDelay;
Function VoicePos( V : Byte) : Longint;
Function GUSPeek(Loc : Longint) : Byte;
Procedure GUSPoke(Loc : Longint; B : Byte);
Function GUSProbe(adr : word) : Boolean;
Procedure GUSFind;
Function GUSFindMem : Longint;
Procedure GUSSetFreq( V : Byte; hz : Word);
Procedure GUSVoiceControl( V, B : Byte);
Procedure GUSSetBalance( V, Bal : Byte);
Procedure GUSSetVolume( V : Byte; Vol : Word);
Procedure GUSSetLoopMode( V : Byte);
Procedure GUSStopVoice( V : Byte);
Procedure GUSPlayVoice( V, Mode : Byte;VBegin, VStart, VEnd : Longint);
procedure gusrelvoice(v : byte);
procedure GusSetOfs(v : byte;vbegin : longint);
Procedure GUSReset;
procedure gusdeinit;
procedure updatenotes;
procedure start_playing;
procedure stop_playing;
procedure set_timer(ticks : word);
procedure init_mod;
procedure free_mod;
procedure load_mod(s : string;debug : boolean);
implementation
var
oldint : procedure;
int_tick,o_int_tick : word;
int_rate : word;
gus_bank : longint;
misc_buf : array[0..5000] of byte; {buffer used while loading mod}
misc_buf2 : ^t_memarray; {points to misc_buf}
{$i gus.inc}
{$s-}
procedure get_notes;
var
chn : byte;
ptn : byte;
org_sam,sam,note : byte;
st_ofs : longint;
per,dper,vol,freq : word;
_fx,_fxdata : byte;
mute: byte;
_ptn : p_pattern;
procedure prefx;
var
w : word;
_efxdata : byte;
begin
case _fx of
9 : begin
w := _fxdata*$100;
st_ofs := w;
channels[chn].no_fx := 1;
channels[chn].fx := _fx;
channels[chn].fxdata := _fxdata;
end;
$c : begin
if _fxdata > 64 then _fxdata := 64;
vol := _fxdata;
end;
$e : begin
_efxdata := _fxdata and 15;
case _fxdata shr 4 of
4 : begin
channels[chn].fx := _fx;
channels[chn].fxdata := _fxdata;
if _efxdata and 3 < 3 then channels[chn].vib_wave := _efxdata
else channels[chn].vib_wave := 0 or (_efxdata and 4);
end;
$c : if _efxdata and 15 = 0 then begin
mute := 1;
gusstopvoice(chn+1);
end;
$d : if _efxdata > 0 then mute := 2
else mute := 0;
end;
end;
end;
end;
begin
ptn := orders[cur_ptn];
for chn := 0 to header.chns-1 do begin
if channels[chn].fx = 0 then begin
sam := channels[chn].sample;
per := per_table[samples[sam].ftune,
channels[chn].note];
gussetfreq(chn+1,periods[per]);
end;
channels[chn].hit := 0;
if ((patterns[ptn]^[cur_row,chn].per > 0) or
(patterns[ptn]^[cur_row,chn].sample > 0)) then begin
mute := 1;
vol := channels[chn].vol;
per := channels[chn].per;
note := channels[chn].note;
freq := periods[channels[chn].per];
_fx := patterns[ptn]^[cur_row,chn].fx;
_fxdata := patterns[ptn]^[cur_row,chn].fxdata;
org_sam := patterns[ptn]^[cur_row,chn].sample;
channels[chn].start_fx := 0;
channels[chn].trig_cnt := 0;
if org_sam = 0 then begin
sam := channels[chn].sample;
end
else begin
sam := org_sam;
end;
if (_fx = 3) or (_fx = 5) then begin {port to/port to&vol slide}
mute := 1; {dont restart sample}
if patterns[ptn]^[cur_row,chn].note > 0 then begin
note := patterns[ptn]^[cur_row,chn].note;
dper := per_table[samples[sam].ftune,note];
if dper > max_per then dper := max_per;
if dper < min_per then dper := min_per;
channels[chn].dper := dper;
end;
end
else if patterns[ptn]^[cur_row,chn].per > 0 then begin
if patterns[ptn]^[cur_row,chn].note > 0 then begin
note := patterns[ptn]^[cur_row,chn].note;
per := per_table[samples[sam].ftune,note];
end
else if patterns[ptn]^[cur_row,chn].per > 0 then
per := patterns[ptn]^[cur_row,chn].per;
if per > max_per then per := max_per;
if per < min_per then per := min_per;
channels[chn].dper := per;
channels[chn].per := per;
freq := periods[per];
mute := 0;
end;
if org_sam > 0 then begin {should I reset volume}
vol := samples[sam].volume;
if channels[chn].sample <> org_sam then mute := 0;
end;
if samples[sam].length > 0 then st_ofs := 2;
{coz first 2 bytes = amiga loopinfo, discard them}
channels[chn].no_fx := 0;
prefx;
channels[chn].vol := vol;
channels[chn].note := note;
if channels[chn].vib_wave and 4 = 0 then channels[chn].vib_cnt := 0;
channels[chn].sample := sam;
channels[chn].bar := channels[chn].vol;
vol := gusvol[vol]*amp_vol;
if channels[chn].on = 0 then mute := 1;
if mute = 0 then begin
channels[chn].hit := 1;
gussetbalance(chn+1,channels[chn].pan);
if (samples[sam].loopend > 2) then
gusplayall(chn+1,8,gus_addr[sam]+st_ofs,
gus_addr[sam]+samples[sam].loopstart,
gus_addr[sam]+samples[sam].loopend,freq,vol)
else gusplayall(chn+1,0,gus_addr[sam]+st_ofs,
gus_addr[sam]+st_ofs,
gus_addr[sam]+samples[sam].length,freq,vol);
end
else if (channels[chn].on = 1) and (mute=1) then gussetvolume(chn+1,vol);
end;
end;
end;
procedure get_fx;
var
chn,ptn : byte;
_fx,_fxdata : byte;
_efx,_efxdata : byte;
per : word;
b : byte;
w : word;
begin
ptn := orders[cur_ptn];
new_ptn := cur_ptn;
new_row := cur_row;
jump := 0;
for chn := 0 to header.chns-1 do
if channels[chn].no_fx = 0 then begin
channels[chn].start_fx := 0;
channels[chn].fx := 255;
_fx := patterns[ptn]^[cur_row,chn].fx;
_fxdata := patterns[ptn]^[cur_row,chn].fxdata;
case _fx of
0 : if _fxdata > 0 then begin {Arpeggio}
channels[chn].fx := _fx;
channels[chn].fxdata := _fxdata;
channels[chn].arp1 := _fxdata shr 4;
channels[chn].arp2 := _fxdata and 15;
channels[chn].arp_cnt := 0;
end;
1 : begin {port up}
channels[chn].fx := _fx;
channels[chn].fxdata := _fxdata;
channels[chn].start_fx := 2;
end;
2 : begin {port down}
channels[chn].fx := _fx;
channels[chn].fxdata := _fxdata;
channels[chn].start_fx := 2;
end;
3 : begin {port to}
channels[chn].fx := _fx;
if _fxdata > 0 then begin
channels[chn].fxdata := _fxdata;
channels[chn].fx_sl2 := _fxdata;
end
else channels[chn].fxdata := channels[chn].fx_sl2;
channels[chn].start_fx := 2;
end;
4 : begin {vibrato}
channels[chn].fx := _fx;
b := _fxdata and 15;
if b = 0 then b := channels[chn].fx_vib and 15;
w := b;
b := _fxdata shr 4;
if b = 0 then b := channels[chn].fx_vib shr 4;
w := w or (b shl 4);
b := w;
channels[chn].fxdata := b;
channels[chn].fx_vib := b;
end;
5 : begin {port to & vol slide}
channels[chn].fx := _fx;
if _fxdata and 15 > 0 then
_fxdata := _fxdata and 15; {if both ways, then slide down}
channels[chn].fxdata := _fxdata;
end;
6 : begin {Vibrato & vol slide}
channels[chn].fx := _fx;
channels[chn].fxdata := _fxdata;
end;
7 : begin {Tremolo}
channels[chn].fx := _fx;
channels[chn].fxdata := _fxdata;
end;
8 : begin {Set panning}
channels[chn].fx := _fx;
channels[chn].fxdata := _fxdata;
end;
9 : begin {set sample offset}
channels[chn].fx := _fx;
channels[chn].fxdata := _fxdata;
w := _fxdata * 256;
b := channels[chn].sample;
if channels[chn].on = 1 then gussetofs(chn+1,gus_addr[b]+w);
end;
$a : begin {volume slide}
channels[chn].fx := _fx;
if _fxdata and 15 > 0 then
_fxdata := _fxdata and 15; {if both ways, then slide up}
channels[chn].fxdata := _fxdata;
channels[chn].start_fx := 2;
end;
$b : begin {position jump}
if _fxdata < max_ptn then begin
new_ptn := _fxdata;
new_row := 0;
jump := 1;
end;
end;
$c : begin {Set volume}
if _fxdata > 64 then _fxdata := 64;
channels[chn].fx := _fx;
channels[chn].fxdata := _fxdata;
channels[chn].vol := _fxdata;
channels[chn].bar := _fxdata;
w := gusvol[_fxdata {* main_vol}]*amp_vol;
if channels[chn].on = 1 then gussetvolume(chn+1,w);
end;
$d : begin {break pattern}
new_ptn := cur_ptn;
inc(new_ptn);
new_row := ((_fxdata and $f0) shr 4)*10+_fxdata and 15;
jump := 1;
end;
$e : begin {extended effect}
channels[chn].fx := _fx;
channels[chn].fxdata := _fxdata;
_efx := _fxdata shr 4;
_efxdata := _fxdata and 15;
case _efx of
1 : begin
per := channels[chn].per;
inc(per,_efxdata);
if per > max_per then per := max_per;
channels[chn].per := per;
w := periods[channels[chn].per];
gussetfreq(chn+1,w);
end;
2 : begin
per := channels[chn].per;
dec(per,_efxdata);
if per < min_per then per := min_per;
channels[chn].per := per;
w := periods[channels[chn].per];
gussetfreq(chn+1,w);
end;
4 : begin {set vibrato waveform}
channels[chn].vib_wave := _efxdata;
end;
5 : begin {set finetune}
samples[channels[chn].sample].ftune := _efxdata;
end;
8 : begin {set mtm-pan}
channels[chn].pan := _efxdata;
gussetbalance(chn+1,_efxdata);
end;
9 : if _efxdata > 0 then begin {retrigger}
channels[chn].fx := _fx;
channels[chn].fxdata := _fxdata;
channels[chn].trig_cnt := _efxdata;
end;
$a : begin {fine vol slide up}
b := channels[chn].vol;
inc(b,_efxdata);
if b > 64 then b := 64;
channels[chn].vol := b;
w := gusvol[b{*main_vol}]*amp_vol;
if channels[chn].on = 1 then gussetvolume(chn+1,w);
channels[chn].bar := b;
end;
$b : begin {fine vol slide down}
b := channels[chn].vol;
dec(b,_efxdata);
if b > 128 then b := 0;
channels[chn].vol := b;
w := gusvol[b{*main_vol}]*amp_vol;
if channels[chn].on = 1 then gussetvolume(chn+1,w);
channels[chn].bar := b;
end;
$c : begin {cut note}
channels[chn].fx := _fx;
channels[chn].fxdata := _fxdata;
end;
$d : if _efxdata > 0 then begin
channels[chn].fx := _fx;
channels[chn].fxdata := _fxdata;
channels[chn].start_fx := 1+_efxdata;
end
else channels[chn].fx := 255;
end;
end;
$f : begin {set speed}
channels[chn].fx := _fx;
channels[chn].fxdata := _fxdata;
if (_fxdata <= 32) or vblank then begin {SPEED not tempo}
nspeed := _fxdata;
speed := _fxdata;
end
else begin
tempo := _fxdata;
if tempo < 50 then tempo := 50;
int_rate := 1193182 div (tempo*4 div 10);
set_timer(int_rate);
end;
end
else begin
channels[chn].fx := 255;
channels[chn].fxdata := 0;
end;
end;
end
else channels[chn].no_fx := 0;
end;
procedure do_fx;
var
chn : byte;
_fx,_fxdata : byte;
_efx,_efxdata : byte;
per : word;
b : byte;
s : shortint;
w : word;
begin
for chn := 0 to header.chns-1 do if channels[chn].on = 1 then begin
if channels[chn].start_fx > 0 then dec(channels[chn].start_fx);
_fx := channels[chn].fx;
_fxdata := channels[chn].fxdata;
if (channels[chn].on = 1) and (channels[chn].start_fx = 0)
then case _fx of
0 : with channels[chn] do begin
case channels[chn].arp_cnt mod 3 of
0 : gussetfreq(chn+1,
periods[per_table[samples[sample].ftune,note]]);
1 : gussetfreq(chn+1,
periods[per_table[samples[sample].ftune,note+arp1]]);
2 : gussetfreq(chn+1,
periods[per_table[samples[sample].ftune,note+arp2]]);
end;
inc(arp_cnt);
end;
1 : begin {port up}
per := channels[chn].per;
dec(per,_fxdata);
if per < min_per then per := min_per;
channels[chn].per := per;
gussetfreq(chn+1,periods[per]);
end;
2 : begin {port down}
per := channels[chn].per;
inc(per,_fxdata);
if per > max_per then per := max_per;
channels[chn].per := per;
gussetfreq(chn+1,periods[per]);
end;
3 : begin {Port to}
if channels[chn].per < channels[chn].dper then begin
w := channels[chn].dper;
per := channels[chn].per;
inc(per,channels[chn].fx_sl2);
if per > w then per := w;
if per > max_per then per := max_per;
if per < min_per then per := min_per;
channels[chn].per := per;
gussetfreq(chn+1,periods[per]);
end
else begin
w := channels[chn].dper;
per := channels[chn].per;
if per-channels[chn].fx_sl2 > per then per := min_per
else dec(per,channels[chn].fx_sl2);
if per < w then per := w;
if per < min_per then per := min_per;
if per > max_per then per := max_per;
channels[chn].per := per;
gussetfreq(chn+1,periods[per]);
end;
end;
4 : begin
_fxdata := channels[chn].fx_vib;
b := _fxdata and 15;
s := vib_tbl[channels[chn].vib_wave,channels[chn].vib_cnt];
s := (s * b) div 64;
w := channels[chn].per+s;
if w > max_per then w := max_per;
if w < min_per then w := min_per;
b := _fxdata shr 4;
gussetfreq(chn+1,periods[w]);
inc(channels[chn].vib_cnt,b);
if channels[chn].vib_cnt > 63 then
channels[chn].vib_cnt := channels[chn].vib_cnt - 64;
end;
5 : begin
{volume slide}
if _fxdata and 15 > 0 then begin {slide down}
b := channels[chn].vol;
if b-_fxdata >= 0 then dec(b,_fxdata)
else b := 0;
if b > 128 then b := 0;
channels[chn].vol := b;
channels[chn].bar := b;
w := gusvol[b {* main_vol}]*amp_vol;
gussetvolume(chn+1,w);
end
else begin {slide up}
b := channels[chn].vol;
inc(b,_fxdata shr 4);
if b > 64 then b := 64;
channels[chn].vol := b;
channels[chn].bar := b;
w := gusvol[b {* main_vol}]*amp_vol;
gussetvolume(chn+1,w);
end;
_fxdata := channels[chn].fx_sl2;
if channels[chn].per < channels[chn].dper then begin {port to}
w := channels[chn].dper;
per := channels[chn].per;
inc(per,_fxdata);
if per > w then per := w;
if per > max_per then per := max_per;
if per < min_per then per := min_per;
channels[chn].per := per;
gussetfreq(chn+1,periods[per]);
end
else begin
w := channels[chn].dper;
per := channels[chn].per;
if per-_fxdata > per then per := min_per
else dec(per,_fxdata);
if per < w then per := w;
if per < min_per then per := min_per;
if per > max_per then per := max_per;
channels[chn].per := per;
gussetfreq(chn+1,periods[per]);
end;
end;
6 : begin
begin
b := channels[chn].fx_vib and 15;
s := vib_tbl[channels[chn].vib_wave,channels[chn].vib_cnt];
s := (s * b) div 64;
w := channels[chn].per+s;
if w > max_per then w := max_per;
if w < min_per then w := min_per;
b := channels[chn].fx_vib shr 4;
gussetfreq(chn+1,periods[w]);
inc(channels[chn].vib_cnt,b);
if channels[chn].vib_cnt > 63 then
channels[chn].vib_cnt := channels[chn].vib_cnt - 64;
end;
{volume slide}
if _fxdata and 15 > 0 then begin {slide down}
b := channels[chn].vol;
if b-_fxdata >= 0 then dec(b,_fxdata)
else b := 0;
if b > 128 then b := 0;
channels[chn].vol := b;
channels[chn].bar := b;
w := gusvol[b {* main_vol}]*amp_vol;
gussetvolume(chn+1,w);
end
else begin {slide up}
b := channels[chn].vol;
inc(b,_fxdata shr 4);
if b > 64 then b := 64;
channels[chn].vol := b;
channels[chn].bar := b;
w := gusvol[b {* main_vol}]*amp_vol;
gussetvolume(chn+1,w);
end;
end;
$a : begin {volume slide}
if _fxdata and 15 > 0 then begin {slide down}
b := channels[chn].vol;
if b < (_fxdata and 15) then b := 0
else dec(b,_fxdata and 15);
if b > 64 then b := 0;
channels[chn].vol := b;
channels[chn].bar := b;
w := gusvol[b]*amp_vol;
gussetvolume(chn+1,w);
end
else begin {slide up}
b := channels[chn].vol;
inc(b,_fxdata shr 4);
if b > 64 then b := 64;
channels[chn].vol := b;
channels[chn].bar := b;
w := gusvol[b {* main_vol}]*amp_vol;
gussetvolume(chn+1,w);
end;
end;
$e : begin
_efx := _fxdata shr 4;
_efxdata := _fxdata and 15;
case _efx of
9 : begin
b := channels[chn].sample;
dec(channels[chn].trig_cnt);
if channels[chn].trig_cnt = 0 then begin
gussetofs(chn+1,gus_addr[b]+2);
channels[chn].trig_cnt := _efxdata;
end;
end;
$c : if _efxdata = 0 then begin
gussetvolume(chn+1,0);
end
else begin
dec(_efxdata);
b := _fxdata;
b := b and $f0;
b := b or _efxdata;
channels[chn].fxdata := b;
end;
$d : begin
w := channels[chn].sample;
if channels[chn].on = 1 then begin
channels[chn].hit := 1;
gussetbalance(chn+1,channels[chn].pan);
if (samples[w].loopend > 2) then
gusplayall(chn+1,8,gus_addr[w]+2,
gus_addr[w]+samples[w].loopstart,
gus_addr[w]+samples[w].loopend,
periods[channels[chn].per],
gusvol[channels[chn].vol]*amp_vol)
else gusplayall(chn+1,0,gus_addr[w]+2,
gus_addr[w],
gus_addr[w]+samples[w].length+1,
periods[channels[chn].per],
gusvol[channels[chn].vol]*amp_vol);
end;
end;
end;
end;
end;
end;
end;
procedure updatenotes;
var
n : integer;
begin
if cur_ptn > header.length-1 then new_ptn := 0;
cur_ptn := new_ptn;
cur_row := new_row;
if (cur_tick >= speed) and (speed > 0) then begin
speed := nspeed;
cur_tick := 0;
if jump = 0 then inc(cur_row);
if cur_row > 63 then begin
inc(cur_ptn);
cur_row := 0;
if cur_ptn > header.length-1 then begin
new_ptn := 0;
cur_ptn := 0;
end;
end;
end;
for n := 0 to maxchn-1 do begin
if channels[n].bar > 1 then dec(channels[n].bar,2)
else channels[n].bar := 0;
end;
new_ptn := cur_ptn;
new_row := cur_row;
if speed > 0 then begin
inc(cur_tick);
if cur_tick = 1 then begin
get_notes;
if port[$3da] and 8 = 8 then vrt_flag := 1;
get_fx;
end;
if port[$3da] and 8 = 8 then vrt_flag := 1;
do_fx;
if port[$3da] and 8 = 8 then vrt_flag := 1;
end;
end;
procedure modint; interrupt;
{This happens bpm*4/10 times per second (50hz if vblank).}
begin
asm sti end;
if port[$3da] and 8 = 8 then vrt_flag := 1;
inc(time_counter2);
updatenotes;
o_int_tick := int_tick;
int_tick := int_tick + int_rate;
if o_int_tick > int_tick then begin
inc(time_counter);
asm
cli
pushf
call oldint
end;
end
else
asm
mov al,20h
out 20h,al {send EOI}
end;
end;
{$s+}
procedure load_MOD(s : string;debug : boolean);
var
f : file;
procedure set_up_modheader;
var
chn : integer;
begin
header.samples := 31;
header.name[0] := #20;
move(misc_buf[0],header.name[1],20);
header.tag := ' ';
move(misc_buf[1080],header.tag,4);
chn := maxchn;
if header.tag = 'M.K.' then chn := 4
else if header.tag = 'M!K!' then chn := 4
else if header.tag = '6CHN' then chn := 6
else if header.tag = '8CHN' then chn := 8
else if header.tag = '12CH' then chn := 12
else begin
header.samples := 15;
chn := 4;
end;
if chn > maxchn then begin
mod_error := 1;
exit;
end;
if header.samples = 15 then begin
move(misc_buf[472],orders[0],128);
seek(f,600);
header.length := misc_buf[470];
header.chns := 4;
end else begin
header.length := misc_buf[950];
move(misc_buf[952],orders[0],128);
if debug then writeln('Tag: ',header.tag);
end;
header.chns := chn;
end;
procedure mod_sample_info;
var
n : integer;
maxi : integer;
begin
for n := 0 to 31 do begin
fillchar(samples[n].name,22,0);
samples[n].length := 0;
samples[n].ftune := 0;
samples[n].volume := 0;
samples[n].loopstart := 0;
samples[n].loopend := 0;
end;
for n := 1 to header.samples do begin
move(misc_buf[(n-1)*30+20],samples[n].name[1],22);
samples[n].name[23] := #0;
samples[n].length := 2*swap(misc_buf2^[(n-1)*15+21]); {n*30+42}
samples[n].ftune := misc_buf[(n-1)*30+44];
samples[n].volume := misc_buf[(n-1)*30+45];
samples[n].loopstart := 2*swap(misc_buf2^[(n-1)*15+23]); {n*30+46}
samples[n].loopend := 2*swap(misc_buf2^[(n-1)*15+24]); {n*30+48}
if samples[n].loopend < 3 then begin
samples[n].loopend := 0;
samples[n].loopstart := 0;
end;
inc(samples[n].loopend,samples[n].loopstart);
if samples[n].loopend > samples[n].length then
samples[n].loopend := samples[n].length;
end;
end;
procedure read_ptn(n : word);
var
row,note : integer;
w,w2,i : word;
b : byte;
mchn : byte;
begin
mchn := header.chns;
blockread(f,misc_buf,256*mchn);
for row := 0 to 63 do
for note := 0 to mchn-1 do begin
w := misc_buf2^[row*(2*mchn)+note*2];
w2 := misc_buf2^[row*(2*mchn)+note*2+1];
asm
mov cx,w
and cl,15
xchg cl,ch
and cx,0fffh
mov i,cx
end;
patterns[n]^[row,note].per := i;
asm
mov al,byte ptr w2
shr al,4
mov ah,byte ptr w
and ah,11110000b
or al,ah
xor ah,ah
mov i,ax
end;
patterns[n]^[row][note].sample := i;
patterns[n]^[row][note].fx := lo(w2) and 15;
patterns[n]^[row][note].fxdata := hi(w2);
i := patterns[n]^[row,note].per;
w := 0;
b := 0;
while b = 0 do begin
inc(w);
if (w > 48) or (i = per_table[0,w]) then b := 1;
end;
if w <= 48 then patterns[n]^[row,note].note := w
else patterns[n]^[row,note].note := 0;
end;
end;
procedure load_patterns;
var
num_ptn : longint;
n : word;
m_ptn : integer;
begin
if debug then write('Loading patterns');
num_ptn := 0;
for n := 0 to 127 do if orders[n] > num_ptn then begin
if orders[n] > 127 then begin
mod_error := 2;
exit;
end else num_ptn := orders[n];
end;
max_ptn := num_ptn+1;
for n := 0 to max_ptn-1 do begin
if maxavail < 256*header.chns then begin
mod_error := 3; {if error then release memory allocated}
if n >= max_ptn-2 then for n := 0 to max_ptn-2 do dispose(patterns[n]);
exit;
end;
if debug then write('.');
new(patterns[n]);
read_ptn(n);
end;
if debug then writeln;
end;
procedure load2gus(len : word);
var
{n : word;
addlo,addhi : word;}
l : longint;
begin
l := top_addr;
asm
mov di,len
mov si,offset misc_buf
@@1:
{AddLo := L AND $FFFF;
AddHi := longint(L and $ff0000) shr 16;}
mov ax,word ptr l
mov cx,ax {cx=addlo}
mov ax,word ptr l+2
and ax,0ffh
mov bx,ax {bx=addhi}
mov dx,command {Port [command] := $43;}
mov al,43h
out dx,al
mov dx,data_low {Portw[data_low] := AddLo;}
mov ax,cx
out dx,ax
mov dx,command {Port [command] := $44;}
mov al,44h
out dx,al
mov dx,data_high
mov ax,bx
out dx,ax {Port [data_high] := AddHi;}
add word ptr l,1 {inc(l,1);}
adc word ptr l+2,0
mov dx,dram_io {Port [dram_io] := misc_buf[n];}
outsb
dec di
jnz @@1
end;
inc(top_addr,len);
end;
procedure load_sample(num : word);
const
block = 4096;
var
w : word;
fl,l : word;
len : longint;
begin
if debug then write('.');
guspoke(top_addr,0);
inc(top_addr);
guspoke(top_addr,0);
inc(top_addr);
len := samples[num].length+top_addr;
if (len > gus_bank+$40000) and (top_addr < gus_bank+$40000) then begin
gus_bank := gus_bank+$40000;
top_addr := gus_bank;
end;
samples[num].addr := top_addr;
gus_addr[num] := top_addr;
if samples[num].length < 1 then exit;
{blockread(f,w,2);} {read amiga repeat bytes}
fl := (samples[num].length) div block;
l := (samples[num].length) mod block;
if fl > 0 then for w := 1 to fl do begin
blockread(f,misc_buf,block);
load2gus(block); {load in 4kb blocks}
end;
if l > 0 then begin
blockread(f,misc_buf,l);
load2gus(l); {load remainder}
end;
if samples[num].loopend > 2 then begin
guspoke(top_addr,guspeek(gus_addr[num]+samples[num].loopstart));
guspoke(gus_addr[num]+samples[num].loopend+1,
guspeek(gus_addr[num]+samples[num].loopstart));
inc(top_addr);
end;
end;
var
i : integer;
l : longint;
begin
gus_bank := 0;
assign(f,s);
{$i-}
reset(f,1);
blockread(f,misc_buf,1084); {read module header}
i := ioresult;
if i <> 0 then begin
mod_error := 2;
exit;
end;
set_up_modheader;
if mod_error <> 0 then exit;
mod_sample_info;
load_patterns;
if mod_error <> 0 then exit;
if debug then write('Loading samples');
for i := 0 to 31 do load_sample(i);
if debug then writeln;
close(f);
{$i+}
end;
procedure free_mod;
var
n,i : word;
begin
for n := max_ptn-1 downto 0 do dispose(patterns[n]);
top_addr := 16;
for n := 0 to 31 do with samples[n] do begin
addr := 0;
for i := 0 to sizeof(name) do name[i] := #0;
length := 0;
loopstart := 0;
loopend := 0;
ftune := 0;
volume := 0;
end;
gus_bank := 0;
end;
procedure init_mod;
var
n,i : integer;
l : longint;
begin
vrt_flag := 0;
misc_buf2 := @misc_buf;
for n := 10 to 1050 do begin
{gusperiod:=586580935 div (amigaperiod * (divisor div 100 shl 4))}
{divisor = 44100}
{l := 7093789 div (n*2);
l := l div 40;}
l := n;
l := 586580935 div (l * 7056);
periods[n] := l;
{hz = 7093789.2/(per*2)}
end;
for n := 0 to 255 do orders[n] := 0;
for n := 0 to maxchn-1 do begin
channels[n].vol := 64;
channels[n].per := 0;
channels[n].dper := 0;
channels[n].sample := 0;
channels[n].pan := 7; {middle}
channels[n].note := 0;
end;
for n := 0 to 31 do with samples[n] do begin
addr := 0;
for i := 0 to sizeof(name) do name[i] := #0;
length := 0;
loopstart := 0;
loopend := 0;
ftune := 0;
volume := 0;
end;
for n := 0 to 128 do patterns[n] := nil;
for n := 1 to 14 do gussetvolume(n,0);
for n := 1 to 14 do gusstopvoice(n);
cur_ptn := 0;
cur_row := 0;
new_ptn := 0;
new_row := 0;
cur_tick := 0;
for n := 0 to 31 do guspoke(n,0);
top_addr := 16;
gus_bank := 0;
vblank := false;
getintvec(8,@oldint);
end;
procedure set_timer(ticks : word);
begin
asm cli end;
port[$43] := $36;
port[$40] := lo(ticks);
port[$40] := hi(ticks);
asm sti end;
end;
procedure stop_playing;
var
n : integer;
begin
int_rate := 65535;
set_timer(65535);
setintvec(8,@oldint);
for n := 1 to maxchn do GusStopVoice(n);
end;
procedure start_playing;
var
n : integer;
begin
for n := 0 to maxchn-1 do begin
channels[n].vol := 0;
channels[n].per := 428;
channels[n].sample := 0;
channels[n].pan := 7; {middle}
channels[n].on := 1;
channels[n].dper := 428;
channels[n].bar := 0;
channels[n].fx := 255;
channels[n].fxdata := 0;
channels[n].fx_sl2 := 0;
channels[n].fx_vib := 0;
channels[n].vib_cnt := 0;
channels[n].vib_wave := 0;
channels[n].note := 0;
channels[n].hit := 0;
channels[n].no_fx := 0;
channels[n].start_fx := 0;
channels[n].arp1 := 0;
channels[n].arp2 := 0;
channels[n].arp_cnt := 0;
end;
speed := 6;
nspeed := 6;
tempo := 125;
channels[0].pan := 7-def_pan;
channels[1].pan := 7+def_pan;
channels[2].pan := 7+def_pan;
channels[3].pan := 7-def_pan;
if maxchn > 4 then for n := 4 to maxchn-1 do
channels[n].pan := channels[n-4].pan;
if maxchn > 8 then for n := 8 to maxchn-1 do
channels[n].pan := channels[n-8].pan;
jump := 0;
int_tick := 0;
cur_ptn := 0;
cur_row := 0;
new_ptn := 0;
new_row := 0;
cur_tick := 0;
time_counter := 0;
time_counter2 := 0;
asm cli end;
setintvec(8,@modint);
int_rate := 1193182 div 50;
set_timer(int_rate);
asm sti end;
end;
begin
end.
