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

...
Google Search
Forth-FAQ Spy Grafic

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




Начать новую тему Ответить на тему  [ Сообщений: 10 ] 
Автор Сообщение
 Заголовок сообщения: Преобразование текста в код Морзе и обратно
СообщениеДобавлено: Сб янв 05, 2008 22:42 
Не в сети
Аватара пользователя

Зарегистрирован: Вт мар 20, 2007 23:39
Сообщения: 1261
Благодарил (а): 3 раз.
Поблагодарили: 19 раз.
Преобразовать a u строку в текстовый код Морзе и обратно, все символы меньше 32 считать разделителями, неизвестные символы игнорировать, между буквами пробел как разделитель.
Код:
\ преобразовать строку с текстом в строку Морзе кода
: S>MORSE ( a u -- a1 u1 )
                  ;
\ преобразовать строку Морзе кода в строку с текстом
: MORSE>S ( a u -- a1 u1 )
                  ;

Например:

S" С новым годом!" S>MORSE TYPE
··· -· --- ·-- -·-- -- --· --- -·· --- -- --··-- Ok

S" ··· -· --- ·-- -·-- -- --· --- -·· --- -- --··--" MORSE>S TYPE
С новым годом! Ok

Вот такой тест для проверки:
Код:
S" йцукенгшщзхъфывапролджэячсмитьбюqwertyuiopasdfghjklzxcvbnmЙЦУКЕНГШЩЗХЪФЫВАПРОЛДЖЭЯЧСМИТЬБЮ.QWERTYUIOPASDFGHJKLZXCVBNM1234567890.,/&!@   #$%^&*()№;%:?{}[]   " S>MORSE TYPE


Код морзе здесь есть:
http://ru.wikipedia.org/wiki/Азбука_Морзе
Таблица кодов:
http://forth.pastebin.ca/842974

P.S. Извиняюсь за немного сумбурное выкладывание и изменения в ТЗ.

_________________
Cтоимость сопровождения программного обеспечения пропорциональна квадрату творческих способностей программиста.
Роберт Д. Блисc


Последний раз редактировалось VoidVolker Пн янв 07, 2008 02:46, всего редактировалось 6 раз(а).

Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Вс янв 06, 2008 00:05 
Не в сети
Administrator
Administrator
Аватара пользователя

Зарегистрирован: Вт май 02, 2006 13:19
Сообщения: 3565
Откуда: St.Petersburg
Благодарил (а): 4 раз.
Поблагодарили: 72 раз.
VoidVolker писал(а):
···-···--·---·---·-----···---·----··-------··-- Ok

что-то тут не Ok...
паузы между буквами никак не обозначены пробелы должны быть хотя бы, разделяющие буквы.

_________________
С уважением, WingLion
Forth-CPU . RuF09WE
Мой Форт
Отсутствие бана это не заслуга юзера, а недоработка модератора (с)


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Вс янв 06, 2008 05:20 
Не в сети
Moderator
Moderator
Аватара пользователя

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

_________________
Мне бы только мой крошечный вклад внести,
За короткую жизнь сплести
Хотя бы ниточку шёлка.
fleur


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Вс янв 06, 2008 12:27 
Не в сети
Аватара пользователя

Зарегистрирован: Вт мар 20, 2007 23:39
Сообщения: 1261
Благодарил (а): 3 раз.
Поблагодарили: 19 раз.
mOleg писал(а):
а как определять, в каком регистре\кодировке выводить текст? потому как морзянка для eEеEёЁ, например, совпадает (тут русские буквы, и английские)?

Думаю язык в морзянке определяется по контексту. А вот при обратном преобразовании как раз возникают сложности - какие символы использовать: кирилические или латинские. Предлагаю сделать по умолчанию преобразование кода Морзе в кирилические прописные символы.

_________________
Cтоимость сопровождения программного обеспечения пропорциональна квадрату творческих способностей программиста.
Роберт Д. Блисc


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Вс янв 06, 2008 22:00 
Не в сети
Moderator
Moderator
Аватара пользователя

