'-----------------------------------------------------------------------------------------------
'
' Graphical Xaw frontend for the 'mpg123' player ported from Motif. This player only accepts plain http.
'
' Requires BaCon 4.0.1 or higher. May 2020, Peter van Eerten - MIT License.
'
' Version 1.0: initial release
' Version 1.1: code update to handle hex pointer
' Version 1.2: fixed bug in parsing URL when fetching title
' Version 1.3: more code updates
' Version 1.4: added pointer cast so it works for 32bit too
' Version 1.5: more stability in network code
' Version 1.6: added Xmu header for Ubuntu type distro's
' Version 1.7: set timeout for mpg123 and set socket timeout
' Version 1.8: better title tracking
'
'-----------------------------------------------------------------------------------------------
' Install correct X11 font package for lucida-bold:
'
' # sudo apt install xfonts-75dpi
' # fc-cache
' # xset +fp /usr/share/fonts/X11/75dpi/
'-----------------------------------------------------------------------------------------------

OPTION GUI TRUE
' PRAGMA GUI Xaw3d
OPTION SOCKET 1

' Needed in case of Ubuntu type distro
PRAGMA INCLUDE <X11/Xmu/WidgetNode.h>

CONST Conf$ = GETENVIRON$("HOME") & "/.radio.cfg"
CONST Fifo$ = "/dev/shm/mpg.fifo." & STR$(MYPID)
CONST Ipc$ = "/dev/shm/mpg.ipc"
CONST Buffer = 32768

DECLARE Current_Station$
DECLARE Current_Url$
DECLARE Current_Window
DECLARE dict$[100]

SIGNAL SIG_IGN, SIGCHLD

'-----------------------------------------------------------------------------------------------

SUB My_Update

	LOCAL config$, item$, url$, total$
	LOCAL x, count, pos, mynet, area, ch

	IF FILEEXISTS(Ipc$) THEN
		CALL GUISET(Current_Window, "playing", XtNlabel, LOAD$(Ipc$))
		CALL XFlush(XtDisplay(GUIWIDGET(Current_Window, "playing")))
	ENDIF

	IF LEN(Current_Url$) AND COUNT(Current_Url$, ASC("/")) > 2 THEN
		pid = FORK
		IF pid = 0 THEN
			url$ = INBETWEEN$(Current_Url$, "http://", "/")
			area = MEMORY(Buffer*2)

			OPEN url$ & ":80" FOR NETWORK AS mynet
			SEND "GET /" & OUTBETWEEN$(Current_Url$, "url=http://", "/") & " HTTP/1.1\r\nHost: " & url$ & "\r\nUser-Agent: Mozilla/5.0\r\nConnection: keep-alive\r\nIcy-Metadata: 1\r\n\r\n" TO mynet

			WHILE WAIT(mynet, 1000)
				RECEIVE area+pos FROM mynet CHUNK Buffer SIZE amount
				INCR pos, amount
				IF amount = 0 OR pos > Buffer THEN BREAK
			WEND

			CLOSE NETWORK mynet

			FOR x = 0 TO Buffer-1
				ch = PEEK(area+x)
				IF ch BETWEEN 32 AND 126 THEN total$ = total$ & CHR$(ch)
			NEXT

			OPTION QUOTED FALSE
			title$ = INBETWEEN$(total$, "StreamTitle=", ";")

			IF LEN(CHOP$(title$, "'")) THEN
				SAVE CHOP$(title$, "'") TO Ipc$
			ELIF NOT(FILEEXISTS(Ipc$)) THEN
				SAVE "No track info provided by " & Current_Station$ TO Ipc$
			ENDIF

			FREE area
			ENDFORK
		ENDIF
	ENDIF

	ALARM My_Update, 3000

ENDSUB

'-----------------------------------------------------------------------------------------------

SUB Load_Config(id)

	LOCAL config$, station$, name$, url$
	LOCAL nr

	LOCAL empty$[] = { "", NULL }
	CALL GUISET(id, "list", XtNlist, empty$, XtNnumberStrings, 0)

	IF FILEEXISTS(Conf$) THEN
		config$ = LOAD$(Conf$)
		FOR station$ IN config$ STEP "#"
			IF LEN(CHOP$(station$)) = 0 THEN CONTINUE
			name$ = TOKEN$(CHOP$(station$), 1, NL$)
			url$ = TOKEN$(CHOP$(station$), 2, NL$)
			dict$[nr] = TOKEN$(name$, 2, "=")
			INCR nr
		NEXT
	ENDIF

	dict$[nr] = NULL
	CALL GUISET(id, "list", XtNlist, dict$, XtNnumberStrings, 0)

