Sound, Music & MIDI Collection 2/SMMVOL2.bin/DOS/SS_PLAY/FUNK106.ZIP/FUNK_S.ZIP/MOD2FNK.PAS

Pascal/Delphi Source File | 1995-03-31 | 21.2 KB | 799 lines

{
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;                                                                          ;
; MOD2FNK:-                                                                ;
;                                                                          ;
; Converts "M.K." Modules to the FunkTracker format (11/03/95)             ;
;                                                                          ;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
}
{$I-}
program mod2fnk;

const
  version          = 'V1.2';
  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     : longint;
    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';
  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, sizeof(tfnkheader) - sizeof(tfnksamples));
  fnkheader.LZH_check_sum := 0;
  repeat
    blockread(modfile, trans_buffer1, fnbuf_size, rws);
    if rws <> 0 then
    begin
      for x := 0 to (rws-1) do
      begin
        fnkheader.LZH_check_sum := fnkheader.LZH_check_sum + trans_buffer1[x];
      end;
    end;
  until rws = 0;
  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.