Автор |
Сообщение |
|
|
Заголовок сообщения: |
|
|
|
Еще нашлось:)
Basic morse application
http://www.geocities.com/petrusp_id/morse.html
|
|
|
|
Добавлено: Вт янв 29, 2008 15:19 |
|
|
|
|
|
Заголовок сообщения: |
DLL на ForthEC |
|
|
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 Сорри за сырое решение - главное же участие
DLL на ForthEC
Черновой вариант: только перевод морзе в текст (англ.) Увы, подключить DLL к SPF не получилось, т.к. строка с морзянкой должна быть в UNICODE - поэтому нормально отбивает только предусмотренную "ошибку" с пробелом в начале строки.
DLL:
[code]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@ ;[/code] EXE на ForthEC для проверки: [code]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 [/code]
Остальное - готовая DLL, def-файл к ней, батники, экзешник, последняя версия ForthEC (и MASM32 к нему), а также пара старых примеров вызова фортековских DLL из СПФ лежит на [url]http://bayzar.net[/url] в папке ForthUNE
PS Сорри за сырое решение - главное же участие ;)
|
|
|
|
Добавлено: Вс янв 13, 2008 18:55 |
|
|
|
|
|
Заголовок сообщения: |
|
|
|
Есть такое
Приложение для 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
Есть такое
Приложение для 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
|
|
|
|
Добавлено: Чт янв 10, 2008 09:54 |
|
|
|
|
|
Заголовок сообщения: |
|
|
|
Вот и мой вариант - для ннКрона:
(для проверки открыть консоль и запустить эту задачу)
Код: #( Морзянка 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 )#
Вот и мой вариант - для ннКрона:
(для проверки открыть консоль и запустить эту задачу)
[code]#( Морзянка 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 )#[/code]
|
|
|
|
Добавлено: Пн янв 07, 2008 02:18 |
|
|
|
|
|
Заголовок сообщения: |
|
|
|
обратное преобразование:
(написано для форка 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
обратное преобразование:
(написано для форка http://fforum.winglion.ru/viewtopic.php?t=531 сборка 4.05-800)
(в сборке заменить qcase.f на http://www.forth.org.ru/~mOleg/qcase.f )
[code] \ 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 [/code]
|
|
|
|
Добавлено: Вс янв 06, 2008 22:18 |
|
|
|
|
|
Заголовок сообщения: |
|
|
|
преобразование в код Морзе:
(написано для форка 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
преобразование в код Морзе:
(написано для форка http://fforum.winglion.ru/viewtopic.php?t=531 сборка 4.05-800)
[code] \ 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 [/code]
|
|
|
|
Добавлено: Вс янв 06, 2008 22:00 |
|
|
|
|
|
Заголовок сообщения: |
|
|
|
mOleg писал(а): а как определять, в каком регистре\кодировке выводить текст? потому как морзянка для eEеEёЁ, например, совпадает (тут русские буквы, и английские)?
Думаю язык в морзянке определяется по контексту. А вот при обратном преобразовании как раз возникают сложности - какие символы использовать: кирилические или латинские. Предлагаю сделать по умолчанию преобразование кода Морзе в кирилические прописные символы.
[quote="mOleg"]а как определять, в каком регистре\кодировке выводить текст? потому как морзянка для eEеEёЁ, например, совпадает (тут русские буквы, и английские)?[/quote]
Думаю язык в морзянке определяется по контексту. А вот при обратном преобразовании как раз возникают сложности - какие символы использовать: кирилические или латинские. Предлагаю сделать по умолчанию преобразование кода Морзе в кирилические прописные символы.
|
|
|
|
Добавлено: Вс янв 06, 2008 12:27 |
|
|
|
|
|
Заголовок сообщения: |
|
|
|
а как определять, в каком регистре\кодировке выводить текст?
потому как морзянка для eEеEёЁ, например, совпадает (тут русские буквы, и английские)?
а как определять, в каком регистре\кодировке выводить текст?
потому как морзянка для eEеEёЁ, например, совпадает (тут русские буквы, и английские)?
|
|
|
|
Добавлено: Вс янв 06, 2008 05:20 |
|
|
|
|
|
Заголовок сообщения: |
|
|
|
VoidVolker писал(а): ···-···--·---·---·-----···---·----··-------··-- Ok
что-то тут не Ok...
паузы между буквами никак не обозначены пробелы должны быть хотя бы, разделяющие буквы.
[quote="VoidVolker"]···-···--·---·---·-----···---·----··-------··-- Ok [/quote]
что-то тут не Ok...
паузы между буквами никак не обозначены пробелы должны быть хотя бы, разделяющие буквы.
|
|
|
|
Добавлено: Вс янв 06, 2008 00:05 |
|
|
|
|
|
Заголовок сообщения: |
Преобразование текста в код Морзе и обратно |
|
|
Преобразовать 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. Извиняюсь за немного сумбурное выкладывание и изменения в ТЗ.
Преобразовать a u строку в текстовый код Морзе и обратно, все символы меньше 32 считать разделителями, неизвестные символы игнорировать, между буквами пробел как разделитель.
[code] \ преобразовать строку с текстом в строку Морзе кода : S>MORSE ( a u -- a1 u1 ) ; \ преобразовать строку Морзе кода в строку с текстом : MORSE>S ( a u -- a1 u1 ) ; [/code] Например:
S" С новым годом!" S>MORSE TYPE ··· -· --- ·-- -·-- -- --· --- -·· --- -- --··-- Ok
S" ··· -· --- ·-- -·-- -- --· --- -·· --- -- --··--" MORSE>S TYPE С новым годом! Ok
Вот такой тест для проверки: [code]S" йцукенгшщзхъфывапролджэячсмитьбюqwertyuiopasdfghjklzxcvbnmЙЦУКЕНГШЩЗХЪФЫВАПРОЛДЖЭЯЧСМИТЬБЮ.QWERTYUIOPASDFGHJKLZXCVBNM1234567890.,/&!@ #$%^&*()№;%:?{}[] " S>MORSE TYPE[/code]
Код морзе здесь есть:
http://ru.wikipedia.org/wiki/Азбука_Морзе
Таблица кодов:
http://forth.pastebin.ca/842974
P.S. Извиняюсь за немного сумбурное выкладывание и изменения в ТЗ.
|
|
|
|
Добавлено: Сб янв 05, 2008 22:42 |
|
|
|
|