70s Color Organ

Do you have a BASIC! program that you would like to share? Post it the the FTP server and tell us about it here.

70s Color Organ

Joined: April 15th, 2015, 4:57 am

June 7th, 2018, 6:36 am #1

I have to tweak this some more before I publish it, but I finally tried out Gregor's audio.record.peak function in oliBasic and modified my color therapy app to respond to sound.

Here is a preview:



Sent from my Moto E (4) using Tapatalk

Quote
Like
Share

Joined: April 15th, 2015, 4:57 am

June 7th, 2018, 3:18 pm #2

I would like to not have to store a recording so maybe Gregor could add a parameter to audio.record.start so that it could not actually record to a real file.

Here is the oliBasic code so far but again I hope it doesn't give people seizures..

Code: Select all

FN.DEF hsv2rgb(hue,saturation,value,r,g,b)
 LET r=0:g=0:b=0
 LET chroma=value*saturation
 LET hue1=hue/60

 LET x=chroma*(1-ABS(MOD(hue1, 2)-1))

 IF (hue1 >= 0 & hue1 <= 1)  
  r1=chroma:g1=x:b1=0
 ELSE if (hue1 >= 1 & hue1 <=2) 
  r1=x: g1=chroma:b1=0
 ELSE if (hue1 >= 2 & hue1 <=3) 
  r1=0:g1=chroma:b1=x
 ELSE if (hue1 >= 3 & hue1 <=4)
  r1=0: g1=x:b1=chroma
 ELSE if (hue1 >= 4 & hue1 <=5)
  r1=x:g1=0:b1=chroma
 ELSE if (hue1 >= 5 & hue1 <=6)
  r1=chroma:g1=0:b1=x
 ENDIF
 LET m=value-chroma
 r=r1+m:g=g1+m:b=b1+m
 r=255*r
 g=255*g
 b=255*b
FN.END

FN.DEF n(f)
 x=(RND()*3+1) *f
 IF RND()<0.5 THEN x=-x
 FN.RTN x
FN.END

FN.DEF f$(flag)
 IF flag THEN FN.RTN "on" ELSE FN.RTN "off"
FN.END

rf=1:gf=1:bf=1

GR.OPEN 255,0,0,0,0,0
WAKELOCK 2
nbox=13
GR.SCREEN w,h
again:
audio.record.stop
gr.cls

bx=FLOOR(w/nbox):hh=110
wx=FLOOR(w/bx):wy=FLOOR(h/bx)
undim grid[]
DIM grid[wx,wy]
GR.SET.ANTIALIAS 0

d=0.06
FOR y=1 TO wy
 FOR x=1 TO wx
GR.COLOR 0,0,0,0
  GR.RECT grid[x,y],(x-1)*bx,(y-1)*bx,x*bx,y*bx
 NEXT
NEXT
GR.RENDER
gr.color 120,255,255,255
gr.text.size h/10
gr.text.align 2
gr.text.draw t1,w/2,h/4,"tap to change"
gr.text.draw t2,w/2,3*h/4,"tap for menu"
gr.show t1
gr.show t2
gr.render
b=clock()

let ag=0
F=rnd()+1
LET xb=w/n(f)
LET yb=-w/n(f)
LET xr=w/n(f)
LET yr=w/n(f)
LET xg=w/n(f)
LET yg=w/n(f)
LET xbb=w/n(f)
LET ybb=-w/n(f)
LET xrr=w/n(f)
LET yrr=w/n(f)
LET xgg=w/n(f)
LET ygg=w/n(f)


d1=RND()*d
d2=RND()*d
d3=RND()*d
d4=RND()*d
d5=RND()*d
d5=RND()*d

audio.record.start "colororgan"


loop:
pause 15
audio.record.peak peak
peak=0.6+peak/(255*150)

let st=CLOCK():t++
tr=t*peak
tg=t*peak
tb=t*peak
FOR y=1 TO wy
 FOR x=1 TO wx
  LET xc=x/w:LET yc=y/h
  LET bb=SIN(xb*xc-yb*yc-d1*tb)+1
! LET bb+=0.5*SIN(xbb*xc-ybb*yc-d6*t)+1.5
  LET rr=SIN(xr*xc-yr*yc-d2*tr)+1
 !LET rr+=0.5*SIN(xrr*xc-yrr*yc-d4*t)+1.5
  LET gg=SIN(xg*xc+yg*yc-d3*tg)+1
