cimp/cimp.bas

declare library"terminkey"
    function terminkey%()
    sub echooff()
    sub echoon()
    function termwidth()
    function ipc_init&()
    function ipc_check_message%(byval buf as _offset,byval max_len as long)
    sub ipc_send_message(buf as string)
    sub ipc_cleanup()
end declare

$console:only
on error goto quit
const key_up=1001
const key_down=1002
const key_right=1003
const key_left=1004
dim slash as string
slash="/"
$if win then
shell"chcp 65001 > nul"
slash="\"
$end if

redim file(0) as string
chdir _startdir$
if command$=""then
print"please specify file to play."
goto quit
end if

dim ipc_status as long
ipc_status=ipc_init

if ipc_status=0 then
    ' --- CLIENT MODE ---
    dim cmd_msg as string

    select case command$(1)
        case "--soundbank"
            cmd_msg="SOUNDBANK:"+_cwd$ +slash+command$(2)
        case "--next"
            cmd_msg="NEXT"

        case "--prev"
            cmd_msg="PREV"

        case "-v","--volume"
            cmd_msg="VOL:"+command$(2)

        case "--pause"
            cmd_msg="PAUSE"
        case "--stop"
            cmd_msg="STOP"
        case "--play"
            cmd_msg="PLAY"
        case "--quit"
            cmd_msg="QUIT"
        case "--shuffle"
            cmd_msg="SHUFFLE"
        case "--repeat"
            cmd_msg="REPEAT"
        case "--repeat-1"
            cmd_msg="REPEAT1"
        case "--repeat-off"
            cmd_msg="REPEATOFF"
        case "--nyan"
            cmd_msg="NYAN"
        case "--nyan-off"
            cmd_msg="NYANOFF"
        case "--add"
            for i=2 to _commandcount
                cmd_msg="ADD:"+_cwd$ +slash+command$(i)
                ipc_send_message cmd_msg
            next i
            system

        case "--playlist"
            cmd_msg="GET_PLAYLIST"

        case else
            ' Default behavior: Resolve target file/playlist and replace active queue
            cmd_msg="PLAY:"+_cwd$ +slash+command$(1)
            ipc_send_message cmd_msg
            if _commandcount>1 then
                for i=2 to _commandcount
                    cmd_msg="ADD:"+_cwd$ +slash+command$(i)
                    ipc_send_message cmd_msg
                next i
                system
            end if
    end select

    ' Send instruction to the main player instance
    ipc_send_message cmd_msg

    ' --- Two-way Client feedback for --playlist ---
    if cmd_msg="GET_PLAYLIST" then
        ipc_cleanup
        _delay 0.1

        dim client_listen as long
        client_listen=ipc_init
        if client_listen=1 then
            dim reply_buf as string
            reply_buf=space$(4096)+chr$(0)
            dim start_wait as double
            start_wait=timer

            do while timer-start_wait<2
                dim reply_len as long
                reply_len=ipc_check_message(_offset(reply_buf),4096)
                if reply_len>0 then
                    print left$(reply_buf,reply_len)
                    exit do
                end if
                _limit 30
            loop
            ipc_cleanup
        end if
    end if

    system ' Exit client instance completely
elseif ipc_status=-1 then
    print "Error initializing Inter-Process Communication."
    goto quit
end if

' ---SERVER MODE (Main Player Execution)---

echooff
cursoroff

dim volume as single
dim repeat as integer
dim shuffle as integer
dim nooutput as integer
dim timevis as integer
dim nyan as integer
dim server as integer

dim marqueeoffset as integer
dim i as integer

dim musichandle as long
dim oldhandle as long
dim keyin as integer
dim playnext as integer

dim state as string
dim songname as string
dim progress as string
dim progressbar as string

dim tw as integer
dim fixedwidth as integer
dim maxtitlewidth as integer
dim visibletitle as string
dim currentsongwidth as integer
dim paddedtitle as string
dim paddedlength as integer
dim idx as integer
dim addedwidth as integer
dim charidx as integer
dim nextchar as string
dim marqueeframe as integer

