Forth
http://www.fforum.winglion.ru/

раскрашиваем исходые тексты на форуме
http://www.fforum.winglion.ru/viewtopic.php?f=25&t=2582
Страница 1 из 3

Автор:  mOleg [ Вс апр 25, 2010 14:50 ]
Заголовок сообщения:  раскрашиваем исходые тексты на форуме

решил поразмяться, и вот какой набросок у меня получился:

source file: colorer.f
\ 24.04.2010 ~mOleg
\ Сopyright [C] 2009 mOleg mOlegg@ya.ru
\ Раскраска исходных текстов для публикования на форуме

branch/ case.fts
vocs/ shadow.fts
vocs/ vocab.fts
exc/ demand.fts

\
: >OUT ( asc # --> )
TYPE ;

USER-VALUE latestlex \ адрес последней лексемы во входном потоке

\ все пробельные символы передаются без изменений
: lexx ( --> )
BEGIN system_buff ?COMPLETE WHILENOT
PeekChar ?separator WHILE
CharAddr DUP C# >OUT
SkipChar
REPEAT
THEN ;

\
: ?num ( asc # --> flag )
[ ALSO HIDDEN ] snNumber [ PREVIOUS ]
*IF 2 = IF DDROP ELSE DROP THEN TRUE ;THEN ;

VOCABULARY COL

\ создать правило
: rule: ( / name --> )
ALSO COL THIS
:
;


\ завершить создание правила
: ;r ( --> )
[COMPILE] ;
DEFINITIONS
; IMMEDIATE

: cline ( asc # color --> asc # )
S>D 0x10 {# s" [/color\]" HOLDS DSWAP HOLDS s" ]" HOLDS
# # # # # # s" [color\=#" HOLDS #>
;

: <prev CharAddr <C 1 <BACK ;

: myself ( --> asc # ) latestlex CharAddr OVER - ;

: simple ( color --> ) >L myself L> cline >OUT ;

: alone: ( color / name --> )
rule: LIT, COMPILE simple [COMPILE] ;r ;

: cpath ( color --> )
>L latestlex ParseFileName DDROP <prev
CharAddr OVER - L> cline >OUT ;

: cpath: ( color / name --> )
rule: LIT, COMPILE cpath [COMPILE] ;r ;

: string ( color / string" --> )
>L latestlex system_buff [CHAR] " MISSTILL SkipChar
CharAddr OVER - L> cline
>OUT ;

: string: ( color / string" --> )
rule: LIT, COMPILE string [COMPILE] ;r ;

: pair ( color / lexeme --> )
>L latestlex NEXT-WORD DDROP <prev
CharAddr OVER - L> cline
>OUT ;

: pair: ( color / lexeme --> )
rule: LIT, COMPILE pair [COMPILE] ;r ;

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

\ ветвления одним цветом
0xCF8F60 alone: BEGIN
0xCF8F60 alone: WHILE
0xCF8F60 alone: *WHILE
0xCF8F60 alone: REPEAT
0xCF8F60 alone: IF
0xCF8F60 alone: IFNOT
0xCF8F60 alone: *IF
0xCF8F60 alone: ELSE
0xCF8F60 alone: THEN
\
0xBF00BF alone: ALSO
0xBF00BF alone: ONLY
0xBF00BF alone: DEFINITIONS
0xBF00BF alone: THIS
0xBF00BF alone: PREVIOUS
\
0xCF8F60 alone: DEMAND
\ опасные операции и обработка ошибок
0xCF0000 alone: THROW
0xCF0000 alone: EXECUTE
0xCF0000 alone: REJECT
0xCF0000 alone: [
0xCF0000 alone: ]
0xCF0000 alone: IMMEDIATE
\ подключение библиотек
0x00E000 cpath: branch/
0x00E000 cpath: vocs/
0x00E000 cpath: exc/
\ строковые литералы
0x00E000 string: s"
0x00E000 string: S"
\ компилирующие слова
0x00E000 pair: [CHAR]
0x00E000 pair: [COMPILE]
0x00E000 pair: [']
\ определяющие слова
0xFF8000 pair: VALUE
0xFF8000 pair: VARIABLE
0xFF8000 pair: VECT
0xFF8000 pair: USER
0xFF8000 pair: USER-VALUE
0xFF8000 pair: USER-VECT
0xFF8000 pair: VOCABULARY
\
rule: \ ( --> )
<prev Cr_ PARSE 0x408040 cline
>OUT <prev ;r

\
rule: ( ( --> )
CharAddr <C system_buff [CHAR] ) MISSTILL SkipChar
CharAddr OVER - 0x0040BF cline
>OUT ;r

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

\
: ?def ( asc # --> )
DDUP + <C C@ [CHAR] : =
IF
s" [color=#FF8000]" >OUT >OUT
CharAddr NextWord DDROP <prev CharAddr OVER - >OUT
s" [/color\]" >OUT
;THEN

OVER C@ [CHAR] ; =
IF s" [\color=#FF8000]" >OUT >OUT s" [/color\]" >OUT
;THEN

DDUP ?num
IF s" [color=#00E000]" >OUT >OUT s" [/color\]" >OUT
;THEN

>OUT ;

\
: (defoult) ( --> )
BEGIN lexx
system_buff LEXEME *WHILE OVER TO latestlex
SFIND IFNOT ?def ELSE EXECUTE THEN
REPEAT DDROP ;

\
: 2COL ( / file.name --> )
SAVE-ORDER
DEMAND COL SEAL
s" [pre\]\n\r source file: " >OUT
ParseFileName DDUP >OUT
s" \n\r[b\]" >OUT
FileSource ['] (defoult) EvalSrcWith
s" [\/b][/pre\]" >OUT
-1 THROW
REJECT RESTORE-ORDER ;


просьба, сильно не ругать, т.к. писалось на больную голову и очень быстро.

Автор:  WingLion [ Вс апр 25, 2010 16:00 ]
Заголовок сообщения:  Re: раскрашиваем исходые тексты на форуме

Подсказку бы, что и куда совать, чтобы получилась эта самая раскраска.
А то, больная голова совсем ничего не понимает...

Автор:  Hishnik [ Вс апр 25, 2010 16:36 ]
Заголовок сообщения:  Re: раскрашиваем исходые тексты на форуме

VECT CREATE-BMP
VECT LOAD-BMP
VECT SHOW-BMP

" Примерно вот такая раскраска" PRINT

: CREATE-BMP24 // STR --
CREATE
0x36 ALLOT
OPEN TO HF-OUT
HF-OUT HERE 0x36 - 0x36 READFILE
HF-OUT HERE
HERE 0x20 - @
HERE 0x24 - @ BEGIN DUP 4 MOD WHILE 1+ REPEAT * 3 * DUP ALLOT
READFILE
HF-OUT CLOSE
;

: LOAD-BMP24 // STR -- ADDR
HERE SWAP
0x36 ALLOT
OPEN TO HF-OUT
HF-OUT HERE 0x36 - 0x36 READFILE
HF-OUT HERE
HERE 0x20 - @
HERE 0x24 - @ BEGIN DUP 4 MOD WHILE 1+ REPEAT * 3 * DUP ALLOT
READFILE
HF-OUT CLOSE
;

Автор:  mOleg [ Вс апр 25, 2010 18:15 ]
Заголовок сообщения:  Re: раскрашиваем исходые тексты на форуме

WingLion писал(а):
Подсказку бы, что и куда совать, чтобы получилась эта самая раскраска.
А то, больная голова совсем ничего не понимает...


я так делал:
fork.exe col.f 2COL colorer.f BYE >out.log


можно и в отдельный файл, однако для этого надо >OUT подправить.

Автор:  вопрос [ Пн апр 26, 2010 00:35 ]
Заголовок сообщения:  Re: раскрашиваем исходые тексты на форуме

Да, работает...

source file: asm_.f

: TYPEFILEINT
PARSE-NAME
2DUP S" .text" COMPARE 0= IF 2DROP EXIT THEN
2DUP S" .section" COMPARE 0= IF 2DROP EXIT THEN
2DROP
SOURCE TYPE CR ;


CREATE ZZZZ 100 ALLOT

: TYPEFILE
&INTERPRET @ >R
H-STDOUT >R
PARSE-NAME
2DUP 1- ZZZZ $!
S" s" ZZZZ $+!
ZZZZ COUNT W/O CREATE-FILE THROW
TO H-STDOUT

['] TYPEFILEINT &INTERPRET !
." .data" CR
INCLUDED
R> TO H-STDOUT
R> &INTERPRET ! ;


Автор:  in4 [ Пн апр 26, 2010 01:03 ]
Заголовок сообщения:  Re: раскрашиваем исходые тексты на форуме

Лучше светложелтый и светлозеленый не использовать - на белом фоне плохо читаются... :(

Автор:  mOleg [ Пн апр 26, 2010 03:43 ]
Заголовок сообщения:  Re: раскрашиваем исходые тексты на форуме

in4 писал(а):
Лучше светложелтый и светлозеленый не использовать - на белом фоне плохо читаются...

тут можно свою раскраску придумать ;)
к сожалению нельзя выбирать цвет фона, поэтому моя рабочая палитра не подходит.

Автор:  WingLion [ Пн апр 26, 2010 05:21 ]
Заголовок сообщения:  Re: раскрашиваем исходые тексты на форуме

проверка тега цвета бакграунда

- Тег [ bgc=#COLOR ] и [ /bgc ] цвет только руками вставлять надо -

Автор:  mOleg [ Пн апр 26, 2010 09:49 ]
Заголовок сообщения:  Re: раскрашиваем исходые тексты на форуме

WingLion писал(а):
проверка тега цвета бакграунда

урряяяЯЯЯ!!!

Автор:  mOleg [ Пн апр 26, 2010 10:02 ]
Заголовок сообщения:  Re: раскрашиваем исходые тексты на форуме

мдяя, красятся только символы, а не фон страницы 8(
может и фон как-то можно задавать-то?

Автор:  in4 [ Пн апр 26, 2010 15:45 ]
Заголовок сообщения:  Re: раскрашиваем исходые тексты на форуме

mOleg писал(а):
мдяя, красятся только символы, а не фон страницы 8(
может и фон как-то можно задавать-то?

Прикольно выглядит в разных браузерах: В Опере белые буквы, в ФайрФоксе - черные... :)

Автор:  mOleg [ Пн апр 26, 2010 16:10 ]
Заголовок сообщения:  Re: раскрашиваем исходые тексты на форуме

in4 писал(а):
Прикольно выглядит в разных браузерах: В Опере белые буквы, в ФайрФоксе - черные...

а в IE темно-синие на темно-сером фоне, причем, в ответе цвет другой 8(

Автор:  mOleg [ Пн апр 26, 2010 20:59 ]
Заголовок сообщения:  Re: раскрашиваем исходые тексты на форуме

И пусть попугаи нервно завидуют в сторонке!!!
Баловство продолжено, подчищены хвосты, добавлены перечисления и чуточку больше коментариев,
так же немного изменена палитра, цвета теперь именованы.

source file: colorer.f
\ 24.04.2010 ~mOleg
\ Сopyright [C] 2009 mOleg mOlegg@ya.ru
\ ???


branch/ case.fts
string/ add.fts
transl/ useful.fts
vocs/ shadow.fts
vocs/ vocab.fts
exc/ demand.fts


CONTAINER COLORER \ отдельный словарь, чтобы "не мусорить" в FORTH

0x000000 CONSTANT Black
0x0000F0 CONSTANT Blue
0x00F000 CONSTANT Green
0x00A0A0 CONSTANT Cyan
0xC00000 CONSTANT Red
0x800080 CONSTANT Magenta
0x808000 CONSTANT Brown
0xC0C0C0 CONSTANT LightGray
0x808080 CONSTANT DarkGray
0x0080C0 CONSTANT LightBlue
0x00FF00 CONSTANT LightGreen
0x00FFFF CONSTANT LightСyan
0xFF0000 CONSTANT LightRed
0xFF00FF CONSTANT LightMagenta
0xE0E000 CONSTANT Yellow
0xFFFFFF CONSTANT White
0xFF8000 CONSTANT Orange

\ для работы с файлами менять тут!
\ слово выводит раскрашенный текст в stdout
: >OUT ( asc # --> ) TYPE ;

USER-VALUE latestlex \ адрес последней лексемы во входном потоке

\ все пробельные символы передаются без изменений
: lexx ( --> )
BEGIN system_buff ?COMPLETE WHILENOT
PeekChar ?separator WHILE
CharAddr DUP C# >OUT
SkipChar
REPEAT
THEN ;

\ является ли лексема числом?
: ?num ( asc # --> flag )
[ ALSO HIDDEN ] snNumber [ PREVIOUS ]
*IF 2 = IF DDROP ELSE DROP THEN TRUE ;THEN ;

VOCABULARY COL

\ создать правило
: rule: ( / name --> )
ALSO COL THIS
:
;


\ завершить создание правила
: ;r ( --> )
[COMPILE] ;
DEFINITIONS
; IMMEDIATE

: cline ( asc # color --> asc # )
S>D 0x10 {# s" [/color\]" HOLDS DSWAP HOLDS s" ]" HOLDS
# # # # # # s" [color\=#" HOLDS #>
;

: <prev CharAddr <C 1 <BACK ;

: myself ( --> asc # ) latestlex CharAddr OVER - ;

: simple ( color --> ) >L myself L> cline >OUT ;

: alone: ( color / name --> )
rule: LIT, COMPILE simple [COMPILE] ;r ;

: cpath ( color --> )
>L latestlex ParseFileName DDROP <prev
CharAddr OVER - L> cline >OUT ;

: cpath: ( color / name --> )
rule: LIT, COMPILE cpath [COMPILE] ;r ;

: string ( color / string" --> )
>L latestlex system_buff [CHAR] " MISSTILL SkipChar
CharAddr OVER - L> cline
>OUT ;

: string: ( color / string" --> )
rule: LIT, COMPILE string [COMPILE] ;r ;

: pair ( color / lexeme --> )
>L latestlex NEXT-WORD DDROP <prev
CharAddr OVER - L> cline
>OUT ;

: pair: ( color / lexeme --> )
rule: LIT, COMPILE pair [COMPILE] ;r ;

\
: All ( color / name --> )
>L ' >L
<: BEGIN SeeForw NIP WHILE DL@ EXECUTE REPEAT LDROP ;>
Cr_ PARSE ROT EVALUATE-WITH ;

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

\ ветвления одним цветом
Cyan All alone: BEGIN WHILE WHILENOT *WHILE REPEAT UNTIL AGAIN
Cyan All alone: IF IFNOT *IF -IF ELSE THEN
\
LightMagenta All alone: ALSO ONLY DEFINITIONS THIS PREVIOUS
\
Cyan alone: DEMAND
\ опасные операции и обработка ошибок
Red All alone: THROW EXECUTE REJECT [ ] IMMEDIATE LEAP
\ подключение библиотек
Green All cpath: branch/ vocs/ exc/ string/ transl/
\ строковые литералы
Green All string: s" S" "
\ компилирующие слова
Green All pair: [CHAR] [COMPILE] ['] COMPILE
\
константы
Green All alone: Bl_ Cr_ Lf_ Tab_
\ определяющие слова
Orange All pair: VALUE VARIABLE VECT USER USER-VALUE USER-VECT
Orange
All pair: CONSTANT VOCABULARY CONTAINER

Blue All alone: <# {# # S# #> #} HOLD HOLDS KEEP KEEPS <| |>

\ коментарий до конца строки
rule: \ ( --> )
<prev Cr_ PARSE LightGray cline
>OUT <prev ;r

\ скобочный коментарий
rule: ( ( --> )
CharAddr <C system_buff [CHAR] ) MISSTILL SkipChar
CharAddr OVER - LightBlue cline
>OUT ;r

\ коментарий до конца текста
rule: \EOF ( / text --> )
latestlex system_buff CONTENT + OVER -
LightGray cline >OUT
SOURCE >IN ! DROP ;r

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

\ попытка распознать слово как литерал, определяющее слово, завершающее слово
: ?def ( asc # --> )
\ ежели в конце имени содержится двоеточие, считаем слово определяющим
DDUP + <C C@ [CHAR] : =
IF latestlex NextWord DDROP <prev CharAddr OVER - Orange cline >OUT ;THEN
\ все, что в начале слова содержит ';' считаем завершаюшим определение
OVER C@ [CHAR] ; = IF Orange cline >OUT ;THEN
\ все опознанное числом красим в зеленый
DDUP ?num IF Green cline >OUT ;THEN
\ все незнакомое не красим
>OUT ;

\ основной цикл трансляции текста
: (defoult) ( --> )
BEGIN lexx
system_buff LEXEME *WHILE OVER TO latestlex
SFIND IFNOT ?def ELSE EXECUTE THEN
REPEAT DDROP ;

\ раскрашивает содержимое указанного файла
: 2COL ( / file.name --> )
SAVE-ORDER
DEMAND COL SEAL
s" [pre\]\n\r source file: " >OUT
ParseFileName DDUP >OUT
s" \n\r[b\]" >OUT
FileSource ['] (defoult) EvalSrcWith
s" [\/b][/pre\]" >OUT
-1 THROW
REJECT RESTORE-ORDER ;

\EOF
использовать можно так:

fork.exe colorer.f 2COL colrer.f BYE >result.txt

Автор:  Гость [ Пн апр 26, 2010 21:00 ]
Заголовок сообщения:  Re: раскрашиваем исходые тексты на форуме

in4 писал(а):
mOleg писал(а):
мдяя, красятся только символы, а не фон страницы 8(
может и фон как-то можно задавать-то?

Прикольно выглядит в разных браузерах: В Опере белые буквы, в ФайрФоксе - черные... :)

У меня не выіглядит, видимо, где-то есть настройка

Автор:  chess [ Пн апр 26, 2010 21:10 ]
Заголовок сообщения:  Re: раскрашиваем исходые тексты на форуме

У меня отношение к раскрашиванию текстов на Форте не изменилось - я их вообще не крашу( только комменты тонким
текстом и все). В форте нет ключевых слов, как в других языках поэтому нечего красить. Да и основная масса имен
в программах это новые слова - они все неокрашенные. Контроль правильности написания все равно должен транслятор проверять.

Страница 1 из 3 Часовой пояс: UTC + 3 часа [ Летнее время ]
Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group
http://www.phpbb.com/