unit load_xm;

interface
uses
  Windows, MikModEng;
  {$O+} {$R-} {$B-} {$T-} {$WARNINGS OFF} {$HINTS OFF}

const
  XMENVCNT          = (12 * 2);
  XMNOTECNT         = (8 * 12{OCTAVE});
  XM_SMPINCR        = 64;

  //*========== Module structure */
type
  XMHEADER = record
    id: array[0..16] of CHAR;           //* ID text: 'Extended module: ' */
    songname: array[0..20] of CHAR;     //* Module name */
    trackername: array[0..19] of CHAR;  //* Tracker name */
    version: UWORD;                     //* Version number */
    headersize: ULONG;                  //* Header size */
    songlength: UWORD;                  //* Song length (in patten order table) */
    restart: UWORD;                     //* Restart position */
    numchn: UWORD;                      //* Number of channels (2,4,6,8,10,...,32) */
    numpat: UWORD;                      //* Number of patterns (max 256) */
    numins: UWORD;                      //* Number of instruments (max 128) */
    flags: UWORD;
    tempo: UWORD;                       //* Default tempo */
    bpm: UWORD;                         //* Default BPM */
    orders: array[0..255] of UBYTE;     //* Pattern order table  */
  end;

  PXMHEADER = ^XMHEADER;

  XMHEADERARRAY = array[0..$EFFFF] of XMHEADER;
  PXMHEADERARRAY = ^XMHEADERARRAY;

  XMINSTHEADER = record
    size: ULONG;                        //* Instrument size */
    name: array[0..21] of CHAR;         //* Instrument name */
    _type: UBYTE;                       //* Instrument type (always 0) */
    numsmp: UWORD;                      //* Number of samples in instrument */
    ssize: ULONG;
  end;

  PXMINSTHEADER = ^XMINSTHEADER;

  XMINSTHEADERARRAY = array[0..$EFFFF] of XMINSTHEADER;
  PXMINSTHEADERARRAY = ^XMINSTHEADERARRAY;

  XMPATCHHEADER = record
    what: array[0..XMNOTECNT - 1] of UBYTE; //*  Sample number for all notes */
    volenv: array[0..XMENVCNT - 1] of UWORD; //*  Points for volume envelope */
    panenv: array[0..XMENVCNT - 1] of UWORD; //*  Points for panning envelope */
    volpts: UBYTE;                      //*  Number of volume points */
    panpts: UBYTE;                      //*  Number of panning points */
    volsus: UBYTE;                      //*  Volume sustain point */
    volbeg: UBYTE;                      //*  Volume loop start point */
    volend: UBYTE;                      //*  Volume loop end point */
    pansus: UBYTE;                      //*  Panning sustain point */
    panbeg: UBYTE;                      //*  Panning loop start point */
    panend: UBYTE;                      //*  Panning loop end point */
    volflg: UBYTE;                      //*  Volume type: bit 0: On; 1: Sustain; 2: Loop */
    panflg: UBYTE;                      //*  Panning type: bit 0: On; 1: Sustain; 2: Loop */
    vibflg: UBYTE;                      //*  Vibrato type */
    vibsweep: UBYTE;                    //*  Vibrato sweep */
    vibdepth: UBYTE;                    //*  Vibrato depth */
    vibrate: UBYTE;                     //*  Vibrato rate */
    volfade: UWORD;                     //*  Volume fadeout */
  end;
  PXMPATCHHEADER = ^XMPATCHHEADER;

  XMPATCHHEADERARRAY = array[0..$EFFFF] of XMPATCHHEADER;
  PXMPATCHHEADERARRAY = ^XMPATCHHEADERARRAY;

  XMWAVHEADER = record
    length: ULONG;                      //* Sample length */
    loopstart: ULONG;                   //* Sample loop start */
    looplength: ULONG;                  //* Sample loop length */
    volume: UBYTE;                      //* Volume  */
    finetune: SBYTE;                    //* Finetune (signed byte -128..+127) */
    _type: UBYTE;                       //* Loop type */
    panning: UBYTE;                     //* Panning (0-255) */
    relnote: SBYTE;                     //* Relative note number (signed byte) */
    reserved: UBYTE;
    samplename: array[0..21] of CHAR;   //* Sample name */
    vibtype: UBYTE;                     //* Vibrato type */
    vibsweep: UBYTE;                    //* Vibrato sweep */
    vibdepth: UBYTE;                    //* Vibrato depth */
    vibrate: UBYTE;                     //* Vibrato rate */
  end;
  PXMWAVHEADER = ^XMWAVHEADER;

  XMWAVHEADERARRAY = array[0..$EFFFF] of XMWAVHEADER;
  PXMWAVHEADERARRAY = ^XMWAVHEADERARRAY;

  XMPATHEADER = record
    size: ULONG;                        //* Pattern header length  */
    packing: UBYTE;                     //* Packing type (always 0) */
    numrows: UWORD;                     //* Number of rows in pattern (1..256) */
    packsize: SWORD;                    //* Packed patterndata size */
  end;

  PXMPATHEADER = ^XMPATHEADER;
  XMPATHEADERARRAY = array[0..$EFFFF] of XMPATHEADER;
  PXMPATHEADERARRAY = ^XMPATHEADERARRAY;

  XMNOTE = record
    note, ins, vol, eff, dat: UBYTE;
  end;
  PXMNOTE = ^XMNOTE;
  XMNOTEARRAY = array[0..$EFFFF] of XMNOTE;
  PXMNOTEARRAY = ^XMNOTEARRAY;

