home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Large Pack of OldSkool DOS MOD Trackers
/
funk108a.zip
/
FUNK_S.ZIP
/
MOD2FNK.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1995-07-02
|
22KB
|
793 lines
{
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; ;
; MOD2FNK:- ;
; ;
; Converts "M.K." Modules to the FunkTracker format (11/03/95) ;
; ;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
}
{$I-}
program mod2fnk;
const
version = 'V1.3';
tmodsamples_size = 30;
fnbuf_size = 20000;
type
t_mod_type = (NO_MOD, FOURCHAN_MOD, EIGHTCHAN_MOD);
{=MOD STRUCTURES==============================}
tmodsamples = record
sname : array[1..22] of char;
slength : word;
sfinetune : byte;
svolume : byte;
srepeat : word;
sreplen : word;
end;
tmodheader = record
songname : array[1..20] of char;
samples : array[1..31] of tmodsamples;
songlen : byte;
restart : byte;
sequences : array[1..128] of byte;
mk : array[1..4] of char;
end;
tmodslot = record
byte1 : byte;
byte2 : byte;
byte3 : byte;
byte4 : byte;
end;
{=FNK STRUCTURES==============================
─'info' code──────────────────────────────────┴────────────────────────
0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 3 3 3 3 3 3 3 3
\-day---/ \month--/ \----year---/ \-card/ \-CPU-/ | 0 0 0 0 0 0 0
| \memory reqi/
| (256Kb x)
16 bit = 1 ----
cpu: 0 = Unknown
1 = IBM ????
2 = IBM ????
3 = Intel386
4 = Intel486
5 = Pentium
card:
0 = SB 2.0
1 = SB PRO
2 = GUS v<>
3 = Bogus SB
4 = Reserved
5 = GUS f<>
6 = Ripped/converted from another format
}
tfnksamples = record
sname : array [1..19] of char;
start : longint;
length : longint;
volume : byte;
balance : byte;
pt_and_sop : byte;
vv_waveform : byte;
rl_and_as : byte;
end;
tfnkheader = record
sig : array[1..4] of char;
info : array[1..4] of byte;
LZH_check_size : longint;
LZH_check_sum : array[1..4] of char;
loop_order : byte;
order_list : array[1..256] of byte;
break_list : array[1..128] of byte;
samples : array[1..64] of tfnksamples;
end;
tfnkslot = record
byte1 : byte;
byte2 : byte;
byte3 : byte;
end;
{=============================================}
var
newstr : string[80];
modfile : file;
funkfile : file;
modheader : tmodheader;
fnkheader : tfnkheader;
numpatterns : byte;
numsamples : byte;
rws : word;
modpattern : array[0..(64*8)-1] of tmodslot;
fnkpattern : array[0..(64*8)-1] of tfnkslot;
trans_buffer1 : array[0..(fnbuf_size-1)] of byte;
trans_buffer2 : array[0..(fnbuf_size-1)] of byte;
channels : byte;
pattern : byte;
treks : byte;
oldsample : array[0..7] of byte;
mod_type : t_mod_type;
{
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; ;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
}
function convert_header : boolean;
var
y, m, d, dow : Word;
x : byte;
begin
convert_header := false;
{init fnk header}
fnkheader.sig[1] := 'F';
fnkheader.sig[2] := 'u';
fnkheader.sig[3] := 'n';
fnkheader.sig[4] := 'k';
fnkheader.LZH_check_sum[1] := 'F';
fnkheader.LZH_check_sum[2] := 'k';
fnkheader.LZH_check_sum[3] := '0';
fnkheader.LZH_check_sum[4] := '8';
asm
mov ah,2ah
int 21h
xor ax,ax
mov al,dl
xor dl,dl
xchg dl,dh
shl dx,5
or ax,dx
sub cx,1980
shl cx,9
or ax,cx
mov word[fnkheader.info+0],ax
xor ax,ax
mov al,6 {card_type}
mov bl,1 {cpu type}
shl bl,4
or al,bl
mov word[fnkheader.info+2],ax
end;
fnkheader.loop_order := $FF;
for dow := 1 to 256 do
begin
fnkheader.order_list[dow] := $ff;
end;
for dow := 1 to 128 do
begin
fnkheader.break_list[dow] := $3f;
end;
for dow := 1 to 64 do
begin
for y := 1 to 19 do
begin
fnkheader.samples[dow].sname[y] := #0;
end;
fnkheader.samples[dow].start := $ffffffff;
fnkheader.samples[dow].length := 0;
fnkheader.samples[dow].volume := $ff;
fnkheader.samples[dow].balance := $80;
fnkheader.samples[dow].pt_and_sop := $08;
fnkheader.samples[dow].vv_waveform := $0;
fnkheader.samples[dow].rl_and_as := $43;
end;
{convert header}
mod_type := NO_MOD;
blockread(modfile, modheader, sizeof(modheader), rws);
if (modheader.mk[1] = 'M') and
(modheader.mk[2] = '.') and
(modheader.mk[3] = 'K') and
(modheader.mk[4] = '.') then
begin
mod_type := FOURCHAN_MOD;
writeln('converting 4 channel M.K...');
end
else
begin
if (modheader.mk[1] = '8') and
(modheader.mk[2] = 'C') and
(modheader.mk[3] = 'H') and
(modheader.mk[4] = 'N') then
begin
mod_type := EIGHTCHAN_MOD;
writeln('converting 8 channel 8CHN...');
end
else
begin
writeln('Not an regonised MOD module.');
end;
end;
if mod_type <> NO_MOD then
begin
convert_header := true;
for y := 1 to 128 do
begin
fnkheader.order_list[y] := modheader.sequences[y];
end;
for y := 1 to 31 do
begin
for dow := 1 to 19 do
begin
fnkheader.samples[y].sname[dow] := modheader.samples[y].sname[dow];
end;
asm
mov al,tmodsamples_size
mov bl,byte [y]
dec bl
mul bl
mov bx,ax
add bx,offset modheader.samples
mov ax,word[bx+tmodsamples.slength]
xchg al,ah
shl ax,1
mov word[bx+tmodsamples.slength],ax
mov ax,word[bx+tmodsamples.srepeat]
xchg al,ah
shl ax,1
mov word[bx+tmodsamples.srepeat],ax
mov ax,word[bx+tmodsamples.sreplen]
xchg al,ah
shl ax,1
mov word[bx+tmodsamples.sreplen],ax
end;
if modheader.samples[y].slength > 0 then
begin
if modheader.samples[y].sreplen > 2 then
begin
fnkheader.samples[y].length := modheader.samples[y].srepeat +
modheader.samples[y].sreplen;
if fnkheader.samples[y].length > modheader.samples[y].slength then
begin
fnkheader.samples[y].length := modheader.samples[y].slength;
end;
fnkheader.samples[y].start := modheader.samples[y].srepeat;
end
else
begin
fnkheader.samples[y].length := modheader.samples[y].slength;
end;
if modheader.samples[y].svolume > 0 then
begin
dow := trunc((modheader.samples[y].svolume * 256) / 64);
if dow = 256 then
begin
dow := 255;
end;
fnkheader.samples[y].volume := byte(dow);
end
else
begin
fnkheader.samples[y].volume := 0;
end;
end;
end;
blockwrite(funkfile, fnkheader, sizeof(fnkheader), rws);
end;
end;
{
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; ;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
}
const
mus_match : array[0..60] of word = (
1712,1616,1524,1440,1356,1280,1208,1140,1076,1016,960,912,
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,0
);
function mod_notematcher(note : word) : byte;
var
x : byte;
label exit;
begin
mod_notematcher := 0;
for x := 0 to 60 do
begin
if note >= mus_match[x] then
begin
mod_notematcher := x;
goto exit;
end;
end;
exit:
end;
{
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; ;
;-MOD SLOT FORMAT----------------------------------------------------------;
; ;
; _____byte 1_____ byte2_ _____byte 3_____ byte4_ ;
;/ ╓ / ╓ / ╓ / ╓ ;
;0000 0000-00000000 0000 0000-00000000 ;
; ;
;upper four 12 bits for lower four effect command. ;
;bits of sam- note period. bits of sam- ;
;ple number. ple number. ;
;
;-FUNK SLOT FORMAT---------------------------------------------------------
;
;Each pattern block is 600h bytes - 8 by 64 slot. Each slot has
;the following format:
;
; 00000000 11111111 22222222
; \____/\_____/\__/ \______/
; Note Sample com command value
;
; - if note = 3D, reload sample attr
; - if note = 3F, then it's a null slot
; - if note = 3E, then sample only slot
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
}
procedure convert_command(var modcom, modcomv, fnkcom, fnkcomv : byte);
var
xxx : word;
procedure convert_slide;
begin { 0 = slide down}
if (modcomv and $f0) <> 0 then
begin
fnkcom := byte('G');
fnkcomv := modcomv and $f;
end
else
begin
fnkcom := byte('H');
fnkcomv := modcomv and $f;
end;
end;
begin
fnkcom := $f + byte('A');
fnkcomv := 0;
case modcom of
0: {arpeggio}
begin
fnkcom := byte('L');
fnkcomv := modcomv;
end;
1: {portup}
begin
fnkcom := byte('A');
fnkcomv := modcomv;
end;
2: {portdn}
begin
fnkcom := byte('B');
fnkcomv := modcomv;
end;
3: {porta note}
begin
fnkcom := byte('C');
fnkcomv := modcomv;
end;
4: {vibrato}
begin
fnkcom := byte('D');
fnkcomv := modcomv;
end;
5: {porta note + volslide}
begin
convert_slide;
end;
6: {vibrato + volslide}
begin
convert_slide;
end;
7: {tremolo}
begin
fnkcom := byte('K');
fnkcomv := modcomv;
end;
9: {sample offset}
begin
fnkcom := byte('M');
fnkcomv := modcomv;
end;
$a: {Volume Slide}
begin
convert_slide;
end;
$c: {set volume}
begin
fnkcom := byte('N');
{$r-}
xxx := trunc((modcomv * 256) / 64);
if xxx = 256 then
begin
xxx := 255;
end;
fnkcomv := xxx;
{$r+}
end;
$d: {pattern break}
begin
fnkheader.break_list[pattern] := treks;
end;
$e: {command e}
begin
case (modcomv shr 4) of
1: {fine slideup}
begin
fnkcom := byte('O');
fnkcomv := $40 or (modcomv and $f);
end;
2: {fine slidedn}
begin
fnkcom := byte('O');
fnkcomv := $50 or (modcomv and $f);
end;
4: {Vibrato command}
begin
end;
7: {tremolo command}
begin
end;
9: {retrig note}
begin
fnkcom := byte('O');
fnkcomv := $D0 or (modcomv and $f);
end;
$a: {fine volume up}
begin
fnkcom := byte('O');
fnkcomv := $60 or (modcomv and $f);
end;
$b: {fine volume dn}
begin
fnkcom := byte('O');
fnkcomv := $70 or (modcomv and $f);
end;
$c: {note cut}
begin
fnkcom := byte('O');
fnkcomv := $01 or (modcomv and $f);
end;
end;
end;
$f: {set tempo}
begin
fnkcom := byte('O');
if modcomv > 0 then
begin
dec(modcomv);
end;
fnkcomv := $f0 or (modcomv and $f);
end;
end;
fnkcom := fnkcom - byte('A');
end;
procedure convert_slot(mod_slot : tmodslot; var fnk_slot : tfnkslot);
var
note : word;
note2 : byte;
sample : byte;
command : byte;
commval : byte;
fnkcom : byte;
fnkcomv : byte;
begin
asm
mov ax,word[mod_slot.byte1]
xchg al,ah
and ax,0fffh
mov note,ax
end;
note2 := mod_notematcher(note);
sample := (mod_slot.byte3 shr 4) or (mod_slot.byte1 and $f0);
command := mod_slot.byte3 and $f;
commval := mod_slot.byte4;
if note <> 0 then
begin
if sample = 0 then
begin
sample := oldsample[channels];
end
else
begin
oldsample[channels] := sample;
end;
if sample > 0 then
begin
dec(sample);
fnk_slot.byte1 := note2 shl 2;
fnk_slot.byte2 := $f;
fnk_slot.byte1 := fnk_slot.byte1 or ((sample shr 4) and 3);
fnk_slot.byte2 := fnk_slot.byte2 or ((sample and 15) shl 4);
end;
end;
if (command > 0) and (commval > 0) then
begin
convert_command(command, commval, fnkcom, fnkcomv);
fnk_slot.byte2 := fnk_slot.byte2 and $f0;
fnk_slot.byte2 := fnk_slot.byte2 or (fnkcom and $f);
fnk_slot.byte3 := fnkcomv;
end;
end;
{
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; ;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
}
procedure convert_patterns;
var
numpatterns : byte;
x : byte;
no_channels : byte;
pattern_total : longint;
begin
pattern_total := 0;
write(#10);
case mod_type of
FOURCHAN_MOD: no_channels := 4;
EIGHTCHAN_MOD: no_channels := 8;
end;
numpatterns := 0;
for x := 1 to 128 do
begin
if modheader.sequences[x] > numpatterns then
begin
numpatterns := modheader.sequences[x];
end;
end;
inc(numpatterns);
oldsample[0] := 0;
oldsample[1] := 0;
oldsample[2] := 0;
oldsample[3] := 0;
{convert mod patterns}
for pattern := 1 to numpatterns do
begin
blockread(modfile, modpattern, sizeof(tmodslot)*(64*no_channels), rws);
for treks := 0 to 63 do
begin
for channels := 0 to 7 do
begin
fnkpattern[channels+(treks*8)].byte1 := $fc;
fnkpattern[channels+(treks*8)].byte2 := $f;
fnkpattern[channels+(treks*8)].byte3 := 0;
end;
end;
for treks := 0 to 63 do
begin
for channels := 0 to (no_channels-1) do
begin
convert_slot(modpattern[channels+(treks*no_channels)], fnkpattern[channels+(treks*8)])
end;
end;
blockwrite(funkfile, fnkpattern, sizeof(tfnkslot)*(64*8), rws);
pattern_total := pattern_total + rws;
write('patterns : ',pattern:8,', ',pattern_total:8,' bytes',#13);
end;
end;
{
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; ;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
}
const
MOD_tune_table : array[0..15] of word = (
($369e9a div 0428),
($369e9a div 0425),
($369e9a div 0422),
($369e9a div 0419),
($369e9a div 0416),
($369e9a div 0413),
($369e9a div 0410),
($369e9a div 0407),
($369e9a div 0453),
($369e9a div 0450),
($369e9a div 0447),
($369e9a div 0444),
($369e9a div 0441),
($369e9a div 0437),
($369e9a div 0434),
($369e9a div 0431));
procedure convert_samples_etc;
var
rws2 : word;
sample_block_size : longint;
x : word;
read_length : word;
truct : longint;
saminfreqinc : real;
saminpos : real;
samoutpos : word;
procedure write_block;
begin
if samoutpos > 0 then
begin
blockwrite(funkfile, trans_buffer2, samoutpos, rws2);
samoutpos := 0;
sample_block_size := sample_block_size + rws;
fnkheader.samples[x].length := fnkheader.samples[x].length + rws2;
end;
end;
procedure trans_block;
begin
fnkheader.samples[x].length := 0;
if read_length > 0 then
begin
repeat
if read_length > fnbuf_size then
begin
blockread(modfile, trans_buffer1, fnbuf_size, rws);
end
else
begin
blockread(modfile, trans_buffer1, read_length, rws);
end;
read_length := read_length - rws;
if rws > 0 then
begin
saminpos := 0;
samoutpos := 0;
saminfreqinc := MOD_tune_table[modheader.samples[x].sfinetune] / MOD_tune_table[0];
repeat
if samoutpos = fnbuf_size then
begin
write_block;
end;
if trunc(saminpos) < rws then
begin
trans_buffer2[samoutpos] := trans_buffer1[trunc(saminpos)];
inc(samoutpos);
saminpos := saminpos + saminfreqinc;
end;
until trunc(saminpos) >= rws;
write_block;
end;
until rws = 0;
end;
end;
procedure skip_block;
begin
if read_length > 0 then
begin
repeat
if read_length > fnbuf_size then
begin
blockread(modfile, trans_buffer1, fnbuf_size, rws);
end
else
begin
blockread(modfile, trans_buffer1, read_length, rws);
end;
read_length := read_length - rws;
until rws = 0;
end;
end;
begin
write(#10);
sample_block_size := 0;
for x := 1 to 31 do
begin
truct := 0;
if modheader.samples[x].sreplen > 2 then
begin
read_length := (modheader.samples[x].srepeat + modheader.samples[x].sreplen);
if read_length > modheader.samples[x].slength then
begin
read_length := modheader.samples[x].slength;
trans_block;
end
else
begin
trans_block;
read_length := modheader.samples[x].slength - (modheader.samples[x].srepeat + modheader.samples[x].sreplen);
truct := read_length;
skip_block;
end;
end
else
begin
read_length := modheader.samples[x].slength;
trans_block;
end;
write('sample ',x:2,': ',fnkheader.samples[x].length:8,',',
fnkheader.samples[x].start:8,',',sample_block_size:8,
' bytes ',#13);
if modheader.samples[x].sfinetune = 7 then
begin
writeln(#10' WARNING: FUNKTRACKER DOESN`T HAVE FINETUNE. PLEASE RESAMPLE.');
end;
if truct > 0 then
begin
writeln(#10' WARNING: UNUSED SAMPLE LOOP TRUCATED BY ',truct,' bytes.');
end;
end;
fnkheader.info[4] := byte(sample_block_size shr 18);
fnkheader.LZH_check_size := filesize(funkfile);
seek(funkfile, 0);
blockwrite(funkfile, fnkheader, sizeof(tfnkheader) - sizeof(tfnksamples), rws);
end;
{
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; ;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
}
var
as : byte;
begin
if ParamStr(1) = '' then
begin
writeln('MOD2FNK ',version, '- Converts ProTracker modules to FunkTracker format');
writeln('───────────────────────────────────────────────────────────────────────────────');
writeln('Command: MOD2FNK <modfile>');
end
else
begin
as := pos('.', ParamStr(1));
if as > 0 then
begin
newstr := copy(ParamStr(1),1, pos('.', ParamStr(1))-1);
end
else
begin
newstr := ParamStr(1);
end;
assign(modfile, newstr + '.MOD');
reset(modfile, 1);
if ioresult = 0 then
begin
assign(funkfile, newstr + '.FNK');
rewrite(funkfile,1);
if ioresult = 0 then
begin
if convert_header then
begin
convert_patterns;
convert_samples_etc;
end;
close(funkfile);
end;
close(modfile);
writeln(#10,'Successfully converted.');
end
else
begin
writeln;
writeln('MOD file not found.');
end;
end;
end.