Forth и другие саморасширяющиеся системы программирования Locations of visitors to this page
Текущее время: Пт апр 19, 2024 19:19

...
Google Search
Forth-FAQ Spy Grafic

Часовой пояс: UTC + 3 часа [ Летнее время ]




Начать новую тему Ответить на тему  [ Сообщений: 3 ] 
Автор Сообщение
 Заголовок сообщения: кодирование-раскодирования utf символов.
СообщениеДобавлено: Вс окт 07, 2007 18:14 
Не в сети
Moderator
Moderator
Аватара пользователя

Зарегистрирован: Чт май 04, 2006 00:53
Сообщения: 5062
Откуда: был Крым, теперь Новосибирск
Благодарил (а): 23 раз.
Поблагодарили: 63 раз.
тут набросок либы для работы с unicode utf8 символами

<pre>
\ 07-10-2007 ~mOleg
\ Copyright [C] 2007 mOleg mininoleg@yahoo.com
\ работа с utf8: диапазон символов 0 -- 0x7FFFFFFF

REQUIRE B@ devel\~mOleg\lib\util\bytes.f \ чтобы не путаться с C@

CREATE utf8cnt \ табличка для определения длины символа в utf8 кодировке
0x01 B, 0x01 B, 0x01 B, 0x01 B, 0x01 B, 0x01 B, 0x01 B, 0x01 B,
0x01 B, 0x01 B, 0x01 B, 0x01 B, 0x01 B, 0x01 B, 0x01 B, 0x01 B,
0x01 B, 0x01 B, 0x01 B, 0x01 B, 0x01 B, 0x01 B, 0x01 B, 0x01 B,
0x01 B, 0x01 B, 0x01 B, 0x01 B, 0x01 B, 0x01 B, 0x01 B, 0x01 B,
0x01 B, 0x01 B, 0x01 B, 0x01 B, 0x01 B, 0x01 B, 0x01 B, 0x01 B,
0x01 B, 0x01 B, 0x01 B, 0x01 B, 0x01 B, 0x01 B, 0x01 B, 0x01 B,
0x02 B, 0x02 B, 0x02 B, 0x02 B, 0x02 B, 0x02 B, 0x02 B, 0x02 B,
0x03 B, 0x03 B, 0x03 B, 0x03 B, 0x04 B, 0x04 B, 0x05 B, 0x06 B,

\ определить длину символа.
\ на входе адрес, где символ лежит, на выходе его длина
: CHAR# ( 'char --> # ) B@ 2 RSHIFT [ utf8cnt ] LITERAL + B@ ;

CREATE utf8hdr \ маска для выделения данных из первого байта
0x7F B, 0x3F B, 0x1F B, 0x0F B, 0x07 B, 0x03 B, 0x01 B,

