home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Hack-Phreak Scene Programs
/
cleanhpvac.zip
/
cleanhpvac
/
AMOD095.ZIP
/
MODUNIT.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1995-12-21
|
76KB
|
2,635 lines
{AdnMod 0.95 by Beta/A-Men.
GUS only (working on SB support)
Thanks to:
Gravis for great soundcard
flap / Capacala for sending me "some" info
Mark Feldman for PCGPE
Mark Dixon for his GUS669 source
Thunder for excellent info about MODs
Tran & Joshua C. Jensen for releasing ultradox
Greets:
Black Hole - Happy now??? ;-)
Wihannes / Nordic vision
Solar / Hysteria
Johnny Field ;-)
Trane
Psyko / Acidface software
ASYLUM.ZIP
All users of Metropoli & Starport
}
unit modunit;
{$s-}
{$g+}
{$x+}
{$a+}
{$o-}
{$r-}
interface
uses dos,modtypes;
{DEFINE __DEBUG__}
{DEFINE __FX__} {sound fx support}
{$DEFINE __LOADERS__}
{$DEFINE __S3M__} {s3m support}
{$DEFINE __MOD__} {mod support}
{DEFINE __MINI__}
const
mt_mod = 1;
mt_s3m = 2;
maxchn = 32; {max # of channels in mod.}
amp_vol : byte = 15; {amplifying volume. Increasing by one doubles
the volume}
{$IFDEF __FX__}
maxfxchn = 2;
fxchns : integer = 0;
fx_amp_vol : byte = 16; {amp vol for sound fx}
{$ENDIF}
{$IFDEF __S3M__}
def_s3mpan : array[0..31] of byte =
($3,$c,$3,$c,$3,$c,$3,$c,$3,$c,$3,$c,$3,$c,$3,$c,
$3,$c,$3,$c,$3,$c,$3,$c,$3,$c,$3,$c,$3,$c,$3,$c);
{$ENDIF}
{$IFDEF __MOD__}
def_modpan : array[0..31] of byte =
($3,$c,$c,$3,$3,$c,$c,$3,$3,$c,$c,$3,$3,$c,$c,$3,
$3,$c,$c,$3,$3,$c,$c,$3,$3,$c,$c,$3,$3,$c,$c,$3);
{$ENDIF}
max_per = 32000; {Max & min period }
min_per = 5;
gus_base : word = 0; {GUS address}
gus_irq : word = 0; {GUS IRQ}
ramp_speed = 31;
mod_error : word = 0;
{0 = no error
1 = too many channels
2 = load error
3 = out of pattern memory
255 = other error}
{$IFDEF __MOD__}
per_table : array[1..60] of word = (
1712,1616,1524,1440,1356,1280,1208,1140,1076,1016,960,906,
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);
note_table : array[1..60] of byte =
(32+0,32+1,32+2,32+3,32+4,32+5,32+6,32+7,32+8,32+9,32+10,32+11,
48+0,48+1,48+2,48+3,48+4,48+5,48+6,48+7,48+8,48+9,48+10,48+11,
64+0,64+1,64+2,64+3,64+4,64+5,64+6,64+7,64+8,64+9,64+10,64+11,
80+0,80+1,80+2,80+3,80+4,80+5,80+6,80+7,80+8,80+9,80+10,80+11,
96+0,96+1,96+2,96+3,96+4,96+5,96+6,96+7,96+8,96+9,96+10,96+11);
{$ENDIF}
ftune_per : array[0..15] of integer =
(8363,8413,8463,8529,8581,8651,8723,8757,
7895,7941,7985,8046,8107,8169,8232,8280);
st3_per : array[0..15] of integer =
(1712,1616,1524,1440,1356,1280,1208,1140,1076,1016,0960,0907,
1712,1712,1712,1712);
{$IFDEF __S3M__}
s3m_fx : array[0..28] of byte = (
255,16,$b,$d,21,17,18,3,4,255,0,6,
5,255,255,9,255,22,255,255,15,255,23,255,
8,255,255,255,255);
{$ENDIF}
gusvol : array[0..64] of word =
(0,1246,1502,1646,1758,1846,1902,1958,2014,2070,
2102,2130,2158,2186,2214,2242,2270,2298,2326,2344,
2358,2372,2386,2400,2414,2428,2442,2456,2470,2484,
2498,2512,2526,2540,2554,2568,2582,2593,2600,2607,
2614,2621,2628,2635,2642,2649,2656,2663,2670,2677,
2684,2691,2698,2705,2712,2719,2726,2733,2740,2747,
2754,2761,2768,2775,2782);
{gusperiod:=586580935 div (amigaperiod * (divisor div 100 shl 4))}
{divisor = 44100}
gus_div : array[1..32] of word =
(7056,7056,7056,7056,7056,7056,7056,7056,7056,7056,7056,7056,7056,7056,
6576,6160,5808,5488,5184,4928,4704,4480,4288,4112,3936,3792,3648,3520,
3392,3280,3184,3072);
gusdiv : word = 7056;
vib_tbl : array[0..2,0..63] of shortint = {192 bytes}
((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));
const
gst_vol = 1;
gst_pan = 2;
gst_ofs = 4;
gst_note = 16;
gst_stop = 32;
type
t_channel = record
{gvol : word;}
Vol : integer; {current volume 0-64}
note : integer; {current note lo=note, hi=octave}
basenote : integer;
Per,dper : word; {period & dest. period for tone portamentos}
Sample : byte; {current sample}
Pan : byte; {panning}
fx,fxdata : byte;
fx_sl2 : integer;
fx_vib : byte; {slide to & vibrato fx-data}
fx_portd,fx_portu : byte; {slide up & down fx-data}
vols : shortint; {vol slide speed}
fx_volslide : byte; {vol slide fx-data}
fx_trm : byte; {tremolo 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}
{$IFNDEF __MINI__}
bar : byte; {volume bar}
hit : byte;
{$ENDIF}
no_fx : byte; {1 = do not get new fx}
end;
p_channel = ^t_channel;
t_sample = record
_type : byte;
dosname : array[0..11] of char;
memseg : byte;
memofs : word;
length,
loopstart,
loopend : longint;
volume : byte;
ftune : byte;
pack : byte;
flags : byte;
c4spd : longint;
loop : boolean;
dumb2 : array[0..2] of byte;
intgp , int512 : word;
addr : longint;
name : string[27];
scrs : array[0..3] of char;
end;
t_note = record
note,
sample,
vol,
fx,
fxdata : byte;
end;
p_note = ^t_note;
t_pattern = array[0..(64*14)-1] of t_note;
p_pattern = ^t_pattern;
mod_header = record
name : string[30];
s3m_flags : byte;
Length : integer; {Number of orders in mod}
tag : array[0..3] of char; {M.K.}
chns : integer; {1..14}
samples : integer;
chn_set : array[0..31] of byte;
chn_pan : array[0..31] of byte;
ispeed,itempo : integer;
modtype : integer; {1=mod,2 = s3m}
usedchns : integer;
end;
{$IFDEF __S3M__}
p_s3mheader = ^t_s3mheader;
t_s3mheader = record
name : array[0..27] of char;
dumb1 : byte;
typ : byte;
dumb2 : integer;
ordnum,insnum,patnum : integer;
flags,ver,ffv : word;
scrm : array[0..3] of char;
gvol,ispeed,itempo,mvol,uc,dp : byte;
dumb3 : array[0..9] of byte;
chn_set : array[0..31] of byte;
data : array[0..400] of byte;
end;
{$ENDIF}
t_guschn = record
status : word;
per : longint;
offset : word;
sam : word;
ovol,vol : word;
pan : integer;
end;
var
gus_addr : array[0..99] of longint; {128 bytes}
channels : array[0..maxchn-1] of t_channel;
gus_chn : array[0..maxchn-1] of t_guschn;
samples : array[0..99] of t_sample; {8000 bytes}
{$IFDEF __FX__}
fx_samples : array[0..31] of t_sample;
fx_channels : array[0..maxfxchn-1] of t_channel;
base_fx_chn : integer;
top_fx_addr : longint;
{$ENDIF}
patterns : array[0..127] of p_pattern; {516 bytes}
usedptn : array[0..127] of boolean;
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 : integer;
main_vol : byte; {main volume. volume = (vol*main_vol div 64)}
vblank : boolean; {if true then do not use bpm tempos}
playing,loaded : boolean; {guess :-)}
header : mod_header;
low_addr,top_addr : longint; {Next free address in GUS mem}
dos_irq : integer; {interrupt number}
timer_rate,timer_cnt,
int_rate : word;
time_counter : longint; {For syncing with demos. Increments
every 1/18.2 seconds}
time_counter2 : longint; {Increments every tick}
time_counter3 : longint; {1250hz timer}
{$i gushdr.inc} {has lots of defines}
procedure updatenotes;
procedure start_playing;
procedure stop_playing;
procedure set_timer(ticks : word);
procedure init_mod;
procedure done_mod;
{$IFDEF __LOADERS__}
procedure free_mod;
procedure load_mod(s : string);
{$IFDEF __S3M__}
{$IFDEF __MOD__}
procedure _load_mod(s : string);
procedure load_s3m(s : string);
{$ENDIF}
{$ENDIF}
{$ENDIF}
procedure goto_mod(ptn,row : integer);
{$IFDEF __FX__}
procedure init_fx(fxspace : longint;chns : integer);
function load_fx_raw(s : string;num : integer) : integer;
function load_fx_st3(s : string;num : integer) : integer;
procedure play_fx(_chn,num : integer);
{$ENDIF}
function per2gus(per : longint) : word;
function longmul(x,y : integer) : longint;
inline($5a/$58/$f7/$ea);
function longdiv(x : longint;y : word) : word;
inline($59/$58/$5a/$f7/$f1);
implementation
{const
gst_vol = 1;
gst_pan = 2;
gst_ofs = 4;
gst_note = 16;
gst_stop = 32;}
type
t_memarray = array[0..2000] of word;
t_memarray2 = array[0..5000] of byte;
p_memarray = ^t_memarray;
p_memarray2 = ^t_memarray2;
{t_guschn = record
status : word;
per : longint;
offset : word;
sam : word;
ovol,vol : word;
pan : integer;
end;}
var
pdelay,loops,loope,loopcnt : integer;
int_tick,o_int_tick : word;
oldint : procedure;
gus_bank : longint;
{$IFDEF __LOADERS__}
misc_buf : p_memarray2; {buffer used while loading mod}
misc_buf2 : p_memarray; {points to misc_buf}
{$ENDIF}
{$i gus.inc}
procedure dump2gus;
const
chn : integer = 0;
freq : longint = 0;
begin
for chn := 0 to header.usedchns-1 do with gus_chn[chn] do begin
gussetfreq(chn,per2gus(per));
if channels[chn].on <> 1 then vol := 32*256;
if status and gst_note <> 0 then begin
freq := per2gus(per);
if (samples[sam].loop) then
gusplayall(chn,8,gus_addr[sam]+offset,
gus_addr[sam]+samples[sam].loopstart,
gus_addr[sam]+samples[sam].loopend,freq,19968)
else gusplayall(chn,0,gus_addr[sam]+offset,
gus_addr[sam]+offset,
gus_addr[sam]+samples[sam].length+1,freq,19968);
gussetramp(chn,20000 shr 8,vol shr 8,ramp_speed);
gussetbalance(chn,pan);
ovol := vol;
end
else begin
if status and gst_vol <> 0 then begin
if (channels[chn].on = 1) and (vol <> ovol) then begin
{channels[chn].gvol := vol;}
gussetramp(chn,ovol shr 8,vol shr 8,ramp_speed);
end;
ovol := vol;
end;
if status and gst_pan <> 0 then gussetbalance(chn,pan);
if status and gst_ofs <> 0 then gussetofs(chn,gus_addr[sam]+offset);
if status and gst_stop <> 0 then begin
ovol := vol;
gusstopvoice(chn);
vol := 0;
end;
end;
status := 0;
end;
end;
function per2gus(per : longint) : word;
begin
per2gus := 586580935 div (per * (gusdiv shr 2));
end;
{$s-}
procedure get_notes;
const
chn : byte = 0;
ptn : byte = 0;
org_sam : byte = 0;
sam : byte = 0;
note : byte = 0;
st_ofs : longint = 0;
per : longint = 0;
dper : longint = 0;
vol : word = 0;
_fx : integer = 0;
_fxdata : integer = 0;
mute : byte = 0;
_ptn : p_pattern = nil;
c4spd : longint = 0;
{ovol : word = 0;}
cchn : p_channel = nil;
cnote : p_note = nil;
procedure prefx;
const
w : word = 0;
_efxdata : byte = 0;
begin
if _ptn^[cur_row*header.chns+chn].vol < 64 then begin
vol := _ptn^[cur_row*header.chns+chn].vol;
end;
case _fx of
9 : begin
st_ofs := word(_fxdata*$100);
channels[chn].no_fx := 1;
channels[chn].fx := _fx;
channels[chn].fxdata := _fxdata;
with gus_chn[chn] do begin
offset := word(_fxdata) shl 8;
status := status or gst_ofs;
end;
end;
$c : begin
if _fxdata > 64 then _fxdata := 64;
vol := _fxdata;
channels[chn].fx := $c;
channels[chn].fxdata := _fxdata;
channels[chn].no_fx := 1;
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;
8 : begin
channels[chn].pan := _efxdata;
gus_chn[chn].status := gus_chn[chn].status or gst_pan;
gus_chn[chn].pan := _efxdata;
end;
$c : if _efxdata and 15 = 0 then begin
mute := 1;
{gusstopvoice(chn);}
gus_chn[chn].status := gus_chn[chn].status or gst_stop;
end;
$d : if _efxdata > 0 then mute := 2
else mute := 0;
end;
end;
end;
end;
begin
ptn := orders[cur_ptn];
_ptn := virt_getptn(ptn);
for chn := 0 to header.usedchns-1 do begin
cnote := @_ptn^[cur_row*header.chns+chn];
cchn := @channels[chn];
if cchn^.fx = 0 then begin
sam := cchn^.sample;
note := cchn^.basenote;
cchn^.note := note;
per := (8363 * longint((16*st3_per[note and 15]) shr (note shr 4)))
div samples[cchn^.sample].c4spd;
cchn^.per := per;
end;
gus_chn[chn].per := cchn^.per;
{$IFNDEF __MINI__}
cchn^.hit := 0;
{$ENDIF}
if cnote^.note = 254 then cchn^.note := 254
else if cchn^.note = 254 then cchn^.note := cchn^.basenote;
if ((cnote^.note < 254) or
(cnote^.sample > 0)) then begin
mute := 0;
vol := cchn^.vol;
per := cchn^.per;
note := cchn^.note;
_fx := cnote^.fx;
_fxdata := cnote^.fxdata;
org_sam := cnote^.sample;
st_ofs := 0;
if samples[org_sam]._type <> 1 then sam := cchn^.sample
else begin
sam := org_sam;
if sam = cchn^.sample then mute := 1;
end;
c4spd := samples[sam].c4spd;
if (_fx = $e) and (_fxdata shr 4 = 5) then
c4spd := ftune_per[_fxdata and 15];
if (_fx = 3) or (_fx = 5) then begin {port to/port to&vol slide}
mute := 1; {dont restart sample}
if cnote^.note < 254 then begin
note := cnote^.note;
if c4spd = 8363 then
dper := (16*st3_per[note and 15]) shr (note shr 4)
else begin
{if header.modtype = mt_s3m then
dper := longdiv(longint(8363*
longint(16*st3_per[note and 15])) shr (note shr 4),c4spd)}
{else} dper := longdiv((longmul(8363,
(st3_per[note and 15] shl 4)) shr (note shr 4)),c4spd);
end;
if dper > max_per then dper := max_per;
if dper < min_per then dper := min_per;
cchn^.dper := dper;
end;
end
else if cnote^.note < 254 then begin
note := cnote^.note;
if c4spd = 8363 then per := (16*st3_per[note and 15]) shr (note shr 4)
else begin
{if header.modtype = mt_s3m then
per := longdiv(longmul(8363,
16*st3_per[note and 15]) shr (note shr 4),c4spd)}
{else} per := longdiv(longmul(8363,16*st3_per[note and 15])
shr (note shr 4),c4spd);
end;
if per > max_per then per := max_per;
if per < min_per then per := min_per;
cchn^.dper := per;
cchn^.per := per;
mute := 0;
end;
if org_sam > 0 then begin {should I reset volume}
vol := samples[sam].volume;
if cchn^.sample <> org_sam then mute := 0;
end;
st_ofs := 0;
if (header.modtype = mt_mod) and (samples[sam].length > 2) then st_ofs := 2;
{coz first 2 bytes = amiga loopinfo, discard them}
cchn^.no_fx := 0;
prefx;
cchn^.vol := vol;
cchn^.note := note;
cchn^.basenote := note;
cchn^.sample := sam;
{$IFNDEF __MINI__}
cchn^.bar := vol;
{$ENDIF}
vol := (gusvol[word(vol*main_vol) div 64]*amp_vol+20000);
if st_ofs > samples[sam].length then st_ofs := samples[sam].length;
{if cchn^.on = 0 then mute := 1;}
gus_chn[chn].sam := sam;
gus_chn[chn].per := per;
if mute = 0 then begin
gus_chn[chn].status := gus_chn[chn].status or gst_note;
gus_chn[chn].offset := st_ofs;
gus_chn[chn].vol := vol;
{$IFNDEF __MINI__}
cchn^.hit := 1;
{$ENDIF}
end
else begin
gus_chn[chn].status := gus_chn[chn].status or gst_vol;
gus_chn[chn].vol := vol;
end;
end;
end;
end;
procedure get_fx;
const
chn : byte = 0;
ptn : byte = 0;
_fx : integer = 0;
_fxdata : integer = 0;
_efx : integer = 0;
_efxdata : integer = 0;
per : longint = 0;
b : byte = 0;
i : integer = 0;
w : word = 0;
_ptn : p_pattern = nil;
cnote : p_note = nil;
begin
_ptn := virt_getptn(orders[cur_ptn]);
new_ptn := cur_ptn;
new_row := cur_row;
jump := 0;
pdelay := 0;
for chn := 0 to header.usedchns-1 do begin
if channels[chn].note = 254 then
gus_chn[chn].status := gus_chn[chn].status or gst_stop;
if channels[chn].no_fx = 0 then begin
cnote := @_ptn^[cur_row*header.chns+chn];
_fx := cnote^.fx;
_fxdata := cnote^.fxdata;
if channels[chn].fx <> 22 then channels[chn].trig_cnt := 0;
channels[chn].start_fx := 0;
channels[chn].fx := _fx;
channels[chn].fxdata := _fxdata;
if (cnote^.vol < 255) and (_fx <> $c) then with cnote^ do begin
i := vol;
if i > 64 then i := 64;
channels[chn].vol := i;
{$IFNDEF __MINI__}
channels[chn].bar := i;
{$ENDIF}
with gus_chn[chn] do begin
status := status or gst_vol;
vol := gusvol[word(i*main_vol) div 64]*amp_vol+20000;
end;
end;
if _fx <> 255 then
case _fx of
0 : begin {Arpeggio}
channels[chn].arp1 := _fxdata shr 4;
channels[chn].arp2 := _fxdata and 15;
channels[chn].arp_cnt := 0;
channels[chn].basenote := channels[chn].note;
end;
{$IFDEF __MOD__}
1 : begin {port up}
if _fxdata = 0 then begin
_fxdata := channels[chn].fx_portu;
channels[chn].fxdata := _fxdata;
end
else channels[chn].fx_portu := _fxdata;
channels[chn].start_fx := 2;
end;
2 : begin {port down}
if _fxdata = 0 then begin
_fxdata := channels[chn].fx_portd;
channels[chn].fxdata := _fxdata;
end
else channels[chn].fx_portd := _fxdata;
channels[chn].start_fx := 2;
end;
{$ENDIF}
3 : begin {port to}
if _fxdata > 0 then begin
channels[chn].fxdata := _fxdata;
channels[chn].fx_sl2 := _fxdata;
end
else channels[chn].fxdata := channels[chn].fx_sl2;
if channels[chn].per <> channels[chn].dper then
channels[chn].start_fx := 2
else channels[chn].fx := 255;
end;
4 : begin {vibrato}
b := _fxdata and 15;
if b = 0 then b := channels[chn].fx_vib and 15;
w := b;
b := _fxdata and $f0;
if b = 0 then b := channels[chn].fx_vib and $f0;
w := w or b;
channels[chn].fxdata := w;
channels[chn].fx_vib := w;
end;
5 : begin {port to & vol slide}
if _fxdata = 0 then _fxdata := channels[chn].fx_volslide;
if _fxdata and 15 > 0 then
_fxdata := _fxdata and 15; {if both ways, then slide down}
channels[chn].fx_volslide := _fxdata;
channels[chn].fxdata := _fxdata;
end;
6 : begin {Vibrato & vol slide}
if _fxdata = 0 then _fxdata := channels[chn].fx_volslide;
if _fxdata and 15 > 0 then begin {slide up}
_fxdata := _fxdata and 15;
i := -_fxdata;
end
else begin
i := _fxdata shr 4 and 15;
end;
channels[chn].fx_volslide := _fxdata;
channels[chn].fxdata := _fxdata;
channels[chn].vols := i;
end;
7 : begin {Tremolo}
if _fxdata > 0 then begin
channels[chn].fxdata := _fxdata;
channels[chn].fx_trm := _fxdata;
end
else channels[chn].fxdata := channels[chn].fx_trm;
end;
8 : begin {Set dmp-panning}
if _fxdata = $80 then i := 15
else if _fxdata = $a4 then i := 7
else if _fxdata < $80 then i := _fxdata shr 3;
channels[chn].pan := i;
with gus_chn[chn] do begin
pan := i;
status := status or gst_pan;
end;
end;
9 : with gus_chn[chn] do begin {set sample offset}
offset := word(_fxdata) shl 8;
status := status or gst_ofs;
end;
{$IFDEF __MOD__}
$a : begin {volume slide}
if _fxdata = 0 then _fxdata := channels[chn].fx_volslide;
if _fxdata and 15 > 0 then begin {slide down}
_fxdata := _fxdata and 15;
i := -(_fxdata and 15);
end
else i := _fxdata shr 4 and 15;
channels[chn].fxdata := _fxdata;
channels[chn].fx_volslide := _fxdata;
channels[chn].vols := i;
channels[chn].start_fx := 2;
end;
{$ENDIF}
$b : begin {position jump}
if _fxdata < header.length then begin
new_ptn := _fxdata;
if jump = 0 then new_row := 0;
jump := 1;
end;
end;
{$IFDEF __MOD__}
$c : begin {Set volume}
if _fxdata > 64 then _fxdata := 64;
channels[chn].fxdata := _fxdata;
channels[chn].vol := _fxdata;
{$IFNDEF __MINI__}
channels[chn].bar := _fxdata;
{$ENDIF}
with gus_chn[chn] do begin
status := status or gst_vol;
vol := gusvol[word(_fxdata*main_vol) div 64]*amp_vol+20000;
end;
end;
{$ENDIF}
$d : begin {break pattern}
if jump=0 then new_ptn := cur_ptn+1;
new_row := (_fxdata shr 4)*10+_fxdata and 15;
jump := 1;
end;
$e : begin {extended effect}
_efx := _fxdata shr 4;
_efxdata := _fxdata and 15;
case _efx of
1 : begin {fine portamento up}
per := channels[chn].per;
dec(per,_efxdata*4);
if per < min_per then per := min_per;
channels[chn].per := per;
gus_chn[chn].per := per;
end;
2 : begin {fine portamento down}
per := channels[chn].per;
inc(per,_efxdata*4);
if per > max_per then per := max_per;
channels[chn].per := per;
gus_chn[chn].per := per;
end;
4 : begin {set vibrato waveform}
channels[chn].vib_wave := _efxdata;
end;
6 : begin {pattern loop}
if _efxdata = 0 then loops := cur_row
else begin
if loope = 0 then begin {start new loop}
loopcnt := _efxdata;
loope := cur_row;
end;
if loopcnt = 0 then begin
loope := 0;
loops := 0;
end
else begin
dec(loopcnt);
new_row := loops;
jump := 1;
end;
end;
end;
8 : begin {set mtm-pan}
channels[chn].pan := _efxdata;
gus_chn[chn].status := gus_chn[chn].status or gst_pan;
gus_chn[chn].pan := _efxdata;
end;
9 : if _efxdata > 0 then begin {retrigger}
{channels[chn].trig_cnt := 0;}
end;
$a : begin {fine vol slide up}
i := channels[chn].vol;
inc(i,_efxdata);
if i > 64 then i := 64;
channels[chn].vol := i;
with gus_chn[chn] do begin
status := status or gst_vol;
vol := gusvol[word(i*main_vol) div 64]*amp_vol+20000;
end;
{$IFNDEF __MINI__}
channels[chn].bar := i;
{$ENDIF}
end;
$b : begin {fine vol slide down}
i := channels[chn].vol;
dec(i,_efxdata);
if i < 0 then i := 0;
channels[chn].vol := i;
with gus_chn[chn] do begin
status := status or gst_vol;
vol := gusvol[word(i*main_vol) div 64]*amp_vol+20000;
end;
{$IFNDEF __MINI__}
channels[chn].bar := i;
{$ENDIF}
end;
$d : if _efxdata > 0 then begin {note delay}
channels[chn].start_fx := _efxdata+1;
end
else channels[chn].fx := 255;
$e : pdelay := _efxdata;
end;
end;
$f : begin {set speed / tempo}
if (_fxdata <= 31) or vblank then begin {SPEED not tempo}
nspeed := _fxdata;
speed := _fxdata;
end
else begin {Tempo}
tempo := _fxdata;
{timer_rate := 10000 div (tempo);}
asm
mov ax,tempo {round}
shr ax,1
add ax,25000
mov dx,0
mov cx,tempo
div cx
mov timer_rate,ax
end;
end;
end;
16 : begin {set speed}
nspeed := _fxdata;
speed := _fxdata;
end;
{$IFDEF __S3M__}
17 : begin {s3m slide down}
if _fxdata = 0 then _fxdata := channels[chn].fx_portd
else channels[chn].fx_portd := _fxdata;
_efxdata := _fxdata and 15;
if _fxdata shr 4 = $f then begin
channels[chn].fx := $e;
_fxdata := $20 or _efxdata;
per := channels[chn].per;
inc(per,_efxdata*4);
if per > max_per then per := max_per;
channels[chn].per := per;
end
else if _fxdata shr 4 = $e then begin
_fxdata := _efxdata;
channels[chn].fx := 19;
per := channels[chn].per;
inc(per,_efxdata);
if per > max_per then per := max_per;
channels[chn].per := per;
end else channels[chn].fx := 2;
channels[chn].fxdata := _fxdata;
channels[chn].start_fx := 2;
gus_chn[chn].per := channels[chn].per;
end;
18 : begin {s3m slide up}
if _fxdata = 0 then _fxdata := channels[chn].fx_portd
else channels[chn].fx_portd := _fxdata;
_efxdata := _fxdata and 15;
if _fxdata shr 4 = $f then begin
channels[chn].fx := $e;
_fxdata := $10 or _efxdata;
per := channels[chn].per;
dec(per,_efxdata*4);
if per < min_per then per := min_per;
channels[chn].per := per;
end
else if _fxdata shr 4 = $e then begin
_fxdata := _efxdata;
channels[chn].fx := 20;
per := channels[chn].per;
dec(per,_efxdata);
if per < min_per then per := min_per;
channels[chn].per := per;
end else channels[chn].fx := 1;
channels[chn].fxdata := _fxdata;
channels[chn].start_fx := 2;
gus_chn[chn].per := channels[chn].per;
end;
21 : begin {s3m volume slide}
channels[chn].fx := 21;
if _fxdata = 0 then _fxdata := channels[chn].fx_volslide;
if (_fxdata shr 4 = $f) and (_fxdata and $f <> 0) then
begin {fine volume down}
channels[chn].fx := 21;
i := channels[chn].vol-_fxdata and 15;
if i < 0 then i := 0;
channels[chn].vol := i;
with gus_chn[chn] do begin
status := status or gst_vol;
vol := gusvol[word(i*main_vol) div 64]*amp_vol+20000;
end;
{$IFNDEF __MINI__}
channels[chn].bar := i;
{$ENDIF}
end
else if (_fxdata and 15 = $f) and (_fxdata shr 4 <> 0) then
begin
channels[chn].fx := 21;
i := channels[chn].vol+(_fxdata shr 4);
if i > 64 then i := 64;
channels[chn].vol := i;
with gus_chn[chn] do begin
status := status or gst_vol;
vol := gusvol[word(i*main_vol) div 64]*amp_vol+20000;
end;
{$IFNDEF __MINI__}
channels[chn].bar := i;
{$ENDIF}
end
else begin
if _fxdata and 15 > 0 then begin {slide down}
_fxdata := _fxdata and 15;
i := -_fxdata;
end
else begin
i := _fxdata shr 4 and 15;
end;
channels[chn].fx := $a;
end;
channels[chn].fxdata := _fxdata;
channels[chn].fx_volslide := _fxdata;
channels[chn].vols := i;
channels[chn].start_fx := 2;
end;
22 : begin {s3m retrig}
{if (_fxdata and 15 > 0) and (channels[chn].trig_cnt = 0) then
begin
channels[chn].trig_cnt := _fxdata and 15;
end;}
end;
23 : if _fxdata < 65 then main_vol := _fxdata;
{$ENDIF}
else begin
channels[chn].fx := 255;
channels[chn].fxdata := 0;
end;
end;
if (channels[chn].fx <> 22) or
(channels[chn].fx = $e) and (channels[chn].fxdata shr 4 = 9) then
else channels[chn].trig_cnt := 0;
end
else channels[chn].no_fx := 0;
end;
end;
procedure do_fx;
const
chn : byte = 0;
_fx : integer = 0;
_fxdata : integer = 0;
_efx : integer = 0;
_efxdata : integer = 0;
per : longint = 0;
b : byte = 0;
s : shortint = 0;
w : word = 0;
i : integer = 0;
begin
for chn := 0 to header.usedchns-1 do
if (channels[chn].on = 1) and (channels[chn].fx <> 255) 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 {arpeggio}
case channels[chn].arp_cnt mod 3 of
0 : b := 0;
1 : b := arp1;
2 : b := arp2;
end;
i := basenote and 15+b;
w := (basenote shr 4) and 15;
while i > 11 do begin
dec(i,12);
inc(w);
end;
per := longint(8363*((16*st3_per[i]) shr (w)))
div longint(samples[channels[chn].sample].c4spd);
channels[chn].per := per;
gus_chn[chn].per := per;
channels[chn].note := w*16+i;
inc(arp_cnt);
end;
1 : begin {port up}
per := channels[chn].per;
dec(per,_fxdata shl 2);
if per < min_per then per := min_per;
channels[chn].per := per;
gus_chn[chn].per := per;
end;
2 : begin {port down}
per := channels[chn].per;
inc(per,_fxdata shl 2);
if per > max_per then per := max_per;
channels[chn].per := per;
gus_chn[chn].per := 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,word(channels[chn].fx_sl2) shl 2);
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;
gus_chn[chn].per := per;
end
else begin
w := channels[chn].dper;
per := channels[chn].per;
if per-(word(channels[chn].fx_sl2) shl 2) > per then per := min_per
else dec(per,ord(channels[chn].fx_sl2) shl 2);
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;
gus_chn[chn].per := per;
end;
end;
4 : begin {vibrato}
_fxdata := channels[chn].fx_vib;
b := _fxdata and 15;
i := vib_tbl[channels[chn].vib_wave,channels[chn].vib_cnt];
i := (i * b) div 16;
w := channels[chn].per+i;
if w > max_per then w := max_per;
if w < min_per then w := min_per;
gus_chn[chn].per := w;
inc(channels[chn].vib_cnt,_fxdata shr 4);
if channels[chn].vib_cnt > 63 then
dec(channels[chn].vib_cnt,64);
end;
5 : begin {volume slide & portamento}
if _fxdata and 15 > 0 then begin {slide down}
_fxdata := _fxdata and 15;
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;
{$IFNDEF __MINI__}
channels[chn].bar := b;
{$ENDIF}
with gus_chn[chn] do begin
status := status or gst_vol;
vol := gusvol[word(b*main_vol) div 64]*amp_vol+20000;
end;
end
else begin {slide up}
b := channels[chn].vol;
inc(b,(_fxdata shr 4));
if b > 64 then b := 64;
channels[chn].vol := b;
{$IFNDEF __MINI__}
channels[chn].bar := b;
{$ENDIF}
with gus_chn[chn] do begin
status := status or gst_vol;
vol := gusvol[word(b*main_vol) div 64]*amp_vol+20000;
end;
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*4);
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;
gus_chn[chn].per := per;
end
else begin
w := channels[chn].dper;
per := channels[chn].per;
if per-(_fxdata*4) > per then per := min_per
else dec(per,_fxdata*4);
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;
gus_chn[chn].per := per;
end;
end;
6 : begin {vibrato & vol slide}
begin
b := channels[chn].fx_vib and 15;
s := vib_tbl[channels[chn].vib_wave,channels[chn].vib_cnt];
s := (s * b) div 16;
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;
gus_chn[chn].per := w;
inc(channels[chn].vib_cnt,b);
if channels[chn].vib_cnt > 63 then
dec(channels[chn].vib_cnt,64);
end;
{volume slide}
i := channels[chn].vol;
inc(i,channels[chn].vols);
if i < 0 then i := 0
else if i > 64 then i := 64;
channels[chn].vol := i;
{$IFNDEF __MINI__}
channels[chn].bar := i;
{$ENDIF}
with gus_chn[chn] do begin
status := status or gst_vol;
vol := gusvol[word(i*main_vol) div 64]*amp_vol+20000;
end;
end;
$a : begin {volume slide}
i := channels[chn].vol;
inc(i,channels[chn].vols);
if i < 0 then i := 0
else if i > 64 then i := 64;
channels[chn].vol := i;
{$IFNDEF __MINI__}
channels[chn].bar := i;
{$endif}
with gus_chn[chn] do begin
status := status or gst_vol;
vol := gusvol[word(i*main_vol) div 64]*amp_vol+20000;
end;
end;
$e : begin
_efx := _fxdata shr 4;
_efxdata := _fxdata and 15;
case _efx of
9 : begin {Retrig note}
b := channels[chn].sample;
inc(channels[chn].trig_cnt);
if channels[chn].trig_cnt = 0 then with gus_chn[chn] do begin
status := status or gst_note;
offset := 0;
channels[chn].trig_cnt := 1;
end;
end;
$c : if _efxdata = 0 then begin {note cut}
gus_chn[chn].status := gus_chn[chn].status or gst_stop;
channels[chn].fx := 255;
end
else begin
dec(_efxdata);
b := _fxdata;
b := b and $f0;
b := b or _efxdata;
channels[chn].fxdata := b;
end;
$d : begin {note delay}
channels[chn].start_fx := 255;
{$IFNDEF __MINI__}
channels[chn].hit := 1;
{$ENDIF}
with gus_chn[chn] do begin
sam := channels[chn].sample;
per := channels[chn].per;
offset := 0;
vol := gusvol[word(channels[chn].vol*main_vol) div 64]*
amp_vol+20000;
status := status or gst_note;
end;
end;
end;
end;
{$IFDEF __S3M__}
22 : begin {s3m retrig note}
b := channels[chn].sample;
inc(channels[chn].trig_cnt);
if channels[chn].trig_cnt > _fxdata and 15 then begin
i := channels[chn].vol;
w := _fxdata shr 4;
case w of
1..5 : dec(i,1 shl (w-1));
7 : i := i shr 1;
9..$d : inc(i,1 shl (w-9));
$f : inc(i,i);
end;
if i < 0 then i := 0
else if i > 64 then i := 64;
with gus_chn[chn] do begin
status := status or gst_note;
offset := 0;
vol := gusvol[word(i*main_vol) div 64]*amp_vol+20000;
end;
channels[chn].vol := i;
channels[chn].trig_cnt := 1;
end;
end;
{$ENDIF}
end;
end;
end;
procedure updatenotes;
const
n : integer = 0;
cptn : integer = 0;
begin
if cur_ptn >= header.length then new_ptn := 0;
while orders[new_ptn] = 254 do inc(new_ptn);
cur_ptn := new_ptn;
cur_row := new_row;
if (cur_tick >= speed) and (speed > 0) then begin
speed := nspeed;
cur_tick := 0;
if pdelay=0 then begin
if jump = 0 then inc(cur_row);
if cur_row > 63 then begin
inc(cur_ptn);
while orders[cur_ptn] = 254 do inc(cur_ptn);
if orders[cur_ptn]=255 then cur_ptn := 0;
cur_row := 0;
if cur_ptn > header.length-1 then begin
cur_ptn := 0;
end;
end;
end;
end;
cptn := orders[cur_ptn];
if cptn = 255 then cur_ptn := 0;
new_ptn := cur_ptn;
new_row := cur_row;
if speed > 0 then begin
{$IFNDEF __MINI__}
for n := 0 to header.usedchns-1 do begin
if channels[n].bar > 1 then dec(channels[n].bar,2)
else channels[n].bar := 0;
end;
{$ENDIF}
inc(cur_tick);
if cur_tick = 1 then begin
if pdelay=0 then begin
virt_needptn(cptn);
get_notes;
get_fx;
virt_noneedptn(cptn);
end
else dec(pdelay);
end;
do_fx;
dump2gus;
end;
while orders[new_ptn] = 254 do inc(new_ptn);
if orders[new_ptn] = 255 then new_ptn := 0;
if new_ptn <> cur_ptn then virt_warnptn(orders[new_ptn])
else if cur_row = 63 then begin
cptn := cur_ptn+1;
while orders[cptn] = 254 do inc(cptn);
if orders[cptn] = 255 then cptn := 0;
cptn := orders[cptn];
virt_warnptn(cptn);
end;
if jump = 1 then virt_warnptn(orders[new_ptn]);
end;
procedure volrampend;
const
chn : integer = 0;
begin
for chn := 0 to header.chns-1 do begin
port[active_voice] := chn;
port[command] := $8d;
if port[data_high] and 3 = 1 then begin
port[command] := $d;
port[data_high] := 2;
port[command] := 9;
portw[data_low] := gus_chn[chn].vol;
end;
end;
end;
{$s-}
procedure timerint; interrupt;
const
regs : array[0..5] of longint = (0,0,0,0,0,0);
begin
asm
cli
db 66h
mov word ptr regs[0],ax
db 66h
mov word ptr regs[4],bx
db 66h
mov word ptr regs[8],cx
db 66h
mov word ptr regs[12],dx
db 66h
mov word ptr regs[16],si
db 66h
mov word ptr regs[20],di
end;
if playing then begin
volrampend;
dec(timer_cnt,8);
inc(time_counter3);
if timer_cnt < 8 then begin
inc(time_counter2);
updatenotes;
inc(timer_cnt,timer_rate);
end;
end;
o_int_tick := int_tick;
int_tick := int_tick + int_rate;
if (o_int_tick > int_tick) or not playing then begin
if playing then inc(time_counter);
asm
pushf
cli
call oldint
end;
end
else
asm
mov al,20h
out 20h,al {send EOI}
end;
asm
db 66h
mov ax,word ptr regs[0]
db 66h
mov bx,word ptr regs[4]
db 66h
mov cx,word ptr regs[8]
db 66h
mov dx,word ptr regs[12]
db 66h
mov si,word ptr regs[16]
db 66h
mov di,word ptr regs[20]
end;
end;
procedure gusint; interrupt;
const
regs : array[0..5] of longint = (0,0,0,0,0,0);
irq_source : word = 0;
begin
asm
cli
db 66h
mov word ptr regs[0],ax
db 66h
mov word ptr regs[4],bx
db 66h
mov word ptr regs[8],cx
db 66h
mov word ptr regs[12],dx
db 66h
mov word ptr regs[16],si
db 66h
mov word ptr regs[20],di
end;
irq_source := port[gus_base+6];
if (irq_source and gf1_timer1_irq) <> 0 then begin
port[command] := timer_control;
port[data_high] := 0;
port[data_high] := 4;
if playing then begin
volrampend;
dec(timer_cnt,8);
inc(time_counter3);
if timer_cnt < 8 then begin
inc(time_counter2);
updatenotes;
inc(timer_cnt,timer_rate);
end;
end;
o_int_tick := int_tick;
int_tick := int_tick + int_rate;
if (o_int_tick > int_tick) then inc(time_counter);
end;
if gus_irq > 7 then port[$a0] := $20;
port[$20] := $20;
asm
db 66h
mov ax,word ptr regs[0]
db 66h
mov bx,word ptr regs[4]
db 66h
mov cx,word ptr regs[8]
db 66h
mov dx,word ptr regs[12]
db 66h
mov si,word ptr regs[16]
db 66h
mov di,word ptr regs[20]
end;
end;
{$s-}
{$f+}
procedure def_virt_alloc(numptn,ptnsize : integer);
var
n : integer;
begin
fillchar(patterns,sizeof(patterns),0);
virt_info.numptn := numptn;
virt_info.ptnsize := ptnsize;
virt_info.err_wptn := -1;
virt_info.err_nptn := -1;
end;
procedure def_virt_free;
var
n : integer;
begin
for n := 0 to 127 do if patterns[n] <> nil then begin
freemem(patterns[n],virt_info.ptnsize);
patterns[n] := nil;
end;
end;
procedure def_virt_allocptn(ptn : integer);
begin
getmem(patterns[ptn],virt_info.ptnsize);
end;
procedure def_virt_loadptn(ptn : integer;p : pointer);
begin
move(p^,patterns[ptn]^,virt_info.ptnsize);
end;
procedure def_virt_freeptn(ptn : integer);
begin
if patterns[ptn] <> nil then begin
freemem(patterns[ptn],virt_info.ptnsize);
patterns[ptn] := nil;
end;
end;
function def_virt_getptn(ptn : integer) : pointer;
begin
def_virt_getptn := patterns[ptn];
end;
procedure def_virt_warnptn(ptn : integer);
begin
virt_info.warnedptn := ptn;
end;
procedure def_virt_needptn(ptn : integer);
begin
if ptn <> virt_info.warnedptn then begin
virt_info.err_cptn := cur_ptn;
virt_info.err_wptn := virt_info.warnedptn;
virt_info.err_nptn := ptn;
end;
end;
procedure def_virt_noneedptn(ptn : integer);
begin
end;
{$f-}
{$s-}
function heaperr(size : word) : integer; far;
begin
if size > 0 then begin
mod_error := 3;
heaperr := 1;
end;
end;
{$IFDEF __LOADERS__}
procedure load2gus(memaddr : pointer;gusaddr : longint;len,flip : word);
begin
asm
mov di,len
mov si,word ptr memaddr
mov es,word ptr memaddr+2
mov cx,word ptr gusaddr {cx=addlo}
mov bl,byte ptr gusaddr+2 {bl=addhi}
mov bh,byte ptr flip {bh = flip}
mov dx,command {Port [command] := $44;}
mov al,44h
out dx,al
mov dx,data_high
mov al,bl
out dx,al {Port [data_high] := AddHi;}
mov dx,command {Port [command] := $43;}
mov al,43h
out dx,al
@@1:
mov dx,data_low {Portw[data_low] := AddLo;}
mov ax,cx
out dx,ax
cmp cx,0
jne @@2
mov dx,command {Port [command] := $44;}
mov al,44h
out dx,al
mov dx,data_high
mov al,bl
out dx,al {Port [data_high] := AddHi;}
mov dx,command {Port [command] := $43;}
mov al,43h
out dx,al
@@2:
mov dx,dram_io {Port [dram_io] := misc_buf^[n];}
mov al,es:[si]
sub al,bh
out dx,al
inc si
add cx,1 {inc(l,1);}
adc bl,0
dec di
jnz @@1
end;
end;
{$IFDEF __MOD__}
{$IFDEF __S3M__}
procedure load_MOD(s : string);
var
i : integer;
f : file;
a : string[4];
begin
a := '1234';
assign(f,s);
reset(f,1);
seek(f,$2c);
blockread(f,a[1],4);
i := ioresult;
if i <> 0 then begin
mod_error := 2;
exit;
end;
close(f);
{$i+}
if a = 'SCRM' then load_s3m(s)
else _load_mod(s);
end;
{$ENDIF}
{$ENDIF}
{$IFDEF __MOD__}
{$IFDEF __S3M__}
procedure _load_MOD(s : string);
{$ELSE}
procedure load_MOD(s : string);
{$ENDIF}
var
f : file;
mbuf : pointer;
oldheaperr : procedure;
procedure set_up_modheader;
var
chn,c,n,i : integer;
begin
fillchar(header,sizeof(header),0);
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;
with header do
if tag = 'M.K.' then chn := 4
else if tag = 'M!K!' then chn := 4
else if tag[1]+tag[2]+tag[3]='CHN' then begin
val(tag[0],n,c);
if c=0 then chn := n;
end
else if tag[2]+tag[3]='CH' then begin
val(tag[0]+tag[1],n,c);
if c=0 then chn := n;
end
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);
{$IFDEF __DEBUG__}
writeln('Tag: ',header.tag);
{$ENDIF}
end;
header.chns := chn;
header.usedchns := chn;
max_ptn := 0;
for n := 0 to 127 do if orders[n] > max_ptn then begin
if orders[n] > 127 then begin
mod_error := 2;
exit;
end else max_ptn := orders[n];
end;
move(def_modpan,header.chn_pan,32);
header.ispeed := 6;
header.itempo := 125;
header.modtype := mt_mod;
max_ptn := max_ptn+1;
{$IFDEF __FX__}
base_fx_chn := chn;
inc(chn,fxchns);
{$ENDIF}
if chn < 14 then gussetchns(13)
else gussetchns(chn-1);
gusdiv := gus_div[chn];
end;
procedure mod_sample_info;
var
n : integer;
maxi,i : integer;
begin
fillchar(samples,sizeof(samples),0);
for n := 0 to 99 do samples[n].c4spd := 8363;
samples[0].name[0] := #22;
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].name[0] := #22;
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].c4spd := ftune_per[samples[n].ftune];
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
else samples[n].loop := true;
inc(samples[n].loopend,samples[n].loopstart);
if samples[n].loopend > samples[n].length then
samples[n].loopend := samples[n].length;
samples[n]._type := 1;
end;
end;
procedure read_ptn(n : word);
var
row,chn : integer;
w,w2,i : word;
x,y : integer;
b : byte;
mchn : integer;
mb : p_pattern;
per : word;
begin
mchn := header.chns;
mb := mbuf;
blockread(f,misc_buf^,256*mchn);
for row := 0 to 63 do
for chn := 0 to mchn-1 do with mb^[row*header.chns+chn] do begin
w := misc_buf2^[row*(2*mchn)+chn*2];
w2 := misc_buf2^[row*(2*mchn)+chn*2+1];
asm
mov cx,w
and cl,15
xchg cl,ch
and cx,0fffh
mov i,cx
end;
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;
sample := i;
fx := lo(w2) and 15;
fxdata := hi(w2);
if (fx=0) and (fxdata=0) then begin
fx := 255;
fxdata := 0;
end;
i := per;
if i > 0 then begin
w := 0;
repeat
inc(w);
until (i >= per_table[w]);
if w < 60 then begin
if i > per_table[w] then begin
x := per_table[w-1]-i;
y := i-per_table[w];
if x < y then w := w+1;
end;
note := w
end
else note := 60;
end
else note := 0;
if note > 0 then note := note_table[note]
else note := 255;
vol := 255;
end;
end;
procedure load_patterns;
var
num_ptn : longint;
n : word;
m_ptn : integer;
begin
{$IFDEF __DEBUG__}
write('Loading patterns');
{$ENDIF}
for n := 0 to max_ptn-1 do if mod_error = 0 then begin
{$IFDEF __DEBUG__}
write('.');
{$ENDIF}
virt_allocptn(n);
if mod_error <> 0 then begin
virt_free;
exit;
end;
read_ptn(n);
virt_loadptn(n,mbuf);
end;
{$IFDEF __DEBUG__}
writeln;
{$ENDIF}
end;
procedure load_sample(num : word);
const
block = 4096;
var
n : longint;
w : word;
fl,l : word;
b : byte;
begin
{$IFDEF __DEBUG__}
write('.');
{$ENDIF}
samples[num].addr := top_addr;
gus_addr[num] := top_addr;
if samples[num].length < 1 then begin
guspoke(top_addr,0);
guspoke(top_addr+1,0);
guspoke(top_addr+2,0);
inc(top_addr,2);
exit;
end;
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(misc_buf,top_addr,block,0); {load in 4kb blocks}
inc(top_addr,block);
end;
if l > 0 then begin
blockread(f,misc_buf^,l);
load2gus(misc_buf,top_addr,l,0); {load remainder}
inc(top_addr,l);
end;
if samples[num].loop then begin
b := guspeek(gus_addr[num]+samples[num].loopstart);
guspoke(gus_addr[num]+samples[num].loopend+1,b);
guspoke(gus_addr[num]+samples[num].loopend,b);
inc(top_addr,2);
end
else begin
guspoke(top_addr,0);
inc(top_addr);
guspoke(top_addr,0);
end;
end;
var
i : integer;
l : longint;
begin
mod_error := 0;
l := maxavail;
getmem(misc_buf,256*maxchn);
l := maxavail;
getmem(mbuf,320*maxchn);
l := maxavail;
@oldheaperr := heaperror;
{heaperror := @heaperr;}
if mod_error <> 0 then exit;
misc_buf2 := addr(misc_buf^);
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;
heaperror := @oldheaperr;
freemem(mbuf,320*maxchn);
freemem(misc_buf,256*maxchn);
exit;
end;
set_up_modheader;
if mod_error <> 0 then begin
heaperror := @oldheaperr;
freemem(mbuf,320*maxchn);
freemem(misc_buf,256*maxchn);
exit;
end;
mod_sample_info;
virt_alloc(max_ptn,sizeof(t_note)*64*header.chns);
load_patterns;
if mod_error <> 0 then begin
heaperror := @oldheaperr;
freemem(mbuf,320*maxchn);
freemem(misc_buf,256*maxchn);
exit;
end;
{$IFDEF __DEBUG__}
write('Loading samples');
{$ENDIF}
for i := 0 to 31 do load_sample(i);
{$IFDEF __DEBUG__}
writeln;
{$ENDIF}
close(f);
{$i+}
l := maxavail;
freemem(mbuf,maxchn*320);
l := maxavail;
freemem(misc_buf,maxchn*256);
l := maxavail;
loaded := true;
heaperror := @oldheaperr;
end;
{$ENDIF}
procedure free_mod;
begin
if playing then stop_playing;
if not loaded then exit;
loaded := false;
virt_free;
top_addr := low_addr+16;
fillchar(samples,sizeof(samples),0);
gus_bank := 0;
end;
{$IFDEF __S3M__}
{$IFDEF __MOD__}
procedure load_s3m(s : string);
{$ELSE}
procedure load_mod(s : string);
{$ENDIF}
var
mbuf : pointer;
f : file;
oldheaperr : procedure;
ins_ptr : array[0..99] of word;
ptn_ptr : array[0..127] of word;
hdr : p_s3mheader;
procedure set_up_s3mheader;
var
i,j : integer;
b : byte;
begin
fillchar(ins_ptr,sizeof(ins_ptr),0);
fillchar(ptn_ptr,sizeof(ptn_ptr),0);
fillchar(usedptn,sizeof(usedptn),0);
fillchar(header,sizeof(header),0);
hdr := @misc_buf^;
move(hdr^.name,header.name[1],28);
i := 0;
while hdr^.name[i] <> #0 do inc(i);
header.name[0] := char(i);
j := 0;
for i := 0 to hdr^.ordnum -1 do
if hdr^.data[i] < 254 then j := i;
header.length := j+1;
if header.length=0 then header.length := 1;
j := 0;
for i := 0 to header.length-1 do begin
b := hdr^.data[i];
if b < 128 then usedptn[b] := true;
if (b < 128) and (b > j) then j := b;
end;
max_ptn := j+1;
if max_ptn > hdr^.patnum then
for j := hdr^.patnum to max_ptn do usedptn[j] := false;
if max_ptn=0 then begin
max_ptn := 1;
usedptn[0] := true;
end;
move(hdr^.data,orders,hdr^.ordnum);
for j := 0 to header.length-1 do
if (orders[j] < 128) and (usedptn[orders[j]] = false) then orders[j] := 254;
main_vol := hdr^.gvol;
header.ispeed := hdr^.ispeed;
header.itempo := hdr^.itempo;
header.samples := hdr^.insnum;
move(hdr^.chn_set,header.chn_set,32);
move(hdr^.data[hdr^.ordnum],ins_ptr,header.samples*2);
move(hdr^.data[hdr^.ordnum+hdr^.insnum*2],
ptn_ptr,max_ptn*2);
move(def_s3mpan,header.chn_pan,32);
if hdr^.dp=252 then begin
move(hdr^.data[hdr^.ordnum+hdr^.insnum*2+hdr^.patnum*2],
header.chn_pan,32);
for i := 0 to 31 do if header.chn_pan[i] and 32 = 0 then
header.chn_pan[i] := ((header.chn_set[i] shr 3) and 1)*9+3
else header.chn_pan[i] := header.chn_pan[i] and 15;
end;
j := 0;
for i := 0 to 31 do if header.chn_set[i] < 16 then j := i;
header.chns := j+1;
header.usedchns := 0;
header.modtype := mt_s3m;
if header.chns > maxchn then begin
header.usedchns := 4;
gusdiv := gus_div[14];
gussetchns(13);
mod_error := 1;
exit;
end;
end;
procedure load_inst;
var
num : integer;
i,j : integer;
begin
fillchar(samples,sizeof(samples),0);
fillchar(gus_addr,sizeof(gus_addr),0);
for num := 0 to 99 do samples[num].name[0] := #27;
for num := 0 to 99 do samples[num].c4spd := 8363;
for num := 0 to header.samples-1 do with samples[num+1] do begin
seek(f,ins_ptr[num]*16);
blockread(f,samples[num+1],80);
move(name,name[1],27);
name[0] := #27;
i := 1;
while (name[i] <> #0) and (i < 27) do inc(i);
if i > 27 then i := 27;
if i < 27 then for j := i+1 to 27 do name[j] := #0;
name[0] := #27;
addr := (longint(memseg) shl 16+longint(memofs)) shl 4;
if flags and 1 <> 0 then loop := true;
if loopstart = loopend then loop := false;
if _type<> 1 then begin
length := 0;
loopstart := 0;
loopend := 0;
addr := 0;
end;
end;
end;
procedure read_ptn(ptn : integer);
var
buf : p_memarray2;
mchn : integer;
chn,row,n : integer;
mb : p_pattern;
fc,size : word;
org_b,b,b2 : byte;
fx,fxdata,efxdata : byte;
l : longint;
begin
mchn := header.chns;
mb := mbuf;
fillchar(mbuf^,320*maxchn,255);
for chn := 0 to header.chns-1 do for row := 0 to 63 do begin
mb^[row*mchn+chn].sample := 0;
mb^[row*mchn+chn].fxdata := 0;
end;
if not usedptn[ptn] then exit;
if ptn_ptr[ptn]=0 then exit;
seek(f,longint(ptn_ptr[ptn])*16);
blockread(f,size,2);
if size = 0 then exit;
if size > 256*maxchn then begin
size := 256*maxchn;
end;
blockread(f,misc_buf^,size);
buf := misc_buf;
fc := 0;
row := 0;
chn := 0;
while (fc < size) or (row > 63) do begin
org_b := buf^[fc]; inc(fc);
if org_b = 0 then begin
chn := 0;
inc(row);
if row > 63 then begin
exit;
end;
end
else begin
chn := org_b and 31;
if org_b and 32 > 0 then begin
b := buf^[fc]; inc(fc);
b2 := buf^[fc]; inc(fc);
if chn < header.chns then begin
if chn > header.usedchns then header.usedchns := chn;
mb^[row*mchn+chn].note := b;
mb^[row*mchn+chn].sample := b2;
end;
end;
if org_b and 64 > 0 then begin
b := buf^[fc]; inc(fc);
if chn < header.chns then mb^[row*mchn+chn].vol := b;
end;
if org_b and 128 > 0 then begin
fx := buf^[fc]; inc(fc);
fxdata := buf^[fc]; inc(fc);
efxdata := fxdata and 15;
case fx of
19 : case fxdata shr 4 of
0 : fx := $e; {set filter}
2 : begin {set finetune}
fx := $e;
fxdata := $50 or efxdata;
end;
$b : begin
fx := $e;
fxdata := $60 or efxdata;
end;
8,$c,$d,$e : fx := $e;
end;
else if fx < 29 then fx := s3m_fx[fx];
end;
if fx=255 then begin
fx := $e;
fxdata := buf^[fc-2] and 15;
end;
if (fx=16) and (fxdata = 0) then fx := 255;
if chn < header.chns then begin
mb^[row*mchn+chn].fx := fx;
mb^[row*mchn+chn].fxdata := fxdata;
end;
end;
end;
end;
end;
procedure load_ptns;
var
ptn : integer;
begin
{$IFDEF __DEBUG__}
write('Loading patterns');
{$ENDIF}
for ptn := 0 to max_ptn-1 do if usedptn[ptn] then begin
{$IFDEF __DEBUG__}
write('.');
{$ENDIF}
virt_allocptn(ptn);
if mod_error <> 0 then begin
virt_free;
exit;
end;
read_ptn(ptn);
virt_loadptn(ptn,mbuf);
end;
{$IFDEF __DEBUG__}
writeln;
{$ENDIF}
end;
procedure load_sample(num : word);
const
block = 4096;
var
n : longint;
w : word;
fl,l : word;
len : longint;
b : byte;
begin
seek(f,samples[num].addr);
{$IFDEF __DEBUG__}
write('.');
{$ENDIF}
samples[num].addr := top_addr;
gus_addr[num] := top_addr;
if samples[num].length < 1 then begin
guspoke(top_addr,0);
guspoke(top_addr+1,0);
guspoke(top_addr+2,0);
inc(top_addr,2);
exit;
end;
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(misc_buf,top_addr,block,128); {load in 4kb blocks}
inc(top_addr,block);
end;
if l > 0 then begin
blockread(f,misc_buf^,l);
load2gus(misc_buf,top_addr,l,128); {load remainder}
inc(top_addr,l);
end;
if samples[num].loop then begin
b := guspeek(gus_addr[num]+samples[num].loopstart);
guspoke(gus_addr[num]+samples[num].loopend+1,b);
guspoke(gus_addr[num]+samples[num].loopend,b);
inc(top_addr,2);
end
else begin
guspoke(top_addr,0);
guspoke(top_addr+1,0);
guspoke(top_addr+2,0);
inc(top_addr,2);
end;
end;
procedure load_samples;
var
sam : integer;
i,j : integer;
begin
{$IFDEF __DEBUG__}
write('Loading samples');
{$ENDIF}
for sam := 1 to header.samples do if samples[sam]._type = 1 then
load_sample(sam);
{$IFDEF __DEBUG__}
writeln;
{$ENDIF}
end;
var
i : integer;
begin
mod_error := 0;
getmem(misc_buf,256*maxchn);
getmem(mbuf,320*maxchn);
{@oldheaperr := heaperror;
heaperror := @heaperr;}
if mod_error <> 0 then exit;
misc_buf2 := addr(misc_buf^);
gus_bank := 0;
assign(f,s);
{$i-}
reset(f,1);
blockread(f,misc_buf^,500); {read s3m header}
i := ioresult;
if i <> 0 then begin
mod_error := 2;
heaperror := @oldheaperr;
freemem(mbuf,320*maxchn);
freemem(misc_buf,256*maxchn);
exit;
end;
set_up_s3mheader;
if mod_error <> 0 then begin
{$i-}
close(f);
{$i+}
heaperror := @oldheaperr;
freemem(mbuf,320*maxchn);
freemem(misc_buf,256*maxchn);
exit;
end;
load_inst;
seek(f,0);
virt_alloc(max_ptn,sizeof(t_note)*64*header.chns);
load_ptns;
load_samples;
inc(header.usedchns);
i := header.usedchns;
{$IFDEF __FX__}
base_fx_chn := i;
inc(i,fxchns);
{$ENDIF}
if i < 14 then gussetchns(13)
else gussetchns(i-1);
gusdiv := gus_div[i];
{heaperror := @oldheaperr;}
freemem(mbuf,320*maxchn);
freemem(misc_buf,256*maxchn);
close(f);
loaded := true;
end;
{$ENDIF}
{$ENDIF}
procedure goto_mod(ptn,row : integer);
begin
jump := 1;
if ptn > header.length-1 then ptn := header.length;
if ptn < 0 then ptn := 0;
new_ptn := ptn;
new_row := row;
virt_warnptn(orders[ptn]);
end;
procedure initchn(chn : integer);
begin
fillchar(channels[chn],sizeof(t_channel),0);
channels[chn].per := st3_per[0];
channels[chn].dper := st3_per[0];
channels[chn].note := 4*16;
channels[chn].basenote := 4*16;
channels[chn].sample := 0;
channels[chn].pan := 7;
channels[chn].on := 1;
channels[chn].fx := 255;
end;
procedure gusstarttimer1(time : integer);
begin
asm
pushf
cli
end;
port[command] := timer1;
port[data_high] := 256-time;
port[command] := timer_control;
port[data_high] := 4;
port[gus_base+8] := 4;
port[gus_base+9] := 1;
asm
popf
end;
end;
procedure gusstoptimer1;
begin
asm
pushf
cli
end;
port[command] := timer_control;
port[data_high] := 0;
port[gus_base+8] := 4;
port[gus_base+9] := $80;
asm
popf
end;
end;
var
oldexitproc : pointer;
procedure newexitproc; far;
begin
exitproc := oldexitproc;
if gus_irq <> 0 then gusstoptimer1
else set_timer(65535);
setintvec(dos_irq,@oldint);
asm
mov cx,30
@@1:
mov ah,2
mov dl,7
int 21h {Just to remind you to call done_mod}
loop @@1
end;
end;
procedure done_mod;
begin
if playing then stop_playing;
setintvec(dos_irq,@oldint);
exitproc := oldexitproc;
gusdeinit;
end;
procedure init_mod;
var
n,i : integer;
l : longint;
begin
virt_info.err_wptn := -1;
virt_info.err_nptn := -1;
virt_info.err_cptn := -1;
virt_error := 0;
virt_alloc := def_virt_alloc;
virt_free := def_virt_free;
virt_allocptn := def_virt_allocptn;
virt_loadptn := def_virt_loadptn;
virt_freeptn := def_virt_freeptn;
virt_getptn := def_virt_getptn;
virt_warnptn := def_virt_warnptn;
virt_needptn := def_virt_needptn;
virt_noneedptn := def_virt_noneedptn;
for n := 0 to 255 do orders[n] := 0;
for n := 0 to maxchn-1 do begin
initchn(n);
gussetbalance(n,channels[n].pan);
end;
fillchar(samples,sizeof(samples),0);
for n := 0 to 13 do gusplayvoice(n,2,0,0,1);
for n := 0 to 13 do gussetvolume(n,0);
for n := 0 to 13 do gussetbalance(n,7);
fillchar(header,sizeof(header),0);
header.chns := 4;
header.usedchns := 4;
cur_ptn := 0;
cur_row := 0;
new_ptn := 0;
new_row := 0;
cur_tick := 0;
pdelay := 0;
main_vol := 64;
vblank := false;
low_addr := 0;
top_addr := low_addr+16;
gus_bank := 0;
for n := 0 to 31 do guspoke(n,0);
playing := false;
loaded := false;
oldexitproc := exitproc;
exitproc := @newexitproc;
if gus_irq > 7 then begin
dos_irq := gus_irq+$68;
port[$a1] := port[$a1] and not (1 shl (gus_irq-8));
port[$21] := port[$21] and $fb;
end else begin
dos_irq := gus_irq+8;
port[$21] := port[$21] and not (1 shl gus_irq);
end;
getintvec(dos_irq,@oldint);
if gus_irq <> 0 then begin
port[gus_base] := $49;
i := 5;
case gus_irq of
2 : i := 1;
5 : i := 2;
3 : i := 3;
7 : i := 4;
11 : i := 5;
12 : i := 6;
15 : i := 7;
end;
port[gus_base+$b] := i;
setintvec(dos_irq,@gusint);
gusstoptimer1;
end
else setintvec(dos_irq,@timerint);
end;
{$s-}
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
playing := false;
int_rate := 65535;
if gus_irq <> 0 then gusstoptimer1
else set_timer(65535);
{setintvec(dos_irq,@oldint);}
for n := 0 to maxchn-1 do begin
{$IFNDEF __MINI__}
channels[n].hit := 0;
channels[n].bar := 0;
{$ENDIF}
GusStopVoice(n);
gussetofs(n,0);
end;
end;
procedure start_playing;
var
n : integer;
begin
if (not loaded) or (playing) then exit;
for n := 0 to maxchn-1 do initchn(n);
speed := header.ispeed;
nspeed := header.ispeed;
tempo := header.itempo;
for n := 0 to header.usedchns-1 do begin
fillchar(gus_chn,sizeof(gus_chn),0);
gussetvolume(n,0);
channels[n].pan := header.chn_pan[n];
gussetbalance(n,channels[n].pan);
gusstopvoice(n);
gussetofs(n,0);
end;
for n := 0 to maxchn-1 do gus_chn[n].pan := channels[n].pan;
pdelay := 0;
loops := 0;
loope := 0;
loopcnt := 0;
jump := 0;
main_vol := 64;
int_tick := 0;
cur_ptn := 0;
cur_row := 0;
new_ptn := 0;
new_row := 0;
cur_tick := 0;
time_counter := 0;
time_counter2 := 0;
time_counter3 := 0;
virt_warnptn(orders[0]);
virt_needptn(orders[0]);
asm cli end;
{setintvec(dos_irq,@timerint);}
timer_rate := 25000 div (tempo);
timer_cnt := timer_rate;
int_rate := 1193182 div 1250;
if gus_irq = 0 then set_timer(int_rate)
else gusstarttimer1(10);
playing := true;
asm sti end;
end;
{$IFDEF __FX__}
procedure init_fx(fxspace: longint;chns : integer);
{fxspace = gus memory reserved for sound fx, chns = # of channels
reserved for sound fx}
var
n : integer;
begin
fillchar(fx_samples,sizeof(fx_samples),0);
fillchar(fx_channels,sizeof(fx_channels),0);
for n := 0 to maxfxchn-1 do with fx_channels[n] do begin
note := 4*16;
basenote := 4*16;
per := 1712;
dper := 1712;
pan := 7;
end;
for n := 0 to 31 do begin
fx_samples[n].c4spd := 8363;
end;
low_addr := fxspace;
top_addr := fxspace+16;
for n := 0 to 31 do guspoke(n+low_addr,0);
for n := 0 to 31 do guspoke(n,0);
top_fx_addr := 16;
base_fx_chn := 0;
fxchns := chns;
end;
function load_fx_raw(s : string;num : integer) : integer;
{Loads a raw (signed) sample}
const
block = 4096;
var
f : file;
n : integer;
fl,l : word;
oa : longint;
begin
oa := top_fx_addr;
fillchar(fx_samples[num],sizeof(fx_samples[num]),0);
{$i-}
assign(f,s);
reset(f,1);
if ioresult <> 0 then begin
load_fx_raw := -1;
exit;
end;
with fx_samples[num] do begin
_type := 1;
volume := 64;
c4spd := 8363;
length := filesize(f);
addr := top_fx_addr;
end;
getmem(misc_buf,block);
fl := fx_samples[num].length div block;
l := fx_samples[num].length mod block;
if fl > 0 then for n := 1 to fl do begin
blockread(f,misc_buf^,block);
load2gus(misc_buf,top_fx_addr,block,0);
inc(top_fx_addr,block);
end;
if l > 0 then begin
blockread(f,misc_buf^,l);
load2gus(misc_buf,top_fx_addr,l,0);
inc(top_fx_addr,l);
end;
guspoke(top_fx_addr,0);
guspoke(top_fx_addr+1,0);
inc(top_fx_addr);
freemem(misc_buf,block);
close(f);
load_fx_raw := 0;
end;
function load_fx_st3(s : string;num : integer) : integer;
{Loads an ST3 instrument file}
const
block = 4096;
var
f : file;
n : integer;
fl,l : word;
oa : longint;
begin
oa := top_fx_addr;
fillchar(fx_samples[num],sizeof(fx_samples[num]),0);
{$i-}
assign(f,s);
reset(f,1);
if ioresult <> 0 then begin
load_fx_st3 := -1;
exit;
end;
blockread(f,fx_samples[num],sizeof(fx_samples[num]));
with fx_samples[num] do begin
if flags and 1 <> 0 then loop := true;
if loopstart = loopend then loop := false;
addr := top_fx_addr;
if _type<> 1 then begin
length := 0;
loopstart := 0;
loopend := 0;
addr := 0;
end;
end;
getmem(misc_buf,block);
fl := fx_samples[num].length div block;
l := fx_samples[num].length mod block;
if fl > 0 then for n := 1 to fl do begin
blockread(f,misc_buf^,block);
load2gus(misc_buf,top_fx_addr,block,128);
inc(top_fx_addr,block);
end;
if l > 0 then begin
blockread(f,misc_buf^,l);
load2gus(misc_buf,top_fx_addr,l,128);
inc(top_fx_addr,l);
end;
with fx_samples[num] do begin
if loop then begin
guspoke(addr+loopend+1,
guspeek(addr+loopstart));
guspoke(addr+loopend,
guspeek(addr+loopstart));
inc(top_fx_addr,2);
end;
end;
guspoke(top_fx_addr,0);
guspoke(top_fx_addr+1,0);
inc(top_fx_addr);
freemem(misc_buf,block);
close(f);
load_fx_st3 := 0;
end;
procedure play_fx(_chn,num : integer);
{Plays a sample [num] in channel [_chn]}
var
c4spd : word;
l : word;
chn : integer;
begin
if (_chn >= fxchns) or (num > 31) then exit;
chn := base_fx_chn+_chn;
c4spd := fx_samples[num].c4spd;
with fx_channels[_chn] do begin
sample := num;
note := 4*16;
basenote := 4*16;
vol := 64;
per := longdiv((longmul(8363,
16*st3_per[note and 15]) shr (note shr 4)),c4spd);
gvol := gusvol[64]*fx_amp_vol+20000;
gussetbalance(chn,pan);
if (fx_samples[num].loop) then
gusplayall(chn,8,fx_samples[num].addr,
fx_samples[num].addr+fx_samples[num].loopstart,
fx_samples[num].addr+fx_samples[num].loopend,
per2gus(per),gvol)
else gusplayall(chn,0,fx_samples[num].addr,
fx_samples[num].addr,
fx_samples[num].addr+fx_samples[num].length,
per2gus(per),gvol);
end;
end;
{$ENDIF}
end.