! LET gg+=0.5*SIn(xgg*xc+ygg*yc-d5*t)+1.5
if hsv
call hsv2rgb(rf*rr*180,gf*gg/2,bf*bb/3,&r,&g,&b)
GR.COLOR 255,r,g,b
else
  GR.COLOR 255,hh*rr*rf,hh*gg*gf,hh*bb*bf
endif
  GR.PAINT.GET p:GR.MODIFY grid[x,y],"paint",p
 NEXT
NEXT

GR.RENDER

GR.TOUCH tt,xx,yy
if tt & yy < h/2 
 do
 gr.touch tt,xx,yy
 pause 50
 until !tt
 
 let ag=1:goto Again
endif
IF tt THEN GOSUB change
IF ag THEN GOTO again 


do
let e=clock()-st
if clock()-b >3000 then gr.hide t1:gr.hide t2
 until e > 15
GOTO loop

change:
hsv$=word$("off,on",hsv+1,",")
LIST.CREATE s,menu
LIST.ADD menu,"new","speed","red:"+f$(rf),"green:"+f$(gf),"blue:"+f$(bf),"grid","hsv:"+hsv$,"quit"

DIALOG.SELECT s,menu
SW.BEGIN s
 SW.CASE 8
  gr.close
  EXIT
  SW.BREAk
sw.case 7
  hsv=!hsv
  sw.break
sw.case 6
ag=1
do
   input "enter # boxes across 2-30",nbox,nbox,c
until !c & nbox >0 & nbox<31
sw.break
 SW.CASE 2
  DO
   INPUT "enter speed (0.01-1)",d,d,can
  UNTIL d>=0.01 & d <=1
  d1=RND()*d
  d2=RND()*d
  d3=RND()*d
  SW.BREAK
 SW.CASE 1
  ag=1 
  SW.BREAK
 SW.CASE 3
  rf=!rf
  SW.BREAK
 SW.CASE 4
  gf=!gf
  SW.BREAK
 SW.CASE 5
  bf=!bf
  SW.BREAK
SW.END

RETURN


Sent from my Moto E (4) using Tapatalk

Quote
Like
Share

Joined: July 10th, 2013, 9:11 am

June 8th, 2018, 8:39 am #3

Hi Chris


Unfortunately is there no way to detect a peak level without recording.
From time to time you have to stop and start again. 


Here is an interesting article on this topic:
https://stackoverflow.com/questions/106 ... ctually-gi

Loudness and brightness are almost logarithmically recognized by humans, so it is correct that you do not use logarithms and exponents for this type of application.

Maybe you have to give an opportunity to calibrate the device dependent maximum audio level.

Gregor
Quote
Like
Share

Joined: April 15th, 2015, 4:57 am

June 9th, 2018, 3:34 pm #4

Yes, I changed it so that it should be scale the peak value relative to a peak max (pmax) value.

I am trying to have it restart recording every 50 cycles (1 second) but am not sure it is working to clean out the old recorded data. Maybe I can also do a file delete on an ONBACKGROUND: interrupt.

Code: Select all

FN.DEF hsv2rgb(hue,saturation,value,r,g,b)
 LET r=0:g=0:b=0
 LET chroma=value*saturation
 LET hue1=hue/60

 LET x=chroma*(1-ABS(MOD(hue1, 2)-1))

 IF (hue1 >= 0 & hue1 <= 1)  
  r1=chroma:g1=x:b1=0
 ELSE if (hue1 >= 1 & hue1 <=2) 
  r1=x: g1=chroma:b1=0
 ELSE if (hue1 >= 2 & hue1 <=3) 
  r1=0:g1=chroma:b1=x
 ELSE if (hue1 >= 3 & hue1 <=4)
  r1=0: g1=x:b1=chroma
 ELSE if (hue1 >= 4 & hue1 <=5)
  r1=x:g1=0:b1=chroma
 ELSE if (hue1 >= 5 & hue1 <=6)
  r1=chroma:g1=0:b1=x
 ENDIF
 LET m=value-chroma
 r=r1+m:g=g1+m:b=b1+m
 r=255*r
 g=255*g
 b=255*b
FN.END

FN.DEF n(f)
 x=(RND()*3+1) *f
 IF RND()<0.5 THEN x=-x
 FN.RTN x
FN.END

FN.DEF f$(flag)
 IF flag THEN FN.RTN "on" ELSE FN.RTN "off"
FN.END

rf=1:gf=1:bf=1

GR.OPEN 255,0,0,0,0,0
WAKELOCK 2
nbox=13
GR.SCREEN w,h
again:
AUDIO.RECORD.STOP
GR.CLS

