BBC BASIC for Windows
Programming >> Sound, Music and Video >> Sound Utility program. try it out. TEST
http://bb4w.conforums.com/index.cgi?board=multimedia&action=display&num=1466057297
Sound Utility program. try it out. TEST
Post by michael on Jun 16th, 2016, 06:08am

It was tough to get the kinks worked out on this. But I think it needs fine adjustment on some bars with buttons.

Duration should be set to 1 because you technically only need to press the test button to lengthen the sound.

The extra PROCs and stuff that isn't being used is there for possible expansion once I figure if this is going to be a
good project.
Code:
      INSTALL @lib$+"STRINGLIB"
      REM SET YOUR GRAPHICS RESOLUTION TO 1024 x 600 to use this program properly
      PROC_screen(1024,600)
      REM Turn off the text cursor _
      OFF
      VDU 5 : REM Treat text as graphics (transparent background)
      REM pr(x,y,"message".textcolor0-15,R 0-255,G 0-255,B 0-255)
      status$=""
      vol=0:volume=0:channel=0:pitch=0:duration=0
      a%=FNgraph(500,100,"setup",15)
      a%=FNgraph(500,150,"setup",35)
      a%=FNgraph(500,200,"setup",255)
      a%=FNgraph(500,250,"setup",254)
      a%=FNbutton(500,500,"setup")
      REPEAT
        vol=FNgraph(500,100,"VOLUME   ",15)
        channel=FNgraph(500,150,"CHANNEL  ",35)
        pitch=FNgraph(500,200,"PITCH    ",255)
        duration=FNgraph(500,250,"DURATION ",254)
        test=FNbutton(500,500,"TEST  ")
        IF duration=0 THEN duration=1
        IF test=TRUE THEN :PROCpr(100,600,15,"PLAYING  ",255,255,255):SOUND channel,0-vol,pitch,duration
        test%=0
      UNTIL status$="no"
      WAIT 0
      END
      DEF FNbutton(x,y,what$)
      LOCAL result%,moux,mouy,b,dist%
      dist%=LENwhat$
      dist%=dist%*22
      MOUSE moux,mouy,b
      IF what$<>"setup" THEN
        PROCpr(x,y,15,what$,200,200,200)
        IF moux>x-5 AND moux<x+dist% AND mouy>y-25 AND mouy<y+20 THEN PROCpr(x,y,15,what$,255,255,255)
        IF moux>x-5 AND moux<x+dist% AND mouy>y-25 AND mouy<y+20 AND b=4 THEN
          result%=TRUE
          PROCpr(x,y,15,what$,200,200,200)
        ENDIF
      ENDIF
      IF what$="setup" THEN PROCpr(x,y,15,"      ",200,200,200)
      =result%
      DEF FNgraph(xx,yy,what$,max)
      LOCAL x,y,b
      la=0
      PRIVATE channel,pitch,duration
      PRIVATE vol,lx,ly,lly
      MOUSE x,y,b
      *REFRESH OFF
      IF what$="setup" THEN PROCsbox(xx-15,yy+10,xx+max+15,yy+50)
      IF what$<>"setup" THEN PROCpr(xx-230,yy+40,15,what$,255,255,255)
      IF x>xx-2 AND y>yy AND x<xx+max+2 AND y<yy+50 AND b=4 THEN
        PROCsbox(xx-15,yy+10,xx+max+15,yy+50)
        la=x-xx
        PROCcolor("f",0,0,0)
        LINE x,yy+12,x,yy+46
        lx=x:ly=yy+12:lly=yy+46
        IF what$="CHANNEL  " THEN
          IF la<10 THEN la=0
          IF la>9 AND la<20 THEN la=1
          IF la>19 AND la<30 THEN la=2
          IF la>29 AND la<40 THEN la=3
        ENDIF
        IF what$="VOLUME   " THEN IF la>15 THEN la=15
        IF what$="PITCH    " THEN IF la>255 THEN la=255
        IF what$="DURATION " THEN IF la=0 THEN la=1
        PROCpr(xx+280,yy+40,15,STR$(la)+"   ",255,255,255)
        IF what$="VOLUME   " THEN vol=la
        IF what$="CHANNEL  " THEN channel=la
        IF what$="PITCH    " THEN pitch=la
        IF what$="DURATION " THEN duration=la
      ENDIF
      *REFRESH
      IF what$="VOLUME   " THEN la=vol
      IF what$="CHANNEL  " THEN la=channel
      IF what$="PITCH    " THEN la=pitch
      IF what$="DURATION " THEN la=duration
      =la
      DEF PROC_screen(h,v)
      REM       width;height;charwidth,charheight,number of colors,character set
      VDU 23,22,h;v;8,15,16,1 :REM max width is 1920 and 1440 height
      ENDPROC
      DEF PROCsbox(x%,y%,w%,h%)
      LOCAL ry%,sx%,sy%
      sx%=x%:sy%=y%
      IF x%>w% THEN x%=w%:w%=sx%
      IF y%>h% THEN y%=h%:h%=sy%
      ry%=y%
      PROCcolor("f",255,255,255)
      REPEAT
        LINE x%,y%,w%,y%
        y%=y%+1
      UNTIL y%=h%
      y%=ry%
      PROCcolor("f",0,0,0)
      LINE x%+2,y%+2,w%-2,y%+2
      LINE w%-2,y%+2,w%-2,h%-4
      LINE w%-2,h%-4,x%+2,h%-4
      LINE x%+2,h%-4,x%+2,y%+2
      ENDPROC
      REM H,V,TEXTLIMIT (simpler?)
      DEF PROCinput(bx,by,textlimit)
      LOCAL rback%,gback%,bback%,remains$,sl%
      PRIVATE cursor%
      rback%=200:gback%=200:bback%=200
      LOCAL rfore%,gfore%,bfore%,fi
      rfore%=0:gfore=0:bfore=0
      gbx%=bx:gby%=by:initialx%=0:sl%=0:key$="":MESSAGE$="":MES$=""
      initialx%=textlimit*16.2
      FOR fi=1 TO 55
        PROCcolor("f",200,200,200):LINE bx,by+20-fi,bx+initialx%+8,by+20-fi
      NEXT fi
      PROCcolor("f",0,0,0):LINE bx,by+20,bx+initialx%+8,by+20:LINE bx,by+20-fi,bx+initialx%+8,by+20-fi:
      REPEAT
        REPEAT
          key$ =INKEY$(1)
          PROCcolor("F",rfore%,gfore%,bfore%)
          MOVE bx,by:PRINT MESSAGE$;"_" :* REFRESH
          sl%=LEN(MESSAGE$)
          remains%=sl%-cursor%
          lstring$=LEFT$(MESSAGE$,cursor%):rstring$=RIGHT$(MESSAGE$,remains%)
        UNTIL key$ <>""
        sl%=LEN(MESSAGE$)
        IF INKEY(-48) sl%=LEN(MESSAGE$)-1:key$=""
        REPEAT UNTIL INKEY(0)=-1
        IF MESSAGE$<> MESSAGE$ OR sl%<LEN(MESSAGE$) THEN
          PROCcolor("F",rback%,gback%,bback%)
          MOVE bx,by
          PRINT MESSAGE$;"_"
        ENDIF
        MES$=MID$(MESSAGE$,0,sl%)
        MESSAGE$=MES$
        PROCcolor("F",rback%,gback%,bback%):MOVE bx,by:PRINT MESSAGE$;"_"
        IF LEN(key$) = 1 THEN
          IF LEN(MESSAGE$)<textlimit THEN PROCcolor("F",rback%,gback%,bback%):MOVE bx,by:PRINT MESSAGE$;"_": MESSAGE$=MESSAGE$+key$:* REFRESH OFF
          REM (jump)
        ENDIF
      UNTIL INKEY(-74)
      * REFRESH ON
      ENDPROC
      REM ***************End of INPUT routine ************
      REM ***********************this is my super custom text box tool ***********************
      REM X,Y,text color,boarder color,message,r,g,b
      REM ************************************************************************
      DEF PROCpr(X,Y,C,msg$,r,g,b)
      initialx%=LEN(msg$)
      COLOUR 0,r,g,b
      GCOL 0
      LET tx= X+initialx%+25
      LET ty= Y:reduction%=0
      reduction%=initialx%/2
      reduction%=reduction%*6
      IF initialx%<20 THEN reduction%=reduction%/2
      initialx%=initialx%*22-reduction%
      FOR fill=12 TO 48
        LINE X-3,Y+20-fill,X+initialx%+8,Y+20-fill
      NEXT fill
      COLOUR 0,0,0,0
      GCOL 0
      MOVE tx,ty
      PRINT msg$
      MOVE 0,0 REM hide that thing
      ENDPROC
      REM ******************this is a custom Foreground and Background control tool (too much?) *****************
      REM color "F"or"B", r,g,b
      DEF PROCcolor(fb$,r%,g%,b%)
      IF fb$="f" OR fb$="F" THEN COLOUR 0,r%,g%,b% : GCOL 0
      IF fb$="b" OR fb$="B" THEN COLOUR 1,r%,g%,b% : GCOL 128+1
      ENDPROC
