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