PureBoard

Code: Alles auswählen

Procedure c_str1(txt.s)
  Protected *c = AllocateMemory(StringByteLength(txt, #PB_UTF8)+1)
  Debug "Memory: " + Str(MemorySize(*c))
  PokeS(*c, txt, -1, #PB_UTF8)
  ProcedureReturn *c
EndProcedure

Procedure c_str2(txt.s)
  Protected *c = AllocateMemory(MemoryStringLength(@txt,#PB_UTF8))
  Debug "Memory: " + Str(MemorySize(*c)) 
  PokeS(*c, txt, -1, #PB_UTF8)
  ProcedureReturn *c
EndProcedure

Procedure c_str3(txt.s)
  Protected *c = AllocateMemory(MemoryStringLength(@txt))
  Debug "Memory: " + Str(MemorySize(*c)) 
  PokeS(*c, txt, -1, #PB_UTF8)
  ProcedureReturn *c
EndProcedure

Debug c_str1("Hallöchen") ;11 Byte (korrekt!)

Debug c_str2("Hallöchen") ;Warum ist der Speicher hier 1 Byte?

Debug c_str3("Hallöchen") ;18 Bytes wären schön, aber falschen Befehl benutzt :(

Code: Alles auswählen

text.s = "0123456789"
a = MemoryStringLength(@text)
b = StringByteLength(text)
Debug "Anzahl Zeichen: "  + a
Debug "Anzahl Bytes: " + b 

Code: Alles auswählen

MemoryStringLength(@text,#PB_UTF8)

Code: Alles auswählen

Procedure fl_utf8decode(*p, *pEnd, *len)
  Protected.a c = PeekA(*p)
  
  If (c < $80)
    If (*len) 
      PokeI(*len, 1)
    EndIf
    ProcedureReturn c
  ElseIf (c < $c2)
    Goto FAIL
  EndIf
  If (*pEnd And *p + 1 >= *pEnd) Or ((PeekA(*p + 1) & $c0) <> $80) 
    Goto FAIL
  EndIf
  If (c < $e0)
    If (*len)
      PokeI(*len, 2)
    EndIf
    ProcedureReturn ((PeekA(*p) & $1f) << 6) + (PeekA(*p + 1) & $3f)
  ElseIf(c = $e0)
    If (PeekA(*p + 1) < $a0) 
      Goto FAIL
    EndIf
    Goto UTF8_3
  ElseIf(c < $f0)
    UTF8_3:
    If (*pEnd And *p + 2 >= *pEnd) Or ((PeekA(*p + 2) & $c0) <> $80) 
      Goto FAIL
    EndIf
    If (*len) 
      PokeI(*len, 3)
    EndIf
    ProcedureReturn ((PeekA(*p) & $0f) << 12) + ((PeekA(*p + 1) & $3f) << 6) + (PeekA(*p + 2) & $3f)
  ElseIf(c = $f0)
    If(PeekB(*p + 1)  < $90) 
      Goto FAIL
    EndIf
    Goto UTF8_4
  ElseIf(c < $f4)
    UTF8_4:
    If (*pEnd And *p + 3 >= *pEnd) Or ((PeekA(*p + 2) & $c0) <> $80) Or ((PeekA(*p + 3) & $c0) <> $80) 
      Goto FAIL
    EndIf
    If (*len)
      PokeI(*len, 4)
    EndIf
    ProcedureReturn ((PeekA(*p) & $07) << 18) + ((PeekA(*p + 1) & $3f) << 12) + ((PeekA(*p + 2) & $3f) << 6) + (PeekA(*p + 3) & $3f)
  ElseIf (c = $f4)
    If (PeekA(*p + 1) > $8f) 
      Goto FAIL; /* after 0x10ffff */
    EndIf
    Goto UTF8_4                                     ;
  Else
    FAIL:
    If (*len) 
      PokeI(*len, 1)
    EndIf
  EndIf
EndProcedure

Procedure fl_utf8test(*src, srclen.i)
  Protected.i ret = 1
  Protected *p = *src
  Protected *e = *src + srclen
  Protected.i len

  While (*p < *e)
    If(PeekA(*p) & $80) ;Das gefundene Zeichen ist größer oder gleich 128
      fl_utf8decode(*p, *e, @len)
      If (len < 2) 
        ProcedureReturn 0
      EndIf
      If (len > ret) 
        ret = len
      EndIf
      *p + len
    Else
      *p + 1
    EndIf
  Wend
  ProcedureReturn ret
EndProcedure

Debug fl_utf8test(UTF8("Hallöchen"), Len("Hallöchen"))

; Examines the first srclen bytes in src And returns a verdict on whether it is UTF-8 Or Not.
; 
; Returns 0 If there is any illegal UTF-8 sequences, using the same rules As fl_utf8decode(). Note that some UCS values considered illegal by RFC 3629, such As 0xffff, are considered legal by this.
; Returns 1 If there are only single-byte characters (ie no bytes have the high bit set). This is legal UTF-8, but also indicates plain ASCII. It also returns 1 If srclen is zero.
; Returns 2 If there are only characters less than 0x800.
; Returns 3 If there are only characters less than 0x10000.
; Returns 4 If there are characters in the 0x10000 To 0x10ffff range.
; Because there are many illegal sequences in UTF-8, it is almost impossible For a string in another encoding To be confused With UTF-8. This is very useful For transitioning Unix To UTF-8 filenames, you can simply test each filename With this To decide If it is UTF-8 Or in the locale encoding. My hope is that If this is done we will be able To cleanly transition To a locale-less encoding.