volume=1
repeat=0
shuffle=0
nooutput=0
timevis=1
nyan=0
marqueeoffset=0


dim config as string
config=GetConfig("cimp.conf")
if _fileexists(config) then
    dim li as string
    dim fh as integer
    fh=freefile
    open config for input as fh
    while not eof(fh)
        line input #fh,li
        if left$(li,1)="#" then _continue
        select case _trim$(left$(li,instr(li,"=")-1))
            case "volume"
                volume=val(_trim$(mid$(li,instr(li,"=")+1)))/100
            case "shuffle"
                if _trim$(mid$(li,instr(li,"=")+1))="true" then shuffle=-1 else shuffle=0
            case "repeat"
                if _trim$(mid$(li,instr(li,"=")+1))="true" then repeat=-1 else repeat=0
                if _trim$(mid$(li,instr(li,"=")+1))="1" then repeat=1
            case "server"
                if _trim$(mid$(li,instr(li,"=")+1))="true" then server=-1 else server=0
            case "nyan"
                if _trim$(mid$(li,instr(li,"=")+1))="true" then nyan=-1 else nyan=0
            case "nooutput"
                if _trim$(mid$(li,instr(li,"=")+1))="true" then nooutput=-1 else nooutput=0
            case ""
            case else
                print "Config not understood:"
                print li
        end select
    wend
    close fh
end if

for i=1 to _commandcount
    select case command$(i)
        case "-v","--volume"
            i=i+1
            volume=val(command$(i))/100
        case "-s","--shuffle"
            shuffle=-1
        case "-r","--repeat"
            if command$(i+1)="1"then
            repeat=1
        else
            repeat=-1
        end if
    case "-n","--nooutput"
        nooutput=-1
    case "-N","--nyan"
        nyan=-1
    case "-b","--soundbank"
        if _commandcount>i and _fileexists(command$(i+1)) then
            loadsoundbank command$(i+1)
        else
            print "error loading soundbank"
            system
        end if
    case else
        if _fileexists(command$(i)) then
            if lcase$(right$(command$(i),4))=".m3u"then
            parsem3u command$(i),file()
        else
            file(ubound(file))=command$(i)
            redim _preserve file(ubound(file)+1)
        end if
    end if
end select
next

redim _preserve file(ubound(file)-1)

if shuffle=-1 then shufflearray file()
i=0
musichandle=_sndopen(file(i))
if musichandle=0 then
    print"Error: could not open file ";file(i)
    goto quit
end if
_sndvol musichandle,volume
_sndplay musichandle
state="playing "
songname=beforelast(".",afterlast("/",file(i)))

