{.mod loader}
{$i-}
{$I load_inc.pas}

procedure pokeb(offset:longint; value:byte);
var page:word;
    offs:word;
begin
 page:=(longint(offset) shr 14);
 offs:=offset and $3FFF;
 if ems.page<>page then begin
  map_page(ems.handle,0,page);
  ems.page:=page;
 end;
 mem[ems.addr:offs]:=value;
end;

procedure free_mod;
var i:word;
begin
{ for i:=1 to module.instruments do if (samples[i].used) and (samples[i].data<>nil)
  then freemem(samples[i].data,samples[i].length);}
 free_ems(ems.handle);
 for i:=0 to song.patterns do if song.pattern[i]<>nil then
  freemem(song.pattern[i],5*64*module.channels+10);
end;

function load_mod(name:string):boolean;
var f:file;
    sig:string[4];

function getname:string;
var str:string[20];
    b:byte;
begin
 seek(f,0);
 blockread(f,str[1],20);
 str[0]:=#20;
 for b:=20 downto 1 do if str[b]=#0 then str[0]:=char(b-1);
 getname:=str;
end;

function amigaword(w:word):word; assembler;
asm
 mov al,[w].byte[1];
 mov ah,[w].byte[0];
end;

function getsampleinfo:boolean;
var i:byte;
    w:word;
    b:byte;
begin
 getsampleinfo:=true;
 seek(f,20);
 for i:=1 to module.instruments do with samples[i] do begin
  blockread(f,name[1],22);
  name[0]:=#22;
  for b:=22 downto 1 do if name[b]=#0 then name[0]:=char(b-1);
  blockread(f,w,2);
  length:=longint(amigaword(w))*2;
  inc(totalsamples,length);
  blockread(f,b,1);
  if b<16 then c2spd:=finetunes[b] else c2spd:=8363;
  blockread(f,volume,1);
  blockread(f,w,2);
  loop.start:=longint(amigaword(w))*2;
  blockread(f,w,2);
  loop.length:=longint(amigaword(w))*2;
  if loop.length<3 then begin loop.length:=0; loop.start:=0; end;
  loop.endi:=loop.start+loop.length;
  used:=(length<>0);
 end;
end;

function loadpatterns:boolean;
var i:byte;
    a:word;
    b0,b1,b2,b3:byte;
    p:pointer;
    offs:word;

function getnote(amigaval:word):byte;
var c2:byte;
begin
{getnote:=$ffff;
for c2:=1 to 36 do
 if (amigaval>periods[c2]-2) and (amigaval<periods[c2]+2)
  then getnote:=c2;}
getnote:=$ff;
for c2:=0 to 107 do
 if amigaval>=periods[c2+24] then begin
  getnote:=c2;
  exit;
 end;
end;

var periodfreq:word;
begin
 loadpatterns:=true;
 write('reading patterns..');
 getmem(p,64*module.channels*4);
 for i:=0 to song.patterns do begin
  getmem(song.pattern[i],5*64*module.channels+10);
  blockread(f,p^,64*module.channels*4);
  offs:=0;
  for a:=1 to 64*module.channels do begin
   b0:=mem[seg(p^):ofs(p^)+offs];
   b1:=mem[seg(p^):ofs(p^)+offs+1];
   b2:=mem[seg(p^):ofs(p^)+offs+2];
   b3:=mem[seg(p^):ofs(p^)+offs+3];
   inc(offs,4);
{   blockread(f,b0,1);
   blockread(f,b1,1);
   blockread(f,b2,1);
   blockread(f,b3,1);}

   mem[seg(song.pattern[i]^):ofs(song.pattern[i]^)+a*5]:=(b0 and $F0)+(b2 shr 4);
   periodfreq:=word(word(b0 and $0F) shl 8)+word(b1);
   mem[seg(song.pattern[i]^):ofs(song.pattern[i]^)+a*5+1]:=getnote(periodfreq);
   mem[seg(song.pattern[i]^):ofs(song.pattern[i]^)+a*5+2]:=b2 and $0F;
   mem[seg(song.pattern[i]^):ofs(song.pattern[i]^)+a*5+3]:=b3;
   mem[seg(song.pattern[i]^):ofs(song.pattern[i]^)+a*5+4]:=255; {volume, impossible value}
  end;
 end;
 freemem(p,64*module.channels*4);
 writeln('done!');
end;

function readsamples:boolean;
var a,posi:longint;
    i:byte;
    pos:longint;
    get:longint;
 {   koe:byte;}
    buf:pointer;
   {$ifdef ripsamples}
    outf:file;
   {$endif}
    ch:char;
