home *** CD-ROM | disk | FTP | other *** search
/ Collection of Hack-Phreak Scene Programs / cleanhpvac.zip / cleanhpvac / AMOD095.ZIP / MODUNIT.PAS < prev    next >
Pascal/Delphi Source File  |  1995-12-21  |  76KB  |  2,635 lines
  1. {AdnMod 0.95 by Beta/A-Men.
  2.  GUS only (working on SB support)
  3.  Thanks to:
  4.     Gravis for great soundcard
  5.     flap / Capacala for sending me "some" info
  6.     Mark Feldman for PCGPE
  7.     Mark Dixon for his GUS669 source
  8.     Thunder for excellent info about MODs
  9.     Tran & Joshua C. Jensen for releasing ultradox
  10.  
  11.  Greets:
  12.     Black Hole - Happy now??? ;-)
  13.     Wihannes / Nordic vision
  14.     Solar / Hysteria
  15.     Johnny Field ;-)
  16.     Trane
  17.     Psyko / Acidface software
  18.     ASYLUM.ZIP
  19.     All users of Metropoli & Starport
  20. }
  21. unit modunit;
  22. {$s-}
  23. {$g+}
  24. {$x+}
  25. {$a+}
  26. {$o-}
  27. {$r-}
  28. interface
  29. uses dos,modtypes;
  30. {DEFINE __DEBUG__}
  31. {DEFINE __FX__}     {sound fx support}
  32. {$DEFINE __LOADERS__}
  33. {$DEFINE __S3M__}    {s3m support}
  34. {$DEFINE __MOD__}    {mod support}
  35. {DEFINE __MINI__}
  36. const
  37. mt_mod = 1;
  38. mt_s3m = 2;
  39.  
  40. maxchn = 32;   {max # of channels in mod.}
  41. amp_vol : byte = 15;  {amplifying volume. Increasing by one doubles
  42.                        the volume}
  43. {$IFDEF __FX__}
  44. maxfxchn = 2;
  45. fxchns : integer = 0;
  46. fx_amp_vol : byte = 16;  {amp vol for sound fx}
  47. {$ENDIF}
  48. {$IFDEF __S3M__}
  49. def_s3mpan : array[0..31] of byte =
  50.   ($3,$c,$3,$c,$3,$c,$3,$c,$3,$c,$3,$c,$3,$c,$3,$c,
  51.    $3,$c,$3,$c,$3,$c,$3,$c,$3,$c,$3,$c,$3,$c,$3,$c);
  52. {$ENDIF}
  53. {$IFDEF __MOD__}
  54. def_modpan : array[0..31] of byte =
  55.   ($3,$c,$c,$3,$3,$c,$c,$3,$3,$c,$c,$3,$3,$c,$c,$3,
  56.    $3,$c,$c,$3,$3,$c,$c,$3,$3,$c,$c,$3,$3,$c,$c,$3);
  57. {$ENDIF}
  58. max_per = 32000;          {Max & min period }
  59. min_per = 5;
  60. gus_base : word = 0;       {GUS address}
  61. gus_irq : word = 0;          {GUS IRQ}
  62. ramp_speed = 31;
  63. mod_error : word = 0;
  64. {0 = no error
  65.  1 = too many channels
  66.  2 = load error
  67.  3 = out of pattern memory
  68.  255 = other error}
  69.  
  70. {$IFDEF __MOD__}
  71. per_table : array[1..60] of word = (
  72.    1712,1616,1524,1440,1356,1280,1208,1140,1076,1016,960,906,
  73.    856,808,762,720,678,640,604,570,538,508,480,453,
  74.    428,404,381,360,339,320,302,285,269,254,240,226,
  75.    214,202,190,180,170,160,151,143,135,127,120,113,
  76.    107,101,95,90,85,80,75,71,67,63,60,56);
  77. note_table : array[1..60] of byte =
  78.    (32+0,32+1,32+2,32+3,32+4,32+5,32+6,32+7,32+8,32+9,32+10,32+11,
  79.    48+0,48+1,48+2,48+3,48+4,48+5,48+6,48+7,48+8,48+9,48+10,48+11,
  80.    64+0,64+1,64+2,64+3,64+4,64+5,64+6,64+7,64+8,64+9,64+10,64+11,
  81.    80+0,80+1,80+2,80+3,80+4,80+5,80+6,80+7,80+8,80+9,80+10,80+11,
  82.    96+0,96+1,96+2,96+3,96+4,96+5,96+6,96+7,96+8,96+9,96+10,96+11);
  83. {$ENDIF}
  84. ftune_per : array[0..15] of integer =
  85.   (8363,8413,8463,8529,8581,8651,8723,8757,
  86.    7895,7941,7985,8046,8107,8169,8232,8280);
  87.  
  88. st3_per : array[0..15] of integer =
  89.   (1712,1616,1524,1440,1356,1280,1208,1140,1076,1016,0960,0907,
  90.    1712,1712,1712,1712);
  91.  
  92. {$IFDEF __S3M__}
  93. s3m_fx : array[0..28] of byte = (
  94.   255,16,$b,$d,21,17,18,3,4,255,0,6,
  95.   5,255,255,9,255,22,255,255,15,255,23,255,
  96.   8,255,255,255,255);
  97. {$ENDIF}
  98.  
  99. gusvol : array[0..64] of word =
  100. (0,1246,1502,1646,1758,1846,1902,1958,2014,2070,
  101. 2102,2130,2158,2186,2214,2242,2270,2298,2326,2344,
  102. 2358,2372,2386,2400,2414,2428,2442,2456,2470,2484,
  103. 2498,2512,2526,2540,2554,2568,2582,2593,2600,2607,
  104. 2614,2621,2628,2635,2642,2649,2656,2663,2670,2677,
  105. 2684,2691,2698,2705,2712,2719,2726,2733,2740,2747,
  106. 2754,2761,2768,2775,2782);
  107.  
  108.        {gusperiod:=586580935 div (amigaperiod * (divisor div 100 shl 4))}
  109.        {divisor = 44100}
  110. gus_div : array[1..32] of word =
  111.   (7056,7056,7056,7056,7056,7056,7056,7056,7056,7056,7056,7056,7056,7056,
  112.    6576,6160,5808,5488,5184,4928,4704,4480,4288,4112,3936,3792,3648,3520,
  113.    3392,3280,3184,3072);
  114. gusdiv : word = 7056;
  115.  
  116. vib_tbl : array[0..2,0..63] of shortint =    {192 bytes}
  117. ((0,6,12,19,24,30,36,41,45,49,53,56,59,61,63,64,
  118. 64,64,63,61,59,56,53,49,45,41,36,30,24,19,12,6,
  119. 0,-6,-12,-19,-24,-30,-36,-41,-45,-49,-53,-56,-59,-61,-63,-64,
  120. -64,-64,-63,-61,-59,-56,-53,-49,-45,-41,-36,-30,-24,-19,-12,-6),
  121. (-63,-61,-59,-57,-55,-53,-51,-49,-47,-45,-43,-41,-39,-37,-35,-33,
  122. -31,-29,-27,-25,-23,-21,-19,-17,-15,-13,-11,-9,-7,-5,-3,-1,
  123. 1,3,5,7,9,11,13,15,17,19,21,23,25,27,29,31,
  124. 33,35,37,39,41,43,45,47,49,51,53,55,57,59,61,63),
  125. (-64,-64,-64,-64,-64,-64,-64,-64,-64,-64,-64,-64,-64,-64,-64,-64,
  126. -64,-64,-64,-64,-64,-64,-64,-64,-64,-64,-64,-64,-64,-64,-64,-64,
  127. 64,64,64,64,64,64,64,64,64,64,64,64,64,64,64,64,
  128. 64,64,64,64,64,64,64,64,64,64,64,64,64,64,64,64));
  129.  
  130. const
  131. gst_vol = 1;
  132. gst_pan = 2;
  133. gst_ofs = 4;
  134. gst_note = 16;
  135. gst_stop = 32;
  136.  
  137. type
  138.   t_channel = record
  139.                 {gvol : word;}
  140.                 Vol : integer;    {current volume 0-64}
  141.                 note : integer;   {current note lo=note, hi=octave}
  142.                 basenote : integer;
  143.                 Per,dper : word;  {period & dest. period for tone portamentos}
  144.                 Sample : byte;    {current sample}
  145.                 Pan : byte;       {panning}
  146.                 fx,fxdata : byte;
  147.                 fx_sl2 : integer;
  148.                 fx_vib : byte;     {slide to & vibrato fx-data}
  149.                 fx_portd,fx_portu : byte; {slide up & down fx-data}
  150.                 vols : shortint;       {vol slide speed}
  151.                 fx_volslide : byte;       {vol slide fx-data}
  152.                 fx_trm : byte;            {tremolo fx-data}
  153.                 vib_wave : byte;    {vibrato waveform}
  154.                 vib_cnt : byte;     {vibrato counter}
  155.                 trig_cnt : byte;    {retrig counter}
  156.                 arp1,arp2,         {arpeggio params}
  157.                 arp_cnt : byte;     {arpeggio counter}
  158.                 start_fx : byte;    {tick to start do_fx for channel}
  159.                 on : byte;        {0 = channel is muted}
  160.                 {$IFNDEF __MINI__}
  161.                 bar : byte;       {volume bar}
  162.                 hit : byte;
  163.                 {$ENDIF}
  164.                 no_fx : byte;  {1 = do not get new fx}
  165.               end;
  166.   p_channel = ^t_channel;
  167.   t_sample = record
  168.                _type : byte;
  169.                dosname : array[0..11] of char;
  170.                memseg : byte;
  171.                memofs : word;
  172.                length,
  173.                loopstart,
  174.                loopend : longint;
  175.                volume : byte;
  176.                ftune : byte;
  177.                pack : byte;
  178.                flags : byte;
  179.                c4spd : longint;
  180.                loop : boolean;
  181.                dumb2 : array[0..2] of byte;
  182.                intgp , int512 : word;
  183.                addr : longint;
  184.                name : string[27];
  185.                scrs : array[0..3] of char;
  186.              end;
  187.   t_note = record
  188.              note,
  189.              sample,
  190.              vol,
  191.              fx,
  192.              fxdata : byte;
  193.            end;
  194.   p_note = ^t_note;
  195.   t_pattern = array[0..(64*14)-1] of t_note;
  196.   p_pattern = ^t_pattern;
  197.  
  198.   mod_header = record
  199.                  name : string[30];
  200.                  s3m_flags : byte;
  201.                  Length : integer;        {Number of orders in mod}
  202.                  tag : array[0..3] of char;  {M.K.}
  203.                  chns : integer;  {1..14}
  204.                  samples : integer;
  205.                  chn_set : array[0..31] of byte;
  206.                  chn_pan : array[0..31] of byte;
  207.                  ispeed,itempo : integer;
  208.                  modtype : integer; {1=mod,2 = s3m}
  209.                  usedchns : integer;
  210.                end;
  211. {$IFDEF __S3M__}
  212.   p_s3mheader = ^t_s3mheader;
  213.   t_s3mheader = record
  214.                   name : array[0..27] of char;
  215.                   dumb1 : byte;
  216.                   typ : byte;
  217.                   dumb2 : integer;
  218.                   ordnum,insnum,patnum : integer;
  219.                   flags,ver,ffv : word;
  220.                   scrm : array[0..3] of char;
  221.                   gvol,ispeed,itempo,mvol,uc,dp : byte;
  222.                   dumb3 : array[0..9] of byte;
  223.                   chn_set : array[0..31] of byte;
  224.                   data : array[0..400] of byte;
  225.                 end;
  226. {$ENDIF}
  227.   t_guschn = record
  228.                status : word;
  229.                per : longint;
  230.                offset : word;
  231.                sam : word;
  232.                ovol,vol : word;
  233.                pan : integer;
  234.              end;
  235. var
  236.   gus_addr : array[0..99] of longint;    {128 bytes}
  237.   channels : array[0..maxchn-1] of t_channel;
  238.   gus_chn : array[0..maxchn-1] of t_guschn;
  239.   samples : array[0..99] of t_sample;    {8000 bytes}
  240. {$IFDEF __FX__}
  241.   fx_samples : array[0..31] of t_sample;
  242.   fx_channels : array[0..maxfxchn-1] of t_channel;
  243.   base_fx_chn : integer;
  244.   top_fx_addr : longint;
  245. {$ENDIF}
  246.   patterns : array[0..127] of p_pattern; {516 bytes}
  247.   usedptn : array[0..127] of boolean;
  248.   orders : array[0..255] of byte;   {order list}
  249.   max_ptn : word;                   {# patterns in mod}
  250.   cur_ptn,cur_row,cur_tick : byte;
  251.   new_ptn,new_row,jump : byte;      {used in jumps}
  252.   speed,nspeed,tempo : integer;
  253.   main_vol : byte;             {main volume. volume = (vol*main_vol div 64)}
  254.   vblank : boolean;                 {if true then do not use bpm tempos}
  255.   playing,loaded : boolean;   {guess :-)}
  256.  
  257.   header : mod_header;
  258.   low_addr,top_addr : longint;         {Next free address in GUS mem}
  259.  
  260.   dos_irq : integer; {interrupt number}
  261.   timer_rate,timer_cnt,
  262.   int_rate : word;
  263.   time_counter : longint;      {For syncing with demos. Increments
  264.                                 every 1/18.2 seconds}
  265.   time_counter2 : longint;    {Increments every tick}
  266.   time_counter3 : longint;    {1250hz timer}
  267.  
  268.  
  269. {$i gushdr.inc}  {has lots of defines}
  270.  
  271. procedure updatenotes;
  272. procedure start_playing;
  273. procedure stop_playing;
  274. procedure set_timer(ticks : word);
  275. procedure init_mod;
  276. procedure done_mod;
  277. {$IFDEF __LOADERS__}
  278. procedure free_mod;
  279. procedure load_mod(s : string);
  280.  
  281. {$IFDEF __S3M__}
  282. {$IFDEF __MOD__}
  283. procedure _load_mod(s : string);
  284. procedure load_s3m(s : string);
  285. {$ENDIF}
  286. {$ENDIF}
  287. {$ENDIF}
  288. procedure goto_mod(ptn,row : integer);
  289. {$IFDEF __FX__}
  290. procedure init_fx(fxspace : longint;chns : integer);
  291. function load_fx_raw(s : string;num : integer) : integer;
  292. function load_fx_st3(s : string;num : integer) : integer;
  293. procedure play_fx(_chn,num : integer);
  294. {$ENDIF}
  295.  
  296. function per2gus(per : longint) : word;
  297. function longmul(x,y : integer) : longint;
  298. inline($5a/$58/$f7/$ea);
  299. function longdiv(x : longint;y : word) : word;
  300. inline($59/$58/$5a/$f7/$f1);
  301.  
  302. implementation
  303. {const
  304. gst_vol = 1;
  305. gst_pan = 2;
  306. gst_ofs = 4;
  307. gst_note = 16;
  308. gst_stop = 32;}
  309.  
  310. type
  311.   t_memarray = array[0..2000] of word;
  312.   t_memarray2 = array[0..5000] of byte;
  313.   p_memarray = ^t_memarray;
  314.   p_memarray2 = ^t_memarray2;
  315.   {t_guschn = record
  316.                status : word;
  317.                per : longint;
  318.                offset : word;
  319.                sam : word;
  320.                ovol,vol : word;
  321.                pan : integer;
  322.              end;}
  323.  
  324. var
  325.   pdelay,loops,loope,loopcnt : integer;
  326.   int_tick,o_int_tick : word;
  327.  
  328.   oldint : procedure;
  329.  
  330.   gus_bank : longint;
  331. {$IFDEF __LOADERS__}
  332.   misc_buf : p_memarray2;    {buffer used while loading mod}
  333.   misc_buf2 : p_memarray;      {points to misc_buf}
  334. {$ENDIF}
  335.  
  336. {$i gus.inc}
  337.  
  338. procedure dump2gus;
  339. const
  340. chn : integer = 0;
  341. freq : longint = 0;
  342. begin
  343.   for chn := 0 to header.usedchns-1 do with gus_chn[chn] do begin
  344.     gussetfreq(chn,per2gus(per));
  345.     if channels[chn].on <> 1 then vol := 32*256;
  346.     if status and gst_note <> 0 then begin
  347.       freq := per2gus(per);
  348.       if (samples[sam].loop) then
  349.         gusplayall(chn,8,gus_addr[sam]+offset,
  350.                              gus_addr[sam]+samples[sam].loopstart,
  351.                              gus_addr[sam]+samples[sam].loopend,freq,19968)
  352.       else gusplayall(chn,0,gus_addr[sam]+offset,
  353.                             gus_addr[sam]+offset,
  354.                             gus_addr[sam]+samples[sam].length+1,freq,19968);
  355.       gussetramp(chn,20000 shr 8,vol shr 8,ramp_speed);
  356.       gussetbalance(chn,pan);
  357.       ovol := vol;
  358.     end
  359.     else begin
  360.       if status and gst_vol <> 0 then begin
  361.         if (channels[chn].on = 1) and (vol <> ovol) then begin
  362.           {channels[chn].gvol := vol;}
  363.           gussetramp(chn,ovol shr 8,vol shr 8,ramp_speed);
  364.         end;
  365.         ovol := vol;
  366.       end;
  367.       if status and gst_pan <> 0 then gussetbalance(chn,pan);
  368.       if status and gst_ofs <> 0 then gussetofs(chn,gus_addr[sam]+offset);
  369.       if status and gst_stop <> 0 then begin
  370.         ovol := vol;
  371.         gusstopvoice(chn);
  372.         vol := 0;
  373.       end;
  374.     end;
  375.     status := 0;
  376.   end;
  377. end;
  378.  
  379. function per2gus(per : longint) : word;
  380. begin
  381.   per2gus := 586580935 div (per * (gusdiv shr 2));
  382. end;
  383.  
  384. {$s-}
  385. procedure get_notes;
  386. const
  387.   chn : byte = 0;
  388.   ptn : byte = 0;
  389.   org_sam : byte = 0;
  390.   sam : byte = 0;
  391.   note : byte = 0;
  392.   st_ofs : longint = 0;
  393.   per : longint = 0;
  394.   dper : longint = 0;
  395.   vol : word = 0;
  396.   _fx : integer = 0;
  397.   _fxdata : integer = 0;
  398.   mute : byte = 0;
  399.   _ptn : p_pattern = nil;
  400.   c4spd : longint = 0;
  401.   {ovol : word = 0;}
  402.   cchn : p_channel = nil;
  403.   cnote : p_note = nil;
  404.  
  405. procedure prefx;
  406. const
  407. w : word = 0;
  408. _efxdata : byte = 0;
  409. begin
  410.   if _ptn^[cur_row*header.chns+chn].vol < 64 then begin
  411.     vol := _ptn^[cur_row*header.chns+chn].vol;
  412.   end;
  413.   case _fx of
  414.     9 : begin
  415.           st_ofs := word(_fxdata*$100);
  416.           channels[chn].no_fx := 1;
  417.           channels[chn].fx := _fx;
  418.           channels[chn].fxdata := _fxdata;
  419.           with gus_chn[chn] do begin
  420.             offset := word(_fxdata) shl 8;
  421.             status := status or gst_ofs;
  422.           end;
  423.         end;
  424.     $c : begin
  425.            if _fxdata > 64 then _fxdata := 64;
  426.            vol := _fxdata;
  427.            channels[chn].fx := $c;
  428.            channels[chn].fxdata := _fxdata;
  429.            channels[chn].no_fx := 1;
  430.          end;
  431.     $e : begin
  432.            _efxdata := _fxdata and 15;
  433.            case _fxdata shr 4 of
  434.              4 : begin
  435.                 channels[chn].fx := _fx;
  436.                  channels[chn].fxdata := _fxdata;
  437.                  if _efxdata and 3 < 3 then channels[chn].vib_wave := _efxdata
  438.                  else channels[chn].vib_wave := 0 or (_efxdata and 4);
  439.                end;
  440.              8 : begin
  441.                    channels[chn].pan := _efxdata;
  442.                    gus_chn[chn].status := gus_chn[chn].status or gst_pan;
  443.                    gus_chn[chn].pan := _efxdata;
  444.                  end;
  445.              $c : if _efxdata and 15 = 0 then begin
  446.                     mute := 1;
  447.                     {gusstopvoice(chn);}
  448.                     gus_chn[chn].status := gus_chn[chn].status or gst_stop;
  449.                   end;
  450.              $d : if _efxdata > 0 then mute := 2
  451.                   else mute := 0;
  452.            end;
  453.     end;
  454.   end;
  455. end;
  456.  
  457. begin
  458.   ptn := orders[cur_ptn];
  459.   _ptn := virt_getptn(ptn);
  460.   for chn := 0 to header.usedchns-1 do begin
  461.     cnote := @_ptn^[cur_row*header.chns+chn];
  462.     cchn := @channels[chn];
  463.     if cchn^.fx = 0 then begin
  464.       sam := cchn^.sample;
  465.       note := cchn^.basenote;
  466.       cchn^.note := note;
  467.       per := (8363 * longint((16*st3_per[note and 15]) shr (note shr 4)))
  468.               div samples[cchn^.sample].c4spd;
  469.       cchn^.per := per;
  470.     end;
  471.     gus_chn[chn].per := cchn^.per;
  472.     {$IFNDEF __MINI__}
  473.     cchn^.hit := 0;
  474.     {$ENDIF}
  475.     if cnote^.note = 254 then cchn^.note := 254
  476.     else if cchn^.note = 254 then cchn^.note := cchn^.basenote;
  477.     if ((cnote^.note < 254) or
  478.     (cnote^.sample > 0)) then begin
  479.       mute := 0;
  480.       vol := cchn^.vol;
  481.       per := cchn^.per;
  482.       note := cchn^.note;
  483.       _fx := cnote^.fx;
  484.       _fxdata := cnote^.fxdata;
  485.       org_sam := cnote^.sample;
  486.       st_ofs := 0;
  487.       if samples[org_sam]._type <> 1 then sam := cchn^.sample
  488.       else begin
  489.         sam := org_sam;
  490.         if sam = cchn^.sample then mute := 1;
  491.       end;
  492.       c4spd := samples[sam].c4spd;
  493.       if (_fx = $e) and (_fxdata shr 4 = 5) then
  494.         c4spd := ftune_per[_fxdata and 15];
  495.       if (_fx = 3) or (_fx = 5) then begin {port to/port to&vol slide}
  496.         mute := 1; {dont restart sample}
  497.         if cnote^.note < 254 then begin
  498.           note := cnote^.note;
  499.           if c4spd = 8363 then
  500.             dper := (16*st3_per[note and 15]) shr (note shr 4)
  501.       else begin
  502.             {if header.modtype = mt_s3m then
  503.               dper := longdiv(longint(8363*
  504.                       longint(16*st3_per[note and 15])) shr (note shr 4),c4spd)}
  505.             {else} dper := longdiv((longmul(8363,
  506.                       (st3_per[note and 15] shl 4)) shr (note shr 4)),c4spd);
  507.           end;
  508.           if dper > max_per then dper := max_per;
  509.           if dper < min_per then dper := min_per;
  510.           cchn^.dper := dper;
  511.         end;
  512.       end
  513.       else if cnote^.note < 254 then begin
  514.         note := cnote^.note;
  515.         if c4spd = 8363 then per := (16*st3_per[note and 15]) shr (note shr 4)
  516.         else begin
  517.           {if header.modtype = mt_s3m then
  518.             per := longdiv(longmul(8363,
  519.                    16*st3_per[note and 15]) shr (note shr 4),c4spd)}
  520.           {else} per := longdiv(longmul(8363,16*st3_per[note and 15])
  521.                                 shr (note shr 4),c4spd);
  522.         end;
  523.         if per > max_per then per := max_per;
  524.         if per < min_per then per := min_per;
  525.         cchn^.dper := per;
  526.         cchn^.per := per;
  527.         mute := 0;
  528.       end;
  529.       if org_sam > 0 then begin    {should I reset volume}
  530.         vol := samples[sam].volume;
  531.         if cchn^.sample <> org_sam then mute := 0;
  532.       end;
  533.       st_ofs := 0;
  534.       if (header.modtype = mt_mod) and (samples[sam].length > 2) then st_ofs := 2;
  535.         {coz first 2 bytes = amiga loopinfo, discard them}
  536.       cchn^.no_fx := 0;
  537.       prefx;
  538.       cchn^.vol := vol;
  539.       cchn^.note := note;
  540.       cchn^.basenote := note;
  541.       cchn^.sample := sam;
  542.       {$IFNDEF __MINI__}
  543.       cchn^.bar := vol;
  544.       {$ENDIF}
  545.       vol := (gusvol[word(vol*main_vol) div 64]*amp_vol+20000);
  546.       if st_ofs > samples[sam].length then st_ofs := samples[sam].length;
  547.       {if cchn^.on = 0 then mute := 1;}
  548.       gus_chn[chn].sam := sam;
  549.       gus_chn[chn].per := per;
  550.       if mute = 0 then begin
  551.         gus_chn[chn].status := gus_chn[chn].status or gst_note;
  552.         gus_chn[chn].offset := st_ofs;
  553.         gus_chn[chn].vol := vol;
  554.         {$IFNDEF __MINI__}
  555.         cchn^.hit := 1;
  556.         {$ENDIF}
  557.       end
  558.       else begin
  559.         gus_chn[chn].status := gus_chn[chn].status or gst_vol;
  560.         gus_chn[chn].vol := vol;
  561.       end;
  562.     end;
  563.   end;
  564. end;
  565.  
  566. procedure get_fx;
  567. const
  568. chn : byte = 0;
  569. ptn : byte = 0;
  570. _fx : integer = 0;
  571. _fxdata : integer = 0;
  572. _efx : integer = 0;
  573. _efxdata : integer = 0;
  574. per : longint = 0;
  575. b : byte = 0;
  576. i : integer = 0;
  577. w : word = 0;
  578. _ptn : p_pattern = nil;
  579. cnote : p_note = nil;
  580.  
  581. begin
  582.   _ptn := virt_getptn(orders[cur_ptn]);
  583.   new_ptn := cur_ptn;
  584.   new_row := cur_row;
  585.   jump := 0;
  586.   pdelay := 0;
  587.   for chn := 0 to header.usedchns-1 do begin
  588.    if channels[chn].note = 254 then
  589.      gus_chn[chn].status := gus_chn[chn].status or gst_stop;
  590.    if channels[chn].no_fx = 0 then begin
  591.     cnote := @_ptn^[cur_row*header.chns+chn];
  592.     _fx := cnote^.fx;
  593.     _fxdata := cnote^.fxdata;
  594.     if channels[chn].fx <> 22 then channels[chn].trig_cnt := 0;
  595.     channels[chn].start_fx := 0;
  596.     channels[chn].fx := _fx;
  597.     channels[chn].fxdata := _fxdata;
  598.     if (cnote^.vol < 255) and (_fx <> $c) then with cnote^ do begin
  599.       i := vol;
  600.       if i > 64 then i := 64;
  601.       channels[chn].vol := i;
  602.       {$IFNDEF __MINI__}
  603.       channels[chn].bar := i;
  604.       {$ENDIF}
  605.       with gus_chn[chn] do begin
  606.         status := status or gst_vol;
  607.         vol := gusvol[word(i*main_vol) div 64]*amp_vol+20000;
  608.       end;
  609.     end;
  610.     if _fx <> 255 then
  611.     case _fx of
  612.       0 : begin {Arpeggio}
  613.             channels[chn].arp1 := _fxdata shr 4;
  614.             channels[chn].arp2 := _fxdata and 15;
  615.             channels[chn].arp_cnt := 0;
  616.             channels[chn].basenote := channels[chn].note;
  617.           end;
  618.       {$IFDEF __MOD__}
  619.       1 : begin  {port up}
  620.             if _fxdata = 0 then begin
  621.               _fxdata := channels[chn].fx_portu;
  622.               channels[chn].fxdata := _fxdata;
  623.             end
  624.             else channels[chn].fx_portu := _fxdata;
  625.             channels[chn].start_fx := 2;
  626.           end;
  627.       2 : begin  {port down}
  628.             if _fxdata = 0 then begin
  629.               _fxdata := channels[chn].fx_portd;
  630.               channels[chn].fxdata := _fxdata;
  631.             end
  632.             else channels[chn].fx_portd := _fxdata;
  633.             channels[chn].start_fx := 2;
  634.           end;
  635.       {$ENDIF}
  636.       3 :  begin   {port to}
  637.             if _fxdata > 0 then begin
  638.               channels[chn].fxdata := _fxdata;
  639.               channels[chn].fx_sl2 := _fxdata;
  640.             end
  641.             else channels[chn].fxdata := channels[chn].fx_sl2;
  642.             if channels[chn].per <> channels[chn].dper then
  643.               channels[chn].start_fx := 2
  644.             else channels[chn].fx := 255;
  645.           end;
  646.       4 : begin    {vibrato}
  647.             b := _fxdata and 15;
  648.             if b = 0 then b := channels[chn].fx_vib and 15;
  649.             w := b;
  650.             b := _fxdata and $f0;
  651.             if b = 0 then b := channels[chn].fx_vib and $f0;
  652.             w := w or b;
  653.             channels[chn].fxdata := w;
  654.             channels[chn].fx_vib := w;
  655.           end;
  656.       5 : begin    {port to & vol slide}
  657.              if _fxdata = 0 then _fxdata := channels[chn].fx_volslide;
  658.              if _fxdata and 15 > 0 then
  659.                _fxdata := _fxdata and 15; {if both ways, then slide down}
  660.              channels[chn].fx_volslide := _fxdata;
  661.              channels[chn].fxdata := _fxdata;
  662.           end;
  663.       6 : begin      {Vibrato & vol slide}
  664.             if _fxdata = 0 then _fxdata := channels[chn].fx_volslide;
  665.             if _fxdata and 15 > 0 then begin {slide up}
  666.               _fxdata := _fxdata and 15;
  667.               i := -_fxdata;
  668.             end
  669.             else begin
  670.               i := _fxdata shr 4 and 15;
  671.             end;
  672.             channels[chn].fx_volslide := _fxdata;
  673.             channels[chn].fxdata := _fxdata;
  674.             channels[chn].vols := i;
  675.           end;
  676.       7 : begin      {Tremolo}
  677.             if _fxdata > 0 then begin
  678.               channels[chn].fxdata := _fxdata;
  679.               channels[chn].fx_trm := _fxdata;
  680.             end
  681.             else channels[chn].fxdata := channels[chn].fx_trm;
  682.           end;
  683.       8 : begin       {Set dmp-panning}
  684.             if _fxdata = $80 then i := 15
  685.             else if _fxdata = $a4 then i := 7
  686.             else if _fxdata < $80 then i := _fxdata shr 3;
  687.             channels[chn].pan := i;
  688.             with gus_chn[chn] do begin
  689.               pan := i;
  690.               status := status or gst_pan;
  691.             end;
  692.           end;
  693.       9 : with gus_chn[chn] do begin   {set sample offset}
  694.             offset := word(_fxdata) shl 8;
  695.             status := status or gst_ofs;
  696.           end;
  697.       {$IFDEF __MOD__}
  698.       $a : begin   {volume slide}
  699.              if _fxdata = 0 then _fxdata := channels[chn].fx_volslide;
  700.              if _fxdata and 15 > 0 then begin {slide down}
  701.                _fxdata := _fxdata and 15;
  702.                i := -(_fxdata and 15);
  703.              end
  704.              else i := _fxdata shr 4 and 15;
  705.              channels[chn].fxdata := _fxdata;
  706.              channels[chn].fx_volslide := _fxdata;
  707.              channels[chn].vols := i;
  708.              channels[chn].start_fx := 2;
  709.            end;
  710.       {$ENDIF}
  711.       $b : begin   {position jump}
  712.              if _fxdata < header.length then begin
  713.                new_ptn := _fxdata;
  714.                if jump = 0 then new_row := 0;
  715.                jump := 1;
  716.              end;
  717.            end;
  718.       {$IFDEF __MOD__}
  719.       $c : begin  {Set volume}
  720.              if _fxdata > 64 then _fxdata := 64;
  721.              channels[chn].fxdata := _fxdata;
  722.              channels[chn].vol := _fxdata;
  723.              {$IFNDEF __MINI__}
  724.              channels[chn].bar := _fxdata;
  725.              {$ENDIF}
  726.              with gus_chn[chn] do begin
  727.                status := status or gst_vol;
  728.                vol := gusvol[word(_fxdata*main_vol) div 64]*amp_vol+20000;
  729.              end;
  730.            end;
  731.       {$ENDIF}
  732.       $d : begin   {break pattern}
  733.              if jump=0 then new_ptn := cur_ptn+1;
  734.              new_row := (_fxdata shr 4)*10+_fxdata and 15;
  735.              jump := 1;
  736.            end;
  737.       $e : begin        {extended effect}
  738.              _efx := _fxdata shr 4;
  739.              _efxdata := _fxdata and 15;
  740.              case _efx of
  741.                1 : begin    {fine portamento up}
  742.                      per := channels[chn].per;
  743.                      dec(per,_efxdata*4);
  744.                      if per < min_per then per := min_per;
  745.                      channels[chn].per := per;
  746.                      gus_chn[chn].per := per;
  747.                    end;
  748.                2 : begin    {fine portamento down}
  749.                      per := channels[chn].per;
  750.                      inc(per,_efxdata*4);
  751.                      if per > max_per then per := max_per;
  752.                      channels[chn].per := per;
  753.                      gus_chn[chn].per := per;
  754.                    end;
  755.                4 : begin {set vibrato waveform}
  756.                      channels[chn].vib_wave := _efxdata;
  757.                    end;
  758.                6 : begin  {pattern loop}
  759.                      if _efxdata = 0 then loops := cur_row
  760.                      else begin
  761.                        if loope = 0 then begin  {start new loop}
  762.                          loopcnt := _efxdata;
  763.                          loope := cur_row;
  764.                        end;
  765.                        if loopcnt = 0 then begin
  766.                          loope := 0;
  767.                          loops := 0;
  768.                        end
  769.                        else begin
  770.                          dec(loopcnt);
  771.                          new_row := loops;
  772.                          jump := 1;
  773.                        end;
  774.                      end;
  775.                    end;
  776.                8 : begin  {set mtm-pan}
  777.                      channels[chn].pan := _efxdata;
  778.                      gus_chn[chn].status := gus_chn[chn].status or gst_pan;
  779.                      gus_chn[chn].pan := _efxdata;
  780.                    end;
  781.                9 : if _efxdata > 0 then begin   {retrigger}
  782.                      {channels[chn].trig_cnt := 0;}
  783.                    end;
  784.                $a : begin   {fine vol slide up}
  785.                       i := channels[chn].vol;
  786.                       inc(i,_efxdata);
  787.                       if i > 64 then i := 64;
  788.                       channels[chn].vol := i;
  789.                       with gus_chn[chn] do begin
  790.                         status := status or gst_vol;
  791.                         vol := gusvol[word(i*main_vol) div 64]*amp_vol+20000;
  792.                       end;
  793.                       {$IFNDEF __MINI__}
  794.                       channels[chn].bar := i;
  795.                       {$ENDIF}
  796.                     end;
  797.                $b : begin   {fine vol slide down}
  798.                       i := channels[chn].vol;
  799.                       dec(i,_efxdata);
  800.                       if i < 0 then i := 0;
  801.                       channels[chn].vol := i;
  802.                       with gus_chn[chn] do begin
  803.                         status := status or gst_vol;
  804.                         vol := gusvol[word(i*main_vol) div 64]*amp_vol+20000;
  805.                       end;
  806.                       {$IFNDEF __MINI__}
  807.                       channels[chn].bar := i;
  808.                       {$ENDIF}
  809.                     end;
  810.                $d : if _efxdata > 0 then begin {note delay}
  811.                       channels[chn].start_fx := _efxdata+1;
  812.                     end
  813.                     else channels[chn].fx := 255;
  814.                $e : pdelay := _efxdata;
  815.              end;
  816.            end;
  817.       $f : begin  {set speed / tempo}
  818.              if (_fxdata <= 31) or vblank then begin    {SPEED not tempo}
  819.                nspeed := _fxdata;
  820.                speed := _fxdata;
  821.              end
  822.              else begin                   {Tempo}
  823.                tempo := _fxdata;
  824.                {timer_rate := 10000 div (tempo);}
  825.                asm
  826.                  mov  ax,tempo   {round}
  827.                  shr  ax,1
  828.                  add  ax,25000
  829.                  mov  dx,0
  830.                  mov  cx,tempo
  831.                  div  cx
  832.                  mov  timer_rate,ax
  833.                end;
  834.              end;
  835.            end;
  836.       16 : begin  {set speed}
  837.              nspeed := _fxdata;
  838.              speed := _fxdata;
  839.            end;
  840.       {$IFDEF __S3M__}
  841.       17 : begin  {s3m slide down}
  842.              if _fxdata = 0 then _fxdata := channels[chn].fx_portd
  843.              else channels[chn].fx_portd := _fxdata;
  844.              _efxdata := _fxdata and 15;
  845.              if _fxdata shr 4 = $f then begin
  846.                channels[chn].fx := $e;
  847.                _fxdata := $20 or _efxdata;
  848.                per := channels[chn].per;
  849.                inc(per,_efxdata*4);
  850.                if per > max_per then per := max_per;
  851.                channels[chn].per := per;
  852.              end
  853.              else if _fxdata shr 4 = $e then begin
  854.                _fxdata := _efxdata;
  855.                channels[chn].fx := 19;
  856.                per := channels[chn].per;
  857.                inc(per,_efxdata);
  858.                if per > max_per then per := max_per;
  859.                channels[chn].per := per;
  860.              end else channels[chn].fx := 2;
  861.              channels[chn].fxdata := _fxdata;
  862.              channels[chn].start_fx := 2;
  863.              gus_chn[chn].per := channels[chn].per;
  864.            end;
  865.       18 : begin  {s3m slide up}
  866.              if _fxdata = 0 then _fxdata := channels[chn].fx_portd
  867.              else channels[chn].fx_portd := _fxdata;
  868.              _efxdata := _fxdata and 15;
  869.              if _fxdata shr 4 = $f then begin
  870.                channels[chn].fx := $e;
  871.                _fxdata := $10 or _efxdata;
  872.                per := channels[chn].per;
  873.                dec(per,_efxdata*4);
  874.                if per < min_per then per := min_per;
  875.                channels[chn].per := per;
  876.              end
  877.              else if _fxdata shr 4 = $e then begin
  878.                _fxdata := _efxdata;
  879.                channels[chn].fx := 20;
  880.                per := channels[chn].per;
  881.                dec(per,_efxdata);
  882.                if per < min_per then per := min_per;
  883.                channels[chn].per := per;
  884.              end else channels[chn].fx := 1;
  885.              channels[chn].fxdata := _fxdata;
  886.              channels[chn].start_fx := 2;
  887.              gus_chn[chn].per := channels[chn].per;
  888.            end;
  889.       21 : begin   {s3m volume slide}
  890.              channels[chn].fx := 21;
  891.              if _fxdata = 0 then _fxdata := channels[chn].fx_volslide;
  892.              if (_fxdata shr 4 = $f) and (_fxdata and $f <> 0) then
  893.              begin {fine volume down}
  894.                channels[chn].fx := 21;
  895.                i := channels[chn].vol-_fxdata and 15;
  896.                if i < 0 then i := 0;
  897.                channels[chn].vol := i;
  898.                with gus_chn[chn] do begin
  899.                  status := status or gst_vol;
  900.                  vol := gusvol[word(i*main_vol) div 64]*amp_vol+20000;
  901.                end;
  902.                {$IFNDEF __MINI__}
  903.                channels[chn].bar := i;
  904.                {$ENDIF}
  905.              end
  906.              else if (_fxdata and 15 = $f) and (_fxdata shr 4 <> 0) then
  907.              begin
  908.                channels[chn].fx := 21;
  909.                i := channels[chn].vol+(_fxdata shr 4);
  910.                if i > 64 then i := 64;
  911.                channels[chn].vol := i;
  912.                with gus_chn[chn] do begin
  913.                  status := status or gst_vol;
  914.                  vol := gusvol[word(i*main_vol) div 64]*amp_vol+20000;
  915.                end;
  916.                {$IFNDEF __MINI__}
  917.                channels[chn].bar := i;
  918.                {$ENDIF}
  919.              end
  920.              else begin
  921.                if _fxdata and 15 > 0 then begin {slide down}
  922.                  _fxdata := _fxdata and 15;
  923.                  i := -_fxdata;
  924.                end
  925.                else begin
  926.                  i := _fxdata shr 4 and 15;
  927.                end;
  928.                channels[chn].fx := $a;
  929.              end;
  930.              channels[chn].fxdata := _fxdata;
  931.              channels[chn].fx_volslide := _fxdata;
  932.              channels[chn].vols := i;
  933.              channels[chn].start_fx := 2;
  934.            end;
  935.       22 : begin  {s3m retrig}
  936.              {if (_fxdata and 15 > 0) and (channels[chn].trig_cnt = 0) then
  937.              begin
  938.                 channels[chn].trig_cnt := _fxdata and 15;
  939.              end;}
  940.            end;
  941.       23 : if _fxdata < 65 then main_vol := _fxdata;
  942.       {$ENDIF}
  943.       else begin
  944.         channels[chn].fx := 255;
  945.         channels[chn].fxdata := 0;
  946.       end;
  947.     end;
  948.     if (channels[chn].fx <> 22) or
  949.       (channels[chn].fx = $e) and (channels[chn].fxdata shr 4 = 9) then
  950.     else channels[chn].trig_cnt := 0;
  951.    end
  952.    else channels[chn].no_fx := 0;
  953.   end;
  954. end;
  955.  
  956. procedure do_fx;
  957. const
  958. chn : byte = 0;
  959. _fx : integer = 0;
  960. _fxdata : integer = 0;
  961. _efx : integer = 0;
  962. _efxdata : integer = 0;
  963. per : longint = 0;
  964. b : byte = 0;
  965. s : shortint = 0;
  966. w : word = 0;
  967. i : integer = 0;
  968. begin
  969.   for chn := 0 to header.usedchns-1 do
  970.    if (channels[chn].on = 1) and (channels[chn].fx <> 255) then begin
  971.     if channels[chn].start_fx > 0 then dec(channels[chn].start_fx);
  972.     _fx := channels[chn].fx;
  973.     _fxdata := channels[chn].fxdata;
  974.     if (channels[chn].on = 1) and (channels[chn].start_fx = 0) then
  975.     case _fx of
  976.       0 : with channels[chn] do begin  {arpeggio}
  977.             case channels[chn].arp_cnt mod 3 of
  978.               0 : b := 0;
  979.               1 : b := arp1;
  980.               2 : b := arp2;
  981.             end;
  982.             i := basenote and 15+b;
  983.             w := (basenote shr 4) and 15;
  984.             while i > 11 do begin
  985.               dec(i,12);
  986.               inc(w);
  987.             end;
  988.             per := longint(8363*((16*st3_per[i]) shr (w)))
  989.                     div longint(samples[channels[chn].sample].c4spd);
  990.             channels[chn].per := per;
  991.             gus_chn[chn].per := per;
  992.             channels[chn].note := w*16+i;
  993.             inc(arp_cnt);
  994.           end;
  995.       1 : begin   {port up}
  996.             per := channels[chn].per;
  997.             dec(per,_fxdata shl 2);
  998.             if per < min_per then per := min_per;
  999.             channels[chn].per := per;
  1000.             gus_chn[chn].per := per;
  1001.           end;
  1002.       2 : begin  {port down}
  1003.             per := channels[chn].per;
  1004.             inc(per,_fxdata shl 2);
  1005.             if per > max_per then per := max_per;
  1006.             channels[chn].per := per;
  1007.             gus_chn[chn].per := per;
  1008.           end;
  1009.       3 : begin   {Port to}
  1010.             if channels[chn].per < channels[chn].dper then begin
  1011.               w := channels[chn].dper;
  1012.               per := channels[chn].per;
  1013.               inc(per,word(channels[chn].fx_sl2) shl 2);
  1014.               if per > w then per := w;
  1015.               if per > max_per then per := max_per;
  1016.               if per < min_per then per := min_per;
  1017.               channels[chn].per := per;
  1018.               gus_chn[chn].per := per;
  1019.             end
  1020.             else begin
  1021.               w := channels[chn].dper;
  1022.               per := channels[chn].per;
  1023.               if per-(word(channels[chn].fx_sl2) shl 2) > per then per := min_per
  1024.               else dec(per,ord(channels[chn].fx_sl2) shl 2);
  1025.               if per < w then per := w;
  1026.               if per < min_per then per := min_per;
  1027.               if per > max_per then per := max_per;
  1028.               channels[chn].per := per;
  1029.               gus_chn[chn].per := per;
  1030.             end;
  1031.           end;
  1032.       4 : begin    {vibrato}
  1033.             _fxdata := channels[chn].fx_vib;
  1034.             b := _fxdata and 15;
  1035.             i := vib_tbl[channels[chn].vib_wave,channels[chn].vib_cnt];
  1036.             i := (i * b) div 16;
  1037.             w := channels[chn].per+i;
  1038.             if w > max_per then w := max_per;
  1039.             if w < min_per then w := min_per;
  1040.             gus_chn[chn].per := w;
  1041.             inc(channels[chn].vib_cnt,_fxdata shr 4);
  1042.             if channels[chn].vib_cnt > 63 then
  1043.               dec(channels[chn].vib_cnt,64);
  1044.           end;
  1045.       5 : begin   {volume slide & portamento}
  1046.             if _fxdata and 15 > 0 then begin  {slide down}
  1047.               _fxdata := _fxdata and 15;
  1048.               b := channels[chn].vol;
  1049.               if b-_fxdata >= 0 then dec(b,_fxdata)
  1050.               else b := 0;
  1051.               if b > 128 then b := 0;
  1052.               channels[chn].vol := b;
  1053.               {$IFNDEF __MINI__}
  1054.               channels[chn].bar := b;
  1055.               {$ENDIF}
  1056.               with gus_chn[chn] do begin
  1057.                 status := status or gst_vol;
  1058.                 vol := gusvol[word(b*main_vol) div 64]*amp_vol+20000;
  1059.               end;
  1060.             end
  1061.             else begin      {slide up}
  1062.               b := channels[chn].vol;
  1063.               inc(b,(_fxdata shr 4));
  1064.               if b > 64 then b := 64;
  1065.               channels[chn].vol := b;
  1066.               {$IFNDEF __MINI__}
  1067.               channels[chn].bar := b;
  1068.               {$ENDIF}
  1069.               with gus_chn[chn] do begin
  1070.                 status := status or gst_vol;
  1071.                 vol := gusvol[word(b*main_vol) div 64]*amp_vol+20000;
  1072.               end;
  1073.             end;
  1074.             _fxdata := channels[chn].fx_sl2;
  1075.             if channels[chn].per < channels[chn].dper then begin {port to}
  1076.               w := channels[chn].dper;
  1077.               per := channels[chn].per;
  1078.               inc(per,_fxdata*4);
  1079.               if per > w then per := w;
  1080.               if per > max_per then per := max_per;
  1081.               if per < min_per then per := min_per;
  1082.               channels[chn].per := per;
  1083.               gus_chn[chn].per := per;
  1084.             end
  1085.             else begin
  1086.               w := channels[chn].dper;
  1087.               per := channels[chn].per;
  1088.               if per-(_fxdata*4) > per then per := min_per
  1089.               else dec(per,_fxdata*4);
  1090.               if per < w then per := w;
  1091.               if per < min_per then per := min_per;
  1092.               if per > max_per then per := max_per;
  1093.               channels[chn].per := per;
  1094.               gus_chn[chn].per := per;
  1095.             end;
  1096.           end;
  1097.       6 : begin     {vibrato & vol slide}
  1098.             begin
  1099.               b := channels[chn].fx_vib and 15;
  1100.               s := vib_tbl[channels[chn].vib_wave,channels[chn].vib_cnt];
  1101.               s := (s * b) div 16;
  1102.               w := channels[chn].per+s;
  1103.               if w > max_per then w := max_per;
  1104.               if w < min_per then w := min_per;
  1105.               b := channels[chn].fx_vib shr 4;
  1106.               gus_chn[chn].per := w;
  1107.               inc(channels[chn].vib_cnt,b);
  1108.               if channels[chn].vib_cnt > 63 then
  1109.                 dec(channels[chn].vib_cnt,64);
  1110.             end;
  1111.             {volume slide}
  1112.             i := channels[chn].vol;
  1113.             inc(i,channels[chn].vols);
  1114.             if i < 0 then i := 0
  1115.             else if i > 64 then i := 64;
  1116.             channels[chn].vol := i;
  1117.             {$IFNDEF __MINI__}
  1118.             channels[chn].bar := i;
  1119.             {$ENDIF}
  1120.             with gus_chn[chn] do begin
  1121.               status := status or gst_vol;
  1122.               vol := gusvol[word(i*main_vol) div 64]*amp_vol+20000;
  1123.             end;
  1124.           end;
  1125.       $a : begin  {volume slide}
  1126.              i := channels[chn].vol;
  1127.              inc(i,channels[chn].vols);
  1128.              if i < 0 then i := 0
  1129.              else if i > 64 then i := 64;
  1130.              channels[chn].vol := i;
  1131.              {$IFNDEF __MINI__}
  1132.              channels[chn].bar := i;
  1133.              {$endif}
  1134.              with gus_chn[chn] do begin
  1135.                status := status or gst_vol;
  1136.                vol := gusvol[word(i*main_vol) div 64]*amp_vol+20000;
  1137.              end;
  1138.            end;
  1139.       $e : begin
  1140.              _efx := _fxdata shr 4;
  1141.              _efxdata := _fxdata and 15;
  1142.              case _efx of
  1143.                9 : begin   {Retrig note}
  1144.                      b := channels[chn].sample;
  1145.                      inc(channels[chn].trig_cnt);
  1146.                      if channels[chn].trig_cnt = 0 then with gus_chn[chn] do begin
  1147.                        status := status or gst_note;
  1148.                        offset := 0;
  1149.                        channels[chn].trig_cnt := 1;
  1150.                      end;
  1151.                    end;
  1152.                $c : if _efxdata = 0 then begin     {note cut}
  1153.                       gus_chn[chn].status := gus_chn[chn].status or gst_stop;
  1154.                       channels[chn].fx := 255;
  1155.                     end
  1156.                     else begin
  1157.                       dec(_efxdata);
  1158.                       b := _fxdata;
  1159.                       b := b and $f0;
  1160.                       b := b or _efxdata;
  1161.                       channels[chn].fxdata := b;
  1162.                     end;
  1163.                $d : begin                    {note delay}
  1164.                       channels[chn].start_fx := 255;
  1165.                       {$IFNDEF __MINI__}
  1166.                       channels[chn].hit := 1;
  1167.                       {$ENDIF}
  1168.                       with gus_chn[chn] do begin
  1169.                         sam := channels[chn].sample;
  1170.                         per := channels[chn].per;
  1171.                         offset := 0;
  1172.                         vol := gusvol[word(channels[chn].vol*main_vol) div 64]*
  1173.                                                    amp_vol+20000;
  1174.                         status := status or gst_note;
  1175.                       end;
  1176.                     end;
  1177.              end;
  1178.            end;
  1179.       {$IFDEF __S3M__}
  1180.       22 : begin {s3m retrig note}
  1181.              b := channels[chn].sample;
  1182.              inc(channels[chn].trig_cnt);
  1183.              if channels[chn].trig_cnt > _fxdata and 15 then begin
  1184.                i := channels[chn].vol;
  1185.                w := _fxdata shr 4;
  1186.                case w of
  1187.                  1..5 : dec(i,1 shl (w-1));
  1188.                  7 : i := i shr 1;
  1189.                  9..$d : inc(i,1 shl (w-9));
  1190.                  $f : inc(i,i);
  1191.                end;
  1192.                if i < 0 then i := 0
  1193.                else if i > 64 then i := 64;
  1194.                with gus_chn[chn] do begin
  1195.                  status := status or gst_note;
  1196.                  offset := 0;
  1197.                  vol := gusvol[word(i*main_vol) div 64]*amp_vol+20000;
  1198.                end;
  1199.                channels[chn].vol := i;
  1200.                channels[chn].trig_cnt := 1;
  1201.              end;
  1202.            end;
  1203.       {$ENDIF}
  1204.     end;
  1205.   end;
  1206. end;
  1207.  
  1208. procedure updatenotes;
  1209. const
  1210. n : integer = 0;
  1211. cptn : integer = 0;
  1212. begin
  1213.   if cur_ptn >= header.length then new_ptn := 0;
  1214.   while orders[new_ptn] = 254 do inc(new_ptn);
  1215.   cur_ptn := new_ptn;
  1216.   cur_row := new_row;
  1217.   if (cur_tick >= speed) and (speed > 0) then begin
  1218.     speed := nspeed;
  1219.     cur_tick := 0;
  1220.     if pdelay=0 then begin
  1221.       if jump = 0 then inc(cur_row);
  1222.       if cur_row > 63 then begin
  1223.         inc(cur_ptn);
  1224.         while orders[cur_ptn] = 254 do inc(cur_ptn);
  1225.         if orders[cur_ptn]=255 then cur_ptn := 0;
  1226.         cur_row := 0;
  1227.         if cur_ptn > header.length-1 then begin
  1228.           cur_ptn := 0;
  1229.         end;
  1230.       end;
  1231.     end;
  1232.   end;
  1233.   cptn := orders[cur_ptn];
  1234.   if cptn = 255 then cur_ptn := 0;
  1235.   new_ptn := cur_ptn;
  1236.   new_row := cur_row;
  1237.   if speed > 0 then begin
  1238.     {$IFNDEF __MINI__}
  1239.     for n := 0 to header.usedchns-1 do begin
  1240.       if channels[n].bar > 1 then dec(channels[n].bar,2)
  1241.       else channels[n].bar := 0;
  1242.     end;
  1243.     {$ENDIF}
  1244.     inc(cur_tick);
  1245.     if cur_tick = 1 then begin
  1246.       if pdelay=0 then begin
  1247.         virt_needptn(cptn);
  1248.         get_notes;
  1249.         get_fx;
  1250.         virt_noneedptn(cptn);
  1251.       end
  1252.       else dec(pdelay);
  1253.     end;
  1254.     do_fx;
  1255.     dump2gus;
  1256.   end;
  1257.   while orders[new_ptn] = 254 do inc(new_ptn);
  1258.   if orders[new_ptn] = 255 then new_ptn := 0;
  1259.   if new_ptn <> cur_ptn then virt_warnptn(orders[new_ptn])
  1260.   else if cur_row = 63 then begin
  1261.     cptn := cur_ptn+1;
  1262.     while orders[cptn] = 254 do inc(cptn);
  1263.     if orders[cptn] = 255 then cptn := 0;
  1264.     cptn := orders[cptn];
  1265.     virt_warnptn(cptn);
  1266.   end;
  1267.   if jump = 1 then virt_warnptn(orders[new_ptn]);
  1268. end;
  1269.  
  1270. procedure volrampend;
  1271. const
  1272. chn : integer = 0;
  1273. begin
  1274.   for chn := 0 to header.chns-1 do begin
  1275.     port[active_voice] := chn;
  1276.     port[command] := $8d;
  1277.     if port[data_high] and 3 = 1 then begin
  1278.       port[command] := $d;
  1279.       port[data_high] := 2;
  1280.       port[command] := 9;
  1281.       portw[data_low] := gus_chn[chn].vol;
  1282.     end;
  1283.   end;
  1284. end;
  1285.  
  1286. {$s-}
  1287. procedure timerint; interrupt;
  1288. const
  1289. regs : array[0..5] of longint = (0,0,0,0,0,0);
  1290.  
  1291. begin
  1292.   asm
  1293.     cli
  1294.     db  66h
  1295.     mov  word ptr regs[0],ax
  1296.     db  66h
  1297.     mov  word ptr regs[4],bx
  1298.     db  66h
  1299.     mov  word ptr regs[8],cx
  1300.     db  66h
  1301.     mov  word ptr regs[12],dx
  1302.     db  66h
  1303.     mov  word ptr regs[16],si
  1304.     db  66h
  1305.     mov  word ptr regs[20],di
  1306.   end;
  1307.   if playing then begin
  1308.     volrampend;
  1309.     dec(timer_cnt,8);
  1310.     inc(time_counter3);
  1311.     if timer_cnt < 8 then begin
  1312.       inc(time_counter2);
  1313.       updatenotes;
  1314.       inc(timer_cnt,timer_rate);
  1315.     end;
  1316.   end;
  1317.   o_int_tick := int_tick;
  1318.   int_tick := int_tick + int_rate;
  1319.   if (o_int_tick > int_tick) or not playing then begin
  1320.     if playing then inc(time_counter);
  1321.     asm
  1322.       pushf
  1323.       cli
  1324.       call oldint
  1325.     end;
  1326.   end
  1327.   else
  1328.     asm
  1329.       mov  al,20h
  1330.       out  20h,al  {send EOI}
  1331.     end;
  1332.   asm
  1333.     db  66h
  1334.     mov  ax,word ptr regs[0]
  1335.     db  66h
  1336.     mov  bx,word ptr regs[4]
  1337.     db  66h
  1338.     mov  cx,word ptr regs[8]
  1339.     db  66h
  1340.     mov  dx,word ptr regs[12]
  1341.     db  66h
  1342.     mov  si,word ptr regs[16]
  1343.     db  66h
  1344.     mov  di,word ptr regs[20]
  1345.   end;
  1346. end;
  1347.  
  1348. procedure gusint; interrupt;
  1349. const
  1350. regs : array[0..5] of longint = (0,0,0,0,0,0);
  1351. irq_source : word = 0;
  1352.  
  1353. begin
  1354.   asm
  1355.     cli
  1356.     db  66h
  1357.     mov  word ptr regs[0],ax
  1358.     db  66h
  1359.     mov  word ptr regs[4],bx
  1360.     db  66h
  1361.     mov  word ptr regs[8],cx
  1362.     db  66h
  1363.     mov  word ptr regs[12],dx
  1364.     db  66h
  1365.     mov  word ptr regs[16],si
  1366.     db  66h
  1367.     mov  word ptr regs[20],di
  1368.   end;
  1369.   irq_source := port[gus_base+6];
  1370.   if (irq_source and gf1_timer1_irq) <> 0 then begin
  1371.     port[command] := timer_control;
  1372.     port[data_high] := 0;
  1373.     port[data_high] := 4;
  1374.     if playing then begin
  1375.       volrampend;
  1376.       dec(timer_cnt,8);
  1377.       inc(time_counter3);
  1378.       if timer_cnt < 8 then begin
  1379.         inc(time_counter2);
  1380.         updatenotes;
  1381.         inc(timer_cnt,timer_rate);
  1382.       end;
  1383.     end;
  1384.     o_int_tick := int_tick;
  1385.     int_tick := int_tick + int_rate;
  1386.     if (o_int_tick > int_tick) then inc(time_counter);
  1387.   end;
  1388.   if gus_irq > 7 then port[$a0] := $20;
  1389.   port[$20] := $20;
  1390.   asm
  1391.     db  66h
  1392.     mov  ax,word ptr regs[0]
  1393.     db  66h
  1394.     mov  bx,word ptr regs[4]
  1395.     db  66h
  1396.     mov  cx,word ptr regs[8]
  1397.     db  66h
  1398.     mov  dx,word ptr regs[12]
  1399.     db  66h
  1400.     mov  si,word ptr regs[16]
  1401.     db  66h
  1402.     mov  di,word ptr regs[20]
  1403.   end;
  1404. end;
  1405.  
  1406. {$s-}
  1407. {$f+}
  1408. procedure def_virt_alloc(numptn,ptnsize : integer);
  1409. var
  1410. n : integer;
  1411. begin
  1412.   fillchar(patterns,sizeof(patterns),0);
  1413.   virt_info.numptn := numptn;
  1414.   virt_info.ptnsize := ptnsize;
  1415.   virt_info.err_wptn := -1;
  1416.   virt_info.err_nptn := -1;
  1417. end;
  1418.  
  1419. procedure def_virt_free;
  1420. var
  1421. n : integer;
  1422. begin
  1423.   for n := 0 to 127 do if patterns[n] <> nil then begin
  1424.     freemem(patterns[n],virt_info.ptnsize);
  1425.     patterns[n] := nil;
  1426.   end;
  1427. end;
  1428.  
  1429. procedure def_virt_allocptn(ptn : integer);
  1430. begin
  1431.   getmem(patterns[ptn],virt_info.ptnsize);
  1432. end;
  1433.  
  1434. procedure def_virt_loadptn(ptn : integer;p : pointer);
  1435. begin
  1436.   move(p^,patterns[ptn]^,virt_info.ptnsize);
  1437. end;
  1438.  
  1439. procedure def_virt_freeptn(ptn : integer);
  1440. begin
  1441.   if patterns[ptn] <> nil then begin
  1442.     freemem(patterns[ptn],virt_info.ptnsize);
  1443.     patterns[ptn] := nil;
  1444.   end;
  1445. end;
  1446.  
  1447. function def_virt_getptn(ptn : integer) : pointer;
  1448. begin
  1449.   def_virt_getptn := patterns[ptn];
  1450. end;
  1451.  
  1452. procedure def_virt_warnptn(ptn : integer);
  1453. begin
  1454.   virt_info.warnedptn := ptn;
  1455. end;
  1456.  
  1457. procedure def_virt_needptn(ptn : integer);
  1458. begin
  1459.   if ptn <> virt_info.warnedptn then begin
  1460.     virt_info.err_cptn := cur_ptn;
  1461.     virt_info.err_wptn := virt_info.warnedptn;
  1462.     virt_info.err_nptn := ptn;
  1463.   end;
  1464. end;
  1465.  
  1466. procedure def_virt_noneedptn(ptn : integer);
  1467. begin
  1468. end;
  1469.  
  1470. {$f-}
  1471.  
  1472. {$s-}
  1473. function heaperr(size : word) : integer; far;
  1474. begin
  1475.   if size > 0 then begin
  1476.     mod_error := 3;
  1477.     heaperr := 1;
  1478.   end;
  1479. end;
  1480.  
  1481. {$IFDEF __LOADERS__}
  1482. procedure load2gus(memaddr : pointer;gusaddr : longint;len,flip : word);
  1483. begin
  1484.   asm
  1485.     mov  di,len
  1486.     mov  si,word ptr memaddr
  1487.     mov  es,word ptr memaddr+2
  1488.     mov  cx,word ptr gusaddr   {cx=addlo}
  1489.     mov  bl,byte ptr gusaddr+2 {bl=addhi}
  1490.     mov  bh,byte ptr flip {bh = flip}
  1491.       mov  dx,command    {Port [command] := $44;}
  1492.       mov  al,44h
  1493.       out  dx,al
  1494.  
  1495.       mov  dx,data_high
  1496.       mov  al,bl
  1497.       out  dx,al        {Port [data_high] := AddHi;}
  1498.  
  1499.       mov  dx,command   {Port [command] := $43;}
  1500.       mov  al,43h
  1501.       out  dx,al
  1502. @@1:
  1503.       mov  dx,data_low  {Portw[data_low] := AddLo;}
  1504.       mov  ax,cx
  1505.       out  dx,ax
  1506.  
  1507.       cmp  cx,0
  1508.       jne  @@2
  1509.  
  1510.       mov  dx,command    {Port [command] := $44;}
  1511.       mov  al,44h
  1512.       out  dx,al
  1513.  
  1514.       mov  dx,data_high
  1515.       mov  al,bl
  1516.       out  dx,al        {Port [data_high] := AddHi;}
  1517.  
  1518.       mov  dx,command   {Port [command] := $43;}
  1519.       mov  al,43h
  1520.       out  dx,al
  1521. @@2:
  1522.     mov  dx,dram_io      {Port [dram_io] := misc_buf^[n];}
  1523.     mov  al,es:[si]
  1524.     sub  al,bh
  1525.     out  dx,al
  1526.     inc  si
  1527.  
  1528.       add  cx,1     {inc(l,1);}
  1529.       adc  bl,0
  1530.  
  1531.     dec  di
  1532.     jnz  @@1
  1533.   end;
  1534. end;
  1535. {$IFDEF __MOD__}
  1536. {$IFDEF __S3M__}
  1537. procedure load_MOD(s : string);
  1538. var
  1539. i : integer;
  1540. f : file;
  1541. a : string[4];
  1542. begin
  1543.   a := '1234';
  1544.   assign(f,s);
  1545.   reset(f,1);
  1546.   seek(f,$2c);
  1547.   blockread(f,a[1],4);
  1548.   i := ioresult;
  1549.   if i <> 0 then begin
  1550.     mod_error := 2;
  1551.     exit;
  1552.   end;
  1553.   close(f);
  1554.   {$i+}
  1555.   if a = 'SCRM' then load_s3m(s)
  1556.   else _load_mod(s);
  1557. end;
  1558. {$ENDIF}
  1559. {$ENDIF}
  1560.  
  1561. {$IFDEF __MOD__}
  1562. {$IFDEF __S3M__}
  1563. procedure _load_MOD(s : string);
  1564. {$ELSE}
  1565. procedure load_MOD(s : string);
  1566. {$ENDIF}
  1567.  
  1568. var
  1569. f : file;
  1570. mbuf : pointer;
  1571. oldheaperr : procedure;
  1572.  
  1573. procedure set_up_modheader;
  1574. var
  1575. chn,c,n,i : integer;
  1576. begin
  1577.   fillchar(header,sizeof(header),0);
  1578.   header.samples := 31;
  1579.   header.name[0] := #20;
  1580.   move(misc_buf^[0],header.name[1],20);
  1581.   header.tag := '    ';
  1582.   move(misc_buf^[1080],header.tag,4);
  1583.   chn := maxchn;
  1584.   with header do
  1585.     if tag = 'M.K.' then chn := 4
  1586.     else if tag = 'M!K!' then chn := 4
  1587.     else if tag[1]+tag[2]+tag[3]='CHN' then begin
  1588.       val(tag[0],n,c);
  1589.       if c=0 then chn := n;
  1590.     end
  1591.     else if tag[2]+tag[3]='CH' then begin
  1592.       val(tag[0]+tag[1],n,c);
  1593.       if c=0 then chn := n;
  1594.     end
  1595.     else begin
  1596.       header.samples := 15;
  1597.       chn := 4;
  1598.     end;
  1599.   if chn > maxchn then begin
  1600.     mod_error := 1;
  1601.     exit;
  1602.   end;
  1603.   if header.samples = 15 then begin
  1604.     move(misc_buf^[472],orders[0],128);
  1605.     seek(f,600);
  1606.     header.length := misc_buf^[470];
  1607.     header.chns := 4;
  1608.   end else begin
  1609.     header.length := misc_buf^[950];
  1610.     move(misc_buf^[952],orders[0],128);
  1611.     {$IFDEF __DEBUG__}
  1612.       writeln('Tag: ',header.tag);
  1613.     {$ENDIF}
  1614.   end;
  1615.   header.chns := chn;
  1616.   header.usedchns := chn;
  1617.   max_ptn := 0;
  1618.   for n := 0 to 127 do if orders[n] > max_ptn then begin
  1619.     if orders[n] > 127 then begin
  1620.       mod_error := 2;
  1621.       exit;
  1622.     end else max_ptn := orders[n];
  1623.   end;
  1624.   move(def_modpan,header.chn_pan,32);
  1625.   header.ispeed := 6;
  1626.   header.itempo := 125;
  1627.   header.modtype := mt_mod;
  1628.   max_ptn := max_ptn+1;
  1629. {$IFDEF __FX__}
  1630.   base_fx_chn := chn;
  1631.   inc(chn,fxchns);
  1632. {$ENDIF}
  1633.   if chn < 14 then gussetchns(13)
  1634.   else gussetchns(chn-1);
  1635.   gusdiv := gus_div[chn];
  1636. end;
  1637.  
  1638. procedure mod_sample_info;
  1639. var
  1640. n : integer;
  1641. maxi,i : integer;
  1642. begin
  1643.   fillchar(samples,sizeof(samples),0);
  1644.   for n := 0 to 99 do samples[n].c4spd := 8363;
  1645.   samples[0].name[0] := #22;
  1646.   for n := 1 to header.samples do begin
  1647.     move(misc_buf^[(n-1)*30+20],samples[n].name[1],22);
  1648.     samples[n].name[23] := #0;
  1649.     samples[n].name[0] := #22;
  1650.     samples[n].length := 2*swap(misc_buf2^[(n-1)*15+21]); {n*30+42}
  1651.     samples[n].ftune := misc_buf^[(n-1)*30+44];
  1652.     samples[n].c4spd := ftune_per[samples[n].ftune];
  1653.     samples[n].volume := misc_buf^[(n-1)*30+45];
  1654.     samples[n].loopstart := 2*swap(misc_buf2^[(n-1)*15+23]);  {n*30+46}
  1655.     samples[n].loopend := 2*swap(misc_buf2^[(n-1)*15+24]);  {n*30+48}
  1656.     if samples[n].loopend < 3 then begin
  1657.       samples[n].loopend := 0;
  1658.       samples[n].loopstart := 0;
  1659.     end
  1660.     else samples[n].loop := true;
  1661.     inc(samples[n].loopend,samples[n].loopstart);
  1662.     if samples[n].loopend > samples[n].length then
  1663.       samples[n].loopend := samples[n].length;
  1664.     samples[n]._type := 1;
  1665.   end;
  1666. end;
  1667.  
  1668. procedure read_ptn(n : word);
  1669. var
  1670. row,chn : integer;
  1671. w,w2,i : word;
  1672. x,y : integer;
  1673. b : byte;
  1674. mchn : integer;
  1675. mb : p_pattern;
  1676. per : word;
  1677.  
  1678. begin
  1679.   mchn := header.chns;
  1680.   mb := mbuf;
  1681.   blockread(f,misc_buf^,256*mchn);
  1682.   for row := 0 to 63 do
  1683.     for chn := 0 to mchn-1 do with mb^[row*header.chns+chn] do begin
  1684.       w := misc_buf2^[row*(2*mchn)+chn*2];
  1685.       w2 := misc_buf2^[row*(2*mchn)+chn*2+1];
  1686.       asm
  1687.         mov  cx,w
  1688.         and  cl,15
  1689.         xchg cl,ch
  1690.         and  cx,0fffh
  1691.         mov  i,cx
  1692.       end;
  1693.       per := i;
  1694.       asm
  1695.         mov  al,byte ptr w2
  1696.         shr  al,4
  1697.         mov  ah,byte ptr w
  1698.         and  ah,11110000b
  1699.         or   al,ah
  1700.         xor  ah,ah
  1701.         mov  i,ax
  1702.       end;
  1703.       sample := i;
  1704.       fx := lo(w2) and 15;
  1705.       fxdata := hi(w2);
  1706.       if (fx=0) and (fxdata=0) then begin
  1707.         fx := 255;
  1708.         fxdata := 0;
  1709.       end;
  1710.       i := per;
  1711.       if i > 0 then begin
  1712.         w := 0;
  1713.         repeat
  1714.           inc(w);
  1715.         until (i >= per_table[w]);
  1716.         if w < 60 then begin
  1717.           if i > per_table[w] then begin
  1718.             x := per_table[w-1]-i;
  1719.             y := i-per_table[w];
  1720.             if x < y then w := w+1;
  1721.           end;
  1722.           note := w
  1723.         end
  1724.         else note := 60;
  1725.       end
  1726.       else note := 0;
  1727.       if note > 0 then note := note_table[note]
  1728.       else note := 255;
  1729.       vol := 255;
  1730.     end;
  1731. end;
  1732.  
  1733. procedure load_patterns;
  1734. var
  1735. num_ptn : longint;
  1736. n : word;
  1737. m_ptn : integer;
  1738. begin
  1739.   {$IFDEF __DEBUG__}
  1740.     write('Loading patterns');
  1741.   {$ENDIF}
  1742.   for n := 0 to max_ptn-1 do if mod_error = 0 then begin
  1743.     {$IFDEF __DEBUG__}
  1744.       write('.');
  1745.     {$ENDIF}
  1746.     virt_allocptn(n);
  1747.     if mod_error <> 0 then begin
  1748.       virt_free;
  1749.       exit;
  1750.     end;
  1751.     read_ptn(n);
  1752.     virt_loadptn(n,mbuf);
  1753.   end;
  1754.   {$IFDEF __DEBUG__}
  1755.     writeln;
  1756.   {$ENDIF}
  1757. end;
  1758.  
  1759.  
  1760. procedure load_sample(num : word);
  1761. const
  1762. block = 4096;
  1763. var
  1764. n : longint;
  1765. w : word;
  1766. fl,l : word;
  1767. b : byte;
  1768.  
  1769. begin
  1770.   {$IFDEF __DEBUG__}
  1771.     write('.');
  1772.   {$ENDIF}
  1773.   samples[num].addr := top_addr;
  1774.   gus_addr[num] := top_addr;
  1775.   if samples[num].length < 1 then begin
  1776.     guspoke(top_addr,0);
  1777.     guspoke(top_addr+1,0);
  1778.     guspoke(top_addr+2,0);
  1779.     inc(top_addr,2);
  1780.     exit;
  1781.   end;
  1782.   fl := (samples[num].length) div block;
  1783.   l := (samples[num].length) mod block;
  1784.   if fl > 0 then for w := 1 to fl do begin
  1785.     blockread(f,misc_buf^,block);
  1786.     load2gus(misc_buf,top_addr,block,0);       {load in 4kb blocks}
  1787.     inc(top_addr,block);
  1788.   end;
  1789.   if l > 0 then begin
  1790.     blockread(f,misc_buf^,l);
  1791.     load2gus(misc_buf,top_addr,l,0);           {load remainder}
  1792.     inc(top_addr,l);
  1793.   end;
  1794.   if samples[num].loop then begin
  1795.     b := guspeek(gus_addr[num]+samples[num].loopstart);
  1796.     guspoke(gus_addr[num]+samples[num].loopend+1,b);
  1797.     guspoke(gus_addr[num]+samples[num].loopend,b);
  1798.     inc(top_addr,2);
  1799.   end
  1800.   else begin
  1801.     guspoke(top_addr,0);
  1802.     inc(top_addr);
  1803.     guspoke(top_addr,0);
  1804.   end;
  1805. end;
  1806.  
  1807. var
  1808. i : integer;
  1809. l : longint;
  1810.  
  1811. begin
  1812.   mod_error := 0;
  1813.   l := maxavail;
  1814.   getmem(misc_buf,256*maxchn);
  1815.   l := maxavail;
  1816.   getmem(mbuf,320*maxchn);
  1817.   l := maxavail;
  1818.   @oldheaperr := heaperror;
  1819.   {heaperror := @heaperr;}
  1820.   if mod_error <> 0 then exit;
  1821.   misc_buf2 := addr(misc_buf^);
  1822.   gus_bank := 0;
  1823.   assign(f,s);
  1824.   {$i-}
  1825.   reset(f,1);
  1826.   blockread(f,misc_buf^,1084);  {read module header}
  1827.   i := ioresult;
  1828.   if i <> 0 then begin
  1829.     mod_error := 2;
  1830.     heaperror := @oldheaperr;
  1831.     freemem(mbuf,320*maxchn);
  1832.     freemem(misc_buf,256*maxchn);
  1833.     exit;
  1834.   end;
  1835.   set_up_modheader;
  1836.   if mod_error <> 0 then begin
  1837.     heaperror := @oldheaperr;
  1838.     freemem(mbuf,320*maxchn);
  1839.     freemem(misc_buf,256*maxchn);
  1840.     exit;
  1841.   end;
  1842.   mod_sample_info;
  1843.   virt_alloc(max_ptn,sizeof(t_note)*64*header.chns);
  1844.   load_patterns;
  1845.   if mod_error <> 0 then begin
  1846.     heaperror := @oldheaperr;
  1847.     freemem(mbuf,320*maxchn);
  1848.     freemem(misc_buf,256*maxchn);
  1849.     exit;
  1850.   end;
  1851.   {$IFDEF __DEBUG__}
  1852.     write('Loading samples');
  1853.   {$ENDIF}
  1854.   for i := 0 to 31 do load_sample(i);
  1855.   {$IFDEF __DEBUG__}
  1856.     writeln;
  1857.   {$ENDIF}
  1858.   close(f);
  1859.   {$i+}
  1860.   l := maxavail;
  1861.   freemem(mbuf,maxchn*320);
  1862.   l := maxavail;
  1863.   freemem(misc_buf,maxchn*256);
  1864.   l := maxavail;
  1865.   loaded := true;
  1866.   heaperror := @oldheaperr;
  1867. end;
  1868. {$ENDIF}
  1869.  
  1870. procedure free_mod;
  1871. begin
  1872.   if playing then stop_playing;
  1873.   if not loaded then exit;
  1874.   loaded := false;
  1875.   virt_free;
  1876.   top_addr := low_addr+16;
  1877.   fillchar(samples,sizeof(samples),0);
  1878.   gus_bank := 0;
  1879. end;
  1880.  
  1881. {$IFDEF __S3M__}
  1882. {$IFDEF __MOD__}
  1883. procedure load_s3m(s : string);
  1884. {$ELSE}
  1885. procedure load_mod(s : string);
  1886. {$ENDIF}
  1887. var
  1888. mbuf : pointer;
  1889. f : file;
  1890. oldheaperr : procedure;
  1891. ins_ptr : array[0..99] of word;
  1892. ptn_ptr : array[0..127] of word;
  1893. hdr : p_s3mheader;
  1894.  
  1895. procedure set_up_s3mheader;
  1896. var
  1897. i,j : integer;
  1898. b : byte;
  1899. begin
  1900.   fillchar(ins_ptr,sizeof(ins_ptr),0);
  1901.   fillchar(ptn_ptr,sizeof(ptn_ptr),0);
  1902.   fillchar(usedptn,sizeof(usedptn),0);
  1903.   fillchar(header,sizeof(header),0);
  1904.   hdr := @misc_buf^;
  1905.   move(hdr^.name,header.name[1],28);
  1906.   i := 0;
  1907.   while hdr^.name[i] <> #0 do inc(i);
  1908.   header.name[0] := char(i);
  1909.  
  1910.   j := 0;
  1911.   for i := 0 to hdr^.ordnum -1 do
  1912.     if hdr^.data[i] < 254 then j := i;
  1913.   header.length := j+1;
  1914.   if header.length=0 then header.length := 1;
  1915.  
  1916.   j := 0;
  1917.   for i := 0 to header.length-1 do begin
  1918.     b := hdr^.data[i];
  1919.     if b < 128 then usedptn[b] := true;
  1920.     if (b < 128) and (b > j) then j := b;
  1921.   end;
  1922.   max_ptn := j+1;
  1923.   if max_ptn > hdr^.patnum then
  1924.     for j := hdr^.patnum to max_ptn do usedptn[j] := false;
  1925.   if max_ptn=0 then begin
  1926.     max_ptn := 1;
  1927.     usedptn[0] := true;
  1928.   end;
  1929.   move(hdr^.data,orders,hdr^.ordnum);
  1930.   for j := 0 to header.length-1 do
  1931.     if (orders[j] < 128) and (usedptn[orders[j]] = false) then orders[j] := 254;
  1932.  
  1933.   main_vol := hdr^.gvol;
  1934.   header.ispeed := hdr^.ispeed;
  1935.   header.itempo := hdr^.itempo;
  1936.   header.samples := hdr^.insnum;
  1937.   move(hdr^.chn_set,header.chn_set,32);
  1938.   move(hdr^.data[hdr^.ordnum],ins_ptr,header.samples*2);
  1939.   move(hdr^.data[hdr^.ordnum+hdr^.insnum*2],
  1940.        ptn_ptr,max_ptn*2);
  1941.   move(def_s3mpan,header.chn_pan,32);
  1942.   if hdr^.dp=252 then begin
  1943.     move(hdr^.data[hdr^.ordnum+hdr^.insnum*2+hdr^.patnum*2],
  1944.     header.chn_pan,32);
  1945.     for i := 0 to 31 do if header.chn_pan[i] and 32 = 0 then
  1946.       header.chn_pan[i] := ((header.chn_set[i] shr 3) and 1)*9+3
  1947.     else header.chn_pan[i] := header.chn_pan[i] and 15;
  1948.   end;
  1949.   j := 0;
  1950.   for i := 0 to 31 do if header.chn_set[i] < 16 then j := i;
  1951.   header.chns := j+1;
  1952.   header.usedchns := 0;
  1953.  
  1954.   header.modtype := mt_s3m;
  1955.   if header.chns > maxchn then begin
  1956.     header.usedchns := 4;
  1957.     gusdiv := gus_div[14];
  1958.     gussetchns(13);
  1959.     mod_error := 1;
  1960.     exit;
  1961.   end;
  1962. end;
  1963.  
  1964. procedure load_inst;
  1965. var
  1966. num : integer;
  1967. i,j : integer;
  1968. begin
  1969.   fillchar(samples,sizeof(samples),0);
  1970.   fillchar(gus_addr,sizeof(gus_addr),0);
  1971.   for num := 0 to 99 do samples[num].name[0] := #27;
  1972.   for num := 0 to 99 do samples[num].c4spd := 8363;
  1973.   for num := 0 to header.samples-1 do with samples[num+1] do begin
  1974.     seek(f,ins_ptr[num]*16);
  1975.     blockread(f,samples[num+1],80);
  1976.     move(name,name[1],27);
  1977.     name[0] := #27;
  1978.     i := 1;
  1979.     while (name[i] <> #0) and (i < 27) do inc(i);
  1980.     if i > 27 then i := 27;
  1981.     if i < 27 then for j := i+1 to 27 do name[j] := #0;
  1982.     name[0] := #27;
  1983.     addr := (longint(memseg) shl 16+longint(memofs)) shl 4;
  1984.     if flags and 1 <> 0 then loop := true;
  1985.     if loopstart = loopend then loop := false;
  1986.     if _type<> 1 then begin
  1987.       length := 0;
  1988.       loopstart := 0;
  1989.       loopend := 0;
  1990.       addr := 0;
  1991.     end;
  1992.   end;
  1993. end;
  1994.  
  1995. procedure read_ptn(ptn : integer);
  1996. var
  1997. buf : p_memarray2;
  1998. mchn : integer;
  1999. chn,row,n : integer;
  2000. mb : p_pattern;
  2001. fc,size : word;
  2002. org_b,b,b2 : byte;
  2003. fx,fxdata,efxdata : byte;
  2004. l : longint;
  2005.  
  2006. begin
  2007.   mchn := header.chns;
  2008.   mb := mbuf;
  2009.   fillchar(mbuf^,320*maxchn,255);
  2010.   for chn := 0 to header.chns-1 do for row := 0 to 63 do begin
  2011.     mb^[row*mchn+chn].sample := 0;
  2012.     mb^[row*mchn+chn].fxdata := 0;
  2013.   end;
  2014.   if not usedptn[ptn] then exit;
  2015.   if ptn_ptr[ptn]=0 then exit;
  2016.   seek(f,longint(ptn_ptr[ptn])*16);
  2017.   blockread(f,size,2);
  2018.   if size = 0 then exit;
  2019.   if size > 256*maxchn then begin
  2020.     size := 256*maxchn;
  2021.   end;
  2022.   blockread(f,misc_buf^,size);
  2023.   buf := misc_buf;
  2024.   fc := 0;
  2025.   row := 0;
  2026.   chn := 0;
  2027.   while (fc < size) or (row > 63) do begin
  2028.     org_b := buf^[fc]; inc(fc);
  2029.     if org_b = 0 then begin
  2030.       chn := 0;
  2031.       inc(row);
  2032.       if row > 63 then begin
  2033.         exit;
  2034.       end;
  2035.     end
  2036.     else begin
  2037.       chn := org_b and 31;
  2038.       if org_b and 32 > 0 then begin
  2039.         b := buf^[fc]; inc(fc);
  2040.         b2 := buf^[fc]; inc(fc);
  2041.         if chn < header.chns then begin
  2042.           if chn > header.usedchns then header.usedchns := chn;
  2043.           mb^[row*mchn+chn].note := b;
  2044.           mb^[row*mchn+chn].sample := b2;
  2045.         end;
  2046.       end;
  2047.       if org_b and 64 > 0 then begin
  2048.         b := buf^[fc]; inc(fc);
  2049.         if chn < header.chns then mb^[row*mchn+chn].vol := b;
  2050.       end;
  2051.       if org_b and 128 > 0 then begin
  2052.         fx := buf^[fc]; inc(fc);
  2053.         fxdata := buf^[fc]; inc(fc);
  2054.         efxdata := fxdata and 15;
  2055.         case fx of
  2056.           19 : case fxdata shr 4 of
  2057.                  0 : fx := $e;  {set filter}
  2058.                  2 : begin   {set finetune}
  2059.                        fx := $e;
  2060.                        fxdata := $50 or efxdata;
  2061.                      end;
  2062.                  $b : begin
  2063.                         fx := $e;
  2064.                         fxdata := $60 or efxdata;
  2065.                       end;
  2066.                  8,$c,$d,$e : fx := $e;
  2067.                end;
  2068.           else if fx < 29 then fx := s3m_fx[fx];
  2069.         end;
  2070.         if fx=255 then begin
  2071.           fx := $e;
  2072.           fxdata := buf^[fc-2] and 15;
  2073.         end;
  2074.         if (fx=16) and (fxdata = 0) then fx := 255;
  2075.         if chn < header.chns then begin
  2076.           mb^[row*mchn+chn].fx := fx;
  2077.           mb^[row*mchn+chn].fxdata := fxdata;
  2078.         end;
  2079.       end;
  2080.     end;
  2081.   end;
  2082. end;
  2083.  
  2084. procedure load_ptns;
  2085. var
  2086. ptn : integer;
  2087. begin
  2088.   {$IFDEF __DEBUG__}
  2089.     write('Loading patterns');
  2090.   {$ENDIF}
  2091.   for ptn := 0 to max_ptn-1 do if usedptn[ptn] then begin
  2092.     {$IFDEF __DEBUG__}
  2093.       write('.');
  2094.     {$ENDIF}
  2095.     virt_allocptn(ptn);
  2096.     if mod_error <> 0 then begin
  2097.       virt_free;
  2098.       exit;
  2099.     end;
  2100.     read_ptn(ptn);
  2101.     virt_loadptn(ptn,mbuf);
  2102.   end;
  2103.   {$IFDEF __DEBUG__}
  2104.     writeln;
  2105.   {$ENDIF}
  2106. end;
  2107.  
  2108. procedure load_sample(num : word);
  2109. const
  2110. block = 4096;
  2111. var
  2112. n : longint;
  2113. w : word;
  2114. fl,l : word;
  2115. len : longint;
  2116. b : byte;
  2117.  
  2118. begin
  2119.   seek(f,samples[num].addr);
  2120.   {$IFDEF __DEBUG__}
  2121.     write('.');
  2122.   {$ENDIF}
  2123.   samples[num].addr := top_addr;
  2124.   gus_addr[num] := top_addr;
  2125.   if samples[num].length < 1 then begin
  2126.     guspoke(top_addr,0);
  2127.     guspoke(top_addr+1,0);
  2128.     guspoke(top_addr+2,0);
  2129.     inc(top_addr,2);
  2130.     exit;
  2131.   end;
  2132.   fl := (samples[num].length) div block;
  2133.   l := (samples[num].length) mod block;
  2134.   if fl > 0 then for w := 1 to fl do begin
  2135.     blockread(f,misc_buf^,block);
  2136.     load2gus(misc_buf,top_addr,block,128);       {load in 4kb blocks}
  2137.     inc(top_addr,block);
  2138.   end;
  2139.   if l > 0 then begin
  2140.     blockread(f,misc_buf^,l);
  2141.     load2gus(misc_buf,top_addr,l,128);           {load remainder}
  2142.     inc(top_addr,l);
  2143.   end;
  2144.   if samples[num].loop then begin
  2145.     b := guspeek(gus_addr[num]+samples[num].loopstart);
  2146.     guspoke(gus_addr[num]+samples[num].loopend+1,b);
  2147.     guspoke(gus_addr[num]+samples[num].loopend,b);
  2148.     inc(top_addr,2);
  2149.   end
  2150.   else begin
  2151.     guspoke(top_addr,0);
  2152.     guspoke(top_addr+1,0);
  2153.     guspoke(top_addr+2,0);
  2154.     inc(top_addr,2);
  2155.   end;
  2156. end;
  2157.  
  2158. procedure load_samples;
  2159. var
  2160. sam : integer;
  2161. i,j : integer;
  2162. begin
  2163.   {$IFDEF __DEBUG__}
  2164.     write('Loading samples');
  2165.   {$ENDIF}
  2166.   for sam := 1 to header.samples do if samples[sam]._type = 1 then
  2167.     load_sample(sam);
  2168.   {$IFDEF __DEBUG__}
  2169.     writeln;
  2170.   {$ENDIF}
  2171. end;
  2172.  
  2173. var
  2174. i : integer;
  2175.  
  2176. begin
  2177.   mod_error := 0;
  2178.   getmem(misc_buf,256*maxchn);
  2179.   getmem(mbuf,320*maxchn);
  2180.   {@oldheaperr := heaperror;
  2181.   heaperror := @heaperr;}
  2182.   if mod_error <> 0 then exit;
  2183.   misc_buf2 := addr(misc_buf^);
  2184.   gus_bank := 0;
  2185.   assign(f,s);
  2186.   {$i-}
  2187.   reset(f,1);
  2188.   blockread(f,misc_buf^,500);  {read s3m header}
  2189.   i := ioresult;
  2190.   if i <> 0 then begin
  2191.     mod_error := 2;
  2192.     heaperror := @oldheaperr;
  2193.     freemem(mbuf,320*maxchn);
  2194.     freemem(misc_buf,256*maxchn);
  2195.     exit;
  2196.   end;
  2197.   set_up_s3mheader;
  2198.   if mod_error <> 0 then begin
  2199.     {$i-}
  2200.     close(f);
  2201.     {$i+}
  2202.     heaperror := @oldheaperr;
  2203.     freemem(mbuf,320*maxchn);
  2204.     freemem(misc_buf,256*maxchn);
  2205.     exit;
  2206.   end;
  2207.   load_inst;
  2208.   seek(f,0);
  2209.   virt_alloc(max_ptn,sizeof(t_note)*64*header.chns);
  2210.   load_ptns;
  2211.   load_samples;
  2212.   inc(header.usedchns);
  2213.   i := header.usedchns;
  2214. {$IFDEF __FX__}
  2215.   base_fx_chn := i;
  2216.   inc(i,fxchns);
  2217. {$ENDIF}
  2218.   if i < 14 then gussetchns(13)
  2219.   else gussetchns(i-1);
  2220.   gusdiv := gus_div[i];
  2221.   {heaperror := @oldheaperr;}
  2222.   freemem(mbuf,320*maxchn);
  2223.   freemem(misc_buf,256*maxchn);
  2224.   close(f);
  2225.   loaded := true;
  2226. end;
  2227. {$ENDIF}
  2228. {$ENDIF}
  2229.  
  2230. procedure goto_mod(ptn,row : integer);
  2231. begin
  2232.   jump := 1;
  2233.   if ptn > header.length-1 then ptn := header.length;
  2234.   if ptn < 0 then ptn := 0;
  2235.   new_ptn := ptn;
  2236.   new_row := row;
  2237.   virt_warnptn(orders[ptn]);
  2238. end;
  2239.  
  2240. procedure initchn(chn : integer);
  2241. begin
  2242.   fillchar(channels[chn],sizeof(t_channel),0);
  2243.   channels[chn].per := st3_per[0];
  2244.   channels[chn].dper := st3_per[0];
  2245.   channels[chn].note := 4*16;
  2246.   channels[chn].basenote := 4*16;
  2247.   channels[chn].sample := 0;
  2248.   channels[chn].pan := 7;
  2249.   channels[chn].on := 1;
  2250.   channels[chn].fx := 255;
  2251. end;
  2252.  
  2253. procedure gusstarttimer1(time : integer);
  2254. begin
  2255.   asm
  2256.     pushf
  2257.     cli
  2258.   end;
  2259.   port[command] := timer1;
  2260.   port[data_high] := 256-time;
  2261.   port[command] := timer_control;
  2262.   port[data_high] := 4;
  2263.   port[gus_base+8] := 4;
  2264.   port[gus_base+9] := 1;
  2265.   asm
  2266.     popf
  2267.   end;
  2268. end;
  2269.  
  2270. procedure gusstoptimer1;
  2271. begin
  2272.   asm
  2273.     pushf
  2274.     cli
  2275.   end;
  2276.   port[command] := timer_control;
  2277.   port[data_high] := 0;
  2278.   port[gus_base+8] := 4;
  2279.   port[gus_base+9] := $80;
  2280.   asm
  2281.     popf
  2282.   end;
  2283. end;
  2284.  
  2285.  
  2286. var
  2287. oldexitproc : pointer;
  2288.  
  2289. procedure newexitproc; far;
  2290. begin
  2291.   exitproc := oldexitproc;
  2292.   if gus_irq <> 0 then gusstoptimer1
  2293.   else set_timer(65535);
  2294.   setintvec(dos_irq,@oldint);
  2295.   asm
  2296.     mov  cx,30
  2297. @@1:
  2298.     mov  ah,2
  2299.     mov  dl,7
  2300.     int  21h   {Just to remind you to call done_mod}
  2301.     loop @@1
  2302.   end;
  2303. end;
  2304.  
  2305. procedure done_mod;
  2306. begin
  2307.   if playing then stop_playing;
  2308.   setintvec(dos_irq,@oldint);
  2309.   exitproc := oldexitproc;
  2310.   gusdeinit;
  2311. end;
  2312.  
  2313. procedure init_mod;
  2314. var
  2315. n,i : integer;
  2316. l : longint;
  2317.  
  2318. begin
  2319.   virt_info.err_wptn := -1;
  2320.   virt_info.err_nptn := -1;
  2321.   virt_info.err_cptn := -1;
  2322.   virt_error := 0;
  2323.   virt_alloc := def_virt_alloc;
  2324.   virt_free := def_virt_free;
  2325.   virt_allocptn := def_virt_allocptn;
  2326.   virt_loadptn := def_virt_loadptn;
  2327.   virt_freeptn := def_virt_freeptn;
  2328.   virt_getptn := def_virt_getptn;
  2329.   virt_warnptn := def_virt_warnptn;
  2330.   virt_needptn := def_virt_needptn;
  2331.   virt_noneedptn := def_virt_noneedptn;
  2332.   for n := 0 to 255 do orders[n] := 0;
  2333.   for n := 0 to maxchn-1 do begin
  2334.     initchn(n);
  2335.     gussetbalance(n,channels[n].pan);
  2336.   end;
  2337.   fillchar(samples,sizeof(samples),0);
  2338.   for n := 0 to 13 do gusplayvoice(n,2,0,0,1);
  2339.   for n := 0 to 13 do gussetvolume(n,0);
  2340.   for n := 0 to 13 do gussetbalance(n,7);
  2341.   fillchar(header,sizeof(header),0);
  2342.   header.chns := 4;
  2343.   header.usedchns := 4;
  2344.   cur_ptn := 0;
  2345.   cur_row := 0;
  2346.   new_ptn := 0;
  2347.   new_row := 0;
  2348.   cur_tick := 0;
  2349.   pdelay := 0;
  2350.   main_vol := 64;
  2351.   vblank := false;
  2352.   low_addr := 0;
  2353.   top_addr := low_addr+16;
  2354.   gus_bank := 0;
  2355.   for n := 0 to 31 do guspoke(n,0);
  2356.   playing := false;
  2357.   loaded := false;
  2358.   oldexitproc := exitproc;
  2359.   exitproc := @newexitproc;
  2360.   if gus_irq > 7 then begin
  2361.     dos_irq := gus_irq+$68;
  2362.     port[$a1] := port[$a1] and not (1 shl (gus_irq-8));
  2363.     port[$21] := port[$21] and $fb;
  2364.   end else begin
  2365.     dos_irq := gus_irq+8;
  2366.     port[$21] := port[$21] and not (1 shl gus_irq);
  2367.   end;
  2368.   getintvec(dos_irq,@oldint);
  2369.   if gus_irq <> 0 then begin
  2370.     port[gus_base] := $49;
  2371.     i := 5;
  2372.     case gus_irq of
  2373.       2 : i := 1;
  2374.       5 : i := 2;
  2375.       3 : i := 3;
  2376.       7 : i := 4;
  2377.       11 : i := 5;
  2378.       12 : i := 6;
  2379.       15 : i := 7;
  2380.     end;
  2381.     port[gus_base+$b] := i;
  2382.     setintvec(dos_irq,@gusint);
  2383.     gusstoptimer1;
  2384.   end
  2385.   else setintvec(dos_irq,@timerint);
  2386. end;
  2387.  
  2388. {$s-}
  2389. procedure set_timer(ticks : word);
  2390. begin
  2391.   asm cli end;
  2392.   port[$43] := $36;
  2393.   port[$40] := lo(ticks);
  2394.   port[$40] := hi(ticks);
  2395.   asm sti end;
  2396. end;
  2397.  
  2398. procedure stop_playing;
  2399. var
  2400. n : integer;
  2401. begin
  2402.   playing := false;
  2403.   int_rate := 65535;
  2404.   if gus_irq <> 0 then gusstoptimer1
  2405.   else set_timer(65535);
  2406.   {setintvec(dos_irq,@oldint);}
  2407.   for n := 0 to maxchn-1 do begin
  2408.     {$IFNDEF __MINI__}
  2409.     channels[n].hit := 0;
  2410.     channels[n].bar := 0;
  2411.     {$ENDIF}
  2412.     GusStopVoice(n);
  2413.     gussetofs(n,0);
  2414.   end;
  2415. end;
  2416.  
  2417. procedure start_playing;
  2418. var
  2419. n : integer;
  2420. begin
  2421.   if (not loaded) or (playing) then exit;
  2422.   for n := 0 to maxchn-1 do initchn(n);
  2423.   speed := header.ispeed;
  2424.   nspeed := header.ispeed;
  2425.   tempo := header.itempo;
  2426.   for n := 0 to header.usedchns-1 do begin
  2427.     fillchar(gus_chn,sizeof(gus_chn),0);
  2428.     gussetvolume(n,0);
  2429.     channels[n].pan := header.chn_pan[n];
  2430.     gussetbalance(n,channels[n].pan);
  2431.     gusstopvoice(n);
  2432.     gussetofs(n,0);
  2433.   end;
  2434.   for n := 0 to maxchn-1 do gus_chn[n].pan := channels[n].pan;
  2435.   pdelay := 0;
  2436.   loops := 0;
  2437.   loope := 0;
  2438.   loopcnt := 0;
  2439.   jump := 0;
  2440.   main_vol := 64;
  2441.   int_tick := 0;
  2442.   cur_ptn := 0;
  2443.   cur_row := 0;
  2444.   new_ptn := 0;
  2445.   new_row := 0;
  2446.   cur_tick := 0;
  2447.   time_counter := 0;
  2448.   time_counter2 := 0;
  2449.   time_counter3 := 0;
  2450.   virt_warnptn(orders[0]);
  2451.   virt_needptn(orders[0]);
  2452.   asm cli end;
  2453.   {setintvec(dos_irq,@timerint);}
  2454.   timer_rate := 25000 div (tempo);
  2455.   timer_cnt := timer_rate;
  2456.   int_rate := 1193182 div 1250;
  2457.   if gus_irq = 0 then set_timer(int_rate)
  2458.   else gusstarttimer1(10);
  2459.   playing := true;
  2460.   asm sti end;
  2461. end;
  2462.  
  2463. {$IFDEF __FX__}
  2464. procedure init_fx(fxspace: longint;chns : integer);
  2465. {fxspace = gus memory reserved for sound fx, chns = # of channels
  2466.  reserved for sound fx}
  2467.  
  2468. var
  2469. n : integer;
  2470. begin
  2471.   fillchar(fx_samples,sizeof(fx_samples),0);
  2472.   fillchar(fx_channels,sizeof(fx_channels),0);
  2473.   for n := 0 to maxfxchn-1 do with fx_channels[n] do begin
  2474.     note := 4*16;
  2475.     basenote := 4*16;
  2476.     per := 1712;
  2477.     dper := 1712;
  2478.     pan := 7;
  2479.   end;
  2480.   for n := 0 to 31 do begin
  2481.     fx_samples[n].c4spd := 8363;
  2482.   end;
  2483.   low_addr := fxspace;
  2484.   top_addr := fxspace+16;
  2485.   for n := 0 to 31 do guspoke(n+low_addr,0);
  2486.   for n := 0 to 31 do guspoke(n,0);
  2487.   top_fx_addr := 16;
  2488.   base_fx_chn := 0;
  2489.   fxchns := chns;
  2490. end;
  2491.  
  2492. function load_fx_raw(s : string;num : integer) : integer;
  2493. {Loads a raw (signed) sample}
  2494. const
  2495. block = 4096;
  2496. var
  2497. f : file;
  2498. n : integer;
  2499. fl,l : word;
  2500. oa : longint;
  2501. begin
  2502.   oa := top_fx_addr;
  2503.   fillchar(fx_samples[num],sizeof(fx_samples[num]),0);
  2504.   {$i-}
  2505.   assign(f,s);
  2506.   reset(f,1);
  2507.   if ioresult <> 0 then begin
  2508.     load_fx_raw := -1;
  2509.     exit;
  2510.   end;
  2511.   with fx_samples[num] do begin
  2512.     _type := 1;
  2513.     volume := 64;
  2514.     c4spd := 8363;
  2515.     length := filesize(f);
  2516.     addr := top_fx_addr;
  2517.   end;
  2518.   getmem(misc_buf,block);
  2519.   fl := fx_samples[num].length div block;
  2520.   l := fx_samples[num].length mod block;
  2521.   if fl > 0 then for n := 1 to fl do begin
  2522.     blockread(f,misc_buf^,block);
  2523.     load2gus(misc_buf,top_fx_addr,block,0);
  2524.     inc(top_fx_addr,block);
  2525.   end;
  2526.   if l > 0 then begin
  2527.     blockread(f,misc_buf^,l);
  2528.     load2gus(misc_buf,top_fx_addr,l,0);
  2529.     inc(top_fx_addr,l);
  2530.   end;
  2531.   guspoke(top_fx_addr,0);
  2532.   guspoke(top_fx_addr+1,0);
  2533.   inc(top_fx_addr);
  2534.   freemem(misc_buf,block);
  2535.   close(f);
  2536.   load_fx_raw := 0;
  2537. end;
  2538.  
  2539. function load_fx_st3(s : string;num : integer) : integer;
  2540. {Loads an ST3 instrument file}
  2541. const
  2542. block = 4096;
  2543. var
  2544. f : file;
  2545. n : integer;
  2546. fl,l : word;
  2547. oa : longint;
  2548. begin
  2549.   oa := top_fx_addr;
  2550.   fillchar(fx_samples[num],sizeof(fx_samples[num]),0);
  2551.   {$i-}
  2552.   assign(f,s);
  2553.   reset(f,1);
  2554.   if ioresult <> 0 then begin
  2555.     load_fx_st3 := -1;
  2556.     exit;
  2557.   end;
  2558.   blockread(f,fx_samples[num],sizeof(fx_samples[num]));
  2559.   with fx_samples[num] do begin
  2560.     if flags and 1 <> 0 then loop := true;
  2561.     if loopstart = loopend then loop := false;
  2562.     addr := top_fx_addr;
  2563.     if _type<> 1 then begin
  2564.       length := 0;
  2565.       loopstart := 0;
  2566.       loopend := 0;
  2567.       addr := 0;
  2568.     end;
  2569.   end;
  2570.   getmem(misc_buf,block);
  2571.   fl := fx_samples[num].length div block;
  2572.   l := fx_samples[num].length mod block;
  2573.   if fl > 0 then for n := 1 to fl do begin
  2574.     blockread(f,misc_buf^,block);
  2575.     load2gus(misc_buf,top_fx_addr,block,128);
  2576.     inc(top_fx_addr,block);
  2577.   end;
  2578.   if l > 0 then begin
  2579.     blockread(f,misc_buf^,l);
  2580.     load2gus(misc_buf,top_fx_addr,l,128);
  2581.     inc(top_fx_addr,l);
  2582.   end;
  2583.   with fx_samples[num] do begin
  2584.     if loop then begin
  2585.       guspoke(addr+loopend+1,
  2586.               guspeek(addr+loopstart));
  2587.       guspoke(addr+loopend,
  2588.               guspeek(addr+loopstart));
  2589.       inc(top_fx_addr,2);
  2590.     end;
  2591.   end;
  2592.   guspoke(top_fx_addr,0);
  2593.   guspoke(top_fx_addr+1,0);
  2594.   inc(top_fx_addr);
  2595.   freemem(misc_buf,block);
  2596.   close(f);
  2597.   load_fx_st3 := 0;
  2598. end;
  2599.  
  2600. procedure play_fx(_chn,num : integer);
  2601. {Plays a sample [num] in channel [_chn]}
  2602. var
  2603.   c4spd : word;
  2604.   l : word;
  2605.   chn : integer;
  2606. begin
  2607.   if (_chn >= fxchns) or (num > 31) then exit;
  2608.   chn := base_fx_chn+_chn;
  2609.   c4spd := fx_samples[num].c4spd;
  2610.   with fx_channels[_chn] do begin
  2611.     sample := num;
  2612.     note := 4*16;
  2613.     basenote := 4*16;
  2614.     vol := 64;
  2615.     per := longdiv((longmul(8363,
  2616.                   16*st3_per[note and 15]) shr (note shr 4)),c4spd);
  2617.     gvol := gusvol[64]*fx_amp_vol+20000;
  2618.     gussetbalance(chn,pan);
  2619.     if (fx_samples[num].loop) then
  2620.         gusplayall(chn,8,fx_samples[num].addr,
  2621.                          fx_samples[num].addr+fx_samples[num].loopstart,
  2622.                          fx_samples[num].addr+fx_samples[num].loopend,
  2623.                          per2gus(per),gvol)
  2624.     else gusplayall(chn,0,fx_samples[num].addr,
  2625.                           fx_samples[num].addr,
  2626.                           fx_samples[num].addr+fx_samples[num].length,
  2627.                           per2gus(per),gvol);
  2628.  
  2629.   end;
  2630. end;
  2631. {$ENDIF}
  2632.  
  2633. end.
  2634.  
  2635.