Simple Online Radio

User projects written in or related to FreeBASIC.
Coolman
Posts: 211
Joined: Nov 05, 2010 15:09

Re: Simple Online Radio

Postby 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
Posts: 1038
Joined: May 28, 2007 1:52

Re: Simple Online Radio

Postby 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
Posts: 211
Joined: Nov 05, 2010 15:09

Re: Simple Online Radio

Postby 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
Posts: 1038
Joined: May 28, 2007 1:52

Re: Simple Online Radio

Postby 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: viewtopic.php?f=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
Posts: 211
Joined: Nov 05, 2010 15:09

Re: Simple Online Radio

Postby Coolman » Apr 10, 2012 23:21

Good idea...
oog
Posts: 124
Joined: Jul 08, 2011 20:34

Re: Simple Online Radio

Postby 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
Posts: 211
Joined: Nov 05, 2010 15:09

Re: Simple Online Radio

Postby 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()


Return to “Projects”

Who is online

Users browsing this forum: Baidu [Spider] and 0 guests