var
  _load_xm          : MLOADER_;

  function XM_Load(curious: BOOL): BOOL;

implementation

//*========== Loader variables */
var
  xmpat             : PXMNOTE = nil;
  mh                : PXMHEADER = nil;

  //* increment unit for sample array reallocation */

  nextwav           : PULONG = nil;
  wh                : PXMWAVHEADER = nil;
  s                 : PXMWAVHEADER = nil;

function XM_Test(): BOOL;
var
  id                : array[0..37] of UBYTE;
begin
  modreader.Position := 0;
  modreader.read(id, 38);
  if (memcmp(@id, PChar('Extended Module: '), 17)) <> 0 then
  begin
    result := 0;
    exit;
  end;
  if (id[37] = $1A) then
  begin
    result := 1;
    exit;
  end;
  result := 0;
end;

function XM_Init(): BOOL;
begin
  mh := _mm_malloc(sizeof(XMHEADER));
  if mh = nil then
  begin
    result := 0;
    exit;
  end;
  result := 1;
end;

procedure XM_Cleanup();
begin
  FreeMem(mh);
  mh := nil;
end;

function XM_ReadNote(n: PXMNOTE): integer;
var
  res, cmp          : UBYTE;
begin
  res := 1;
  memset(n, 0, sizeof(XMNOTE));
  cmp := _mm_read_UBYTE(modreader);
  if (cmp and $80) <> 0 then
  begin
    if (cmp and 1) <> 0 then
    begin
      inc(res);
      n^.note := _mm_read_UBYTE(modreader);
    end;
    if (cmp and 2) <> 0 then
    begin
      inc(res);
      n^.ins := _mm_read_UBYTE(modreader);
    end;
    if (cmp and 4) <> 0 then
    begin
      inc(res);
      n^.vol := _mm_read_UBYTE(modreader);
    end;
    if (cmp and 8) <> 0 then
    begin
      inc(res);
      n^.eff := _mm_read_UBYTE(modreader);
    end;
    if (cmp and 16) <> 0 then
    begin
      inc(res);
      n^.dat := _mm_read_UBYTE(modreader);
    end;
  end else
  begin
    n^.note := cmp;
    n^.ins := _mm_read_UBYTE(modreader);
    n^.vol := _mm_read_UBYTE(modreader);
    n^.eff := _mm_read_UBYTE(modreader);
    n^.dat := _mm_read_UBYTE(modreader);
    inc(res, 4);
  end;
  result := res;
end;

function XM_Convert(xmtrack: PXMNOTE; rows: UWORD): PBYTE;
var
  t                 : integer;
  note, ins, vol, eff, dat: UBYTE;