Re: Sound Utility program. try it out. TEST
Post by DDRM on Jun 16th, 2016, 08:00am

Hi Michael,

That's shaping up nicely. I agree some sliders might be better as buttons - for example, the channel. Might you extend it to allow the playing of multiple channels, to allow you to build up sounds with harmonics, for example? One option might be to provide a set of sliders for each channel.

The "playing" button doesn't seem to disappear again once the sound finishes. Is it meant to?

I agree the sliders could do with fine-tuning - the working range doesn't quite fill the box, which feels a little counterintuitive. I like the way you report the value in the box - should there be default values, which show when you start?

Do you know that you can convert channel 0 to a tone channel instead of a noise channel by adding 128 to the value in *TEMPO? That would allow four part harmony, or more complex harmonics.

Now to add a designer for ENVELOPE - which is an incrediby powerful command once you get to grips with it.

Here's a cut-down version of a program I wrote to practise bell ringing (really designed for handbell ringing) to show a bell-like sound:
Code:
      MODE 10
      NB%=30
      REM DATA 4,12,20,24,32,40,48    :REM You can add this data for another 7 bells, but they don't sound as nice
      DATA 52,60,68,72,80,88,96,100,108,116,120,128,136,144,148,156,164,168,176,184,192,196,204,212,216,224,232,240,244,252
      DIM BP%(NB%),b%(NB%,1)
      FOR x%=1 TO NB%
        READ BP%(x%-1)
      NEXT x%

      *TEMPO 132
      REM 132 = 128 + 4. The 128 means use 4 channel sound; the 4 gives 25 "beats" per second for note duration
      ENVELOPE 1,128+2,0,0,0,1,10,127,127,-2,-1,-4,126,0    :REM Makes a nice bell sound

      NumRinging%=8
      NumChanging%=5
      HandStrokeGap%=FALSE
      ringFast%=FALSE
      method%=0
      mbell%=0
      zbell%=0

      bellsep%=80/SQR(NumRinging%)
      CLS
      FOR x%=1 TO NumRinging%
        b%(x%,0)=x%
        b%(x%,1)=x%
      NEXT x%

      PROCPlainHunt(NumChanging%,NumRinging%)

      END
      :
      DEFPROCPlainHunt(nc%,nb%)
      LOCAL x%
      PROCRing2(NumRinging%)

      FOR x%=1 TO nc%
        PROCHunt2(nc%)
        PROCRing2(nb%)
      NEXT x%
      ENDPROC
      :
      DEFPROCRing2(nb%)
      LOCAL x%,y%,mp%,zp%,k$,t$
      FOR y%=0 TO 1
        FOR x%=1 TO nb%
          IF b%(x%,y%)=mbell% THEN mp%=x%
          IF b%(x%,y%)=zbell% THEN zp%=x%
        NEXT x%
        FOR x%=1 TO nb%
          COLOUR 128
          WAIT bellsep%
          IF (x%<>mp%) AND (x%<>zp%) THEN SOUND &10+(x% MOD 4),1,BP%(nb%-b%(x%,y%)),bellsep%
          IF b%(x%,y%)=1 THEN COLOUR 129
          PRINT TAB(x%*3);STR$(b%(x%,y%));
        NEXT x%
        PRINT
      NEXT y%
      IF HandStrokeGap% THEN WAIT  bellsep%
      ENDPROC
      :
      DEFPROCHunt2(nb%)
      LOCAL x%,y%
      FOR x%=1 TO nb%-1 STEP 2
        b%(x%,0)=b%(x%+1,1)
        b%(x%+1,0)=b%(x%,1)
      NEXT x%
      IF (nb% MOD 2)=1 THEN b%(nb%,0)=b%(nb%,1)
      b%(1,1)=b%(1,0)
      IF (nb% MOD 2)=0 THEN b%(nb%,1)=b%(nb%,0)
      FOR x%=2 TO nb%-1 STEP 2
        b%(x%,1)=b%(x%+1,0)
        b%(x%+1,1)=b%(x%,0)
      NEXT x%
      ENDPROC

...and here's the engine noise from my proto-flightsim:
Code:
      v=3
      ENVELOPE 1,1,5,-5,0,2,2,0,100,0,0,0,100,100
      SOUND 1,1,40+10*v,1
      WAIT 100
      SOUND 1,0,0,0


Best wishes,

D
Re: Sound Utility program. try it out. TEST
Post by michael on Jun 16th, 2016, 1:55pm

I did have it clear the message, but it would clear it so fast that I couldn't see it. I may have to work it into a condition, just like the flashing button, OR
maybe make the flashing button turn into PLAYING as long as it is pressed.
I was going to try to make a tool for creating a computer voice. There would be many different tones and abrasive sounds involved in making a voice.
So many channels and settings would be required. to test the mix
So I might have 3 samples to mix to make the sound of "p" or a