Автор |
Сообщение |
|
|
Заголовок сообщения: |
Re: *простой текстовый viewer |
|
|
KPG писал(а): Возможно имеет смысл создать DLL библиотеку, для подключения в рамках произвольной Форт системы,по примеру проекта Scintilla c предоставлением соответствующего сервиса. c DLL много возни, не хочется.
[quote="KPG"]Возможно имеет смысл создать DLL библиотеку, для подключения в рамках произвольной Форт системы,по примеру проекта Scintilla c предоставлением соответствующего сервиса.[/quote] c DLL много возни, не хочется.
|
|
|
|
Добавлено: Пн авг 05, 2013 18:44 |
|
|
|
|
|
Заголовок сообщения: |
Re: *простой текстовый viewer |
|
|
Возможно имеет смысл создать DLL библиотеку, для подключения в рамках произвольной Форт системы, по примеру проекта Scintilla c предоставлением соответствующего сервиса. P.S. В Win32Forth один из представленных проектов сделан для использования scintilla.dll в качестве ядра редактора.
Возможно имеет смысл создать DLL библиотеку, для подключения в рамках произвольной Форт системы, по примеру проекта [url=http://www.scintilla.org/]Scintilla[/url] c предоставлением соответствующего сервиса.
P.S. В Win32Forth один из представленных проектов сделан для использования [color=#400040]scintilla.dll [/color]в качестве ядра редактора.
|
|
|
|
Добавлено: Пт июл 26, 2013 17:06 |
|
|
|
|
|
Заголовок сообщения: |
Re: *простой текстовый viewer |
|
|
Продолжаю баловаться. Теперь правила раскраски в отдельном файле, имена, определенные в просматриватриваемом файле автоматически расцвечиваются, правда есть побочные эффекты в случае повторного определения слов. Вообще, так как файл по сути интерпретируестя правила расцветки ограничиваются фантазией. p.s. не делал многострочные строковые литералы и коментарии. для того, чтобы текст выглядел контрастно нужно в свойствах окна поправить значение серого цвета со 128 128 128 на 80 80 80 source file: view.fts \ 02.07.2013 ~mOleg \ Copyright [C] 2013 mOleg mOlegg@ya.ru \ просмотрщик текстовых файлов с раскраской исходников
vocs/ unit.fts vocs/ struct.fts os/ heap.fts os/ console.fts os/ ccon.fts branch/ for-next.fts memory/ buff.fts memory/ pocket.fts \ rel/ keys.fts
ALSO HIDDEN ALIAS EKEY SYSKEY ALIAS EKEY? key? PREVIOUS
Unit: key'
F: esc 0x101001B ;F F: up 0x1480000 ;F F: dn 0x1500000 ;F F: left 0x14B0000 ;F F: right 0x14D0000 ;F
F: home 0x1470000 ;F F: end 0x14F0000 ;F F: pgup 0x1490000 ;F F: pgdn 0x1510000 ;F EndUnit
Unit: View{
USER 1stLine \ первая линия текста USER LastLine \ последняя линия текста USER TopLine \ первая отображаемая линия текста
70 VALUE Width \ ширина рабочей области экрана 0 VALUE Displ \ смещение первого отображаемого символа от начала строки 2 VALUE Up \ положение первого символа окна просмотра слева 2 VALUE Top \ и сверху 25 VALUE Height \ высота рабочей области экрана 255 VALUE MaxWidth \ максимальная длина строки
\ каждая линия хранится отдельно 0 Struct: line Addr[] off_prev \ ссылка на предыдущую линию текста Addr[] off_next \ ссылка на следующую линию текста Cell[] off_size \ длина строки Zero[] off_body \ начало текста EndStruct
\ получить указатель на следующую линию текста : next ( str --> str | nil ) line off_next A@ ;
\ задать ссылку str2 на следующую строку str1 : !next ( str1 str2 --> ) line off_next A! ;
\ получить указатель на предыдущую линию текста : prev ( str --> str | nil ) line off_prev A@ ;
\ задать ссылку str2 на предыдущую строку str1 : !prev ( str1 str2 --> ) line off_prev A! ;
\ вернуть начало a2 и a1 конец строки ? : str> ( str --> asc # ) DUP line off_size @ SWAP line off_body SWAP ;
USER-VALUE cbuff \ временный буфер
\ инициализация буфера : cinit ( --> buff ) cbuff *IF DUP Clean ;THEN DROP MaxWidth Buffer DUP TO cbuff ;
\ Выделить лидирующие пробельные символы : skipsp ( a1 a2 --> a1 a2 str # ) DDUP BEGIN DDUP > WHILE DUP C@ ?separator WHILE C+ REPEAT THEN -ROT DROP DDUP - ;
\ Выделить лидирующие непробельные символы : nextlx ( a1 a2 --> a1 a2 asc # ) DDUP BEGIN DDUP > WHILE DUP C@ ?separator WHILENOT C+ REPEAT THEN -ROT DROP DDUP - ;
\ выделить из строки подстроку, содержащую пару лексем, \ вернуть ключевое слово : _pair> ( a1 a2 asc1 # --> a1 a2 asc1 #1 asc2 # asc3 # ) DROP >L skipsp DDROP nextlx D>R DUP L@ - L> SWAP DR> ;
\ выделить из строки подстроку, содержащую тройку лексем, \ вернуть последнюю лексему в виде строки asc3 # : _thre> ( a1 a2 asc1 # --> a1 a2 asc1 #1 asc2 # asc3 # ) DROP >L skipsp DDROP nextlx DDROP skipsp DDROP nextlx D>R DUP L@ - L> SWAP DR> ;
\ выделить из строки подстроку, завершенную указанным символом ch : _toch ( a1 a2 asc1 # ch --> a1 a2 asc1 #1 asc2 # ) >L DROP >R BEGIN DDUP > WHILE DUP C@ L@ <> WHILE C+ REPEAT C+ THEN DUP R@ - R> SWAP LDROP ;
\ выделить из строки подстроку, завершенную переводом строки : _eol ( a1 a2 asc1 # --> a1 a2 asc1 #1 asc2 # ) DROP >L BEGIN DDUP > WHILE DUP ?NewLine WHILENOT C+ REPEAT THEN DUP L@ - L> SWAP ;
\ преобразовать цвет в строку : c>s" ( color --> x asc # ) 8 LSHIFT SP@ 2 ;
USER-VALUE prevcol \ предыдущий цвет
\ переменная для хранения vId временного словаря для хранения правил расцветки USER-VALUE cvid
\ вернуть id временного словаря : cVid ( --> vID ) cvid *IF ;THEN DROP ALSO HEAP DEFINITIONS s" RULES" SVOCAB DUP TO cvid DUP MOUNT RECENT ;
\ удалить содержимое временного словаря : Remove ( vId --> ) DUP DUP [ ALSO HIDDEN ] off_umount PERFORM [ PREVIOUS ] ALSO MOUNT PREVIOUS ;
\ создание правила расцветки : rule: ( color / name --> ) DUP >L c>s" ALSO cVid WITH THIS [COMPILE] : ;
\ создание правила расцветки имя задается строкой со счетчиком : ruleS: ( asc # color --> ) >L D>R L@ c>s" ALSO cVid WITH THIS DR> S: NOOP ;
\ завершение правила расцветки : ;r ( x asc # --> ) SLIT, DROP [COMPILE] ; DEFINITIONS L> TO prevcol ; IMMEDIATE
\ правило для расцветки одиночных имен : ones: ( color / name --> ) rule: [COMPILE] ;r ;
\ правило для расцветки пары имен : pair: ( color / name --> ) rule: COMPILE _pair> COMPILE DDROP [COMPILE] ;r ;
\ выполнить над всеми словами до конца строки действие name c параметром color : All ( color / name lex1 lex2 .. lexN --> ) >L ' >L <: BEGIN SeeForw NIP WHILE DL@ EXECUTE REPEAT LDROP LDROP ;> Cr_ PARSE ROT EVALUATE-WITH ;
0 VALUE ?State
Color{
Gray CONSTANT StdBG \ стандартный цвет фона
\ получить цвет из комбинации цвета текста и цвета фона : FONE ( color fone --> ) Fone + ;
\ добавить к цвету стандартный фон : OnBG ( color --> color ) StdBG DDUP = IF 0xF XOR THEN \ если цвета совпадают, инвертировать фон Fone + ;
\ выбор цветов для различных групп слов White OnBG CONSTANT control's Magenta Light OnBG CONSTANT vocab's Yellow Black FONE CONSTANT vocdef's Gray Light OnBG CONSTANT simple's Brown OnBG CONSTANT local's Brown OnBG CONSTANT filed's Yellow OnBG CONSTANT def's Red Light OnBG CONSTANT danger's Red Light OnBG CONSTANT errmes's Green Light OnBG CONSTANT literal's Blue Light Black FONE CONSTANT format's Cyan Light OnBG CONSTANT confer's Cyan OnBG CONSTANT comment's Blue OnBG CONSTANT diagram's
Gray Light Black FONE CONSTANT newdef's
Blue Light Gray Light FONE CONSTANT hilight's
\ автоматическое добавление правил при разборе текста : dodef _pair> newdef's ruleS: [COMPILE] ;r ; : dovoc _pair> vocab's ruleS: [COMPILE] ;r ; : dofld _pair> filed's ruleS: [COMPILE] ;r ; : donew _pair> newdef's ruleS: [COMPILE] ;r ; : doals _thre> newdef's ruleS: [COMPILE] ;r ;
( a1 a2 asc1 # --> a1 a2 asc1 #1 asc2 # ) \ цвет имен, правила расцветки для которых не определены Gray OnBG : undefcode [ c>s" SLIT, DROP ] ; \ цвет пробельных символов StdBG 1 + OnBG : spaces [ c>s" SLIT, DROP ] ; \ цвет литералов (чисел, строк, адресов, символов, т.п.) literal's : litcode [ c>s" SLIT, DROP ] ;
RECENT
\ вернуть тег расцветки : ?color ( a1 a2 asc1 #1 --> a1 a2 asc1 #1 asc2 #2 ) DDUP cVid ( WHO CVID) SEARCH-NAME *IF LINK>C EXECUTE ;THEN DROP
DDUP [ ALSO HIDDEN ] snNumber [ PREVIOUS ] \ если число *IF NIP 2 = IF DROP THEN litcode ;THEN DROP
OVER s" off_" TUCK COMPARE IFNOT litcode ;THEN \ если строка начинаестя с "off_" OVER s" to_" TUCK COMPARE IFNOT litcode ;THEN \ если строка начинаестя с "to_"
OVER C@ [CHAR] / = IF litcode ;THEN \ если строка начинается со "\"
undefcode ;
\ преобразовать : colorify ( asc # --> asc # ) BOUNDS cinit >L BEGIN DDUP > WHILE skipsp *IF spaces L@ >Buffer DROP THEN L@ >Buffer DROP nextlx ?color L@ >Buffer DROP L@ >Buffer DROP REPEAT DDROP L> Buffer> ;
\ создать новую запись в хипе, скопировать туда содержимое строки ? : new ( asc # --> str ) colorify DUP line /size + BLOCK >L TUCK L@ line off_body SWAP CMOVE L@ line off_size ! nil L@ !prev nil L@ !next L> ;
\ добавить строку в конец текста : push ( str --> ) LastLine A@ OVER !prev DUP LastLine A@ !next LastLine A! ;
\ задать начальное состояние : set ( str --> ) DUP 1stLine A! DUP LastLine A! TopLine A! ;
\ добавить строку в конец списка строк : add ( str --> ) 1stLine @ IF push ;THEN set ;
\ вернуть адрес конца подстроки : part ( a1 a2 --> a3 ) BEGIN DDUP > WHILE DUP B@ WHILE 1 + REPEAT THEN NIP ;
\ вернуть цвет из начала указанной строки, пропустить цветовую информацию : @col ( a1 --> a2 c ) 1 + DUP B@ 0:1 D+ ;
\ выделить из начала строки, ограниченной адресами a1 a2 раскрашенную в цвет C подстроку asc # \ исключить из начала исходной строки выделенную подстроку : lex ( a1 a2 --> a1 a4 asc # c ) @col >L DDUP part TUCK OVER - L> ;
\ длинная строка пробелов CREATE spaceS MaxWidth <| FOR Bl_ KEEP TILL |> S, ;CREATE
\ отобразить с текущей позиции курсора указанное количество \ пробельных символов фонового цвета : cSpaces ( # --> ) *IF spaceS SWAP spaces DROP 1 + B@ CTYPE ;THEN DROP ;
\ вывести строку asc # в консоль максимально допустимая длина строки s символов : cType] ( asc # s --> ) >L BEGIN DDUP > WHILE lex L@ THRID - -IF DROP NIP L> SWAP CTYPE DDROP ;THEN LDROP >L CTYPE REPEAT DDROP L> cSpaces ;
\ вывести строку asc # в консоль длина отображаемой строки u символов \ если строка длиннее - обрезать, если короче - дополнить пробелами : >cType] ( asc # s u --> ) >L -ROT BOUNDS THRID >R BEGIN DDUP > WHILE lex L@ THRID - -IF DROP -ROT L> SKIPn DUP >L R> MIN ROT CTYPE ROT L> - 0 MAX cType] ;THEN LDROP >L TDROP REPEAT RDROP LDROP ROT cType] ;
\ отобразить текст в окне начиная с позиции up top размером width height \ текст сместить от начала строк на x позиций : show ( width disp TopLine up top height --> ) FOR DDUP setxy D>L THRID THRID THRID IF THRID str> DSWAP >cType] next ELSE spaces DSWAP >cType] THEN DL> 1 + TILL 5 nDROP ;
\ освободить занимаемую память : free ( 1stLine --> ) A@ BEGIN *WHILE DUP next SWAP FREE DROP REPEAT DROP nil set ;
\ загрузка строк из файла : load ( asc # --> ) FILE>HEAP IFNOT ERROR" Invalid file name!" THEN OVER >L <: BOUNDS SWAP BEGIN DDUP < WHILE DDUP EOL> -ROT THRID ROT TUCK - -EOL ['] new CATCH IF 1stLine free ERROR" Not enought memory!" THEN add REPEAT DDROP ;> CATCH L> FREE DROP THROW ;
\ сместить окно на одну линию вверх : TopUp ( --> ) TopLine A@ prev *IF TopLine A! ELSE DROP THEN ;
\ сместить окно на одну линию вниз : TopDn ( --> ) TopLine A@ next *IF TopLine A! ELSE DROP THEN ;
\ на одну страницу вверх : PgUp ( --> ) Height FOR TopUp TILL ;
\ на одну страницу вниз : PgDn ( --> ) Height FOR TopDn TILL ;
\ отслеживание изменение размеров экрана (отображаемой области) : scr# ( --> ) width Up - 2 - TO Width height Top - 2 - TO Height ;
\ обработка событий нажатий клавиш : reflex ( key --> flag ) CASE key' esc OF ERROR" Ok." ENDOF key' dn OF TopDn TRUE ENDOF key' up OF TopUp TRUE ENDOF key' right OF Displ 1 + MaxWidth Width - MIN TO Displ TRUE ENDOF key' left OF Displ 1 - 0 MAX TO Displ TRUE ENDOF key' pgup OF PgUp TRUE ENDOF key' pgdn OF PgDn TRUE ENDOF key' home OF 1stLine A@ TopLine A! TRUE ENDOF key' end OF LastLine A@ TopLine A! TRUE ENDOF scr# DROP FALSE ENDCASE ;
\ отобразить страницу текста в окне : ~Page ( --> ) Width Displ TopLine A@ Up Top Height show ;
\ главный рабочий цикл :> Viewer ( --> ) ~Page BEGIN key? IF SYSKEY reflex IF ~Page THEN \ отрисовка только в случае изменений THEN 10 PAUSE AGAIN ; F: } ;F
\ загрузить файл правил расцветки : LoadRules ( asc #--> ) Color{ [COMPILE] View{ INCLUDED [ PREVIOUS ] PREVIOUS ;
EndUnit
POCKET FileName \ для хранения имени файла
\ отобразить содержимое указанного файла : VIEW ( asc # --> ) FileName <| s" file: " KEEPS KEEPS |> ~title View{ s" color.rule" LoadRules 0 FileName load HideCur scr# Viewer CATCH DROP 1stLine free ShowCur cVid Remove } ;
source file: color.rule \ правила расцветки исходных текстов m0leg 22.07.2013
\ ?init: ?stop ADMIT DEF N?DEFINED init: \ пока не понятно как с ними быть
\ имена словарей и слова работающие с ними vocab's All ones: FORTH NUMBERS ROOT HIDDEN HEAP IMPORT FORTH-WORDLIST vocab's All ones: ALSO ONLY only SEAL PREVIOUS WITH INSIDE UNDER vocab's All ones: CURRENT GET-CURRENT DEFINITIONS RECENT THIS SVOCAB vocab's All ones: UNMOUNT MOUNT RMVID init-order vocab's All ones: CONTEXT SAVE-ORDER RESTORE-ORDER SET-CURRENT SET-ORDER
\ подсветка слов управляющих структур control's All ones: BEGIN WHILE WHILENOT *WHILE REPEAT AGAIN UNTIL control's All ones: IF -IF *IF IFNOT ELSE THEN control's All ones: CASE OF uOF ENDOF ENDCASE control's All ones: NOW SINCE FOR TILL NEXT control's All ones: DO ?DO LOOP +LOOP LEAVE I J control's All ones: SWITCH: ;SWITCH
\ простые имена из словаря FORTH simple's All ones: !voc-flag (1С=) (<C) (ABORT) (ACCEPT) (ALLOCATE) (API-CODE) simple's All ones: #TIB ! (Allot) (BOX) (BYE) (C!) (C#) (C+) (C@) (CLOSE-FILE) simple's All ones: (CONSOLE-HANDLES) (CONST) (CR) (DLIT) (DOES) (EMIT) (ENTER) simple's All ones: (CREATE) (EXC) (INCLUDED) (FREE) (INIT) (INTERPRET) (PAIRS) simple's All ones: (EvalSrc) (READ-LINE) (QUIT) (JOIN) (LIT) (OPTIONS) (PAUSE) simple's All ones: (OK) ([) (MESSAGE) (REFILL) (SYSMSG>) (TYPE) (USER) (TITLE) simple's All ones: (]) (check-voc) (code) (conclude) (flag) (get-attr) (mount) simple's All ones: (d.) (id>asc) (invalid) (iso-<c) (iso-c!) (iso-c#) (iso-c+) simple's All ones: (iso-c@) (latest) (link-voc) (name) (prev) (prompt) (vdlit) simple's All ones: (n.) (sHeader) (set-attr) (uvalue) (size) (switch) (ustore) simple's All ones: (store) (value) (vlit) (voc-search) (~ERROR) (~EXC) *BRANCH simple's All ones: (~Place) * + +! , - -1 -BRANCH -ROT . / <BACK <C <> >NUMBER simple's All ones: < <EOL <EXC-DUMP> <MAIN> <MARK <Node <RESOLVE >List ?BRANCH simple's All ones: <resolve >ASCIIZ >ASCIIZ> >CIPHER ?ABSENT >MARK >IN >stderr simple's All ones: > = >UPPER >lower >number >DIGIT ?BIT ?COMP ?LockMutex @API simple's All ones: ?COMPLETE ?EXEC ?EXISTS ?SMUDGED ?LINES ?SHEADER ?separator simple's All ones: ?hex-pref ?IMMEDIATE ?SIGN ?STACK ?NewLine ?WORD @ @ATTR A! simple's All ones: ?NOTFOUND ?UNIQUE A, ABS ACCEPT ACHANGE ALIGN-BYTES ALIGNED simple's All ones: A@ ADDR, ALIGN ALLOCATE ALLOT ANSI><OEM ANSI>OEM ASCIIZ> B@ simple's All ones: AND API-CALL AR@ ApiAddr ATIB AddExHandler BOUNDS BRANCH C! simple's All ones: AT-SOURCE B! B, CMOVE BASE@ BETWEEN BIT CLOSE-FILE C# C+ C, simple's All ones: C@ CALL, CELLS CHANGE CODE-ALIGN CIPHER CONSOLE-HANDLES DS/ simple's All ones: COMPARE COMPARE-NAMES COMPILE COMPILE, CONSIDER CREATE-FILE simple's All ones: CSTREAM CURSRC CUT-PATH COUNT CharCode CR CharAddr CookLine simple's All ones: CookAsc D! CONTENT CompBuf D+ D, D. DABS DDROP DECODE-ERROR simple's All ones: DIGIT DLIT, DOVER DSWAP CloseSource D@ DLITERAL DTUCK ERASE simple's All ones: dliteral DNEGATE DNIP DP DDUP DROP EVAL-TOKEN EXIT, FREFILL simple's All ones: DU* FENCE EMIT EOL> ER-A ER-U ERRORS EvalSrcWith ExitSource simple's All ones: F>HEAP FILE-POSITION FILE>HEAP DUP FileSource FindThread H. simple's All ones: EvalSource FILL HASH ID>ASC INTERPRET IN-EXCEPTION INCLUDED simple's All ones: ISO> HANDLER HERE HLD INI-FILE FREE GET-ATTR FRAME INIT-MEM simple's All ones: INIT? INPUT-STREAM JUMP, LAST-NAME LINK>XTI LIT, LP@ LSHIFT simple's All ones: LAST LATEST LEXEME LINK-VOC LinkLast LINK> LoadDll MISSTILL simple's All ones: LoadInit LoadMess MESSAGE MAX LINK>C MissOne MissSeparators simple's All ones: MOD MissLexeme ModuleDirName NEGATE MIN ModuleName N?BRANCH simple's All ones: NewSource N. NEW-WORDLIST NIP MAINX NEXT-WORD NOOP NOTFOUND simple's All ones: NextChar NextOne NextWord MSG-FILE OEM>ANSI OFF OK ON PARSE simple's All ones: ON-SOURCE-EXIT ON-SOURCE-START PassLexeme OVER QUIT PAD-TOP simple's All ones: PAUSE PIECE OPTIONS OPEN-FILE OPEN-FILE-SHARED PAD PeekChar simple's All ones: OR PRESENT PROCESS PROMPT ParseFileName REFILL-STDIN RECOIL simple's All ones: REGULAR PeekOne ProcessHeap READ-FILE QUEST REPOSITION-FILE simple's All ones: READ-LINE RSHIFT REF, ROUND RET, REFILL PLACE RESOLVE> REST simple's All ones: ROT RdLine S", S>VAL S-O REF! REF@ S, SEARCH S>HEAP SA SAVE simple's All ones: SCNT! SCNT, SET-ATTR SCOPY SDP S>D SIGN SKIP1 SKIPn SOURCE! simple's All ones: SCNT@ SEARCH-NAME SEEN-ERROR SFIND TLS-INIT SOURCE-NAME SP@ simple's All ones: SLIT, SWAP TOKEN@ TDROP TIB TOKEN! SpaceLine StrSource TUCK simple's All ones: SetSource SOURCE SYSMSG> USER-HERE TlsIndex@ TranslateFlow simple's All ones: TYPE U. U< U> U>D UA! UA@ VLISTUM/MOD SkipChar UNLINK-LAST simple's All ones: USER-ALLOT USER-OFFS USER-PLACE atod UnlockMutex WRITE-FILE simple's All ones: VIEWPOINT WITHIN VOC-LIST W! WIN-ERR UM* controls WINAPLINK simple's All ones: WaitUnlock Waiting WithList XOR aGetChar create-file expose simple's All ones: W, W@ cmdline> cur-err-h entry equivalent is_path_delimiter simple's All ones: err-handler find-msg-body check-voc suNumber voc-table ~fha simple's All ones: find-msg-num identify init-input literal last-number linkto simple's All ones: no-umount last-msg load-messages msg-list reffered no-mount simple's All ones: num-msg new-msg nDROP prefer restore restore-: s## s?number simple's All ones: sFindIn sNumLfa save-dp search-thread system_buff source-id simple's All ones: state stream-type ~ErrPlace snNumber unique-msg vAllot simple's All ones: THRID setxy getxy
\ литералы literal's All ones: #compbuf #err-handlers &ALS &DAS &IMM &NON &PRI &SMG &code literal's All ones: &VOC &name &prev &size &v-dyn &v-std &vinit /cfa /lfa /ffa literal's All ones: /header /SrcRec /msgRecord /nfa /sList /source /vocabulary literal's All ones: /chartype /vtable /winrec /wordlist H-STDIN BUILD-DATE Bl_ literal's All ones: IMAGE-BEGIN CELL CFL Cr_ H-STDERR H-STDOUT IMAGE-BASE ADDR literal's All ones: C/L FALSE REF LIMIT R/W LTL Lf_ MESS? NewLine OS> PAD# R/O literal's All ones: L0 LT R0 S0 SCNT# THREADS# TLS# TOKEN comma Tab_ WORDLISTS literal's All ones: TRUE VERSION W/O imm_word point std_word tab# nil
\ слова для работы с локальным стеком данных local's All ones: >L L> L@ LDUP LDROP DL@ D>L { } AL@ A>L AL> AL+ ALDROP ALDUP local's All ones: DL> L+
\ def's All ones: EndStruct EndUnit DOES> CREATED ?EXIT <: ;> EXIT ;THEN SHEADER def's All ones: ;CREATE /struct HEADER WORDLIST
\ потенциально опасные слова, требующие внимания и обработка исключений danger's All ones: >R R> R@ RDROP R+ DR> D>R A>R AR> DR@ ARDROP N>R NR> rnDROP danger's All ones: EXECUTE PERFORM JUMP LEAP CATCH THROW DEMAND REJECT ERROR danger's All ones: IMMEDIATE unfeasible SMUDGE HIDE IT-DOES PRIMITIVE VOC 0>R' danger's All ones: LITERAL WARNING >STDERR CR>ERR ON-ERROR EXIT-ERROR ON-CATCH danger's All ones: BYE HALT ERR-EXIT ExitProcess FATAL-HANDLER danger's All ones: HEX BASE DECIMAL always danger's All ones: [IF] [ELSE] [THEN] ' [ ] danger's All ones: ClearDStack ClearLStack LP! SP! RP! RP@ FS! FS@ TlsIndex!
\ подсветка отладочных определений hilight's All ones: .S DUMP DUMP~ ORDER
\ форматное преобразование чисел и строк format's All ones: {# <# # #S HOLD HOLDS #> #} <| KEEP KEEPS |> BLANK BLANKS
\ работа с VALUE и VECT переменными confer's All pair: TO IS FROM HAS
\ литералы literal's All pair: [CHAR] [COMPILE] WHO ['] LFA CHAR" 1CHAR= ^
\ подключаемые библиотеки literal's All pair: rel/ root/ vocs/ os/ branch/ memory/ string/ transl/ literal's All pair: math/ exc/ stack/ util/
\ --------------------- более сложные правила расцветки ----------------------- comment's rule: \ _eol ;r \ коментарий до конца строки hilight's rule: \? _eol ;r \ подсвеченый коментарий hilight's rule: \! _eol ;r \ подсвеченый коментарий
literal's rule: s" [CHAR] " _toch ;r \ однострочные строковые литералы literal's rule: S" [CHAR] " _toch ;r \ однострочные строковые литералы
diagram's rule: ( [CHAR] ) _toch ;r \ однострочные стековые коментарии
literal's rule: .( [CHAR] ) _toch ;r \ однострочные сообщения literal's rule: ." [CHAR] " _toch ;r \ однострочные сообщения
literal's rule: STRING" [CHAR] " _toch ;r \ строка сообщения
errmes's rule: ERROR" [CHAR] " _toch ;r \ сообщение об ошибке errmes's rule: ABORT" [CHAR] " _toch ;r \ сообщение об ошибке
literal's rule: NOTICE" [CHAR] " _toch ;r \ строка сообщения
\ следущие определения автоматически добавляют в словарь правила раскраски
\ определения различных переменных s" USER" def's ruleS: dodef ;r s" VALUE" def's ruleS: dodef ;r s" DVALUE" def's ruleS: dodef ;r s" VARIABLE" def's ruleS: dodef ;r s" DVARIABLE" def's ruleS: dodef ;r s" USER-VALUE" def's ruleS: dodef ;r s" USER-DVAL" def's ruleS: dodef ;r s" CONSTANT" def's ruleS: dodef ;r s" VECT" def's ruleS: dodef ;r s" DEFER" def's ruleS: dodef ;r s" USER-VECT" def's ruleS: dodef ;r s" USER-CREATE" def's ruleS: dodef ;r s" CREATE" def's ruleS: dodef ;r s" POCKET" def's ruleS: dodef ;r
s" ALIAS" def's ruleS: doals ;r
\ создание словарей s" Unit:" vocdef's ruleS: dovoc ;r s" VOCABULARY" vocdef's ruleS: dovoc ;r s" CONTAINER" vocdef's ruleS: dovoc ;r s" Struct:" vocdef's ruleS: dovoc ;r s" struct:" vocdef's ruleS: dovoc ;r
\ поля структур s" Cell[]" filed's ruleS: dofld ;r s" Addr[]" filed's ruleS: dofld ;r s" Zero[]" filed's ruleS: dofld ;r s" addr[]" filed's ruleS: dofld ;r s" byte[]" filed's ruleS: dofld ;r s" --" filed's ruleS: dofld ;r
\ определяющие слова s" :" def's ruleS: ?State IFNOT donew TRUE TO ?State THEN ;r s" :>" def's ruleS: ?State IFNOT donew TRUE TO ?State THEN ;r s" S:" def's ruleS: ?State IFNOT donew TRUE TO ?State THEN ;r s" F:" def's ruleS: ?State IFNOT donew TRUE TO ?State THEN ;r
\ слова завершающие определения s" ;" def's ruleS: FALSE TO ?State ;r s" ;F" def's ruleS: FALSE TO ?State ;r s" ;stop" def's ruleS: FALSE TO ?State ;r
Продолжаю баловаться. Теперь правила раскраски в отдельном файле, имена, определенные в просматриватриваемом файле автоматически расцвечиваются, правда есть побочные эффекты в случае повторного определения слов. Вообще, так как файл по сути интерпретируестя правила расцветки ограничиваются фантазией. p.s. не делал многострочные строковые литералы и коментарии. для того, чтобы текст выглядел контрастно нужно в свойствах окна поправить значение серого цвета со 128 128 128 на 80 80 80
[pre]source file: view.fts [b][color=#808080]\ 02.07.2013 ~mOleg[/color] [color=#808080]\ Copyright [C] 2013 mOleg mOlegg@ya.ru[/color] [color=#808080]\ просмотрщик текстовых файлов с раскраской исходников[/color]
[color=#00F000]vocs/ unit.fts[/color] [color=#00F000]vocs/ struct.fts[/color] [color=#00F000]os/ heap.fts[/color] [color=#00F000]os/ console.fts[/color] [color=#00F000]os/ ccon.fts[/color] [color=#00F000]branch/ for-next.fts[/color] [color=#00F000]memory/ buff.fts[/color] [color=#00F000]memory/ pocket.fts[/color] [color=#808080]\ rel/ keys.fts[/color]
[color=#FF00FF]ALSO[/color] [color=#FF00FF]HIDDEN[/color] [color=#FF8000]ALIAS EKEY SYSKEY[/color] [color=#FF8000]ALIAS EKEY? key?[/color] [color=#FF00FF]PREVIOUS[/color]
[color=#FF8000]Unit: key'[/color]
[color=#FF8000]F: esc[/color] [color=#00F000]0x101001B[/color] [color=#FF8000];F[/color] [color=#FF8000]F: up[/color] [color=#00F000]0x1480000[/color] [color=#FF8000];F[/color] [color=#FF8000]F: dn[/color] [color=#00F000]0x1500000[/color] [color=#FF8000];F[/color] [color=#FF8000]F: left[/color] [color=#00F000]0x14B0000[/color] [color=#FF8000];F[/color] [color=#FF8000]F: right[/color] [color=#00F000]0x14D0000[/color] [color=#FF8000];F[/color]
[color=#FF8000]F: home[/color] [color=#00F000]0x1470000[/color] [color=#FF8000];F[/color] [color=#FF8000]F: end[/color] [color=#00F000]0x14F0000[/color] [color=#FF8000];F[/color] [color=#FF8000]F: pgup[/color] [color=#00F000]0x1490000[/color] [color=#FF8000];F[/color] [color=#FF8000]F: pgdn[/color] [color=#00F000]0x1510000[/color] [color=#FF8000];F[/color] [color=#FF8000]EndUnit[/color]
[color=#FF8000]Unit: View{[/color]
[color=#FF8000]USER 1stLine[/color] [color=#808080]\ первая линия текста[/color] [color=#FF8000]USER LastLine[/color] [color=#808080]\ последняя линия текста[/color] [color=#FF8000]USER TopLine[/color] [color=#808080]\ первая отображаемая линия текста[/color]
[color=#00F000]70[/color] [color=#FF8000]VALUE Width[/color] [color=#808080]\ ширина рабочей области экрана[/color] [color=#00F000]0[/color] [color=#FF8000]VALUE Displ[/color] [color=#808080]\ смещение первого отображаемого символа от начала строки[/color] [color=#00F000]2[/color] [color=#FF8000]VALUE Up[/color] [color=#808080]\ положение первого символа окна просмотра слева[/color] [color=#00F000]2[/color] [color=#FF8000]VALUE Top[/color] [color=#808080]\ и сверху[/color] [color=#00F000]25[/color] [color=#FF8000]VALUE Height[/color] [color=#808080]\ высота рабочей области экрана[/color] [color=#00F000]255[/color] [color=#FF8000]VALUE MaxWidth[/color] [color=#808080]\ максимальная длина строки[/color]
[color=#808080]\ каждая линия хранится отдельно[/color] [color=#00F000]0[/color] [color=#FF8000]Struct: line[/color] [color=#808000]Addr[] off_prev[/color] [color=#808080]\ ссылка на предыдущую линию текста[/color] [color=#808000]Addr[] off_next[/color] [color=#808080]\ ссылка на следующую линию текста[/color] [color=#808000]Cell[] off_size[/color] [color=#808080]\ длина строки[/color] [color=#808000]Zero[] off_body[/color] [color=#808080]\ начало текста[/color] [color=#FF8000]EndStruct[/color]
[color=#808080]\ получить указатель на следующую линию текста[/color] [color=#FF8000]: next[/color] [color=#0080C0]( str --> str | nil )[/color] line off_next A@ [color=#FF8000];[/color]
[color=#808080]\ задать ссылку str2 на следующую строку str1[/color] [color=#FF8000]: !next[/color] [color=#0080C0]( str1 str2 --> )[/color] line off_next A! [color=#FF8000];[/color]
[color=#808080]\ получить указатель на предыдущую линию текста[/color] [color=#FF8000]: prev[/color] [color=#0080C0]( str --> str | nil )[/color] line off_prev A@ [color=#FF8000];[/color]
[color=#808080]\ задать ссылку str2 на предыдущую строку str1[/color] [color=#FF8000]: !prev[/color] [color=#0080C0]( str1 str2 --> )[/color] line off_prev A! [color=#FF8000];[/color]
[color=#808080]\ вернуть начало a2 и a1 конец строки ?[/color] [color=#FF8000]: str>[/color] [color=#0080C0]( str --> asc # )[/color] DUP line off_size @ SWAP line off_body SWAP [color=#FF8000];[/color]
[color=#FF8000]USER-VALUE cbuff[/color] [color=#808080]\ временный буфер[/color]
[color=#808080]\ инициализация буфера[/color] [color=#FF8000]: cinit[/color] [color=#0080C0]( --> buff )[/color] cbuff [color=#00A0A0]*IF[/color] DUP Clean [color=#FF8000];THEN[/color] DROP MaxWidth Buffer DUP TO cbuff [color=#FF8000];[/color]
[color=#808080]\ Выделить лидирующие пробельные символы[/color] [color=#FF8000]: skipsp[/color] [color=#0080C0]( a1 a2 --> a1 a2 str # )[/color] DDUP [color=#00A0A0]BEGIN[/color] DDUP > [color=#00A0A0]WHILE[/color] DUP C@ ?separator [color=#00A0A0]WHILE[/color] C+ [color=#00A0A0]REPEAT[/color] [color=#00A0A0]THEN[/color] -ROT DROP DDUP - [color=#FF8000];[/color]
[color=#808080]\ Выделить лидирующие непробельные символы[/color] [color=#FF8000]: nextlx[/color] [color=#0080C0]( a1 a2 --> a1 a2 asc # )[/color] DDUP [color=#00A0A0]BEGIN[/color] DDUP > [color=#00A0A0]WHILE[/color] DUP C@ ?separator [color=#00A0A0]WHILENOT[/color] C+ [color=#00A0A0]REPEAT[/color] [color=#00A0A0]THEN[/color] -ROT DROP DDUP - [color=#FF8000];[/color]
[color=#808080]\ выделить из строки подстроку, содержащую пару лексем,[/color] [color=#808080]\ вернуть ключевое слово[/color] [color=#FF8000]: _pair>[/color] [color=#0080C0]( a1 a2 asc1 # --> a1 a2 asc1 #1 asc2 # asc3 # )[/color] DROP >L skipsp DDROP nextlx D>R DUP L@ - L> SWAP DR> [color=#FF8000];[/color]
[color=#808080]\ выделить из строки подстроку, содержащую тройку лексем,[/color] [color=#808080]\ вернуть последнюю лексему в виде строки asc3 #[/color] [color=#FF8000]: _thre>[/color] [color=#0080C0]( a1 a2 asc1 # --> a1 a2 asc1 #1 asc2 # asc3 # )[/color] DROP >L skipsp DDROP nextlx DDROP skipsp DDROP nextlx D>R DUP L@ - L> SWAP DR> [color=#FF8000];[/color]
[color=#808080]\ выделить из строки подстроку, завершенную указанным символом ch[/color] [color=#FF8000]: _toch[/color] [color=#0080C0]( a1 a2 asc1 # ch --> a1 a2 asc1 #1 asc2 # )[/color] >L DROP [color=#C00000]>R[/color] [color=#00A0A0]BEGIN[/color] DDUP > [color=#00A0A0]WHILE[/color] DUP C@ L@ <> [color=#00A0A0]WHILE[/color] C+ [color=#00A0A0]REPEAT[/color] C+ [color=#00A0A0]THEN[/color] DUP R@ - [color=#C00000]R>[/color] SWAP LDROP [color=#FF8000];[/color]
[color=#808080]\ выделить из строки подстроку, завершенную переводом строки[/color] [color=#FF8000]: _eol[/color] [color=#0080C0]( a1 a2 asc1 # --> a1 a2 asc1 #1 asc2 # )[/color] DROP >L [color=#00A0A0]BEGIN[/color] DDUP > [color=#00A0A0]WHILE[/color] DUP ?NewLine [color=#00A0A0]WHILENOT[/color] C+ [color=#00A0A0]REPEAT[/color] [color=#00A0A0]THEN[/color] DUP L@ - L> SWAP [color=#FF8000];[/color]
[color=#808080]\ преобразовать цвет в строку[/color] [color=#FF8000]: c>s"[/color] [color=#0080C0]( color --> x asc # )[/color] [color=#00F000]8[/color] LSHIFT SP@ [color=#00F000]2[/color] [color=#FF8000];[/color]
[color=#FF8000]USER-VALUE prevcol[/color] [color=#808080]\ предыдущий цвет[/color]
[color=#808080]\ переменная для хранения vId временного словаря для хранения правил расцветки[/color] [color=#FF8000]USER-VALUE cvid[/color]
[color=#808080]\ вернуть id временного словаря[/color] [color=#FF8000]: cVid[/color] [color=#0080C0]( --> vID )[/color] cvid [color=#00A0A0]*IF[/color] [color=#FF8000];THEN[/color] DROP [color=#FF00FF]ALSO[/color] HEAP [color=#FF00FF]DEFINITIONS[/color] [color=#00F000]s" RULES"[/color] SVOCAB DUP TO cvid DUP MOUNT [color=#FF00FF]RECENT[/color] [color=#FF8000];[/color]
[color=#808080]\ удалить содержимое временного словаря[/color] [color=#FF8000]: Remove[/color] [color=#0080C0]( vId --> )[/color] DUP DUP [color=#C00000][[/color] [color=#FF00FF]ALSO[/color] [color=#FF00FF]HIDDEN[/color] [color=#C00000]][/color] off_umount PERFORM [color=#C00000][[/color] [color=#FF00FF]PREVIOUS[/color] [color=#C00000]][/color] [color=#FF00FF]ALSO[/color] MOUNT [color=#FF00FF]PREVIOUS[/color] [color=#FF8000];[/color]
[color=#808080]\ создание правила расцветки[/color] [color=#FF8000]: rule:[/color] [color=#0080C0]( color / name --> )[/color] DUP >L c>s" [color=#FF00FF]ALSO[/color] cVid [color=#FF00FF]WITH[/color] [color=#FF00FF]THIS[/color] [color=#00F000][COMPILE] :[/color] [color=#FF8000];[/color]
[color=#808080]\ создание правила расцветки имя задается строкой со счетчиком[/color] [color=#FF8000]: ruleS:[/color] [color=#0080C0]( asc # color --> )[/color] >L D>R L@ c>s" [color=#FF00FF]ALSO[/color] cVid [color=#FF00FF]WITH[/color] [color=#FF00FF]THIS[/color] DR> [color=#FF8000]S: NOOP[/color] [color=#FF8000];[/color]
[color=#808080]\ завершение правила расцветки[/color] [color=#FF8000]: ;r[/color] [color=#0080C0]( x asc # --> )[/color] SLIT, DROP [color=#00F000][COMPILE] ;[/color] [color=#FF00FF]DEFINITIONS[/color] L> TO prevcol [color=#FF8000];[/color] [color=#C00000]IMMEDIATE[/color]
[color=#808080]\ правило для расцветки одиночных имен[/color] [color=#FF8000]: ones:[/color] [color=#0080C0]( color / name --> )[/color] [color=#FF8000]rule: [COMPILE][/color] [color=#FF8000];r[/color] [color=#FF8000];[/color]
[color=#808080]\ правило для расцветки пары имен[/color] [color=#FF8000]: pair:[/color] [color=#0080C0]( color / name --> )[/color] [color=#FF8000]rule: COMPILE[/color] _pair> [color=#00F000]COMPILE DDROP[/color] [color=#00F000][COMPILE] ;r[/color] [color=#FF8000];[/color]
[color=#808080]\ выполнить над всеми словами до конца строки действие name c параметром color[/color] [color=#FF8000]: All[/color] [color=#0080C0]( color / name lex1 lex2 .. lexN --> )[/color] >L ' >L [color=#FF8000]<: BEGIN[/color] SeeForw NIP [color=#00A0A0]WHILE[/color] DL@ [color=#C00000]EXECUTE[/color] [color=#00A0A0]REPEAT[/color] LDROP LDROP [color=#FF8000];>[/color] [color=#00F000]Cr_[/color] PARSE ROT EVALUATE-WITH [color=#FF8000];[/color]
[color=#00F000]0[/color] [color=#FF8000]VALUE ?State[/color]
Color{
Gray [color=#FF8000]CONSTANT StdBG[/color] [color=#808080]\ стандартный цвет фона[/color]
[color=#808080]\ получить цвет из комбинации цвета текста и цвета фона[/color] [color=#FF8000]: FONE[/color] [color=#0080C0]( color fone --> )[/color] Fone + [color=#FF8000];[/color]
[color=#808080]\ добавить к цвету стандартный фон[/color] [color=#FF8000]: OnBG[/color] [color=#0080C0]( color --> color )[/color] StdBG DDUP = [color=#00A0A0]IF[/color] [color=#00F000]0xF[/color] XOR [color=#00A0A0]THEN[/color] [color=#808080]\ если цвета совпадают, инвертировать фон[/color] Fone + [color=#FF8000];[/color]
[color=#808080]\ выбор цветов для различных групп слов[/color] White OnBG [color=#FF8000]CONSTANT control's[/color] Magenta Light OnBG [color=#FF8000]CONSTANT vocab's[/color] Yellow Black FONE [color=#FF8000]CONSTANT vocdef's[/color] Gray Light OnBG [color=#FF8000]CONSTANT simple's[/color] Brown OnBG [color=#FF8000]CONSTANT local's[/color] Brown OnBG [color=#FF8000]CONSTANT filed's[/color] Yellow OnBG [color=#FF8000]CONSTANT def's[/color] Red Light OnBG [color=#FF8000]CONSTANT danger's[/color] Red Light OnBG [color=#FF8000]CONSTANT errmes's[/color] Green Light OnBG [color=#FF8000]CONSTANT literal's[/color] Blue Light Black FONE [color=#FF8000]CONSTANT format's[/color] Cyan Light OnBG [color=#FF8000]CONSTANT confer's[/color] Cyan OnBG [color=#FF8000]CONSTANT comment's[/color] Blue OnBG [color=#FF8000]CONSTANT diagram's[/color]
Gray Light Black FONE [color=#FF8000]CONSTANT newdef's[/color]
Blue Light Gray Light FONE [color=#FF8000]CONSTANT hilight's[/color]
[color=#808080]\ автоматическое добавление правил при разборе текста[/color] [color=#FF8000]: dodef[/color] _pair> newdef's [color=#FF8000]ruleS: [COMPILE][/color] [color=#FF8000];r[/color] [color=#FF8000];[/color] [color=#FF8000]: dovoc[/color] _pair> vocab's [color=#FF8000]ruleS: [COMPILE][/color] [color=#FF8000];r[/color] [color=#FF8000];[/color] [color=#FF8000]: dofld[/color] _pair> filed's [color=#FF8000]ruleS: [COMPILE][/color] [color=#FF8000];r[/color] [color=#FF8000];[/color] [color=#FF8000]: donew[/color] _pair> newdef's [color=#FF8000]ruleS: [COMPILE][/color] [color=#FF8000];r[/color] [color=#FF8000];[/color] [color=#FF8000]: doals[/color] _thre> newdef's [color=#FF8000]ruleS: [COMPILE][/color] [color=#FF8000];r[/color] [color=#FF8000];[/color]
[color=#0080C0]( a1 a2 asc1 # --> a1 a2 asc1 #1 asc2 # )[/color] [color=#808080]\ цвет имен, правила расцветки для которых не определены[/color] Gray OnBG [color=#FF8000]: undefcode[/color] [color=#C00000][[/color] c>s" SLIT, DROP [color=#C00000]][/color] [color=#FF8000];[/color] [color=#808080]\ цвет пробельных символов[/color] StdBG [color=#00F000]1[/color] + OnBG [color=#FF8000]: spaces[/color] [color=#C00000][[/color] c>s" SLIT, DROP [color=#C00000]][/color] [color=#FF8000];[/color] [color=#808080]\ цвет литералов (чисел, строк, адресов, символов, т.п.)[/color] literal's [color=#FF8000]: litcode[/color] [color=#C00000][[/color] c>s" SLIT, DROP [color=#C00000]][/color] [color=#FF8000];[/color]
[color=#FF00FF]RECENT[/color]
[color=#808080]\ вернуть тег расцветки[/color] [color=#FF8000]: ?color[/color] [color=#0080C0]( a1 a2 asc1 #1 --> a1 a2 asc1 #1 asc2 #2 )[/color] DDUP cVid [color=#0080C0]( WHO CVID)[/color] SEARCH-NAME [color=#00A0A0]*IF[/color] LINK>C [color=#C00000]EXECUTE[/color] [color=#FF8000];THEN[/color] DROP
DDUP [color=#C00000][[/color] [color=#FF00FF]ALSO[/color] [color=#FF00FF]HIDDEN[/color] [color=#C00000]][/color] snNumber [color=#C00000][[/color] [color=#FF00FF]PREVIOUS[/color] [color=#C00000]][/color] [color=#808080]\ если число[/color] [color=#00A0A0]*IF[/color] NIP [color=#00F000]2[/color] = [color=#00A0A0]IF[/color] DROP [color=#00A0A0]THEN[/color] litcode [color=#FF8000];THEN[/color] DROP
OVER [color=#00F000]s" off_"[/color] TUCK COMPARE [color=#00A0A0]IFNOT[/color] litcode [color=#FF8000];THEN[/color] [color=#808080]\ если строка начинаестя с "off_"[/color] OVER [color=#00F000]s" to_"[/color] TUCK COMPARE [color=#00A0A0]IFNOT[/color] litcode [color=#FF8000];THEN[/color] [color=#808080]\ если строка начинаестя с "to_"[/color]
OVER C@ [color=#00F000][CHAR] /[/color] = [color=#00A0A0]IF[/color] litcode [color=#FF8000];THEN[/color] [color=#808080]\ если строка начинается со "\"[/color]
undefcode [color=#FF8000];[/color]
[color=#808080]\ преобразовать[/color] [color=#FF8000]: colorify[/color] [color=#0080C0]( asc # --> asc # )[/color] BOUNDS cinit >L [color=#00A0A0]BEGIN[/color] DDUP > [color=#00A0A0]WHILE[/color] skipsp [color=#00A0A0]*IF[/color] spaces L@ >Buffer DROP [color=#00A0A0]THEN[/color] L@ >Buffer DROP nextlx ?color L@ >Buffer DROP L@ >Buffer DROP [color=#00A0A0]REPEAT[/color] DDROP L> Buffer> [color=#FF8000];[/color]
[color=#808080]\ создать новую запись в хипе, скопировать туда содержимое строки ?[/color] [color=#FF8000]: new[/color] [color=#0080C0]( asc # --> str )[/color] colorify DUP line /size + BLOCK >L TUCK L@ line off_body SWAP CMOVE L@ line off_size ! nil L@ !prev nil L@ !next L> [color=#FF8000];[/color]
[color=#808080]\ добавить строку в конец текста[/color] [color=#FF8000]: push[/color] [color=#0080C0]( str --> )[/color] LastLine A@ OVER !prev DUP LastLine A@ !next LastLine A! [color=#FF8000];[/color]
[color=#808080]\ задать начальное состояние[/color] [color=#FF8000]: set[/color] [color=#0080C0]( str --> )[/color] DUP 1stLine A! DUP LastLine A! TopLine A! [color=#FF8000];[/color]
[color=#808080]\ добавить строку в конец списка строк[/color] [color=#FF8000]: add[/color] [color=#0080C0]( str --> )[/color] 1stLine @ [color=#00A0A0]IF[/color] push [color=#FF8000];THEN[/color] set [color=#FF8000];[/color]
[color=#808080]\ вернуть адрес конца подстроки[/color] [color=#FF8000]: part[/color] [color=#0080C0]( a1 a2 --> a3 )[/color] [color=#00A0A0]BEGIN[/color] DDUP > [color=#00A0A0]WHILE[/color] DUP B@ [color=#00A0A0]WHILE[/color] [color=#00F000]1[/color] + [color=#00A0A0]REPEAT[/color] [color=#00A0A0]THEN[/color] NIP [color=#FF8000];[/color]
[color=#808080]\ вернуть цвет из начала указанной строки, пропустить цветовую информацию[/color] [color=#FF8000]: @col[/color] [color=#0080C0]( a1 --> a2 c )[/color] [color=#00F000]1[/color] + DUP B@ [color=#00F000]0:1[/color] D+ [color=#FF8000];[/color]
[color=#808080]\ выделить из начала строки, ограниченной адресами a1 a2 раскрашенную в цвет C подстроку asc #[/color] [color=#808080]\ исключить из начала исходной строки выделенную подстроку[/color] [color=#FF8000]: lex[/color] [color=#0080C0]( a1 a2 --> a1 a4 asc # c )[/color] @col >L DDUP part TUCK OVER - L> [color=#FF8000];[/color]
[color=#808080]\ длинная строка пробелов[/color] CREATE spaceS MaxWidth [color=#0000F0]<|[/color] FOR [color=#00F000]Bl_[/color] [color=#0000F0]KEEP[/color] TILL [color=#0000F0]|>[/color] S, [color=#FF8000];CREATE[/color]
[color=#808080]\ отобразить с текущей позиции курсора указанное количество[/color] [color=#808080]\ пробельных символов фонового цвета[/color] [color=#FF8000]: cSpaces[/color] [color=#0080C0]( # --> )[/color] [color=#00A0A0]*IF[/color] spaceS SWAP spaces DROP [color=#00F000]1[/color] + B@ CTYPE [color=#FF8000];THEN[/color] DROP [color=#FF8000];[/color]
[color=#808080]\ вывести строку asc # в консоль максимально допустимая длина строки s символов[/color] [color=#FF8000]: cType][/color] [color=#0080C0]( asc # s --> )[/color] >L [color=#00A0A0]BEGIN[/color] DDUP > [color=#00A0A0]WHILE[/color] lex L@ THRID - [color=#00A0A0]-IF[/color] DROP NIP L> SWAP CTYPE DDROP [color=#FF8000];THEN[/color] LDROP >L CTYPE [color=#00A0A0]REPEAT[/color] DDROP L> cSpaces [color=#FF8000];[/color]
[color=#808080]\ вывести строку asc # в консоль длина отображаемой строки u символов[/color] [color=#808080]\ если строка длиннее - обрезать, если короче - дополнить пробелами[/color] [color=#FF8000]: >cType][/color] [color=#0080C0]( asc # s u --> )[/color] >L -ROT BOUNDS THRID [color=#C00000]>R[/color] [color=#00A0A0]BEGIN[/color] DDUP > [color=#00A0A0]WHILE[/color] lex L@ THRID - [color=#00A0A0]-IF[/color] DROP -ROT L> SKIPn DUP >L [color=#C00000]R>[/color] MIN ROT CTYPE ROT L> - [color=#00F000]0[/color] MAX cType] [color=#FF8000];THEN[/color] LDROP >L TDROP [color=#00A0A0]REPEAT[/color] RDROP LDROP ROT cType] [color=#FF8000];[/color]
[color=#808080]\ отобразить текст в окне начиная с позиции up top размером width height[/color] [color=#808080]\ текст сместить от начала строк на x позиций[/color] [color=#FF8000]: show[/color] [color=#0080C0]( width disp TopLine up top height --> )[/color] FOR DDUP setxy D>L THRID THRID THRID [color=#00A0A0]IF[/color] THRID str> DSWAP >cType] next [color=#00A0A0]ELSE[/color] spaces DSWAP >cType] [color=#00A0A0]THEN[/color] DL> [color=#00F000]1[/color] + TILL [color=#00F000]5[/color] nDROP [color=#FF8000];[/color]
[color=#808080]\ освободить занимаемую память[/color] [color=#FF8000]: free[/color] [color=#0080C0]( 1stLine --> )[/color] A@ [color=#00A0A0]BEGIN[/color] [color=#00A0A0]*WHILE[/color] DUP next SWAP FREE DROP [color=#00A0A0]REPEAT[/color] DROP nil set [color=#FF8000];[/color]
[color=#808080]\ загрузка строк из файла[/color] [color=#FF8000]: load[/color] [color=#0080C0]( asc # --> )[/color] FILE>HEAP [color=#00A0A0]IFNOT[/color] [color=#C00000]ERROR" Invalid file name!"[/color] [color=#00A0A0]THEN[/color] OVER >L [color=#FF8000]<: BOUNDS[/color] SWAP [color=#00A0A0]BEGIN[/color] DDUP < [color=#00A0A0]WHILE[/color] DDUP EOL> -ROT THRID ROT TUCK - -EOL [color=#00F000]['] new[/color] CATCH [color=#00A0A0]IF[/color] 1stLine free [color=#C00000]ERROR" Not enought memory!"[/color] [color=#00A0A0]THEN[/color] add [color=#00A0A0]REPEAT[/color] DDROP [color=#FF8000];>[/color] CATCH L> FREE DROP [color=#C00000]THROW[/color] [color=#FF8000];[/color]
[color=#808080]\ сместить окно на одну линию вверх[/color] [color=#FF8000]: TopUp[/color] [color=#0080C0]( --> )[/color] TopLine A@ prev [color=#00A0A0]*IF[/color] TopLine A! [color=#00A0A0]ELSE[/color] DROP [color=#00A0A0]THEN[/color] [color=#FF8000];[/color]
[color=#808080]\ сместить окно на одну линию вниз[/color] [color=#FF8000]: TopDn[/color] [color=#0080C0]( --> )[/color] TopLine A@ next [color=#00A0A0]*IF[/color] TopLine A! [color=#00A0A0]ELSE[/color] DROP [color=#00A0A0]THEN[/color] [color=#FF8000];[/color]
[color=#808080]\ на одну страницу вверх[/color] [color=#FF8000]: PgUp[/color] [color=#0080C0]( --> )[/color] Height FOR TopUp TILL [color=#FF8000];[/color]
[color=#808080]\ на одну страницу вниз[/color] [color=#FF8000]: PgDn[/color] [color=#0080C0]( --> )[/color] Height FOR TopDn TILL [color=#FF8000];[/color]
[color=#808080]\ отслеживание изменение размеров экрана (отображаемой области)[/color] [color=#FF8000]: scr#[/color] [color=#0080C0]( --> )[/color] width Up - [color=#00F000]2[/color] - TO Width height Top - [color=#00F000]2[/color] - TO Height [color=#FF8000];[/color]
[color=#808080]\ обработка событий нажатий клавиш[/color] [color=#FF8000]: reflex[/color] [color=#0080C0]( key --> flag )[/color] CASE key' esc OF [color=#C00000]ERROR" Ok."[/color] ENDOF key' dn OF TopDn [color=#00F000]TRUE[/color] ENDOF key' up OF TopUp [color=#00F000]TRUE[/color] ENDOF key' right OF Displ [color=#00F000]1[/color] + MaxWidth Width - MIN TO Displ [color=#00F000]TRUE[/color] ENDOF key' left OF Displ [color=#00F000]1[/color] - [color=#00F000]0[/color] MAX TO Displ [color=#00F000]TRUE[/color] ENDOF key' pgup OF PgUp [color=#00F000]TRUE[/color] ENDOF key' pgdn OF PgDn [color=#00F000]TRUE[/color] ENDOF key' home OF 1stLine A@ TopLine A! [color=#00F000]TRUE[/color] ENDOF key' end OF LastLine A@ TopLine A! [color=#00F000]TRUE[/color] ENDOF scr# DROP [color=#00F000]FALSE[/color] ENDCASE [color=#FF8000];[/color]
[color=#808080]\ отобразить страницу текста в окне[/color] [color=#FF8000]: ~Page[/color] [color=#0080C0]( --> )[/color] Width Displ TopLine A@ Up Top Height show [color=#FF8000];[/color]
[color=#808080]\ главный рабочий цикл[/color] [color=#FF8000]:> Viewer[/color] [color=#0080C0]( --> )[/color] ~Page [color=#00A0A0]BEGIN[/color] key? [color=#00A0A0]IF[/color] SYSKEY reflex [color=#00A0A0]IF[/color] ~Page [color=#00A0A0]THEN[/color] [color=#808080]\ отрисовка только в случае изменений[/color] [color=#00A0A0]THEN[/color] [color=#00F000]10[/color] PAUSE [color=#00A0A0]AGAIN[/color] [color=#FF8000];[/color] [color=#FF8000]F: }[/color] [color=#FF8000];F[/color]
[color=#808080]\ загрузить файл правил расцветки[/color] [color=#FF8000]: LoadRules[/color] [color=#0080C0]( asc #--> )[/color] Color{ [color=#00F000][COMPILE] View{[/color] INCLUDED [color=#C00000][[/color] [color=#FF00FF]PREVIOUS[/color] [color=#C00000]][/color] [color=#FF00FF]PREVIOUS[/color] [color=#FF8000];[/color]
[color=#FF8000]EndUnit[/color]
POCKET FileName [color=#808080]\ для хранения имени файла[/color]
[color=#808080]\ отобразить содержимое указанного файла[/color] [color=#FF8000]: VIEW[/color] [color=#0080C0]( asc # --> )[/color] FileName [color=#0000F0]<|[/color] [color=#00F000]s" file: "[/color] [color=#0000F0]KEEPS[/color] [color=#0000F0]KEEPS[/color] [color=#0000F0]|>[/color] ~title View{ [color=#00F000]s" color.rule"[/color] LoadRules [color=#00F000]0[/color] FileName load HideCur scr# Viewer CATCH DROP 1stLine free ShowCur cVid Remove } [color=#FF8000];[/color] [/b][/pre]
[pre]source file: color.rule [b][color=#808080]\ правила расцветки исходных текстов m0leg 22.07.2013[/color]
[color=#808080]\ ?init: ?stop ADMIT DEF N?DEFINED init: \ пока не понятно как с ними быть[/color]
[color=#808080]\ имена словарей и слова работающие с ними[/color] vocab's All [color=#FF8000]ones: FORTH[/color] NUMBERS [color=#FF00FF]ROOT[/color] [color=#FF00FF]HIDDEN[/color] HEAP [color=#FF00FF]IMPORT[/color] FORTH-WORDLIST vocab's All [color=#FF8000]ones: ALSO[/color] [color=#FF00FF]ONLY[/color] only [color=#FF00FF]SEAL[/color] [color=#FF00FF]PREVIOUS[/color] [color=#FF00FF]WITH[/color] INSIDE UNDER vocab's All [color=#FF8000]ones: CURRENT[/color] [color=#FF00FF]GET-CURRENT[/color] [color=#FF00FF]DEFINITIONS[/color] [color=#FF00FF]RECENT[/color] [color=#FF00FF]THIS[/color] SVOCAB vocab's All [color=#FF8000]ones: UNMOUNT[/color] MOUNT RMVID init-order vocab's All [color=#FF8000]ones: CONTEXT[/color] [color=#FF00FF]SAVE-ORDER[/color] [color=#FF00FF]RESTORE-ORDER[/color] [color=#FF00FF]SET-CURRENT[/color] SET-ORDER
[color=#808080]\ подсветка слов управляющих структур[/color] control's All [color=#FF8000]ones: BEGIN[/color] [color=#00A0A0]WHILE[/color] [color=#00A0A0]WHILENOT[/color] [color=#00A0A0]*WHILE[/color] [color=#00A0A0]REPEAT[/color] [color=#00A0A0]AGAIN[/color] [color=#00A0A0]UNTIL[/color] control's All [color=#FF8000]ones: IF[/color] [color=#00A0A0]-IF[/color] [color=#00A0A0]*IF[/color] [color=#00A0A0]IFNOT[/color] [color=#00A0A0]ELSE[/color] [color=#00A0A0]THEN[/color] control's All [color=#FF8000]ones: CASE[/color] OF uOF ENDOF ENDCASE control's All [color=#FF8000]ones: NOW[/color] SINCE FOR TILL NEXT control's All [color=#FF8000]ones: DO[/color] ?DO LOOP +LOOP LEAVE I J control's All [color=#FF8000]ones: SWITCH:[/color] [color=#FF8000];SWITCH[/color]
[color=#808080]\ простые имена из словаря FORTH[/color] simple's All [color=#FF8000]ones: !voc-flag[/color] (1С=) (<C) (ABORT) (ACCEPT) (ALLOCATE) (API-CODE) simple's All [color=#FF8000]ones: #TIB[/color] ! (Allot) (BOX) (BYE) (C!) (C#) (C+) (C@) (CLOSE-FILE) simple's All [color=#FF8000]ones: (CONSOLE-HANDLES)[/color] (CONST) (CR) (DLIT) (DOES) (EMIT) (ENTER) simple's All [color=#FF8000]ones: (CREATE)[/color] (EXC) (INCLUDED) (FREE) (INIT) (INTERPRET) (PAIRS) simple's All [color=#FF8000]ones: (EvalSrc)[/color] (READ-LINE) (QUIT) (JOIN) (LIT) (OPTIONS) (PAUSE) simple's All [color=#FF8000]ones: (OK)[/color] ([) (MESSAGE) (REFILL) (SYSMSG>) (TYPE) (USER) (TITLE) simple's All [color=#FF8000]ones: (])[/color] (check-voc) (code) (conclude) (flag) (get-attr) (mount) simple's All [color=#FF8000]ones: (d.)[/color] (id>asc) (invalid) (iso-<c) (iso-c!) (iso-c#) (iso-c+) simple's All [color=#FF8000]ones: (iso-c@)[/color] (latest) (link-voc) (name) (prev) (prompt) (vdlit) simple's All [color=#FF8000]ones: (n.)[/color] (sHeader) (set-attr) (uvalue) (size) (switch) (ustore) simple's All [color=#FF8000]ones: (store)[/color] (value) (vlit) (voc-search) (~ERROR) (~EXC) *BRANCH simple's All [color=#FF8000]ones: (~Place)[/color] * + +! , - [color=#00F000]-1[/color] -BRANCH -ROT . / <BACK <C <> >NUMBER simple's All [color=#FF8000]ones: <[/color] <EOL <EXC-DUMP> <MAIN> <MARK <Node <RESOLVE >List ?BRANCH simple's All [color=#FF8000]ones: <resolve[/color] >ASCIIZ >ASCIIZ> >CIPHER [color=#C00000]?ABSENT >MARK >IN >stderr[/color] simple's All [color=#FF8000]ones: >[/color] = >UPPER >lower >number >DIGIT ?BIT ?COMP ?LockMutex @API simple's All [color=#FF8000]ones: ?COMPLETE[/color] ?EXEC [color=#C00000]?EXISTS ?SMUDGED ?LINES ?SHEADER ?separator[/color] simple's All [color=#FF8000]ones: ?hex-pref[/color] ?IMMEDIATE ?SIGN ?STACK ?NewLine ?WORD @ @ATTR A! simple's All [color=#FF8000]ones: ?NOTFOUND[/color] ?UNIQUE A, ABS ACCEPT ACHANGE ALIGN-BYTES ALIGNED simple's All [color=#FF8000]ones: A@[/color] ADDR, ALIGN ALLOCATE ALLOT ANSI><OEM ANSI>OEM ASCIIZ> B@ simple's All [color=#FF8000]ones: AND[/color] API-CALL AR@ ApiAddr ATIB AddExHandler BOUNDS BRANCH C! simple's All [color=#FF8000]ones: AT-SOURCE[/color] B! B, CMOVE BASE@ BETWEEN BIT CLOSE-FILE C# C+ C, simple's All [color=#FF8000]ones: C@[/color] CALL, CELLS CHANGE CODE-ALIGN CIPHER CONSOLE-HANDLES DS/ simple's All [color=#FF8000]ones: COMPARE[/color] COMPARE-NAMES [color=#00F000]COMPILE COMPILE,[/color] CONSIDER CREATE-FILE simple's All [color=#FF8000]ones: CSTREAM[/color] CURSRC CUT-PATH COUNT CharCode CR CharAddr CookLine simple's All [color=#FF8000]ones: CookAsc[/color] D! CONTENT CompBuf D+ D, D. DABS DDROP DECODE-ERROR simple's All [color=#FF8000]ones: DIGIT[/color] DLIT, DOVER DSWAP CloseSource D@ DLITERAL DTUCK ERASE simple's All [color=#FF8000]ones: dliteral[/color] DNEGATE DNIP DP DDUP DROP EVAL-TOKEN EXIT, FREFILL simple's All [color=#FF8000]ones: DU*[/color] FENCE EMIT EOL> ER-A ER-U ERRORS EvalSrcWith ExitSource simple's All [color=#FF8000]ones: F>HEAP[/color] FILE-POSITION FILE>HEAP DUP FileSource FindThread H. simple's All [color=#FF8000]ones: EvalSource[/color] FILL HASH ID>ASC INTERPRET IN-EXCEPTION INCLUDED simple's All [color=#FF8000]ones: ISO>[/color] HANDLER HERE HLD INI-FILE FREE GET-ATTR FRAME INIT-MEM simple's All [color=#FF8000]ones: INIT?[/color] INPUT-STREAM JUMP, LAST-NAME LINK>XTI LIT, LP@ LSHIFT simple's All [color=#FF8000]ones: LAST[/color] LATEST LEXEME LINK-VOC LinkLast LINK> LoadDll MISSTILL simple's All [color=#FF8000]ones: LoadInit[/color] LoadMess MESSAGE MAX LINK>C MissOne MissSeparators simple's All [color=#FF8000]ones: MOD[/color] MissLexeme ModuleDirName NEGATE MIN ModuleName N?BRANCH simple's All [color=#FF8000]ones: NewSource[/color] N. NEW-WORDLIST NIP MAINX NEXT-WORD NOOP NOTFOUND simple's All [color=#FF8000]ones: NextChar[/color] NextOne NextWord MSG-FILE OEM>ANSI OFF OK ON PARSE simple's All [color=#FF8000]ones: ON-SOURCE-EXIT[/color] ON-SOURCE-START PassLexeme OVER QUIT PAD-TOP simple's All [color=#FF8000]ones: PAUSE[/color] PIECE OPTIONS OPEN-FILE OPEN-FILE-SHARED PAD PeekChar simple's All [color=#FF8000]ones: OR[/color] PRESENT PROCESS PROMPT ParseFileName REFILL-STDIN RECOIL simple's All [color=#FF8000]ones: REGULAR[/color] PeekOne ProcessHeap READ-FILE QUEST REPOSITION-FILE simple's All [color=#FF8000]ones: READ-LINE[/color] RSHIFT REF, ROUND RET, REFILL PLACE RESOLVE> REST simple's All [color=#FF8000]ones: ROT[/color] RdLine S", S>VAL S-O REF! REF@ S, SEARCH S>HEAP SA SAVE simple's All [color=#FF8000]ones: SCNT![/color] SCNT, SET-ATTR SCOPY SDP S>D SIGN SKIP1 SKIPn SOURCE! simple's All [color=#FF8000]ones: SCNT@[/color] SEARCH-NAME SEEN-ERROR SFIND TLS-INIT SOURCE-NAME SP@ simple's All [color=#FF8000]ones: SLIT,[/color] SWAP TOKEN@ TDROP TIB TOKEN! SpaceLine StrSource TUCK simple's All [color=#FF8000]ones: SetSource[/color] SOURCE SYSMSG> USER-HERE TlsIndex@ TranslateFlow simple's All [color=#FF8000]ones: TYPE[/color] U. U< U> U>D UA! UA@ VLISTUM/MOD SkipChar UNLINK-LAST simple's All [color=#FF8000]ones: USER-ALLOT[/color] USER-OFFS USER-PLACE atod UnlockMutex WRITE-FILE simple's All [color=#FF8000]ones: VIEWPOINT[/color] WITHIN VOC-LIST W! WIN-ERR UM* controls WINAPLINK simple's All [color=#FF8000]ones: WaitUnlock[/color] Waiting WithList XOR aGetChar create-file expose simple's All [color=#FF8000]ones: W,[/color] W@ cmdline> cur-err-h entry equivalent is_path_delimiter simple's All [color=#FF8000]ones: err-handler[/color] find-msg-body check-voc suNumber voc-table ~fha simple's All [color=#FF8000]ones: find-msg-num[/color] identify init-input literal last-number linkto simple's All [color=#FF8000]ones: no-umount[/color] last-msg load-messages msg-list reffered no-mount simple's All [color=#FF8000]ones: num-msg[/color] new-msg nDROP prefer restore [color=#FF8000]restore-: s##[/color] s?number simple's All [color=#FF8000]ones: sFindIn[/color] sNumLfa save-dp search-thread system_buff source-id simple's All [color=#FF8000]ones: state[/color] stream-type ~ErrPlace snNumber unique-msg vAllot simple's All [color=#FF8000]ones: THRID[/color] setxy getxy
[color=#808080]\ литералы[/color] literal's All [color=#FF8000]ones: #compbuf[/color] #err-handlers &ALS &DAS &IMM &NON &PRI &SMG &code literal's All [color=#FF8000]ones: &VOC[/color] &name &prev &size &v-dyn &v-std &vinit /cfa /lfa /ffa literal's All [color=#FF8000]ones: /header[/color] /SrcRec /msgRecord /nfa /sList /source /vocabulary literal's All [color=#FF8000]ones: /chartype[/color] /vtable /winrec /wordlist H-STDIN BUILD-DATE [color=#00F000]Bl_[/color] literal's All [color=#FF8000]ones: IMAGE-BEGIN[/color] CELL CFL [color=#00F000]Cr_[/color] H-STDERR H-STDOUT IMAGE-BASE ADDR literal's All [color=#FF8000]ones: C/L[/color] [color=#00F000]FALSE[/color] REF LIMIT R/W LTL [color=#00F000]Lf_[/color] MESS? NewLine OS> PAD# R/O literal's All [color=#FF8000]ones: L0[/color] LT R0 S0 SCNT# THREADS# TLS# TOKEN comma [color=#00F000]Tab_[/color] WORDLISTS literal's All [color=#FF8000]ones: TRUE[/color] VERSION W/O imm_word point std_word tab# nil
[color=#808080]\ слова для работы с локальным стеком данных[/color] local's All [color=#FF8000]ones: >L[/color] L> L@ LDUP LDROP DL@ D>L { } AL@ A>L AL> AL+ ALDROP ALDUP local's All [color=#FF8000]ones: DL>[/color] L+
[color=#808080]\[/color] def's All [color=#FF8000]ones: EndStruct[/color] [color=#FF8000]EndUnit[/color] DOES> CREATED ?EXIT [color=#FF8000]<: ;>[/color] EXIT [color=#FF8000];THEN[/color] SHEADER def's All [color=#FF8000]ones: ;CREATE[/color] /struct HEADER WORDLIST
[color=#808080]\ потенциально опасные слова, требующие внимания и обработка исключений[/color] danger's All [color=#FF8000]ones: >R[/color] [color=#C00000]R>[/color] R@ RDROP R+ DR> D>R [color=#C00000]A>R[/color] [color=#C00000]AR>[/color] DR@ ARDROP N>R NR> rnDROP danger's All [color=#FF8000]ones: EXECUTE[/color] PERFORM JUMP [color=#C00000]LEAP[/color] CATCH [color=#C00000]THROW[/color] [color=#00A0A0]DEMAND[/color] [color=#C00000]REJECT[/color] ERROR danger's All [color=#FF8000]ones: IMMEDIATE[/color] unfeasible SMUDGE HIDE IT-DOES PRIMITIVE VOC 0>R' danger's All [color=#FF8000]ones: LITERAL[/color] WARNING >STDERR CR>ERR ON-ERROR EXIT-ERROR ON-CATCH danger's All [color=#FF8000]ones: BYE[/color] HALT ERR-EXIT ExitProcess FATAL-HANDLER danger's All [color=#FF8000]ones: HEX[/color] BASE DECIMAL always danger's All [color=#FF8000]ones: [IF][/color] [ELSE] [THEN] ' [color=#C00000][[/color] [color=#C00000]][/color] danger's All [color=#FF8000]ones: ClearDStack[/color] ClearLStack LP! SP! RP! RP@ FS! FS@ TlsIndex!
[color=#808080]\ подсветка отладочных определений[/color] hilight's All [color=#FF8000]ones: .S[/color] DUMP DUMP~ ORDER
[color=#808080]\ форматное преобразование чисел и строк[/color] format's All [color=#FF8000]ones: {#[/color] [color=#0000F0]<#[/color] [color=#0000F0]#[/color] #S [color=#0000F0]HOLD[/color] [color=#0000F0]HOLDS[/color] [color=#0000F0]#>[/color] [color=#0000F0]#}[/color] [color=#0000F0]<|[/color] [color=#0000F0]KEEP[/color] [color=#0000F0]KEEPS[/color] [color=#0000F0]|>[/color] BLANK BLANKS
[color=#808080]\ работа с VALUE и VECT переменными[/color] confer's All [color=#FF8000]pair: TO[/color] IS FROM HAS
[color=#808080]\ литералы[/color] literal's All [color=#FF8000]pair: [CHAR][/color] [color=#00F000][COMPILE] WHO[/color] [color=#00F000]['] LFA[/color] CHAR" 1CHAR= ^
[color=#808080]\ подключаемые библиотеки[/color] literal's All [color=#FF8000]pair: rel/[/color] root/ [color=#00F000]vocs/ os/[/color] [color=#00F000]branch/ memory/[/color] [color=#00F000]string/ transl/[/color] literal's All [color=#FF8000]pair: math/[/color] [color=#00F000]exc/ stack/[/color] [color=#00F000]util/
\[/color] --------------------- более сложные правила расцветки ----------------------- comment's [color=#FF8000]rule: \[/color] _eol [color=#FF8000];r[/color] [color=#808080]\ коментарий до конца строки[/color] hilight's [color=#FF8000]rule: \?[/color] _eol [color=#FF8000];r[/color] [color=#808080]\ подсвеченый коментарий[/color] hilight's [color=#FF8000]rule: \![/color] _eol [color=#FF8000];r[/color] [color=#808080]\ подсвеченый коментарий[/color]
literal's [color=#FF8000]rule: s"[/color] [color=#00F000][CHAR] "[/color] _toch [color=#FF8000];r[/color] [color=#808080]\ однострочные строковые литералы[/color] literal's [color=#FF8000]rule: S"[/color] [color=#00F000][CHAR] "[/color] _toch [color=#FF8000];r[/color] [color=#808080]\ однострочные строковые литералы[/color]
diagram's [color=#FF8000]rule: ([/color] [color=#00F000][CHAR] )[/color] _toch [color=#FF8000];r[/color] [color=#808080]\ однострочные стековые коментарии[/color]
literal's [color=#FF8000]rule: .([/color] [color=#00F000][CHAR] )[/color] _toch [color=#FF8000];r[/color] [color=#808080]\ однострочные сообщения[/color] literal's [color=#FF8000]rule: ."[/color] [color=#00F000][CHAR] "[/color] _toch [color=#FF8000];r[/color] [color=#808080]\ однострочные сообщения[/color]
literal's [color=#FF8000]rule: STRING"[/color] [color=#00F000][CHAR] "[/color] _toch [color=#FF8000];r[/color] [color=#808080]\ строка сообщения[/color]
errmes's [color=#FF8000]rule: ERROR"[/color] [color=#00F000][CHAR] "[/color] _toch [color=#FF8000];r[/color] [color=#808080]\ сообщение об ошибке[/color] errmes's [color=#FF8000]rule: ABORT"[/color] [color=#00F000][CHAR] "[/color] _toch [color=#FF8000];r[/color] [color=#808080]\ сообщение об ошибке[/color]
literal's [color=#FF8000]rule: NOTICE"[/color] [color=#00F000][CHAR] "[/color] _toch [color=#FF8000];r[/color] [color=#808080]\ строка сообщения[/color]
[color=#808080]\ следущие определения автоматически добавляют в словарь правила раскраски[/color]
[color=#808080]\ определения различных переменных[/color] [color=#00F000]s" USER"[/color] def's [color=#FF8000]ruleS: dodef[/color] [color=#FF8000];r[/color] [color=#00F000]s" VALUE"[/color] def's [color=#FF8000]ruleS: dodef[/color] [color=#FF8000];r[/color] [color=#00F000]s" DVALUE"[/color] def's [color=#FF8000]ruleS: dodef[/color] [color=#FF8000];r[/color] [color=#00F000]s" VARIABLE"[/color] def's [color=#FF8000]ruleS: dodef[/color] [color=#FF8000];r[/color] [color=#00F000]s" DVARIABLE"[/color] def's [color=#FF8000]ruleS: dodef[/color] [color=#FF8000];r[/color] [color=#00F000]s" USER-VALUE"[/color] def's [color=#FF8000]ruleS: dodef[/color] [color=#FF8000];r[/color] [color=#00F000]s" USER-DVAL"[/color] def's [color=#FF8000]ruleS: dodef[/color] [color=#FF8000];r[/color] [color=#00F000]s" CONSTANT"[/color] def's [color=#FF8000]ruleS: dodef[/color] [color=#FF8000];r[/color] [color=#00F000]s" VECT"[/color] def's [color=#FF8000]ruleS: dodef[/color] [color=#FF8000];r[/color] [color=#00F000]s" DEFER"[/color] def's [color=#FF8000]ruleS: dodef[/color] [color=#FF8000];r[/color] [color=#00F000]s" USER-VECT"[/color] def's [color=#FF8000]ruleS: dodef[/color] [color=#FF8000];r[/color] [color=#00F000]s" USER-CREATE"[/color] def's [color=#FF8000]ruleS: dodef[/color] [color=#FF8000];r[/color] [color=#00F000]s" CREATE"[/color] def's [color=#FF8000]ruleS: dodef[/color] [color=#FF8000];r[/color] [color=#00F000]s" POCKET"[/color] def's [color=#FF8000]ruleS: dodef[/color] [color=#FF8000];r[/color]
[color=#00F000]s" ALIAS"[/color] def's [color=#FF8000]ruleS: doals[/color] [color=#FF8000];r[/color]
[color=#808080]\ создание словарей[/color] [color=#00F000]s" Unit:"[/color] vocdef's [color=#FF8000]ruleS: dovoc[/color] [color=#FF8000];r[/color] [color=#00F000]s" VOCABULARY"[/color] vocdef's [color=#FF8000]ruleS: dovoc[/color] [color=#FF8000];r[/color] [color=#00F000]s" CONTAINER"[/color] vocdef's [color=#FF8000]ruleS: dovoc[/color] [color=#FF8000];r[/color] [color=#00F000]s" Struct:"[/color] vocdef's [color=#FF8000]ruleS: dovoc[/color] [color=#FF8000];r[/color] [color=#00F000]s" struct:"[/color] vocdef's [color=#FF8000]ruleS: dovoc[/color] [color=#FF8000];r[/color]
[color=#808080]\ поля структур[/color] [color=#00F000]s" Cell[]"[/color] filed's [color=#FF8000]ruleS: dofld[/color] [color=#FF8000];r[/color] [color=#00F000]s" Addr[]"[/color] filed's [color=#FF8000]ruleS: dofld[/color] [color=#FF8000];r[/color] [color=#00F000]s" Zero[]"[/color] filed's [color=#FF8000]ruleS: dofld[/color] [color=#FF8000];r[/color] [color=#00F000]s" addr[]"[/color] filed's [color=#FF8000]ruleS: dofld[/color] [color=#FF8000];r[/color] [color=#00F000]s" byte[]"[/color] filed's [color=#FF8000]ruleS: dofld[/color] [color=#FF8000];r[/color] [color=#00F000]s" --"[/color] filed's [color=#FF8000]ruleS: dofld[/color] [color=#FF8000];r[/color]
[color=#808080]\ определяющие слова[/color] [color=#00F000]s" :"[/color] def's [color=#FF8000]ruleS: ?State[/color] [color=#00A0A0]IFNOT[/color] donew [color=#00F000]TRUE[/color] TO ?State [color=#00A0A0]THEN[/color] [color=#FF8000];r[/color] [color=#00F000]s" :>"[/color] def's [color=#FF8000]ruleS: ?State[/color] [color=#00A0A0]IFNOT[/color] donew [color=#00F000]TRUE[/color] TO ?State [color=#00A0A0]THEN[/color] [color=#FF8000];r[/color] [color=#00F000]s" S:"[/color] def's [color=#FF8000]ruleS: ?State[/color] [color=#00A0A0]IFNOT[/color] donew [color=#00F000]TRUE[/color] TO ?State [color=#00A0A0]THEN[/color] [color=#FF8000];r[/color] [color=#00F000]s" F:"[/color] def's [color=#FF8000]ruleS: ?State[/color] [color=#00A0A0]IFNOT[/color] donew [color=#00F000]TRUE[/color] TO ?State [color=#00A0A0]THEN[/color] [color=#FF8000];r[/color]
[color=#808080]\ слова завершающие определения[/color] [color=#00F000]s" ;"[/color] def's [color=#FF8000]ruleS: FALSE[/color] TO ?State [color=#FF8000];r[/color] [color=#00F000]s" ;F"[/color] def's [color=#FF8000]ruleS: FALSE[/color] TO ?State [color=#FF8000];r[/color] [color=#00F000]s" ;stop"[/color] def's [color=#FF8000]ruleS: FALSE[/color] TO ?State [color=#FF8000];r[/color][/b][/pre]
|
|
|
|
Добавлено: Чт июл 25, 2013 21:35 |
|
|
|
|
|
Заголовок сообщения: |
Re: *простой текстовый viewer |
|
|
source file: view.fts \ 02.07.2013 ~mOleg \ Copyright [C] 2013 mOleg mOlegg@ya.ru \ простой просмотрщик исходных текстов с расцвечиванием лексем
vocs/ unit.fts vocs/ struct.fts os/ heap.fts os/ console.fts os/ ccon.fts branch/ for-next.fts memory/ buff.fts \ rel/ keys.fts
ALSO HIDDEN ALIAS EKEY SYSKEY ALIAS EKEY? key? PREVIOUS
Unit: key'
F: esc 0x101001B ;F F: up 0x1480000 ;F F: dn 0x1500000 ;F F: left 0x14B0000 ;F F: right 0x14D0000 ;F
F: home 0x1470000 ;F F: end 0x14F0000 ;F F: pgup 0x1490000 ;F F: pgdn 0x1510000 ;F EndUnit
Unit: View{
USER 1stLine \ первая линия текста USER LastLine \ последняя линия текста USER TopLine \ первая отображаемая линия текста
70 VALUE Width \ ширина рабочей области экрана 0 VALUE Displ \ смещение первого отображаемого символа от начала строки 3 VALUE Up \ положение первого символа окна просмотра слева 3 VALUE Top \ и сверху 25 VALUE Height \ высота рабочей области экрана 255 VALUE MaxWidth \ максимальная длина строки
\ каждая линия хранится отдельно 0 Struct: line Addr[] off_prev \ ссылка на предыдущую линию текста Addr[] off_next \ ссылка на следующую линию текста Cell[] off_size \ длина строки Zero[] off_body \ начало текста EndStruct
\ получить указатель на следующую линию текста : next ( str --> str | nil ) line off_next A@ ;
\ задать ссылку str2 на следующую строку str1 : !next ( str1 str2 --> ) line off_next A! ;
\ получить указатель на предыдущую линию текста : prev ( str --> str | nil ) line off_prev A@ ;
\ задать ссылку str2 на предыдущую строку str1 : !prev ( str1 str2 --> ) line off_prev A! ;
\ вернуть начало a2 и a1 конец строки ? : str> ( str --> asc # ) DUP line off_size @ SWAP line off_body SWAP ;
USER-VALUE cbuff \ временный буфер
\ инициализация буфера : cinit ( --> buff ) cbuff *IF DUP Clean ;THEN DROP MaxWidth Buffer DUP TO cbuff ;
\ Выделить лидирующие пробельные символы : skipsp ( a1 a2 --> a1 a2 str # ) DDUP BEGIN DDUP > WHILE DUP C@ ?separator WHILE C+ REPEAT THEN -ROT DROP DDUP - ;
\ Выделить лидирующие непробельные символы : nextlx ( a1 a2 --> a1 a2 asc # ) DDUP BEGIN DDUP > WHILE DUP C@ ?separator WHILENOT C+ REPEAT THEN -ROT DROP DDUP - ;
\ выделить из строки подстроку, содержащую пару лексем : _pair ( a1 a2 asc1 # --> a1 a2 asc1 #1 asc2 # ) DROP >L skipsp DDROP nextlx DDROP DUP L@ - L> SWAP ;
\ выделить из строки подстроку, завершенную указанным символом ch : _toch ( a1 a2 asc1 # ch --> a1 a2 asc1 #1 asc2 # ) >L DROP >R BEGIN DDUP > WHILE DUP C@ L@ <> WHILE C+ REPEAT THEN C+ DUP R@ - R> SWAP LDROP ;
\ выделить из строки подстроку, завершенную переводом строки : _eol ( a1 a2 asc1 # --> a1 a2 asc1 #1 asc2 # ) DROP >L BEGIN DDUP > WHILE DUP ?NewLine WHILENOT C+ REPEAT THEN DUP L@ - L> SWAP ;
\ преобразовать цвет в строку : c>s" ( color --> x asc # ) 8 LSHIFT SP@ 2 ;
USER-VALUE prevcol \ предыдущий цвет
VOCABULARY CVID \ словарь для хранения списка методов расцветки
\ создание правила расцветки : rule: ( color fone / name --> ) DUP >L c>s" ALSO CVID THIS [COMPILE] : ;
\ завершение правила расцветки : ;r ( x asc # --> ) SLIT, DROP [COMPILE] ; DEFINITIONS L> TO prevcol ; IMMEDIATE
\ правило для расцветки одиночных имен : ones: ( color / name --> ) rule: [COMPILE] ;r ;
\ правило для расцветки пары имен : pair: ( color / name --> ) rule: COMPILE _pair [COMPILE] ;r ;
\ выполнить над всеми словами до конца строки действие name c параметром color : All ( color / name lex1 lex2 .. lexN --> ) >L ' >L <: BEGIN SeeForw NIP WHILE DL@ EXECUTE REPEAT LDROP ;> Cr_ PARSE ROT EVALUATE-WITH ;
Color{
\ : FONE ( color fone --> ) Fone + ; ( a1 a2 asc1 # --> a1 a2 asc1 #1 asc2 # ) Black Gray FONE : undefcode [ c>s" SLIT, DROP ] ; Gray Gray FONE : spaces [ c>s" SLIT, DROP ] ; Green Light Gray FONE : litcode [ c>s" SLIT, DROP ] ;
\ --------------------------------------------------------------------------------------------------
Yellow Gray FONE ones: Yellow Green Gray FONE ones: Green Red Gray FONE ones: Red Gray Light Gray FONE ones: Gray White Gray FONE ones: Light White Gray FONE ones: White Black Gray FONE ones: Black Brown Gray FONE ones: Brown Cyan Gray FONE ones: Cyan Blue Gray FONE ones: Blue Magenta Gray FONE ones: Magenta
Magenta Gray FONE All ones: ALSO ONLY SEAL DEFINITIONS THIS RECENT PREVIOUS Magenta Gray FONE All ones: ROOT FORTH HIDDEN NUMBERS
White Gray FONE All ones: BEGIN WHILE WHILENOT *WHILE REPEAT AGAIN UNTIL White Gray FONE All ones: IF -IF *IF IFNOT ELSE THEN White Gray FONE All ones: CASE OF uOF ENDOF ENDCASE White Gray FONE All ones: NOW SINCE FOR TILL NEXT
Gray Light Gray FONE All ones: DUP DROP SWAP OVER NIP TUCK ROT -ROT THRID BOUNDS Gray Light Gray FONE All ones: DDUP DSWAP DDROP DOVER D+ DEPTH TDROP nDROP SLIT, Gray Light Gray FONE All ones: @ ! A@ A! C@ C! C+ B@ B! W@ W! +! MAX MIN UMAX UMIN Gray Light Gray FONE All ones: + - < > <> * / MOD /MOD LSHIFT RSHIFT AND OR XOR Gray Light Gray FONE All ones: CMOVE BLOCK ALLOCATE FREE SP@ SEARCH-NAME LINK>C Gray Light Gray FONE All ones: FILE>HEAP PAUSE ORDER CONTEXT CURRENT
Brown Gray FONE All ones: >L L> L@ L+ LDROP DL@ D>L DL>
Yellow Gray FONE All ones: ; ;THEN EXIT <: ;> ;F EndStruct EndUnit ;r
Red Light Gray FONE All ones: >R R> R@ RDROP R+ SP! DR> D>R A>R AR> AR@ Red Light Gray FONE All ones: EXECUTE CATCH THROW IMMEDIATE
Green Light Gray FONE All ones: Bl_ Cr_ Lf_ LTL TRUE FALSE nil
Blue Light Gray FONE All ones: {# <# # #S HOLD HOLDS #> #} <| KEEP KEEPS |>
Yellow Gray FONE All pair: : VARIABLE VALUE VECT USER USER-VALUE USER-VECT Yellow Gray FONE All pair: Struct: Unit: F: rule: VOCABULARY CONTAINER
Brown Gray FONE All pair: Cell[] Addr[] Zero[]
Cyan Light Gray FONE All pair: TO IS
Green Light Gray FONE All pair: [COMPILE] WHO ['] Green Light Gray FONE All pair: rel/ vocs/ os/ branch/ memory/
\ более сложные правила расцветки Cyan Gray FONE rule: \ _eol ;r \ коментарий до конца строки Green Light Gray FONE rule: s" [CHAR] " _toch ;r \ однострочные строковые литералы Blue Gray FONE rule: ( [CHAR] ) _toch ;r \ однострочные стековые коментарии Red Light Gray FONE rule: ERROR" [CHAR] " _toch ;r \ сообщение об ошибке
RECENT \ -----------------------------------------------------------------------
\ вернуть тег расцветки : ?color ( a1 a2 asc1 #1 --> a1 a2 asc1 #1 asc2 #2 ) DDUP WHO CVID SEARCH-NAME *IF LINK>C EXECUTE ;THEN DROP DDUP [ ALSO HIDDEN ] snNumber [ PREVIOUS ] CASE 0 OF undefcode ENDOF 1 OF DROP litcode ENDOF 2 OF DDROP litcode ENDOF ERROR" невозможная ошибка!" ENDCASE ;
\ преобразовать : colorify ( asc # --> asc # ) BOUNDS cinit >L BEGIN DDUP > WHILE skipsp *IF spaces L@ >Buffer DROP THEN L@ >Buffer DROP nextlx ?color L@ >Buffer DROP L@ >Buffer DROP REPEAT DDROP L> Buffer> ;
\ создать новую запись в хипе, скопировать туда содержимое строки ? : new ( asc # --> str ) colorify DUP line /size + BLOCK >L TUCK L@ line off_body SWAP CMOVE L@ line off_size ! nil L@ !prev nil L@ !next L> ;
\ добавить строку в конец текста : push ( str --> ) LastLine A@ OVER !prev DUP LastLine A@ !next LastLine A! ;
\ задать начальное состояние : set ( str --> ) DUP 1stLine A! DUP LastLine A! TopLine A! ;
\ добавить строку в конец списка строк : add ( str --> ) 1stLine @ IF push ;THEN set ;
\ вернуть адрес конца подстроки : part ( a1 a2 --> a3 ) BEGIN DDUP > WHILE DUP B@ WHILE 1 + REPEAT THEN NIP ;
\ вернуть цвет из начала указанной строки, пропустить цветовую информацию : @col ( a1 --> a2 c ) 1 + DUP B@ 0:1 D+ ;
\ выделить из начала строки, ограниченной адресами a1 a2 раскрашенную в цвет C подстроку asc # \ исключить из начала исходной строки выделенную подстроку : lex ( a1 a2 --> a1 a4 asc # c ) @col >L DDUP part TUCK OVER - L> ;
\ указанное количество пробельных символов фонового цвета : cSpaces ( # --> ) *IF <# FOR Bl_ HOLD TILL #} spaces DROP 1 + B@ CTYPE ;THEN DROP ;
\ вывести строку asc # в консоль максимально допустимая длина строки s символов : cType] ( asc # s --> ) >L BEGIN DDUP > WHILE lex L@ THRID - -IF DROP NIP L> SWAP CTYPE DDROP ;THEN LDROP >L CTYPE REPEAT DDROP L> cSpaces ;
\ вывести строку asc # в консоль длина отображаемой строки u символов \ если строка длиннее - обрезать, если короче - дополнить пробелами : >cType] ( asc # s u --> ) >L -ROT BOUNDS THRID >R BEGIN DDUP > WHILE lex L@ THRID - -IF DROP -ROT L> SKIPn DUP >L R> MIN ROT CTYPE ROT L> - 0 MAX cType] ;THEN LDROP >L TDROP REPEAT RDROP LDROP ROT cType] ;
\ отобразить текст в окне начиная с позиции up top размером width height \ текст сместить от начала строк на x позиций : show ( width disp TopLine up top height --> ) FOR DDUP setxy D>L THRID THRID THRID IF THRID str> DSWAP >cType] next ELSE spaces DSWAP >cType] THEN DL> 1 + TILL 5 nDROP ;
\ загрузка строк из файла : load ( asc # --> ) FILE>HEAP IFNOT ERROR" Invalid file name!" THEN OVER >L <: BOUNDS SWAP BEGIN DDUP < WHILE DDUP EOL> -ROT THRID ROT TUCK - LTL @ - 0 MAX new add REPEAT DDROP ;> CATCH L> FREE DROP THROW ;
\ освободить занимаемую память : free ( 1stLine --> ) A@ BEGIN *WHILE DUP next SWAP FREE DROP REPEAT DROP nil set ;
\ сместить окно на одну линию вверх : TopUp ( --> ) TopLine A@ prev *IF TopLine A! ELSE DROP THEN ;
\ сместить окно на одну линию вниз : TopDn ( --> ) TopLine A@ next *IF TopLine A! ELSE DROP THEN ;
\ на одну страницу вверх : PgUp ( --> ) Height FOR TopUp TILL ;
\ на одну страницу вниз : PgDn ( --> ) Height FOR TopDn TILL ;
\ обработка событий нажатий клавиш : reflex ( key --> ) CASE key' esc OF ERROR" Ok." ENDOF key' dn OF TopDn ENDOF key' up OF TopUp ENDOF key' right OF Displ 1 + MaxWidth Width - MIN TO Displ ENDOF key' left OF Displ 1 - 0 MAX TO Displ ENDOF key' pgup OF PgUp ENDOF key' pgdn OF PgDn ENDOF key' home OF 1stLine A@ TopLine A! ENDOF key' end OF LastLine A@ TopLine A! ENDOF DROP ENDCASE ;
\ отобразить страницу текста в окне : ~Page ( --> ) Width Displ TopLine A@ Up Top Height show ;
\ главный рабочий цикл :> Viewer ( --> ) ~Page BEGIN key? IF SYSKEY reflex ~Page THEN 0 PAUSE AGAIN ;
F: } ;F
EndUnit
\ отобразить содержимое указанного файла : VIEW ( asc # --> ) View{ DDUP ~title load HideCur width 80 MIN TO Width height 25 MIN TO Height Viewer CATCH DROP 1stLine free ShowCur } ;
использовать так: rel/ view.fts s" view.fts" VIEW
[pre]source file: view.fts [b][color=#808080]\ 02.07.2013 ~mOleg[/color] [color=#808080]\ Copyright [C] 2013 mOleg mOlegg@ya.ru[/color] [color=#808080]\ простой просмотрщик исходных текстов с расцвечиванием лексем[/color]
[color=#00F000]vocs/ unit.fts[/color] [color=#00F000]vocs/ struct.fts[/color] [color=#00F000]os/ heap.fts[/color] [color=#00F000]os/ console.fts[/color] [color=#00F000]os/ ccon.fts[/color] [color=#00F000]branch/ for-next.fts[/color] [color=#00F000]memory/ buff.fts[/color] [color=#808080]\ rel/ keys.fts[/color]
[color=#FF00FF]ALSO[/color] [color=#FF00FF]HIDDEN[/color] [color=#FF8000]ALIAS EKEY SYSKEY[/color] [color=#FF8000]ALIAS EKEY? key?[/color] [color=#FF00FF]PREVIOUS[/color]
[color=#FF8000]Unit: key'[/color]
[color=#FF8000]F: esc[/color] [color=#00F000]0x101001B[/color] [color=#FF8000];F[/color] [color=#FF8000]F: up[/color] [color=#00F000]0x1480000[/color] [color=#FF8000];F[/color] [color=#FF8000]F: dn[/color] [color=#00F000]0x1500000[/color] [color=#FF8000];F[/color] [color=#FF8000]F: left[/color] [color=#00F000]0x14B0000[/color] [color=#FF8000];F[/color] [color=#FF8000]F: right[/color] [color=#00F000]0x14D0000[/color] [color=#FF8000];F[/color]
[color=#FF8000]F: home[/color] [color=#00F000]0x1470000[/color] [color=#FF8000];F[/color] [color=#FF8000]F: end[/color] [color=#00F000]0x14F0000[/color] [color=#FF8000];F[/color] [color=#FF8000]F: pgup[/color] [color=#00F000]0x1490000[/color] [color=#FF8000];F[/color] [color=#FF8000]F: pgdn[/color] [color=#00F000]0x1510000[/color] [color=#FF8000];F[/color] [color=#FF8000]EndUnit[/color]
[color=#FF8000]Unit: View{[/color]
[color=#FF8000]USER 1stLine[/color] [color=#808080]\ первая линия текста[/color] [color=#FF8000]USER LastLine[/color] [color=#808080]\ последняя линия текста[/color] [color=#FF8000]USER TopLine[/color] [color=#808080]\ первая отображаемая линия текста[/color]
[color=#00F000]70[/color] [color=#FF8000]VALUE Width[/color] [color=#808080]\ ширина рабочей области экрана[/color] [color=#00F000]0[/color] [color=#FF8000]VALUE Displ[/color] [color=#808080]\ смещение первого отображаемого символа от начала строки[/color] [color=#00F000]3[/color] [color=#FF8000]VALUE Up[/color] [color=#808080]\ положение первого символа окна просмотра слева[/color] [color=#00F000]3[/color] [color=#FF8000]VALUE Top[/color] [color=#808080]\ и сверху[/color] [color=#00F000]25[/color] [color=#FF8000]VALUE Height[/color] [color=#808080]\ высота рабочей области экрана[/color] [color=#00F000]255[/color] [color=#FF8000]VALUE MaxWidth[/color] [color=#808080]\ максимальная длина строки[/color]
[color=#808080]\ каждая линия хранится отдельно[/color] [color=#00F000]0[/color] [color=#FF8000]Struct: line[/color] [color=#808000]Addr[] off_prev[/color] [color=#808080]\ ссылка на предыдущую линию текста[/color] [color=#808000]Addr[] off_next[/color] [color=#808080]\ ссылка на следующую линию текста[/color] [color=#808000]Cell[] off_size[/color] [color=#808080]\ длина строки[/color] [color=#808000]Zero[] off_body[/color] [color=#808080]\ начало текста[/color] [color=#FF8000]EndStruct[/color]
[color=#808080]\ получить указатель на следующую линию текста[/color] [color=#FF8000]: next[/color] [color=#0080C0]( str --> str | nil )[/color] line off_next A@ [color=#FF8000];[/color]
[color=#808080]\ задать ссылку str2 на следующую строку str1[/color] [color=#FF8000]: !next[/color] [color=#0080C0]( str1 str2 --> )[/color] line off_next A! [color=#FF8000];[/color]
[color=#808080]\ получить указатель на предыдущую линию текста[/color] [color=#FF8000]: prev[/color] [color=#0080C0]( str --> str | nil )[/color] line off_prev A@ [color=#FF8000];[/color]
[color=#808080]\ задать ссылку str2 на предыдущую строку str1[/color] [color=#FF8000]: !prev[/color] [color=#0080C0]( str1 str2 --> )[/color] line off_prev A! [color=#FF8000];[/color]
[color=#808080]\ вернуть начало a2 и a1 конец строки ?[/color] [color=#FF8000]: str>[/color] [color=#0080C0]( str --> asc # )[/color] DUP line off_size @ SWAP line off_body SWAP [color=#FF8000];[/color]
[color=#FF8000]USER-VALUE cbuff[/color] [color=#808080]\ временный буфер[/color]
[color=#808080]\ инициализация буфера[/color] [color=#FF8000]: cinit[/color] [color=#0080C0]( --> buff )[/color] cbuff [color=#00A0A0]*IF[/color] DUP Clean [color=#FF8000];THEN[/color] DROP MaxWidth Buffer DUP TO cbuff [color=#FF8000];[/color]
[color=#808080]\ Выделить лидирующие пробельные символы[/color] [color=#FF8000]: skipsp[/color] [color=#0080C0]( a1 a2 --> a1 a2 str # )[/color] DDUP [color=#00A0A0]BEGIN[/color] DDUP > [color=#00A0A0]WHILE[/color] DUP C@ ?separator [color=#00A0A0]WHILE[/color] C+ [color=#00A0A0]REPEAT[/color] [color=#00A0A0]THEN[/color] -ROT DROP DDUP - [color=#FF8000];[/color]
[color=#808080]\ Выделить лидирующие непробельные символы[/color] [color=#FF8000]: nextlx[/color] [color=#0080C0]( a1 a2 --> a1 a2 asc # )[/color] DDUP [color=#00A0A0]BEGIN[/color] DDUP > [color=#00A0A0]WHILE[/color] DUP C@ ?separator [color=#00A0A0]WHILENOT[/color] C+ [color=#00A0A0]REPEAT[/color] [color=#00A0A0]THEN[/color] -ROT DROP DDUP - [color=#FF8000];[/color]
[color=#808080]\ выделить из строки подстроку, содержащую пару лексем[/color] [color=#FF8000]: _pair[/color] [color=#0080C0]( a1 a2 asc1 # --> a1 a2 asc1 #1 asc2 # )[/color] DROP >L skipsp DDROP nextlx DDROP DUP L@ - L> SWAP [color=#FF8000];[/color]
[color=#808080]\ выделить из строки подстроку, завершенную указанным символом ch[/color] [color=#FF8000]: _toch[/color] [color=#0080C0]( a1 a2 asc1 # ch --> a1 a2 asc1 #1 asc2 # )[/color] >L DROP [color=#C00000]>R[/color] [color=#00A0A0]BEGIN[/color] DDUP > [color=#00A0A0]WHILE[/color] DUP C@ L@ <> [color=#00A0A0]WHILE[/color] C+ [color=#00A0A0]REPEAT[/color] [color=#00A0A0]THEN[/color] C+ DUP R@ - [color=#C00000]R>[/color] SWAP LDROP [color=#FF8000];[/color]
[color=#808080]\ выделить из строки подстроку, завершенную переводом строки[/color] [color=#FF8000]: _eol[/color] [color=#0080C0]( a1 a2 asc1 # --> a1 a2 asc1 #1 asc2 # )[/color] DROP >L [color=#00A0A0]BEGIN[/color] DDUP > [color=#00A0A0]WHILE[/color] DUP ?NewLine [color=#00A0A0]WHILENOT[/color] C+ [color=#00A0A0]REPEAT[/color] [color=#00A0A0]THEN[/color] DUP L@ - L> SWAP [color=#FF8000];[/color]
[color=#808080]\ преобразовать цвет в строку[/color] [color=#FF8000]: c>s"[/color] [color=#0080C0]( color --> x asc # )[/color] [color=#00F000]8[/color] LSHIFT SP@ [color=#00F000]2[/color] [color=#FF8000];[/color]
[color=#FF8000]USER-VALUE prevcol[/color] [color=#808080]\ предыдущий цвет[/color]
[color=#FF8000]VOCABULARY CVID[/color] [color=#808080]\ словарь для хранения списка методов расцветки[/color]
[color=#808080]\ создание правила расцветки[/color] [color=#FF8000]: rule:[/color] [color=#0080C0]( color fone / name --> )[/color] DUP >L c>s" [color=#FF00FF]ALSO[/color] CVID [color=#FF00FF]THIS[/color] [color=#00F000][COMPILE] :[/color] [color=#FF8000];[/color]
[color=#808080]\ завершение правила расцветки[/color] [color=#FF8000]: ;r[/color] [color=#0080C0]( x asc # --> )[/color] SLIT, DROP [color=#00F000][COMPILE] ;[/color] [color=#FF00FF]DEFINITIONS[/color] L> TO prevcol [color=#FF8000];[/color] [color=#C00000]IMMEDIATE[/color]
[color=#808080]\ правило для расцветки одиночных имен[/color] [color=#FF8000]: ones:[/color] [color=#0080C0]( color / name --> )[/color] [color=#FF8000]rule: [COMPILE][/color] [color=#FF8000];r[/color] [color=#FF8000];[/color]
[color=#808080]\ правило для расцветки пары имен[/color] [color=#FF8000]: pair:[/color] [color=#0080C0]( color / name --> )[/color] [color=#FF8000]rule: COMPILE[/color] _pair [color=#00F000][COMPILE] ;r[/color] [color=#FF8000];[/color]
[color=#808080]\ выполнить над всеми словами до конца строки действие name c параметром color[/color] [color=#FF8000]: All[/color] [color=#0080C0]( color / name lex1 lex2 .. lexN --> )[/color] >L ' >L [color=#FF8000]<: BEGIN[/color] SeeForw NIP [color=#00A0A0]WHILE[/color] DL@ [color=#C00000]EXECUTE[/color] [color=#00A0A0]REPEAT[/color] LDROP [color=#FF8000];>[/color] [color=#00F000]Cr_[/color] PARSE ROT EVALUATE-WITH [color=#FF8000];[/color]
Color{
[color=#808080]\[/color] [color=#FF8000]: FONE[/color] [color=#0080C0]( color fone --> )[/color] Fone + [color=#FF8000];[/color] [color=#0080C0]( a1 a2 asc1 # --> a1 a2 asc1 #1 asc2 # )[/color] Black Gray FONE [color=#FF8000]: undefcode[/color] [color=#C00000][[/color] c>s" SLIT, DROP [color=#C00000]][/color] [color=#FF8000];[/color] Gray Gray FONE [color=#FF8000]: spaces[/color] [color=#C00000][[/color] c>s" SLIT, DROP [color=#C00000]][/color] [color=#FF8000];[/color] Green Light Gray FONE [color=#FF8000]: litcode[/color] [color=#C00000][[/color] c>s" SLIT, DROP [color=#C00000]][/color] [color=#FF8000];[/color]
[color=#808080]\ --------------------------------------------------------------------------------------------------[/color]
Yellow Gray FONE [color=#FF8000]ones: Yellow[/color] Green Gray FONE [color=#FF8000]ones: Green[/color] Red Gray FONE [color=#FF8000]ones: Red[/color] Gray Light Gray FONE [color=#FF8000]ones: Gray[/color] White Gray FONE [color=#FF8000]ones: Light[/color] White Gray FONE [color=#FF8000]ones: White[/color] Black Gray FONE [color=#FF8000]ones: Black[/color] Brown Gray FONE [color=#FF8000]ones: Brown[/color] Cyan Gray FONE [color=#FF8000]ones: Cyan[/color] Blue Gray FONE [color=#FF8000]ones: Blue[/color] Magenta Gray FONE [color=#FF8000]ones: Magenta[/color]
Magenta Gray FONE All [color=#FF8000]ones: ALSO[/color] [color=#FF00FF]ONLY[/color] [color=#FF00FF]SEAL[/color] [color=#FF00FF]DEFINITIONS[/color] [color=#FF00FF]THIS[/color] [color=#FF00FF]RECENT[/color] [color=#FF00FF]PREVIOUS[/color] Magenta Gray FONE All [color=#FF8000]ones: ROOT[/color] [color=#FF00FF]FORTH[/color] [color=#FF00FF]HIDDEN[/color] NUMBERS
White Gray FONE All [color=#FF8000]ones: BEGIN[/color] [color=#00A0A0]WHILE[/color] [color=#00A0A0]WHILENOT[/color] [color=#00A0A0]*WHILE[/color] [color=#00A0A0]REPEAT[/color] [color=#00A0A0]AGAIN[/color] [color=#00A0A0]UNTIL[/color] White Gray FONE All [color=#FF8000]ones: IF[/color] [color=#00A0A0]-IF[/color] [color=#00A0A0]*IF[/color] [color=#00A0A0]IFNOT[/color] [color=#00A0A0]ELSE[/color] [color=#00A0A0]THEN[/color] White Gray FONE All [color=#FF8000]ones: CASE[/color] OF uOF ENDOF ENDCASE White Gray FONE All [color=#FF8000]ones: NOW[/color] SINCE FOR TILL NEXT
Gray Light Gray FONE All [color=#FF8000]ones: DUP[/color] DROP SWAP OVER NIP TUCK ROT -ROT THRID BOUNDS Gray Light Gray FONE All [color=#FF8000]ones: DDUP[/color] DSWAP DDROP DOVER D+ DEPTH TDROP nDROP SLIT, Gray Light Gray FONE All [color=#FF8000]ones: @[/color] ! A@ A! C@ C! C+ B@ B! W@ W! +! MAX MIN UMAX UMIN Gray Light Gray FONE All [color=#FF8000]ones: +[/color] - < > <> * / MOD /MOD LSHIFT RSHIFT AND OR XOR Gray Light Gray FONE All [color=#FF8000]ones: CMOVE[/color] BLOCK ALLOCATE FREE SP@ SEARCH-NAME LINK>C Gray Light Gray FONE All [color=#FF8000]ones: FILE>HEAP[/color] PAUSE ORDER CONTEXT CURRENT
Brown Gray FONE All [color=#FF8000]ones: >L[/color] L> L@ L+ LDROP DL@ D>L DL>
Yellow Gray FONE All [color=#FF8000]ones: ;[/color] [color=#FF8000];THEN[/color] EXIT [color=#FF8000]<: ;>[/color] [color=#FF8000];F[/color] [color=#FF8000]EndStruct[/color] [color=#FF8000]EndUnit[/color] [color=#FF8000];r[/color]
Red Light Gray FONE All [color=#FF8000]ones: >R[/color] [color=#C00000]R>[/color] R@ RDROP R+ SP! DR> D>R [color=#C00000]A>R[/color] [color=#C00000]AR>[/color] AR@ Red Light Gray FONE All [color=#FF8000]ones: EXECUTE[/color] CATCH [color=#C00000]THROW[/color] [color=#C00000]IMMEDIATE[/color]
Green Light Gray FONE All [color=#FF8000]ones: Bl_[/color] [color=#00F000]Cr_[/color] [color=#00F000]Lf_[/color] LTL [color=#00F000]TRUE[/color] [color=#00F000]FALSE[/color] nil
Blue Light Gray FONE All [color=#FF8000]ones: {#[/color] [color=#0000F0]<#[/color] [color=#0000F0]#[/color] #S [color=#0000F0]HOLD[/color] [color=#0000F0]HOLDS[/color] [color=#0000F0]#>[/color] [color=#0000F0]#}[/color] [color=#0000F0]<|[/color] [color=#0000F0]KEEP[/color] [color=#0000F0]KEEPS[/color] [color=#0000F0]|>[/color]
Yellow Gray FONE All [color=#FF8000]pair: :[/color] [color=#FF8000]VARIABLE VALUE[/color] [color=#FF8000]VECT USER[/color] [color=#FF8000]USER-VALUE USER-VECT[/color] Yellow Gray FONE All [color=#FF8000]pair: Struct:[/color] [color=#FF8000]Unit: F:[/color] [color=#FF8000]rule: VOCABULARY[/color] [color=#FF8000]CONTAINER
Brown[/color] Gray FONE All [color=#FF8000]pair: Cell[][/color] [color=#808000]Addr[] Zero[][/color]
Cyan Light Gray FONE All [color=#FF8000]pair: TO[/color] IS
Green Light Gray FONE All [color=#FF8000]pair: [COMPILE][/color] WHO [color=#00F000]['] Green[/color] Light Gray FONE All [color=#FF8000]pair: rel/[/color] [color=#00F000]vocs/ os/[/color] [color=#00F000]branch/ memory/[/color]
[color=#808080]\ более сложные правила расцветки[/color] Cyan Gray FONE [color=#FF8000]rule: \[/color] _eol [color=#FF8000];r[/color] [color=#808080]\ коментарий до конца строки[/color] Green Light Gray FONE [color=#FF8000]rule: s"[/color] [color=#00F000][CHAR] "[/color] _toch [color=#FF8000];r[/color] [color=#808080]\ однострочные строковые литералы[/color] Blue Gray FONE [color=#FF8000]rule: ([/color] [color=#00F000][CHAR] )[/color] _toch [color=#FF8000];r[/color] [color=#808080]\ однострочные стековые коментарии[/color] Red Light Gray FONE [color=#FF8000]rule: ERROR"[/color] [color=#00F000][CHAR] "[/color] _toch [color=#FF8000];r[/color] [color=#808080]\ сообщение об ошибке[/color]
[color=#FF00FF]RECENT[/color] [color=#808080]\ -----------------------------------------------------------------------[/color]
[color=#808080]\ вернуть тег расцветки[/color] [color=#FF8000]: ?color[/color] [color=#0080C0]( a1 a2 asc1 #1 --> a1 a2 asc1 #1 asc2 #2 )[/color] DDUP WHO CVID SEARCH-NAME [color=#00A0A0]*IF[/color] LINK>C [color=#C00000]EXECUTE[/color] [color=#FF8000];THEN[/color] DROP DDUP [color=#C00000][[/color] [color=#FF00FF]ALSO[/color] [color=#FF00FF]HIDDEN[/color] [color=#C00000]][/color] snNumber [color=#C00000][[/color] [color=#FF00FF]PREVIOUS[/color] [color=#C00000]][/color] CASE [color=#00F000]0[/color] OF undefcode ENDOF [color=#00F000]1[/color] OF DROP litcode ENDOF [color=#00F000]2[/color] OF DDROP litcode ENDOF [color=#C00000]ERROR" невозможная ошибка!"[/color] ENDCASE [color=#FF8000];[/color]
[color=#808080]\ преобразовать[/color] [color=#FF8000]: colorify[/color] [color=#0080C0]( asc # --> asc # )[/color] BOUNDS cinit >L [color=#00A0A0]BEGIN[/color] DDUP > [color=#00A0A0]WHILE[/color] skipsp [color=#00A0A0]*IF[/color] spaces L@ >Buffer DROP [color=#00A0A0]THEN[/color] L@ >Buffer DROP nextlx ?color L@ >Buffer DROP L@ >Buffer DROP [color=#00A0A0]REPEAT[/color] DDROP L> Buffer> [color=#FF8000];[/color]
[color=#808080]\ создать новую запись в хипе, скопировать туда содержимое строки ?[/color] [color=#FF8000]: new[/color] [color=#0080C0]( asc # --> str )[/color] colorify DUP line /size + BLOCK >L TUCK L@ line off_body SWAP CMOVE L@ line off_size ! nil L@ !prev nil L@ !next L> [color=#FF8000];[/color]
[color=#808080]\ добавить строку в конец текста[/color] [color=#FF8000]: push[/color] [color=#0080C0]( str --> )[/color] LastLine A@ OVER !prev DUP LastLine A@ !next LastLine A! [color=#FF8000];[/color]
[color=#808080]\ задать начальное состояние[/color] [color=#FF8000]: set[/color] [color=#0080C0]( str --> )[/color] DUP 1stLine A! DUP LastLine A! TopLine A! [color=#FF8000];[/color]
[color=#808080]\ добавить строку в конец списка строк[/color] [color=#FF8000]: add[/color] [color=#0080C0]( str --> )[/color] 1stLine @ [color=#00A0A0]IF[/color] push [color=#FF8000];THEN[/color] set [color=#FF8000];[/color]
[color=#808080]\ вернуть адрес конца подстроки[/color] [color=#FF8000]: part[/color] [color=#0080C0]( a1 a2 --> a3 )[/color] [color=#00A0A0]BEGIN[/color] DDUP > [color=#00A0A0]WHILE[/color] DUP B@ [color=#00A0A0]WHILE[/color] [color=#00F000]1[/color] + [color=#00A0A0]REPEAT[/color] [color=#00A0A0]THEN[/color] NIP [color=#FF8000];[/color]
[color=#808080]\ вернуть цвет из начала указанной строки, пропустить цветовую информацию[/color] [color=#FF8000]: @col[/color] [color=#0080C0]( a1 --> a2 c )[/color] [color=#00F000]1[/color] + DUP B@ [color=#00F000]0:1[/color] D+ [color=#FF8000];[/color]
[color=#808080]\ выделить из начала строки, ограниченной адресами a1 a2 раскрашенную в цвет C подстроку asc #[/color] [color=#808080]\ исключить из начала исходной строки выделенную подстроку[/color] [color=#FF8000]: lex[/color] [color=#0080C0]( a1 a2 --> a1 a4 asc # c )[/color] @col >L DDUP part TUCK OVER - L> [color=#FF8000];[/color]
[color=#808080]\ указанное количество пробельных символов фонового цвета[/color] [color=#FF8000]: cSpaces[/color] [color=#0080C0]( # --> )[/color] [color=#00A0A0]*IF[/color] [color=#0000F0]<#[/color] FOR [color=#00F000]Bl_[/color] [color=#0000F0]HOLD[/color] TILL [color=#0000F0]#}[/color] spaces DROP [color=#00F000]1[/color] + B@ CTYPE [color=#FF8000];THEN[/color] DROP [color=#FF8000];[/color]
[color=#808080]\ вывести строку asc # в консоль максимально допустимая длина строки s символов[/color] [color=#FF8000]: cType][/color] [color=#0080C0]( asc # s --> )[/color] >L [color=#00A0A0]BEGIN[/color] DDUP > [color=#00A0A0]WHILE[/color] lex L@ THRID - [color=#00A0A0]-IF[/color] DROP NIP L> SWAP CTYPE DDROP [color=#FF8000];THEN[/color] LDROP >L CTYPE [color=#00A0A0]REPEAT[/color] DDROP L> cSpaces [color=#FF8000];[/color]
[color=#808080]\ вывести строку asc # в консоль длина отображаемой строки u символов[/color] [color=#808080]\ если строка длиннее - обрезать, если короче - дополнить пробелами[/color] [color=#FF8000]: >cType][/color] [color=#0080C0]( asc # s u --> )[/color] >L -ROT BOUNDS THRID [color=#C00000]>R[/color] [color=#00A0A0]BEGIN[/color] DDUP > [color=#00A0A0]WHILE[/color] lex L@ THRID - [color=#00A0A0]-IF[/color] DROP -ROT L> SKIPn DUP >L [color=#C00000]R>[/color] MIN ROT CTYPE ROT L> - [color=#00F000]0[/color] MAX cType] [color=#FF8000];THEN[/color] LDROP >L TDROP [color=#00A0A0]REPEAT[/color] RDROP LDROP ROT cType] [color=#FF8000];[/color]
[color=#808080]\ отобразить текст в окне начиная с позиции up top размером width height[/color] [color=#808080]\ текст сместить от начала строк на x позиций[/color] [color=#FF8000]: show[/color] [color=#0080C0]( width disp TopLine up top height --> )[/color] FOR DDUP setxy D>L THRID THRID THRID [color=#00A0A0]IF[/color] THRID str> DSWAP >cType] next [color=#00A0A0]ELSE[/color] spaces DSWAP >cType] [color=#00A0A0]THEN[/color] DL> [color=#00F000]1[/color] + TILL [color=#00F000]5[/color] nDROP [color=#FF8000];[/color]
[color=#808080]\ загрузка строк из файла[/color] [color=#FF8000]: load[/color] [color=#0080C0]( asc # --> )[/color] FILE>HEAP [color=#00A0A0]IFNOT[/color] [color=#C00000]ERROR" Invalid file name!"[/color] [color=#00A0A0]THEN[/color] OVER >L [color=#FF8000]<: BOUNDS[/color] SWAP [color=#00A0A0]BEGIN[/color] DDUP < [color=#00A0A0]WHILE[/color] DDUP EOL> -ROT THRID ROT TUCK - LTL @ - [color=#00F000]0[/color] MAX new add [color=#00A0A0]REPEAT[/color] DDROP [color=#FF8000];>[/color] CATCH L> FREE DROP [color=#C00000]THROW[/color] [color=#FF8000];[/color]
[color=#808080]\ освободить занимаемую память[/color] [color=#FF8000]: free[/color] [color=#0080C0]( 1stLine --> )[/color] A@ [color=#00A0A0]BEGIN[/color] [color=#00A0A0]*WHILE[/color] DUP next SWAP FREE DROP [color=#00A0A0]REPEAT[/color] DROP nil set [color=#FF8000];[/color]
[color=#808080]\ сместить окно на одну линию вверх[/color] [color=#FF8000]: TopUp[/color] [color=#0080C0]( --> )[/color] TopLine A@ prev [color=#00A0A0]*IF[/color] TopLine A! [color=#00A0A0]ELSE[/color] DROP [color=#00A0A0]THEN[/color] [color=#FF8000];[/color]
[color=#808080]\ сместить окно на одну линию вниз[/color] [color=#FF8000]: TopDn[/color] [color=#0080C0]( --> )[/color] TopLine A@ next [color=#00A0A0]*IF[/color] TopLine A! [color=#00A0A0]ELSE[/color] DROP [color=#00A0A0]THEN[/color] [color=#FF8000];[/color]
[color=#808080]\ на одну страницу вверх[/color] [color=#FF8000]: PgUp[/color] [color=#0080C0]( --> )[/color] Height FOR TopUp TILL [color=#FF8000];[/color]
[color=#808080]\ на одну страницу вниз[/color] [color=#FF8000]: PgDn[/color] [color=#0080C0]( --> )[/color] Height FOR TopDn TILL [color=#FF8000];[/color]
[color=#808080]\ обработка событий нажатий клавиш[/color] [color=#FF8000]: reflex[/color] [color=#0080C0]( key --> )[/color] CASE key' esc OF [color=#C00000]ERROR" Ok."[/color] ENDOF key' dn OF TopDn ENDOF key' up OF TopUp ENDOF key' right OF Displ [color=#00F000]1[/color] + MaxWidth Width - MIN TO Displ ENDOF key' left OF Displ [color=#00F000]1[/color] - [color=#00F000]0[/color] MAX TO Displ ENDOF key' pgup OF PgUp ENDOF key' pgdn OF PgDn ENDOF key' home OF 1stLine A@ TopLine A! ENDOF key' end OF LastLine A@ TopLine A! ENDOF DROP ENDCASE [color=#FF8000];[/color]
[color=#808080]\ отобразить страницу текста в окне[/color] [color=#FF8000]: ~Page[/color] [color=#0080C0]( --> )[/color] Width Displ TopLine A@ Up Top Height show [color=#FF8000];[/color]
[color=#808080]\ главный рабочий цикл[/color] [color=#FF8000]:> Viewer[/color] [color=#0080C0]( --> )[/color] ~Page [color=#00A0A0]BEGIN[/color] key? [color=#00A0A0]IF[/color] SYSKEY reflex ~Page [color=#00A0A0]THEN[/color] [color=#00F000]0[/color] PAUSE [color=#00A0A0]AGAIN[/color] [color=#FF8000];[/color]
[color=#FF8000]F: }[/color] [color=#FF8000];F[/color]
[color=#FF8000]EndUnit[/color]
[color=#808080]\ отобразить содержимое указанного файла[/color] [color=#FF8000]: VIEW[/color] [color=#0080C0]( asc # --> )[/color] View{ DDUP ~title load HideCur width [color=#00F000]80[/color] MIN TO Width height [color=#00F000]25[/color] MIN TO Height Viewer CATCH DROP 1stLine free ShowCur } [color=#FF8000];[/color] [/b][/pre]
использовать так: rel/ view.fts s" view.fts" VIEW
|
|
|
|
Добавлено: Сб июл 06, 2013 22:54 |
|
|
|
|
|
Заголовок сообщения: |
Re: *простой текстовый viewer |
|
|
предыдущий вариант не сработает если файл будет с html разметкой для этого надо делать замену некоторых символов нa подстроки (вот она цена использования сторонних компонентов - мы не только подгоняем поведение под требуемое, но и еще готовим для него правильные входные данные!) Код: mutex.f process.f locals.f str5.f case.f
: VIEW { a u \ buf inpfile outfile -- } 1000 ALLOCATE THROW -> buf a u R/O OPEN-FILE-SHARED THROW -> inpfile S" view.tmp" R/W CREATE-FILE THROW -> outfile BEGIN buf 1000 inpfile READ-LINE THROW WHILE buf + buf ?DO I C@ CASE [CHAR] & OF S" &" outfile WRITE-FILE THROW ENDOF [CHAR] ' OF S" '" outfile WRITE-FILE THROW ENDOF [CHAR] " OF S" "" outfile WRITE-FILE THROW ENDOF [CHAR] < OF S" <" outfile WRITE-FILE THROW ENDOF [CHAR] > OF S" >" outfile WRITE-FILE THROW ENDOF I 1 outfile WRITE-FILE THROW ENDCASE LOOP LT 2 outfile WRITE-FILE THROW REPEAT DROP inpfile CLOSE-FILE THROW outfile CLOSE-FILE THROW buf FREE THROW S" cmd.exe /c copy /B head.tmp+view.tmp+tail.tmp /B view.hta > null.tmp" StartAppWait THROW S" cmd.exe /c view.hta" StartApp THROW DROP ;
содержимое файла head.tmp Цитата: <html> <head> <SCRIPT language="javascript"> document.onkeydown = function(event){ events = event || window.event; if (events.keyCode == 27) { window.close();}} window.resizeTo (480,240); window.moveTo((screen.width-480)/2,(screen.height-240)/2); </SCRIPT> <hta:application id=v_i_e_w applicationName=view maximizeButton=yes border=thin innerBorder=no selection=no contextMenu=no singleinstance=yes WINDOWSTATE="normal"/> <title> V I E W </title> </head><body><pre> содержимое файла tail.tmp Цитата: </pre></body></html>
предыдущий вариант не сработает если файл будет с html разметкой для этого надо делать замену некоторых символов нa подстроки (вот она цена использования сторонних компонентов - мы не только подгоняем поведение под требуемое, но и еще готовим для него правильные входные данные!) [code] mutex.f process.f locals.f str5.f case.f
: VIEW { a u \ buf inpfile outfile -- } 1000 ALLOCATE THROW -> buf a u R/O OPEN-FILE-SHARED THROW -> inpfile S" view.tmp" R/W CREATE-FILE THROW -> outfile BEGIN buf 1000 inpfile READ-LINE THROW WHILE buf + buf ?DO I C@ CASE [CHAR] & OF S" &" outfile WRITE-FILE THROW ENDOF [CHAR] ' OF S" '" outfile WRITE-FILE THROW ENDOF [CHAR] " OF S" "" outfile WRITE-FILE THROW ENDOF [CHAR] < OF S" <" outfile WRITE-FILE THROW ENDOF [CHAR] > OF S" >" outfile WRITE-FILE THROW ENDOF I 1 outfile WRITE-FILE THROW ENDCASE LOOP LT 2 outfile WRITE-FILE THROW REPEAT DROP inpfile CLOSE-FILE THROW outfile CLOSE-FILE THROW buf FREE THROW S" cmd.exe /c copy /B head.tmp+view.tmp+tail.tmp /B view.hta > null.tmp" StartAppWait THROW S" cmd.exe /c view.hta" StartApp THROW DROP ; [/code] содержимое файла head.tmp [quote]<html> <head> <SCRIPT language="javascript"> document.onkeydown = function(event){ events = event || window.event; if (events.keyCode == 27) { window.close();}} window.resizeTo (480,240); window.moveTo((screen.width-480)/2,(screen.height-240)/2); </SCRIPT> <hta:application id=v_i_e_w applicationName=view maximizeButton=yes border=thin innerBorder=no selection=no contextMenu=no singleinstance=yes WINDOWSTATE="normal"/> <title> V I E W </title> </head><body><pre>[/quote] содержимое файла tail.tmp [quote]</pre></body></html>[/quote]
|
|
|
|
Добавлено: Сб июл 06, 2013 21:13 |
|
|
|
|
|
Заголовок сообщения: |
Re: *простой текстовый viewer |
|
|
Alex писал(а): мож кто искать будетрешение, и этот вариант подойдет да, конечно.
[quote="Alex"]мож кто искать будетрешение, и этот вариант подойдет[/quote] да, конечно.
|
|
|
|
Добавлено: Пт июл 05, 2013 20:07 |
|
|
|
|
|
Заголовок сообщения: |
Re: *простой текстовый viewer |
|
|
добавил выход по клавише ESC, прошу таки оставить в этой теме, мож кто искать будет решение, и этот вариант подойдет
добавил выход по клавише ESC, прошу таки оставить в этой теме, мож кто искать будет решение, и этот вариант подойдет
|
|
|
|
Добавлено: Пт июл 05, 2013 19:58 |
|
|
|
|
|
Заголовок сообщения: |
Re: *простой текстовый viewer |
|
|
gudleifr писал(а): Как было сказано выше Смотрим, в каком разделе находится задача Если еще остались вопросы, пожалуйста, задавайте их где-нибудь в другом месте, мне на вас нет желания тратить время. Троли мне не симпатичны, в данном разделе я стролями нянчиться не намерен.
[quote="gudleifr"]Как было сказано выше[/quote] Смотрим, в каком разделе находится задача 8)
Если еще остались вопросы, пожалуйста, задавайте их где-нибудь в другом месте, мне на вас нет желания тратить время. Троли мне не симпатичны, в данном разделе я стролями нянчиться не намерен.
|
|
|
|
Добавлено: Пт июл 05, 2013 16:42 |
|
|
|
|
|
Заголовок сообщения: |
Re: *простой текстовый viewer |
|
|
mOleg писал(а): Задача решается с отступлением от задания, а, значит, не решена. Как было сказано выше, задача была решена столько раз, что Ваши "перламутровые пуговицы" никому не интересны. (Если угодно, в мое решение выход по Esc втюхать легко. Но зачем?). Это как прийти к спортсменам прыгунам и поставить задачу - прыгать в зеленых кедах. Зачем? Кстати, вопрос по Вашему решению. Если мы после выполнения вертикального смещения из позиции "в хвостовой части длинной строки" попадаем на фрагмент коротких строк, окно уходит в пустоту или идет влево - пока не найдет текст?
[quote="mOleg"]Задача решается с отступлением от задания, а, значит, не решена.[/quote]Как было сказано выше, задача была решена столько раз, что Ваши "перламутровые пуговицы" никому не интересны. (Если угодно, в мое решение выход по Esc втюхать легко. Но зачем?). Это как прийти к спортсменам прыгунам и поставить задачу - прыгать в зеленых кедах. Зачем?
Кстати, вопрос по Вашему решению. Если мы после выполнения вертикального смещения из позиции "в хвостовой части длинной строки" попадаем на фрагмент коротких строк, окно уходит в пустоту или идет влево - пока не найдет текст?
|
|
|
|
Добавлено: Пт июл 05, 2013 16:30 |
|
|
|
|
|
Заголовок сообщения: |
Re: *простой текстовый viewer |
|
|
gudleifr писал(а): В Вашем задании про это - ни слова. Вполне достаточно выхода по 'ESC' - как вы уже заметили в стандартных компонентах этого нет. gudleifr писал(а): пожалуйста, в мое задание ваше "баба Яга против" мне не интересно в принципе. gudleifr писал(а): Поэтому в решении коллеги Alex, как и у меня, задача решается минимумом затрат, что можно только приветствовать. Задача решается с отступлением от задания, а, значит, не решена.
[quote="gudleifr"]В Вашем задании про это - ни слова. [/quote] Вполне достаточно выхода по 'ESC' - как вы уже заметили в стандартных компонентах этого нет.
[quote="gudleifr"]пожалуйста, в мое задание[/quote] ваше "баба Яга против" мне не интересно в принципе.
[quote="gudleifr"]Поэтому в решении коллеги Alex, как и у меня, задача решается минимумом затрат, что можно только приветствовать.[/quote] Задача решается с отступлением от задания, а, значит, не решена.
|
|
|
|
Добавлено: Пт июл 05, 2013 16:24 |
|
|
|
|
|
Заголовок сообщения: |
Re: *простой текстовый viewer |
|
|
mOleg писал(а): Смысл задания не в том, чтоб вызывать сторонний компонент, а чтобы использовать штатные. Вы что-то путаете. В Вашем задании про это - ни слова. (Про "смысл" - это, пожалуйста, в мое задание). Поэтому в решении коллеги Alex, как и у меня, задача решается минимумом затрат, что можно только приветствовать. (Разве что, имело заменить тег <br> на <pre>). Раздражает только опять наличие плясок с бубном. И, заметьте, это при 4-х подключенных либах. Forth-у в листинге и места не находится. Оффтоп. Когда-то я поминал 6 этапов разработки программы по Кнуту. Видимо, каждый программист подсознательно тяготеет к одному из этапов, начиная со временем остальные считать чем-то второстепенным. Любители сверхмощных ОО и прочих визуальных монстров, которые мы здесь наблюдаем, очевидно, тяготеют к пункту (4) - "Начальные установки".
[quote="mOleg"]Смысл задания не в том, чтоб вызывать сторонний компонент, а чтобы использовать штатные.[/quote]Вы что-то путаете. В Вашем задании про это - ни слова. (Про "смысл" - это, пожалуйста, в мое задание). Поэтому в решении коллеги [b]Alex[/b], как и у меня, задача решается минимумом затрат, что можно только приветствовать. (Разве что, имело заменить тег <br> на <pre>).
Раздражает только опять наличие плясок с бубном. И, заметьте, это при 4-х подключенных либах. Forth-у в листинге и места не находится.
Оффтоп. Когда-то я поминал 6 этапов разработки программы по Кнуту. Видимо, каждый программист подсознательно тяготеет к одному из этапов, начиная со временем остальные считать чем-то второстепенным. Любители сверхмощных ОО и прочих визуальных монстров, которые мы здесь наблюдаем, очевидно, тяготеют к пункту (4) - "Начальные установки".
|
|
|
|
Добавлено: Пт июл 05, 2013 16:12 |
|
|
|
|
|
Заголовок сообщения: |
Re: *простой текстовый viewer |
|
|
Alex писал(а): используем для реализации просмотрщика сторонние Смысл задания не в том, чтоб вызывать сторонний компонент, а чтобы использовать штатные.
[quote="Alex"]используем для реализации просмотрщика сторонние[/quote] Смысл задания не в том, чтоб вызывать сторонний компонент, а чтобы использовать штатные.
|
|
|
|
Добавлено: Пт июл 05, 2013 14:55 |
|
|
|
|
|
Заголовок сообщения: |
Re: *простой текстовый viewer |
|
|
используем для реализации просмотрщика сторонние (html,hta) технологии, так как поведение на стрелки, начало и конец и листание страниц такое-же как и требуется. заданный файл обернем в начале и в конце заготовленными фрагментами для формирования приложения view.hta при копировании строк исходного файла дополним их hnml символами перевода строки решение не соответствует полностью заданию, так нет выхода по ESC но оно здесь и не надо, так как действует как независимое приложение и закрывается штатно. написано на SPF4, под win. Код: mutex.f process.f locals.f str5.f
: VIEW { a u \ buf inpfile outfile -- } 500 ALLOCATE THROW -> buf a u R/O OPEN-FILE-SHARED THROW -> inpfile S" view.hta" R/W CREATE-FILE THROW -> outfile " <html> <head> <SCRIPT language={''}javascript{''}> document.onkeydown = function(event){ S' {' } events = event || window.event; if (events.keyCode == 27) { S' {' } window.close();}} window.resizeTo (480,240); window.moveTo((screen.width-480)/2,(screen.height-240)/2); </SCRIPT> <hta:application id=v_i_e_w applicationName=view maximizeButton=yes border=thin innerBorder=no selection=no contextMenu=no singleinstance=yes WINDOWSTATE={''}normal{''} /> <title> V I E W </title> </head>{CRLF}<body>" DUP STR@ outfile WRITE-FILE THROW STRFREE
BEGIN buf 500 inpfile READ-LINE THROW WHILE buf SWAP outfile WRITE-FILE THROW S" <br>" outfile WRITE-FILE THROW LT 2 outfile WRITE-FILE THROW REPEAT DROP inpfile CLOSE-FILE THROW
" </body>{CRLF}</html>" DUP STR@ outfile WRITE-FILE THROW outfile CLOSE-FILE THROW STRFREE S" cmd.exe /c view.hta" StartApp THROW DROP ;
используем для реализации просмотрщика сторонние (html,hta) технологии, так как поведение на стрелки, начало и конец и листание страниц такое-же как и требуется. заданный файл обернем в начале и в конце заготовленными фрагментами для формирования приложения view.hta при копировании строк исходного файла дополним их hnml символами перевода строки решение не соответствует полностью заданию, так нет выхода по ESC но оно здесь и не надо, так как действует как независимое приложение и закрывается штатно. написано на SPF4, под win. [code] mutex.f process.f locals.f str5.f
: VIEW { a u \ buf inpfile outfile -- } 500 ALLOCATE THROW -> buf a u R/O OPEN-FILE-SHARED THROW -> inpfile S" view.hta" R/W CREATE-FILE THROW -> outfile " <html> <head> <SCRIPT language={''}javascript{''}> document.onkeydown = function(event){ S' {' } events = event || window.event; if (events.keyCode == 27) { S' {' } window.close();}} window.resizeTo (480,240); window.moveTo((screen.width-480)/2,(screen.height-240)/2); </SCRIPT> <hta:application id=v_i_e_w applicationName=view maximizeButton=yes border=thin innerBorder=no selection=no contextMenu=no singleinstance=yes WINDOWSTATE={''}normal{''} /> <title> V I E W </title> </head>{CRLF}<body>" DUP STR@ outfile WRITE-FILE THROW STRFREE
BEGIN buf 500 inpfile READ-LINE THROW WHILE buf SWAP outfile WRITE-FILE THROW S" <br>" outfile WRITE-FILE THROW LT 2 outfile WRITE-FILE THROW REPEAT DROP inpfile CLOSE-FILE THROW
" </body>{CRLF}</html>" DUP STR@ outfile WRITE-FILE THROW outfile CLOSE-FILE THROW STRFREE S" cmd.exe /c view.hta" StartApp THROW DROP ; [/code]
|
|
|
|
Добавлено: Пт июл 05, 2013 13:11 |
|
|
|
|
|
Заголовок сообщения: |
Re: *простой текстовый viewer |
|
|
Цитата: Он показал нам блок-схему программы, предназначавшейся для решения этой задачи, но стрелки, которые вели от одного квадратика к другому, были так беспорядочно расположены, что мы оба решили не рассматривать это решение (если оно было решением, что мы так и не смогли выяснить!). Цитата: [Нужны ли константы клавиш?] Ответ зависит от того, считаете ли Вы, что другим компонентам надо будет "знать" числовое значение, связанное с каждой клавишей. Чаще этого "не" требуется. Простая, более компактная форма здесь поэтому предпочтительнее. Также в первой версии [с константами] добавление нового кода клавиши потребует изменений в двух местах. А, если серьезно, я вижу несколько важных ошибок: 1. Программа написана не на Forth, а на плохом C (с механической заменой операторов на слова). Коробит, наше отношение к Броуди. Мы его чтим, но то, что он писал, пропускаем мимо ушей. 2. Программа, очевидно, очень сильно ОС-зависима (ср. мое решение), но эти зависимости в решении не обособлены. 3. Разбиение на слова было произведено по-чайниковски: по командам интерфейса, а не по правилам организации вычислений и/или доказательства корректности. 4. Заодно видны недостатки выбранного средства программирования: обилие не нужных для решения танцев с бубном. Зачем писать сверхмощный Forth, если половина листинга полностью состоит из его настроек? Был бы умный, сам бы настроился.
[quote]Он показал нам блок-схему программы, предназначавшейся для решения этой задачи, но стрелки, которые вели от одного квадратика к другому, были так беспорядочно расположены, что мы оба решили не рассматривать это решение (если оно было решением, что мы так и не смогли выяснить!).[/quote] [quote][Нужны ли константы клавиш?] Ответ зависит от того, считаете ли Вы, что другим компонентам надо будет "знать" числовое значение, связанное с каждой клавишей. Чаще этого "не" требуется. Простая, более компактная форма здесь поэтому предпочтительнее. Также в первой версии [с константами] добавление нового кода клавиши потребует изменений в двух местах.[/quote] А, если серьезно, я вижу несколько важных ошибок: 1. Программа написана не на Forth, а на плохом C (с механической заменой операторов на слова). Коробит, наше отношение к Броуди. Мы его чтим, но то, что он писал, пропускаем мимо ушей. 2. Программа, очевидно, очень сильно ОС-зависима (ср. мое решение), но эти зависимости в решении не обособлены. 3. Разбиение на слова было произведено по-чайниковски: по командам интерфейса, а не по правилам организации вычислений и/или доказательства корректности. 4. Заодно видны недостатки выбранного средства программирования: обилие не нужных для решения танцев с бубном. Зачем писать сверхмощный Forth, если половина листинга полностью состоит из его настроек? Был бы умный, сам бы настроился.
|
|
|
|
Добавлено: Чт июл 04, 2013 09:18 |
|
|
|
|
|
Заголовок сообщения: |
Re: *простой текстовый viewer |
|
|
написано для форка используемая версия 4-mc10-b750. source file: view.fts \ 02.07.2013 ~mOleg \ Copyright [C] 2013 mOleg mOlegg@ya.ru \ простой просмотрщик текстовых файлов
vocs/ unit.fts vocs/ struct.fts os/ heap.fts os/ console.fts os/ ccon.fts branch/ for-next.fts memory/ buff.fts
ALSO HIDDEN ALIAS EKEY SYSKEY ALIAS EKEY? key? PREVIOUS
vocs/ unit.fts
Unit: key'
F: esc 0x101001B ;F F: up 0x1480000 ;F F: dn 0x1500000 ;F F: left 0x14B0000 ;F F: right 0x14D0000 ;F
F: home 0x1470000 ;F F: end 0x14F0000 ;F F: pgup 0x1490000 ;F F: pgdn 0x1510000 ;F EndUnit
Unit: View{
USER 1stLine \ первая линия текста USER LastLine \ последняя линия текста USER TopLine \ первая отображаемая линия текста
70 VALUE Width \ ширина рабочей области экрана 0 VALUE Displ \ смещение первого отображаемого символа от начала строки 0 VALUE Up \ положение первого символа окна просмотра слева 0 VALUE Top \ и сверху 25 VALUE Height \ высота рабочей области экрана 255 VALUE MaxWidth \ максимальная длина строки
\ каждая линия хранится отдельно 0 Struct: line Addr[] off_prev \ ссылка на предыдущую линию текста Addr[] off_next \ ссылка на следующую линию текста Cell[] off_size \ длина строки Zero[] off_body \ начало текста EndStruct
\ получить указатель на следующую линию текста : next ( str --> str | nil ) line off_next A@ ;
\ задать ссылку str2 на следующую строку str1 : !next ( str1 str2 --> ) line off_next A! ;
\ получить указатель на предыдущую линию текста : prev ( str --> str | nil ) line off_prev A@ ;
\ задать ссылку str2 на предыдущую строку str1 : !prev ( str1 str2 --> ) line off_prev A! ;
\ вернуть начало a2 и a1 конец строки ? : str> ( str --> asc # ) DUP line off_size @ SWAP line off_body SWAP ;
\ создать новую запись в хипе, скопировать туда содержимое строки ? : new ( asc # --> str ) DUP line /size + BLOCK >L TUCK L@ line off_body SWAP CMOVE L@ line off_size ! nil L@ !prev nil L@ !next L> ;
\ добавить строку в конец текста : push ( str --> ) LastLine A@ OVER !prev DUP LastLine A@ !next LastLine A! ;
\ задать начальное состояние : set ( str --> ) DUP 1stLine A! DUP LastLine A! TopLine A! ;
\ добавить строку в конец списка строк : add ( str --> ) 1stLine @ IF push ;THEN set ;
\ пропустить u символов с начала строки : skip ( asc # u --> a1 a2 ) >L OVER + SWAP BEGIN DDUP > WHILE L@ WHILE -1 L+ C+ REPEAT THEN LDROP ;
\ преобразовать ограниченную a1, a2 строку в строку длиной # символов \ при необходимости дополненную в конце пробельными символами : form ( a1 a2 # --> asc # ) <| >L BEGIN L@ WHILE DDUP > WHILE -1 L+ DUP C@ KEEP C+ REPEAT BEGIN L@ WHILE Bl_ KEEP -1 L+ REPEAT THEN DDROP LDROP |> ;
\ подготовить строку addr для отображения \ u - смещение от начала строки, # - количество символов для отображения : prep ( # u asc # --> asc # ) ROT skip ROT form TYPE ;
\ отобразить текст в окне начиная с позиции up top размером width height \ текст сместить от начала строк на x позиций : show ( width disp TopLine up top height --> ) FOR DDUP setxy D>L THRID THRID THRID IF THRID str> prep next ELSE s" " prep THEN DL> 1 + TILL 5 nDROP ;
\ загрузка строк из файла : load ( asc # --> ) FILE>HEAP IFNOT ERROR" Invalid file name!" THEN OVER >L <: BOUNDS SWAP BEGIN DDUP < WHILE DDUP EOL> -ROT THRID ROT TUCK - LTL @ - 0 MAX new add REPEAT DDROP ;> CATCH L> FREE DROP THROW ;
\ освободить занимаемую память : free ( 1stLine --> ) A@ BEGIN *WHILE DUP next SWAP FREE DROP REPEAT DROP nil set ;
\ сместить окно на одну линию вверх : TopUp ( --> ) TopLine A@ prev *IF TopLine A! ELSE DROP THEN ;
\ сместить окно на одну линию вниз : TopDn ( --> ) TopLine A@ next *IF TopLine A! ELSE DROP THEN ;
\ на одну страницу вверх : PgUp ( --> ) Height FOR TopUp TILL ;
\ на одну страницу вниз : PgDn ( --> ) Height FOR TopDn TILL ;
\ обработка событий нажатий клавиш : reflex ( key --> ) CASE key' esc OF ERROR" Ok." ENDOF key' dn OF TopDn ENDOF key' up OF TopUp ENDOF key' right OF Displ 1 + MaxWidth Width - MIN TO Displ ENDOF key' left OF Displ 1 - 0 MAX TO Displ ENDOF key' pgup OF PgUp ENDOF key' pgdn OF PgDn ENDOF key' home OF 1stLine A@ TopLine A! ENDOF key' end OF LastLine A@ TopLine A! ENDOF DROP ENDCASE ;
\ отобразить страницу текста в окне : ~Page ( --> ) Width Displ TopLine A@ Up Top Height show ;
\ главный рабочий цикл :> Viewer ( --> ) ~Page BEGIN key? IF SYSKEY reflex ~Page THEN 10 PAUSE AGAIN ;
F: } ;F
EndUnit
\ отобразить содержимое указанного файла : VIEW ( asc # --> ) View{ DDUP ~title load HideCur width TO Width height 1 - TO Height Viewer CATCH DROP 1stLine free ShowCur } ;
написано для [url=http://fforum.winglion.ru/viewtopic.php?p=37472#p37472]форка[/url] используемая версия 4-mc10-b750.
[pre]source file: view.fts [b][color=#808080]\ 02.07.2013 ~mOleg[/color] [color=#808080]\ Copyright [C] 2013 mOleg mOlegg@ya.ru[/color] [color=#808080]\ простой просмотрщик текстовых файлов[/color]
[color=#00F000]vocs/ unit.fts[/color] [color=#00F000]vocs/ struct.fts[/color] [color=#00F000]os/ heap.fts[/color] [color=#00F000]os/ console.fts[/color] [color=#00F000]os/ ccon.fts[/color] [color=#00F000]branch/ for-next.fts[/color] [color=#00F000]memory/ buff.fts[/color]
[color=#FF00FF]ALSO[/color] [color=#FF00FF]HIDDEN[/color] [color=#FF8000]ALIAS EKEY SYSKEY[/color] [color=#FF8000]ALIAS EKEY? key?[/color] [color=#FF00FF]PREVIOUS[/color]
[color=#00F000]vocs/ unit.fts[/color]
[color=#FF8000]Unit: key'[/color]
[color=#FF8000]F: esc[/color] [color=#00F000]0x101001B[/color] [color=#FF8000];F[/color] [color=#FF8000]F: up[/color] [color=#00F000]0x1480000[/color] [color=#FF8000];F[/color] [color=#FF8000]F: dn[/color] [color=#00F000]0x1500000[/color] [color=#FF8000];F[/color] [color=#FF8000]F: left[/color] [color=#00F000]0x14B0000[/color] [color=#FF8000];F[/color] [color=#FF8000]F: right[/color] [color=#00F000]0x14D0000[/color] [color=#FF8000];F[/color]
[color=#FF8000]F: home[/color] [color=#00F000]0x1470000[/color] [color=#FF8000];F[/color] [color=#FF8000]F: end[/color] [color=#00F000]0x14F0000[/color] [color=#FF8000];F[/color] [color=#FF8000]F: pgup[/color] [color=#00F000]0x1490000[/color] [color=#FF8000];F[/color] [color=#FF8000]F: pgdn[/color] [color=#00F000]0x1510000[/color] [color=#FF8000];F[/color] [color=#FF8000]EndUnit[/color]
[color=#FF8000]Unit: View{[/color]
[color=#FF8000]USER 1stLine[/color] [color=#808080]\ первая линия текста[/color] [color=#FF8000]USER LastLine[/color] [color=#808080]\ последняя линия текста[/color] [color=#FF8000]USER TopLine[/color] [color=#808080]\ первая отображаемая линия текста[/color]
[color=#00F000]70[/color] [color=#FF8000]VALUE Width[/color] [color=#808080]\ ширина рабочей области экрана[/color] [color=#00F000]0[/color] [color=#FF8000]VALUE Displ[/color] [color=#808080]\ смещение первого отображаемого символа от начала строки[/color] [color=#00F000]0[/color] [color=#FF8000]VALUE Up[/color] [color=#808080]\ положение первого символа окна просмотра слева[/color] [color=#00F000]0[/color] [color=#FF8000]VALUE Top[/color] [color=#808080]\ и сверху[/color] [color=#00F000]25[/color] [color=#FF8000]VALUE Height[/color] [color=#808080]\ высота рабочей области экрана[/color] [color=#00F000]255[/color] [color=#FF8000]VALUE MaxWidth[/color] [color=#808080]\ максимальная длина строки[/color]
[color=#808080]\ каждая линия хранится отдельно[/color] [color=#00F000]0[/color] [color=#FF8000]Struct: line[/color] [color=#808000]Addr[] off_prev[/color] [color=#808080]\ ссылка на предыдущую линию текста[/color] [color=#808000]Addr[] off_next[/color] [color=#808080]\ ссылка на следующую линию текста[/color] [color=#808000]Cell[] off_size[/color] [color=#808080]\ длина строки[/color] [color=#808000]Zero[] off_body[/color] [color=#808080]\ начало текста[/color] [color=#FF8000]EndStruct[/color]
[color=#808080]\ получить указатель на следующую линию текста[/color] [color=#FF8000]: next[/color] [color=#0080C0]( str --> str | nil )[/color] line off_next A@ [color=#FF8000];[/color]
[color=#808080]\ задать ссылку str2 на следующую строку str1[/color] [color=#FF8000]: !next[/color] [color=#0080C0]( str1 str2 --> )[/color] line off_next A! [color=#FF8000];[/color]
[color=#808080]\ получить указатель на предыдущую линию текста[/color] [color=#FF8000]: prev[/color] [color=#0080C0]( str --> str | nil )[/color] line off_prev A@ [color=#FF8000];[/color]
[color=#808080]\ задать ссылку str2 на предыдущую строку str1[/color] [color=#FF8000]: !prev[/color] [color=#0080C0]( str1 str2 --> )[/color] line off_prev A! [color=#FF8000];[/color]
[color=#808080]\ вернуть начало a2 и a1 конец строки ?[/color] [color=#FF8000]: str>[/color] [color=#0080C0]( str --> asc # )[/color] DUP line off_size @ SWAP line off_body SWAP [color=#FF8000];[/color]
[color=#808080]\ создать новую запись в хипе, скопировать туда содержимое строки ?[/color] [color=#FF8000]: new[/color] [color=#0080C0]( asc # --> str )[/color] DUP line /size + BLOCK >L TUCK L@ line off_body SWAP CMOVE L@ line off_size ! nil L@ !prev nil L@ !next L> [color=#FF8000];[/color]
[color=#808080]\ добавить строку в конец текста[/color] [color=#FF8000]: push[/color] [color=#0080C0]( str --> )[/color] LastLine A@ OVER !prev DUP LastLine A@ !next LastLine A! [color=#FF8000];[/color]
[color=#808080]\ задать начальное состояние[/color] [color=#FF8000]: set[/color] [color=#0080C0]( str --> )[/color] DUP 1stLine A! DUP LastLine A! TopLine A! [color=#FF8000];[/color]
[color=#808080]\ добавить строку в конец списка строк[/color] [color=#FF8000]: add[/color] [color=#0080C0]( str --> )[/color] 1stLine @ [color=#00A0A0]IF[/color] push [color=#FF8000];THEN[/color] set [color=#FF8000];[/color]
[color=#808080]\ пропустить u символов с начала строки[/color] [color=#FF8000]: skip[/color] [color=#0080C0]( asc # u --> a1 a2 )[/color] >L OVER + SWAP [color=#00A0A0]BEGIN[/color] DDUP > [color=#00A0A0]WHILE[/color] L@ [color=#00A0A0]WHILE[/color] [color=#00F000]-1[/color] L+ C+ [color=#00A0A0]REPEAT[/color] [color=#00A0A0]THEN[/color] LDROP [color=#FF8000];[/color]
[color=#808080]\ преобразовать ограниченную a1, a2 строку в строку длиной # символов[/color] [color=#808080]\ при необходимости дополненную в конце пробельными символами[/color] [color=#FF8000]: form[/color] [color=#0080C0]( a1 a2 # --> asc # )[/color] [color=#0000F0]<|[/color] >L [color=#00A0A0]BEGIN[/color] L@ [color=#00A0A0]WHILE[/color] DDUP > [color=#00A0A0]WHILE[/color] [color=#00F000]-1[/color] L+ DUP C@ [color=#0000F0]KEEP[/color] C+ [color=#00A0A0]REPEAT[/color] [color=#00A0A0]BEGIN[/color] L@ [color=#00A0A0]WHILE[/color] [color=#00F000]Bl_[/color] [color=#0000F0]KEEP[/color] [color=#00F000]-1[/color] L+ [color=#00A0A0]REPEAT[/color] [color=#00A0A0]THEN[/color] DDROP LDROP [color=#0000F0]|>[/color] [color=#FF8000];[/color]
[color=#808080]\ подготовить строку addr для отображения[/color] [color=#808080]\ u - смещение от начала строки, # - количество символов для отображения[/color] [color=#FF8000]: prep[/color] [color=#0080C0]( # u asc # --> asc # )[/color] ROT skip ROT form TYPE [color=#FF8000];[/color]
[color=#808080]\ отобразить текст в окне начиная с позиции up top размером width height[/color] [color=#808080]\ текст сместить от начала строк на x позиций[/color] [color=#FF8000]: show[/color] [color=#0080C0]( width disp TopLine up top height --> )[/color] FOR DDUP setxy D>L THRID THRID THRID [color=#00A0A0]IF[/color] THRID str> prep next [color=#00A0A0]ELSE[/color] [color=#00F000]s" "[/color] prep [color=#00A0A0]THEN[/color] DL> [color=#00F000]1[/color] + TILL [color=#00F000]5[/color] nDROP [color=#FF8000];[/color]
[color=#808080]\ загрузка строк из файла[/color] [color=#FF8000]: load[/color] [color=#0080C0]( asc # --> )[/color] FILE>HEAP [color=#00A0A0]IFNOT[/color] [color=#C00000]ERROR" Invalid file name!"[/color] [color=#00A0A0]THEN[/color] OVER >L [color=#FF8000]<: BOUNDS[/color] SWAP [color=#00A0A0]BEGIN[/color] DDUP < [color=#00A0A0]WHILE[/color] DDUP EOL> -ROT THRID ROT TUCK - LTL @ - [color=#00F000]0[/color] MAX new add [color=#00A0A0]REPEAT[/color] DDROP [color=#FF8000];>[/color] CATCH L> FREE DROP [color=#C00000]THROW[/color] [color=#FF8000];[/color]
[color=#808080]\ освободить занимаемую память[/color] [color=#FF8000]: free[/color] [color=#0080C0]( 1stLine --> )[/color] A@ [color=#00A0A0]BEGIN[/color] [color=#00A0A0]*WHILE[/color] DUP next SWAP FREE DROP [color=#00A0A0]REPEAT[/color] DROP nil set [color=#FF8000];[/color]
[color=#808080]\ сместить окно на одну линию вверх[/color] [color=#FF8000]: TopUp[/color] [color=#0080C0]( --> )[/color] TopLine A@ prev [color=#00A0A0]*IF[/color] TopLine A! [color=#00A0A0]ELSE[/color] DROP [color=#00A0A0]THEN[/color] [color=#FF8000];[/color]
[color=#808080]\ сместить окно на одну линию вниз[/color] [color=#FF8000]: TopDn[/color] [color=#0080C0]( --> )[/color] TopLine A@ next [color=#00A0A0]*IF[/color] TopLine A! [color=#00A0A0]ELSE[/color] DROP [color=#00A0A0]THEN[/color] [color=#FF8000];[/color]
[color=#808080]\ на одну страницу вверх[/color] [color=#FF8000]: PgUp[/color] [color=#0080C0]( --> )[/color] Height FOR TopUp TILL [color=#FF8000];[/color]
[color=#808080]\ на одну страницу вниз[/color] [color=#FF8000]: PgDn[/color] [color=#0080C0]( --> )[/color] Height FOR TopDn TILL [color=#FF8000];[/color]
[color=#808080]\ обработка событий нажатий клавиш[/color] [color=#FF8000]: reflex[/color] [color=#0080C0]( key --> )[/color] CASE key' esc OF [color=#C00000]ERROR" Ok."[/color] ENDOF key' dn OF TopDn ENDOF key' up OF TopUp ENDOF key' right OF Displ [color=#00F000]1[/color] + MaxWidth Width - MIN TO Displ ENDOF key' left OF Displ [color=#00F000]1[/color] - [color=#00F000]0[/color] MAX TO Displ ENDOF key' pgup OF PgUp ENDOF key' pgdn OF PgDn ENDOF key' home OF 1stLine A@ TopLine A! ENDOF key' end OF LastLine A@ TopLine A! ENDOF DROP ENDCASE [color=#FF8000];[/color]
[color=#808080]\ отобразить страницу текста в окне[/color] [color=#FF8000]: ~Page[/color] [color=#0080C0]( --> )[/color] Width Displ TopLine A@ Up Top Height show [color=#FF8000];[/color]
[color=#808080]\ главный рабочий цикл[/color] [color=#FF8000]:> Viewer[/color] [color=#0080C0]( --> )[/color] ~Page [color=#00A0A0]BEGIN[/color] key? [color=#00A0A0]IF[/color] SYSKEY reflex ~Page [color=#00A0A0]THEN[/color] [color=#00F000]10[/color] PAUSE [color=#00A0A0]AGAIN[/color] [color=#FF8000];[/color]
[color=#FF8000]F: }[/color] [color=#FF8000];F[/color]
[color=#FF8000]EndUnit[/color]
[color=#808080]\ отобразить содержимое указанного файла[/color] [color=#FF8000]: VIEW[/color] [color=#0080C0]( asc # --> )[/color] View{ DDUP ~title load HideCur width TO Width height [color=#00F000]1[/color] - TO Height Viewer CATCH DROP 1stLine free ShowCur } [color=#FF8000];[/color] [/b][/pre]
|
|
|
|
Добавлено: Чт июл 04, 2013 08:56 |
|
|
|
|