cimp/cimp.bas

678 lines
19 KiB
QBasic
Raw Permalink Normal View History

2026-06-10 10:35:36 +02:00
declare library"terminkey"
2026-06-10 10:32:15 +02:00
function terminkey%()
sub echooff()
sub echoon()
function termwidth()
2026-06-23 10:21:17 +02:00
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()
2026-06-10 10:32:15 +02:00
end declare
$console:only
on error goto quit
2026-06-10 10:35:36 +02:00
const key_up=1001
const key_down=1002
const key_right=1003
const key_left=1004
2026-06-23 12:10:10 +02:00
dim slash as string
slash="/"
2026-06-10 10:35:36 +02:00
$if win then
shell"chcp 65001 > nul"
2026-06-23 12:10:10 +02:00
slash="\"
2026-06-10 10:32:15 +02:00
$end if
2026-06-10 10:35:36 +02:00
2026-06-10 10:32:15 +02:00
redim file(0) as string
2026-06-23 12:10:10 +02:00
chdir _startdir$
2026-06-10 10:35:36 +02:00
if command$=""then
print"please specify file to play."
2026-06-10 10:32:15 +02:00
goto quit
end if
2026-06-23 10:21:17 +02:00
dim ipc_status as long
ipc_status = ipc_init
if ipc_status = 0 then
' --- CLIENT MODE ---
dim cmd_msg as string
2026-06-23 12:10:10 +02:00
Select Case command$(1)
Case "--next"
cmd_msg = "NEXT"
2026-06-24 11:44:10 +02:00
2026-06-23 12:10:10 +02:00
Case "--prev"
cmd_msg = "PREV"
2026-06-23 10:21:17 +02:00
2026-06-23 12:10:10 +02:00
Case "-v", "--volume"
cmd_msg = "VOL:" + command$(2)
2026-06-24 11:44:10 +02:00
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"
2026-06-24 12:40:02 +02:00
case "--nyan"
cmd_msg = "NYAN"
2026-06-23 12:10:10 +02:00
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)
2026-06-24 12:00:25 +02:00
ipc_send_message cmd_msg
2026-06-23 12:10:10 +02:00
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
2026-06-23 10:21:17 +02:00
' 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
2026-06-24 11:44:10 +02:00
' ---SERVER MODE (Main Player Execution)---
2026-06-23 10:21:17 +02:00
2026-06-10 10:32:15 +02:00
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
2026-06-10 10:35:36 +02:00
dim marqueeoffset as integer
2026-06-10 10:32:15 +02:00
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
2026-06-10 10:35:36 +02:00
dim fixedwidth as integer
dim maxtitlewidth as integer
dim visibletitle as string
dim currentsongwidth as integer
dim paddedtitle as string
dim paddedlength as integer
2026-06-10 10:32:15 +02:00
dim idx as integer
2026-06-10 10:35:36 +02:00
dim addedwidth as integer
dim charidx as integer
dim nextchar as string
dim marqueeframe as integer
2026-06-10 10:32:15 +02:00
volume=1
repeat=0
shuffle=0
nooutput=0
timevis=1
nyan=0
2026-06-10 10:35:36 +02:00
marqueeoffset=0
2026-06-10 10:32:15 +02:00
for i=1 to _commandcount
select case command$(i)
2026-06-10 10:35:36 +02:00
case "-v","--volume"
2026-06-10 10:32:15 +02:00
i=i+1
2026-06-10 10:35:36 +02:00
volume=val(command$(i))/100
2026-06-10 10:32:15 +02:00
case "-s","--shuffle"
shuffle=-1
case "-r","--repeat"
2026-06-10 10:35:36 +02:00
if command$(i+1)="1"then
2026-06-10 10:32:15 +02:00
repeat=1
else
repeat=-1
end if
case "-n","--nooutput"
nooutput=-1
case "-N","--nyan"
nyan=-1
case else
if _fileexists(command$(i)) then
2026-06-10 10:35:36 +02:00
if lcase$(right$(command$(i),4))=".m3u"then
parsem3u command$(i),file()
2026-06-10 10:32:15 +02:00
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
2026-06-10 10:35:36 +02:00
musichandle=_sndopen(file(i))
if musichandle=0 then
print"Error: could not open file "; file(i)
2026-06-10 10:32:15 +02:00
goto quit
end if
2026-06-10 10:35:36 +02:00
_sndvol musichandle,volume
2026-06-10 10:32:15 +02:00
_sndplay musichandle
2026-06-10 10:35:36 +02:00
state="playing "
songname=beforelast(".",afterlast("/",file(i)))
2026-06-10 10:32:15 +02:00
2026-06-10 10:35:36 +02:00
while keyin<>27
keyin=terminkey
2026-06-24 11:44:10 +02:00
' ---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 = "SHUFFLE" then
keyin=asc("s")
2026-06-24 12:40:02 +02:00
elseif client_cmd = "NYAN" then
nyan = not nyan
2026-06-24 11:44:10 +02:00
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 ---
2026-06-10 10:32:15 +02:00
select case keyin
2026-06-10 10:35:36 +02:00
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
2026-06-10 10:32:15 +02:00
else
2026-06-10 10:35:36 +02:00
playnext=1
2026-06-10 10:32:15 +02:00
end if
2026-06-10 10:35:36 +02:00
case key_left
if _sndgetpos(musichandle)-5>0 then
_sndsetpos musichandle,_sndgetpos(musichandle)-5
2026-06-10 10:32:15 +02:00
else
2026-06-10 10:35:36 +02:00
playnext=-1
2026-06-10 10:32:15 +02:00
end if
case asc("q")
2026-06-10 10:35:36 +02:00
keyin=27
2026-06-10 10:32:15 +02:00
case asc("z")
2026-06-10 10:35:36 +02:00
if _sndgetpos(musichandle)>2 then
_sndsetpos musichandle,0
2026-06-10 10:32:15 +02:00
else
2026-06-10 10:35:36 +02:00
playnext=-1
2026-06-10 10:32:15 +02:00
end if
case asc("x")
if _sndplaying(musichandle) then
2026-06-10 10:35:36 +02:00
_sndsetpos musichandle,0
2026-06-10 10:32:15 +02:00
else
_sndplay musichandle
end if
2026-06-10 10:35:36 +02:00
case asc("c"),asc(" ")
2026-06-10 10:32:15 +02:00
if _sndplaying(musichandle) then
_sndpause musichandle
2026-06-10 10:35:36 +02:00
state="paused "
2026-06-10 10:32:15 +02:00
else
_sndplay musichandle
2026-06-10 10:35:36 +02:00
state="playing "
2026-06-10 10:32:15 +02:00
end if
case asc("v")
_sndstop musichandle
2026-06-10 10:35:36 +02:00
state="stopped "
2026-06-10 10:32:15 +02:00
case asc("b")
2026-06-10 10:35:36 +02:00
playnext=1
2026-06-10 10:32:15 +02:00
case asc("t")
2026-06-10 10:35:36 +02:00
timevis=-timevis
2026-06-10 10:32:15 +02:00
case asc("s")
shufflearray file()
end select
2026-06-10 10:35:36 +02:00
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)
2026-06-10 10:32:15 +02:00
end if
end if
end if
2026-06-10 10:35:36 +02:00
musichandle=_sndopen(file(i))
if musichandle<>0 then
_sndvol musichandle,volume
_sndplay musichandle
_sndstop oldhandle
_sndclose oldhandle
state="playing "
2026-06-24 13:37:45 +02:00
songname=beforelast(".",afterlast(slash,file(i)))
2026-06-10 10:35:36 +02:00
playnext=0
else
musichandle=oldhandle
end if
end if
if timevis=1 then
progress=" -"+timeleft(musichandle)
2026-06-10 10:32:15 +02:00
else
2026-06-10 10:35:36 +02:00
progress=" "+timeelapsed(musichandle)
2026-06-10 10:32:15 +02:00
end if
2026-06-10 10:35:36 +02:00
if nooutput=0 then
tw=termwidth
fixedwidth=uwidth(state)+uwidth(progress)
maxtitlewidth=tw-fixedwidth-2
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)
2026-06-10 10:32:15 +02:00
end if
2026-06-10 10:35:36 +02:00
marqueeframe=marqueeframe+1
if marqueeframe mod 4=0 then
marqueeoffset=marqueeoffset+1
if marqueeoffset>=paddedlength then marqueeoffset=0
2026-06-10 10:32:15 +02:00
end if
2026-06-10 10:35:36 +02:00
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
2026-06-10 10:32:15 +02:00
end if
2026-06-10 10:35:36 +02:00
' 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
2026-06-10 10:32:15 +02:00
_limit 30
if _exit then goto quit
2026-06-23 10:21:17 +02:00
wend
2026-06-10 10:32:15 +02:00
quit:
_sndclose musichandle
2026-06-23 10:21:17 +02:00
ipc_cleanup
2026-06-10 10:32:15 +02:00
print clearrest
print clearrest;
print cursorback;
2026-06-10 10:35:36 +02:00
print chr$(27)+"[0m";
2026-06-10 10:32:15 +02:00
cursoron
echoon
system
sub shufflearray (stringarray() as string)
randomize timer
2026-06-10 10:35:36 +02:00
dim n as long,j as long
for n=ubound(stringarray) to 1 step -1
j=int(rnd*n)
swap stringarray(n),stringarray(j)
2026-06-10 10:32:15 +02:00
next
end sub
2026-06-10 10:35:36 +02:00
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)
2026-06-10 10:32:15 +02:00
exit for
end if
next
2026-06-10 10:35:36 +02:00
f=freefile
2026-06-10 10:32:15 +02:00
open filename$ for input as #f
2026-06-10 10:35:36 +02:00
count=0
2026-06-10 10:32:15 +02:00
do until eof(f)
2026-06-10 10:35:36 +02:00
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$
2026-06-10 10:32:15 +02:00
end if
2026-06-10 10:35:36 +02:00
if _fileexists(resolvedpath$) then
array$(ubound(array$))=resolvedpath$
redim _preserve array$(ubound(array$)+1)
2026-06-10 10:32:15 +02:00
end if
end if
loop
close #f
end sub
function timeleft$ (handle&)
dim seconds as integer
2026-06-10 10:35:36 +02:00
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)
2026-06-10 10:32:15 +02:00
end function
function timeelapsed$ (handle&)
dim seconds as integer
2026-06-10 10:35:36 +02:00
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)
2026-06-10 10:32:15 +02:00
end function
function termcolor$ (colorvalue as _unsigned long)
select case colorvalue
case 0 to 7
2026-06-10 10:35:36 +02:00
termcolor=chr$(27)+"[0;3"+_trim$(str$(colorvalue))+"m"
2026-06-10 10:32:15 +02:00
case 8 to 15
2026-06-10 10:35:36 +02:00
termcolor=chr$(27)+"[1;3"+_trim$(str$(colorvalue-8))+"m"
2026-06-10 10:32:15 +02:00
case 16 to 255
2026-06-10 10:35:36 +02:00
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"
2026-06-10 10:32:15 +02:00
end select
end function
function cursorback$ ()
2026-06-10 10:35:36 +02:00
cursorback=chr$(27)+"[F"
2026-06-10 10:32:15 +02:00
end function
function clearline$
2026-06-10 10:35:36 +02:00
clearline=chr$(27)+"[2K"
2026-06-10 10:32:15 +02:00
end function
function clearrest$
2026-06-10 10:35:36 +02:00
clearrest=chr$(27)+"[K"
2026-06-10 10:32:15 +02:00
end function
sub cursoroff ()
2026-06-10 10:35:36 +02:00
print chr$(27);"[?25l";
2026-06-10 10:32:15 +02:00
end sub
sub cursoron ()
2026-06-10 10:35:36 +02:00
print chr$(27);"[?25h";
2026-06-10 10:32:15 +02:00
end sub
2026-06-10 10:35:36 +02:00
function bar$ (length as integer,percent as integer,color1 as long,color2 as long)
2026-06-10 10:32:15 +02:00
dim done as string
dim notdone as string
dim i as integer
2026-06-10 10:35:36 +02:00
for i=1 to int((percent/100)*length)
done=done+"━"
2026-06-10 10:32:15 +02:00
next i
2026-06-10 10:35:36 +02:00
for i=1 to length-int((percent/100)*length)
notdone=notdone+"━"
2026-06-10 10:32:15 +02:00
next i
2026-06-10 10:35:36 +02:00
bar$=termcolor(color1)+done+termcolor(color2)+notdone
2026-06-10 10:32:15 +02:00
end function
2026-06-10 10:35:36 +02:00
function afterlast$ (delim as string,strng as string)
afterlast=mid$(strng,_instrrev(strng,delim)+1)
2026-06-10 10:32:15 +02:00
end function
2026-06-10 10:35:36 +02:00
function beforelast$ (delim as string,strng as string)
beforelast=left$(strng,_instrrev(strng,delim)-1)
2026-06-10 10:32:15 +02:00
end function
2026-06-10 10:35:36 +02:00
function animatedrainbowtext$ (text$)
2026-06-10 10:32:15 +02:00
static offset as double
dim result as string
2026-06-10 10:35:36 +02:00
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
2026-06-10 10:32:15 +02:00
select case sector
2026-06-10 10:35:36 +02:00
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
2026-06-10 10:32:15 +02:00
end select
2026-06-10 10:35:36 +02:00
rgbpart$=_trim$(str$(r))+";"+_trim$(str$(g))+";"+_trim$(str$(b))
result=result+chr$(27)+"[38;2;"+rgbpart$+"m"+umid$(text$,i,1)
2026-06-10 10:32:15 +02:00
next i
2026-06-10 10:35:36 +02:00
animatedrainbowtext$=result+chr$(27)+"[0m"
2026-06-10 10:32:15 +02:00
end function
2026-06-10 10:35:36 +02:00
function mod_double (value as double,m as double)
mod_double=value-(m*int(value/m))
2026-06-10 10:32:15 +02:00
end function
function ulen% (txt$)
2026-06-10 10:35:36 +02:00
dim count%,i%,b%
count%=0
for i%=1 to len(txt$)
b%=asc(txt$,i%)
if (b% and &h80)=0 or (b% and &hc0)=&hc0 then
count%=count%+1
2026-06-10 10:32:15 +02:00
end if
next
2026-06-10 10:35:36 +02:00
ulen%=count%
2026-06-10 10:32:15 +02:00
end function
2026-06-10 10:35:36 +02:00
function umid$ (txt$,startchar%,numchars%)
if startchar%<1 or numchars%<=0 or txt$=""then exit function
2026-06-10 10:32:15 +02:00
2026-06-10 10:35:36 +02:00
dim byteidx%,charcount%,startbyte%,endbyte%,b%
byteidx%=1
charcount%=0
2026-06-10 10:32:15 +02:00
2026-06-10 10:35:36 +02:00
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%
2026-06-10 10:32:15 +02:00
end if
2026-06-10 10:35:36 +02:00
if startbyte%>0 then exit while
byteidx%=byteidx%+1
2026-06-10 10:32:15 +02:00
wend
2026-06-10 10:35:36 +02:00
if startbyte%=0 then exit function
byteidx%=startbyte%
dim charsfound%
charsfound%=0
2026-06-10 10:32:15 +02:00
2026-06-10 10:35:36 +02:00
while byteidx%<=len(txt$)
b%=asc(txt$,byteidx%)
if (b% and &h80)=0 or (b% and &hc0)=&hc0 then
charsfound%=charsfound%+1
2026-06-10 10:32:15 +02:00
end if
2026-06-10 10:35:36 +02:00
if charsfound%>numchars% then exit while
byteidx%=byteidx%+1
2026-06-10 10:32:15 +02:00
wend
2026-06-10 10:35:36 +02:00
umid$=mid$(txt$,startbyte%,byteidx%-startbyte%)
2026-06-10 10:32:15 +02:00
end function
2026-06-10 10:35:36 +02:00
function uwidth% (txt$)
dim totalwidth%,i%,char$,cp&
totalwidth%=0
for i%=1 to ulen(txt$)
char$=umid(txt$,i%,1)
cp&=getcodepoint&(char$)
2026-06-10 10:32:15 +02:00
2026-06-10 10:35:36 +02:00
if cp&>&h1100 then
totalwidth%=totalwidth%+2
2026-06-10 10:32:15 +02:00
else
2026-06-10 10:35:36 +02:00
totalwidth%=totalwidth%+1
2026-06-10 10:32:15 +02:00
end if
next
2026-06-10 10:35:36 +02:00
uwidth%=totalwidth%
2026-06-10 10:32:15 +02:00
end function
2026-06-10 10:35:36 +02:00
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
2026-06-10 10:32:15 +02:00
2026-06-10 10:35:36 +02:00
select case llength
2026-06-10 10:32:15 +02:00
case 1
2026-06-10 10:35:36 +02:00
getcodepoint&=asc(utf8char$,1)
2026-06-10 10:32:15 +02:00
case 2
2026-06-10 10:35:36 +02:00
b1=asc(utf8char$,1):b2=asc(utf8char$,2)
getcodepoint&=(b1 and &h1f)*64+(b2 and &h3f)
2026-06-10 10:32:15 +02:00
case 3
2026-06-10 10:35:36 +02:00
b1=asc(utf8char$,1):b2=asc(utf8char$,2):b3=asc(utf8char$,3)
getcodepoint&=(b1 and &h0f)*4096+(b2 and &h3f)*64+(b3 and &h3f)
2026-06-10 10:32:15 +02:00
case 4
2026-06-10 10:35:36 +02:00
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)
2026-06-10 10:32:15 +02:00
end select
end function