Amiga ISO Collection/AmigaUtilCD2.iso/Programming/E/TFF-A32R.LZX/AmigaE3.2a/Src/Lang/NGRC.e

Text File | 1996-06-06 | 21.3 KB | 743 lines

/* Noise Compiler v1.0

Short:    The noise compiler is a program that translates source files in
    a type of "music programming language" into Noise/ProTracker (tm)
    compatible files.

The noise compiler reads ascii source files containing a description
of a musical piece, and then starts generating a sequence of notes by
recursively walking down your definition. finally, it will load all
samples and write all data to a ProTracker (tm) file.

A noise grammar program (extension ".ngr") consist of one to unlimited
number of so called "rules" (it really helps if you already know something
about context free grammars). Each rule looks like:

<sym> "->" <symlist> ";"

example:

beat -> drum [C#,1]                     /* a C-flat */
        { [D,2] | [D#,2] | [Db,2] }     /* D, D-sharp, D-flat */
        ( boomboom 1 );                 /* index=1 */

every token may be separated by a whitespace, which denotes any number of
spaces/tabs/linefeeds, and comments which start with "/*" and end
with "*/", and may be nested infinitely.

a <symlist> is one or more <item>s. an <item> can be:

    <sym> <index>

will be recursively replaced by the definition of <sym>.
<index> is optional and explained later
example: drum

    "(" <weight> <symlist> ")"

as <sym>, only an optional <weight> (default=500, range 0-1000) specifies
the chance of <symlist> getting rewritten, with 0=no chance at all.
example:

(beat)        (250 beat)

decide while generating if the defintion for "beat" gets played or
not, resp. 50% and 25% chance.

    "{" <weight> <symlist> "|" ..... "}"

any number of <symlist>s may be between the {}, separated by a bar |.
<weight> is again optional, and again between 0-1000, only now
the default =1. With no weights, simply one of the <simlist>s is
picked. examples:

{ beat | boomboom | [Gb+,4] }        /* chances: each 33% */
{ 3 beat | 7 boomboom }            /* chances: 30%,70% resp. */

    <samplename> <vol>

an AmigaDos path to a sample, <vol> is an optional integer, range 0-64
example: "samples:guitar.iff"

    "[" <note> "," <duration> "]"

a note specification, see below.

    <hexinteger>

a special effects spec., see below.

Notes.
a <note> is a character like:  C D E F G A B
it may be followed by any number of modifiers, where:

"#" = sharp
"b" = flat
"+" = octave up
"-" = octave down

in general, you can get only one octave up/down, and the parser will
give an error if you write something like "E+++"
Any number of "#" and "b" are allowed, only in general you would
write "D" for "C##", or "F" for "E#" etc. Note that the current
version of the noise compiler only allows for C-major. Examples:

C    C (the one in the middle of a piano)
C#+    C-sharp one octave up
Dbb-    C one octave down

for those who are not at all familiar with classical notes, a note
may also be specified as an integer ranging from -12 to 23, with
0 being the middle C again, and negative numbers lower notes.

the <duration> is an integer specifying the time in units spent
on playing the note, before starting the new one, range = 1-100
A unit is about a quarter of a normal note, so a whole note should
be written "4" etc. examples:

[C,1]
[F#,4]         /* an F-sharp for one second */


Sound Effects.
various souneffects may be used as an hexadecimal integer.
Such an effect only works with the next following note.
Example:

mainpart -> $E01 drums solo drums

puts hardware audio filter off before play. See protracker documentation
for a summary of effects.

Indexing.
while () and {|||} are nice ways to either generate totally random music, or
just make your pieces sound more natural due to some variation, one often
wishes to have the random choices made repeated: for example, if
you design a symbol "beat" that you wish to re-use in certain parts of
your program, and the definition contains some random-variation, you
may want to have the random choices fixed for the second time you use it,
because it would sound totally random otherwise. for example, considering
the pseudo-definition of "beat" above:

beats -> beat boomboom beat boomboom;

this looks like a normal rhytm, but "beat" is replaced by two different
sequences of notes. with:

beats -> beat1 boomboom2 beat1 boomboom2;

you specify that with the first "beat", the random choices are recorded
and all others that are similar indexed will have their notes generated
according to the first. note that this doesn't work for samples, i.e:

beats -> "bass.iff" beat1 "hihat.iff" beat1;

will generate two exactly the same sequences, only played by different
instruments.


Symbols and Channels.
A symbol consists of any number of lowercase characters. As the
Amiga plays four channels simulanously, there's not one start
symbol for the grammar, but four, called: "one", "two", "three",
"four". Atleast one of these has to be defined in a grammar.
Example:

one -> "dat:noiz/Dguitar" 20 aa1;
two -> "dat:noiz/drumz/bassdrum" aa1;

aa -> a $E00 a $E01 a a;

a -> { c d c c d d | d d | c d c d | c c };

c -> [C,1] [C#,3];
d -> [D,2] [D,3];

plays the sequence "aa" simultanously over two channels, by two
different instruments, with volumes 20 and 64. the sequence "aa"
consists of several instances of "a", while switching filter
on/off. "a" consist of 4 possible sequences, which in turn
consist of notes to be played. (NOTE: don't try these examples,
they no pieces of real music, just "examples")


Designing Tunes.
For example, for a small guitar tune, we would start with
a defintion of some notes, a and b

a -> [D,1] [E,3];
b -> [D,1] [D#,7];

Then, we would combine them into a sequence:

c -> a a a b;

Finally, we play those over channel one, and define a sample:

one -> guitar c c c a [C,16];          /* just one channel */

/* our set of instruments */
guitar -> "dat:noiz/Dguitar";

note that notes get played by a certain instrument from the point it
is encountered in the grammar.


Using Randomness.
You may use randomness to bring subtle variations into your music,
for example, with:

mynote -> { 10 [D,2] | 1 [D#,2] | 1 [Db,2] };

we define a note that is played like a "D" most of the time, but
occasionally flat or sharp. We can easily do the same thing with
the duration, or even with the order a certain sequence gets played.

*/

OBJECT sym            /* primairy structure of rewrite symbols */
  next,type,name,rptr
ENDOBJECT

OBJECT rlist            /* linked list structure for grammar     */
  next,type,index,info
ENDOBJECT

OBJECT optset            /* structure for storing { | | } exp.    */
  next,rptr,weight
ENDOBJECT

OBJECT sample            /* all data about a given sample         */
  path,len,adr,vol
ENDOBJECT

OBJECT i            /* indexing of rewritten trees           */
  start,len,isym
ENDOBJECT

ENUM SYM,OPTSET,OPTION,NOTE,SAMPLE,SFX        /* rlist.type    */
ENUM NOTYPE,REWRITE                /* sym.type    */
ENUM NOMEM,NOFILE,NOFORM,NOGRAM,STACKFLOW,    /* errors    */
     BADSTRUCTURE,BREAK,WRITEMOD,READSAMPLE

CONST MAXINDEX=1000,MAXROWS=64*4*64,MAXDURATION=100
CONST MAXDATA=MAXROWS*4,MAXSAMPLE=31,MAXNOTE=23,MINNOTE=-12
CONST PARSE_ER=100,GEN_ER=200,MASK=$0FFF0FFF

RAISE NOMEM IF New()=NIL,            /* define exceptions */
      NOMEM IF String()=NIL,
      STACKFLOW IF FreeStack()<1000,
      BREAK IF CtrlC()=TRUE

DEF buf,flen,p,tokeninfo,symlist=NIL:PTR TO sym,ltoken=-1,numsample=0,
    notes,np:PTR TO LONG,maxrows=0,cursample=0,cursfx=0,curglob=0,end,
    timings:PTR TO INT,fh=NIL,notevals:PTR TO LONG

DEF sdata[32]:ARRAY OF sample,
    itab[MAXINDEX]:ARRAY OF i,
    channel[4]:ARRAY OF i,
    infile[100]:STRING,outfile[100]:STRING

PROC main() HANDLE
  WriteF('Noise Compiler v1.0\n')
  WriteF('Translates NoiseGrammar programs into ProTracker modules!\n')
  readgrammar()
  WriteF('grammar "\s" loaded. Parsing...\n',infile)
  parsegrammar()
  WriteF('Grammar parsed succesfully. Generating...\n')
  generate()
  WriteF('Noise generated. Now loading samples...\n')
  loadsamples()
  WriteF('Now saving to file "\s".\n',outfile)
  writemodule()
  WriteF('done.\n')
EXCEPT
  IF fh THEN Close(fh)           /* lowest level exception handler: */
  WriteF('Terminating: ')        /* general error report */
  SELECT exception
    CASE NOFILE;       WriteF('Could not load "\s" grammar file!\n',infile)
    CASE NOMEM;        WriteF('Not enough memory!\n')
    CASE NOFORM;       WriteF('Grammar format error!\n')
    CASE STACKFLOW;    WriteF('Stack overflow! (too heavy recursion?)\n')
    CASE BADSTRUCTURE; WriteF('Problems while generating.\n')
    CASE NOGRAM;       WriteF('No rules rewritten!\n')
    CASE BREAK;        WriteF('Stopped by user\n')
    CASE WRITEMOD;     WriteF('Unable to write PT module "\s"!\n',outfile)
    CASE READSAMPLE;   WriteF('Unable to read sample(s)!\n')
  ENDSELECT
  DeleteFile(outfile)
ENDPROC

PROC readgrammar()
  StrCopy(infile,arg,ALL)
  StrAdd(infile,'.ngr',ALL)    /* '#?.ngr' = NoizGRammar */
  StrCopy(outfile,arg,ALL)    /* '#?.mod' = ProTracker format */
  StrAdd(outfile,'.mod',ALL)
  IF (flen:=FileLength(infile))<1 THEN Raise(NOFILE)
  IF (fh:=Open(infile,OLDFILE))=NIL THEN Raise(NOFILE)
  IF Read(fh,buf:=New(flen+1),flen)<>flen THEN Raise(NOFILE)
  Close(fh)
  fh:=NIL
  buf[flen]:=";"        /* for parser */
ENDPROC

/* this is the parser part. we use a simple but powerfull top-down
   parser, and build our syntax tree here.                              */

ENUM ER_UNTOKEN=PARSE_ER,ER_UNEXPECTED,ER_QUOTE,ER_SYMEXP,ER_DOUBLE,
     ER_ARROWEXP,ER_RPARENTHEXP,ER_RBRACEEXP,ER_EMPTY,ER_EOLEXP,ER_RANGE,
     ER_COMMENT,ER_UNDEF,ER_RBRACKETEXP,ER_MAXSAMPLE,ER_NOSAMPLE,
     ER_INTEGEREXP,ER_COMMAEXP,ER_NOTEEXP

ENUM EOF,EOL,ARROW,BAR,COMMA,        /* ; -> | ,    */
     RSYM,INTEGER,HEXINTEGER,        /* sym 100 $E01    */
     ISTRING,NOTEVAL,            /* "" C#+    */
     LBRACE,RBRACE,LPARENTH,        /* { } (    */
     RPARENTH,LBRACKET,RBRACKET        /* ) [ ]    */

PROC parsegrammar() HANDLE
  DEF end,spot,sl:PTR TO sym,s,i
  notevals:=[9,11,0,2,4,5,7]
  p:=buf
  WHILE parserule() DO NOP
  p:=NIL
  IF (sl:=symlist)=NIL THEN Raise(NOGRAM)
  IF numsample=0 THEN Raise(ER_NOSAMPLE)
  REPEAT
    IF sl.type=NOTYPE            /* check for undefined symbols */
      s:=sl.name
      Raise(ER_UNDEF)
    ENDIF
  UNTIL (sl:=sl.next)=NIL
EXCEPT                         /* re-throw if unknown exception */
  IF exception>=PARSE_ER THEN WriteF('ERROR: ') ELSE Raise(exception)
  WriteF(ListItem(['Unexpected lexical item\n',
    'Unexpected characters in line!\n',
    'Unmatched quote "\n',
    'Symbol expected\n',
    'Double definition of symbol\n',           /* language errors */
    '"->" expected\n',
    '")" expected\n',
    '"}" expected\n',
    'Empty rewrite-list\n',
    'End of rule expected\n',
    'Integer/Note value out of range\n',
    'Incorrectly nested comment(s)\n',
    'No rule defined for symbol "\s"\n',
    '"]" expected\n',
    'Maximum of 32 samples exceeded\n',
    'Grammar needs atleast one sample\n',
    'Integer expected\n',
    '"," expected\n',
    'Note expected'],exception-PARSE_ER),s)
  IF p                /* display very nice error indication */
    IF p[-1]=";" THEN DEC p
    spot:=p
    WHILE (p[]--<>";") AND (p[]<>10) AND (p<>buf) DO NOP
    INC p
    spot:=spot-p+5
    end:=p
    WHILE (end[]<>";") AND (end[]++<>10) DO NOP
    end[]--:=0
    WriteF('LINE: \s\n',p)
    FOR i:=1 TO spot DO WriteF(' ')
    WriteF('^\n')
  ENDIF
  Raise(NOFORM)
ENDPROC

PROC parserule()
  DEF token,csym:PTR TO sym
  IF (token:=gettoken())=EOF
    RETURN FALSE
  ELSEIF token=RSYM
    csym:=tokeninfo
    IF csym.type<>NOTYPE THEN Raise(ER_DOUBLE)
    IF gettoken()<>ARROW THEN Raise(ER_ARROWEXP)
    csym.rptr:=parseitemlist()
    csym.type:=REWRITE
    IF gettoken()<>EOL THEN Raise(ER_EOLEXP)
  ELSE
    Raise(ER_SYMEXP)
  ENDIF
ENDPROC TRUE

PROC parseitemlist()
  DEF item:PTR TO rlist,prev:PTR TO rlist,ilist=NIL
  prev:={ilist}
  WHILE (item:=parseitem())<>NIL
    prev.next:=item
    prev:=item
  ENDWHILE
  IF ilist=NIL THEN Raise(ER_EMPTY)
ENDPROC ilist

PROC parseitem()
  DEF token,item:PTR TO rlist,t2,prev:PTR TO optset,
      curr:PTR TO optset,olist,totalw=0
  token:=gettoken()
  IF token=RSYM
    item:=New(SIZEOF rlist)
    item.type:=SYM
    item.info:=tokeninfo
    IF (t2:=gettoken())=INTEGER
      item.index:=checkinfo(1,MAXINDEX-1)
    ELSE
      putback(t2)
      item.index:=0
    ENDIF
  ELSEIF token=ISTRING
    item:=New(SIZEOF rlist)
    item.type:=SAMPLE
    sdata[numsample].path:=tokeninfo
    IF (t2:=gettoken())=INTEGER
      sdata[numsample].vol:=checkinfo(0,64)
    ELSE
      putback(t2)
      sdata[numsample].vol:=64
    ENDIF
    item.info:=numsample++
    IF numsample=MAXSAMPLE THEN Raise(ER_MAXSAMPLE)
  ELSEIF token=LBRACE          /* parse { | | ... } */
    item:=New(SIZEOF rlist)
    item.type:=OPTSET
    prev:={olist}
    REPEAT
      curr:=New(SIZEOF optset)
      IF (token:=gettoken())=INTEGER        /* check for weight */
        curr.weight:=checkinfo(0,1000)
      ELSE
        curr.weight:=1
        putback(token)
      ENDIF
      totalw:=totalw+curr.weight
      curr.rptr:=parseitemlist()
      prev.next:=curr
      prev:=curr
    UNTIL (token:=gettoken())<>BAR
    IF token<>RBRACE THEN Raise(ER_RBRACEEXP)
    item.info:=olist
    item.index:=totalw     /* we store weight here */
  ELSEIF token=LPARENTH
    item:=New(SIZEOF rlist)             /* parse ( ) */
    item.type:=OPTION
    IF (token:=gettoken())=INTEGER        /* check for weight */
      item.index:=checkinfo(0,1000)
    ELSE
      item.index:=500
      putback(token)
    ENDIF
    item.info:=parseitemlist()
    IF gettoken()<>RPARENTH THEN Raise(ER_RPARENTHEXP)
  ELSEIF token=LBRACKET
    item:=New(SIZEOF rlist)             /* parse [note,duration] */
    item.type:=NOTE
    token:=gettoken()
    IF (token<>INTEGER) AND (token<>NOTEVAL) THEN Raise(ER_NOTEEXP)
    item.info:=checkinfo(MINNOTE,MAXNOTE)
    IF gettoken()<>COMMA THEN Raise(ER_COMMAEXP)
    IF gettoken()<>INTEGER THEN Raise(ER_INTEGEREXP)
    item.index:=checkinfo(1,MAXDURATION)
    IF gettoken()<>RBRACKET THEN Raise(ER_RBRACKETEXP)
  ELSEIF token=HEXINTEGER
    item:=New(SIZEOF rlist)             /* parse $SFX */
    item.type:=SFX
    item.info:=checkinfo(0,$FFF)
  ELSEIF (token=EOL) OR (token=RBRACE) OR (token=RPARENTH) OR (token=BAR)
    putback(token)
    RETURN NIL
  ELSE
    Raise(ER_UNTOKEN)
  ENDIF
ENDPROC item

/* the lexical analyser: called by the parser each time it
   needs a token. attribute values are in "tokeninfo". allows
   for one symbol lookahead, with putback() function */

PROC gettoken()
  DEF c,x,start,len,syml:PTR TO sym,s,depth
  FreeStack(); CtrlC()
  IF ltoken<>-1
    x:=ltoken
    ltoken:=-1
    RETURN x
  ENDIF
  tokeninfo:=0
  parse:
  c:=p[]++
  SELECT c
    CASE ";"; RETURN IF buf+flen<p THEN p-- BUT EOF ELSE EOL
    CASE "|"; RETURN BAR
    CASE ","; RETURN COMMA
    CASE "("; RETURN LPARENTH
    CASE ")"; RETURN RPARENTH
    CASE "{"; RETURN LBRACE
    CASE "}"; RETURN RBRACE
    CASE "["; RETURN LBRACKET
    CASE "]"; RETURN RBRACKET
    CASE "-"; IF p[]=">" THEN RETURN p++ BUT ARROW
    CASE "/"
      IF p[]="*"
        x:=p
        depth:=1
        WHILE buf+flen>p++
          IF (p[0]="/") AND (p[1]="*")
            INC depth
            INC p
          ENDIF
          IF (p[0]="*") AND (p[1]="/")
            DEC depth
            INC p
          ENDIF
          IF depth=0
            INC p
            BRA parse
          ENDIF
        ENDWHILE
        p:=x
        Raise(ER_COMMENT)
      ENDIF
      Raise(ER_UNEXPECTED)
    CASE 34
      start:=p
      WHILE (p[]<>";") AND (p[]<>10) AND (p[]++<>34) DO NOP
      IF p[-1]=";" THEN p-- BUT Raise(ER_QUOTE)
      len:=p-start-1
      tokeninfo:=String(len)
      StrCopy(tokeninfo,start,len)
      RETURN ISTRING
    DEFAULT
      IF (c>="a") AND (c<="z")
        start:=p--
        WHILE (p[]>="a") AND (p[]++<="z") DO NOP
        len:=p---start
        s:=String(len)
        StrCopy(s,start,len)
        syml:=symlist
        WHILE syml
          IF StrCmp(s,syml.name,ALL) THEN BRA found
          syml:=syml.next
        ENDWHILE
        syml:=New(SIZEOF sym)
        syml.next:=symlist
        syml.name:=s
        syml.type:=NOTYPE
        symlist:=tokeninfo:=syml
        RETURN RSYM
        found:
        tokeninfo:=syml
        RETURN RSYM
      ELSEIF (c>="A") AND (c<="G")
        tokeninfo:=notevals[c-"A"]
        LOOP
          x:=p[]++
          SELECT x
            CASE "+"; tokeninfo:=tokeninfo+12        /* octave up    */
            CASE "-"; tokeninfo:=tokeninfo-12        /* octave down    */
            CASE "#"; tokeninfo:=tokeninfo+1        /* sharp    */
            CASE "b"; tokeninfo:=tokeninfo-1        /* flat        */
            DEFAULT
              DEC p
              RETURN NOTEVAL
          ENDSELECT
        ENDLOOP
      ELSEIF ((c>="0") AND (c<="9")) OR (c="-") OR (c="$")
        tokeninfo,x:=Val(p--)
        p:=p+x
        RETURN IF c="$" THEN HEXINTEGER ELSE INTEGER
      ENDIF
      IF c>32 THEN Raise(ER_UNEXPECTED) ELSE BRA parse
  ENDSELECT
ENDPROC

PROC putback(token)
  ltoken:=token
ENDPROC

PROC checkinfo(min,max) RETURN IF (tokeninfo<min) OR (tokeninfo>max) THEN
  Raise(ER_RANGE) ELSE tokeninfo

ENUM NOCHANNEL=GEN_ER,LARGESONG,CROSSINDEX

PROC generate() HANDLE
  DEF x,ci:PTR TO i,syms:PTR TO LONG,numc=0
  Rnd(-Shl(VbeamPos(),14))        /* initialise seed */
  ci:=itab
  FOR x:=0 TO MAXINDEX-1 DO ci[].start++:=NIL
  ci:=channel
  timings:=[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]:INT
  /*        C-  C#- D-  D#- E-  F-  F#- G-  G#- A-  A#- B-
            C   C#  D   D#  E   F   F#  G   G#  A   A#  B
            C+  C#+ D+  D#+ E+  F+  F#+ G+  G#+ A+  A#+ B+     */
  WriteF('s\d\n',MAXDURATION*4+100+MAXDATA)
  np:=notes:=New(MAXDURATION*4+100+MAXDATA)
  end:=np+MAXDATA
  syms:=['one','two','three','four']
  FOR x:=0 TO 3
    ci[x].start:=np
    IF findsym(syms[x])
      ci[x].len:=np-ci[x].start
      IF ci[x].len>maxrows THEN maxrows:=ci[x].len
      INC numc
    ELSE
      ci[x].start:=NIL
    ENDIF
  ENDFOR
  IF numc=0 THEN Raise(NOCHANNEL)
  IF maxrows=0 THEN Raise(NOGRAM)
  IF maxrows>MAXROWS THEN Raise(LARGESONG)
EXCEPT
  IF exception>=GEN_ER THEN WriteF('ERROR: ')
  SELECT exception
    CASE NOCHANNEL;  WriteF('Atleast one channel must be defined\n')
    CASE LARGESONG;  WriteF('Song too large!\n')
    CASE CROSSINDEX; WriteF('No cross-symbol indexing allowed\n')
    DEFAULT;         Raise(exception)         /* re-throw if unknown */
  ENDSELECT
  Raise(BADSTRUCTURE)        /* terminate */
ENDPROC

PROC findsym(name)
  DEF s:PTR TO sym
  s:=symlist
  WHILE s
    IF StrCmp(s.name,name,ALL) THEN BRA.S continue
    s:=s.next
  ENDWHILE
  RETURN FALSE
  continue:
  rewritelist(s.rptr)
ENDPROC TRUE

PROC rewritelist(list:PTR TO rlist)
  WHILE list
    rewritesym(list)
    list:=list.next
  ENDWHILE
ENDPROC

PROC rewritesym(rsym:PTR TO rlist)
  DEF t,sl:PTR TO sym,rnd,c1,c2,ol:PTR TO optset,x,i,st:PTR TO LONG,l,n
  FreeStack(); CtrlC()
  t:=rsym.type
  SELECT t
    CASE SYM
      sl:=rsym.info
      IF i:=rsym.index
        st:=itab[i].start
        l:=itab[i].len
        IF st
          IF np+l>=end THEN Raise(LARGESONG)
          IF sl<>itab[i].isym THEN Raise(CROSSINDEX)
          l:=Shr(l,2)
          IF l THEN FOR x:=1 TO l DO np[]++:=IF n:=st[]++ THEN
            n AND MASK OR curglob ELSE 0
        ELSE
          st:=np
          rewritelist(sl.rptr)
          itab[i].len:=np-st
          itab[i].start:=st
          itab[i].isym:=sl
        ENDIF
      ELSE
        rewritelist(sl.rptr)
      ENDIF
    CASE OPTION
      IF Rnd(1001)<rsym.index THEN rewritelist(rsym.info)
    CASE OPTSET
      rnd:=Rnd(rsym.index)
      c1:=c2:=0
      ol:=rsym.info
      WHILE ol
        c2:=c1+ol.weight
        IF (rnd>=c1) AND (rnd<c2) THEN rewritelist(ol.rptr)
        c1:=c2
        ol:=ol.next
      ENDWHILE
    CASE NOTE
      np[]++:=cursfx OR curglob OR Shl(timings[rsym.info+-MINNOTE],16)
      IF rsym.index>1 THEN FOR x:=2 TO rsym.index DO np[]++:=0
      IF np>=end THEN Raise(LARGESONG)
      cursfx:=0
    CASE SAMPLE
      cursample:=rsym.info
      curglob:=Shl(cursample+1 AND $F,12) OR Shl(cursample+1 AND $F0,24)
    CASE SFX
      cursfx:=rsym.info
  ENDSELECT
ENDPROC

PROC loadsamples() HANDLE
  DEF s:PTR TO sample,i,l,r,f:PTR TO LONG
  s:=sdata
  FOR i:=1 TO numsample
    IF (l:=FileLength(s.path))<10 THEN Raise(0)
    s.len:=l
    s.adr:=New(l)
    IF (fh:=Open(s.path,OLDFILE))=NIL THEN Raise(0)
    r:=Read(fh,s.adr,l)
    Close(fh)
    fh:=NIL
    IF r<10 THEN Raise(0)
    f:=s.adr
    IF f[]="FORM"
      WHILE f[]++<>"BODY" DO IF s.adr+l<f THEN Raise(0)
      s.len:=l+s.adr-f
      s.adr:=f
    ENDIF
    s++
  ENDFOR
EXCEPT
  WriteF('While processing sample "\s":\n',s.path)
  Raise(READSAMPLE)
ENDPROC

PROC writemodule()
  DEF s,x,pnum,dat[4]:ARRAY OF LONG,nument,n,ch:PTR TO LONG,len,wl
  IF (fh:=Open(outfile,NEWFILE))=NIL THEN Raise(WRITEMOD)
  Write(fh,StringF(s:=String(19),'\l\s[20]',arg) BUT s,20)
  FOR x:=0 TO MAXSAMPLE-1
    wl:=Shr(sdata[x].len,1)
    IF x>=numsample
      Write(fh,[0,0,0,0,0,0,0,0],30)
    ELSE
      Write(fh,sdata[x].path,21)
      Out(fh,0)
      Write(fh,[wl,sdata[x].vol,0,1]:INT,8)  /* or [,,wl,] */
    ENDIF
  ENDFOR
  IF (pnum:=maxrows/256)*256<>maxrows THEN INC pnum
  Out(fh,pnum)
  Out(fh,120)  /* 127 */
  FOR x:=0 TO pnum-1 DO Out(fh,x)
  FOR x:=pnum TO 127 DO Out(fh,0)
  Write(fh,["M.K."],4)
  nument:=pnum*64-1
  FOR x:=0 TO nument
    FOR n:=0 TO 3
      ch:=channel[n].start
      IF ch
        len:=channel[n].len
        IF len
          dat[n]:=ch[]++
          channel[n].start:=ch
          channel[n].len:=len-4
        ELSE
          dat[n]:=0
        ENDIF
      ELSE
        dat[n]:=0
      ENDIF
    ENDFOR
    Write(fh,dat,16)
  ENDFOR
  FOR x:=0 TO numsample-1
    Write(fh,sdata[x].adr,sdata[x].len)
  ENDFOR
  Close(fh)
  fh:=NIL
ENDPROC