ENDSUB

'-----------------------------------------------------------------------------------------------

FUNCTION Create_Gui

	LOCAL id

	id = GUIDEFINE( " \
	{ type=window name=window callback=window XtNtitle=\"BaCon Internet Radio v1.8\" XtNwidth=450 XtNheight=250 } \
	{ type=formWidgetClass name=form parent=window } \
	{ type=viewportWidgetClass name=view parent=form XtNwidth=450 XtNallowVert=True XtNleft=XawChainLeft XtNuseRight=True XtNright=XawChainRight XtNtop=XawChainTop XtNbottom=XawChainBottom } \
	{ type=listWidgetClass name=list parent=view callback=XtNcallback XtNverticalList=True XtNforceColumns=True XtNdefaultColumns=1 XtNleft=XawChainLeft XtNright=XawChainRight XtNtop=XawChainTop XtNbottom=XawChainBottom } \
	{ type=labelWidgetClass name=playing parent=form XtNfromVert=view XtNheight=30 XtNwidth=440 XtNlabel=\"Use right mouse button for menu...\" XtNjustify=XtJustifyLeft XtNleft=XawChainLeft XtNright=XawChainLeft XtNtop=XawChainBottom XtNbottom=XawChainBottom } \
	{ type=simpleMenuWidgetClass name=menu parent=list } \
	{ type=smeBSBObjectClass name=Pause parent=menu callback=XtNcallback } \
	{ type=smeBSBObjectClass name=Resume parent=menu callback=XtNcallback } \
	{ type=smeLineObjectClass name=line1 parent=menu } \
	{ type=smeBSBObjectClass name=Add parent=menu callback=XtNcallback } \
	{ type=smeBSBObjectClass name=Edit parent=menu callback=XtNcallback } \
	{ type=smeBSBObjectClass name=Delete parent=menu callback=XtNcallback } \
	{ type=smeLineObjectClass name=line2 parent=menu } \
	{ type=smeBSBObjectClass name=Exit parent=menu callback=XtNcallback } \
	{ type=sessionShellWidgetClass name=window2 parent=window XtNtitle=\"Radio Stations\" } \
	{ type=formWidgetClass name=form2 parent=window2 } \
	{ type=labelWidgetClass name=label1 parent=form2 XtNjustify=XtJustifyLeft XtNlabel=\"Radio Station Name:\" XtNleft=XawChainLeft XtNtop=XawChainTop } \
	{ type=asciiTextWidgetClass name=en1 parent=form2 XtNfromVert=label1 XtNeditType=XawtextEdit XtNwidth=300 XtNleft=XawChainLeft XtNright=XawChainRight } \
	{ type=labelWidgetClass name=label2 parent=form2 XtNfromVert=en1 XtNjustify=XtJustifyLeft XtNlabel=\"Radio Station URL:\" XtNleft=XawChainLeft XtNtop=XawChainTop } \
	{ type=asciiTextWidgetClass name=en2 parent=form2 XtNfromVert=label2 XtNeditType=XawtextEdit XtNwidth=300 XtNleft=XawChainLeft XtNright=XawChainRight } \
	{ type=commandWidgetClass name=OK parent=form2 callback=XtNcallback XtNfromVert=en2 XtNleft=XawChainLeft } \
	{ type=commandWidgetClass name=Cancel parent=form2 callback=XtNcallback XtNfromVert=en2 XtNhorizDistance=250 XtNright=XawChainRight } \
	{ type=sessionShellWidgetClass name=err1 parent=window XtNtitle=\"Delete Stations\" } \
	{ type=dialogWidgetClass name=dialog parent=err1 XtNlabel=\"Are you sure?\" } \
	{ type=commandWidgetClass name=Yes parent=dialog callback=XtNcallback } \
	{ type=commandWidgetClass name=No parent=dialog callback=XtNcallback XtNhorizDistance=100 XtNright=XawChainRight } \
	{ type=sessionShellWidgetClass name=err2 parent=window XtNtitle=\"Warning\" } \
	{ type=dialogWidgetClass name=dlg parent=err2 XtNlabel=\"No 'mpg123' found on this system!\" } \
	{ type=commandWidgetClass name=Close parent=dlg callback=XtNcallback }")

	CALL GUISET(id, "list", XtNtranslations, XtParseTranslationTable("<Btn1Down>:Set() Notify()\n<Btn3Down>:XawPositionSimpleMenu(menu) XtMenuPopup(menu)"))
	CALL GUISET(id, "menu", XtVaTypedArg, XtNbackground, XtRString, "grey75", 7)

	Load_Config(id)
	Current_Window = id

	RETURN id

