home *** CD-ROM | disk | FTP | other *** search
/ The Datafile PD-CD 1B / DATAFILE_PDCD1B.iso / _pocketbk / pocketbook / 004 / digital_zi / DIGITAL.OPL next >
Text File  |  1994-01-20  |  9KB  |  583 lines
  1. rem Digital.opl
  2. rem An example of digital audio (DSP)
  3. rem signal processing.
  4. rem
  5. rem Totally Public Domain - do
  6. rem anything you wish, freely, with
  7. rem this code - I claim no
  8. rem copyright, or offer warranties.
  9. rem 
  10. rem Needs modifying for the 3a
  11. rem
  12. rem Written by jezar@cix
  13. rem January 1994
  14.  
  15. Proc startup:
  16.     setup:("kget%")
  17. endp
  18.  
  19. PROC kget%:
  20.     LOCAL k%,h$(26),a$(5)
  21.     h$="NOSAWLUVGCKRDHIZPMXBTF"
  22.     WHILE 1
  23.         k%=GET
  24.         IF k%=$122 REM Menu key
  25.             mINIT
  26.              mCARD "File","New file",%N,"Open file",%o,"Save file",%s,"Save as",%a,"Revert",%v
  27.             mCARD "Edit","Add waveforms",%w,"Low pass filter",%l,"Volume",%g,"Clear wave",%c,"Complex filter",%k,"Undo",%u
  28.             mCARD "Display","Redraw",%r,"Show difference",%d
  29.             mCARD "Store","Store waveform",%h,"Retrieve waveform",%i,"Difference "+chr$(16)+" waveform",%z,"Mix waveform+store",%m
  30.             mCARD "Special","Phase toggle",%t,"Phase offset",%p,"Base offset",%b,"Info about program",%f,"Exit",%x
  31.             k%=MENU
  32.             IF k% AND INTF(LOC(h$,CHR$(k%)))
  33.                 a$="proc"+CHR$(k%)
  34.                 @(a$): REM procn:, proco:, ...
  35.             ENDIF
  36.         ELSEIF k% REM hot-key 
  37.             k%=k% AND $DF REM Uppercase
  38.             k%=LOC(h$,CHR$(k%)) REM One of ours?
  39.             IF k%
  40.                  a$="proc"+MID$(h$,k%,1)
  41.                 @(a$): REM procn:, proco:, ...
  42.             ENDIF REM ignore other weird keypresses
  43.         ELSE REM some other key
  44.             RETURN k%
  45.         ENDIF
  46.     ENDWH
  47. ENDP
  48.  
  49.  
  50. Proc setup:(calback$)
  51.     Global data(239),undo(239)
  52.     Global squt(239),sint(239)
  53.     Global store(239),poly%(481)
  54.     Global yoff%,xmax%,e%(10),fname$(130)
  55.     Global lpf,lpg,nf&,na,sa,saved%,fo&
  56.     Global kl0,kl1,kl2,kk1,kk2,stable%
  57.     Global wt1%,wt2%,gn,sp
  58.     wt1%=2
  59.     wt2%=2
  60.     gn=1
  61.     na=0.5
  62.     sa=0.5
  63.     nf&=5
  64.     kl0=.6
  65.     kl1=-0.42
  66.     kk1=0.42
  67.     kl2=-0.15
  68.     kk2=0.1
  69.     yoff%=40-1
  70.     xmax%=240-1
  71.     lpg=0.2
  72.     lpf=0.8
  73.     gborder 1
  74.     gat 1,yoff%
  75.     glineto xmax%-1,yoff%
  76.     fname$="Digital.odb"
  77.     setname fname$
  78.     
  79.     if exist(fname$)
  80.         loader%:(fname$)
  81.     endif
  82.     
  83.     if testevent
  84.         getevent e%()
  85.     endif
  86.     @(calback$):
  87. endp
  88.  
  89. Proc backup:
  90.     local i%
  91.     
  92.     while i%<xmax%
  93.         i%=i%+1
  94.         undo(i%)=data(i%)
  95.     endwh
  96.     saved%=0
  97. endp
  98.  
  99. Proc procu:
  100.     local i%,s
  101.     
  102.     while i%<xmax%
  103.         i%=i%+1
  104.         s=data(i%)
  105.         data(i%)=undo(i%)
  106.         undo(i%)=s
  107.     endwh
  108.     saved%=0
  109.     redraw:
  110. endp
  111.  
  112. proc redraw:
  113.     local i%,j%
  114.     onerr errhand
  115.     i%=1
  116.     j%=2
  117.     
  118.     busy "Redrawing"
  119.     poly%(1)=1
  120.     poly%(2)=data(1)+yoff%
  121.     poly%(3)=xmax%-2
  122.     
  123.     while i%<xmax%
  124.         i%=i%+1
  125.         j%=j%+2
  126.         poly%(j%)=2
  127.         poly%(j%+1)=int(data(i%))-int(data(i%-1))
  128.     endwh
  129.     cls
  130.     gborder 1
  131.     gpoly poly%()
  132.     busy off
  133.     return
  134.     
  135. errhand::
  136.     onerr off
  137.     busy off
  138.     error%:
  139.     procu:
  140. endp
  141.  
  142. proc procd:
  143.     local i%,j%,p%,t%
  144.     i%=1
  145.     j%=2
  146.     
  147.     busy "Showing difference"
  148.     poly%(1)=1
  149.     p%=data(1)-store(1)
  150.     poly%(2)=p%+yoff%
  151.     poly%(3)=xmax%-2
  152.     
  153.     while i%<xmax%
  154.         i%=i%+1
  155.         j%=j%+2
  156.         poly%(j%)=2
  157.         t%=data(i%)-store(i%)
  158.         poly%(j%+1)=t%-p%
  159.         p%=t%
  160.     endwh
  161.     cls
  162.     gborder 1
  163.     gpoly poly%()
  164.     busy off
  165. endp
  166.  
  167. proc procw:
  168.     local f&,w$(5)
  169.     w$="Wave "
  170.     
  171.     dinit
  172.         dlong nf&,w$+"1 frequency",1,xmax%/2
  173.         dfloat na,w$+"1 amplitude",-1,1
  174.         dfloat sp,w$+"1 start point",0,1
  175.         dChoice wt1%,w$+"1 type","Sine,Square"
  176.         dlong f&,w$+"2 frequency",0,xmax%/2
  177.         dfloat sa,w$+"2 amplitude",-1,1
  178.         dChoice wt2%,w$+"2 type","Sine,Square"
  179.     if dialog=0
  180.         return
  181.     elseif stable%=0
  182.         stable:
  183.     endif
  184.     
  185.     if f&
  186.         busy "Adding waveforms"
  187.     else
  188.         busy "Adding waveform"
  189.     endif
  190.     
  191.     backup:
  192.     if wt1%=1
  193.         snwave:(nf&,na,sp)
  194.     elseif wt1%=2
  195.         sqwave:(nf&,na,sp)
  196.     endif
  197.     if f&
  198.         if wt2%=1
  199.             snwave:(f&,sa,0.0)
  200.         elseif wt2%=2
  201.             sqwave:(f&,sa,0.0)
  202.         endif
  203.     endif
  204.     busy off
  205.     redraw:
  206. endp
  207.  
  208. proc snwave:(fq&,a,sp)
  209.     local i%,wp%,am
  210.     wp%=sp*xmax%
  211.     if wp%=0
  212.         wp%=xmax%
  213.     endif
  214.     
  215.     am=a*(yoff%-1)
  216.     
  217.     while i%<xmax%
  218.         i%=i%+1
  219.         data(i%)=data(i%)+am*sint(wp%)
  220.         wp%=wp%+fq&
  221.         if wp%>xmax%
  222.             wp%=wp%-xmax%
  223.         endif
  224.     endwh
  225. endp
  226.  
  227. proc sqwave:(fq&,a,sp)
  228.     local i%,wp%,am
  229.     wp%=sp*xmax%
  230.     if wp%=0
  231.         wp%=xmax%
  232.     endif
  233.     
  234.     am=a*(yoff%-1)
  235.     
  236.     while i%<xmax%
  237.         i%=i%+1
  238.         data(i%)=data(i%)+am*squt(wp%)
  239.         wp%=wp%+fq&
  240.         if wp%>xmax%
  241.             wp%=wp%-xmax%
  242.         endif
  243.     endwh
  244. endp
  245.  
  246. proc stable:
  247.     local i%,rd,v%,h%
  248.     h%=xmax%/2
  249.     v%=1
  250.     
  251.     busy "Building wavetables"
  252.     rd=2*pi/xmax%
  253.     while i%<xmax%
  254.         i%=i%+1
  255.         if i%=h%
  256.             v%=-v%
  257.         endif
  258.         squt(i%)=v%
  259.         sint(i%)=sin(i%*rd)
  260.     endwh
  261.     busy off
  262.     stable%=1
  263. endp
  264.  
  265. proc procg:
  266.     local i%
  267.     
  268.     dinit "Volume"
  269.         dfloat gn,"Gain",0,1000
  270.     if dialog=0
  271.         return
  272.     endif
  273.     busy "Adjusting volume"
  274.     backup:
  275.     while i%<xmax%
  276.         i%=i%+1
  277.         data(i%)=data(i%)*gn
  278.     endwh
  279.     busy off
  280.     redraw:
  281. endp
  282.  
  283. proc procp:
  284.     local i%
  285.     
  286.     dinit "Phase offset"
  287.         dlong fo&,"Amount",0,xmax%
  288.     if dialog=0
  289.         return
  290.     endif
  291.     busy "Adjusting phase"
  292.     backup:
  293.     i%=xmax%-fo&
  294.     while i%
  295.         data(i%+fo&)=data(i%)
  296.         i%=i%-1
  297.     endwh
  298.     busy off
  299.     redraw:
  300. endp
  301.  
  302. proc procl:
  303.     local i%,p
  304.     
  305.     dinit "Low pass filter"
  306.         dfloat lpg,"Gain",-5,5
  307.         dfloat lpf,"Frequency response",-5,5
  308.     if dialog=0
  309.         return
  310.     endif
  311.     busy "Filtering"
  312.     backup:
  313.     while i%<xmax%
  314.         i%=i%+1
  315.         data(i%)=data(i%)*lpg+p
  316.         p=data(i%)*lpf
  317.     endwh
  318.     busy off
  319.     redraw:
  320. endp
  321.  
  322. proc procc:
  323.     local i%
  324.     
  325.     busy "Clearing"
  326.     backup:
  327.     while i%<xmax%
  328.         i%=i%+1
  329.         data(i%)=0
  330.     endwh
  331.     busy off
  332.     redraw:
  333. endp
  334.  
  335. proc procz:
  336.     local i%
  337.     
  338.     busy "Converting"
  339.     backup:
  340.     while i%<xmax%
  341.         i%=i%+1
  342.         data(i%)=data(i%)-store(i%)
  343.     endwh
  344.     busy off
  345.     redraw:
  346. endp
  347.  
  348. proc proct:
  349.     local i%
  350.     
  351.     giprint "Phase inverted"
  352.     while i%<xmax%
  353.         i%=i%+1
  354.         data(i%)=-data(i%)
  355.     endwh
  356.     redraw:
  357. endp
  358.  
  359. proc procm:
  360.     local i%,w,s
  361.     w=1
  362.     s=1
  363.     
  364.     dinit "Mix waveform+store"
  365.         dfloat w,"Waveform gain",-5,5
  366.         dfloat s,"Store gain",-5,5
  367.     if dialog=0
  368.         return
  369.     endif
  370.     busy "Mixing"
  371.     backup:
  372.     while i%<xmax%
  373.         i%=i%+1
  374.         data(i%)=data(i%)*w+store(i%)*s
  375.     endwh
  376.     busy off
  377.     redraw:
  378. endp
  379.  
  380. proc procb:
  381.     local i%,b,r
  382.     b=0
  383.     
  384.     dinit "Move base offset"
  385.         dfloat b,"Shift",-5,5
  386.     if dialog=0
  387.         return
  388.     endif
  389.     r=-2*yoff%*b
  390.     busy "Shifting"
  391.     backup:
  392.     while i%<xmax%
  393.         i%=i%+1
  394.         data(i%)=data(i%)+r
  395.     endwh
  396.     busy off
  397.     redraw:
  398. endp
  399.  
  400. proc prock:
  401.     local dl1,dl2,i%,dk0,dk1,dk2,a
  402.     
  403.     dinit "Second order (IIR) filter"
  404.         dfloat kl0,"Coefficient L0",-5,5
  405.         dfloat kl1,"Coefficient L1",-5,5
  406.         dfloat kk1,"Coefficient K1",-5,5
  407.         dfloat kl2,"Coefficient L2",-5,5
  408.         dfloat kk2,"Coefficient K2",-5,5
  409.     if dialog=0
  410.         return
  411.     endif
  412.     busy "Applying filter"
  413.     backup:
  414.     while i%<xmax%
  415.         i%=i%+1
  416.         if i%>1
  417.             dl1=undo(i%-1)
  418.         endif
  419.         if i%>2
  420.             dl2=undo(i%-2)
  421.         endif
  422.         data(i%)=data(i%)*kl0+dl1*kl1+dl2*kl2+dk1*kk1+dk2*kk2
  423.         dk2=dk1
  424.         dk1=data(i%)
  425.     endwh
  426.     busy off
  427.     redraw:
  428. endp
  429.  
  430. proc procr:
  431.     redraw:
  432. endp
  433.  
  434. proc proch:
  435.     local i%
  436.     
  437.     while i%<xmax%
  438.         i%=i%+1
  439.         store(i%)=data(i%)
  440.     endwh
  441.     giprint "Waveform stored"
  442. endp
  443.  
  444. proc proci:
  445.     local i%
  446.     
  447.     backup:
  448.     while i%<xmax%
  449.         i%=i%+1
  450.         data(i%)=store(i%)
  451.     endwh
  452.     redraw:
  453. endp
  454.  
  455. proc proca:
  456.     local name$(130),nf%
  457.     name$=fname$
  458.     
  459.     dinit "Save as"
  460.         dfile name$,"",$11
  461.         dchoice nf%,"Use new file","Yes,No"
  462.     if dialog=0
  463.         return
  464.     endif
  465.     if nf%=1
  466.         fname$=name$
  467.     endif
  468.     saver%:(name$)
  469. endp
  470.  
  471. proc procs:
  472.     if saved%=0
  473.         saver%:(fname$)
  474.     else
  475.         giprint "Not Changed"
  476.     endif
  477. endp
  478.  
  479. proc proco:
  480.     local name$(130)
  481.     name$=fname$
  482.     
  483.     dinit "Open file"
  484.         dfile name$,"",$00
  485.     if dialog=0
  486.         return
  487.     endif
  488.     loader%:(name$)
  489. endp
  490.  
  491. proc procx:
  492.     procs:
  493.     stop
  494. endp
  495.  
  496. proc procv:
  497.     loader%:(fname$)
  498. endp
  499.  
  500. proc loader%:(name$)
  501.     local i%,er%
  502.     
  503.     trap open name$,A,dat
  504.     if error%:
  505.         return 0
  506.     endif
  507.     
  508.     busy "Loading"
  509.     backup:
  510.     while i%<xmax% and not eof
  511.         i%=i%+1
  512.         data(i%)=A.dat
  513.         next
  514.     endwh
  515.     busy off
  516.     close
  517.     fname$=name$
  518.     setname fname$
  519.     saved%=1
  520.     redraw:
  521.     return 1
  522. endp
  523.  
  524. proc saver%:(name$)
  525.     local i%
  526.     
  527.     trap delete name$
  528.     trap create name$,A,dat
  529.     if error%:
  530.         return 0
  531.     endif
  532.     
  533.     busy "Saving"
  534.     while i%<xmax%
  535.         i%=i%+1
  536.         A.dat=data(i%)
  537.         append
  538.     endwh
  539.     busy off
  540.     close
  541.     setname fname$
  542.     saved%=1
  543.     return 1
  544. endp
  545.  
  546. proc error%:
  547.     if err
  548.         dinit err$(err)
  549.         dbuttons "Continue",-27
  550.         dialog
  551.         return 1
  552.     endif
  553.     return 0
  554. endp
  555.  
  556. proc procn:
  557.     local name$(130)
  558.     
  559.     procs:
  560.     dinit "New file"
  561.         dfile name$,"",$11
  562.     if