while keyin<>27
    keyin=terminkey
    ' ---Poll Client Messages---
    dim incoming_buf as string
    incoming_buf=space$(512)+chr$(0)
    dim msg_len as long
    msg_len=ipc_check_message(_offset(incoming_buf),512)

    if msg_len>0 then
        dim client_cmd as string
        client_cmd=left$(incoming_buf,msg_len)

        if client_cmd="NEXT" then
            playnext=1
        elseif client_cmd="PLAY" then
            keyin=asc("x")
        elseif client_cmd="PAUSE" then
            keyin=asc("c")
        elseif client_cmd="STOP" then
            keyin=asc("v")
        elseif client_cmd="QUIT" then
            keyin=27
        elseif client_cmd="REPEAT" then
            repeat=-1
        elseif client_cmd="REPEAT1" then
            repeat=1
        elseif client_cmd="REPEATOFF" then
            repeat=0
        elseif client_cmd="SHUFFLE" then
            keyin=asc("s")
        elseif client_cmd="NYAN" then
            nyan=not nyan
        elseif client_cmd="NYANOFF" then
            nyan=0
        elseif left$(client_cmd,10)="SOUNDBANK:" then
            if client_cmd="default" then loadsoundbank "" else loadsoundbank mid$(client_cmd,11)

            if _sndplaying(musichandle) then

                ' a hack to make qb64pe load the midi file that is already loaded.
                ' qb64 can't open the same file again with a new sound bank for some reason
                ' so it has to be closed, freed and given a short delay  before reloading
                ' which gives a short break in the playing of music, very annoying.
                ' this should be reverted if qb64pe ever gets the ability to reload the same
                ' file more than once.

                tmppos=_sndgetpos(musichandle)
                _sndstop musichandle
                _sndclose musichandle
                _delay .1
                musichandle=_sndopen(file(i))
                _sndvol musichandle,volume
                _sndsetpos musichandle,tmppos
                _sndplay musichandle
            end if
        elseif left$(client_cmd,4)="VOL:" then
            volume=val(mid$(client_cmd,5))/100
            if volume>1 then volume=1
            if volume<0 then volume=0
            _sndvol musichandle,volume
        elseif left$(client_cmd,4)="ADD:" then
            dim new_file as string
            new_file=_trim$(mid$(client_cmd,5))
            if _fileexists(new_file) then
                if lcase$(right$(new_file,4))=".m3u" then
                    parsem3u new_file,file()
                else
                    redim _preserve file(ubound(file)+1) as string
                    file(ubound(file))=new_file
                end if
            end if
        elseif left$(client_cmd,5)="PLAY:" then
            dim replace_file as string
            replace_file=_trim$(mid$(client_cmd,6))
            if _fileexists(replace_file) then
                redim file(0) as string
                if lcase$(right$(replace_file,4))=".m3u" then
                    parsem3u replace_file,file()
                else
                    file(0)=replace_file
                end if
                i=-1
                playnext=1
            end if
        elseif client_cmd="GET_PLAYLIST" then
            dim p_idx as long
            dim playlist_payload as string
            playlist_payload="=== Current Playlist ==="+chr$(10)
            for p_idx=lbound(file) to ubound(file)
                if p_idx=i then
                    playlist_payload=playlist_payload+"-> "+file(p_idx)+chr$(10)
                else
                    playlist_payload=playlist_payload+"   "+file(p_idx)+chr$(10)
                end if
            next p_idx

            ipc_cleanup
            _delay 0.1
            ipc_send_message playlist_payload
            _delay 0.1
            dim reinit as long
            reinit=ipc_init
        end if
    end if
    ' --- End Poll Client Messages ---

    select case keyin
        case key_up
            volume=volume+(0.01+(volume/10))
            if volume>1 then volume=1
            _sndvol musichandle,volume
        case key_down
            volume=volume-(0.01+(volume/10))
            if volume<0 then volume=0
            _sndvol musichandle,volume
        case key_right
            if _sndgetpos(musichandle)+5<_sndlen(musichandle) then
                _sndsetpos musichandle,_sndgetpos(musichandle)+5
            else
                playnext=1
            end if
        case key_left
            if _sndgetpos(musichandle)-5>0 then
                _sndsetpos musichandle,_sndgetpos(musichandle)-5
            else
                playnext=-1
            end if
        case asc("q")
            keyin=27
        case asc("z")
            if _sndgetpos(musichandle)>2 then
                _sndsetpos musichandle,0
            else
                playnext=-1
            end if
        case asc("x")
            if _sndplaying(musichandle) then
                _sndsetpos musichandle,0
            else
                _sndplay musichandle
            end if
        case asc("c"),asc(" ")
            if _sndplaying(musichandle) then
                _sndpause musichandle
                state="paused "
            else
                _sndplay musichandle
                state="playing "
            end if
        case asc("v")
            _sndstop musichandle
            state="stopped "
        case asc("b")
            playnext=1
        case asc("t")
            timevis=-timevis
        case asc("s")
            shufflearray file()
    end select

    if _sndgetpos(musichandle)=_sndlen(musichandle) then playnext=1
    if playnext<>0 then
        oldhandle=musichandle
        if repeat=1 and playnext=1 then
            playnext=0
        else
            i=i+playnext
            if i>ubound(file) then
                if repeat=-1 then
                    i=0
                else
                    goto quit
                end if
            elseif i<lbound(file) then
                if repeat=-1 then
                    i=ubound(file)
                else
                    i=lbound(file)
                end if
            end if
        end if
        musichandle=_sndopen(file(i))
        if musichandle<>0 then
            _sndvol musichandle,volume
            _sndplay musichandle
            _sndstop oldhandle
            _sndclose oldhandle
            state="playing "
            songname=beforelast(".",afterlast(slash,file(i)))
            playnext=0
        else
            musichandle=oldhandle
        end if
    end if

    if timevis=1 then
        progress=" -"+timeleft(musichandle)
    else
        progress=" "+timeelapsed(musichandle)
    end if
    if nooutput=0 then
        tw=termwidth
        fixedwidth=uwidth(state)+uwidth(progress)
        maxtitlewidth=tw-fixedwidth
        currentsongwidth=uwidth(songname)

        if currentsongwidth>maxtitlewidth and maxtitlewidth>4 then
            paddedtitle=songname+" "
            paddedlength=ulen(paddedtitle)
            visibletitle=""
            addedwidth=0
            idx=0
            while addedwidth<maxtitlewidth
                charidx=((marqueeoffset+idx) mod paddedlength)+1
                nextchar=umid(paddedtitle,charidx,1)
                if addedwidth+uwidth(nextchar)>maxtitlewidth then exit while
                visibletitle=visibletitle+nextchar
                addedwidth=addedwidth+uwidth(nextchar)
                idx=idx+1
            wend

            if addedwidth<maxtitlewidth then
                visibletitle=visibletitle+space$(maxtitlewidth-addedwidth)
            end if

            marqueeframe=marqueeframe+1
            if marqueeframe mod 4=0 then
                marqueeoffset=marqueeoffset+1
                if marqueeoffset>=paddedlength then marqueeoffset=0
            end if
        else
            ' Terminal is wide enough, no scrolling needed
            visibletitle=songname
            marqueeoffset=0
        end if

        ' Reset marquee offset if song changes
        if playnext<>0 then marqueeoffset=0

        ' Print the text line
        if nyan=-1 then
            print termcolor(7);state;animatedrainbowtext(visibletitle);termcolor(7);progress;clearrest
        else
            print termcolor(7);state;termcolor(3);visibletitle;termcolor(7);progress;clearrest
        end if

        ' Generate and print progress bar matching the layout width
        progressbar=bar(uwidth(state)+uwidth(visibletitle)+uwidth(progress),(_sndgetpos(musichandle)/_sndlen(musichandle))*100,11,7)
        print progressbar;clearrest;cursorback;
    end if

    _limit 30
    if _exit then goto quit