\ извлечь символ из указанной позиции.
\ на входе адрес, по которому хранится символ, на выходе его 32 битное значение
: CHAR@ ( 'char --> char )
DUP B@ DUP 0x80 < IF NIP EXIT THEN
OVER CHAR# [ utf8hdr ] LITERAL + B@ AND
BEGIN SWAP 1 + TUCK
B@ DUP 0xC0 AND 0x80 = WHILE
0x3F AND SWAP 6 LSHIFT OR
REPEAT DROP NIP ;

CREATE utf8hhh \ маска для сохранения счетчика в первом байте
0x00 B, 0x00 B, 0xC0 B, 0xE0 B, 0xF0 B, 0xF8 B, 0xFC B,

\ преобразовать длинный символ в последовательность utf8 байт.
\ на стеке байты лежат в обратном порядке.
: charr ( char --> [ 1 .. n ] )
0 BEGIN OVER WHILE
OVER 0x3F AND 0x80 OR
ROT 6 RSHIFT
ROT 1 +
REPEAT NIP
[ utf8hhh ] LITERAL + B@ OR ;

\ сохранить символ char в utf8 кодировке по указанному адресу.
: CHAR! ( char addr --> )
OVER 0x80 U< IF C! EXIT THEN
>R 0 SWAP charr
R> BEGIN OVER WHILE
TUCK B! 1 +
REPEAT 2DROP ;

\ компилировать utf8 символ на вершину кодфайла
: CHAR, ( char --> ) HERE TUCK CHAR! CHAR# ALLOT ;

\ является ли текст utf8 кодированным.
\ на входе адрес начала текста.
: ?utf8 ( addr --> flag ) @ 0xFFFFFF AND 0xBFBBEF = ;

\ является ли символ utf8 символом длиной от двух до шести байт
\ адрес должен указывать на начало символа
: ?utf8char ( addr --> flag )
DUP B@ 0xE0 OVER AND 0xC0 = SWAP
0xF0 OVER AND 0xE0 = SWAP
0xF8 OVER AND 0xF0 = SWAP
0xFC OVER AND 0xF8 = SWAP
0xFE AND 0xFC = OR OR OR OR
SWAP 1+ B@ 0xC0 AND 0x80 = AND ;

\ содержит ли фрагмент текста utf8 символ(ы)
: isUTF8 ( asc # --> flag )
OVER ?utf8 IF 2DROP TRUE EXIT THEN \ ?сигнатура
OVER + SWAP
BEGIN 2DUP <> WHILE \ ищем начало символа
DUP B@ DUP 0x7F < SWAP 0xC0 AND 0x80 = OR WHILE
1 +
REPEAT NIP ?utf8char EXIT
THEN 2DROP FALSE ;
</pre>


Последний раз редактировалось mOleg Ср окт 10, 2007 02:09, всего редактировалось 1 раз.

Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Вс окт 07, 2007 18:20 
---


Последний раз редактировалось profiT Сб мар 01, 2008 00:22, всего редактировалось 1 раз.

Вернуться к началу
  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Ср окт 10, 2007 02:53 
Не в сети
Moderator
Moderator
Аватара пользователя

Зарегистрирован: Чт май 04, 2006 00:53
Сообщения: 5062
Откуда: был Крым, теперь Новосибирск
Благодарил (а): 23 раз.
Поблагодарили: 63 раз.
то же для utf16
<pre>
\ 08-10-2007 ~mOleg
\ Copyright [C] 2007 mOleg mininoleg@yahoo.com
\ работа с utf16 : диапазон от 0 до 0xD800 и от 0xDFFF до 0x10FFFF.

REQUIRE ?DEFINED devel\~moleg\lib\util\ifdef.f

?DEFINED IS : IS POSTPONE TO ; IMMEDIATE

\ ------------------------------------------------------------------------------

\ поменять местами два байта слова
: BSWAP ( W[B|L] --> W[L|B] ) DUP 8 LSHIFT SWAP 8 RSHIFT OR 0xFFFF AND ;

\ прочесть, сохранить двухбайтовое значение с обратным порядком следования байт
\ от принятого на данной архитектуре
: W@' ( addr --> w ) W@ BSWAP ;
: W!' ( w addr --> ) >R BSWAP R> W! ;

\ прочитать пару байт, начинающихся с указанного адреса
\ так как порядок байт зависит от архитектуры и от потока
\ в переменную записывается то(либо) W@ либо W@ BSWAP
USER-VECT WN@ ( addr --> W )
USER-VECT WN! ( w addr --> )
' W@ IS WN@
' W! IS WN!

\ определить размер символа
\ если двухбайтного символа находится в диапазоне 0xD800-0xDFFF
\ символ занимает 4 байта, иначе два.
: CHAR# ( addr --> # ) WN@ 0xDC00 AND 0xD800 = IF 4 ELSE 2 THEN ;

\ извлечь значение символа, хранящегося по указанному адерсу addr
: CHAR@ ( addr --> char )
DUP WN@ 0xD800 2DUP AND =
IF SWAP 2 + WN@
0x03FF AND 10 LSHIFT SWAP 0x03FF AND OR 0x10000 +
ELSE NIP
THEN ;

\ сохранить символ char по указанному адресу addr
\ символы в запрещенном диапазоне 0xD800 0xDFFF пишутся, как обычно
\ слово сохраняющее значение в код этой тонкости знать, мне кажется, не должно
: CHAR! ( char addr --> )
OVER 0xFFFF >
IF >R 0x10000 - DUP 10 RSHIFT \ l h
0x3FF AND 0xDC00 OR R@ 2 + WN!
0x3FF AND 0xD800 OR R> WN!
ELSE WN!
THEN ;

\ компилировать utf8 символ на вершину кодфайла
\ внимание, сначала пишем, затем защищаем с помощью ALLOT
: CHAR, ( char --> ) HERE TUCK CHAR! CHAR# ALLOT ;

\ является ли текст utf16 кодированным.
\ на входе адрес начала текста.
: ?utf16 ( addr --> flag ) W@ 0xFEFF OVER 0xFFFE = -ROT = OR ;

\ является ли символ по указанному адресу utf16 символом
\ наверняка можно опознать только длинный символ, или несколько
\ идущих подряд символов одинарной длины.
: ?utf16char ( addr --> flag )
DUP WN@ DUP 0xD800 0xDFFF WITHIN
IF SWAP 2 + WN@ AND 0xD800 AND 0xD800 =
ELSE 2DROP FALSE
THEN ;

\ содержит ли фрагмент текста utf8 символ(ы)
\ я предполагаю, что подразумевается, что текст в utf16 кодировке всегда
\ начинается с четного адреса, и любой символ всегда начинается с четного
\ адреса.
: isUTF16 ( asc # --> flag )
OVER ?utf16 IF 2DROP TRUE EXIT THEN
OVER ?utf16char IF 2DROP TRUE EXIT THEN
\ дальше предполагаем, что строка состоит хотя бы из трех символов,
\ находящихся в одной кодовой странице
6 < IF DROP FALSE EXIT THEN
DUP CHAR# OVER +
DUP CHAR# DUP 4 = IF DROP NIP ?utf16char EXIT THEN OVER +
DUP CHAR# 4 = IF NIP NIP ?utf16char EXIT THEN
WN@ 0xFF00 AND ROT WN@ 0xFF00 AND ROT WN@ 0xFF00 AND
OVER = >R = R> AND
;
</pre>


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
Показать сообщения за:  Поле сортировки  
Начать новую тему Ответить на тему  [ Сообщений: 3 ] 

Часовой пояс: UTC + 3 часа [ Летнее время ]


Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 15


Вы не можете начинать темы
Вы можете отвечать на сообщения
Вы не можете редактировать свои сообщения
Вы не можете удалять свои сообщения
Вы не можете добавлять вложения

cron
Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group
phpBB сборка от FladeX // Русская поддержка phpBB