'-----------------------------------------------------------------------------------------------
'
' Graphical TK frontend for the 'mpg123' player ported from GTK3. This player only accepts plain http.
'
' Requires BaCon 4.8.1 or higher. April 2024, Peter van Eerten - MIT License.
'
' Version 1.0: initial release for TK
' Version 1.1: added icon to window
' Version 1.2: better title tracking
'
'-----------------------------------------------------------------------------------------------

OPTION GUI TRUE
PRAGMA GUI tk

OPTION COLLAPSE TRUE
OPTION SOCKET 1

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

SIGNAL SIG_IGN, SIGCHLD

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

SUB My_Update(id, current_station$, current_url$)

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

	IF FILEEXISTS(Ipc$) THEN
		CALL GUISET(id, "playing", LOAD$(Ipc$))
		CALL GUIFN(id, ".lbl configure -text $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 " & TOKEN$(current_station$, 2, "=") TO Ipc$
			ENDIF

			FREE area
			ENDFORK
		ENDIF
	ENDIF

ENDSUB

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

SUB Load_Config(id)

	LOCAL config$, station$, name$, url$
	IF FILEEXISTS(Conf$) THEN
		CALL GUIFN(id, ".list delete 0 [.list size];")
		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$)
			CALL GUIFN(id, ".list insert end \"" & TOKEN$(name$, 2, "=") & "\"")
		NEXT
	ENDIF

ENDSUB

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

FUNCTION Create_Gui

	LOCAL id

	id = GUIDEFINE(" \
		proc popupMenu {popup X Y} { set x [expr [winfo rootx .]+$X]; set y [expr [winfo rooty .]+$Y]; $popup post $x $y; }; \
		proc scroll args { .list yview moveto [lindex $args 1]; }; \
		proc updateScroll {x y} {.list yview moveto $x; .vsb set $x $y}; \
		wm title . {BaCon Internet Radio v1.2 for TK}; \
		wm protocol . \"WM_DELETE_WINDOW\" window; \
		wm iconbitmap . gray50; \
		listbox .list -width 50 -height 20 -justify left -selectmode single -yscrollcommand updateScroll; \
		proc myupdate { } { event generate .list <Control-Button-1>; after 3000 myupdate; }; \
		scrollbar .vsb -orient vertical -command scroll; \
		label .lbl -width 50 -anchor w -text {Use right mouse button for menu...}; \
		grid .list -row 0 -column 0 -padx 5 -pady 5 -sticky nsew; \
		grid .vsb -row 0 -column 1 -sticky nsew; \
		grid .lbl -row 1 -column 0 -columnspan 2 -padx 5 -pady 5 -sticky sew; \
		grid columnconfigure . 0 -weight 1; \
		grid rowconfigure . 0 -weight 1; \
		menu .menu -tearoff 0; \
		.menu add command -label \"Pause\" -command pause; \
		.menu add command -label \"Resume\" -command resume; \
		.menu add separator; \
		.menu add command -label \"Add\" -command add; \
		.menu add command -label \"Edit\" -command edit; \
		.menu add command -label \"Delete\" -command delete; \
		.menu add separator; \
		.menu add command -label \"Exit\" -command exit; \
		bind .list <Button-1> list+continue; \
		bind .list <Control-Button-1> async_event; \
		bind .list <Button-3> {popupMenu .menu %x %y}; \
		toplevel .input; \
		wm title .input \"Radio station\"; \
		wm protocol .input \"WM_DELETE_WINDOW\" {wm withdraw .input}; \
		wm withdraw .input; \
		label .input.lbl1 -anchor w -width 40 -text {Radio Station Name:}; \
		entry .input.ent1 -justify left -width 40; \
		label .input.lbl2 -anchor w -width 40 -text {Radio Station URL:}; \
		entry .input.ent2 -justify left -width 40; \
		ttk::separator .input.sep -orient horizontal; \
		button .input.btn1 -text \"OK\" -command ok; \
		button .input.btn2 -text \"Cancel\" -command cancel; \
		grid .input.lbl1 -row 0 -column 0 -columnspan 2 -sticky nwe -padx 5 -pady 5; \
		grid .input.ent1 -row 1 -column 0 -columnspan 2 -sticky nwe -padx 5 -pady 5; \
		grid .input.lbl2 -row 2 -column 0 -columnspan 2 -sticky nwe -padx 5 -pady 5; \
		grid .input.ent2 -row 3 -column 0 -columnspan 2 -sticky nwe -padx 5 -pady 5; \
		grid .input.sep -row 4 -column 0 -columnspan 2 -sticky nwe; \
		grid .input.btn1 -row 5 -column 0 -padx 5 -pady 5 -sticky sw; \
		grid .input.btn2 -row 5 -column 1 -padx 5 -pady 5 -sticky se; \
		grid columnconfigure .input 0 -weight 1; \
		grid rowconfigure .input 0 -weight 0; \
		grid rowconfigure .input 5 -weight 1;")

	CALL Load_Config(id)
	RETURN id