const disk=4096;
begin
 writeln('sampleja yhteensä ',totalsamples,' tavua.');
 writeln('filussa sampleja  ',filesize(f)-(1084+longint(module.channels)*4*64*longint(song.patterns+1)),' tavua.');
 write('reading samples..');
 seek(f,1084+longint(module.channels)*4*64*longint(song.patterns+1));
{$ifdef purkka}
 seek(f,filesize(f)-totalsamples);
{$endif}
 readsamples:=true;
 getmem(buf,disk);
 for i:=1 to module.instruments do if samples[i].length>0 then begin
 {$ifdef ripsamples}
 assign(outf,'SAM!'+strr(i)+'.RAW');
 rewrite(outf,1);
 {$endif}
{  a:=samples[i].length;
  if a>64000 then begin
   a:=64000;
   writeln('sample #',i,' too big; max size is 64000 bytes.');
  end;
  getmem(samples[i].data,a);
  blockread(f,samples[i].data^,a);
  seek(f,filepos(f)+(samples[i].length-a));}
  a:=samples[i].length;
  posi:=0;
  samples[i].data:=ems.used;

  inc(ems.used,samples[i].length);

  repeat
   if a>disk then get:=disk else get:=a;
   dec(a,get);
   blockread(f,buf^,get);
   if ioresult<>0 then begin
    writeln('hih, sample nro ',i,' bugaa; ',samples[i].length,' byteä, joista ',a,' lukematta');
    writeln(filepos(f),'/',filesize(f));
    ch:=readkey;
   end;
   {$ifdef ripsamples}
   blockwrite(outf,buf^,get);
   {$endif}
   for pos:=0 to get-1 do
    pokeb(samples[i].data+posi+pos,mem[seg(buf^):ofs(buf^)+pos]);
   inc(posi,get);
  until a=0;
  {$ifdef ripsamples}
  close(outf);
  {$endif}
 end;
 freemem(buf,disk);
 writeln;
 writeln('done!');
end;

function loadsong:boolean;
var b:byte;
    sig:string[4];
begin
 loadsong:=true;
 seek(f,950);
 blockread(f,song.length,1);
 writeln('song length  : ',song.length);
 blockread(f,b,1);
 writeln('dummy byte: ',b,' (usually 127)');
 writeln;
 song.patterns:=0;
 for b:=1 to 128 do begin
  blockread(f,song.order[b],1);
  if (song.order[b]>song.patterns) and (b<=song.length) then
   song.patterns:=song.order[b];
 end;
 writeln('phys patterns: ',song.patterns+1);
 if filepos(f)<>1080 then writeln('**** BUGIIIIIII!!!! ****',#7#7);
 blockread(f,sig[1],4);
 sig[0]:=#4;
 writeln('module type  : ',sig);
 if not(loadpatterns) then loadsong:=false;
 if not(readsamples) then loadsong:=false;
end;

function check_mk:boolean;
var code:integer;
begin
 check_mk:=true;
 seek(f,1080);
 module.instruments:=31;
 blockread(f,sig[1],4); sig[0]:=#4;
 if ((sig='M.K.') or (sig='M!K!')) then module.channels:=4
 else
  if (sig='OCTA') then module.channels:=8
  else
   if (pos('CH',sig)=3) then begin
    val(copy(sig,1,2),module.channels,code);
    check_mk:=code=0;
   end
   else
    if pos('CHN',sig)=2 then begin
     val(copy(sig,1,1),module.channels,code);
     check_mk:=code=0;
    end
    else
     if pos('FLT',sig)=1 then begin
      val(copy(sig,4,1),module.channels,code);
      check_mk:=code=0;
     end
     else
      if pos('TDZ',sig)=1 then begin
       val(copy(sig,4,1),module.channels,code);
       check_mk:=code=0;
      end
      else check_mk:=false;
end;

begin
 load_mod:=false;
 if not(ems_installed) then begin
  writeln('no ems.');
  exit;
 end;
 assign(f,name);
 reset(f,1);
 if ioresult<>0 then begin
   if pos('.',name)<>length(name)-3 then name:=name+'.MOD';
  assign(f,name);
  reset(f,1);
 end;
 if ioresult<>0 then begin
  writeln('file not found');
  exit;
 end;
 writeln('loading module: ',name);
 if not(check_mk) then begin
  close(f);
  writeln('not a (31-instrument) mod.');
  exit;
 end;
 module.title:=getname;
 module.maxsamples:=32;
 song.speed:=6;
 song.bpm:=125;

 master:=64;
 writeln;
 writeln('module name   : ',module.title);
 writeln('channels      : ',module.channels);
 writeln;
 totalsamples:=0;
 if not(getsampleinfo) then begin
  writeln('error.');
  exit;
 end;
 if totalsamples>(longint(free_pages)*16384) then begin
  close(f);
  writeln('out of memory.');
  exit;
 end;
 ems.used:=0;
 ems.handle:=alloc_pages((totalsamples+16383) div 16384);
 map_page(ems.handle,0,0);
 ems.page:=0;
 ems.addr:=ems_addr;
 if not(loadsong) then begin
  writeln('error.');
  close(f);
  exit;
 end;

 writeln(filepos(f),'/',filesize(f));
 close(f);
 load_mod:=true;
{ writeln('press any key.');
 readkey;}
end;