visionmercer/cimp
1
0
Fork 0
Code Issues 3 Pull requests Projects Releases 1 Packages Wiki Activity Actions

respect repeat regulation

Browse source
This commit is contained in:
visionmercer 2026-06-09 10:56:09 +02:00
commit 765372aa6b
2 changed files with 505 additions and 481 deletions
Download patch file Download diff file Expand all files Collapse all files

BIN
cimp Executable file
View file

Binary file not shown.

986
cimp.bas
View file

@ -1,481 +1,505 @@
declare library "terminkey" 'declare library "terminkey"
function terminkey%() '' function terminkey%()
sub echooff() '' sub echooff()
sub echoon() '' sub echoon()
function termwidth() '' function termwidth()
end declare 'end declare
$console:only $console:only
const KEY_UP = 1001 const key_up=1001
const KEY_DOWN = 1002 const key_down=1002
const KEY_RIGHT = 1003 const key_right=1003
const KEY_LEFT = 1004 const key_left=1004
$if WIN then $if win then
Shell "chcp 65001 > nul" shell"chcp 65001 > nul"
$end if $end if
redim file(0) as string redim file(0) as string
if command$ = "" then if command$=""then
print "please specify file to play." print"please specify file to play."
system system
end if end if
echooff echooff
cursoroff cursoroff
chdir _startdir$ chdir _startdir$
dim volume as single dim volume as single
dim repeat as integer dim repeat as integer
dim shuffle as integer dim shuffle as integer
dim nooutput as integer dim nooutput as integer
dim timevis as integer dim timevis as integer
dim nyan as integer dim nyan as integer
dim marqueeOffset as integer dim marqueeoffset as integer
dim i as integer dim i as integer
dim musichandle as long dim musichandle as long
dim oldhandle as long dim oldhandle as long
dim keyin as integer dim keyin as integer
dim playnext as integer dim playnext as integer
dim state as string dim state as string
dim songname as string dim songname as string
dim progress as string dim progress as string
dim progressbar as string dim progressbar as string
dim tw as integer dim tw as integer
dim fixedWidth as integer dim fixedwidth as integer
dim maxTitleWidth as integer dim maxtitlewidth as integer
dim visibleTitle as string dim visibletitle as string
dim currentSongWidth as integer dim currentsongwidth as integer
dim paddedTitle as string dim paddedtitle as string
dim paddedLength as integer dim paddedlength as integer
dim idx as integer dim idx as integer
dim addedWidth as integer dim addedwidth as integer
dim charIdx as integer dim charidx as integer
dim nextChar as string dim nextchar as string
dim marqueeFrame as integer dim marqueeframe as integer
volume=1 volume=1
repeat=0 repeat=0
shuffle=0 shuffle=0
nooutput=0 nooutput=0
timevis=1 timevis=1
nyan=0 nyan=0
marqueeOffset=0 marqueeoffset=0
for i=1 to _commandcount for i=1 to _commandcount
select case command$(i) select case command$(i)
case "-v", "--volume" case "-v","--volume"
i=i+1 i=i+1
volume=val(command$(i)) / 100 volume=val(command$(i))/100
case "-s","--shuffle" case "-s","--shuffle"
shuffle=-1 shuffle=-1
case "-r","--repeat" case "-r","--repeat"
if command$(i+1)="1" then if command$(i+1)="1"then
repeat=1 repeat=1
else else
repeat=-1 repeat=-1
end if end if
case "-n","--nooutput" case "-n","--nooutput"
nooutput=-1 nooutput=-1
case "-N","--nyan" case "-N","--nyan"
nyan=-1 nyan=-1
case else case else
if _fileexists(command$(i)) then if _fileexists(command$(i)) then
if lcase$(right$(command$(i), 4))=".m3u" then if lcase$(right$(command$(i),4))=".m3u"then
ParseM3U command$(i),file() parsem3u command$(i),file()
else else
file(ubound(file))=command$(i) file(ubound(file))=command$(i)
redim _preserve file(ubound(file)+1) redim _preserve file(ubound(file)+1)
end if end if
end if end if
end select end select
next next
redim _preserve file(ubound(file)-1) redim _preserve file(ubound(file)-1)
if shuffle=-1 then shufflearray file() if shuffle=-1 then shufflearray file()
i=0 i=0
musichandle = _sndopen(file(i)) musichandle=_sndopen(file(i))
if musichandle = 0 then if musichandle=0 then
print "Error: could not open file "; file(i) print"Error: could not open file "; file(i)
system system
end if end if
_sndvol musichandle, volume _sndvol musichandle,volume
_sndplay musichandle _sndplay musichandle
state = "playing " state="playing "
songname = beforelast(".", afterlast("/", file(i))) songname=beforelast(".",afterlast("/",file(i)))
while keyin <> 27 while keyin<>27
keyin = terminkey keyin=terminkey
select case keyin select case keyin
case KEY_UP case key_up
volume = volume + (0.01 + (volume / 10)) volume=volume+(0.01+(volume/10))
if volume > 1 then volume = 1 if volume>1 then volume=1
_sndvol musichandle, volume _sndvol musichandle,volume
case KEY_DOWN case key_down
volume = volume - (0.01 + (volume / 10)) volume=volume-(0.01+(volume/10))
if volume < 0 then volume = 0 if volume<0 then volume=0
_sndvol musichandle, volume _sndvol musichandle,volume
case KEY_RIGHT case key_right
if _sndgetpos(musichandle) + 5 < _sndlen(musichandle) then if _sndgetpos(musichandle)+5<_sndlen(musichandle) then
_sndsetpos musichandle, _sndgetpos(musichandle) + 5 _sndsetpos musichandle,_sndgetpos(musichandle)+5
else else
playnext = 1 playnext=1
end if end if
case KEY_LEFT case key_left
if _sndgetpos(musichandle) - 5 > 0 then if _sndgetpos(musichandle)-5>0 then
_sndsetpos musichandle, _sndgetpos(musichandle) - 5 _sndsetpos musichandle,_sndgetpos(musichandle)-5
else else
playnext = -1 playnext=-1
end if end if
case asc("q") case asc("q")
keyin = 27 keyin=27
case asc("z") case asc("z")
if _sndgetpos(musichandle) > 2 then if _sndgetpos(musichandle)>2 then
_sndsetpos musichandle, 0 _sndsetpos musichandle,0
else else
playnext = -1 playnext=-1
end if end if
case asc("x") case asc("x")
if _sndplaying(musichandle) then if _sndplaying(musichandle) then
_sndsetpos musichandle, 0 _sndsetpos musichandle,0
else else
_sndplay musichandle _sndplay musichandle
end if end if
case asc("c"), asc(" ") case asc("c"),asc(" ")
if _sndplaying(musichandle) then if _sndplaying(musichandle) then
_sndpause musichandle _sndpause musichandle
state = "paused " state="paused "
else else
_sndplay musichandle _sndplay musichandle
state = "playing " state="playing "
end if end if
case asc("v") case asc("v")
_sndstop musichandle _sndstop musichandle
state = "stopped " state="stopped "
case asc("b") case asc("b")
playnext = 1 playnext=1
case asc("t") case asc("t")
timevis = -timevis timevis=-timevis
case asc("s") case asc("s")
shufflearray file() shufflearray file()
end select end select
if _sndgetpos(musichandle) = _sndlen(musichandle) then playnext = 1 if _sndgetpos(musichandle)=_sndlen(musichandle) then playnext=1
if playnext <> 0 then if playnext<>0 then
oldhandle = musichandle oldhandle=musichandle
i = i + playnext
if i > ubound(file) then i = 0 ' Check repeat settings before advancing the playlist index
if i < lbound(file) then i = ubound(file) if repeat=1 and playnext=1 then
musichandle = _sndopen(file(i)) ' Repeat current song: do not change index i
if musichandle <> 0 then playnext=0
_sndvol musichandle, volume else
_sndplay musichandle ' Advance or go back in playlist
_sndstop oldhandle i=i+playnext
_sndclose oldhandle
state = "playing " ' Check boundary conditions based on repeat settings
songname = beforelast(".", afterlast("/", file(i))) if i>ubound(file) then
playnext = 0 if repeat=-1 then
else i=0 ' Loop back to start if repeat playlist is enabled
musichandle=oldhandle else
end if goto quit ' Exit program if we reached the end of the files
end if end if
if timevis = 1 then elseif i<lbound(file) then
progress = " -" + timeleft(musichandle) if repeat=-1 then
else i=ubound(file) ' Loop to the end if navigating backwards
progress = " " + timeelapsed(musichandle) else
end if i=lbound(file) ' Clamp to start if repeat is off
if nooutput = 0 then end if
tw = termwidth end if
fixedWidth = UWidth(state) + UWidth(progress) end if
maxTitleWidth = tw - fixedWidth - 2
currentSongWidth = UWidth(songname) ' Only change song if playnext wasn't canceled by a track-level repeat
musichandle=_sndopen(file(i))
if currentSongWidth > maxTitleWidth and maxTitleWidth > 4 then if musichandle<>0 then
paddedTitle = songname + " " _sndvol musichandle,volume
paddedLength = ulen(paddedTitle) _sndplay musichandle
visibleTitle = "" _sndstop oldhandle
addedWidth = 0 _sndclose oldhandle
idx = 0 state="playing "
while addedWidth < maxTitleWidth songname=beforelast(".",afterlast("/",file(i)))
charIdx = ((marqueeOffset + idx) mod paddedLength) + 1 playnext=0
nextChar = umid(paddedTitle, charIdx, 1) else
if addedWidth + UWidth(nextChar) > maxTitleWidth then exit while musichandle=oldhandle
visibleTitle = visibleTitle + nextChar end if
addedWidth = addedWidth + UWidth(nextChar) end if
idx = idx + 1
wend if timevis=1 then
progress=" -"+timeleft(musichandle)
if addedWidth < maxTitleWidth then else
visibleTitle = visibleTitle + space$(maxTitleWidth - addedWidth) progress=" "+timeelapsed(musichandle)
end if end if
if nooutput=0 then
marqueeFrame = marqueeFrame + 1 tw=termwidth
if marqueeFrame mod 4 = 0 then fixedwidth=uwidth(state)+uwidth(progress)
marqueeOffset = marqueeOffset + 1 maxtitlewidth=tw-fixedwidth-2
if marqueeOffset >= paddedLength then marqueeOffset = 0 currentsongwidth=uwidth(songname)
end if
else if currentsongwidth>maxtitlewidth and maxtitlewidth>4 then
' Terminal is wide enough, no scrolling needed paddedtitle=songname+" "
visibleTitle = songname paddedlength=ulen(paddedtitle)
marqueeOffset = 0 visibletitle=""
end if addedwidth=0
idx=0
' Reset marquee offset if song changes while addedwidth<maxtitlewidth
if playnext <> 0 then marqueeOffset = 0 charidx=((marqueeoffset+idx) mod paddedlength)+1
nextchar=umid(paddedtitle,charidx,1)
' Print the text line if addedwidth+uwidth(nextchar)>maxtitlewidth then exit while
if nyan = -1 then visibletitle=visibletitle+nextchar
print termcolor(7); state; AnimatedRainbowText(visibleTitle); termcolor(7); progress; clearrest addedwidth=addedwidth+uwidth(nextchar)
else idx=idx+1
print termcolor(7); state; termcolor(3); visibleTitle; termcolor(7); progress; clearrest wend
end if
if addedwidth<maxtitlewidth then
' Generate and print progress bar matching the layout width visibletitle=visibletitle+space$(maxtitlewidth-addedwidth)
progressbar = bar(UWidth(state) + UWidth(visibleTitle) + UWidth(progress), (_sndgetpos(musichandle) / _sndlen(musichandle)) * 100, 11, 7) end if
print progressbar; clearrest; cursorback;
end if marqueeframe=marqueeframe+1
if marqueeframe mod 4=0 then
_limit 30 marqueeoffset=marqueeoffset+1
if _exit then goto quit if marqueeoffset>=paddedlength then marqueeoffset=0
wend end if
else
quit: ' Terminal is wide enough, no scrolling needed
_sndclose musichandle visibletitle=songname
print clearrest marqueeoffset=0
print clearrest; end if
print cursorback;
cursoron ' Reset marquee offset if song changes
echoon if playnext<>0 then marqueeoffset=0
system
' Print the text line
sub shufflearray (stringarray() as string) if nyan=-1 then
randomize timer print termcolor(7); state; animatedrainbowtext(visibletitle); termcolor(7); progress; clearrest
dim n as long, j as long else
for n = ubound(stringarray) to 1 step -1 print termcolor(7); state; termcolor(3); visibletitle; termcolor(7); progress; clearrest
j = int(rnd * n) end if
swap stringarray(n), stringarray(j)
next ' Generate and print progress bar matching the layout width
end sub progressbar=bar(uwidth(state)+uwidth(visibletitle)+uwidth(progress),(_sndgetpos(musichandle)/_sndlen(musichandle))*100,11,7)
print progressbar; clearrest; cursorback;
sub ParseM3U (filename$, array$()) end if
dim i as long, f as long, count as long
dim basePath$, l$, resolvedPath$ _limit 30
for i = len(filename$) to 1 step -1 if _exit then goto quit
if mid$(filename$, i, 1) = "/" or mid$(filename$, i, 1) = "\" then wend
basePath$ = left$(filename$, i)
exit for quit:
end if _sndclose musichandle
next print clearrest
f = freefile print clearrest;
open filename$ for input as #f print cursorback;
count = 0 cursoron
do until eof(f) echoon
line input #f, l$ system
l$ = _trim$(l$)
if len(l$) > 0 and left$(l$, 1) <> "#" then sub shufflearray (stringarray() as string)
resolvedPath$ = l$ randomize timer
if not _fileexists(resolvedPath$) then dim n as long,j as long
resolvedPath$ = basePath$ + l$ for n=ubound(stringarray) to 1 step -1
end if j=int(rnd*n)
if _fileexists(resolvedPath$) then swap stringarray(n),stringarray(j)
array$(ubound(array$)) = resolvedPath$ next
redim _preserve array$(ubound(array$) + 1) end sub
end if
end if sub parsem3u (filename$,array$())
loop dim i as long,f as long,count as long
close #f dim basepath$,l$,resolvedpath$
end sub for i=len(filename$) to 1 step -1
if mid$(filename$,i,1)="/"or mid$(filename$,i,1)="\"then
function timeleft$ (handle&) basepath$=left$(filename$,i)
dim seconds as integer exit for
seconds = _sndlen(handle&) - _sndgetpos(handle&) end if
if seconds < 0 then seconds = 0 next
timeleft$ = right$("0" + ltrim$(str$(seconds \ 60)), 2) + ":" + right$("0" + ltrim$(str$(seconds mod 60)), 2) f=freefile
end function open filename$ for input as #f
count=0
function timeelapsed$ (handle&) do until eof(f)
dim seconds as integer line input #f,l$
seconds = _sndgetpos(handle&) l$=_trim$(l$)
if seconds < 0 then seconds = 0 if len(l$)>0 and left$(l$,1)<>"#"then
timeelapsed$ = right$("0" + ltrim$(str$(seconds \ 60)), 2) + ":" + right$("0" + ltrim$(str$(seconds mod 60)), 2) resolvedpath$=l$
end function if not _fileexists(resolvedpath$) then
resolvedpath$=basepath$+l$
function termcolor$ (colorvalue as _unsigned long) end if
select case colorvalue if _fileexists(resolvedpath$) then
case 0 to 7 array$(ubound(array$))=resolvedpath$
termcolor = chr$(27) + "[0;3" + _trim$(str$(colorvalue)) + "m" redim _preserve array$(ubound(array$)+1)
case 8 to 15 end if
termcolor = chr$(27) + "[1;3" + _trim$(str$(colorvalue - 8)) + "m" end if
case 16 to 255 loop
termcolor = chr$(27) + "[38;5;" + _trim$(str$(colorvalue)) + "m" close #f
case is > 255 end sub
termcolor = chr$(27) + "[38;2;" + _trim$(str$(_red32(colorvalue))) + ";" + _trim$(str$(_green32(colorvalue))) + ";" + _trim$(str$(_blue32(colorvalue))) + "m"
end select function timeleft$ (handle&)
end function dim seconds as integer
seconds=_sndlen(handle&)-_sndgetpos(handle&)
function cursorback$ () if seconds<0 then seconds=0
cursorback = chr$(27) + "[F" timeleft$=right$("0"+ltrim$(str$(seconds \ 60)),2)+":"+right$("0"+ltrim$(str$(seconds mod 60)),2)
end function end function
function clearline$ function timeelapsed$ (handle&)
clearline = chr$(27) + "[2K" dim seconds as integer
end function seconds=_sndgetpos(handle&)
if seconds<0 then seconds=0
function clearrest$ timeelapsed$=right$("0"+ltrim$(str$(seconds \ 60)),2)+":"+right$("0"+ltrim$(str$(seconds mod 60)),2)
clearrest = chr$(27) + "[K" end function
end function
function termcolor$ (colorvalue as _unsigned long)
sub cursoroff () select case colorvalue
print chr$(27); "[?25l"; case 0 to 7
end sub termcolor=chr$(27)+"[0;3"+_trim$(str$(colorvalue))+"m"
case 8 to 15
sub cursoron () termcolor=chr$(27)+"[1;3"+_trim$(str$(colorvalue-8))+"m"
print chr$(27); "[?25h"; case 16 to 255
end sub termcolor=chr$(27)+"[38;5;"+_trim$(str$(colorvalue))+"m"
case is>255
function bar$ (length as integer, percent as integer, color1 as long, color2 as long) termcolor=chr$(27)+"[38;2;"+_trim$(str$(_red32(colorvalue)))+";"+_trim$(str$(_green32(colorvalue)))+";"+_trim$(str$(_blue32(colorvalue)))+"m"
dim done as string end select
dim notdone as string end function
dim i as integer
for i = 1 to int((percent / 100) * length) function cursorback$ ()
done = done + "━" cursorback=chr$(27)+"[F"
next i end function
for i = 1 to length - int((percent / 100) * length)
notdone = notdone + "━" function clearline$
next i clearline=chr$(27)+"[2K"
bar$ = termcolor(color1) + done + termcolor(color2) + notdone end function
end function
function clearrest$
function afterlast$ (delim as string, strng as string) clearrest=chr$(27)+"[K"
afterlast = mid$(strng, _instrrev(strng, delim) + 1) end function
end function
sub cursoroff ()
function beforelast$ (delim as string, strng as string) print chr$(27);"[?25l";
beforelast = left$(strng, _instrrev(strng, delim) - 1) end sub
end function
sub cursoron ()
function AnimatedRainbowText$ (text$) print chr$(27);"[?25h";
static offset as double end sub
dim result as string
dim L as long, i as long function bar$ (length as integer,percent as integer,color1 as long,color2 as long)
dim r as integer, g as integer, b as integer dim done as string
dim hue as double, f as double dim notdone as string
dim sector as integer, v as integer, p as integer, q as integer, t as integer dim i as integer
dim rgbPart$ for i=1 to int((percent/100)*length)
done=done+"━"
L = ulen(text$) next i
if L = 0 then exit function for i=1 to length-int((percent/100)*length)
offset = offset + 5.0 notdone=notdone+"━"
if offset >= 360 then offset = offset - 360 next i
bar$=termcolor(color1)+done+termcolor(color2)+notdone
for i = 1 to L end function
hue = MOD_Double(offset + ((i - 1) / L) * 360, 360)
sector = int(hue / 60) function afterlast$ (delim as string,strng as string)
f = (hue / 60) - sector afterlast=mid$(strng,_instrrev(strng,delim)+1)
v = 255: p = 0: q = 255 * (1 - f): t = 255 * f end function
select case sector
case 0: r = v: g = t: b = p function beforelast$ (delim as string,strng as string)
case 1: r = q: g = v: b = p beforelast=left$(strng,_instrrev(strng,delim)-1)
case 2: r = p: g = v: b = t end function
case 3: r = p: g = q: b = v
case 4: r = t: g = p: b = v function animatedrainbowtext$ (text$)
case 5: r = v: g = p: b = q static offset as double
end select dim result as string
rgbPart$ = _trim$(str$(r)) + ";" + _trim$(str$(g)) + ";" + _trim$(str$(b)) dim l as long,i as long
result = result + chr$(27) + "[38;2;" + rgbPart$ + "m" + umid$(text$, i, 1) dim r as integer,g as integer,b as integer
next i dim hue as double,f as double
AnimatedRainbowText$ = result + chr$(27) + "[0m" dim sector as integer,v as integer,p as integer,q as integer,t as integer
end function dim rgbpart$
function MOD_Double (value as double, m as double) l=ulen(text$)
MOD_Double = value - (m * int(value / m)) if l=0 then exit function
end function offset=offset+5.0
if offset>=360 then offset=offset-360
function ulen% (txt$)
dim count%, i%, b% for i=1 to l
count% = 0 hue=mod_double(offset+((i-1)/l)*360,360)
for i% = 1 to len(txt$) sector=int(hue/60)
b% = asc(txt$, i%) f=(hue/60)-sector
if (b% and &H80) = 0 or (b% and &HC0) = &HC0 then v=255:p=0:q=255*(1-f):t=255*f
count% = count% + 1 select case sector
end if case 0:r=v:g=t:b=p
next case 1:r=q:g=v:b=p
ulen% = count% case 2:r=p:g=v:b=t
end function case 3:r=p:g=q:b=v
case 4:r=t:g=p:b=v
function umid$ (txt$, startChar%, numChars%) case 5:r=v:g=p:b=q
if startChar% < 1 or numChars% <= 0 or txt$ = "" then exit function end select
rgbpart$=_trim$(str$(r))+";"+_trim$(str$(g))+";"+_trim$(str$(b))
dim byteIdx%, charCount%, startByte%, endByte%, b% result=result+chr$(27)+"[38;2;"+rgbpart$+"m"+umid$(text$,i,1)
byteIdx% = 1 next i
charCount% = 0 animatedrainbowtext$=result+chr$(27)+"[0m"
end function
while byteIdx% <= len(txt$)
b% = asc(txt$, byteIdx%) function mod_double (value as double,m as double)
if (b% and &H80) = 0 or (b% and &HC0) = &HC0 then mod_double=value-(m*int(value/m))
charCount% = charCount% + 1 end function
if charCount% = startChar% then startByte% = byteIdx%
end if function ulen% (txt$)
if startByte% > 0 then exit while dim count%,i%,b%
byteIdx% = byteIdx% + 1 count%=0
wend for i%=1 to len(txt$)
b%=asc(txt$,i%)
if startByte% = 0 then exit function if (b% and &h80)=0 or (b% and &hc0)=&hc0 then
count%=count%+1
byteIdx% = startByte% end if
dim charsFound% next
charsFound% = 0 ulen%=count%
end function
while byteIdx% <= len(txt$)
b% = asc(txt$, byteIdx%) function umid$ (txt$,startchar%,numchars%)
if (b% and &H80) = 0 or (b% and &HC0) = &HC0 then if startchar%<1 or numchars%<=0 or txt$=""then exit function
charsFound% = charsFound% + 1
end if dim byteidx%,charcount%,startbyte%,endbyte%,b%
if charsFound% > numChars% then exit while byteidx%=1
byteIdx% = byteIdx% + 1 charcount%=0
wend
while byteidx%<=len(txt$)
umid$ = mid$(txt$, startByte%, byteIdx% - startByte%) b%=asc(txt$,byteidx%)
end function if (b% and &h80)=0 or (b% and &hc0)=&hc0 then
charcount%=charcount%+1
function UWidth% (txt$) if charcount%=startchar% then startbyte%=byteidx%
dim totalWidth%, i%, char$, cp& end if
totalWidth% = 0 if startbyte%>0 then exit while
for i% = 1 to ulen(txt$) byteidx%=byteidx%+1
char$ = umid(txt$, i%, 1) wend
cp& = GetCodePoint&(char$)
if startbyte%=0 then exit function
if cp& > &H1100 then
totalWidth% = totalWidth% + 2 byteidx%=startbyte%
else dim charsfound%
totalWidth% = totalWidth% + 1 charsfound%=0
end if
next while byteidx%<=len(txt$)
UWidth% = totalWidth% b%=asc(txt$,byteidx%)
end function if (b% and &h80)=0 or (b% and &hc0)=&hc0 then
charsfound%=charsfound%+1
function GetCodePoint& (utf8Char$) end if
dim lLength as integer if charsfound%>numchars% then exit while
lLength = len(utf8Char$) byteidx%=byteidx%+1
dim b1 as _unsigned _byte, b2 as _unsigned _byte wend
dim b3 as _unsigned _byte, b4 as _unsigned _byte
umid$=mid$(txt$,startbyte%,byteidx%-startbyte%)
select case lLength end function
case 1
GetCodePoint& = asc(utf8Char$, 1) function uwidth% (txt$)
case 2 dim totalwidth%,i%,char$,cp&
b1 = asc(utf8Char$, 1): b2 = asc(utf8Char$, 2) totalwidth%=0
GetCodePoint& = (b1 and &H1F) * 64 + (b2 and &H3F) for i%=1 to ulen(txt$)
case 3 char$=umid(txt$,i%,1)
b1 = asc(utf8Char$, 1): b2 = asc(utf8Char$, 2): b3 = asc(utf8Char$, 3) cp&=getcodepoint&(char$)
GetCodePoint& = (b1 and &H0F) * 4096 + (b2 and &H3F) * 64 + (b3 and &H3F)
case 4 if cp&>&h1100 then
b1 = asc(utf8Char$, 1): b2 = asc(utf8Char$, 2): b3 = asc(utf8Char$, 3): b4 = asc(utf8Char$, 4) totalwidth%=totalwidth%+2
GetCodePoint& = (b1 and &H07) * 262144 + (b2 and &H3F) * 4096 + (b3 and &H3F) * 64 + (b4 and &H3F) else
end select totalwidth%=totalwidth%+1
end function 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