Simple Online Radio

Coolman · Post by **Coolman** » Apr 10, 2012 13:22

nice but with windows 7 64 bit, I see only empty black window, I tried in a winxp vm, it works but it is not stable. program crashes sometimes and when it is restarted I have the same problem of blank black window ...

Merick · Post by **Merick** » Apr 10, 2012 14:48

I've got win7 64 bit too, and it runs fine for me.

If you are running this from the same folder as the original version, try deleting the radio.ini file, my version has more info saved to the ini, but if an older radio.ini exists it will try to load from it and so most of the colors will end up black.

Coolman · Post by **Coolman** » Apr 10, 2012 15:11

Merick wrote:I've got win7 64 bit too, and it runs fine for me.

If you are running this from the same folder as the original version, try deleting the radio.ini file, my version has more info saved to the ini, but if an older radio.ini exists it will try to load from it and so most of the colors will end up black.

it was that. it works fine now. Having said that I personally preferes green color, I changed. nice improvement. it would surely more to enforce a skin directly. I have not seen a post about it for now ...

Merick · Post by **Merick** » Apr 10, 2012 21:00

Another edit, if the stream has shoutcast metadata in it, it will now show the song title if available. You will need to use the newer import lib and dll from here to get it to work though: http://www.freebasic.net/forum/viewtopi ... 14&t=19277

Code: Select all

#Include "fbgfx.bi"
#Include "bass.bi"
#Include "file.bi"

Using fb

#macro closeout()
o.flag=2
Dim As Integer X, Y
ScreenControl GET_WINDOW_POS, X, Y
'	If X<>PosX And Y<>PosY Then
Open FileIni For binary access write As #1
Write #1, o.current, X, Y, foreground, background, soundgraph, highlight, title
Close #1
'	EndIf
#endmacro
' macro by dodicat
#macro closebox(colour)
#define incircle(cx,cy,radius,x,y) ((cx)-(x))*((cx)-(x)) +((cy)-(y))*((cy)-(y))<= (radius)*(radius)
Scope
var mx=0,my=0,mb=0,wx=0
Screeninfo wx
Line(wx-10,1)-(wx-2,9),(colour),bf
Draw String(wx-9,1),"x"
Getmouse mx,my,,mb
If incircle(wx-6,6,6,mx,my) And mb=1 then
	closeout()
endif
End Scope
#endmacro

Dim Shared As String FileIni : FileIni = "Radio.ini"
Dim Shared As Integer PosX, PosY : PosX = 0 : PosY = 0
Dim Shared as integer foreground, background, highlight, soundgraph, title 'skin colors
Dim Shared as string bgpattern 'background pattern
Dim shared as integer M_pressed 'mouse button indicator for moving the window
dim shared as integer mx,my

Sub Split(Text As String, Delim As String = " ", Count As Long = -1, Ret() As String)

	Dim As Long x, p
	If Count < 1 Then
		Do
			x = InStr(x + 1, Text, Delim)
			p += 1
		Loop Until x = 0
		Count = p - 1
	ElseIf Count = 1 Then
		ReDim Ret(Count - 1)
		Ret(0) = Text
	Else
		Count -= 1
	End If
	Dim RetVal(Count) As Long
	x = 0
	p = 0
	Do Until p = Count
		x = InStr(x + 1,Text,Delim)
		RetVal(p) = x
		p += 1
	Loop
	ReDim Ret(Count)
	Ret(0) = Left(Text, RetVal(0) - 1 )
	p = 1
	Do Until p = Count
		Ret(p) = Mid(Text, RetVal(p - 1) + 1, RetVal(p) - RetVal(p - 1) - 1 )
		p += 1
	Loop
	Ret(Count) = Mid(Text, RetVal(Count - 1) + 1)

End Sub


foreground = 10
background = 0
soundgraph = 40
highlight  = 12
title      = 14

Type CoordinatesMouse
	x As Integer
	y As Integer
End Type

Type tobject
	As Integer Nb=1
	As Integer current=1
	As BOOL flag
	e As EVENT
	stream As HSTREAM
	mutex As Any Ptr
	Thread As Any Ptr
	MC As CoordinatesMouse
	tagM(1 To 27) As String
End Type

Dim Shared o As tobject

If FileExists(FileIni) Then
	Open FileIni For Input As #1
	Input #1, o.current, PosX, PosY, foreground, background, soundgraph, highlight, title
	Close #1
EndIf

Dim Shared scrbuf As Byte Ptr
Dim Shared scrsize As Integer
Dim Shared scrhei As Integer
Dim Shared scrpitch As Integer