Зарегистрирован: Чт май 04, 2006 00:53
Сообщения: 5062
Откуда: был Крым, теперь Новосибирск
Благодарил (а): 23 раз.
Поблагодарили: 63 раз.
преобразование в код Морзе:
(написано для форка http://fforum.winglion.ru/viewtopic.php?t=531 сборка 4.05-800)
Код:
\ 05-01-2008 ~mOleg
\ Сopyright [C] 2008 mOleg mininoleg@yahoo.com
\ задача с форума http://fforum.winglion.ru/index.php
\ http://fforum.winglion.ru/viewtopic.php?t=1102&sid=abba47452171c59c00c1fed810e08ebc
\ преобразование исходной текстовой строки в код Морзе

.\lib\add\ufl.f
.\lib\add\for-next.f
.\lib\add\buff.f

\ создаем таблицу на 256 символьных записей длиной в 8 байт
CREATE morze_tbl 256 8 * ALLOTERASE

\ найти место символа в таблице
: mchara ( char --> addr ) 8 * morze_tbl + ;

\ сохранить char в таблицу кодов
: char>m ( asc # char --> ) mchara 2DUP B! 1 + SWAP CMOVE ;

\ добавить символ в таблицу используя исходную запись
: char: ( / charasc --> ) NEXT-WORD OVER C@ >R 1 SKIPn R> char>m ;

ToAll char: a.- b-... w.-- g--. d-.. e. v...- z--.. j.--- k-.- l.-.. m-- I..
ToAll char: n-. o--- p.--. r.-. s... t- u..- f..-. i.. c-.-. q--.-  h.... E.
ToAll char: y-.-- A.- B-... W.-- G--. D-.. V...- Z--.. J.--- K-.- x-..- N-.
ToAll char: L.-.. M-- O--- P.--. R.-. S... T- U..- F..-. H.... C-.-. Q--.-
ToAll char: X-..- Y-.-- а.- б-... в.-- г--. д-.. е. ё. ж...- з--.. и.. й.---
ToAll char: к-.- л.-.. м-- н-. о--- п.--. р.-. с... т- у..- ф..-. х....
ToAll char: ц-.-. ч---. ш---- щ--.- ь-..- ы-.-- э..-.. ю..-- я.-.- А.- Б-...
ToAll char: В.-- Г--. Д-.. Е. Ё. Ж...- З--.. И.. Й.--- К-.- Л.-.. М-- Н-.
ToAll char: О--- П.--. Р.-. С... Т- У..- Ф..-. Х.... Ц-.-. Ч---. Ш---- Щ--.-
ToAll char: Ь-..- Ы-.-- Э..-.. Ю..-- Я.-.- 1.---- 2..--- 3...-- 4....-
ToAll char: 5..... 6-.... 7--... 8---.. 9----. 0----- ....... ,.-.-.- /-..-.
ToAll char: ?..--.. !--..-- @.--.-.

        USER-VALUE strbuf \ накопительный буфер

\ отправить содержимое строки в буфер, добавить пробел
: >buf ( asc # --> ) strbuf >Buffer DROP s"  " strbuf >Buffer DROP ;

\ создать накопительный буфер
: <buf ( # --> )
       strbuf IF strbuf Retire THEN
       Buffer TO strbuf ;

\ вернуть содержимое буфера
: buf> ( --> asc # ) strbuf Buffer> ;

\ преобразовать строку с текстом в строку Морзе кода
: S>MORZE ( asc # --> asc # )
          DUP 8 * <buf
          FOR DUP C@ mchara COUNT >buf 1 + TILL DROP
          buf> ;

\ пример использования
s" С.Новым.Годом" S>MORZE TYPE

_________________
Мне бы только мой крошечный вклад внести,
За короткую жизнь сплести
Хотя бы ниточку шёлка.
fleur


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Вс янв 06, 2008 22:18 
Не в сети
Moderator
Moderator
Аватара пользователя

Зарегистрирован: Чт май 04, 2006 00:53
Сообщения: 5062
Откуда: был Крым, теперь Новосибирск
Благодарил (а): 23 раз.
Поблагодарили: 63 раз.
обратное преобразование:
(написано для форка http://fforum.winglion.ru/viewtopic.php?t=531 сборка 4.05-800)
(в сборке заменить qcase.f на http://www.forth.org.ru/~mOleg/qcase.f )
Код:
\ 06-01-2008 ~mOleg
\ Сopyright [C] 2008 mOleg mininoleg@yahoo.com
\ задача с форума http://fforum.winglion.ru/index.php
\ http://fforum.winglion.ru/viewtopic.php?t=1102&sid=abba47452171c59c00c1fed810e08ebc
\ декодирование строки в коде Морзе

  .\lib\add\for-next.f
  .\lib\add\ufl.f
  .\lib\add\qcase.f

        CHAR" . CONSTANT dot  \ символ "точка"
        CHAR" - CONSTANT dash \ символ "тире"

        USER-VALUE root_  \ корень дерева указывает на пустой узел

        0 \ структура одного узла
          ADDR -- off_dot     \ левая ветка
          ADDR -- off_dash    \ правая ветка
          char -- off_symbol  \ символ текущего узла
          0x10 ROUND          \ округляем до круглого значения
        CONSTANT /leaf        \ размер элемента

\ создать узел в хипе
: entry ( --> addr ) /leaf ALLOCATE THROW ;

\ добавить новый узел, вернуть его адрес
: plus ( addr --> addr ) entry TUCK SWAP A! ;

\ выбрать левый или правый линк
: select ( 'leaf char --> 'leaf | 0 ) dot = IF off_dot ELSE off_dash THEN ;

\ вернуть адрес корня.
: root> ( --> addr ) root_ IFNOT entry DUP TO root_ ELSE root_ THEN ;

\ добавить символ в узел
: plusc ( char asc # --> )
        root> SWAP FOR OVER C@ select
                       DUP A@ IF A@ ELSE plus THEN
                       SWAP char + SWAP
                   TILL NIP
        off_symbol C! ;

\ найти символ по содержимому строки asc #
: readc ( asc # --> char|0 )
        root> SWAP FOR OVER C@ select A@
                       DUP IFNOT NIP RDROP EXIT THEN
                       SWAP char + SWAP
                   TILL NIP off_symbol C@ ;

\ добавить символ в таблицу используя исходную запись
: char: ( / charasc --> ) NEXT-WORD OVER C@ -ROT 1 SKIPn plusc ;

4 [CASE]
  1 [OF] \ для латиницы:
  ToAll char: a.- b-... w.-- g--. d-.. e. v...- z--.. i.. j.--- k-.- l.-..
  ToAll char: m-- n-. o--- p.--. r.-. s... t- u..- f..-. h.... c-.-. q--.-
  ToAll char: x-..- y-.-- 1.---- 2..--- 3...-- 4....- 5..... 6-.... 7--...
  ToAll char: 8---.. 9----. 0----- ....... ,.-.-.- /-..-. ?..--.. !--..--
        char: @.--.-.
      [ENDOF]
  2 [OF] \ для латиницы в верхнем регистре:
  ToAll char: A.- B-... W.-- G--. D-.. E. V...- Z--.. I.. J.--- K-.- L.-..
  ToAll char: M-- N-. O--- P.--. R.-. S... T- U..- F..-. H.... C-.-. Q--.-
  ToAll char: X-..- Y-.-- 1.---- 2..--- 3...-- 4....- 5..... 6-.... 7--...
  ToAll char: 8---.. 9----. 0----- ....... ,.-.-.- /-..-. ?..--.. !--..--
        char: @.--.-.
      [ENDOF]
  3 [OF] \ для кирилицы:
  ToAll char: а.- б-... в.-- г--. д-.. е. ж...- з--.. и.. й.--- к-.- л.-..
  ToAll char: м-- н-. о--- п.--. р.-. с... т- у..- ф..-. х.... ц-.-. ч---.
  ToAll char: ш---- щ--.- ь-..- ы-.-- э..-.. ю..-- я.-.- 1.---- 2..---
  ToAll char: 3...-- 4....- 5..... 6-.... 7--... 8---.. 9----. 0-----
  ToAll char: ....... ,.-.-.- /-..-. ?..--.. !--..-- @.--.-.
      [ENDOF]
  4 [OF] \ для кирилицы в верхнем регистре:
  ToAll char: А.- Б-... В.-- Г--. Д-.. Е. Ж...- З--.. И.. Й.--- К-.- Л.-..
  ToAll char: М-- Н-. О--- П.--. Р.-. С... Т- У..- Ф..-. Х.... Ц-.-. Ч---.
  ToAll char: Ш---- Щ--.- Ь-..- Ы-.-- Э..-.. Ю..-- Я.-.- 1.---- 2..---
  ToAll char: 3...-- 4....- 5..... 6-.... 7--... 8---.. 9----. 0-----
  ToAll char: ....... ,.-.-.- /-..-. ?..--.. !--..-- @.--.-.
      [ENDOF]
[ENDCASE]

\ преобразовать входной поток морзянки в текст asc #
: (morze) ( --> asc # )
          <| BEGIN NextWord DUP WHILE
                   readc DUP IFNOT DROP BL THEN KEEP \ вместо неопознанных BL
             REPEAT 2DROP
           |> ;

\ преобразовать строку Морзе кода в строку с текстом
: MORZE>S ( asc # -- asc # ) ['] (morze) EVALUATE-WITH ;

\ это пример использования
s" ... ...... -. --- .-- -.-- -- ...... --. --- -.. --- -- --..--" MORZE>S TYPE CR

_________________
Мне бы только мой крошечный вклад внести,
За короткую жизнь сплести
Хотя бы ниточку шёлка.
fleur


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

Зарегистрирован: Вт мар 20, 2007 23:39
Сообщения: 1261
Благодарил (а): 3 раз.
Поблагодарили: 19 раз.
Вот и мой вариант - для ннКрона:
(для проверки открыть консоль и запустить эту задачу)
Код:
#( Морзянка
NoActive
\ Автор:  VoidVolker
\ Дата:  07.01,2008  01:05
\ Описание:  Преобразование текста в код Морзе и обратно
\ Слова:
\ S>MORSE  ( a u -- a1 u1 ) -- Преобразует строку с текстом в код Морзе
\ MORSE>S  ( a u -- a1 u1 ) -- Преобразует код Морзе в текстовую строку, по умолчанию все буквы прописные
\ Прописные-буквы  ( -- )
\ Строчные-буквы  ( -- )

CREATE 'morse[] 1024 ALLOT
'morse[] 1024 ERASE
: Разделители!  ( ac -- )  \ Считать разделителем все символы меньше 32
  33 0 DO
  DUP  I CELL * 'morse[] + !
  LOOP DROP
;
   
C" -...- " Разделители!
C" .- " 388 'morse[] + !
C" -... " 392 'morse[] + !
C" .-- " 476 'morse[] + !
C" --. " 412 'morse[] + !
C" -.. " 400 'morse[] + !
C" . " 404 'morse[] + !
C" ...- " 472 'morse[] + !
C" --.. " 488 'morse[] + !
C" .. " 420 'morse[] + !
C" .--- " 424 'morse[] + !
C" -.- " 428 'morse[] + !
C" .-.. " 432 'morse[] + !
C" -- " 436 'morse[] + !
C" -. " 440 'morse[] + !
C" --- " 444 'morse[] + !
C" .--. " 448 'morse[] + !
C" .-. " 456 'morse[] + !
C" ... " 460 'morse[] + !
C" - " 464 'morse[] + !
C" ..- " 468 'morse[] + !
C" ..-. " 408 'morse[] + !
C" .... " 416 'morse[] + !
C" -.-. " 396 'morse[] + !
C" --.- " 452 'morse[] + !
C" -..- " 480 'morse[] + !
C" -.-- " 484 'morse[] + !
C" .- " 260 'morse[] + !
C" -... " 264 'morse[] + !
C" .-- " 348 'morse[] + !
C" --. " 284 'morse[] + !
C" -.. " 272 'morse[] + !
C" . " 276 'morse[] + !
C" ...- " 344 'morse[] + !
C" --.. " 360 'morse[] + !
C" .. " 292 'morse[] + !
C" .--- " 296 'morse[] + !
C" -.- " 300 'morse[] + !
C" .-.. " 304 'morse[] + !
C" -- " 308 'morse[] + !
C" -. " 312 'morse[] + !
C" --- " 316 'morse[] + !
C" .--. " 320 'morse[] + !
C" .-. " 328 'morse[] + !
C" ... " 332 'morse[] + !
C" - " 336 'morse[] + !
C" ..- " 340 'morse[] + !
C" ..-. " 280 'morse[] + !
C" .... " 288 'morse[] + !
C" -.-. " 268 'morse[] + !
C" --.- " 324 'morse[] + !
C" -..- " 352 'morse[] + !
C" -.-- " 356 'morse[] + !
C" .- " 896 'morse[] + !
C" -... " 900 'morse[] + !
C" .-- " 904 'morse[] + !
C" --. " 908 'morse[] + !
C" -.. " 912 'morse[] + !
C" . " 916 'morse[] + !
C" . " 736 'morse[] + !
C" ...- " 920 'morse[] + !
C" --.. " 924 'morse[] + !
C" .. " 928 'morse[] + !
C" .--- " 932 'morse[] + !
C" -.- " 936 'morse[] + !
C" .-.. " 940 'morse[] + !
C" -- " 944 'morse[] + !
C" -. " 948 'morse[] + !
C" --- " 952 'morse[] + !
C" .--. " 956 'morse[] + !
C" .-. " 960 'morse[] + !
C" ... " 964 'morse[] + !
C" - " 968 'morse[] + !
C" ..- " 972 'morse[] + !
C" ..-. " 976 'morse[] + !
C" .... " 980 'morse[] + !
C" -.-. " 984 'morse[] + !
C" ---. " 988 'morse[] + !
C" ---- " 992 'morse[] + !
C" --.- " 996 'morse[] + !
C" -..- " 1008 'morse[] + !
C" -.-- " 1004 'morse[] + !
C" ..-.. " 1012 'morse[] + !
C" ..-- " 1016 'morse[] + !
C" .-.- " 1020 'morse[] + !
C" .- " 768 'morse[] + !
C" -... " 772 'morse[] + !
C" .-- " 776 'morse[] + !
C" --. " 780 'morse[] + !
C" -.. " 784 'morse[] + !
C" . " 788 'morse[] + !
C" . " 672 'morse[] + !
C" ...- " 792 'morse[] + !
C" --.. " 796 'morse[] + !
C" .. " 800 'morse[] + !
C" .--- " 804 'morse[] + !
C" -.- " 808 'morse[] + !
C" .-.. " 812 'morse[] + !
C" -- " 816 'morse[] + !
C" -. " 820 'morse[] + !
C" --- " 824 'morse[] + !
C" .--. " 828 'morse[] + !
C" .-. " 832 'morse[] + !
C" ... " 836 'morse[] + !
C" - " 840 'morse[] + !
C" ..- " 844 'morse[] + !
C" ..-. " 848 'morse[] + !
C" .... " 852 'morse[] + !
C" -.-. " 856 'morse[] + !
C" ---. " 860 'morse[] + !
C" ---- " 864 'morse[] + !
C" --.- " 868 'morse[] + !
C" -..- " 880 'morse[] + !
C" -.-- " 876 'morse[] + !
C" ..-.. " 884 'morse[] + !
C" ..-- " 888 'morse[] + !
C" .-.- " 892 'morse[] + !
C" .---- " 196 'morse[] + !
C" ..--- " 200 'morse[] + !
C" ...-- " 204 'morse[] + !
C" ....- " 208 'morse[] + !
C" ..... " 212 'morse[] + !
C" -.... " 216 'morse[] + !
C" --... " 220 'morse[] + !
C" ---.. " 224 'morse[] + !
C" ----. " 228 'morse[] + !
C" ----- " 192 'morse[] + !
C" ...... " 184 'morse[] + !
C" .-.-.- " 176 'morse[] + !
C" -..-. " 188 'morse[] + !
C" ..--.. " 252 'morse[] + !
C" --..-- " 132 'morse[] + !
C" .--.-. " 256 'morse[] + !

: S>MORSE  { a u -- a1 u1 }  \ Преобразует строку с текстом в код Морзе
S" "       \ Начало строки
u 0 DO
a I + C@      \ Код символа
CELL * 'morse[] + @ ?DUP   \ Код символа >> ac-строка кода Морзе
   IF
     COUNT S+
   THEN
LOOP
;

\ Обратное преобразование кода морзе
CREATE 'morse-chars-small[] 128 ALLOT
32 46 'morse-chars-small[] + C!
CHAR а 5 'morse-chars-small[] + C!
CHAR б 30 'morse-chars-small[] + C!
CHAR в 9 'morse-chars-small[] + C!
CHAR г 12 'morse-chars-small[] + C!
CHAR д 14 'morse-chars-small[] + C!
CHAR е 3 'morse-chars-small[] + C!
CHAR ж 23 'morse-chars-small[] + C!
CHAR з 28 'morse-chars-small[] + C!
CHAR и 7 'morse-chars-small[] + C!
CHAR й 17 'morse-chars-small[] + C!
CHAR к 10 'morse-chars-small[] + C!
CHAR л 29 'morse-chars-small[] + C!
CHAR м 4 'morse-chars-small[] + C!
CHAR н 6 'morse-chars-small[] + C!
CHAR о 8 'morse-chars-small[] + C!
CHAR п 25 'morse-chars-small[] + C!
CHAR р 13 'morse-chars-small[] + C!
CHAR с 15 'morse-chars-small[] + C!
CHAR т 2 'morse-chars-small[] + C!
CHAR у 11 'morse-chars-small[] + C!
CHAR ф 27 'morse-chars-small[] + C!
CHAR х 31 'morse-chars-small[] + C!
CHAR ц 26 'morse-chars-small[] + C!
CHAR ч 24 'morse-chars-small[] + C!
CHAR ш 16 'morse-chars-small[] + C!
CHAR щ 20 'morse-chars-small[] + C!
CHAR ь 22 'morse-chars-small[] + C!
CHAR ы 18 'morse-chars-small[] + C!
CHAR э 59 'morse-chars-small[] + C!
CHAR ю 19 'morse-chars-small[] + C!
CHAR я 21 'morse-chars-small[] + C!
CHAR 1 33 'morse-chars-small[] + C!
CHAR 2 35 'morse-chars-small[] + C!
CHAR 3 39 'morse-chars-small[] + C!
CHAR 4 47 'morse-chars-small[] + C!
CHAR 5 63 'morse-chars-small[] + C!
CHAR 6 62 'morse-chars-small[] + C!
CHAR 7 60 'morse-chars-small[] + C!
CHAR 8 56 'morse-chars-small[] + C!
CHAR 9 48 'morse-chars-small[] + C!
CHAR 0 32 'morse-chars-small[] + C!
CHAR . 127 'morse-chars-small[] + C!
CHAR , 85 'morse-chars-small[] + C!
CHAR / 54 'morse-chars-small[] + C!
CHAR ? 115 'morse-chars-small[] + C!
CHAR ! 76 'morse-chars-small[] + C!
CHAR @ 105 'morse-chars-small[] + C!

CREATE 'morse-chars-big[] 128 ALLOT
32 46 'morse-chars-big[] + C!
CHAR А 5 'morse-chars-big[] + C!
CHAR Б 30 'morse-chars-big[] + C!
CHAR В 9 'morse-chars-big[] + C!
CHAR Г 12 'morse-chars-big[] + C!
CHAR Д 14 'morse-chars-big[] + C!
CHAR Е 3 'morse-chars-big[] + C!
CHAR Ж 23 'morse-chars-big[] + C!
CHAR З 28 'morse-chars-big[] + C!
CHAR И 7 'morse-chars-big[] + C!
CHAR Й 17 'morse-chars-big[] + C!
CHAR К 10 'morse-chars-big[] + C!
CHAR Л 29 'morse-chars-big[] + C!
CHAR М 4 'morse-chars-big[] + C!
CHAR Н 6 'morse-chars-big[] + C!
CHAR О 8 'morse-chars-big[] + C!
CHAR П 25 'morse-chars-big[] + C!
CHAR Р 13 'morse-chars-big[] + C!
CHAR С 15 'morse-chars-big[] + C!
CHAR Т 2 'morse-chars-big[] + C!
CHAR У 11 'morse-chars-big[] + C!
CHAR Ф 27 'morse-chars-big[] + C!
CHAR Х 31 'morse-chars-big[] + C!
CHAR Ц 26 'morse-chars-big[] + C!
CHAR Ч 24 'morse-chars-big[] + C!
CHAR Ш 16 'morse-chars-big[] + C!
CHAR Щ 20 'morse-chars-big[] + C!
CHAR Ь 22 'morse-chars-big[] + C!
CHAR Ы 18 'morse-chars-big[] + C!
CHAR Э 59 'morse-chars-big[] + C!
CHAR Ю 19 'morse-chars-big[] + C!
CHAR Я 21 'morse-chars-big[] + C!
CHAR 1 33 'morse-chars-big[] + C!
CHAR 2 35 'morse-chars-big[] + C!
CHAR 3 39 'morse-chars-big[] + C!
CHAR 4 47 'morse-chars-big[] + C!
CHAR 5 63 'morse-chars-big[] + C!
CHAR 6 62 'morse-chars-big[] + C!
CHAR 7 60 'morse-chars-big[] + C!
CHAR 8 56 'morse-chars-big[] + C!
CHAR 9 48 'morse-chars-big[] + C!
CHAR 0 32 'morse-chars-big[] + C!
CHAR . 127 'morse-chars-big[] + C!
CHAR , 85 'morse-chars-big[] + C!
CHAR / 54 'morse-chars-big[] + C!
CHAR ? 115 'morse-chars-big[] + C!
CHAR ! 76 'morse-chars-big[] + C!
CHAR @ 105 'morse-chars-big[] + C!

: CODE-MORSE>N  { a u -- n }  \ Преобразует строку с кодом Морзе в битовую маску
  1 u LSHIFT   \ Добавляем лидирующую еденицу в начало битовой маски, для исключения совпадения в случаях если все биты равны нулю, при разном их числе (тогда коды вида - -- --- дают разные битовые маски)
  u 0 DO
    a I + C@ 45 -  \ Получает бит символа: ноль - чероточка, один - точка
    I LSHIFT      \ Сдвигает бит влево на позицию этого бита
    +         \ Складывает биты в маску
  LOOP
;

: #MORSE>SMALL-CHAR  ( # -- a u )
  'morse-chars-small[] + 1  ;
: #MORSE>BIG-CHAR  ( # -- a u )
  'morse-chars-big[] + 1  ;

VECT #MORSE>S

: Прописные-буквы
  ['] #MORSE>SMALL-CHAR TO #MORSE>S  ;
: Строчные-буквы
  ['] #MORSE>BIG-CHAR TO #MORSE>S  ;

Прописные-буквы

\ S" --..-- ..--.- - " MORSE>S
: MORSE>S  { \ a u -- } \ Преобразует код Морзе в текстовую строку
  S" " TO u TO a
  BEGIN
   OVER SWAP   \ a a u --
   S"  " SEARCH   \ a a1 u1 ? --
  WHILE   \ a a1 u1 --
   >R   \ a a1 --
   2DUP   \ a a1 a a1 --
   >R   \ a a1 a --   R: u1 a1 --  \ На стеке возвратов строка для продолжения поиска
   -    \ а u2 -- \ Строка с кодом Морзе ( Получает разницу между адресом начала поиска и адресом результата поиска и минус пробел - это длина нашего кода Морзе, ниже уже лежит адрес начала поиска)
   CODE-MORSE>N
   #MORSE>S   \ На стеке строка с символом
   a u 2SWAP S+ TO u TO a   \ Прибавляем полученный символ ко всем остальным
   R> R> 1 -1 D+
  REPEAT
  2DROP DROP
  a u
;
Action:
." Тест преобразования текста в код Морзе:" CR
S" тестовая строка длинною 35 символов" S>MORSE 2DUP TYPE CR
CR
." Тест преобразования кода Морзе в текст:" CR
MORSE>S TYPE CR
)#

_________________
Cтоимость сопровождения программного обеспечения пропорциональна квадрату творческих способностей программиста.
Роберт Д. Блисc


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Чт янв 10, 2008 09:54 
Не в сети
Moderator
Moderator

Зарегистрирован: Ср май 10, 2006 15:37
Сообщения: 1132
Откуда: Chelyabinsk ( Ural)
Благодарил (а): 0 раз.
Поблагодарили: 9 раз.
Есть такое
Приложение для 51-го контроллера из amrforth примеров.

\ morse.fs Morse Code Generator
http://www.amresearch.com/v6/appnotes/appnote005.pdf

код в исходниках форта amrforth7


P.S. Подправил пост по замечанию модератора.

и нагуглил ссылку
morse trainer program in Quartus Forth http://www.qsl.net/ok1fou/quartus/index.html

и еще http://www.forth.hccnet.nl/downloads/morse.frt


Последний раз редактировалось Kopa Чт янв 10, 2008 16:38, всего редактировалось 3 раз(а).

Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: DLL на ForthEC
СообщениеДобавлено: Вс янв 13, 2008 18:55 
Не в сети
Аватара пользователя

Зарегистрирован: Вс май 07, 2006 11:38
Сообщения: 279
Откуда: Slavyansk, Ukraine
Благодарил (а): 0 раз.
Поблагодарили: 0 раз.
DLL на ForthEC
Черновой вариант: только перевод морзе в текст (англ.) Увы, подключить DLL к SPF не получилось, т.к. строка с морзянкой должна быть в UNICODE - поэтому нормально отбивает только предусмотренную "ошибку" с пробелом в начале строки.
DLL:
Код:
INCLUDE   ..\include\windef.f
INCLUDE ..\include\advapi32.f
INCLUDE ..\include\dll@.f
INCLUDE ..\include\stack.f
z"                                                                                                                                " CONSTANT #string
VARIABLE @symbol \ z" _" @symbol !
VARIABLE @tmpcode 0 @tmpcode !
VARIABLE @letter 0 @letter !
VARIABLE @num 0 @num !
VARIABLE @NN 0 @NN !
VARIABLE @N1 0 @N1 !
VARIABLE @N2 0 @N2 !
VARIABLE @TT 0 @TT !
VARIABLE @II 0 @II !

: var_init
   0 @tmpcode !
   0 @letter !
   0 @NN !
   0 @N1 !
   0 @N2 !
   0 @II !
;

: byte_writer ( World String Position -- )
NOTOUCH
   POP EBX
   POP EAX
   POP ECX
   PUSH EAX
   MOV EDX,[ECX]
   MOV [EAX+EBX],EDX
TOUCH
   DROP
;

: letter_writer ( -- )
   @symbol @
   #string
   @II @
   byte_writer
   @II @ 1+ @II !
;

: space_writer ( -- )
   z"  "
   #string
   @II @
   byte_writer
   @II @ 1+ @II !
;


: morze_case ( n -- chr )
   CASE
       1 OF z" E" ENDOF
       2 OF z" T" ENDOF
       3 OF z" I" ENDOF
       4 OF z" A" ENDOF
       5 OF z" N" ENDOF
       6 OF z" M" ENDOF
       7 OF z" S" ENDOF
       8 OF z" U" ENDOF
       9 OF z" R" ENDOF
      10 OF z" W" ENDOF
      11 OF z" D" ENDOF
      12 OF z" K" ENDOF
      13 OF z" G" ENDOF
      14 OF z" O" ENDOF
      15 OF z" H" ENDOF
      16 OF z" V" ENDOF
      17 OF z" F" ENDOF
      18 OF z" x" ENDOF
      19 OF z" L" ENDOF
      20 OF z" x" ENDOF
      21 OF z" P" ENDOF
      22 OF z" J" ENDOF
      23 OF z" B" ENDOF
      24 OF z" X" ENDOF
      25 OF z" C" ENDOF
      26 OF z" Y" ENDOF
      27 OF z" Z" ENDOF
      28 OF z" Q" ENDOF
      29 OF z" x" ENDOF
      30 OF z" x" ENDOF
      31 OF z" 5" ENDOF
      32 OF z" 4" ENDOF
      33 OF z" 3" ENDOF
      34 OF z" x" ENDOF
      35 OF z" 2" ENDOF
      36 OF z" 1" ENDOF
      37 OF z" 6" ENDOF
      38 OF z" /" ENDOF
      39 OF z" 7" ENDOF
      40 OF z" 8" ENDOF
      41 OF z" 9" ENDOF
      42 OF z" 0" ENDOF
      43 OF z" ." ENDOF
      44 OF z" ?" ENDOF
      45 OF z" ," ENDOF
      46 OF z" @" ENDOF
      47 OF z" !" ENDOF
   ENDCASE
;
: except_letter ( n -- n )
      DUP 63 =
   IF
      DROP 43
   THEN
      DUP 75 =
   IF
      DROP 44
   THEN
      DUP 84 =
   IF
      DROP 45
   THEN
      DUP 89 =
   IF
      DROP 46
   THEN
      DUP 114 =
   IF
      DROP 47
   THEN
;
: morze_letter ( n n -- )
   0 @num !
   @N2 @ @N1 @
   DO
      @tmpcode @ 10 MOD
      2 PICK 3 PICK
      DO
         2*
   ."  "
      LOOP
      @TT ! @TT @
      @num @ + @num !
      @tmpcode @ 10 / @tmpcode !
      1-
   LOOP
   DROP DROP
   @num @ 2/ DUP 46 >
   IF
      except_letter
   THEN
   DUP @num !
   morze_case @symbol !
;
: writed ( -- )
   @N2 @ @N1 @ - DUP 1-
   morze_letter
   letter_writer
;
: nexted ( -- )
   @N2 @ 1+ DUP @N1 ! @N2 !
   @NN @ 1+ @NN !
;
: space_letter ( chr -- )
   DUP 13 <>
   IF
      32 =
      IF
         32 =
         IF
            @NN @ 2 + @NN !
            space_writer
            FALSE
         ELSE
            writed
            nexted
            space_writer
            nexted
            FALSE
         THEN
      ELSE
         writed
         nexted
         FALSE
      THEN
   ELSE
      writed
      nexted
      TRUE
   THEN
\   DROP
;

: morze_text { $morze }
\ ." Start:" @5
   $morze c@ DUP 13 <>
   IF
      32 <>
      IF
      var_init
      BEGIN
         @NN @ $morze + c@
         DUP 13 <>
         IF
            DUP 32 <>
            IF
               DUP 45 SWAP - OVER 44 SWAP - OR
               IF
                  44 -
                  3 SWAP -
                  @tmpcode @ 10 * + @tmpcode !
                  @N2 @ 1+ @N2 !
                  FALSE
               ELSE
               \ текущий символ не "." и не "-"
   MB_OK z" Ошибка:" z" Введен нераспознанный символ!" NULL CALL MessageBox
                  TRUE
\                  @NN @ 1+ @NN !
\                  FALSE
               THEN
               \ next
                  @NN @ 1+ @NN !
            ELSE
            \ пробелы
               DROP @NN @ $morze + DUP
               2 + c@ SWAP 1+ c@
               space_letter
            THEN
         ELSE
         \ конец текста
            writed
            TRUE
         THEN
      UNTIL
      DROP
      ELSE
      \ текст начался символом "пробел"
   MB_OK z" Ошибка:" z" Нельзя пробел в начале текста!" NULL CALL MessageBox
      THEN
   ELSE
   DROP
   MB_OK z" Ошибка:" z" Введена пустая строка!" NULL CALL MessageBox
   THEN
\                  #string ." string:"  ". NEWLINE
\ ." End:" @5
   #string a@
;

: text_morze { texte }
   MB_OK z" Message" texte NULL CALL MessageBox
   a@
;

EXE на ForthEC для проверки:
Код:
INCLUDE   ..\include\windef.f
INCLUDE ..\include\advapi32.f
INCLUDE ..\include\dll.f
INCLUDE ..\include\stack.f
VARIABLE user-input 64 ALLOT
z" morze.dll"   CONSTANT morze_dll
morze_dll load_lib

: test-morze_text
\ @5
\   z" morze-text"
   z" morze_text" DLL
DROP DROP
\ @5
;

: test-text_morze
\ @5
   z" morze-text"
   z" text_morze" DLL
DROP DROP
\ @5
;

: test
NEWLINE ." Enter some text, finish with [Return]: "
user-input 32 EXPECT
\ ." You entered: " user-input ". NEWLINE
user-input test-morze_text
\ test-text_morze
;

test ". NEWLINE
test ". NEWLINE
morze_dll free_lib
\ @5
bye

Остальное - готовая DLL, def-файл к ней, батники, экзешник, последняя версия ForthEC (и MASM32 к нему), а также пара старых примеров вызова фортековских DLL из СПФ лежит на http://bayzar.net в папке ForthUNE
PS Сорри за сырое решение - главное же участие ;)

_________________
Банзай!


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Вт янв 29, 2008 15:19 
Не в сети
Moderator
Moderator

Зарегистрирован: Ср май 10, 2006 15:37
Сообщения: 1132
Откуда: Chelyabinsk ( Ural)
Благодарил (а): 0 раз.
Поблагодарили: 9 раз.
Еще нашлось:)
Basic morse application

http://www.geocities.com/petrusp_id/morse.html


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

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


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

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


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

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