wend

quit:
_sndclose musichandle
ipc_cleanup
print clearrest
print clearrest;
print cursorback;
print chr$(27)+"[0m";
cursoron
echoon
system

sub shufflearray (stringarray() as string)
    randomize timer
    dim n as long,j as long
    for n=ubound(stringarray) to 1 step -1
        j=int(rnd*n)
        swap stringarray(n),stringarray(j)
    next
end sub

sub parsem3u (filename$,array$())
    dim i as long,f as long,count as long
    dim basepath$,l$,resolvedpath$
    for i=len(filename$) to 1 step -1
        if mid$(filename$,i,1)="/"or mid$(filename$,i,1)="\"then
        basepath$=left$(filename$,i)
        exit for
    end if
next
f=freefile
open filename$ for input as #f
count=0
do until eof(f)
    line input #f,l$
    l$=_trim$(l$)
    if len(l$)>0 and left$(l$,1)<>"#"then
    resolvedpath$=l$
    if not _fileexists(resolvedpath$) then
        resolvedpath$=basepath$+l$
    end if
    if _fileexists(resolvedpath$) then
        array$(ubound(array$))=resolvedpath$
        redim _preserve array$(ubound(array$)+1)
    end if
end if
loop
close #f
end sub

function timeleft$ (handle&)
    dim seconds as integer
    seconds=_sndlen(handle&)-_sndgetpos(handle&)
    if seconds<0 then seconds=0
    timeleft$=right$("0"+ltrim$(str$(seconds\60)),2)+":"+right$("0"+ltrim$(str$(seconds mod 60)),2)