begin

  UniReset();

  for t := 0 to rows - 1 do
  begin
    note := xmtrack^.note;
    ins := xmtrack^.ins;
    vol := xmtrack^.vol;
    eff := xmtrack^.eff;
    dat := xmtrack^.dat;

    if note <> 0 then
    begin
      if (note > XMNOTECNT) then
        UniEffect(29{ord(UNI_KEYFADE)}, 0)
      else
        UniNote(note - 1);
    end;
    if (ins <> 0) then UniInstrument(ins - 1);

    case (vol shr 4) of
      $6:                               //* volslide down */
        if (vol and $F) <> 0 then UniEffect(33{ord(UNI_XMEFFECTA)}, vol and $F);
      $7:                               //* volslide up */
        if (vol and $F) <> 0 then UniEffect(33{ord(UNI_XMEFFECTA)}, vol shl 4);
      //* volume-row fine volume slide is compatible with protracker
      //   EBx and EAx effects i.e. a zero nibble means DO NOT SLIDE, as
      //	   opposed to 'take the last sliding value'. */
      $8:                               //* finevol down */
        UniPTEffect($E, $B0 or (vol and $F));
      $9:                               //* finevol up */
        UniPTEffect($E, $A0 or (vol and $F));
      $A:                               //* set vibrato speed */
        UniEffect(11{ord(UNI_XMEFFECT4)}, vol shl 4);
      $B:                               //* vibrato */
        UniEffect(11{ord(UNI_XMEFFECT4)}, vol and $F);
      $C:                               //* set panning */
        UniPTEffect($8, vol shl 4);
      $D:                               //* panning slide left (only slide when data not zero) */
        if (vol and $F) <> 0 then UniEffect(41{ord(UNI_XMEFFECTP)}, vol and $F);
      $E:                               //* panning slide right (only slide when data not zero) */
        if (vol and $F) <> 0 then UniEffect(41{ord(UNI_XMEFFECTP)}, vol shl 4);
      $F:                               //* tone porta */
        UniPTEffect($3, vol shl 4);
    else
      if (vol >= $10) and (vol <= $50) then
        UniPTEffect($C, vol - $10);
    end;

    case (eff) of
      $4:
        UniEffect(31{ord(UNI_XMEFFECT4)}, dat);
      $6:
        UniEffect(32{ord(UNI_XMEFFECT6)}, dat);
      $A:
        UniEffect(33{ord(UNI_XMEFFECTA)}, dat);
      $E:                               //* Extended effects */
        case (dat shr 4) of
          $1:                           //* XM fine porta up */
            UniEffect(34{ord(UNI_XMEFFECTE1)}, dat and $F);
          $2:                           //* XM fine porta down */
            UniEffect(35{ord(UNI_XMEFFECTE2)}, dat and $F);
          $A:                           //* XM fine volume up */
            UniEffect(36{ord(UNI_XMEFFECTEA)}, dat and $F);
          $B:                           //* XM fine volume down */
            UniEffect(37{ord(UNI_XMEFFECTEB)}, dat and $F);
        else
          UniPTEffect(eff, dat);
        end;
      (ord('G') - 55):                  //* G - set global volume */
        UniEffect(38{ord(UNI_XMEFFECTG)}, InlineIf((dat > 64), UWORD(128), UWORD(dat shl 1)));
      (ord('H') - 55):                  //* H - global volume slide */
        UniEffect(39{ord(UNI_XMEFFECTH)}, dat);
      (ord('K') - 55):                  //* K - keyOff and KeyFade */
        UniEffect(29{ord(UNI_KEYFADE)}, dat);
      (ord('L') - 55):                  //* L - set envelope position */
        UniEffect(40{ord(UNI_XMEFFECTL)}, dat);
      (ord('P') - 55):                  //* P - panning slide */
        UniEffect(41{ord(UNI_XMEFFECTP)}, dat);
      (ord('R') - 55):                  //* R - multi retrig note */
        UniEffect(24{ord(UNI_S3MEFFECTQ)}, dat);
      (ord('T') - 55):                  //* T - Tremor */
        UniEffect(23{ord(UNI_S3MEFFECTI)}, dat);
      (ord('X') - 55):
        case (dat shr 4) of
          1:                            //* X1 - Extra Fine Porta up */
            UniEffect(42{ord(UNI_XMEFFECTX1)}, dat and $F);
          2:                            //* X2 - Extra Fine Porta down */
            UniEffect(43{ord(UNI_XMEFFECTX2)}, dat and $F);

        end;
    else
      if (eff <= $F) then
      begin
        //* the pattern jump destination is written in decimal,
        //   but it seems some poor tracker software writes them
        //   in hexadecimal... (sigh) */
        if (eff = $D) then
          //* don't change anything if we're sure it's in hexa */
          if ((((dat and $F0) shr 4) <= 9) and ((dat and $F) <= 9)) then
            //* otherwise, convert from dec to hex */
            dat := (((dat and $F0) shr 4) * 10) + (dat and $F);
        UniPTEffect(eff, dat);
      end;
    end;
    UniNewline();
    inc(xmtrack);
  end;
  result := UniDup();
end;

function LoadPatterns(dummypat: BOOL): BOOL;
var
  t, u, v, numtrk   : integer;
  ph                : XMPATHEADER;