Screen 13,,,(GFX_WINDOWED Or GFX_NO_SWITCH or GFX_NO_FRAME)

If PosX>0 And PosY>0 Then ScreenControl SET_WINDOW_POS, PosX, PosY
scrbuf = ScreenPtr: Assert( scrbuf <> 0 )
ScreenInfo( , scrhei, , , scrpitch )
scrsize = scrpitch * scrhei

Sub Load_m3u()
	Open "List.txt" For Input As #1
	If Err>0 Then
		Print "File List.txt not found!"
		Sleep
		end
	EndIf
	For a As Integer=1 To 27
		Line Input #1,o.tagM(a)
	Next
	Close #1
End Sub

Sub DrawAll(Nb As Integer)
	Dim As Integer count=1
	Line(0,0)-(319,199),foreground,B
	Line(8,12)-(312,95),foreground,B
	Line(8,114)-(312,194),foreground,B
	Line(105,12)-(213,12),background
	Line(104,6)-(214,16),foreground,B
	if background = 0 then
		paint (4,4), bgpattern, foreground
	else
		paint (4,4), background,foreground
	endif
	Draw String (112,8),"Online Radio",title
	closebox(4)

	For h As Integer=1 To 3
		For w As Integer=1 To 9
			If Count>9 Then
				If Count<>nb Then
					Circle(w*34-11,h*25+105),12,foreground
					Draw String (w*34-19,h*25+102),Str(count),foreground
				Else
					Circle(w*34-11,h*25+105),12,highlight
					Draw String (w*34-19,h*25+102),Str(count),highlight
				EndIf
			Else
				If Count<>nb Then
					Circle(w*34-11,h*25+105),12,foreground
					Draw String (w*34-14,h*25+102),Str(count),foreground
				Else
					Circle(w*34-11,h*25+105),12,highlight
					Draw String (w*34-14,h*25+102),Str(count),highlight
				EndIf
			EndIf
			Count+=1
		Next
	Next
End Sub

Sub DrawMap(text As String Ptr)
	MutexLock(o.mutex)
	dim as string current_meta, new_meta, meta(), song, station, txt
	dim as zstring ptr test
	station = ""
	Dim As Integer L,L1,L2,c, switch
	Dim As single FFT(1024)
	switch=0
	o.flag=0
	Do
		
		new_meta = *BASS_ChannelGetTags(o.stream,BASS_TAG_META)
		if new_meta <>"" andalso new_meta<>current_meta then
			
			
			current_meta=new_meta
			split(current_meta, ";",,meta(0))
			song = meta(0)
			if instr(ucase(song),"TITLE") then
				c = instr(song,"'")
				song = mid(song,c+1)
				song = left(song, len(song)-1)
			endif
			
			if song = "" then song = "Song title not found"

			if ubound(meta) >=1 then station = meta(1)

			if instr(ucase(station), "STREAMURL") then
				c = instr(station,"'")
				station = mid(station,c+1)
				station = left(station, len(station)-1)
			endif

			if len(station) < 4 then
				station = *text
			endif

			L1=Len(station)
			L2=len(song)

			If L1<40 Then
				L=(320-L1*8)\2
			Else
				L=0
			EndIf

		endif

		L+=1
		If L=320 Then
			switch = switch xor -1
			L=-(L1*8)
			swap L1,L2
		endif
		ScreenLock()
		DrawAll(o.current)
		if switch then
			Draw String (L,101),station,highlight
		else
			Draw String (L,101),song,highlight
		endif
		Var VCH=BASS_ChannelGetData(o.stream,@FFT(0),BASS_DATA_FFT2048)
		For a As Integer=0 To 50
			Dim As Integer value=Fix(FFT(a)*500)
			If VCH = -1 Then
				Value=1
			EndIf
			If value>70 Then value=70
			Line(10+(a*2),90-value)-step(1,value),soundgraph,B
			Line(110+(a*2),90-value)-step(-1,value),soundgraph,B
			Line(210+(a*2),90-value)-step(-1,value),soundgraph,B
		Next
		ScreenUnlock()
		'PCopy
		Sleep 20
		'Cls()
		Clear *scrbuf, 0, scrsize
		If o.flag=2 Then
			end
		EndIf
	Loop Until o.flag=1
	MutexUnLock(o.mutex)
End Sub