bx=FLOOR(w/nbox):hh=110
wx=FLOOR(w/bx):wy=FLOOR(h/bx)
UNDIM grid[]
DIM grid[wx,wy]
GR.SET.ANTIALIAS 0

d=0.1
FOR y=1 TO wy
 FOR x=1 TO wx
  GR.COLOR 0,0,0,0
  GR.RECT grid[x,y],(x-1)*bx,(y-1)*bx,x*bx,y*bx
 NEXT
NEXT
GR.RENDER
GR.COLOR 120,255,255,255
GR.TEXT.SIZE h/10
GR.TEXT.ALIGN 2
GR.TEXT.DRAW t1,w/2,h/4,"tap to change"
GR.TEXT.DRAW t2,w/2,3*h/4,"tap for menu"
GR.SHOW t1
GR.SHOW t2
GR.RENDER
b=CLOCK()

LET ag=0
F=RND()+1
xb=w/n(f)
yb=-w/n(f)
xr=w/n(f)
yr=w/n(f)
xg=w/n(f)
yg=w/n(f)
xbb=w/n(f)
ybb=-w/n(f)
xrr=w/n(f)
yrr=w/n(f)
xgg=w/n(f)
ygg=w/n(f)


d1=RND()*d
d2=RND()*d
d3=RND()*d
d4=RND()*d
d5=RND()*d
d5=RND()*d

pmax=0

filename$ = "NewSound.g3p"
filename$ = "NewSound.m4a"
! file.delete done, filename$ %If you use the original BASIC! you have to delete first!!!
! Command OPTIONS:
so = 1 %Source 0 Default; 1* Mic; 5 CAMCORDER; 6 VOICE_RECOGNITION;(7 VOICE_COMMUNICATION API level 11)
oF = 2 %OutputFormat 1* THREE_GPP(.g3p); 2 MPEG_4 (.mp4, .m4a)
eC = 3 %Encoder 1* AMR_NB; (2 AMR_WB; 3 AAC API level 10); (4 HE_AAC; 5 AAC_ELD API level 16)
sR = 48000 %(SamplingRate in samples per second API level 8) 44100*
eBR = 80000 %(EncodingBitRate in bits per second API level 8) 96000*
aC = 1 %(AudioChannels 1 or 2* API level 8) For one channel you get a mono output in a stereo file!
mFS = -1 %MaxFileSize in bytes, but the real size is more less! -1*
! If the max. file size is reached, the recording stopps sooner or later!
lat = 50 %(Latitude -90 to 90 degree API level 14) 
lon = 150 %(Longitude -180 to 180 degree API level 14)

AUDIO.RECORD.START filename$,so,oF,eC,sR,eBR,aC,mFS,lat,lon


loop:
PAUSE 20
AUDIO.RECORD.PEAK peak

pmax=MAX(pmax,peak)
p=peak/pmax+0.5

LET st=CLOCK():t++
IF MOD(t,50)=0
 ! start over every 50 cycles for privacy
 AUDIO.RECORD.STOP
 AUDIO.RECORD.START filename$,so,oF,eC,sR,eBR,aC,mFS,lat,lon
ENDIF
tr=t*p/2
tg=t*p/3
tb=t*p/4
FOR y=1 TO wy
 FOR x=1 TO wx
  LET xc=x/w:LET yc=y/h
  LET bb=SIN(xb*xc-yb*yc-d1*tb)+1
  LET rr=SIN(xr*xc-yr*yc-d2*tr)+1
  LET gg=SIN(xg*xc+yg*yc-d3*tg)+1
 
  IF hsv
   CALL hsv2rgb(rf*rr*180,gf*gg/2,bf*bb/3,&r,&g,&b)
   GR.COLOR 255,r,g,b
  ELSE
   GR.COLOR 255,hh*rr*rf,hh*gg*gf,hh*bb*bf
  ENDIF
  GR.PAINT.GET p:GR.MODIFY grid[x,y],"paint",p
 NEXT
NEXT

GR.RENDER

GR.TOUCH tt,xx,yy
IF tt & yy < h/2 
 DO
  GR.TOUCH tt,xx,yy
  PAUSE 50
 UNTIL !tt

 LET ag=1:GOTO Again
ENDIF
IF tt THEN GOSUB change
IF ag THEN GOTO again 


DO
 LET e=CLOCK()-st
 IF CLOCK()-b >3000 THEN GR.HIDE t1:GR.HIDE t2
UNTIL e > 15
GOTO loop

