home *** CD-ROM | disk | FTP | other *** search
/ PDA Software Library / pdasoftwarelib.iso / PSION / SOUNDS / WAVEMOD.OPL < prev    next >
Encoding:
Text File  |  1995-02-13  |  16.9 KB  |  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 "Unable to make backup copy!!"
  465.                 return 0
  466.             else
  467.             bfn$=fname$
  468.             endif
  469.         endif
  470.     endif
  471.     
  472.     chg%=1
  473.     
  474.     return 1
  475.  
  476. endp
  477.  
  478. proc unimp:
  479.  
  480.     dinit
  481.     dtext "","Unimplemented in this version.",2
  482.     dialog
  483.     
  484. endp
  485.  
  486. proc selarea:
  487.  
  488. local cw%,cx%,cx&,cw&,k%,km%,fn$(128)
  489. local len&,len%,ev%(6),c$(128),acc%,n%
  490.  
  491.     cw%=1:cx%=gwidth/2
  492.     
  493.     gupdate off
  494.  
  495.     while 1
  496.         drawcurs:(cx%,cw%)
  497.  
  498.         lock off
  499.         
  500.         getevent ev%()
  501.  
  502.         if ev%(1)=$404
  503.             c$=getcmd$
  504.             if left$(c$,1)="X"
  505.                 return
  506.             endif
  507.             if left$(c$,1)="C"
  508.                 if newwave%:(mid$(c$,2,128))
  509.                     fname$=mid$(c$,2,128)
  510.                     showwave:(fname$)
  511.                     cx%=gwidth/2 : cw%=1
  512.                 endif
  513.             endif
  514.             if left$(c$,1)="O"
  515.                 if exist(mid$(c$,2,128))
  516.                     fname$=mid$(c$,2,128)
  517.                     showwave:(fname$) : chg%=0
  518.                     cx%=gwidth/2 : cw%=1
  519.                 endif
  520.             endif
  521.             continue
  522.         else
  523.             k%=ev%(1)
  524.             km%=ev%(2) and $ff
  525.             if km% and 4
  526.                 km%=km% and (not 4)
  527.                 acc%=8
  528.             else
  529.                 acc%=1
  530.             endif
  531.         endif
  532.         
  533.         lock on
  534.         
  535.         if km% and 8
  536.             km%=km% and (2+4)
  537.             if (km% and 2) and k%>=%a+512 and k%<=%z+512
  538.                 k%=k%-(%a-%A)
  539.             endif
  540.         endif
  541.  
  542.         if k%=290
  543.             k%=domenu:+512
  544.             if k%>=512+%A and k%<=512+%Z
  545.                 km%=2
  546.             else
  547.                 km%=0
  548.             endif
  549.         endif
  550.  
  551.         drawcurs:(cx%,cw%)
  552.  
  553.         if k%=291
  554.             dohelp:
  555.         endif
  556.  
  557.         if k%=%v+512 and km%=0
  558.             setvol:
  559.         endif
  560.  
  561.         if (k%=%l+512 and km%=0) or (k%=%L+512 and km%=2)
  562.             if bakchk:
  563.                 dinit "Noise Filter"
  564.                 dchoice n%,"Frequency:","50Hz,100Hz,500Hz"
  565.                 dlong filthr&,"Amplitude",0,100
  566.                 dtext "","(Range 0-100%)",2
  567.                 if dialog
  568.                     filthr&=(4096*filthr&)/100
  569.                     if n%=1 : fillen&=8192/50 : endif
  570.                     if n%=2 : fillen&=8192/100 : endif
  571.                     if n%=3 : fillen&=8192/500 : endif
  572.                     if k%=%L+512
  573.                         function:(fname$,"filter",cx%*iadd+sp,cw%*iadd)
  574.                     else
  575.                         function:(fname$,"filter",0.0,0.0)
  576.                     endif
  577.                     cx&=cx%*iadd+sp : cw&=cw%*iadd
  578.                     showwave:(fname$)
  579.                     cx%=readj:(cx&) : cw%=readjw:(cw&)
  580.                 endif
  581.             endif
  582.         endif
  583.  
  584.         if (k%=%s+512 and km%=0) or (k%=%S+512 and km%=2)
  585.             if bakchk:
  586.                 dinit "Phase Wave"
  587.                 dlong fillen&,"Extent:",1,512
  588.                 dtext "","(1-512)",2
  589.                 if dialog
  590.                     if k%=%S+512
  591.                         function:(fname$,"smooth",cx%*iadd+sp,cw%*iadd)
  592.                     else
  593.                         function:(fname$,"smooth",0.0,0.0)
  594.                     endif
  595.                     cx&=cx%*iadd+sp : cw&=cw%*iadd
  596.                     showwave:(fname$)
  597.                     cx%=readj:(cx&) : cw%=readjw:(cw&)
  598.                 endif
  599.             endif
  600.         endif
  601.  
  602.         if ( k%=%d+512 or k%=8 ) and km%=0 and cw%>1
  603.             if bakchk:
  604.                 busy "Cutting region..."
  605.                 scut:(fname$,tf$,cx%*iadd+sp,cw%*iadd)
  606.                 sdel:(fname$,cx%*iadd+sp,cw%*iadd)
  607.                 cx&=cx%*iadd+sp
  608.                 busy off
  609.                 showwave:(fname$)
  610.                 cx%=readj:(cx&)
  611.                 cw%=1
  612.             endif
  613.         endif
  614.  
  615.         if k%=259 and km%=0 and cx%-acc%>=0
  616.             cx%=cx%-acc%
  617.             cw%=1
  618.         endif
  619.                 
  620.         if k%=258 and km%=0 and cx%+acc%<gwidth
  621.             cx%=cx%+acc%
  622.             cw%=1
  623.         endif
  624.  
  625.         if k%=258 and km%=2 and cx%+cw%+acc%<gwidth
  626.             cw%=cw%+acc%
  627.         endif
  628.  
  629.         if k%=259 and km%=2 and cw%>acc%
  630.             cw%=cw%-acc%
  631.         endif
  632.         
  633.         if k%=263 and km%=2 and cw%>acc%
  634.             cx%=cx%+acc%
  635.             cw%=cw%-acc%
  636.         endif
  637.     
  638.         if k%=262 and km%=2 and cx%>acc%-1
  639.             cw%=cw%+acc%
  640.             cx%=cx%-acc%
  641.         endif
  642.         
  643.         if k%=262 and km%=0
  644.             cx%=0
  645.             cw%=1
  646.         endif
  647.         
  648.         if k%=263 and km%=0
  649.             cx%=gwidth-1
  650.             cw%=1
  651.         endif
  652.         
  653.         if k%=%i+512 and cw%=1
  654.             if bakchk:
  655.                 if exist(tf$)
  656.                     busy "Inserting..."
  657.                     at 1,15
  658.                     sins:(fname$,tf$,cx%*iadd+sp,0.0,0)
  659.                     cx&=cx%*iadd+sp
  660.                     showwave:(fname$)
  661.                     cx%=readj:(cx&)
  662.                     busy off
  663.                 else
  664.                     giprint "Nothing to insert!"
  665.                 endif
  666.             endif
  667.         endif
  668.  
  669.         if k%=%I+512 and cw%=1
  670.             if bakchk:
  671.                 c$=fname$
  672.                 dinit "Insert File"
  673.                 dfile c$,"File:",64
  674.                 if dialog
  675.                     busy "Inserting..."
  676.                     sins:(fname$,c$,cx%*iadd+sp,0.0,0)
  677.                     cx&=cx%*iadd+sp
  678.                     showwave:(fname$)
  679.                     cx%=readj:(cx&)
  680.                     busy off
  681.                 endif
  682.             endif
  683.         endif
  684.         
  685.         if k%=%o+512 and km%=0
  686.             if openwave:("O")
  687.                 showwave:(fname$)
  688.                 cx%=gwidth : cw%=1
  689.             endif
  690.         endif
  691.  
  692.         if k%=%n+512 and km%=0
  693.             if openwave:("C")
  694.                 showwave:(fname$)
  695.                 cx%=gwidth : cw%=1
  696.             endif
  697.         endif
  698.  
  699.         if k%=%N+512 and km%=2
  700.             c$=fname$
  701.             dinit "Rename File"
  702.             dfile fname$,"From:",64
  703.             dfile c$,"To:",1+8
  704.             if dialog
  705.                 giprint "Renaming..."
  706.                 trap rename fname$,c$
  707.                 if not err
  708.                     fname$=c$
  709.                 endif
  710.                 showwave:(fname$)
  711.             endif
  712.         endif
  713.  
  714.         if k%=%C+512 and km%=2
  715.             c$=fname$
  716.             dinit "Copy File"
  717.             dfile fname$,"From:",64
  718.             dfile c$,"To:",1+16+64
  719.             if dialog
  720.                 giprint "Copying..."
  721.                 trap copy fname$,c$
  722.                 if not err
  723.                     fname$=c$
  724.                 else
  725.                     giprint "Unable to copy file!"
  726.                 endif
  727.                 showwave:(fname$)
  728.             endif
  729.         endif
  730.         
  731.         if k%=%c+512 and cw%>1
  732.             giprint "Copied"
  733.             scut:(fname$,tf$,cx%*iadd+sp,cw%*iadd)
  734.         endif
  735.  
  736.         if k%=%P+512 and km%=2 and cw%>1
  737.             busy "Playing Region..."
  738.             scut:(fname$,tf$,cx%*iadd+sp,cw%*iadd)
  739.             playw:(tf$,0,vol%)
  740.             delete tf$
  741.             busy off
  742.         endif
  743.         
  744.         if k%=%p+512 and km%=0
  745.             busy "Playing whole sample..."
  746.             playw:(fname$,0,vol%)
  747.             busy off
  748.         endif
  749.         
  750.         if k%=%w+512 and cw%>1
  751.             dinit "Write region to which file?"
  752.             fn$="*.wve"
  753.             dfile fn$,"File:",64+16+1
  754.             if dialog
  755.                 if fn$=fname$
  756.                     giprint "Cannot write to viewed file!"
  757.                 else
  758.                     busy "Writing region..."
  759.                     scut:(fname$,fn$,cx%*iadd+sp,cw%*iadd)
  760.                     busy off
  761.                 endif
  762.             endif
  763.         endif
  764.         
  765.         if k%=%r+512 and km%=0
  766.             if bakchk:
  767.                 dinit "Record sample"
  768.                 dlong len&,"Seconds?",1,100
  769.                 if dialog
  770.                     dinit "Press Y to begin sampling"
  771.                     dbuttons "No",%n,"Yes",%y
  772.                     if dialog=%y
  773.                         busy "Recording..."
  774.                         len%=len&*4
  775.                         if recordw:(tf$,len%)
  776.                             busy off
  777.                             giprint "Disk Full!"
  778.                         else
  779.                             sins:(fname$,tf$,cx%*iadd+sp,0.0,1)
  780.                             busy off
  781.                             showwave:(fname$)
  782.                         endif
  783.                     endif
  784.                 endif
  785.             endif
  786.         endif
  787.         
  788.         if k%=%R+512 and km%=2 and cw%>1
  789.             if bakchk:
  790.                 sdel:(fname$,cx%*iadd+sp,cw%*iadd)
  791.                 dinit "Record over marked region?"
  792.                 dbuttons "No",%n,"Yes",%y
  793.                 if dialog=%y
  794.                     busy "Recording..."
  795.                     len%=((cw%*iadd)+2047)/2048
  796.                     recordw:(tf$,len%)
  797.                     sins:(fname$,tf$,cx%*iadd+sp,cw%*iadd,1)
  798.                     busy off
  799.                     showwave:(fname$)
  800.                 endif
  801.             endif
  802.         endif
  803.         
  804.         if k%=%g+512 and km%=0
  805.             if bakchk:
  806.                 function:(fname$,"dblspd",0.0,0.0)
  807.                 cx&=cx%*iadd+sp : cw&=cw%*iadd
  808.                 showwave:(fname$)
  809.                 cx%=readj:(cx&) : cw%=readjw:(cw&)
  810.             endif
  811.         endif
  812.  
  813.         if k%=%T+512 and km%=2
  814.             if bakchk:
  815.                 function:(fname$,"revrse",cx%*iadd+sp,cw%*iadd)
  816.                 cx&=cx%*iadd+sp : cw&=cw%*iadd
  817.                 showwave:(fname$)
  818.                 cx%=readj:(cx&) : cw%=readjw:(cw&)
  819.             endif
  820.         endif
  821.  
  822.         if k%=%t+512 and km%=0
  823.             if bakchk:
  824.                 function:(fname$,"revrse",0.0,0.0)
  825.                 cx&=cx%*iadd+sp : cw&=cw%*iadd
  826.                 showwave:(fname$)
  827.                 cx%=readj:(cx&) : cw%=readjw:(cw&)
  828.             endif
  829.         endif
  830.  
  831.         if (k%=%F+512 and km%=2) or (k%=%f+512 and km%=0)
  832.             if bakchk:
  833.                 dinit "Fade up/down"
  834.                 dlong rperc1&,"Start",0,200
  835.                 dlong rperc2&,"End",0,200
  836.                 dtext "","(Range 0-200%)",2
  837.                 if dialog
  838.                     if k%=%F+512
  839.                         function:(fname$,"fade",cx%*iadd+sp,cw%*iadd)
  840.                     else
  841.                         function:(fname$,"fade",0.0,0.0)
  842.                     endif
  843.                     cx&=cx%*iadd+sp : cw&=cw%*iadd
  844.                     showwave:(fname$)
  845.                     cx%=readj:(cx&) : cw%=readjw:(cw&)
  846.                 endif
  847.             endif
  848.         endif
  849.  
  850.         if k%=%G+512 and km%=2
  851.             if bakchk:
  852.                 function:(fname$,"dblspd",cx%*iadd+sp,cw%*iadd)
  853.                 cx&=cx%*iadd+sp : cw&=cw%*iadd
  854.                 showwave:(fname$)
  855.                 cx%=readj:(cx&) : cw%=readjw:(cw&)
  856.             endif
  857.         endif
  858.  
  859.         if k%=%h+512 and km%=0
  860.             if bakchk:
  861.                 function:(fname$,"hlfspd",0.0,0.0)
  862.                 cx&=cx%*iadd+sp : cw&=cw%*iadd
  863.                 showwave:(fname$)
  864.                 cx%=readj:(cx&) : cw%=readjw:(cw&)
  865.             endif
  866.         endif
  867.  
  868.         if k%=%H+512 and km%=2
  869.             if bakchk:
  870.                 function:(fname$,"hlfspd",cx%*iadd+sp,cw%*iadd)
  871.                 cx&=cx%*iadd+sp
  872.                 showwave:(fname$)
  873.                 cx%=readj:(cx&)
  874.             endif
  875.         endif
  876.         
  877.         if (k%=%V+512 and km%=2) or (k%=%u+512 and km%=0)
  878.             if bfn$=fname$
  879.                 dinit "Revert to backup"
  880.                 dtext "","Are you sure?",2
  881.                 dbuttons "No",%n,"Yes",%y
  882.                 if dialog=%y
  883.                     giprint "Reverting..."
  884.                     trap copy bf$,fname$
  885.                     if err
  886.                         giprint "Unable to revert!!"
  887.                     else
  888.                         showwave:(fname$)
  889.                         cx%=gwidth/2 : cw%=1
  890.                     endif
  891.                 endif
  892.             else
  893.                 giprint "Nothing to revert to!"
  894.             endif
  895.         endif
  896.  
  897.         if k%=%Z+512 and km%=2 and sl<>0
  898.             giprint "Zooming Out (x2)"
  899.             cx&=cx%*iadd+sp : cw&=cw%*iadd
  900.             sp=sp-sl/2 : sl=sl*2
  901.             if sp<0 : sp=0 : endif
  902.             showwave:(fname$)
  903.             cx%=readj:(cx&) : cw%=readjw:(cw&)
  904.         endif
  905.  
  906.         if k%=%z+512 and km%=0
  907.             if cw%>1
  908.                 giprint "Zooming Marked Region"
  909.                 sp=sp+cx%*iadd : sl=cw%*iadd
  910.                 showwave:(fname$)
  911.                 cx%=0 : cw%=1
  912.             else
  913.                 giprint "Zooming Out (Full)"
  914.                 sp=0 : sl=0
  915.                 showwave:(fname$)
  916.             endif
  917.         endif
  918.         
  919.         if k%=%a+512
  920.             showinfo:
  921.         endif
  922.  
  923.         if k%=%x+512
  924.             return
  925.         endif
  926.         
  927.         if not iadd
  928.             cw%=1
  929.         endif
  930.     
  931.     endwh
  932.  
  933. endp
  934.  
  935.  
  936.