begin
  if (AllocTracks() = 0) then
  begin
    result := 0;
    exit;
  end;

  if (AllocPatterns() = 0) then
  begin
    result := 0;
    exit;
  end;

  numtrk := 0;

  for t := 0 to mh^.numpat - 1 do
  begin
    ph.size := _mm_read_I_ULONG(modreader);
    if ph.size < InlineIf((mh^.version = $0102), ULONG(8), ULONG(9)) then
    begin
      _mm_errno := 7;//MMERR_LOADING_PATTERN;
      result := 0;
      exit;
    end;

    ph.packing := _mm_read_UBYTE(modreader);
    if (ph.packing <> 0) then
    begin
      _mm_errno := 7;//MMERR_LOADING_PATTERN;
      result := 0;
      exit;
    end;

    if (mh^.version = $0102) then
      ph.numrows := _mm_read_UBYTE(modreader) + 1
    else
      ph.numrows := _mm_read_I_UWORD(modreader);

    ph.packsize := _mm_read_I_UWORD(modreader);

    ph.size := ph.size - InlineIf((mh^.version = $0102), ULONG(8), ULONG(9));
    if (ph.size <> 0) then modreader.position := modreader.position + ph.size;

    PUWORDARRAY(_of.pattrows)[t] := ph.numrows;

    if (ph.numrows <> 0) then
    begin
      xmpat := _mm_calloc(ph.numrows * _of.numchn, sizeof(XMNOTE));
      if xmpat = nil then
      begin
        result := 0;
        exit;
      end;

      //* when packsize is 0, don't try to load a pattern.. it's empty. */
      if (ph.packsize <> 0) then
        for u := 0 to ph.numrows - 1 do
          for v := 0 to _of.numchn - 1 do
          begin
            if ph.packsize = 0 then break;
            ph.packsize := ph.packsize - XM_ReadNote(@PXMNOTEARRAY(xmpat)[(v * ph.numrows) + u]);
            if (ph.packsize < 0) then
            begin
              FreeMem(xmpat);
              xmpat := nil;
              _mm_errno := 7;//MMERR_LOADING_PATTERN;
              result := 0;
              exit;
            end;
          end;

      if (ph.packsize <> 0) then
        modreader.position := modreader.position + ph.packsize;

      if modreader.position > modreader.size then
      begin
        FreeMem(xmpat);
        xmpat := nil;
        _mm_errno := 7;//MMERR_LOADING_PATTERN;
        result := 0;
        exit;
      end;

      for v := 0 to _of.numchn - 1 do
      begin
        PPointerArray(_of.tracks)[numtrk] := XM_Convert(@PXMNOTEARRAY(xmpat)[v * ph.numrows], ph.numrows);
        inc(numtrk);
      end;

      freeMem(xmpat);
      xmpat := nil;
    end else
    begin
      for v := 0 to _of.numchn - 1 do
      begin
        PPointerArray(_of.tracks)[numtrk] := XM_Convert(nil, ph.numrows);
        inc(numtrk);
      end;
    end;
  end;

  if (dummypat <> 0) then
  begin
    PUWORDARRAY(_of.pattrows)[t] := 64;
    xmpat := _mm_calloc(64 * _of.numchn, sizeof(XMNOTE));

    if xmpat = nil then
    begin
      result := 0;
      exit;
    end;

    for v := 0 to _of.numchn - 1 do
    begin
      PPointerArray(_of.tracks)[numtrk] := XM_Convert(@PXMNOTEARRAY(xmpat)[v * 64], 64);
      inc(numtrk);
    end;
    freeMem(xmpat);
    xmpat := nil;
  end;

  result := 1;
end;

procedure FixEnvelope(cur: PENVPT; pts: integer);
var

  u, old, tmp       : integer;
  prev              : PENVPT;

begin

  //* Some broken XM editing program will only save the low byte
  //   of the position value. Try to compensate by adding the
  //   missing high byte. */

  prev := cur;
  inc(cur);
  old := prev^.pos;

  for u := 1 to pts - 1 do
  begin

    if (cur^.pos < prev^.pos) then
    begin
      if (cur^.pos < $100) then
      begin
        if (cur^.pos > old) then        //* same hex century */
          tmp := cur^.pos + (prev^.pos - old)
        else
          tmp := cur^.pos or ((prev^.pos + $100) and $FF00);
        old := cur^.pos;
        cur^.pos := tmp;

      end else
      begin

        old := cur^.pos;
      end;
    end else
      old := cur^.pos;

    inc(prev);
    inc(cur);
  end;
end;

function LoadInstruments(): BOOL;