change:
hsv$=WORD$("off,on",hsv+1,",")
LIST.CREATE s,menu
LIST.ADD menu,"new","speed","red:"+f$(rf),"green:"+f$(gf),"blue:"+f$(bf),"grid","hsv:"+hsv$,"quit"

DIALOG.SELECT s,menu
SW.BEGIN s
 SW.CASE 8
  GR.CLOSE
  EXIT
  SW.BREAK
 SW.CASE 7
  hsv=!hsv
  SW.BREAK
 SW.CASE 6
  ag=1
  DO
   INPUT "enter # boxes across 2-30",nbox,nbox,c
  UNTIL !c & nbox >0 & nbox<31
  SW.BREAK
 SW.CASE 2
  DO
   INPUT "enter speed (0.01-1)",d,d,can
  UNTIL d>=0.01 & d <=1
  d1=RND()*d
  d2=RND()*d
  d3=RND()*d
  SW.BREAK
 SW.CASE 1
  ag=1 
  SW.BREAK
 SW.CASE 3
  rf=!rf
  SW.BREAK
 SW.CASE 4
  gf=!gf
  SW.BREAK
 SW.CASE 5
  bf=!bf
  SW.BREAK
SW.END

RETURN

Sent from my Moto E (4) using Tapatalk

Quote
Like
Share

Joined: April 15th, 2015, 4:57 am

June 16th, 2018, 6:53 pm #5

Here is another oliBasic color organ that uses colored boxes:

Code: Select all

REM Start of BASIC! Program
REM color boxes demo
REM by mookiebearapps 2018
REM
REM WARNING/DISCLAIMER: PLEASE DON'T USE THIS IF YOU HAVE EPILEPSY

FN.DEF hsv2rgb(hue,saturation,value,r,g,b)
 LET r=0:g=0:b=0
 LET chroma=value*saturation
 LET hue1=hue/60

 LET x=chroma*(1-ABS(MOD(hue1, 2)-1))

 IF (hue1 >= 0 & hue1 <= 1)  
  r1=chroma:g1=x:b1=0
 ELSE if (hue1 >= 1 & hue1 <=2) 
  r1=x: g1=chroma:b1=0
 ELSE if (hue1 >= 2 & hue1 <=3) 
  r1=0:g1=chroma:b1=x
 ELSE if (hue1 >= 3 & hue1 <=4)
  r1=0: g1=x:b1=chroma
 ELSE if (hue1 >= 4 & hue1 <=5)
  r1=x:g1=0:b1=chroma
 ELSE if (hue1 >= 5 & hue1 <=6)
  r1=chroma:g1=0:b1=x
 ENDIF
 LET m=value-chroma
 r=r1+m:g=g1+m:b=b1+m
 r=255*r
 g=255*g
 b=255*b
FN.END


GR.OPEN 255,0,0,0,0,1
GR.SCREEN w,h
LET h2=h/2
LET w2=w/2
GR.SET.ANTIALIAS 0
GR.SET.STROKE 2
fill_mode=1
Rd=w/4

wakelock 4

! draw boxes
nboxes=40

LIST.CREATE n,boxes

FOR I=0 TO 1 STEP 1/nboxes
 GR.RECT rr,i*w,i*h,(1-i)*w,(1-i)*h
 GR.SHOW rr
 LIST.ADD boxes,rr
 n++
NEXT


audio.record.start "tempcolor"
pmax=1
t=1
loop:

!GR.TOUCH t,x,y

IF t 
 audio.record.peak p
! let value=y/h
 value=0.9
 let sat=0.99


rot+=0.1
if frac(rot/10)=0 then file.delete e,"tempcolor"

pmax=max(p,pmax)

! let hue=360*x/w
 let hue=mod(270*max(p/pmax,0.1)+rot,360)
 
 !shift paints
 FOR I=1 TO n-1 STEP 1
  LIST.GET boxes,i+1,bx
  GR.GET.VALUE bx,"paint",p
  LIST.GET boxes,i,bx
  GR.MODIFY bx,"paint",p
 NEXT

 CALL hsv2rgb(hue,sat,value,&r,&g,&b)
 GR.COLOR 255,r,g,b
 GR.PAINT.GET p
 LIST.GET boxes,n,bx
 GR.MODIFY bx,"paint",p
 IF BACKGROUND() THEN wakelock 5:gr.close:EXIT
 GR.RENDER
ENDIF
PAUSE 10

GOTO loop

ONBACKKEY:
gr.close
wakelock 5
EXIT


Sent from my Moto E (4) using Tapatalk

Quote
Like
Share