home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 5 / FreshFish_July-August1994.bin / bbs / dev / amiga_e-2.1b.lha / Amiga_E-2.1b / Sources / Projects / NGRC.e < prev    next >
Encoding:
Text File  |  1993-10-05  |  15.2 KB  |  546 lines
  1. /* Noise Compiler v1.0 */
  2.  
  3. OBJECT sym            /* primairy structure of rewrite symbols */
  4.   next,type,name,rptr
  5. ENDOBJECT
  6.  
  7. OBJECT rlist            /* linked list structure for grammar     */
  8.   next,type,index,info
  9. ENDOBJECT
  10.  
  11. OBJECT optset            /* structure for storing { | | } exp.    */
  12.   next,rptr,weight
  13. ENDOBJECT
  14.  
  15. OBJECT sample            /* all data about a given sample         */
  16.   path,len,adr,vol
  17. ENDOBJECT
  18.  
  19. OBJECT i            /* indexing of rewritten trees           */
  20.   start,len,isym
  21. ENDOBJECT
  22.  
  23. ENUM SYM,OPTSET,OPTION,NOTE,SAMPLE,SFX        /* rlist.type    */
  24. ENUM NOTYPE,REWRITE                /* sym.type    */
  25. ENUM NOMEM,NOFILE,NOFORM,NOGRAM,STACKFLOW,    /* errors    */
  26.      BADSTRUCTURE,BREAK,WRITEMOD,READSAMPLE
  27.  
  28. CONST MAXINDEX=1000,MAXROWS=64*4*64,MAXDURATION=100
  29. CONST MAXDATA=MAXROWS*4,MAXSAMPLE=31,MAXNOTE=23,MINNOTE=-12
  30. CONST PARSE_ER=100,GEN_ER=200,MASK=$0FFF0FFF
  31.  
  32. RAISE NOMEM IF New()=NIL,            /* define exceptions */
  33.       NOMEM IF String()=NIL,
  34.       STACKFLOW IF FreeStack()<1000,
  35.       BREAK IF CtrlC()=TRUE
  36.  
  37. DEF buf,flen,p,tokeninfo,symlist=NIL:PTR TO sym,ltoken=-1,numsample=0,
  38.     notes,np:PTR TO LONG,maxrows=0,cursample=0,cursfx=0,curglob=0,end,
  39.     timings:PTR TO INT,fh=NIL,notevals:PTR TO LONG
  40.  
  41. DEF sdata[32]:ARRAY OF sample,
  42.     itab[MAXINDEX]:ARRAY OF i,
  43.     channel[4]:ARRAY OF i,
  44.     infile[100]:STRING,outfile[100]:STRING
  45.  
  46. PROC main() HANDLE
  47.   WriteF('Noise Compiler v1.0\n')
  48.   WriteF('Translates NoiseGrammar programs into ProTracker modules!\n')
  49.   readgrammar()
  50.   WriteF('grammar "\s" loaded. Parsing...\n',infile)
  51.   parsegrammar()
  52.   WriteF('Grammar parsed succesfully. Generating...\n')
  53.   generate()
  54.   WriteF('Noise generated. Now loading samples...\n')
  55.   loadsamples()
  56.   WriteF('Now saving to file "\s".\n',outfile)
  57.   writemodule()
  58.   WriteF('done.\n')
  59. EXCEPT
  60.   IF fh THEN Close(fh)           /* lowest level exception handler: */
  61.   WriteF('Terminating: ')        /* general error report */
  62.   SELECT exception
  63.     CASE NOFILE;       WriteF('Could not load "\s" grammar file!\n',infile)
  64.     CASE NOMEM;        WriteF('Not enough memory!\n')
  65.     CASE NOFORM;       WriteF('Grammar format error!\n')
  66.     CASE STACKFLOW;    WriteF('Stack overflow! (too heavy recursion?)\n')
  67.     CASE BADSTRUCTURE; WriteF('Problems while generating.\n')
  68.     CASE NOGRAM;       WriteF('No rules rewritten!\n')
  69.     CASE BREAK;        WriteF('Stopped by user\n')
  70.     CASE WRITEMOD;     WriteF('Unable to write PT module "\s"!\n',outfile)
  71.     CASE READSAMPLE;   WriteF('Unable to read sample(s)!\n')
  72.   ENDSELECT
  73. ENDPROC
  74.  
  75. PROC readgrammar()
  76.   StrCopy(infile,arg,ALL)
  77.   StrAdd(infile,'.ngr',ALL)    /* '#?.ngr' = NoizGRammar */
  78.   StrCopy(outfile,arg,ALL)    /* '#?.mod' = ProTracker format */
  79.   StrAdd(outfile,'.mod',ALL)
  80.   IF (flen:=FileLength(infile))<1 THEN Raise(NOFILE)
  81.   IF (fh:=Open(infile,OLDFILE))=NIL THEN Raise(NOFILE)
  82.   IF Read(fh,buf:=New(flen+1),flen)<>flen THEN Raise(NOFILE)
  83.   Close(fh)
  84.   fh:=NIL
  85.   buf[flen]:=";"        /* for parser */
  86. ENDPROC
  87.  
  88. /* this is the parser part. we use a simple but powerfull top-down
  89.    parser, and build our syntax tree here.                              */
  90.  
  91. ENUM ER_UNTOKEN=PARSE_ER,ER_UNEXPECTED,ER_QUOTE,ER_SYMEXP,ER_DOUBLE,
  92.      ER_ARROWEXP,ER_RPARENTHEXP,ER_RBRACEEXP,ER_EMPTY,ER_EOLEXP,ER_RANGE,
  93.      ER_COMMENT,ER_UNDEF,ER_RBRACKETEXP,ER_MAXSAMPLE,ER_NOSAMPLE,
  94.      ER_INTEGEREXP,ER_COMMAEXP,ER_NOTEEXP
  95.  
  96. ENUM EOF,EOL,ARROW,BAR,COMMA,        /* ; -> | ,    */
  97.      RSYM,INTEGER,HEXINTEGER,        /* sym 100 $E01    */
  98.      ISTRING,NOTEVAL,            /* "" C#+    */
  99.      LBRACE,RBRACE,LPARENTH,        /* { } (    */
  100.      RPARENTH,LBRACKET,RBRACKET        /* ) [ ]    */
  101.  
  102. PROC parsegrammar() HANDLE
  103.   DEF end,spot,sl:PTR TO sym,s,i
  104.   notevals:=[9,11,0,2,4,5,7]
  105.   p:=buf
  106.   WHILE parserule() DO NOP
  107.   p:=NIL
  108.   IF (sl:=symlist)=NIL THEN Raise(NOGRAM)
  109.   IF numsample=0 THEN Raise(ER_NOSAMPLE)
  110.   REPEAT
  111.     IF sl.type=NOTYPE            /* check for undefined symbols */
  112.       s:=sl.name
  113.       Raise(ER_UNDEF)
  114.     ENDIF
  115.   UNTIL (sl:=sl.next)=NIL
  116. EXCEPT                         /* re-throw if unknown exception */
  117.   IF exception>=PARSE_ER THEN WriteF('ERROR: ') ELSE Raise(exception)
  118.   WriteF(ListItem(['Unexpected lexical item\n',
  119.     'Unexpected characters in line!\n',
  120.     'Unmatched quote "\n',
  121.     'Symbol expected\n',
  122.     'Double definition of symbol\n',           /* language errors */
  123.     '"->" expected\n',
  124.     '")" expected\n',
  125.     '"}" expected\n',
  126.     'Empty rewrite-list\n',
  127.     'End of rule expected\n',
  128.     'Integer/Note value out of range\n',
  129.     'Incorrectly nested comment(s)\n',
  130.     'No rule defined for symbol "\s"\n',
  131.     '"]" expected\n',
  132.     'Maximum of 32 samples exceeded\n',
  133.     'Grammar needs atleast one sample\n',
  134.     'Integer expected\n',
  135.     '"," expected\n',
  136.     'Note expected'],exception-PARSE_ER),s)
  137.   IF p                /* display very nice error indication */
  138.     IF p[-1]=";" THEN DEC p
  139.     spot:=p
  140.     WHILE (p[]--<>";") AND (p[]<>10) AND (p<>buf) DO NOP
  141.     INC p
  142.     spot:=spot-p+5
  143.     end:=p
  144.     WHILE (end[]<>";") AND (end[]++<>10) DO NOP
  145.     end[]--:=0
  146.     WriteF('LINE: \s\n',p)
  147.     FOR i:=1 TO spot DO WriteF(' ')
  148.     WriteF('^\n')
  149.   ENDIF
  150.   Raise(NOFORM)
  151. ENDPROC
  152.  
  153. PROC parserule()
  154.   DEF token,csym:PTR TO sym
  155.   IF (token:=gettoken())=EOF
  156.     RETURN FALSE
  157.   ELSEIF token=RSYM
  158.     csym:=tokeninfo
  159.     IF csym.type<>NOTYPE THEN Raise(ER_DOUBLE)
  160.     IF gettoken()<>ARROW THEN Raise(ER_ARROWEXP)
  161.     csym.rptr:=parseitemlist()
  162.     csym.type:=REWRITE
  163.     IF gettoken()<>EOL THEN Raise(ER_EOLEXP)
  164.   ELSE
  165.     Raise(ER_SYMEXP)
  166.   ENDIF
  167. ENDPROC TRUE
  168.  
  169. PROC parseitemlist()
  170.   DEF item:PTR TO rlist,prev:PTR TO rlist,ilist=NIL
  171.   prev:={ilist}
  172.   WHILE (item:=parseitem())<>NIL
  173.     prev.next:=item
  174.     prev:=item
  175.   ENDWHILE
  176.   IF ilist=NIL THEN Raise(ER_EMPTY)
  177. ENDPROC ilist
  178.  
  179. PROC parseitem()
  180.   DEF token,item:PTR TO rlist,t2,prev:PTR TO optset,
  181.       curr:PTR TO optset,olist,totalw=0
  182.   token:=gettoken()
  183.   IF token=RSYM
  184.     item:=New(SIZEOF rlist)
  185.     item.type:=SYM
  186.     item.info:=tokeninfo
  187.     IF (t2:=gettoken())=INTEGER
  188.       item.index:=checkinfo(1,MAXINDEX-1)
  189.     ELSE
  190.       putback(t2)
  191.       item.index=0
  192.     ENDIF
  193.   ELSEIF token=ISTRING
  194.     item:=New(SIZEOF rlist)
  195.     item.type:=SAMPLE
  196.     sdata[numsample].path:=tokeninfo
  197.     IF (t2:=gettoken())=INTEGER
  198.       sdata[numsample].vol:=checkinfo(0,64)
  199.     ELSE
  200.       putback(t2)
  201.       sdata[numsample].vol:=64
  202.     ENDIF
  203.     item.info:=numsample++
  204.     IF numsample=MAXSAMPLE THEN Raise(ER_MAXSAMPLE)
  205.   ELSEIF token=LBRACE          /* parse { | | ... } */
  206.     item:=New(SIZEOF rlist)
  207.     item.type:=OPTSET
  208.     prev:={olist}
  209.     REPEAT
  210.       curr:=New(SIZEOF optset)
  211.       IF (token:=gettoken())=INTEGER        /* check for weight */
  212.         curr.weight:=checkinfo(0,1000)
  213.       ELSE
  214.         curr.weight:=1
  215.         putback(token)
  216.       ENDIF
  217.       totalw:=totalw+curr.weight
  218.       curr.rptr:=parseitemlist()
  219.       prev.next:=curr
  220.       prev:=curr
  221.     UNTIL (token:=gettoken())<>BAR
  222.     IF token<>RBRACE THEN Raise(ER_RBRACEEXP)
  223.     item.info:=olist
  224.     item.index:=totalw     /* we store weight here */
  225.   ELSEIF token=LPARENTH
  226.     item:=New(SIZEOF rlist)             /* parse ( ) */
  227.     item.type:=OPTION
  228.     IF (token:=gettoken())=INTEGER        /* check for weight */
  229.       item.index:=checkinfo(0,1000)
  230.     ELSE
  231.       item.index:=500
  232.       putback(token)
  233.     ENDIF
  234.     item.info:=parseitemlist()
  235.     IF gettoken()<>RPARENTH THEN Raise(ER_RPARENTHEXP)
  236.   ELSEIF token=LBRACKET
  237.     item:=New(SIZEOF rlist)             /* parse [note,duration] */
  238.     item.type:=NOTE
  239.     token:=gettoken()
  240.     IF (token<>INTEGER) AND (token<>NOTEVAL) THEN Raise(ER_NOTEEXP)
  241.     item.info:=checkinfo(MINNOTE,MAXNOTE)
  242.     IF gettoken()<>COMMA THEN Raise(ER_COMMAEXP)
  243.     IF gettoken()<>INTEGER THEN Raise(ER_INTEGEREXP)
  244.     item.index:=checkinfo(1,MAXDURATION)
  245.     IF gettoken()<>RBRACKET THEN Raise(ER_RBRACKETEXP)
  246.   ELSEIF token=HEXINTEGER
  247.     item:=New(SIZEOF rlist)             /* parse $SFX */
  248.     item.type:=SFX
  249.     item.info:=checkinfo(0,$FFF)
  250.   ELSEIF (token=EOL) OR (token=RBRACE) OR (token=RPARENTH) OR (token=BAR)
  251.     putback(token)
  252.     RETURN NIL
  253.   ELSE
  254.     Raise(ER_UNTOKEN)
  255.   ENDIF
  256. ENDPROC item
  257.  
  258. /* the lexical analyser: called by the parser each time it
  259.    needs a token. attribute values are in "tokeninfo". allows
  260.    for one symbol lookahead, with putback() function */
  261.  
  262. PROC gettoken()
  263.   DEF c,x,start,len,syml:PTR TO sym,s,depth
  264.   FreeStack(); CtrlC()
  265.   IF ltoken<>-1
  266.     x:=ltoken
  267.     ltoken:=-1
  268.     RETURN x
  269.   ENDIF
  270.   tokeninfo:=0
  271.   parse:
  272.   c:=p[]++
  273.   SELECT c
  274.     CASE ";"; RETURN IF buf+flen<p THEN p-- BUT EOF ELSE EOL
  275.     CASE "|"; RETURN BAR
  276.     CASE ","; RETURN COMMA
  277.     CASE "("; RETURN LPARENTH
  278.     CASE ")"; RETURN RPARENTH
  279.     CASE "{"; RETURN LBRACE
  280.     CASE "}"; RETURN RBRACE
  281.     CASE "["; RETURN LBRACKET
  282.     CASE "]"; RETURN RBRACKET
  283.     CASE "-"; IF p[]=">" THEN RETURN p++ BUT ARROW
  284.     CASE "/"
  285.       IF p[]="*"
  286.         x:=p
  287.         depth:=1
  288.         WHILE buf+flen>p++
  289.           IF (p[0]="/") AND (p[1]="*")
  290.             INC depth
  291.             INC p
  292.           ENDIF
  293.           IF (p[0]="*") AND (p[1]="/")
  294.             DEC depth
  295.             INC p
  296.           ENDIF
  297.           IF depth=0
  298.             INC p
  299.             BRA parse
  300.           ENDIF
  301.         ENDWHILE
  302.         p:=x
  303.         Raise(ER_COMMENT)
  304.       ENDIF
  305.       Raise(ER_UNEXPECTED)
  306.     CASE 34
  307.       start:=p
  308.       WHILE (p[]<>";") AND (p[]<>10) AND (p[]++<>34) DO NOP
  309.       IF p[-1]=";" THEN p-- BUT Raise(ER_QUOTE)
  310.       len:=p-start-1
  311.       tokeninfo:=String(len)
  312.       StrCopy(tokeninfo,start,len)
  313.       RETURN ISTRING
  314.     DEFAULT
  315.       IF (c>="a") AND (c<="z")
  316.         start:=p--
  317.         WHILE (p[]>="a") AND (p[]++<="z") DO NOP
  318.         len:=p---start
  319.         s:=String(len)
  320.         StrCopy(s,start,len)
  321.         syml:=symlist
  322.         WHILE syml
  323.           IF StrCmp(s,syml.name,ALL) THEN BRA found
  324.           syml:=syml.next
  325.         ENDWHILE
  326.         syml:=New(SIZEOF sym)
  327.         syml.next:=symlist
  328.         syml.name:=s
  329.         syml.type:=NOTYPE
  330.         symlist:=tokeninfo:=syml
  331.         RETURN RSYM
  332.         found:
  333.         tokeninfo:=syml
  334.         RETURN RSYM
  335.       ELSEIF (c>="A") AND (c<="G")
  336.         tokeninfo:=notevals[c-"A"]
  337.         LOOP
  338.           x:=p[]++
  339.           SELECT x
  340.             CASE "+"; tokeninfo:=tokeninfo+12        /* octave up    */
  341.             CASE "-"; tokeninfo:=tokeninfo-12        /* octave down    */
  342.             CASE "#"; tokeninfo:=tokeninfo+1        /* sharp    */
  343.             CASE "b"; tokeninfo:=tokeninfo-1        /* flat        */
  344.             DEFAULT
  345.               DEC p
  346.               RETURN NOTEVAL
  347.           ENDSELECT
  348.         ENDLOOP
  349.       ELSEIF ((c>="0") AND (c<="9")) OR (c="-") OR (c="$")
  350.         tokeninfo:=Val(p--,{x})
  351.         p:=p+x
  352.         RETURN IF c="$" THEN HEXINTEGER ELSE INTEGER
  353.       ENDIF
  354.       IF c>32 THEN Raise(ER_UNEXPECTED) ELSE BRA parse
  355.   ENDSELECT
  356. ENDPROC
  357.  
  358. PROC putback(token)
  359.   ltoken:=token
  360. ENDPROC
  361.  
  362. PROC checkinfo(min,max) RETURN IF (tokeninfo<min) OR (tokeninfo>max) THEN
  363.   Raise(ER_RANGE) ELSE tokeninfo
  364.  
  365. ENUM NOCHANNEL=GEN_ER,LARGESONG,CROSSINDEX
  366.  
  367. PROC generate() HANDLE
  368.   DEF x,ci:PTR TO i,syms:PTR TO LONG,numc=0
  369.   Rnd(-Shl(VbeamPos(),14))        /* initialise seed */
  370.   ci:=itab
  371.   FOR x:=0 TO MAXINDEX-1 DO ci[].start++:=NIL
  372.   ci:=channel
  373.   timings:=[856,808,762,720,678,640,604,570,538,508,480,453,
  374.             428,404,381,360,339,320,302,285,269,254,240,226,
  375.             214,202,190,180,170,160,151,143,135,127,120,113]:INT
  376.   /*        C-  C#- D-  D#- E-  F-  F#- G-  G#- A-  A#- B-
  377.             C   C#  D   D#  E   F   F#  G   G#  A   A#  B
  378.             C+  C#+ D+  D#+ E+  F+  F#+ G+  G#+ A+  A#+ B+     */
  379.   np:=notes:=New(MAXDURATION*4+100+MAXDATA)
  380.   end:=np+MAXDATA
  381.   syms:=['one','two','three','four']
  382.   FOR x:=0 TO 3
  383.     ci[x].start:=np
  384.     IF findsym(syms[x])
  385.       ci[x].len:=np-ci[x].start
  386.       IF ci[x].len>maxrows THEN maxrows:=ci[x].len
  387.       INC numc
  388.     ELSE
  389.       ci[x].start:=NIL
  390.     ENDIF
  391.   ENDFOR
  392.   IF numc=0 THEN Raise(NOCHANNEL)
  393.   IF maxrows=0 THEN Raise(NOGRAM)
  394.   IF maxrows>MAXROWS THEN Raise(LARGESONG)
  395. EXCEPT
  396.   IF exception>=GEN_ER THEN WriteF('ERROR: ')
  397.   SELECT exception
  398.     CASE NOCHANNEL;  WriteF('Atleast one channel must be defined\n')
  399.     CASE LARGESONG;  WriteF('Song too large!\n')
  400.     CASE CROSSINDEX; WriteF('No cross-symbol indexing allowed\n')
  401.     DEFAULT;         Raise(exception)         /* re-throw if unknown */
  402.   ENDSELECT
  403.   Raise(BADSTRUCTURE)        /* terminate */
  404. ENDPROC
  405.  
  406. PROC findsym(name)
  407.   DEF s:PTR TO sym
  408.   s:=symlist
  409.   WHILE s
  410.     IF StrCmp(s.name,name,ALL) THEN BRA.S continue
  411.     s:=s.next
  412.   ENDWHILE
  413.   RETURN FALSE
  414.   continue:
  415.   rewritelist(s.rptr)
  416. ENDPROC TRUE
  417.  
  418. PROC rewritelist(list:PTR TO rlist)
  419.   WHILE list
  420.     rewritesym(list)
  421.     list:=list.next
  422.   ENDWHILE
  423. ENDPROC
  424.  
  425. PROC rewritesym(rsym:PTR TO rlist)
  426.   DEF t,sl:PTR TO sym,rnd,c1,c2,ol:PTR TO optset,x,i,st:PTR TO LONG,l,n
  427.   FreeStack(); CtrlC()
  428.   t:=rsym.type
  429.   SELECT t
  430.     CASE SYM
  431.       sl:=rsym.info
  432.       IF i:=rsym.index
  433.         st:=itab[i].start
  434.         l:=itab[i].len
  435.         IF st
  436.           IF np+l>=end THEN Raise(LARGESONG)
  437.           IF sl<>itab[i].isym THEN Raise(CROSSINDEX)
  438.           l:=Shr(l,2)
  439.           IF l THEN FOR x:=1 TO l DO np[]++:=IF n:=st[]++ THEN
  440.             n AND MASK OR curglob ELSE 0
  441.         ELSE
  442.           st:=np
  443.           rewritelist(sl.rptr)
  444.           itab[i].len:=np-st
  445.           itab[i].start:=st
  446.           itab[i].isym:=sl
  447.         ENDIF
  448.       ELSE
  449.         rewritelist(sl.rptr)
  450.       ENDIF
  451.     CASE OPTION
  452.       IF Rnd(1001)<rsym.index THEN rewritelist(rsym.info)
  453.     CASE OPTSET
  454.       rnd:=Rnd(rsym.index)
  455.       c1:=c2:=0
  456.       ol:=rsym.info
  457.       WHILE ol
  458.         c2:=c1+ol.weight
  459.         IF (rnd>=c1) AND (rnd<c2) THEN rewritelist(ol.rptr)
  460.         c1:=c2
  461.         ol:=ol.next
  462.       ENDWHILE
  463.     CASE NOTE
  464.       np[]++:=cursfx OR curglob OR Shl(timings[rsym.info+-MINNOTE],16)
  465.       IF rsym.index>1 THEN FOR x:=2 TO rsym.index DO np[]++:=0
  466.       IF np>=end THEN Raise(LARGESONG)
  467.       cursfx:=0
  468.     CASE SAMPLE
  469.       cursample:=rsym.info
  470.       curglob:=Shl(cursample+1 AND $F,12) OR Shl(cursample+1 AND $F0,24)
  471.     CASE SFX
  472.       cursfx:=rsym.info
  473.   ENDSELECT
  474. ENDPROC
  475.  
  476. PROC loadsamples() HANDLE
  477.   DEF s:PTR TO sample,i,l,r,f:PTR TO LONG
  478.   s:=sdata
  479.   FOR i:=1 TO numsample
  480.     IF (l:=FileLength(s.path))<10 THEN Raise(0)
  481.     s.len:=l
  482.     s.adr:=New(l)
  483.     IF (fh:=Open(s.path,OLDFILE))=NIL THEN Raise(0)
  484.     r:=Read(fh,s.adr,l)
  485.     Close(fh)
  486.     fh:=NIL
  487.     IF r<10 THEN Raise(0)
  488.     f:=s.adr
  489.     IF f[]="FORM"
  490.       WHILE f[]++<>"BODY" DO IF s.adr+l<f THEN Raise(0)
  491.       s.len:=l+s.adr-f
  492.       s.adr:=f
  493.     ENDIF
  494.     s++
  495.   ENDFOR
  496. EXCEPT
  497.   WriteF('While processing sample "\s":\n',s.path)
  498.   Raise(READSAMPLE)
  499. ENDPROC
  500.  
  501. PROC writemodule()
  502.   DEF s,x,pnum,dat[4]:ARRAY OF LONG,nument,n,ch:PTR TO LONG,len,wl
  503.   IF (fh:=Open(outfile,NEWFILE))=NIL THEN Raise(WRITEMOD)
  504.   Write(fh,StringF(s:=String(19),'\l\s[20]',arg) BUT s,20)
  505.   FOR x:=0 TO MAXSAMPLE-1
  506.     wl:=Shr(sdata[x].len,1)
  507.     IF x>=numsample
  508.       Write(fh,[0,0,0,0,0,0,0,0],30)
  509.     ELSE
  510.       Write(fh,sdata[x].path,21)
  511.       Out(fh,0)
  512.       Write(fh,[wl,sdata[x].vol,0,1]:INT,8)  /* or [,,wl,] */
  513.     ENDIF
  514.   ENDFOR
  515.   IF (pnum:=maxrows/256)*256<>maxrows THEN INC pnum
  516.   Out(fh,pnum)
  517.   Out(fh,120)  /* 127 */
  518.   FOR x:=0 TO pnum-1 DO Out(fh,x)
  519.   FOR x:=pnum TO 127 DO Out(fh,0)
  520.   Write(fh,["M.K."],4)
  521.   nument:=pnum*64-1
  522.   FOR x:=0 TO nument
  523.     FOR n:=0 TO 3
  524.       ch:=channel[n].start
  525.       IF ch
  526.         len:=channel[n].len
  527.         IF len
  528.           dat[n]:=ch[]++
  529.           channel[n].start:=ch
  530.           channel[n].len:=len-4
  531.         ELSE
  532.           dat[n]:=0
  533.         ENDIF
  534.       ELSE
  535.         dat[n]:=0
  536.       ENDIF
  537.     ENDFOR
  538.     Write(fh,dat,16)
  539.   ENDFOR
  540.   FOR x:=0 TO numsample-1
  541.     Write(fh,sdata[x].adr,sdata[x].len)
  542.   ENDFOR
  543.   Close(fh)
  544.   fh:=NIL
  545. ENDPROC
  546.