Автор |
Сообщение |
|
|
Заголовок сообщения: |
|
|
|
profiT писал(а): А вот, раз пошли личные тычки и мерянье своими аршинами чужого кода (нафик?..), то и я выражу своё глубочайшее убеждение что "не пользовался библиотеками" -- это само- и форто- вредительство. Это постоянное сидение на низких уровнях, когда за битами не видно леса, когда в байтах копаючись на каждый пых по собственному гордому велосипеду пишем.
А давайте не будем шпынять друг друга?
Не поверю, что кому-либо из профессионалов-программистов
не приходилось никогда ковыряться в битах и байтах.
И не поверю, что кто-то из них не изобрел ни одного велосипеда.
[quote="profiT"]А вот, раз пошли личные тычки и мерянье своими аршинами чужого кода (нафик?..), то и я выражу своё глубочайшее убеждение что "не пользовался библиотеками" -- это само- и форто- вредительство. Это постоянное сидение на низких уровнях, когда за битами не видно леса, когда в байтах копаючись на каждый пых по собственному гордому велосипеду пишем. [/quote]
А давайте не будем шпынять друг друга?
Не поверю, что кому-либо из профессионалов-программистов
не приходилось никогда ковыряться в битах и байтах.
И не поверю, что кто-то из них не изобрел ни одного велосипеда.
|
|
|
|
Добавлено: Чт май 17, 2007 18:18 |
|
|
|
|
|
Заголовок сообщения: |
|
|
|
Цитата: Самый неподходящий пример кода у profit - одно огромное слово
Собственно говоря, это не я код опубликовал. Я то как раз предупреждал, но меня не слушали.
Просто специфика такая. Бесмысленно писать тучу слов если можно сказать одной фразой, пусть и длинной. Если нет повторного использования -- то и разбивать нет никакого смысла.
А вот, раз пошли личные тычки и мерянье своими аршинами чужого кода (нафик?..), то и я выражу своё глубочайшее убеждение что "не пользовался библиотеками" -- это само- и форто- вредительство. Это постоянное сидение на низких уровнях, когда за битами не видно леса, когда в байтах копаючись на каждый пых по собственному гордому велосипеду пишем.
[quote]Самый неподходящий пример кода у profit - одно огромное слово[/quote]
Собственно говоря, это не я код опубликовал. Я то как раз предупреждал, но меня не слушали.
Просто специфика такая. Бесмысленно писать тучу слов если можно сказать одной фразой, пусть и длинной. Если нет повторного использования -- то и разбивать нет никакого смысла.
А вот, раз пошли личные тычки и мерянье своими аршинами чужого кода (нафик?..), то и я выражу своё глубочайшее убеждение что "не пользовался библиотеками" -- это само- и форто- вредительство. Это постоянное сидение на низких уровнях, когда за битами не видно леса, когда в байтах копаючись на каждый пых по собственному гордому велосипеду пишем.
|
|
|
|
Добавлено: Чт май 17, 2007 17:05 |
|
|
|
|
|
Заголовок сообщения: |
|
|
|
ygrek писал(а): Офигительно корректно оценивать решения по неизвестным изначально критериям.
Вообще здесь скорее обзор решений, а не оценка, к тому же мой личный взгляд на это дело.
По крайней мере пока никто не собирается ставить оценки, баллы или тому подобными вещами заниматься.
[quote="ygrek"]Офигительно корректно оценивать решения по неизвестным изначально критериям.[/quote]
Вообще здесь скорее обзор решений, а не оценка, к тому же мой личный взгляд на это дело.
По крайней мере пока никто не собирается ставить оценки, баллы или тому подобными вещами заниматься.
|
|
|
|
Добавлено: Чт май 17, 2007 13:09 |
|
|
|
|
|
Заголовок сообщения: |
|
|
|
Офигительно корректно оценивать решения по неизвестным изначально критериям.
Офигительно корректно оценивать решения по неизвестным изначально критериям.
|
|
|
|
Добавлено: Чт май 17, 2007 13:03 |
|
|
|
|
|
Заголовок сообщения: |
|
|
|
ну что же, пора подводить некоторые итоги
Во-первых, оказалось, что написать корректное ТЗ достаточно непросто, и к сожалению читать его тоже не просто 8(
Во-вторых пока что был использован для решения задач только один конкретный форт - СПФ, что вобщем-то неудивительно.
Только я обошелся стандартными средствами, предоставляемыми СПФ - то есть не пользовался библиотеками, остальные решения используют локальные переменные. (Кстати без локальных переменных не обошелся и я, но они у меня именованые USER переменные). Но при этом без динамической памяти не обошелся никто ( что не удивительно 21 век на дворе ), а это значит, что все решения придется модифицировать в той или иной степени при переносе решения на какой-нибудь более простой форт, у которого нету heap. Только я предусмотрел возможность смены стратегий распределения пробелов в тексте(то есть выделил в отдельное слово), было бы интересно немного поменять ТЗ, таким образом посмотреть, кому сколько труда придется вложить при изменении некоторых моментов, например введение абзаца в начале строки и изменение стратегии добавления пробелов в формируемую строку.
Самый неподходящий пример кода у profit - одно огромное слово 8( я даже не пытался разбираться в его работе из-за двух причин: бектрекинг, который не так уж и прост для понимания и размер слова, да при практически полном отсутсвии коментариев. Я не считаю данный пример фортом - уж извините. ( это мое личное мнение, как и все написанное в этом посте )
Самый красивый код у ygrek-а(в смысле раскрашенный) но практически без коментариев 8( Не то чтобы они очень нужны, но все же...
Решение Mrak-а интересно уже тем, что он частично продублировал парсер СПФа. С другой стороны использование RESIZE
при формировании выходной строки очень дорогое решение с точки зрения производительности (ужастно дорогое). Еще для меня очень интересно использование ASCIIZ строк.
Вот, ежели кто еще чего хочет сказать - не стесняйтесь
ну что же, пора подводить некоторые итоги 8)
Во-первых, оказалось, что написать корректное ТЗ достаточно непросто, и к сожалению читать его тоже не просто 8(
Во-вторых пока что был использован для решения задач только один конкретный форт - СПФ, что вобщем-то неудивительно.
Только я обошелся стандартными средствами, предоставляемыми СПФ - то есть не пользовался библиотеками, остальные решения используют локальные переменные. (Кстати без локальных переменных не обошелся и я, но они у меня именованые USER переменные). Но при этом без динамической памяти не обошелся никто ( что не удивительно 21 век на дворе ), а это значит, что все решения придется модифицировать в той или иной степени при переносе решения на какой-нибудь более простой форт, у которого нету heap. Только я предусмотрел возможность смены стратегий распределения пробелов в тексте(то есть выделил в отдельное слово), было бы интересно немного поменять ТЗ, таким образом посмотреть, кому сколько труда придется вложить при изменении некоторых моментов, например введение абзаца в начале строки и изменение стратегии добавления пробелов в формируемую строку.
Самый неподходящий пример кода у profit - одно огромное слово 8( я даже не пытался разбираться в его работе из-за двух причин: бектрекинг, который не так уж и прост для понимания и размер слова, да при практически полном отсутсвии коментариев. Я не считаю данный пример фортом - уж извините. ( это мое личное мнение, как и все написанное в этом посте )
Самый красивый код у ygrek-а(в смысле раскрашенный) но практически без коментариев 8( Не то чтобы они очень нужны, но все же...
Решение Mrak-а интересно уже тем, что он частично продублировал парсер СПФа. С другой стороны использование RESIZE
при формировании выходной строки очень дорогое решение с точки зрения производительности (ужастно дорогое). Еще для меня очень интересно использование ASCIIZ строк.
Вот, ежели кто еще чего хочет сказать - не стесняйтесь
|
|
|
|
Добавлено: Чт май 17, 2007 12:22 |
|
|
|
|
|
Заголовок сообщения: |
|
|
|
Код: \ gl0 SPF4.18 STARTLOG lib/ext/locals.f \ создать строку : crtstr ( u -- adr ) 4 + ALLOCATE THROW DUP 0 SWAP ! ; \ получить из adr -- adr u : au ( adr -- adr u ) DUP 4 + SWAP @ ;
\ прибавить к строке : str+ ( adr adr1 u1 -- adr ) { adr adr1 u1 } adr DUP @ 4 + u1 + RESIZE THROW -> adr adr DUP @ 4 + + adr1 SWAP u1 MOVE adr @ u1 + adr ! adr ;
\ пропустить блок пробелов если они есть : sp ( adr u -- adr1 u1 ) SWAP BEGIN DUP C@ 32 = WHILE 1+ SWAP 1- SWAP REPEAT SWAP ; \ из adr u выбрать первое слово игнорируя предшествующие пробелы длиной не более p : getfwrd ( adr u p -- adr u1 ) { p } sp DUP IF OVER BEGIN DUP C@ 32 = >R OVER 0= R> + p 1 < + 0= WHILE 1+ SWAP 1- SWAP p 1- -> p REPEAT NIP OVER - THEN ; \ считать файл, adr u - имя файла adr1 - строка с текстом файла : in_fl ( adr u -- adr1 ) { \ hndl adr u } R/O OPEN-FILE THROW DUP -> hndl FILE-SIZE THROW D>S -> u u 4 + ALLOCATE THROW DUP -> adr 4 + u hndl READ-FILE THROW DROP hndl CLOSE-FILE THROW u adr ! adr ; \ перебрать строку установив между словами раздилитель 0 байт на слова не длиннее p \ тоесть если попадеться слово длинее строки его порубят на части не привышающие p : pr1 ( adr p -- adr ) { p \ s } 0 crtstr -> s s S" " OVER 0 SWAP C! str+ -> s au BEGIN DUP WHILE 2DUP p getfwrd 2DUP s ROT ROT str+ -> s \ CR TYPE s S" " OVER 0 SWAP C! str+ -> s 2DUP + >R ROT SWAP - >R SWAP - R> SWAP - R> SWAP REPEAT 2DROP s ; \ в строке adr u начиная от конца найти первыйнуль байт и оставить u1 длину строки от adr до последнего нуль байта : pr2.1 ( adr u -- u1 ) 2DUP + NIP 1+ BEGIN 1- DUP C@ 0 = >R 2DUP = R> + UNTIL 2DUP SWAP - NIP ; \ получить количество нульбайт в строке adr u : k0? ( adr u -- n ) { \ n } 0 DO DUP I + C@ 0 = IF n 1+ -> n THEN LOOP DROP n ; \ проиизвести форматную печать строки "adr u" c количеством груп пробелов "k" \ и небходимым к распределению "n" пробелов : fprint ( adr u k n -- ) { adr u k n } n k + -> n k 1+ 0 ?DO adr ASCIIZ> u MIN DUP >R TYPE n k 1 MAX / DUP n SWAP - -> n k 1- -> k SPACES R@ u SWAP - 1- -> u R> adr + 1+ -> adr LOOP ; \ разложить входную строку по строкам : pr2 ( adr p -- adr ) { p \ s } 0 crtstr -> s au 1- BEGIN 1 - SWAP 1 + SWAP 0 MAX DUP WHILE DUP p > IF OVER p pr2.1 ELSE 2DUP THEN 2DUP 2DUP DUP p SWAP - >R k0? R> fprint CR NIP DUP ROT SWAP - SWAP ROT + SWAP REPEAT 2DROP ; \ TEST 80 VALUE fp \ ширина форматирования S" in.txt" in_fl fp pr1 fp pr2 \EOF ну вот примерно гдето так
[code]\ gl0 SPF4.18 STARTLOG lib/ext/locals.f \ создать строку : crtstr ( u -- adr ) 4 + ALLOCATE THROW DUP 0 SWAP ! ; \ получить из adr -- adr u : au ( adr -- adr u ) DUP 4 + SWAP @ ;
\ прибавить к строке : str+ ( adr adr1 u1 -- adr ) { adr adr1 u1 } adr DUP @ 4 + u1 + RESIZE THROW -> adr adr DUP @ 4 + + adr1 SWAP u1 MOVE adr @ u1 + adr ! adr ;
\ пропустить блок пробелов если они есть : sp ( adr u -- adr1 u1 ) SWAP BEGIN DUP C@ 32 = WHILE 1+ SWAP 1- SWAP REPEAT SWAP ; \ из adr u выбрать первое слово игнорируя предшествующие пробелы длиной не более p : getfwrd ( adr u p -- adr u1 ) { p } sp DUP IF OVER BEGIN DUP C@ 32 = >R OVER 0= R> + p 1 < + 0= WHILE 1+ SWAP 1- SWAP p 1- -> p REPEAT NIP OVER - THEN ; \ считать файл, adr u - имя файла adr1 - строка с текстом файла : in_fl ( adr u -- adr1 ) { \ hndl adr u } R/O OPEN-FILE THROW DUP -> hndl FILE-SIZE THROW D>S -> u u 4 + ALLOCATE THROW DUP -> adr 4 + u hndl READ-FILE THROW DROP hndl CLOSE-FILE THROW u adr ! adr ; \ перебрать строку установив между словами раздилитель 0 байт на слова не длиннее p \ тоесть если попадеться слово длинее строки его порубят на части не привышающие p : pr1 ( adr p -- adr ) { p \ s } 0 crtstr -> s s S" " OVER 0 SWAP C! str+ -> s au BEGIN DUP WHILE 2DUP p getfwrd 2DUP s ROT ROT str+ -> s \ CR TYPE s S" " OVER 0 SWAP C! str+ -> s 2DUP + >R ROT SWAP - >R SWAP - R> SWAP - R> SWAP REPEAT 2DROP s ; \ в строке adr u начиная от конца найти первыйнуль байт и оставить u1 длину строки от adr до последнего нуль байта : pr2.1 ( adr u -- u1 ) 2DUP + NIP 1+ BEGIN 1- DUP C@ 0 = >R 2DUP = R> + UNTIL 2DUP SWAP - NIP ; \ получить количество нульбайт в строке adr u : k0? ( adr u -- n ) { \ n } 0 DO DUP I + C@ 0 = IF n 1+ -> n THEN LOOP DROP n ; \ проиизвести форматную печать строки "adr u" c количеством груп пробелов "k" \ и небходимым к распределению "n" пробелов : fprint ( adr u k n -- ) { adr u k n } n k + -> n k 1+ 0 ?DO adr ASCIIZ> u MIN DUP >R TYPE n k 1 MAX / DUP n SWAP - -> n k 1- -> k SPACES R@ u SWAP - 1- -> u R> adr + 1+ -> adr LOOP ; \ разложить входную строку по строкам : pr2 ( adr p -- adr ) { p \ s } 0 crtstr -> s au 1- BEGIN 1 - SWAP 1 + SWAP 0 MAX DUP WHILE DUP p > IF OVER p pr2.1 ELSE 2DUP THEN 2DUP 2DUP DUP p SWAP - >R k0? R> fprint CR NIP DUP ROT SWAP - SWAP ROT + SWAP REPEAT 2DROP ; \ TEST 80 VALUE fp \ ширина форматирования S" in.txt" in_fl fp pr1 fp pr2 \EOF [/code] ну вот примерно гдето так
|
|
|
|
Добавлено: Пн май 14, 2007 21:31 |
|
|
|
|
|
Заголовок сообщения: |
|
|
|
насчет форматирования текста:
мой вариант без использования внешних либ, поэтому в начале секция совместимости.
Код: \ 05-05-2007 ~mOleg \ Copyright [C] 2007 mOleg mininoleg@yahoo.com \ решение задачи с конкурса открытого на форуме \ (http://fforum.winglion.ru/viewtopic.php?p=7274#7274)
\ -- просто набор необходимых слов ------------------------------------------
\ слово откатывает >IN назад, на начало непонятого слова : <back ( ASC # --> ) DROP TIB - >IN ! ;
\ добавить пробел в PAD - работает в пределах <# #> : BLANK ( --> ) BL HOLD ;
\ добавить указанное кол-во пробелов в PAD : BLANKS ( n --> ) BEGIN DUP WHILE BLANK 1 - REPEAT DROP ;
\ добавить число к находящемуся на стеке возвратов : R+ ( r: a d: b --> r: a+b ) 2R> -ROT + >R >R ;
\ вернуть TRUE если выполняется условие a < или = b, иначе FALSE : >= ( a b --> flag ) < 0= ;
\ возвращает адрес и длинну строки, содержащей символ(ы) перевода строки : nl ( --> asc # ) LT LTL @ ;
\ -- формирование результирующей строки -------------------------------------
USER-VALUE buffer \ адрес временного буфера USER-VALUE out> \ позиция с которой можно добавлять данные в буфер
\ добавление в буфер строки asc # к уже имеющимся : >out ( asc # --> ) out> SWAP 2DUP + TO out> CMOVE ;
\ добавление строки с добавлением перевода строки : save-result ( asc # --> ) >out nl >out ;
\ получить адрес и длинну собранной в буфере строки : result> ( --> asc # ) buffer out> OVER - ;
\ освобождение буфера : free-result ( --> ) buffer IF buffer FREE THROW 0 TO buffer THEN ;
\ инициализация буфера : init-buffer ( # --> ) free-result CELLS ALLOCATE THROW DUP TO buffer TO out> ;
\ -- собственно само решение ------------------------------------------------
USER-VALUE regular \ кол-во необходимых пробелов между словами USER-VALUE addons \ кол-во дополнительных пробелов
\ добавить необходимое кол-во пробельных символов между слов \ стратегии добавления пробелов могут быть различны. : add-blanks ( --> ) addons IF BLANK addons 1 - TO addons THEN regular BLANKS ;
\ сформировать строку из n строк, вставив между каждой строкой необходимое \ количество пробельных символов. : prepare ( [ asc # ] n str# p --> asc # ) SWAP - OVER 1 = IF 2DROP EXIT THEN \ если слово одно в строке
OVER 1 - /MOD 1 + TO regular TO addons \ считаем необходимые пробелы
>R <# BEGIN R@ WHILE \ пока есть слова HOLDS -1 R+ R@ WHILE \ если слово не последнее в строке add-blanks REPEAT THEN R@ R> #> ;
USER words# \ счетчик слов для текущей строки
\ собрать слова для одной строки : collect ( asc # p --> [ asc # ] n str# p ) >R DUP >R 1 words# ! BEGIN NextWord DUP WHILE \ пока есть слова во входном потоке DUP 1 + 2R@ ROT + TUCK >= WHILE \ пока длина суммы слов короче p RDROP >R words# 1+! REPEAT DROP <back \ если взято лишнее слово - откат words# @ R> R> EXIT THEN 2DROP words# @ R> DUP RDROP ;
\ форматировать поток, результат сохраняется в buffer : format-stream ( p --> ) >R BEGIN NextWord DUP WHILE R@ collect prepare save-result REPEAT 2DROP RDROP ;
\ форматировать текст : format-text ( asc # p --> asc # ) SAVE-SOURCE N>R >R DUP init-buffer SOURCE! R> format-stream NR> RESTORE-SOURCE result> ;
\ EOF -- test sectin --------------------------------------------------------
: ~- ( n --> ) BEGIN DUP WHILE ." -" 1 - REPEAT DROP CR ;
\ это простой пример форматирования текста. : ft S" simple sample string with the simple sample text." 20 DUP ~- format-text TYPE S" inside string can contain_very_long words larger than 'p' " 13 DUP ~- format-text TYPE ;
\ загрузить содержимое файла в буффер : source ( FileName # --> addr # ) R/O OPEN-FILE THROW >R R@ FILE-SIZE THROW DROP DUP ALLOCATE THROW TUCK SWAP R@ READ-FILE THROW R> CLOSE-FILE THROW ;
S" in.txt" source 60 format-text TYPE
CR ft
насчет форматирования текста:
мой вариант без использования внешних либ, поэтому в начале секция совместимости.
[code] \ 05-05-2007 ~mOleg \ Copyright [C] 2007 mOleg mininoleg@yahoo.com \ решение задачи с конкурса открытого на форуме \ (http://fforum.winglion.ru/viewtopic.php?p=7274#7274)
\ -- просто набор необходимых слов ------------------------------------------
\ слово откатывает >IN назад, на начало непонятого слова : <back ( ASC # --> ) DROP TIB - >IN ! ;
\ добавить пробел в PAD - работает в пределах <# #> : BLANK ( --> ) BL HOLD ;
\ добавить указанное кол-во пробелов в PAD : BLANKS ( n --> ) BEGIN DUP WHILE BLANK 1 - REPEAT DROP ;
\ добавить число к находящемуся на стеке возвратов : R+ ( r: a d: b --> r: a+b ) 2R> -ROT + >R >R ;
\ вернуть TRUE если выполняется условие a < или = b, иначе FALSE : >= ( a b --> flag ) < 0= ;
\ возвращает адрес и длинну строки, содержащей символ(ы) перевода строки : nl ( --> asc # ) LT LTL @ ;
\ -- формирование результирующей строки -------------------------------------
USER-VALUE buffer \ адрес временного буфера USER-VALUE out> \ позиция с которой можно добавлять данные в буфер
\ добавление в буфер строки asc # к уже имеющимся : >out ( asc # --> ) out> SWAP 2DUP + TO out> CMOVE ;
\ добавление строки с добавлением перевода строки : save-result ( asc # --> ) >out nl >out ;
\ получить адрес и длинну собранной в буфере строки : result> ( --> asc # ) buffer out> OVER - ;
\ освобождение буфера : free-result ( --> ) buffer IF buffer FREE THROW 0 TO buffer THEN ;
\ инициализация буфера : init-buffer ( # --> ) free-result CELLS ALLOCATE THROW DUP TO buffer TO out> ;
\ -- собственно само решение ------------------------------------------------
USER-VALUE regular \ кол-во необходимых пробелов между словами USER-VALUE addons \ кол-во дополнительных пробелов
\ добавить необходимое кол-во пробельных символов между слов \ стратегии добавления пробелов могут быть различны. : add-blanks ( --> ) addons IF BLANK addons 1 - TO addons THEN regular BLANKS ;
\ сформировать строку из n строк, вставив между каждой строкой необходимое \ количество пробельных символов. : prepare ( [ asc # ] n str# p --> asc # ) SWAP - OVER 1 = IF 2DROP EXIT THEN \ если слово одно в строке
OVER 1 - /MOD 1 + TO regular TO addons \ считаем необходимые пробелы
>R <# BEGIN R@ WHILE \ пока есть слова HOLDS -1 R+ R@ WHILE \ если слово не последнее в строке add-blanks REPEAT THEN R@ R> #> ;
USER words# \ счетчик слов для текущей строки
\ собрать слова для одной строки : collect ( asc # p --> [ asc # ] n str# p ) >R DUP >R 1 words# ! BEGIN NextWord DUP WHILE \ пока есть слова во входном потоке DUP 1 + 2R@ ROT + TUCK >= WHILE \ пока длина суммы слов короче p RDROP >R words# 1+! REPEAT DROP <back \ если взято лишнее слово - откат words# @ R> R> EXIT THEN 2DROP words# @ R> DUP RDROP ;
\ форматировать поток, результат сохраняется в buffer : format-stream ( p --> ) >R BEGIN NextWord DUP WHILE R@ collect prepare save-result REPEAT 2DROP RDROP ;
\ форматировать текст : format-text ( asc # p --> asc # ) SAVE-SOURCE N>R >R DUP init-buffer SOURCE! R> format-stream NR> RESTORE-SOURCE result> ;
\ EOF -- test sectin --------------------------------------------------------
: ~- ( n --> ) BEGIN DUP WHILE ." -" 1 - REPEAT DROP CR ;
\ это простой пример форматирования текста. : ft S" simple sample string with the simple sample text." 20 DUP ~- format-text TYPE S" inside string can contain_very_long words larger than 'p' " 13 DUP ~- format-text TYPE ;
\ загрузить содержимое файла в буффер : source ( FileName # --> addr # ) R/O OPEN-FILE THROW >R R@ FILE-SIZE THROW DROP DUP ALLOCATE THROW TUCK SWAP R@ READ-FILE THROW R> CLOSE-FILE THROW ;
S" in.txt" source 60 format-text TYPE
CR ft [/code]
|
|
|
|
Добавлено: Пн май 07, 2007 20:45 |
|
|
|
|
|
Заголовок сообщения: |
|
|
|
<pre>
\ http://fforum.winglion.ru/viewtopic.php?t=707
REQUIRE cons ~ygrek/lib/list/all.f
REQUIRE TYPE>STR ~ygrek/lib/typestr.f
: collect-words ( a u -- list )
%[ LAMBDA{ BEGIN PARSE-NAME DUP WHILE " {s}" %s REPEAT 2DROP } EVALUATE-WITH ]% ;
: SLEN ( s -- n ) STR@ NIP ;
: format-line { l p | k -- }
0 LAMBDA{ SLEN + } l mapcar p SWAP - TO p \ spaces available
l length 1 = IF p SPACES l car STR@ TYPE l FREE-LIST EXIT THEN
l cdr
\ distribute spaces over the list (except the first node)
BEGIN
p
WHILE
DUP empty? IF DROP l cdr THEN
DUP car " " TUCK S+ OVER setcar
p 1- TO p
cdr
REPEAT
DROP
LAMBDA{ STR@ TYPE } l mapcar
l FREE-LIST ;
\ : <= > 0= ;
: skip-line ( list1 p -- list2 )
{ list1 p | l n -- list2 }
list1 car SLEN -> n
list1 cdr TO l
BEGIN
l empty? IF list1 () LINK-NODE l EXIT THEN
l car SLEN 1 + n + DUP p <=
WHILE
-> n
l cdr TO l
list1 cdr TO list1
REPEAT
DROP
list1 () LINK-NODE
l ;
: convert ( a u p -- s )
"" { p s | l }
collect-words -> l
BEGIN
l empty? 0=
WHILE
l p skip-line ( l2 )
l p format-line CR
( l2 ) -> l
REPEAT ;
: format ['] convert TYPE>STR STR@ ;
CR CR
S" A large flying craft moved swiftly across the surface of an astoundingly beautiful." 15 format TYPE
CR CR .( Input from 'in.txt'. Press any key) KEY DROP
S" in.txt" FILE 30 format TYPE
</pre>
<pre>
[color=chocolate]\ [/color][color=limegreen]http://fforum.winglion.ru/viewtopic.php?t=707[/color]
[color=darkblue]REQUIRE[/color] [color=darkblue]cons[/color] [color=limegreen]~ygrek/lib/list/all.f[/color]
[color=darkblue]REQUIRE[/color] [color=darkblue]TYPE>STR[/color] [color=limegreen]~ygrek/lib/typestr.f[/color]
[color=darkblue]:[/color] [color=darkblue]collect-words[/color][color=chocolate] ( a u -- list )[/color]
%[ LAMBDA{ [color=deeppink]BEGIN[/color] PARSE-NAME [color=darkblue]DUP[/color] [color=deeppink]WHILE[/color][color=darkblue] " [/color][color=blue]{s}[/color][color=darkblue]"[/color] %s [color=deeppink]REPEAT[/color] [color=darkblue]2DROP[/color] } EVALUATE-WITH ]%[color=darkblue] ;[/color]
[color=darkblue]:[/color] [color=darkblue]SLEN[/color][color=chocolate] ( s -- n )[/color] STR@ [color=darkblue]NIP[/color][color=darkblue] ;[/color]
[color=darkblue]:[/color] [color=darkblue]format-line[/color] [color=darkblue]{[/color] l p [color=darkblue]|[/color][color=limegreen] k[/color] [color=darkblue]--[/color][color=darkblue] }[/color]
[color=limegreen]0[/color] LAMBDA{ SLEN [color=darkblue]+[/color] } l mapcar p [color=darkblue]SWAP[/color] [color=darkblue]-[/color] [color=darkblue]TO[/color] p[color=chocolate] \ spaces available[/color]
l length [color=limegreen]1[/color] [color=darkblue]=[/color] [color=deeppink]IF[/color] p [color=darkblue]SPACES[/color] l car STR@ [color=darkblue]TYPE[/color] l FREE-LIST [color=darkblue]EXIT[/color] [color=deeppink]THEN[/color]
l cdr
[color=chocolate] \ distribute spaces over the list (except the first node)[/color]
[color=deeppink]BEGIN[/color]
p
[color=deeppink]WHILE[/color]
[color=darkblue]DUP[/color] empty? [color=deeppink]IF[/color] [color=darkblue]DROP[/color] l cdr [color=deeppink]THEN[/color]
[color=darkblue]DUP[/color] car[color=darkblue] " [/color] [color=darkblue]"[/color] [color=darkblue]TUCK[/color] S+ [color=darkblue]OVER[/color] setcar
p [color=darkblue]1-[/color] [color=darkblue]TO[/color] p
cdr
[color=deeppink]REPEAT[/color]
[color=darkblue]DROP[/color]
LAMBDA{ STR@ [color=darkblue]TYPE[/color] } l mapcar
l FREE-LIST[color=darkblue] ;[/color]
[color=chocolate]\ : <= > 0= ;[/color]
[color=darkblue]:[/color] [color=darkblue]skip-line[/color][color=chocolate] ( list1 p -- list2 )[/color]
[color=darkblue]{[/color] list1 p [color=darkblue]|[/color][color=limegreen] l n[/color] [color=darkblue]--[/color][color=chocolate] list2[/color][color=darkblue] }[/color]
list1 car SLEN [color=darkblue]->[/color] n
list1 cdr [color=darkblue]TO[/color] l
[color=deeppink]BEGIN[/color]
l empty? [color=deeppink]IF[/color] list1 () LINK-NODE l [color=darkblue]EXIT[/color] [color=deeppink]THEN[/color]
l car SLEN [color=limegreen]1[/color] [color=darkblue]+[/color] n [color=darkblue]+[/color] [color=darkblue]DUP[/color] p <=
[color=deeppink]WHILE[/color]
[color=darkblue]->[/color] n
l cdr [color=darkblue]TO[/color] l
list1 cdr [color=darkblue]TO[/color] list1
[color=deeppink]REPEAT[/color]
[color=darkblue]DROP[/color]
list1 () LINK-NODE
l[color=darkblue] ;[/color]
[color=darkblue]:[/color] [color=darkblue]convert[/color][color=chocolate] ( a u p -- s )[/color]
[color=darkblue]""[/color] [color=darkblue]{[/color] p s [color=darkblue]|[/color][color=limegreen] l[/color][color=darkblue] }[/color]
collect-words [color=darkblue]->[/color] l
[color=deeppink]BEGIN[/color]
l empty? [color=darkblue]0=[/color]
[color=deeppink]WHILE[/color]
l p skip-line[color=chocolate] ( l2 )[/color]
l p format-line [color=darkblue]CR[/color]
[color=chocolate] ( l2 )[/color] [color=darkblue]->[/color] l
[color=deeppink]REPEAT[/color][color=darkblue] ;[/color]
[color=darkblue]:[/color] [color=darkblue]format[/color] [color=deeppink]['][/color] [color=darkblue]convert[/color] TYPE>STR STR@[color=darkblue] ;[/color]
[color=darkblue]CR[/color] [color=darkblue]CR[/color]
[color=darkblue]S" [/color][color=blue]A large flying craft moved swiftly across the surface of an astoundingly beautiful.[/color][color=darkblue]"[/color] [color=limegreen]15[/color] format [color=darkblue]TYPE[/color]
[color=darkblue]CR[/color] [color=darkblue]CR[/color] [color=darkblue].( [/color][color=blue]Input from 'in.txt'. Press any key[/color][color=darkblue])[/color] [color=darkblue]KEY[/color] [color=darkblue]DROP[/color]
[color=darkblue]S" [/color][color=blue]in.txt[/color][color=darkblue]"[/color] FILE [color=limegreen]30[/color] format [color=darkblue]TYPE[/color]
</pre>
|
|
|
|
Добавлено: Сб май 05, 2007 18:31 |
|
|
|
|
|
Заголовок сообщения: |
|
|
|
Код: \ Для запуска нужен дистрибутив SPF: \ http://sourceforge.net/project/showfiles.php?group_id=17919
\ И апрельское обновление: \ http://sourceforge.net/project/shownotes.php?release_id=497972&group_id=17919
REQUIRE /TEST ~profit/lib/testing.f REQUIRE PRO ~profit/lib/bac4th.f REQUIRE split ~profit/lib/bac4th-str.f REQUIRE arr{ ~profit/lib/bac4th-sequence.f REQUIRE LOCAL ~profit/lib/static.f REQUIRE __ ~profit/lib/cellfield.f
: TAKE-THREE PRO *> <*> BSWAP <*> ROT BACK -ROT TRACKING <* CONT ;
0 __ wordsInLine __ spacesBetween __ lastSpace CONSTANT elem
: format-text ( addr u w --> addr u \ <-- ) PRO LOCAL charsInLine DUP charsInLine ! LOCAL charsLeft 1+ charsLeft !
LOCAL wordsEntered concat{ byRows split DUP STR@ charsLeft KEEP wordsEntered 0! arr{ *> 2DUP BL byChar split notEmpty \ DUP STR@ TYPE KEY DROP DUP STR@ NIP DUP 1+ DROPB NEGATE charsLeft +! \ charsLeft @ CR ." {" . wordsEntered 1+! charsLeft @ 0< ONTRUE BACK 1 wordsEntered ! charsInLine @ OVER - \ DUP . ." ^^" charsLeft ! TRACKING
-1 wordsEntered +!
charsLeft @ OVER + 1+ wordsEntered @ 1- \ CR 2DUP . . DUP IF /MOD TUCK + SWAP \ ." :" 2DUP . . ELSE 2DROP 0. THEN 2DROPB
wordsEntered @ DROPB TAKE-THREE <*> 0. 2DROPB 1000000 DROPB TAKE-THREE <* \ добавляем elem в массив для не успевшей обработаться строки }arr \ 2DUP DUMP EXIT DROP
LOCAL runner \ бегунок runner !
concat{ BL byChar split notEmpty DUP STR@ *> <*> -1 runner @ wordsInLine +! BACK runner @ wordsInLine @ 0= IF elem runner +! THEN TRACKING
START{ PRO
runner @ wordsInLine @ 1 = IF runner @ lastSpace @ ELSE runner @ spacesBetween @ THEN
runner @ wordsInLine @ IF -1 ?DO S" " CONT LOOP ELSE DROP BACK \ S" |" CONT LT LTL @ CONT TRACKING THEN
}EMERGE <* }concat DUP STR@ *> <*> LT LTL @ <* }concat DUP STR@ CONT ;
/TEST
$> S" A large flying craft moved swiftly across the surface of an astoundingly beautiful sea." 20 format-text CR TYPE
CR CR .( Input from 'in.txt'. Press any key) KEY DROP $> S" in.txt" FILE 24 format-text TYPE
http://forth.org.ru/~profit/justify.7zРезультат: Код: A large flying craft moved swiftly across the surface of an astoundingly beautiful sea. From mid-morning onwards it plied back and forth in great widening arcs, and at last attracted the attention of the local islanders, a peaceful, sea-food loving people who gathered on the beach and squinted up into the blinding sun, trying to see what was there.
Any sophisticated knowledgeable person, who had knocked about, seen a few things, would probably have remarked on how much the craft looked like a filing cabinet - a large and recently burgled filing cabinet lying on its back with its drawers in the air and flying.
Реализация получилась достаточно большой (на bac4th'е, иначе я уже разучился). Но и алгоритм непростенький.
Есть там пара закавык, упущенных в том числе и в ТЗ. Могу расписать.
[code] \ Для запуска нужен дистрибутив SPF: \ http://sourceforge.net/project/showfiles.php?group_id=17919
\ И апрельское обновление: \ http://sourceforge.net/project/shownotes.php?release_id=497972&group_id=17919
REQUIRE /TEST ~profit/lib/testing.f REQUIRE PRO ~profit/lib/bac4th.f REQUIRE split ~profit/lib/bac4th-str.f REQUIRE arr{ ~profit/lib/bac4th-sequence.f REQUIRE LOCAL ~profit/lib/static.f REQUIRE __ ~profit/lib/cellfield.f
: TAKE-THREE PRO *> <*> BSWAP <*> ROT BACK -ROT TRACKING <* CONT ;
0 __ wordsInLine __ spacesBetween __ lastSpace CONSTANT elem
: format-text ( addr u w --> addr u \ <-- ) PRO LOCAL charsInLine DUP charsInLine ! LOCAL charsLeft 1+ charsLeft !
LOCAL wordsEntered concat{ byRows split DUP STR@ charsLeft KEEP wordsEntered 0! arr{ *> 2DUP BL byChar split notEmpty \ DUP STR@ TYPE KEY DROP DUP STR@ NIP DUP 1+ DROPB NEGATE charsLeft +! \ charsLeft @ CR ." {" . wordsEntered 1+! charsLeft @ 0< ONTRUE BACK 1 wordsEntered ! charsInLine @ OVER - \ DUP . ." ^^" charsLeft ! TRACKING
-1 wordsEntered +!
charsLeft @ OVER + 1+ wordsEntered @ 1- \ CR 2DUP . . DUP IF /MOD TUCK + SWAP \ ." :" 2DUP . . ELSE 2DROP 0. THEN 2DROPB
wordsEntered @ DROPB TAKE-THREE <*> 0. 2DROPB 1000000 DROPB TAKE-THREE <* \ добавляем elem в массив для не успевшей обработаться строки }arr \ 2DUP DUMP EXIT DROP
LOCAL runner \ бегунок runner !
concat{ BL byChar split notEmpty DUP STR@ *> <*> -1 runner @ wordsInLine +! BACK runner @ wordsInLine @ 0= IF elem runner +! THEN TRACKING
START{ PRO
runner @ wordsInLine @ 1 = IF runner @ lastSpace @ ELSE runner @ spacesBetween @ THEN
runner @ wordsInLine @ IF -1 ?DO S" " CONT LOOP ELSE DROP BACK \ S" |" CONT LT LTL @ CONT TRACKING THEN
}EMERGE <* }concat DUP STR@ *> <*> LT LTL @ <* }concat DUP STR@ CONT ;
/TEST
$> S" A large flying craft moved swiftly across the surface of an astoundingly beautiful sea." 20 format-text CR TYPE
CR CR .( Input from 'in.txt'. Press any key) KEY DROP $> S" in.txt" FILE 24 format-text TYPE [/code]
[url]http://forth.org.ru/~profit/justify.7z[/url]
Результат: [code]A large flying craft moved swiftly across the surface of an astoundingly beautiful sea. From mid-morning onwards it plied back and forth in great widening arcs, and at last attracted the attention of the local islanders, a peaceful, sea-food loving people who gathered on the beach and squinted up into the blinding sun, trying to see what was there.
Any sophisticated knowledgeable person, who had knocked about, seen a few things, would probably have remarked on how much the craft looked like a filing cabinet - a large and recently burgled filing cabinet lying on its back with its drawers in the air and flying.[/code]
Реализация получилась достаточно большой (на bac4th'е, иначе я уже разучился). Но и алгоритм непростенький.
Есть там пара закавык, упущенных в том числе и в ТЗ. Могу расписать.
|
|
|
|
Добавлено: Сб май 05, 2007 17:10 |
|
|
|
|
|
Заголовок сообщения: |
|
|
|
чертачки это пробелы добавленые для выравнивания, для наглядности а правая граница не ровная да ... это потомучто туда пробел был выведен, надо добавить чтоб игнорировала пробел в начале вывода строки
перечитал задачу, обнаружил что пробелы надо внутрь строки,
упс, не стриляйте
чертачки это пробелы добавленые для выравнивания, для наглядности а правая граница не ровная да ... это потомучто туда пробел был выведен, надо добавить чтоб игнорировала пробел в начале вывода строки
перечитал задачу, обнаружил что пробелы надо внутрь строки,
упс, не стриляйте
|
|
|
|
Добавлено: Сб май 05, 2007 14:54 |
|
|
|
|
|
Заголовок сообщения: |
|
|
|
Код: S" A large flying craft moved swiftly across the surface of an astoundingly beautiful sea." 15 fl2cns
A large flying craft moved --- swiftly across the surface of an astoundingly beautiful sea.
Правая граница неровная. Чёрточки откуда-то.
[code]S" A large flying craft moved swiftly across the surface of an astoundingly beautiful sea." 15 fl2cns
A large flying craft moved --- swiftly across the surface of an astoundingly beautiful sea. [/code]
Правая граница неровная. Чёрточки откуда-то.
|
|
|
|
Добавлено: Сб май 05, 2007 14:50 |
|
|
|
|
|
Заголовок сообщения: |
|
|
|
Код: \ gl0 SPF4.18 lib/ext/locals.f \ выбрать блок не пробелов : >sp ( adr u -- adr u1 ) OVER BEGIN 1+ SWAP 1- SWAP DUP C@ 32 = >R SWAP DUP 0= >R SWAP R> R> + UNTIL NIP OVER - ; \ выбрать блок пробелов, : >nsp ( adr u -- adr u1 ) OVER \ u adr BEGIN 1+ SWAP 1- SWAP DUP C@ 32 <> >R SWAP DUP 0= >R SWAP R> R> + UNTIL NIP OVER - ;
\ из adr u выбрать первое слово или блок пробелов : getfwrd ( adr u -- adr u1 ) OVER C@ 32 = IF \ если первый символ пробел ищем блок пробелов >nsp ELSE \ если первый символ не пробел ищем блок не пробелов >sp THEN ; \ перебрать adr u по строкам длиной p с заполнением хвостов : format-text ( adr u p -- adr u ) { adr u p \ p1 } p -> p1 \ длина свободной строки adr u \ строка со словами BEGIN 2DUP getfwrd 2DUP \ выберем первое слово или блок пробелов из массива DUP p1 > IF p1 \ если он не умещаеться в остатке строки 0 ?DO S" -" TYPE LOOP \ SPACES \ выводит тире для наглядности OVER C@ 32 = IF 2DROP S" " THEN \ подстановка для вывода слова нулевой длинны если вывод на следующую строку начнется с блока пробелов CR DUP p SWAP - -> p1 ELSE \ если он умещаеться в остатке строки DUP p1 SWAP - -> p1 THEN TYPE \ вывести слово NIP >R R@ - SWAP R> + SWAP DUP 0= \ проверить не кончился ли массив UNTIL p1 0 ?DO S" -" TYPE LOOP \ SPACES \ вывести при необходимости дополнение последней строки ( тире для наглядности) 2DROP \ очистить стек adr u ;
\ тест S" 11111 22222 33333 11111 22222 33333 11111 22222 33333 11111 22222 33333 11111 22222 33333 11111 22222 33333 11111 22222 33333 11111 22222 33333 11111 22222 33333 11111 22222 33333 11111 22222 33333" 15 format-text
первый нафиг
PS исправлено нарушение левой границы
[code] \ gl0 SPF4.18 lib/ext/locals.f \ выбрать блок не пробелов : >sp ( adr u -- adr u1 ) OVER BEGIN 1+ SWAP 1- SWAP DUP C@ 32 = >R SWAP DUP 0= >R SWAP R> R> + UNTIL NIP OVER - ; \ выбрать блок пробелов, : >nsp ( adr u -- adr u1 ) OVER \ u adr BEGIN 1+ SWAP 1- SWAP DUP C@ 32 <> >R SWAP DUP 0= >R SWAP R> R> + UNTIL NIP OVER - ;
\ из adr u выбрать первое слово или блок пробелов : getfwrd ( adr u -- adr u1 ) OVER C@ 32 = IF \ если первый символ пробел ищем блок пробелов >nsp ELSE \ если первый символ не пробел ищем блок не пробелов >sp THEN ; \ перебрать adr u по строкам длиной p с заполнением хвостов : format-text ( adr u p -- adr u ) { adr u p \ p1 } p -> p1 \ длина свободной строки adr u \ строка со словами BEGIN 2DUP getfwrd 2DUP \ выберем первое слово или блок пробелов из массива DUP p1 > IF p1 \ если он не умещаеться в остатке строки 0 ?DO S" -" TYPE LOOP \ SPACES \ выводит тире для наглядности OVER C@ 32 = IF 2DROP S" " THEN \ подстановка для вывода слова нулевой длинны если вывод на следующую строку начнется с блока пробелов CR DUP p SWAP - -> p1 ELSE \ если он умещаеться в остатке строки DUP p1 SWAP - -> p1 THEN TYPE \ вывести слово NIP >R R@ - SWAP R> + SWAP DUP 0= \ проверить не кончился ли массив UNTIL p1 0 ?DO S" -" TYPE LOOP \ SPACES \ вывести при необходимости дополнение последней строки ( тире для наглядности) 2DROP \ очистить стек adr u ;
\ тест S" 11111 22222 33333 11111 22222 33333 11111 22222 33333 11111 22222 33333 11111 22222 33333 11111 22222 33333 11111 22222 33333 11111 22222 33333 11111 22222 33333 11111 22222 33333 11111 22222 33333" 15 format-text [/code]
первый нафиг :)
PS исправлено нарушение левой границы
|
|
|
|
Добавлено: Сб май 05, 2007 14:46 |
|
|
|
|
|
Заголовок сообщения: |
*форматирование текста по ширине |
|
|
Код: Постановка задачи.
Написать слово, преобразующее входную строку в текст, выровненный по ширине экрана, таким образом, чтобы каждая новая строка на экране отделялась от предыдущей символами CRLF (0x0D 0x0A), а промежутки между словами были заполнены необходимым количеством пробелов, достаточным для выравнивания правого края строки в одну линию, не пересекающую позицию p. Первый символ первого слова строки обязан находиться в начале строки, а количество дополнительных пробелов в строке не должно превышать по длинне, первое слово перенесенное на следующую строку. Разрывать слова на части нельзя - можно переносить на следующую строку целиком, либо, если слово оказывается шире требуемой ширины строки, оставлять в строке целиком. Каждый символ занимает один байт пространства в памяти. Каждый символ, включая пробельные и знаки препинания, имеет одинаковую ширину при отображении. Получаемая на входе строка может состоять из произвольного количества слов, отделенных пробельными символами и символами переноса на следующую строку. Знаки препинания считаются частью слов.
\ на входе слово получает строку в виде адрес + длинна \ и требуемую ширину строк в символах. \ на выходе должен быть получен адрес области в памяти, хранящей \ полученный набор строк. : format-text ( asc # p --> asc # )
;
07-05-2007 - mOleg исправил постановку задачи.
[code] Постановка задачи.
Написать слово, преобразующее входную строку в текст, выровненный по ширине экрана, таким образом, чтобы каждая новая строка на экране отделялась от предыдущей символами CRLF (0x0D 0x0A), а промежутки между словами были заполнены необходимым количеством пробелов, достаточным для выравнивания правого края строки в одну линию, не пересекающую позицию p. Первый символ первого слова строки обязан находиться в начале строки, а количество дополнительных пробелов в строке не должно превышать по длинне, первое слово перенесенное на следующую строку. Разрывать слова на части нельзя - можно переносить на следующую строку целиком, либо, если слово оказывается шире требуемой ширины строки, оставлять в строке целиком. Каждый символ занимает один байт пространства в памяти. Каждый символ, включая пробельные и знаки препинания, имеет одинаковую ширину при отображении. Получаемая на входе строка может состоять из произвольного количества слов, отделенных пробельными символами и символами переноса на следующую строку. Знаки препинания считаются частью слов.
\ на входе слово получает строку в виде адрес + длинна \ и требуемую ширину строк в символах. \ на выходе должен быть получен адрес области в памяти, хранящей \ полученный набор строк. : format-text ( asc # p --> asc # )
;
[/code]
07-05-2007 - mOleg исправил постановку задачи.
|
|
|
|
Добавлено: Сб май 05, 2007 02:20 |
|
|
|
|