Sub ClickEvent()
	Dim As Integer count
	Getmouse(o.MC.x,o.MC.y)
	if ((o.MC.x-312) <= 8) andalso o.MC.y <=8 then screenevent
	For h As Integer=1 To 3
		For w As Integer=1 To 9
			count+=1
			If o.MC.x>=w*34-23 And o.MC.x<=w*34+2 And o.MC.y>=h*25+96 And o.MC.y<=h*25+117 Then
				o.flag=1
				o.current=count
				o.Thread=ThreadCreate(Cast(Any Ptr,@DrawMap),@o.tagM(o.current))
				BASS_StreamFree(o.stream)
				o.stream=BASS_StreamCreateURL(o.tagM(o.current), 0, 0, 0, 0)
				BASS_ChannelPlay(o.stream,0)
			EndIf
		Next
	Next
End Sub

function LoadPattern() as string
	open "pattern.ini" for input as #2
	dim tile as string
	dim c as uinteger
	for y  as integer = 0 to 7
		for x as integer = 0 to 7
			input #2,c
			tile &= chr(c)
		next x
	next y
	close #2
	return tile
end function

if background = 0 then bgpattern = LoadPattern()

Sub main()
	BASS_Init(-1, 44100, 0,0,0)
	Load_m3u()
	DrawAll(o.current)
	o.stream=BASS_StreamCreateURL(o.tagM(o.current), 0, 0, 0, 0)
	If o.stream<>0 Then
		BASS_ChannelPlay(o.stream,0)
	EndIf
	o.mutex = MutexCreate
	o.Thread=ThreadCreate(Cast(Any Ptr,@DrawMap),@o.tagM(o.current))
	Do
		If (ScreenEvent(@o.e)) Then
			Select Case o.e.type
				Case EVENT_MOUSE_BUTTON_PRESS
					M_pressed = -1
					closebox(4)
				Case EVENT_MOUSE_BUTTON_RELEASE
					M_pressed = 0
					ClickEvent()
				Case EVENT_MOUSE_MOVE
					If (M_pressed) Then
						ScreenControl GET_WINDOW_POS, mx, my
						ScreenControl SET_WINDOW_POS, mx + o.e.dx, my + o.e.dy
					End If
				Case EVENT_WINDOW_CLOSE
					closeout()
			End Select
		End If

		Sleep 1
	Loop
End Sub

main()

Coolman · Post by **Coolman** » Apr 10, 2012 23:21

Good idea...

oog · Post by **oog** » Apr 15, 2012 18:27

This is a very good Project.
I used parts of it to include a radio to TileCity, now I can drive and fly around with music - very cool.
Many thanks to VANYA for this program.

Coolman · Post by **Coolman** » Nov 24, 2019 19:32

I have slightly modified the source code because the current version is very unstable under linux kde. it is intended for linux but it works under windows...

it is necessary to copy libbass.so : sudo cp libbass.so /usr/lib

I changed the name: OnlineRadio

I also changed the name of the file that contains the radio link: OnlineRadio.txt

Here is the code:

Code: Select all

#Include "fbgfx.bi"
#Include "bass.bi"
#Include "file.bi"
Using fb
Dim Shared As String FileIni : FileIni = "OnlineRadio.ini"
Dim Shared As Integer PosX, PosY, Num : PosX = 0 : PosY = 0 : Num = 0
If FileExists(FileIni) Then
   Open FileIni For Input As #1   
      Input #1, PosX, PosY, Num    
   Close #1   
EndIf
Dim Shared scrbuf As Byte Ptr
Dim Shared scrsize As Integer
Dim Shared scrhei As Integer
Dim Shared scrpitch As Integer
Screen 13,,2,(GFX_WINDOWED Or GFX_NO_SWITCH)
If PosX>0 And PosY>0 Then ScreenControl SET_WINDOW_POS, PosX, PosY
scrbuf = ScreenPtr: Assert( scrbuf <> 0 )
ScreenInfo( , scrhei, , , scrpitch )
scrsize = scrpitch * scrhei
Type CoordinatesMouse
   x As Integer
   y As Integer
End Type
Type tobject
   As Integer Nb=1
   As Integer current=1
   As BOOL flag
   e As EVENT
   stream As HSTREAM
   mutex As Any Ptr
   Thread As Any Ptr
   MC As CoordinatesMouse
   tagM(1 To 27) As String
End Type
Dim Shared o As tobject
Sub Load_m3u()
   Open "OnlineRadio.txt" For Input As #1
   If Err>0 Then
      Print "File OnlineRadio.txt not found!"
      Sleep
      end
   EndIf
   For a As Integer=1 To 27
      Line Input #1,o.tagM(a)
   Next
   Close #1
