home *** CD-ROM | disk | FTP | other *** search
/ The Datafile PD-CD 3 / PDCD_3.iso / pocketbk / sounds / wave11r3 / WAVEMOD.OPL < prev    next >
Text File  |  1995-02-13  |  17KB  |  936 lines
  1. REM *** (c) 1993,4,5 Takoyaki Software Ltd ***
  2. REM *** Programmed by Dylan Cuthbert       ***
  3.  
  4. APP WaveMod
  5.     TYPE $1002
  6.     PATH "\WVE"
  7.     EXT "WVE"
  8.     ICON "\opd\wavemod.pic"
  9. ENDA
  10.  
  11. PROC wavemod:
  12.  
  13. global fname$(128),iadd
  14. global wwin%,vol%,swin%,bwin%
  15. global tf$(128),buf%(512),b%
  16. global rperc1&,rperc2&,chg%
  17. global bf$(128),bfn$(128)
  18. global ct%(4098),et%(256)
  19. global reg%,reg$(32),sp,sl
  20. global fillen&,filthr&
  21.  
  22. rem *** Change reg% to 1 for registered version
  23.     
  24.     reg%=1
  25.     reg$="Dylan Cuthbert"
  26.     
  27.     cache 4096,4096
  28.     cls
  29.  
  30. rem *** make sure the various directories exist
  31.  
  32.     trap mkdir "\WVE"
  33.     trap mkdir "\OPD"
  34.     setpath "\wve\"
  35.     fname$="*.wve"
  36.  
  37. rem *** set the temporary file's name
  38.  
  39.     tf$="\OPD\wm_temp.tmp"
  40.  
  41. rem *** set the backup file's name
  42.  
  43.     bf$="\OPD\backup.tmp"
  44.  
  45.     b%=addr(buf%(1))
  46.  
  47. rem *** load up the modules
  48.     
  49.     loadm "\OPO\wavefunc.opo"
  50.     loadm "\OPO\waveshow.opo"
  51.     loadm "\OPO\wavetabs.opo"
  52.  
  53. rem *** generate the A-law compression/decompression tables    
  54.  
  55.     gentabs:
  56.  
  57.     fname$=cmd$(2)
  58.     
  59.     if cmd$(3)="C"
  60.         if newwave%:(fname$) = 0 : return : endif
  61.     endif
  62.  
  63.     swin%=gcreate (0,100+34,gwidth,16,1)
  64.     wwin%=gcreate (0,32,gwidth,100,1)
  65.     
  66.     showwave:(fname$)
  67.     
  68.     if reg%=0 : showinfo: : endif
  69.     
  70.     selarea:
  71.  
  72.     trap delete tf$
  73.     trap delete bf$
  74.     
  75. endp
  76.  
  77. rem *** cut a section out of a sample
  78.  
  79. proc scut:(in$,out$,rx,rw)
  80.  
  81. local hdr%(16),in%,out%,h%
  82. local len&,ret%,px&,pw&
  83.  
  84.     h%=addr(hdr%(1))
  85.     
  86.     ioopen(in%,in$,$600)
  87.     ioopen(out%,out$,$102)
  88.     
  89.     ioread(in%,h%,32)
  90.     len&=peekl(uadd(h%,18))
  91.     pokel uadd(h%,18),int(rw)
  92.     pokew uadd(h%,24),0
  93.     pokew uadd(h%,22),0
  94.     iowrite(out%,h%,32)
  95.     
  96.     px&=rx+32 : pw&=rw
  97.  
  98.     while pw&>0
  99.         ioseek(in%,1,px&)
  100.         ret%=ioread(in%,b%,1024)
  101.         if ret%=0 : break : endif
  102.         px&=px&+ret%
  103.         if pw&<1024
  104.             iowrite(out%,b%,pw&)
  105.         else
  106.             iowrite(out%,b%,1024)
  107.         endif
  108.         pw&=pw&-1024
  109.     endwh
  110.     
  111.     ioclose(in%) : ioclose(out%)
  112.  
  113. endp
  114.  
  115. rem *** insert into a sample
  116.  
  117. proc sins:(in$,in2$,rx,rw,delin2%)
  118.  
  119. local hdr%(16),in%,in2%,tmp%,h%
  120. local len&,len2&,ret%,px&,pw&
  121. local fn$(130),inp&,n&,hdr2%(16),h2%
  122.  
  123.     h%=addr(hdr%(1))
  124.     h2%=addr(hdr2%(1))
  125.  
  126.     ret% = ioopen(in%,in$,$600) rem *** File to insert into
  127.     if ret%<0 : showerr:(ret%) : return : endif
  128.     ret% = ioopen(in2%,in2$,$600) rem *** File to insert
  129.     if ret%<0 : showerr:(ret%) : return : endif
  130.     ret% = ioopen(tmp%,addr(fn$),$104) rem *** File to output to
  131.     if ret%<0 : showerr:(ret%) : return : endif
  132.  
  133. rem *** Read the 32 byte sound file header
  134.  
  135.     ioread(in%,h%,32)
  136.     ioread(in2%,h2%,32)
  137.     len&=peekl(uadd(h%,18))
  138.     len2&=peekl(uadd(h2%,18))
  139.     if rw<>0 and len2&>rw
  140.         len2&=int(rw)
  141.     endif
  142.     
  143. rem *** Modify the length
  144.     pokel uadd(h%,18),len2&+len&
  145.     iowrite(tmp%,h%,32)
  146.     
  147.     px&=32 : inp&=32 : n&=int(rx)
  148.     
  149. rem *** Copy beginning of file
  150.  
  151.     while n&>0
  152.         ioseek(in%,1,px&)
  153.         if n&>1024
  154.             ret%=ioread(in%,b%,1024)
  155.         else
  156.             ret%=ioread(in%,b%,n&)
  157.         endif
  158.         iowrite(tmp%,b%,ret%)
  159.         px&=px&+ret% : n&=n&-ret%
  160.     endwh
  161.  
  162.  
  163. rem *** Copy paste buffer in
  164.  
  165.     n&=len2&
  166.     
  167.     while n&>0
  168.         ioseek(in2%,1,inp&)
  169.         if n&>1024
  170.             ret%=ioread(in2%,b%,1024)
  171.         else
  172.             ret%=ioread(in2%,b%,n&)
  173.         endif
  174.         iowrite(tmp%,b%,ret%)
  175.         inp&=inp&+ret% : n&=n&-ret%        
  176.     endwh
  177.     
  178. rem *** Copy rest of file ***
  179.     while 1
  180.         ioseek(in%,1,px&)
  181.         ret%=ioread(in%,b%,1024)
  182.         if ret%<=0 : break : endif
  183.         iowrite(tmp%,b%,ret%)
  184.         px&=px&+ret%
  185.     endwh
  186.     
  187.     ioclose(tmp%)
  188.     ioclose(in%)
  189.     ioclose(in2%)
  190.  
  191.     if delin2%=1 : delete in2$ : endif
  192.     trap copy fn$,in$
  193.     if err
  194.         giprint "Disk full!"
  195.     endif
  196.     delete fn$
  197.  
  198. endp
  199.  
  200. rem *** delete a section of a sample
  201.  
  202. proc sdel:(in$,rx,rw)
  203.  
  204. local hdr%(16),in%,tmp%,h%
  205. local len&,ret%,px&,pw&
  206. local fn$(130),n&
  207.  
  208.     h%=addr(hdr%(1))
  209.  
  210.     ret% = ioopen(in%,in$,$600) rem *** File to insert into
  211.     if ret%<0 : showerr:(ret%) : return : endif
  212.     ret% = ioopen(tmp%,addr(fn$),$104) rem *** File to output to
  213.     if ret%<0 : showerr:(ret%) : return : endif
  214.  
  215. rem *** Read the 32 byte sound file header
  216.  
  217.     ioread(in%,h%,32)
  218.     len&=peekl(uadd(h%,18))
  219.     
  220. rem *** Modify the length
  221.     pokel uadd(h%,18),len&-rw
  222.     iowrite(tmp%,h%,32)
  223.     
  224.     px&=32 : n&=int(rx)
  225.     
  226. rem *** Copy beginning of file
  227.  
  228.     while n&>0
  229.         ioseek(in%,1,px&)
  230.         if n&>1024
  231.             ret%=ioread(in%,b%,1024)
  232.         else
  233.             ret%=ioread(in%,b%,n&)
  234.         endif
  235.         iowrite(tmp%,b%,ret%)
  236.         px&=px&+ret% : n&=n&-ret%
  237.     endwh
  238.     
  239.     px&=px&+rw
  240.  
  241. rem *** Copy rest of file ***
  242.     while 1
  243.         ioseek(in%,1,px&)
  244.         ret%=ioread(in%,b%,1024)
  245.         if ret%<=0 : break : endif
  246.         iowrite(tmp%,b%,ret%)
  247.         px&=px&+ret%
  248.     endwh
  249.     
  250.     ioclose(tmp%) : ioclose(in%)
  251.  
  252.     copy fn$,in$
  253.     delete fn$
  254.  
  255. endp
  256.  
  257. rem *** play a sample (taken from OPL manual)
  258.  
  259. proc playw:(inname$,ticks%,vol%)
  260.  
  261.     local name$(128),p%,ret%
  262.     
  263.     p%=peekw($1c)+6
  264.     name$=inname$+chr$(0)
  265.     ret%=call ($1f86, uadd(addr(name$),1),ticks%,vol%)
  266.     if peekw(p%) and 1
  267.         return ret% or $ff00
  268.     endif
  269.  
  270. endp
  271.  
  272. rem *** set up the header for a new sample file
  273.  
  274. proc newwave%:(n$)
  275. local s$(16),ret%,hdr%(17),h%,f%
  276.  
  277.     s$="ALawSoundFile**"
  278.     
  279.     sp=0 : sl=0
  280.  
  281.     h%=addr(hdr%(2))
  282.     if ioopen(f%,n$,$101)=0
  283.         poke$ usub(h%,1),s$
  284.         pokew uadd(h%,16),$100f
  285.         iowrite(f%,h%,32)
  286.         ioclose(f%)
  287.         chg%=0
  288.         return 1
  289.     else
  290.         return 0
  291.     endif
  292.  
  293. endp
  294.  
  295. rem *** open an existing sample
  296.  
  297. proc openwave:(p$)
  298. local d%,f%
  299.  
  300.     if p$="O" : f%=64 : endif
  301.     if p$="C" : f%=1+8 : endif
  302.     
  303.     dinit "Waveform?"
  304.     dfile fname$,"File:",f%
  305.     if dialog
  306.         if not exist(fname$)
  307.             d%=newwave%:(fname$)
  308.         else
  309.             sp=0 : sl=0
  310.             d%=1
  311.         endif
  312.     else
  313.         d%=0
  314.     endif
  315.     
  316.     if d%=1
  317.         chg%=0
  318.     endif
  319.     
  320.     return d%
  321. endp
  322.  
  323. rem *** as copied from OPL manual
  324.  
  325. PROC recordw:(i$,s%)
  326.     local n$(128),p%,r%
  327.     p%=peekw($1c)+6
  328.     n$=i$+chr$(0)
  329.     r%=call($2286,uadd(addr(n$),1),s%)
  330.     if peekw(p%) and 1
  331.         return r% or $ff00
  332.     endif
  333. ENDP
  334.  
  335. proc setvol:
  336.  
  337.     vol%=vol%+1
  338.     dinit "Set Volume"
  339.     dchoice vol%,"Volume:","Loud,Semi-Loud,Medium,Semi-Low,Low"
  340.     dialog
  341.     vol%=vol%-1
  342.  
  343. endp
  344.  
  345. rem *** process a region with the specified function
  346.  
  347. proc function:(in$,func$,rx,rw)
  348.  
  349. local hdr%(16),in%,tmp%,h%
  350. local len&,ret%,px&,pw&,err%
  351. local fn$(130),n&,total&,rw&
  352.  
  353.     h%=addr(hdr%(1))
  354.     
  355.     ret% = ioopen(in%,in$,$600) rem *** File to insert into
  356.     if ret%<0 : showerr:(ret%) : return : endif
  357.     ret% = ioopen(tmp%,addr(fn$),$104) rem *** File to output to
  358.     if ret%<0 : showerr:(ret%) : return : endif
  359.  
  360.     busy "Processing..."
  361. rem *** Read the 32 byte sound file header
  362.  
  363.     ioread(in%,h%,32)
  364.     len&=peekl(uadd(h%,18))
  365.     
  366.     if rw=0 : rw&=len& : else : rw&=int(rw) : endif
  367.  
  368.     px&=32 : n&=rx : total&=n&
  369.     
  370. rem *** Copy beginning of file
  371.  
  372.     while n&>0
  373.         ioseek(in%,1,px&)
  374.         ret%=readbuf%:(in%,n&)
  375.         iowrite(tmp%,b%,ret%)
  376.         px&=px&+ret% : n&=n&-ret%
  377.     endwh
  378.  
  379.     total&=total&+@&(func$):(in%,tmp%,px&,rw&)
  380.     px&=0 : ioseek(in%,3,px&) : rem get current pos in file
  381.  
  382. rem *** Copy rest of file ***
  383.     while 1
  384.         ioseek(in%,1,px&)
  385.         ret%=ioread(in%,b%,1024)
  386.         if ret%<=0 : break : endif
  387.         iowrite(tmp%,b%,ret%)
  388.         px&=px&+ret% :  total&=total&+ret%
  389.     endwh
  390.     
  391.     ioclose(tmp%) : ioclose(in%)
  392.     
  393.     if sp+sl>total&
  394.         if sp<>0 : sl=total&-sp : else : sl=0 : endif
  395.     endif
  396.  
  397. rem *** Now to copy the temporary file over and delete it ***
  398.     ioopen(tmp%,fn$,$600)
  399.     ioopen(in%,in$,$102)
  400.     
  401.     pokel uadd(h%,18),total&
  402.     iowrite(in%,h%,32)
  403.  
  404.     n&=total&
  405.     
  406.     while n&>0
  407.         ret%=readbuf%:(tmp%,n&)
  408.         iowrite(in%,b%,ret%)
  409.         n&=n&-ret%
  410.     endwh
  411.     
  412.     ioclose(tmp%) : ioclose(in%)
  413.     delete fn$
  414.     
  415.     busy off
  416.  
  417. endp
  418.  
  419.  
  420. proc readbuf%:(in%,n&)
  421.     return readbfn%:(in%,n&,int(1024))
  422. endp
  423.  
  424.  
  425. proc readbfn%:(in%,n&,len&)
  426. local ret%
  427.     if n&>len&
  428.         ret%=ioread(in%,b%,len&)
  429.     else
  430.         ret%=ioread(in%,b%,n&)
  431.     endif
  432.     if ret%<0 : ret%=0 : endif
  433.     return ret%
  434. endp
  435.  
  436. proc readj:(cx&)
  437. local nx%
  438.     if iadd : nx%=(cx&-sp)/iadd : else : nx%=gwidth/2 : endif
  439.  
  440.     return nx%
  441. endp
  442.  
  443. proc readjw:(cx&)
  444. local nx%
  445.     nx%=1
  446.     if iadd : nx%=cx&/iadd :  endif
  447.     if nx%=0 : nx%=1 : endif
  448.  
  449.     return nx%
  450. endp
  451.  
  452. proc bakchk:
  453. local d%
  454.  
  455.     if chg%=0
  456.         dinit
  457.         dtext "","Make a backup copy before continuing?",2
  458.         dbuttons "No",%n,"Yes",%y
  459.         d%=dialog
  460.         if d%=0 : return 0 : endif
  461.         if d%=%y
  462.             trap copy fname$,bf$
  463.             if err
  464.                 giprint "Una