Возник вопрос печати текста в консоли:
Не проблема, в PureBasic написал код, символы взял из таблицы CP8666 . Для FreePascal оказалось все сложнее и пришлось переводить символы в UTF-8. Поэтому пришлось вернуться к перекодировке Unicode->UTF-8. Пошарил по страницам и написал код, проверил - работает. Занялся обратным преобразованием UTF-8->Unicode и нашел упоминание о другой длине байтов - не 4, как написано в документации, а 5 или 6. И на этой длине я залип - нет подходящих данных для перекодировки, некоторые значения отличаются друг от друга. Поискал примеры и плюнул на решение задачи, добавив к своей программе дополнительную опцию - вывод сочетания UTF-8.
Осталось ждать появления проблемных символов.
Unicode->UTF-8
Procedure.s h2s(a.a)
ProcedureReturn RSet(Hex(a),2,"0")+" "
EndProcedure
Procedure.s un2u8(c)
r$=""
; 1st byte 2nd byte 3rd byte 4th byte code points
; 0xxxxxxx 0-127 xxxxxxx 7 bits
; 110xxxxx 10xxxxxx 128-2047 yyyyyxxxxxx 11bits
; 1110xxxx 10xxxxxx 10xxxxxx 2048-65535 zzzzyyyyyyxxxxxx 16 bits
; 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx 00010000 – 001FFFFF 21 bits
; 111110xx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx $200000 – $3FFFFFF 26 bits
; 1111110x 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 04000000 – 7FFFFFFF 21 bits
If c<128
r$=h2s(c)
ElseIf c<2048
r$=h2s( $C0+(c>>6)&$1F ) + h2s( $80+(c&$3F))
ElseIf c<65536
r$=h2s($E0+((c>>12)&$0F)) + h2s($80+((c>>6)&$3F)) + h2s($80+(c&$3F))
ElseIf c<=$1FFFFF
r$=h2s($F0+((c>>18)&7)) + h2s($80+((c>>12)&$3F)) + h2s($80+((c>>6)&$3F)) + h2s($80+(c&$3F))
ElseIf c<=$3FFFFFF;111110xx must be wrong
r$=h2s($F8 | (c >> 24))
r$=r$+h2s($80 | ((c >> 18) & $3F))
r$=r$+h2s($80 | ((c >> 12) & $3F))
r$=r$+h2s($80 | ((c >> 6) & $3F))
r$=r$+h2s($80 | (c & $3F))
ElseIf c<=$7FFFFFFF
r$=h2s($FC | ((c >> 30) & 1))
r$=r$+h2s($80 | ((c >> 24) & $3F))
r$=r$+h2s($80 | ((c >> 18) & $3F))
r$=r$+h2s($80 | ((c >> 12) & $3F))
r$=r$+h2s($80 | ((c >> 6) & $3F))
r$=r$+h2s($80 | (c & $3F))
EndIf
Debug Hex(c)+" "+r$
ProcedureReturn r$
EndProcedure
un2u8($10FFFF);F4 8F BF BF
un2u8(65536);0xF0 0x90 0x80 0x80
un2u8($1F4A2);0xF0 0x9F 0x92 0xA2
un2u8($2564);╤ 0xE2 0x95 0xA4
un2u8(2047);2047=0xDF 0xBF
un2u8($401);Ё d0 81
un2u8($30c4);0xE3 0x83 0x84
un2u8($11170);0xF0 0x91 0x85 0xB0
un2u8($FA00);0xEF 0xA8 0x80
un2u8($200000);F8 88 80 80 80
un2u8($3FFFFFF);FB BF BF BF BF
un2u8($7FFFFFFF); FD BF BF BF BF BF
ProcedureReturn RSet(Hex(a),2,"0")+" "
EndProcedure
Procedure.s un2u8(c)
r$=""
; 1st byte 2nd byte 3rd byte 4th byte code points
; 0xxxxxxx 0-127 xxxxxxx 7 bits
; 110xxxxx 10xxxxxx 128-2047 yyyyyxxxxxx 11bits
; 1110xxxx 10xxxxxx 10xxxxxx 2048-65535 zzzzyyyyyyxxxxxx 16 bits
; 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx 00010000 – 001FFFFF 21 bits
; 111110xx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx $200000 – $3FFFFFF 26 bits
; 1111110x 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 04000000 – 7FFFFFFF 21 bits
If c<128
r$=h2s(c)
ElseIf c<2048
r$=h2s( $C0+(c>>6)&$1F ) + h2s( $80+(c&$3F))
ElseIf c<65536
r$=h2s($E0+((c>>12)&$0F)) + h2s($80+((c>>6)&$3F)) + h2s($80+(c&$3F))
ElseIf c<=$1FFFFF
r$=h2s($F0+((c>>18)&7)) + h2s($80+((c>>12)&$3F)) + h2s($80+((c>>6)&$3F)) + h2s($80+(c&$3F))
ElseIf c<=$3FFFFFF;111110xx must be wrong
r$=h2s($F8 | (c >> 24))
r$=r$+h2s($80 | ((c >> 18) & $3F))
r$=r$+h2s($80 | ((c >> 12) & $3F))
r$=r$+h2s($80 | ((c >> 6) & $3F))
r$=r$+h2s($80 | (c & $3F))
ElseIf c<=$7FFFFFFF
r$=h2s($FC | ((c >> 30) & 1))
r$=r$+h2s($80 | ((c >> 24) & $3F))
r$=r$+h2s($80 | ((c >> 18) & $3F))
r$=r$+h2s($80 | ((c >> 12) & $3F))
r$=r$+h2s($80 | ((c >> 6) & $3F))
r$=r$+h2s($80 | (c & $3F))
EndIf
Debug Hex(c)+" "+r$
ProcedureReturn r$
EndProcedure
un2u8($10FFFF);F4 8F BF BF
un2u8(65536);0xF0 0x90 0x80 0x80
un2u8($1F4A2);0xF0 0x9F 0x92 0xA2
un2u8($2564);╤ 0xE2 0x95 0xA4
un2u8(2047);2047=0xDF 0xBF
un2u8($401);Ё d0 81
un2u8($30c4);0xE3 0x83 0x84
un2u8($11170);0xF0 0x91 0x85 0xB0
un2u8($FA00);0xEF 0xA8 0x80
un2u8($200000);F8 88 80 80 80
un2u8($3FFFFFF);FB BF BF BF BF
un2u8($7FFFFFFF); FD BF BF BF BF BF
UTF-8->Unicode
; 1st byte 2nd byte 3rd byte 4th byte code points
; 0xxxxxxx 0-127 xxxxxxx
; 110yyyyy 10xxxxxx 128-2047 yyyyyxxxxxx
; 1110zzzz 10yyyyyy 10xxxxxx 2048-65535 zzzzyyyyyyxxxxxx
; 11110www 10zzzzzz 10yyyyyy 10xxxxxx 65536+ wwwzzzzzzyyyyyyxxxxxx
; 534210FEDCBA976543210 if ( (c & 0x80) == 0 )
Procedure unic(c.s)
c0=Asc(Mid(c,1,1))
c1=Asc(Mid(c,2,1))
c2=Asc(Mid(c,3,1))
c3=Asc(Mid(c,4,1))
c4=Asc(Mid(c,5,1))
c5=Asc(Mid(c,6,1))
If c0 & $80 = 0
wc=c0
ElseIf c0 & $E0=$C0
wc = (c0 & $1F) << 6;
wc =wc|(c1 & $3F)
ElseIf c0 & $F0 = $E0
wc = (c0 & $0F) << 12;
wc =wc|(c1 & $3F) << 6
wc =wc|(c2 & $3F);
ElseIf c0 & $F8 = $F0
wc = (c0 & 07) << 18;
wc =wc|(c1 & $3F) << 12;
wc =wc|(c2 & $3F) << 6
wc =wc|(c3 & $3F)
ElseIf (c0 & $FC) = $F8
wc = (c0 &3) << 24
wc =wc|(c1&$3F) << 18
wc =wc|(c2&$3F) << 12
wc =wc|(c3&$3F) << 6
wc =wc|(c4&$3F)
ElseIf c0 & $FE= $FC
wc = (c0&1) << 30
wc =wc|(c1&$3F) << 24
wc =wc|(c2&$3F) << 18
wc =wc|(c3&$3F) << 12
wc =wc|(c4&$3F) << 6
wc =wc|(C5&$3F)
EndIf
ProcedureReturn wc
EndProcedure
;Debug Hex(unic(Chr($41)),#PB_Long)
;Debug Hex(unic(Chr($c3)+Chr($b6)),#PB_Long);F6
;Debug Hex(unic(Chr($E2)+Chr($82)+Chr($AC)),#PB_Long);20ac
;Debug Hex(unic(Chr($F0)+Chr($9D)+Chr($84)+Chr($9E)),#PB_Long);1D11E
;https://wiki.tcl-lang.org/page/Encoding+Translations+and+i18n
;Debug Hex(unic(Chr($FD)+Chr($BF)+Chr($BF)+Chr($BF)+Chr($BF)+Chr($BF)),#PB_Long); must be 7FFFFFFF
;Debug Hex(unic(Chr($FB)+Chr($BF)+Chr($BF)+Chr($BF)+Chr($BF)),#PB_Long); must be 3FFFFFFF
;Debug Hex(unic(Chr($F7)+Chr($BF)+Chr($BF)+Chr($BF)),#PB_Long); must be 1FFFFFFF
Комментарии
Отправить комментарий