var

  t, u              : integer;
  d                 : PINSTRUMENT;
  next              : ULONG;
  wavcnt            : UWORD;
  ih                : XMINSTHEADER;
  headend           : longint;

  pth               : XMPATCHHEADER;
  p                 : integer;

begin
  next := 0;
  wavcnt := 0;

  if AllocInstruments() = 0 then
  begin
    result := 0;
    exit;
  end;

  d := _of.instruments;
  for t := 0 to _of.numins - 1 do
  begin

    memset(@d^.samplenumber, 255, 120{INSTNOTES} * sizeof(UWORD));

    // read instrument header */
    headend := modreader.position;
    ih.size := _mm_read_I_ULONG(modreader);
    headend := headend + ih.size;
    modreader.Read(ih.name, 22);
    ih._type := _mm_read_UBYTE(modreader);
    ih.numsmp := _mm_read_I_UWORD(modreader);

    getmem(d^.insname, strlen(@ih.name) + 1);
    strcpy(d^.insname, @ih.name);

    if SWORD(ih.size) > 29 then
    begin
      ih.ssize := _mm_read_I_ULONG(modreader);
      if ((SWORD(ih.numsmp) > 0) and (ih.numsmp <= XMNOTECNT)) then
      begin

        //_mm_read_UBYTES (pth.what,XMNOTECNT,modreader);

        modreader.read(pth.what, XMNOTECNT);

        _mm_read_I_UWORDS(@pth.volenv, XMENVCNT, modreader);
        _mm_read_I_UWORDS(@pth.panenv, XMENVCNT, modreader);

        pth.volpts := _mm_read_UBYTE(modreader);
        pth.panpts := _mm_read_UBYTE(modreader);
        pth.volsus := _mm_read_UBYTE(modreader);
        pth.volbeg := _mm_read_UBYTE(modreader);
        pth.volend := _mm_read_UBYTE(modreader);
        pth.pansus := _mm_read_UBYTE(modreader);
        pth.panbeg := _mm_read_UBYTE(modreader);
        pth.panend := _mm_read_UBYTE(modreader);
        pth.volflg := _mm_read_UBYTE(modreader);
        pth.panflg := _mm_read_UBYTE(modreader);
        pth.vibflg := _mm_read_UBYTE(modreader);
        pth.vibsweep := _mm_read_UBYTE(modreader);
        pth.vibdepth := _mm_read_UBYTE(modreader);
        pth.vibrate := _mm_read_UBYTE(modreader);
        pth.volfade := _mm_read_I_UWORD(modreader);

        // read the remainder of the header
        //   (2 bytes for 1.03, 22 for 1.04) */
        u := headend - modreader.position;
        while u <> 0 do
        begin
          _mm_read_UBYTE(modreader);
          dec(u);
        end;

        // we can't trust the envelope point count here, as some
        //   modules have incorrect values (K_OSPACE.XM reports 32 volume
        //   points, for example). */
        if (pth.volpts > XMENVCNT div 2) then pth.volpts := XMENVCNT div 2;
        if (pth.panpts > XMENVCNT div 2) then pth.panpts := XMENVCNT div 2;

        if (modreader.position > modreader.size) or (pth.volpts > XMENVCNT div 2)
          or (pth.panpts > XMENVCNT div 2) then
        begin
          if (nextwav <> nil) then
          begin
            freemem(nextwav);
            nextwav := nil;
          end;
          if (wh <> nil) then
          begin
            freemem(wh);
            wh := nil;
          end;
          _mm_errno := 10;//MMERR_LOADING_SAMPLEINFO;
          result := 0;
          exit;
        end;

        for u := 0 to XMNOTECNT - 1 do
          d^.samplenumber[u] := pth.what[u] + _of.numsmp;
        d^.volfade := pth.volfade;

        //========================================Vol

        for u := 0 to (XMENVCNT shr 1) - 1 do
        begin
          d^.volenv[u].pos := pth.volenv[u shl 1];
          d^.volenv[u].val := pth.volenv[(u shl 1) + 1];
        end;
        if (pth.volflg and 1) <> 0 then d^.volflg := d^.volflg or 1;//EF_ON;
        if (pth.volflg and 2) <> 0 then d^.volflg := d^.volflg or 2;//EF_SUSTAIN;
        if (pth.volflg and 4) <> 0 then d^.volflg := d^.volflg or 4;//EF_LOOP;
        d^.volsusbeg := pth.volsus;
        d^.volsusend := pth.volsus;
        d^.volbeg := pth.volbeg;
        d^.volend := pth.volend;
        d^.volpts := pth.volpts;

        // scale envelope */
        for p := 0 to (XMENVCNT div 2) - 1 do
          d^.volenv[p].val := d^.volenv[p].val shl 2;

        if (d^.volflg and 1{EF_ON} <> 0) and (d^.volpts < 2) then
          d^.volflg := d^.volflg and (not 1{EF_ON});

        //========================================Pan

        for u := 0 to (XMENVCNT shr 1) - 1 do
        begin
          d^.panenv[u].pos := pth.panenv[u shl 1];
          d^.panenv[u].val := pth.panenv[(u shl 1) + 1];
        end;
        if (pth.panflg and 1) <> 0 then d^.panflg := d^.panflg or 1{EF_ON};
        if (pth.panflg and 2) <> 0 then d^.panflg := d^.panflg or 2;//EF_SUSTAIN;
        if (pth.panflg and 4) <> 0 then d^.panflg := d^.panflg or 4;//EF_LOOP;
        d^.pansusbeg := pth.pansus;
        d^.pansusend := pth.pansus;
        d^.panbeg := pth.panbeg;
        d^.panend := pth.panend;
        d^.panpts := pth.panpts;

        // scale envelope */
        for p := 0 to (XMENVCNT div 2) - 1 do
          d^.panenv[p].val := d^.panenv[p].val shl 2;

        if (d^.panflg and 1{EF_ON} <> 0) and (d^.panpts < 2) then
          d^.panflg := d^.panflg and (not 1{EF_ON});

        if (d^.volflg and 1{EF_ON} <> 0) then
          FixEnvelope(@d^.volenv, d^.volpts);
        if (d^.panflg and 1{EF_ON} <> 0) then
          FixEnvelope(@d^.panenv, d^.panpts);

        // Samples are stored outside the instrument struct now, so we
        //   have to load them all into a temp area, count the of.numsmp
        //   along the way and then do an AllocSamples() and move
        //   everything over */
        if (mh^.version > $0103) then next := 0;
        for u := 0 to ih.numsmp - 1 do
        begin
          // Allocate more room for sample information if necessary */
          if (_of.numsmp + u = wavcnt) then
          begin
            wavcnt := wavcnt + XM_SMPINCR;

            nextwav := ReallocMemory(nextwav, wavcnt * sizeof(ULONG));

            if nextwav = nil then
            begin
              if (wh <> nil) then
              begin
                freemem(wh);
                wh := nil;
              end;
              _mm_errno := 2;//MMERR_OUT_OF_MEMORY;
              result := 0;
              exit;
            end;

            wh := ReallocMemory(wh, wavcnt * sizeof(XMWAVHEADER));

            if wh = nil then
            begin
              freemem(nextwav);
              nextwav := nil;
              _mm_errno := 2;//MMERR_OUT_OF_MEMORY;
              result := 0;
              exit;
            end;

            s := wh;
            inc(wh, wavcnt - XM_SMPINCR);
          end;

          s^.length := _mm_read_I_ULONG(modreader);
          s^.loopstart := _mm_read_I_ULONG(modreader);
          s^.looplength := _mm_read_I_ULONG(modreader);
          s^.volume := _mm_read_UBYTE(modreader);
          s^.finetune := _mm_read_SBYTE(modreader);
          s^._type := _mm_read_UBYTE(modreader);
          s^.panning := _mm_read_UBYTE(modreader);
          s^.relnote := _mm_read_SBYTE(modreader);
          s^.vibtype := pth.vibflg;
          s^.vibsweep := pth.vibsweep;
          s^.vibdepth := pth.vibdepth * 4;
          s^.vibrate := pth.vibrate;
          s^.reserved := _mm_read_UBYTE(modreader);

          modreader.read(s^.samplename, 22);

          PULONGARRAY(nextwav)[_of.numsmp + u] := next;
          next := next + s^.length;

          if modreader.Position > modreader.size then
          begin
            freemem(nextwav);
            freemem(wh);
            nextwav := nil;
            wh := nil;
            _mm_errno := 10;//MMERR_LOADING_SAMPLEINFO;
            result := 0;
            exit;
          end;
          inc(s);
        end;

        if (mh^.version > $0103) then
        begin
          for u := 0 to ih.numsmp - 1 do
          begin
            PULONGARRAY(nextwav)[_of.numsmp] := PULONGARRAY(nextwav)[_of.numsmp] + modreader.Position;
            inc(_of.numsmp);
          end;
          modreader.Position := modreader.Position + next;
        end else
          _of.numsmp := _of.numsmp + ih.numsmp;
      end else
      begin
        // read the remainder of the header */
        u := headend - modreader.Position;
        while u <> 0 do
        begin
          _mm_read_UBYTE(modreader);
          dec(u);
        end;

        if modreader.Position > modreader.size then
        begin
          freemem(nextwav);
          freemem(wh);
          nextwav := nil;
          wh := nil;
          _mm_errno := 10;//MMERR_LOADING_SAMPLEINFO;
          result := 0;
          exit;
        end;
      end;
    end;
    inc(d);
  end;

  // sanity check */
  if (_of.numsmp = 0) then
  begin
    if (nextwav <> nil) then
    begin
      freemem(nextwav);
      nextwav := nil;
    end;
    if (wh <> nil) then
    begin
      freemem(wh);
      wh := nil;
    end;
    _mm_errno := 10;//MMERR_LOADING_SAMPLEINFO;
    result := 0;
    exit;
  end;

  result := 1;