ENDFUNCTION

'-----------------------------------------------------------------------------------------------

SUB Main_Function(id)

	LOCAL event$, selected$, config$, name$, url$
	LOCAL info TYPE XawListReturnStruct*
	LOCAL name, url TYPE char*
	LOCAL pos
	LOCAL (*hide)() = XtPopdown TYPE void
	LOCAL (*show)() = XtPopup TYPE void

	IF FILEEXISTS(Ipc$) THEN DELETE FILE Ipc$
	CALL My_Update()

	WHILE TRUE
		event$ = GUIEVENT$(id, TRUE)
		SELECT TOKEN$(event$, 1)
			CASE "Add"
				CALL GUIFN(id, "window2", show, XtGrabNonexclusive)
				CALL GUISET(id, "en1", XtNstring, "")
				CALL GUISET(id, "en2", XtNstring, "")
				status$ = "added"
			CASE "Edit"
				CALL GUIFN(id, "window2", show, XtGrabNonexclusive)
				config$ = LOAD$(Conf$)
				pos = ISTOKEN(config$, "name=" & selected$, NL$)
				url$ = TOKEN$(config$, pos+1, NL$)
				CALL GUISET(id, "en1", XtNstring, selected$)
				CALL GUISET(id, "en2", XtNstring, TOKEN$(url$, 2, "="))
				status$ = "edited"
			CASE "Delete"
				CALL GUIFN(id, "err1", show, XtGrabNonexclusive)
			CASE "window", "Exit"
				IF FILEEXISTS(Fifo$) THEN APPEND "QUIT" & NL$ TO Fifo$
				IF FILEEXISTS(Ipc$) THEN DELETE FILE Ipc$
				END
			CASE "OK"
				config$ = LOAD$(Conf$)
				IF status$ = "edited" THEN
					pos = ISTOKEN(config$, "name=" & selected$, NL$)
					config$ = DEL$(config$, pos+2, NL$)
					config$ = DEL$(config$, pos+1, NL$)
					config$ = CHOP$(DEL$(config$, pos, NL$))
				ENDIF
				CALL GUIGET(id, "en1", XtNstring, &name)
				CALL GUIGET(id, "en2", XtNstring, &url)
				config$ = config$ & NL$ & "name=" & name & NL$ & "url=" & url & NL$
				SAVE SORT$(config$, "#" & NL$) & "#" & NL$ TO Conf$
				CALL GUIFN(id, "window2", hide)
				Load_Config(id)
			CASE "Cancel"
				CALL GUIFN(id, "window2", hide)
			CASE "Close"
				CALL GUIFN(id, "err2", hide)
			CASE "No"
				CALL GUIFN(id, "err1", hide)
			CASE "Yes"
				config$ = LOAD$(Conf$)
				pos = ISTOKEN(config$, "name=" & selected$, NL$)
				config$ = DEL$(config$, pos+2, NL$)
				config$ = DEL$(config$, pos+1, NL$)
				config$ = CHOP$(DEL$(config$, pos, NL$))
				SAVE config$ & NL$ TO Conf$
				Load_Config(id)
				CALL GUIFN(id, "err1", hide)
			CASE "list", "Resume"
				info = (intptr_t)DEC(TOKEN$(event$, 2))
				selected$ = info->string
				IF NOT(LEN(EXEC$("command -v mpg123 2>/dev/null"))) THEN
					CALL GUIFN(id, "err2", show, XtGrabNonexclusive)
				ELSE
					IF FILEEXISTS(Ipc$) THEN DELETE FILE Ipc$
					IF NOT(FILEEXISTS(Fifo$)) THEN SYSTEM "mpg123 -o pulse,openal,alsa -R --fifo " & Fifo$ & " --timeout 1 >/dev/null 2>&1 &"
					REPEAT
						SLEEP 50
					UNTIL FILEEXISTS(Fifo$)
					config$ = LOAD$(Conf$)
					pos = ISTOKEN(config$, "name=" & selected$, NL$)
					url$ = TOKEN$(config$, pos+1, NL$)
					APPEND "LOAD " & TOKEN$(url$, 2, "=") & NL$ TO Fifo$
					Current_Url$ = url$
					Current_Station$ = selected$
					CALL GUISET(id, "playing", XtNlabel, "Fetching track info...")
				ENDIF
			CASE "Pause"
				IF FILEEXISTS(Fifo$) THEN APPEND "QUIT" & NL$ TO Fifo$
		ENDSELECT
	WEND

ENDSUB

'-----------------------------------------------------------------------------------------------

Main_Function(Create_Gui())

'-----------------------------------------------------------------------------------------------