end function

function timeelapsed$ (handle&)
    dim seconds as integer
    seconds=_sndgetpos(handle&)
    if seconds<0 then seconds=0
    timeelapsed$=right$("0"+ltrim$(str$(seconds\60)),2)+":"+right$("0"+ltrim$(str$(seconds mod 60)),2)
end function

function termcolor$ (colorvalue as _unsigned long)
    select case colorvalue
        case 0 to 7
            termcolor=chr$(27)+"[0;3"+_trim$(str$(colorvalue))+"m"
        case 8 to 15
            termcolor=chr$(27)+"[1;3"+_trim$(str$(colorvalue-8))+"m"
        case 16 to 255
            termcolor=chr$(27)+"[38;5;"+_trim$(str$(colorvalue))+"m"
        case is>255
            termcolor=chr$(27)+"[38;2;"+_trim$(str$(_red32(colorvalue)))+";"+_trim$(str$(_green32(colorvalue)))+";"+_trim$(str$(_blue32(colorvalue)))+"m"
    end select
end function

function cursorback$ ()
    cursorback=chr$(27)+"[F"
end function

function clearline$
    clearline=chr$(27)+"[2K"
end function

function clearrest$
    clearrest=chr$(27)+"[K"
end function

sub cursoroff ()
    print chr$(27);"[?25l";
end sub

sub cursoron ()
    print chr$(27);"[?25h";
end sub

function bar$ (length as integer,percent as integer,color1 as long,color2 as long)
    dim done as string
    dim notdone as string
    dim i as integer
    for i=1 to int((percent/100)*length)
        done=done+"━"
    next i
    for i=1 to length-int((percent/100)*length)
        notdone=notdone+"━"
    next i
    bar$=termcolor(color1)+done+termcolor(color2)+notdone
end function

function afterlast$ (delim as string,strng as string)
    afterlast=mid$(strng,_instrrev(strng,delim)+1)
end function

function beforelast$ (delim as string,strng as string)
    beforelast=left$(strng,_instrrev(strng,delim)-1)
end function

function animatedrainbowtext$ (text$)
    static offset as double
    dim result as string
    dim l as long,i as long
    dim r as integer,g as integer,b as integer
    dim hue as double,f as double
    dim sector as integer,v as integer,p as integer,q as integer,t as integer
    dim rgbpart$

    l=ulen(text$)
    if l=0 then exit function
    offset=offset+5.0
    if offset>=360 then offset=offset-360

    for i=1 to l
        hue=mod_double(offset+((i-1)/l)*360,360)
        sector=int(hue/60)
        f=(hue/60)-sector
        v=255:p=0:q=255*(1-f):t=255*f
        select case sector
            case 0:r=v:g=t:b=p
            case 1:r=q:g=v:b=p
            case 2:r=p:g=v:b=t
            case 3:r=p:g=q:b=v
            case 4:r=t:g=p:b=v
            case 5:r=v:g=p:b=q
        end select
        rgbpart$=_trim$(str$(r))+";"+_trim$(str$(g))+";"+_trim$(str$(b))
        result=result+chr$(27)+"[38;2;"+rgbpart$+"m"+umid$(text$,i,1)
    next i
    animatedrainbowtext$=result+chr$(27)+"[0m"
end function

function mod_double (value as double,m as double)
    mod_double=value-(m*int(value/m))
end function

function ulen% (txt$)
    dim count%,i%,b%
    for i%=1 to len(txt$)
        b%=asc(txt$,i%)
        if (b% and &h80)=0 or (b% and &hc0)=&hc0 then count%=count%+1
    next
    ulen%=count%
