/pliant/util/encoding/utf8.pli
 
 1  module "/pliant/install/ring2.pli" 
 2  module "/pliant/language/type/text/str32.pli" 
 3   
 4   
 5  function utf8_encode clear -> encoded 
 6    arg Str32 clear ; arg Str encoded  
 7    var Int length := 0 
 8    for (var Int i) clear:len-1 
 9      var Int := clear:i:number 
 10      if c<2^7 
 11        length += 1 
 12      eif c<2^11 
 13        length += 2 
 14      eif c<2^16 
 15        length += 3 
 16      eif c<2^21 
 17        length += 4 
 18    encoded set (memory_allocate length addressof:encoded) length true 
 19    var Address ptr := encoded characters 
 20    for (var Int i) clear:len-1 
 21      var Int := clear:i:number 
 22      if c<2^7 
 23        ptr map uInt8 := c ; ptr := ptr translate Byte 1 
 24      eif c<2^11 
 25        ptr map uInt8 := 0C0h+c\2^6 ; ptr := ptr translate Byte 1 
 26        ptr map uInt8 := 080h+(.and. 3Fh) ; ptr := ptr translate Byte 1 
 27      eif c<2^16 
 28        ptr map uInt8 := 0E0h+c\2^12 ; ptr := ptr translate Byte 1 
 29        ptr map uInt8 := 080h+(c\2^.and. 3Fh) ; ptr := ptr translate Byte 1 
 30        ptr map uInt8 := 080h+(.and. 3Fh) ; ptr := ptr translate Byte 1 
 31      eif c<2^21 
 32        ptr map uInt8 := 0F0h+c\2^18 ; ptr := ptr translate Byte 1 
 33        ptr map uInt8 := 080h+(c\2^12 .and. 3Fh) ; ptr := ptr translate Byte 1 
 34        ptr map uInt8 := 080h+(c\2^.and. 3Fh) ; ptr := ptr translate Byte 1 
 35        ptr map uInt8 := 080h+(.and. 3Fh) ; ptr := ptr translate Byte 1 
 36   
 37   
 38  function utf8_length8 c -> l 
 39    arg Int l 
 40    if c<80h 
 41      := 1 
 42    eif c<0C0h 
 43      := undefined 
 44    eif c<0E0h 
 45      := 2 
 46    eif c<0F0h 
 47      := 3 
 48    eif c<0F8h 
 49      := 4 
 50    else 
 51      := undefined 
 52   
 53  function utf8_length encoded -> length 
 54    arg Str encoded ; arg Int length 
 55    length := 0 
 56    var Address src := encoded characters ; var Int remain := encoded len 
 57    while remain>0 
 58      var Int := utf8_length8 (src map uInt8) 
 59      if l=undefined 
 60        := 1 
 61      eif l<=remain 
 62        length += 1 
 63      src := src translate uInt8 l ; remain -= l 
 64   
 65   
 66  function utf8_check encoded -> status 
 67    arg Str encoded ; arg Status status 
 68    var Address ptr := encoded characters ; var Int remain := encoded len 
 69    while remain>0 
 70      var Int := utf8_length8 (ptr map uInt8) 
 71      if l=undefined or l>remain 
 72        return failure 
 73      for (var Int i) l-1 
 74        if (((ptr translate uInt8 i) map uInt8) .and. 0C0h)<>80h 
 75          return failure 
 76      ptr := ptr translate uInt8 l ; remain -= l 
 77    status := success 
 78   
 79   
 80  function utf8_decode encoded -> clear 
 81    arg Str encoded ; arg Str32 clear 
 82    var Int length := utf8_length encoded 
 83    clear set (memory_allocate length*Char32:size addressof:clear) length true 
 84    var Address src := encoded characters ; var Int remain := encoded len 
 85    var Address dest := clear characters 
 86    while remain>0 
 87      var Int := src map uInt8 
 88      var Int := utf8_length8 c 
 89      if l=1 
 90        dest map Int32 := .and. 7Fh ; dest := dest translate Int32 1 
 91      eif l=undefined 
 92        := 1 
 93      eif l<=remain 
 94        := .and. 07Fh\2^l 
 95        for (var Int i) l-1 
 96          := c*2^6+(((src translate uInt8 i) map uInt8) .and. 3Fh) 
 97        dest map Int32 := c ; dest := dest translate Int32 1 
 98      src := src translate uInt8 l ; remain -= l 
 99    check dest=(clear:characters translate Char32 length) 
 100   
 101   
 102  export utf8_encode utf8_decode 
 103  export utf8_length utf8_check