'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
  =====================
  'char16 to char8
  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
  '
  subroutine endofline8
  =====================
  if bs=13 'supports cr-only
    bg=13 : @bg++ : @bs++ : i++
    if bs=10
      @bs++ : i++
    endif
    bg=10 : @bg++ j+=2
  elseif bs=10 'supports lf-only
    bg=13 : @bg++
    bg=10 : @bg++
    @bs++ : i++ : j+=2
  endif
  end subroutine
  '
  subroutine endofline16
  ======================
  if bs=13 'supports cr-only
    bg=13 : @bg++ : @bs+=2 : i+=2
    if bs=10 and bs[2]=0
      @bs+=2 : i+=2
    endif
    bg=10 : @bg++ : j+=2
  elseif bs=10 'supports lf-only
    bg=13 : @bg++
    bg=10 : @bg++
    @bs+=2 : i+=2 : j+=2
  endif
  end subroutine

  begin:
  ======
  '
  indexbase 1
  utf16=0
  gbc+=len(src)
  '
  'UTF-8: 0xEF 0xBB,0xBF
  if (bs=0xef) and (bs[2]=0xbb)  and (bs[3]=0xbf)
    stt=3 
  'UTF-16 little endian 
  elseif (bs=0xff) and (bs[2]=0xfe)
    utf16=1 : omo or=2
    bomr=0 'little endian
    stt=2
  'UTF-16 big endian
  elseif (bs=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
        bs=bt
        @bs+=2
        i+=2
      wend
      i=stt
    endif
    @bs=strptr(src)+i
    '
    while i<ls
      if bs=13 and bs[2]=0 'supports cr-only
        gosub endofline16
        continue while
      elseif bs=10 and bs[2]=0 'supports lf-only
        gosub endofline16
        continue while
      elseif bs=0x27 and bs[2]=0 '39
        'excise BASIC line comment
        bc=i : bj=j
        while bs>13
          gosub nextchar16 'retain
        wend
        '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[2]=0
              if bs=13
                gosub endofline16
                continue while
              elseif bs=10
                gosub endofline16
                continue while
              endif
            endif
            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
            gosub skipchar16
          wend
          gosub MakeCommentRecord
          continue while
        endif
      elseif bs=0x22 and bs[2]=0 'quotes
        gosub nextchar16
        while i<ls
          if bs=0x22
            if bs[2]=0
              gosub nextchar16
              exit while
            endif
          endif
          gosub nextchar16
        wend
        continue while
      elseif bs=0x6c or bs=0x4c 'L wide string literals
        if (bs[2]=0) and (bs[3]=0x22) and (bs[4]=0)
          bj=j
          bg=0x6c : bg[2]=0x22 ' long/wide 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=13 or bs=10
        gosub endofline8
        continue while
      elseif bs=0x27 '39
        sk=3
      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 'prev
              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
          @bs++ : i++ 'skip
        wend
        sk=0
        continue while
      elseif sk=2
        while i<ls
          if bs=0x2a and bs[2]=0x2f '42 47 * /
            @bs+=2 : i+=2 'skip
            exit while
          endif
          if bs=13 or bs=10
            gosub endofline8
          else
            @bs+=8 : i++
          endif
        wend
        sk=0
        continue while
      elseif sk=3
        while i<ls
          if bs=13 or bs=10
            exit while
          endif
          nextchar8 'retain comment
        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
