'UTFT.INC


function BinScript(string s, int i,le) as string
================================================
  'convert to hex byte codes
  string w=space(le*3)  'output
  byte *bs,*bw
  byte a,b,v
  int k,m
  @bs=strptr(s)+i-1 'src byte ptr
  @bw=strptr(w)     'dest byte ptr
  m=1
  for k=i to i+le-1
    'see hexb(..)
    v=bs : @bs++
    a=v and 15
    b=(v >> 4) and 15
    select a
      case 0 to 9   : a+=48
      case 10 to 15 : a+=55
    end select
    select b
      case 0 to 9   : b+=48
      case 10 to 15 : b+=55
    end select
    bw=b : m++ : @bw++
    bw=a : m+=2 : @bw+=2
  next
  return w
end function 'BinScript

int gbc    'source length
int utf16  'utf-16 flag
'
procedure ConvertUTF(string*src, int mo=0)
==========================================
  '
  indexbase 0
  '
  'itr unclosed quotes in comments
  '
  int a,k,m              'general
  int i                  'source byte counter
  int j                  'dest byte counter
  int ls=len src         'source length
  int lg=ls*3            'buffer length
  int stt                'start offset
  int bomr               'big-endian flag
  string dst=nuls lg     'dest buffer
  int xt                 'loop exit flag
  int bc                 'start of unicode comment
  int bj                 'start of unicode quote
  int rp                 'string record position
  int le                 'length of quote including quote marks
  int sk                 'skip flag for comments
  string w1="",w2=""     'general
  byte bs at strptr(src) 'source byte overlay
  byte bg at strptr(dst) 'dest byte overlay
  byte bt                'swapper byte
  '
  jmp fwd begin
  '

  subroutine StoreString
  ======================
  'string taken out of compiler processing
  'string reference embedded instead
  rp=utfi+1 'base 1
  if sk
    sk=0 : return
    le=i-bc
    w1=mid(src,bc+1,le)
  else
    le=j-bj-3
    w1=mid(dst,bj+3,le)
  endif
  'qu'
  'quote content excluding marks
  'same as refstring except cqq
  'iqq-1 signifies wide-char string
  'see if qot
  w2=qu+chr(iqq-1)+str(utfi+1)+" "+qu 'cqq
  appendlen(utfs,utfi,w1)
  '
  if sk
    a=sk+1
  else
    a=1 'overwriting L prefix
  endif
  mid dst,bj+a,w2
'print mid dst, bj+1,len(w2)
  'adjust dst and j
  j=bj+len(w2)
  @bg=strptr(dst)+j
  end subroutine
  '
  subroutine nextchar8
  ====================
  bg=bs : @bg++ : @bs++ : i++ : j++
  end subroutine
  '
  subroutine nextchar16
  =====================
  bg=bs : @bg++ : @bs+=2 : i+=2 : j++
  end subroutine
  '
  subroutine skipchar16
  =====================
  @bs+=2 : i+=2
  end subroutine
  '
  subroutine skipline16
  =====================
  while i<ls
    if bs[1]=0
      if bs=13
        exit while
      endif
      if bs=10
        exit while
      endif
    endif
    gosub skipchar16
  wend
  end subroutine
  '
  subroutine encodehex
  ====================
  a=bs>>4
  if a>9
    a+=7
  endif
  bg=a+48 : @bg++ : j++
  a=bs and 15
  if a>9
    a+=7
  endif
  bg=a+48 : @bg++ : j++
  @bs++ : i++
  end subroutine
  '
  subroutine MakeCommentRecord
  ============================
  if mo=1
    sk=1
    gosub StoreString
    sk=0
  endif
  end subroutine
  '
  '
  begin:
  ======
  '
  indexbase 1
  utf16=0
  gbc+=len(src)
  '
  'UTF-8: 0xEF 0xBB,0xBF
  if (bs[1]=0xef) and (bs[2]=0xbb)  and (bs[3]=0xbf)
    stt=3 
  'UTF-16 little endian 
  elseif (bs[1]=0xff) and (bs[2]=0xfe)
    utf16=1 : omo or=2
    bomr=0 'little endian
    stt=2
  'UTF-16 big endian
  elseif (bs[1]=0xfe) and (bs[2]=0xff)
    utf16=1 : omo or=2
    bomr=1 'big endian
    stt=2
  endif
  '
  if not utf16
    if omo and 2 'wide chars
      utf16=1
      stt=0
    endif
  endif
  '
  i=stt
  @bs=strptr(src)+i
  '
  if utf16
    if bomr
      while i<ls
        'convert to little endian
        bt=bs[2]
        bs[2]=bs[1]
        bs[1]=bt
        @bs+=2
        i+=2
      wend
      i=stt
    endif
    @bs=strptr(src)+i
    '
    while i<ls
      if bs=0x27 and bs[2]=0 '39
        'excise BASIC line comment
        bc=i : bj=j
        gosub skipline16
        gosub MakeCommentRecord
        continue while
      elseif bs=0x2f and bs[2]=0 '47
        if bs[3]=0x2f and bs[4]=0
          'excise line ' // comments
          bc=i : bj=j
          gosub skipline16
          gosub MakeCommentRecord
          continue while
        elseif bs[3]=0x2a and bs[4]=0 '42
          'c-style / *..* / comment
          'mo=0  remove content except cr
          bc=i : bj=j
          while i<ls
            if bs=0x2a and bs[3]=0x2f '42 47 * /
              if bs[2]=0 and bs[4]=0
                gosub skipchar16
                gosub skipchar16
                exit while
              endif
            endif
            if mo=0
              'lines
              if (bs=13)and(bs[1]=0)
                gosub nextchar16
                continue while
              endif
              if (bs=10)and(bs[1]=0)
                gosub nextchar16
                continue while
              endif
            endif
            gosub skipchar16
          wend
          gosub MakeCommentRecord
          continue while
        endif
      elseif bs=0x22 'quotes
        xt=0
        while i<ls
          gosub nextchar16
          if xt
            exit while
          endif
          if bs=0x22
            xt=1
          endif
        wend
        continue while
      elseif bs=0x6c or bs=0x4c 'L string literals
        if (bs[2]=0) and (bs[3]=0x22) and (bs[4]=0)
          bj=j
          bg[1]=0x6c : bg[2]=0x22 ' l"
          @bs+=4 : @bg+=2 : i+=4 : j+=2
          while i<ls 'utf-16 string literal
            gosub nextchar8 'copy first byte
            if (bs[0]=0x22) and (bs=0) 'prev
              @bs++ : i++
              exit while
            else
              gosub nextchar8 'copy second byte
            endif
          wend
          gosub StoreString
          continue while
        endif
      endif
      if bs[2]<>0
        'encode unicode char
        bg=utfc : @bg++ : j++
        gosub encodehex
        gosub encodehex
      else
        gosub nextchar16
      endif
    wend
  else 'assume UTF-8 / ANSI
  =========================
    while i<ls
      if bs=0x27 '39
        sk=1
      elseif bs=0x2f '47 /
        if bs[2]=0x2f
          sk=1
        elseif bs[2]=0x2a '42 *
          sk=2
        endif
      elseif bs=0x22 ' 34 "
        while i<ls
          gosub nextchar8
          if bs=0x22 ' 34
            exit while
          endif
        wend
        'quote
      elseif bs=0x6c or bs=0x4c 'L
        if bs[2]=0x22 'QUOTE "
          bg=0x6c : bg[2]=0x22
          bj=j
          @bg+=2 : @bs+=2 : i+=2 : j+=2
          while i<ls 'wide string literal
            gosub nextchar8
            if bs[0]=0x22
              exit while
            endif
            bg=0 'append null
            'little endian
            'itr utf-8 to utf-16 conversion?
            @bg++ : j++ 'insert second byte null
          wend
          gosub StoreString
          continue while 'main
        endif ' L quote
      elseif bs>=0xc0 'potential UTF-8
        'part of unicode char
        'encoding symbols
        bg=utfb : @bg++ : j++
        gosub encodehex
      endif
      'SKIP
      if sk=1
        while i<ls
          if bs=13 or bs=10
            exit while
          endif
          gosub nextchar8
        wend
        sk=0
        continue while
      elseif sk=2
        while i<ls
          if bs=0x2a and bs[2]=0x2f '42 47 * /
            gosub nextchar8
            gosub nextchar8
            exit while
          endif
          gosub nextchar8
        wend
        sk=0
        continue while
      endif
      gosub nextchar8
    wend
  endif 'UTF-16 / UTF-8
  src=left(dst,j)
