Author |
Topic: Sound Utility program. try it out. TEST (Read 490 times) |
|
michael
Senior Member
member is offline
Posts: 335
|
 |
Sound Utility program. try it out. TEST
« Thread started 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
|
| « Last Edit: Jun 16th, 2016, 06:11am by michael » |
 Logged
|
I like making program generators and like reinventing the wheel
|
|
|
DDRM
Administrator
member is offline
Gender: 
Posts: 321
|
|
Re: Sound Utility program. try it out. TEST
« Reply #1 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
|
|
Logged
|
|
|
|
michael
Senior Member
member is offline
Posts: 335
|
|
Re: Sound Utility program. try it out. TEST
« Reply #2 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
|
| « Last Edit: Jun 16th, 2016, 2:01pm by michael » |
Logged
|
I like making program generators and like reinventing the wheel
|
|
|
|