End Sub
Sub DrawAll(Nb As Integer)
   Dim As Integer count=1   
   Line(5,12)-(313,95),7,B   
   Line(105,12)-(213,12),0
   Draw String (112,8),"Online Radio",2
   Line(5,114)-(313,194),7,B   
   For h As Integer=1 To 3
      For w As Integer=1 To 9         
         If Count>9 Then
            If Count<>nb Then
               Circle(w*34-11,h*25+105),12,7
               Draw String (w*34-19,h*25+102),Str(count),7
            Else
               Circle(w*34-11,h*25+105),12,2
               Draw String (w*34-19,h*25+102),Str(count),2               
            EndIf
         Else
            If Count<>nb Then
               Circle(w*34-11,h*25+105),12,7
               Draw String (w*34-14,h*25+102),Str(count),7
            Else
                Circle(w*34-11,h*25+105),12,2
               Draw String (w*34-14,h*25+102),Str(count),2               
            EndIf
         EndIf
         Count+=1
      Next
   Next
End Sub

Sub DrawMap(text As String Ptr)
   MutexLock(o.mutex)
   Dim As Integer L,L1
   Dim As Integer count
   Dim As single FFT(1024)
   o.flag=0
   L1=Len(*text)
   If L1<40 Then
      L=(320-L1*8)\2
   Else
      L=0
   EndIf   
   Do
      L+=1
      If L=320 Then L=-(L1*8)
      ScreenLock() 
      DrawAll(o.current)
      Draw String (L,101),*text,2   
      Var VCH=BASS_ChannelGetData(o.stream,@FFT(0),BASS_DATA_FFT2048)
      For a As Integer=0 To 50
         Dim As Integer value=Fix(FFT(a)*500)
         If VCH = -1 Then
            Value=1
         EndIf
         If value>60 Then value=60
         Line(10+(a*2),80-value)-step(1,value),2,BF
         Line(110+(a*2),80-value)-step(-1,value),2,BF
         Line(210+(a*2),80-value)-step(-1,value),2,BF
      Next   
      ScreenUnlock()
      'PCopy
      Sleep 30
      'Cls()
      Clear *scrbuf, 0, scrsize       
      If o.flag=2 Then
         end
      EndIf
   Loop Until o.flag=1
   MutexUnLock(o.mutex)
End Sub

Sub ClickEvent()
       Dim As Integer count
       Getmouse(o.MC.x,o.MC.y)
       if ((o.MC.x-312) <= 8) andalso o.MC.y <=8 then screenevent
       For h As Integer=1 To 3
          For w As Integer=1 To 9
             count+=1
             If o.MC.x>=w*34-23 And o.MC.x<=w*34+2 And o.MC.y>=h*25+96 And o.MC.y<=h*25+117 Then
                o.flag=1
                o.current=count
                o.Thread=ThreadCreate(Cast(Any Ptr,@DrawMap),@o.tagM(o.current))
                BASS_StreamFree(o.stream)
                o.stream=BASS_StreamCreateURL(o.tagM(o.current), 0, 0, 0, 0)
                BASS_ChannelPlay(o.stream,0)
             EndIf
          Next
       Next
End Sub

Sub main()
   BASS_Init(-1, 44100, 0,0,0)
   Load_m3u()
   If Num > 0 Then o.current = Num : Num = 0
   DrawAll(o.current)
   o.stream=BASS_StreamCreateURL(o.tagM(o.current), 0, 0, 0, 0)
   If o.stream<>0 Then
      BASS_ChannelPlay(o.stream,0)
   EndIf
   o.mutex = MutexCreate
   o.Thread=ThreadCreate(Cast(Any Ptr,@DrawMap),@o.tagM(o.current))
   Do
      If (ScreenEvent(@o.e)) Then
         Select Case o.e.type
            Case EVENT_MOUSE_BUTTON_RELEASE
               ClickEvent()
            Case EVENT_WINDOW_CLOSE
               o.flag=2
               Dim As Integer X, Y   
               ScreenControl GET_WINDOW_POS, X, Y
               Num = o.current
               Open FileIni For Output As #1   
               	Write #1, X, Y, Num
               Close #1                 
         End Select
      End If
      Sleep 15
   Loop
End Sub
main()

Simple Online Radio

Re: Simple Online Radio

Re: Simple Online Radio

Re: Simple Online Radio

Re: Simple Online Radio

Re: Simple Online Radio

Re: Simple Online Radio

Re: Simple Online Radio