end procedure 'ConvertUTF


function ConvertInput(sys p) as string
======================================
  string src
  int w=omo and 3
  int b=omo and 8
  if b
    src=(bstring) p
  else 'chars
    if w=2
      src=(wchar*) p
    else
      src=(char*) p
    endif
  endif
  ConvertUTF(src)
  return src
end function 'ConvertInput


  function ConvertToUnicode(string*src, int n)
  ============================================
  'for error messages etc   
  'converts ansi with encoded symbols to unicode
  'itr string literals
  'utf-8  n=1
  'utf-16 n=2
  '
  int le=len(src)
  string dst=nuls(le*n)
  string w1
  byte bs at strptr(src)
  byte bd at strptr(dst)
  int a,b,i,j,m,v
  indexbase 1
  i=1
  jmp fwd begin
  '
  subroutine convertu
  'hex conversion
  b=bs-48
  if b>9 then b-=7
  a=b<<4
  @bs++ : i++
  b=bs-48
  if b>9 then b-=7
  a+=b
  @bs++ : i++
  bd=a : @bd++ : j++
  end subroutine
  '
  begin:
  '
  while i<le
    a=bs
    if a=utfb
      @bs++ : i++
      gosub convertu 'decode byte
    elseif a=utfc
      @bs++ : i++
      gosub convertu 'decode lower byte
      gosub convertu 'decode upper byte
    elseif a=34
      'itr iqq-1
      if bs[2]=iqq 'refstring utft
        m=i
        i++
        v=val yword(src,i)
        i+=2 'skip right quote mark
        m=cv4(utfs,v) 'length
        v+=4 'start of string quote
        w1=qu+mid(utfs,v,m)+qu
        'insert string w1 into dst
        dst=left(dst,m-1)+w1+mid(dst,i)
        'remap dst
        @bd=strptr(dst)+m-1
      else
        bd=bs : @bs++ : i++ : @bd+=n : j+=n
      endif
    else
      bd=bs : @bs++ : i++ : @bd+=n : j+=n
      'if n=2 then upper byte is left as null
    endif
  wend
  src=left(dst,j)
  end function 'ConvertToUnicode


function ConvertOutput(string*s) as sys
=======================================
  int w=omo and 3
  int b=omo and 8
  static  string sa
  static wstring sw
  ConvertToUnicode s, 1+utf16
 if w=2
    'insert BOM (little endian)
    sw=wchr(0xfeff)+s
    return strptr sw
  else
    sa=s
    return strptr sa
  endif
end function 'ConvertOutput