ENDFUNC

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

SUB Main_Function(id)

	LOCAL config$, item$, current_url$, url$, status$, current_name$, name$, pos$, response$

	IF FILEEXISTS(Ipc$) THEN DELETE FILE Ipc$
	CALL GUIFN(id, "myupdate;")

	WHILE TRUE
		SELECT GUIEVENT$(id)
			CASE "window", "exit"
				IF FILEEXISTS(Fifo$) THEN APPEND "QUIT" & NL$ TO Fifo$
				IF FILEEXISTS(Ipc$) THEN DELETE FILE Ipc$
				CALL GUIFN(id, "exit;")
				END
			CASE "list", "resume"
				IF NOT(LEN(EXEC$("command -v mpg123 2>/dev/null"))) THEN
					CALL GUIFN(id, "tk_messageBox -title {Warning!} -message {No 'mpg123' found on this system!} -icon error -type ok")
				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$)
					CALL GUIFN(id, "set pos [.list curselection];")
					CALL GUIGET(id, "pos", pos$)
					config$ = LOAD$(Conf$)
					item$ = CHOP$(TOKEN$(config$, VAL(pos$)+1, "#"))
					url$ = TOKEN$(item$, 2, NL$)
					APPEND "LOAD " & TOKEN$(url$, 2, "=") & NL$ TO Fifo$
					current_url$ = url$
					current_name$ = TOKEN$(item$, 1, NL$)
					CALL GUIFN(id, ".lbl configure -text \"Fetching track info...\";")
				ENDIF
			CASE "pause"
				IF FILEEXISTS(Fifo$) THEN APPEND "QUIT" & NL$ TO Fifo$
			CASE "add"
				CALL GUIFN(id, "wm deiconify .input; .input.ent1 delete 0 end; .input.ent2 delete 0 end; focus .input.ent1;")
				status$ = "added"
			CASE "edit"
				CALL GUIFN(id, "wm deiconify .input; .input.ent1 delete 0 end; .input.ent2 delete 0 end; set pos [.list curselection];")
				CALL GUIGET(id, "pos", pos$)
				config$ = LOAD$(Conf$)
				item$ = CHOP$(TOKEN$(config$, VAL(pos$)+1, "#"))
				name$ = TOKEN$(item$, 1, NL$)
				url$ = TOKEN$(item$, 2, NL$)
				CALL GUIFN(id, ".input.ent1 insert 0 {" & TOKEN$(name$, 2, "=") & "}")
				CALL GUIFN(id, ".input.ent2 insert 0 {" & TOKEN$(url$, 2, "=") & "}")
				CALL GUIFN(id, "focus .input.ent1;")
				status$ = "edited"
			CASE "ok"
				config$ = LOAD$(Conf$)
				IF status$ = "edited" THEN
					CALL GUIFN(id, "set pos [.list curselection];")
					CALL GUIGET(id, "pos", pos$)
					config$ = CHOP$(DEL$(config$, VAL(pos$)+1, "#"))
				ENDIF
				CALL GUIFN(id, "set name [ .input.ent1 get ]")
				CALL GUIGET(id, "name", name$)
				CALL GUIFN(id, "set url [ .input.ent2 get ]")
				CALL GUIGET(id, "url", url$)
				config$ = CHOP$(config$) & NL$ & "name=" & name$ & NL$ & "url=" & url$ & NL$ & "#" & NL$
				SAVE SORT$(config$, "#" & NL$) & "#" & NL$ TO Conf$
				CALL GUIFN(id, "wm withdraw .input;")
				Load_Config(id)
			CASE "delete"
				CALL GUIFN(id, "set response [tk_messageBox -title {Delete Station} -message {Are you sure?} -icon question -type okcancel]")
				CALL GUIGET(id, "response", response$)
				IF response$ = "ok" THEN
					CALL GUIFN(id, "set pos [.list curselection];")
					CALL GUIGET(id, "pos", pos$)
					config$ = LOAD$(Conf$)
					config$ = CHOP$(DEL$(config$, VAL(pos$)+1, "#"))
					SAVE config$ & NL$ TO Conf$
					CALL Load_Config(id)
				ENDIF
			CASE "cancel"
				CALL GUIFN(id, "wm withdraw .input;")
			CASE "async_event"
				CALL My_Update(id, current_name$, current_url$)
		ENDSELECT
	WEND

ENDSUB

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

Main_Function(Create_Gui())

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