
/*

UNICODE.INC
 
01:55 11/04/2025
CP



 sample unicode symbols

 α β γ δ ε ζ η θ ι κ λ μ ν ξ ο π ρ ς τ υ φ χ ψ ω
 Α α, Β β, Γ γ, Δ δ, Ε ε, Ζ ζ, Η η, Θ θ, Ι ι, Κ κ, Λ λ, Μ μ, Ν ν, Ξ ξ, Ο ο, Π π, Ρ ρ, Σ σ/ς, Τ τ, Υ υ, Φ φ, Χ χ, Ψ ψ, Ω ω.
 Γ Δ Θ Λ Ξ Π Σ σ/ς Υ Φ Ψ Ω

 𑀲 𑁣 𑁜 𑁯 𑁡
 √ ∛ ∜∿≈
 ℂ ℝ ⅈ ⅉ
 ℱ ℒ ℛ
 ∑ ⨊ ⨁
 ≡ ∫ ∬ ∭
 ℇ ∞ ⧜ ⧝ ⧞
 ℯ, ⅇ
 😎 😇 😈 😋 😏 😌 😁 😀 ☻ ☺ ☠
 ⚽ ⚾ ⛒ ⚫ ☀ ⛯ ☁ ☎ ♞ ☔ ☲ ☰ ♠ ♣ ♥ ♦ ☚ ☛ ♜ ♒︎ ☝️🏿 ☘️ ⛺︎
 ⚞ ⚟ ⚠ ⚡ ⛉ ⛊ ⛋ ⛔ ⛛ ⛝ ⛶ ⚛ ⛬ ⛭ ⛯ ⛿ ☎ ☢ ⛰ ♫
 ☕︎ ☑️ ⛨ ⚑ ⚐ ⚅ 💬 🐑 🐧 🌴 🌐 ⏱ ⏲ 👓 👢 💎 🔈 🔇 📞 🔍
 📎 ✂ 🔧 ⚖ 💊 ⚱ ⚠ 🚫
 ➡ ⬆ ⬅ ⬇ ↖ ↩ ↪ 🔄 🔃 ☯ 🕉 ☸ ✡ 🔽 ⏮ ⏺ ☑ ➿  🏴󠁧󠁢󠁥󠁮󠁧󠁿
*/



/*
double φ, ϕ, π
φ = (sqr(5)+1)/2
ϕ = (sqr(5)-1)/2
π = pi()
wstring s=L"π, φ, ϕ >>" cr L"π" tab π  cr L"φ" tab φ cr L"ϕ" tab ϕ cr
print s
print s cr L"ok"
*/

/*
function fn☘️(float α) as float
return α * α
end function
'
'256☑️
' print statement must end with long string
print L" ⛰ " fn☘️(16) L""
*/



/*
wstring caption = L"English" tab L"Greek" tab L"Serbian" tab L"Chinese"
wstring term1   = L"House"   tab L"Σπίτι" tab L"Кућа"    tab L"屋"
wstring term2   = L"City"    tab L"Πόλη"  tab L"град"    tab L"市"

print caption + cr + term1 + cr + term2
*/

/*
double ∞ = 1/0
double ☠ = -∞
'wstring ♣ = str(☠)
'print L"⚫ " ♣
print L"⚫ " ☠ L""
*/

function ucode16(wstring s, int i=1) as int
===========================================
dword c
sys p=strptr s
if not p then return 0
word w at p+(i*2)-2
select w
case 0xd800 to 0xdfff
  c=0x10000+(w-0xd800)*0x400 ' upper 0x400 (10) bits
  @w+=2
  c=c+w-0xdc00
case else
  c=w
end select
return c
end function


function uchr16(dword v) as wbstring
====================================
word wh,wl
select v
case 0x00 to 0xffff
  return wchr(v)
case else
  v-=0x10000
  wh=(v>>10)+0xd800
  wl=(v and 0x3ff)+0xdc00
  sys p=getmemory 4
  word ww at (p)
  ww=wh
  @ww+=2
  ww=wl
  strptr(function)=p
end select
end function


function umid16(wbstring s,int i,n=0) as wbstring
=================================================
'
'unicode mid adjusted for surrigate pairs offset
int ii,j,d,e,f,k,x
sys p,q
p=strptr(s)
e=0
if p
  int a at p-4
  e=a
else
  jmp fwd xumid16
endif
word*w
d=2
@w=p
i*=2
ii=i
if i<0     'negative index
  d=-2     'step backward
  f=-2     
  @w=p+e-2 'start at last char
  i=e      'last char
  ii=-ii   'set positive
endif
'
if i=0 '0 index
  i=2
endif
n*=2
if n=0
  n=e-i+2 'default length
endif
if n<0 then n=0 : jmp fwd xumid16
k=2
'
do
  if i>e then n=0 : jmp fwd xumid16
  if f
    if i<=2 then i=2 : exit do
  endif
  if k>=ii then
    if f then x=2 else exit do
  endif
  select w
  case 0xd800 to 0xdfff
    'as surrogate pairs
    @w+=d : i+=d 'forwards or backwards
  end select
  if x then exit do
  @w+=d : i+=f : k+=2
end do
'
k=2 : ii=n : j=i : n=0
do
  if k>ii then exit do
  if j>e then exit do
  select w
  case 0xd800 to 0xdfff
    'surrogate pairs
    @w+=2 : j+=2 : n+=2
  end select
  @w+=2 : j+=2 : k+=2 : n+=2
end do
'
xumid16:
'
q=getmemory n
if n
  copy q,p+i-2,n
endif
strptr(function)=q
end function


macro uleft16(s,i) {umid16(s,i)}

macro uright16(s,i) {umid16(s,-(i))}

procedure uprint16(wstring s)
print s
end procedure





