\ преобразовать строку с текстом в строку Морзе кода
: S>MORSE ( a u -- a1 u1 )
                  ;
\ преобразовать строку Морзе кода в строку с текстом
: MORSE>S ( a u -- a1 u1 )
                  ;

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

\ 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

\ 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

#( Морзянка
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
)#

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@
;

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