end;

function XM_Load(curious: BOOL): BOOL;
var
  d                 : PINSTRUMENT;
  q                 : PSAMPLE;
  t, u              : integer;
  dummypat          : BOOL;
  note              : integer;
  tmptrackername:string;
  bufstr : string;
begin
  dummypat := 0;

  /// try to read module header */
  modreader.read(mh^.id, 17);
  modreader.read(mh^.songname, 21);
  modreader.read(mh^.trackername, 20);

  mh^.version := _mm_read_I_UWORD(modreader);
  if ((mh^.version < $102) or (mh^.version > $104)) then
  begin
    _mm_errno := 11;//MMERR_NOT_A_MODULE;
    result := 0;
    exit;
  end;
  mh^.headersize := _mm_read_I_ULONG(modreader);
  mh^.songlength := _mm_read_I_UWORD(modreader);
  mh^.restart := _mm_read_I_UWORD(modreader);
  mh^.numchn := _mm_read_I_UWORD(modreader);
  mh^.numpat := _mm_read_I_UWORD(modreader);
  mh^.numins := _mm_read_I_UWORD(modreader);
  mh^.flags := _mm_read_I_UWORD(modreader);
  mh^.tempo := _mm_read_I_UWORD(modreader);
  mh^.bpm := _mm_read_I_UWORD(modreader);
  if (mh^.bpm = 0) then
  begin
    _mm_errno := 11;//MMERR_NOT_A_MODULE;
    result := 0;
    exit;
  end;
  _mm_read_UBYTES(@mh^.orders, 256, modreader);

  if modreader.Position > modreader.size then
  begin
    _mm_errno := 9;//MMERR_LOADING_HEADER;
    result := 0;
    exit;
  end;

  // set module variables */
  _of.initspeed := mh^.tempo;
  _of.inittempo := mh^.bpm;


  // some modules have the tracker name empty */
  //if (!tracker[0])
  //	strcpy(tracker,"Unknown tracker");
  if mh^.trackername[0]=#0 then tmptrackername := 'Unknown tracker' else
  tmptrackername:=Trim(mh^.trackername);

 // tmptrackername := Format('%s (XM format %d.20%d)', [tmptrackername,
 // mh^.version shr 8,mh^.version and $ff]);

  Str(mh^.version shr 8, BufStr);
  tmptrackername := tmptrackername + ' (XM format ' + BufStr;
  Str(mh^.version and $ff, BufStr);
  tmptrackername := tmptrackername + '.20' + BufStr + ')';

  getmem(_of.modtype,length(tmptrackername)+1);
  strcpy(_of.modtype,PChar(tmptrackername));

  _of.numchn := mh^.numchn;
  _of.numpat := mh^.numpat;
  _of.numtrk := UWORD(_of.numpat) * _of.numchn; // get number of channels */

  Getmem(_of.songname, 20);
  Move(mh^.songname,_of.songname^,19);

  _of.numpos := mh^.songlength;         // copy the songlength */
  _of.reppos := InlineIf((mh^.restart < mh^.songlength), mh^.restart, 0);
  _of.numins := mh^.numins;
  _of.flags := _of.flags or $0001{UF_XMPERIODS} or $0004{UF_INST} or $0080{UF_NOWRAP} or $0200{UF_FT2QUIRKS}
    or $0400{UF_PANNING};
  if (mh^.flags and 1) <> 0 then _of.flags := _of.flags or $0002;//UF_LINEAR;
  _of.bpmlimit := 32;

  memset(@_of.chanvol, 64, _of.numchn); // store channel volumes */

  if (AllocPositions(_of.numpos + 1) = 0) then
  begin
    result := 0;
    exit;
  end;

  for t := 0 to _of.numpos - 1 do
    PUWORDARRAY(_of.positions)[t] := mh^.orders[t];

  // We have to check for any pattern numbers in the order list greater than
  //   the number of patterns total. If one or more is found, we set it equal to
  //   the pattern total and make a dummy pattern to workaround the problem */
  for t := 0 to _of.numpos - 1 do
  begin
    if (PUWORDARRAY(_of.positions)[t] >= _of.numpat) then
    begin
      PUWORDARRAY(_of.positions)[t] := _of.numpat;
      dummypat := 1;
    end;
  end;
  if (dummypat <> 0) then
  begin
    inc(_of.numpat);
    _of.numtrk := _of.numtrk + _of.numchn;
  end;

  if (mh^.version < $0104) then
  begin
    if (LoadInstruments() = 0) then
    begin
      result := 0;
      exit;
    end;
    if (LoadPatterns(dummypat) = 0) then
    begin
      result := 0;
      exit;
    end;

    for t := 0 to _of.numsmp - 1 do
      PULONGARRAY(nextwav)[t] := PULONGARRAY(nextwav)[t] + modreader.Position;
  end else
  begin
    if (LoadPatterns(dummypat) = 0) then
    begin
      result := 0;
      exit;
    end;

    if (LoadInstruments() = 0) then
    begin
      result := 0;
      exit;
    end;

  end;

  if (AllocSamples() = 0) then
  begin
    freemem(nextwav);
    freemem(wh);
    nextwav := nil;
    wh := nil;
    result := 0;
    exit;
  end;

  q := _of.samples;
  s := wh;
  for u := 0 to _of.numsmp - 1 do
  begin

   // getmem(q^.samplename, strlen(s^.samplename) + 1);
   // strcpy(q^.samplename, @s^.samplename);
    q^.length := s^.length;
    q^.loopstart := s^.loopstart;
    q^.loopend := s^.loopstart + s^.looplength;
    q^.volume := s^.volume;
    q^.speed := s^.finetune + 128;
    q^.panning := s^.panning;
    q^.seekpos := PULONGARRAY(nextwav)[u];
    q^.vibtype := s^.vibtype;
    q^.vibsweep := s^.vibsweep;
    q^.vibdepth := s^.vibdepth;
    q^.vibrate := s^.vibrate;

    if (s^._type and $10) <> 0 then
    begin
      q^.length := q^.length shr 1;
      q^.loopstart := q^.loopstart shr 1;
      q^.loopend := q^.loopend shr 1;
    end;

    q^.flags := q^.flags or $1000{SF_OWNPAN} or $0010{SF_DELTA} or $0004;//SF_SIGNED;
    if (s^._type and $3) <> 0 then q^.flags := q^.flags or $0100;//SF_LOOP;
    if (s^._type and $2) <> 0 then q^.flags := q^.flags or $0200;//SF_BIDI;
    if (s^._type and $10) <> 0 then q^.flags := q^.flags or $0001;//SF_16BITS;

    inc(q);
    inc(s);
  end;

  d := _of.instruments;
  s := wh;
  for u := 0 to _of.numins - 1 do
  begin
    for t := 0 to XMNOTECNT - 1 do
    begin
      if (d^.samplenumber[t] >= _of.numsmp) then
        d^.samplenote[t] := 255
      else
      begin
        note := t + PXMWAVHEADERARRAY(s)[d^.samplenumber[t]].relnote;
        d^.samplenote[t] := InlineIf((note < 0), 0, note);
      end;
    end;
    inc(d);
  end;
  freemem(wh);
  freemem(nextwav);
  wh := nil;
  nextwav := nil;
  result := 1;
end;

function XM_LoadTitle(): PCHAR;
var
  s                 : array[0..20] of char;
begin
  result := nil;
  modreader.Position := 17;
  modreader.Read(s, 21);
  if strlen(s) > 0 then
  begin
    getmem(result, strlen(s) + 1);
    strcpy(result, @s);
  end;
end;

initialization
  with _load_xm do
  begin
    next := nil;
    _type := 'XM';
    version := 'XM (FastTracker 2)';
    Init := XM_Init;
    Test := XM_Test;
    Load := XM_Load;
    Cleanup := XM_Cleanup;
    LoadTitle := XM_LoadTitle;
  end;
  _mm_registerloader(@_load_xm);

end.