end function

function umid$ (txt$,startchar%,numchars%)
    if startchar%<1 or numchars%<=0 or txt$=""then exit function

    dim byteidx%,charcount%,startbyte%,endbyte%,b%
    byteidx%=1
    charcount%=0

    while byteidx%<=len(txt$)
        b%=asc(txt$,byteidx%)
        if (b% and &h80)=0 or (b% and &hc0)=&hc0 then
            charcount%=charcount%+1
            if charcount%=startchar% then startbyte%=byteidx%
        end if
        if startbyte%>0 then exit while
        byteidx%=byteidx%+1
    wend

    if startbyte%=0 then exit function

    byteidx%=startbyte%
    dim charsfound%
    charsfound%=0

    while byteidx%<=len(txt$)
        b%=asc(txt$,byteidx%)
        if (b% and &h80)=0 or (b% and &hc0)=&hc0 then
            charsfound%=charsfound%+1
        end if
        if charsfound%>numchars% then exit while
        byteidx%=byteidx%+1
    wend

    umid$=mid$(txt$,startbyte%,byteidx%-startbyte%)
end function

function uwidth% (txt$)
    dim totalwidth%,i%,char$,cp&
    totalwidth%=0
    for i%=1 to ulen(txt$)
        char$=umid(txt$,i%,1)
        cp&=getcodepoint&(char$)

        if cp&>&h1100 then
            totalwidth%=totalwidth%+2
        else
            totalwidth%=totalwidth%+1
        end if
    next
    uwidth%=totalwidth%
end function

function getcodepoint& (utf8char$)
    dim llength as integer
    llength=len(utf8char$)
    dim b1 as _unsigned _byte,b2 as _unsigned _byte
    dim b3 as _unsigned _byte,b4 as _unsigned _byte

    select case llength
        case 1
            getcodepoint&=asc(utf8char$,1)
        case 2
            b1=asc(utf8char$,1):b2=asc(utf8char$,2)
            getcodepoint&=(b1 and &h1f)*64+(b2 and &h3f)
        case 3
            b1=asc(utf8char$,1):b2=asc(utf8char$,2):b3=asc(utf8char$,3)
            getcodepoint&=(b1 and &h0f)*4096+(b2 and &h3f)*64+(b3 and &h3f)
        case 4
            b1=asc(utf8char$,1):b2=asc(utf8char$,2):b3=asc(utf8char$,3):b4=asc(utf8char$,4)
            getcodepoint&=(b1 and &h07)*262144+(b2 and &h3f)*4096+(b3 and &h3f)*64+(b4 and &h3f)
    end select
end function

sub loadsoundbank (filename as string)
    _midisoundbank filename
end sub


function GetConfig$ (FileName as string)
    select case left$(_os$,instr(_os$,"]"))
        case "[WINDOWS]"
            dim appdata as string
            appdata=environ$("APPDATA")
            if appdata="" then appdata=environ$("USERPROFILE")+"\AppData\Roaming"
            if right$(appdata,1)<>"\" then appdata=appdata+"\"
            GetConfig=appdata+FileName

        case "[MACOSX]"
            dim homemac as string
            homemac=environ$("HOME")
            if homemac="" then homemac="/tmp"
            if right$(homemac,1)="/" then homemac=left$(homemac,len(homemac)-1)
            GetConfig=homemac+"/Library/Application Support/"+FileName

        case else ' Linux and other Unix-like systems
            dim xdg as string,baseDir as string,homelinux as string
            xdg=environ$("XDG_CONFIG_HOME")
            if xdg<>"" then
                baseDir=xdg
            else
                homelinux=environ$("HOME")
                if homelinux="" then homelinux="/tmp"
                baseDir=homelinux+"/.config"
            end if
            if right$(baseDir,1)="/" then baseDir=left$(baseDir,len(baseDir)-1)
            GetConfig=baseDir+"/"+FileName
    end select
end function