Forth и другие саморасширяющиеся системы программирования Locations of visitors to this page
Текущее время: Пт сен 21, 2018 15:55

...
Google Search
Forth-FAQ Spy Grafic

Часовой пояс: UTC + 3 часа [ Летнее время ]




Начать новую тему Ответить на тему  [ Сообщений: 19 ]  На страницу 1, 2  След.
Автор Сообщение
 Заголовок сообщения: Маленький эксель
СообщениеДобавлено: Вт фев 05, 2008 11:55 
ТЗ восстановлено модератором темы. Ссылки не правил - вставил только текст.

ygrek уже давно ведёт очень интересную тему мерянья с другими языками на примере т.н. "показательных задач" (Python Challenge 0-5 - проФорт, Python Challenge 6-10 - проФорт и Forth - Wide Finder). Дайте-ка я тоже пойду на ту гору.

"Problem K", она же "маленький эксель" -- известная задача не столько на код и хитропопость алгоритма, сколько для обозначения такого трудноуловимого понятия как дизайн (в рамках форта -- особенно эфемерного, в виду непроработанности темы) . По объёму кода задача несложна, поэтому сверхзадача состоит в написании легко модифицируемого (что является определением хорошего дизайна) и понятного кода.

Этот мем, пройдясь волнами по нескольким программистским сообществам, в сухом остатке оставил отложения в виде решений на нескольких языках:


Хаскел(ь?)
Эрланг 1, Эрланг 2
плюс ещё куча которые искать мне просто лень -- да и спойлить себе не хочу


ТЗ: Цитата:

Маленький Эксель

Необходимо реализовать простую электронную таблицу в виде программы, выполняющейся из командной строки. Она должна уметь обрабатывать ячейки таблицы как и более продвинутые аналоги, только с упрощенным синтаксисом выражений. Каждая ячейка может содержать:

Ничего
Неотрицательное целое число
Текстовые строки, которые начинаются с символа '
Строки-выражения, которые начинаются с символа '=' и могут содержать неотрицательные целые числа, ссылки на ячейки и простые арифметические выражения. Скобки запрещены, у всех операций одинаковый приоритет. Ссылки на ячейки состоят из одной латинской буквы и следующей за ней цифры.


Эти ограничения введены для упрощения разбора выражений, поскольку разбор выражений не является основной частью проблемы. Вы можете спокойно положиться на эти ограничения. Вот грамматика содержимого ячейки:
Код:

expression ::= '=' term {operation term}*
term ::= cell_reference | nonnegative_number
cell_reference ::= [A-Za-z][0-9] --
operation ::= '+' | '-' | '*' | '/'
text ::= '\'' {printable_character}



Процесс обработки:

Все выражения должны быть заменены на вычисленный результат.
Все вычисления выполняются с помощью целочисленной арифметики со знаком.
Ячейки с текстом должны быть вычислены как соответствующий текст без префикса '.
Операции над строками текста запрещены.
В случае любой ошибки вычисления формулы, вычисляемая ячейка должна содержать слово-сообщение об ошибке, начинающееся с символа '#'. Используйте короткие, ясные сообщения. Не надо предоставлять подробности об ошибках в выводе.


Программа должна использовать только стандартные библиотеки и классы и не должна вызывать сторонние программы, библиотеки или системные компоненты.

Ввод и вывод

Программа получает описание таблицы с формулами из стандартного ввода, вычисляет ее и печатает полученный результат в стандартный вывод. Входные данные представлены таблицей, элементы строк которой разделены табуляциями. Первая строка содержит пару чисел, разделенных табуляцией - высоту и ширину таблицы, соответственно. Затем идут строки с ячейками таблицы, в грамматике, приведенной выше.


Выход должен содержать только ожидаемую информацию, включая сообщения об ошибках, и никакой другой информации в выводе не должно быть, включая и welcome text. Выход должен быть отформатирован в соответствии с приведенным ниже примером.

Пример данных: Код:

3 4
12 =C2 3 'Sample
=A1+B1*C1/5 =A2*B1 =B3-C3 'Spread
'Test =4-3 5 'Sheet



Ожидаемый вывод: Код:

12 -4 3 Sample
4 -16 -4 Spread
Test 1 5 Sheet




Указания по решению

Необходимо промышленное качество кода. Более короткое и читаемое решение предпочтительней. Решение должно содержать тестовые примеры и код, использованные в процессе создания решения. Не забудьте откомментировать код в ключевых местах. Код должен быть устойчив к ошибкам.

Представьте, что это требования к первой фазе проекта. Необходимо реализовать только то, что нужно на этой фазе. Однако, известно, что планируется вторая фаза, в которой требования будут расширены следующими:

Расширить формулы операциями над строками,
Оптимизировать производительность для громадных таблиц.


Вам необходимо будет указать, какие изменения необходимо сделать для реализации второй фазы проекта.



Замечание по поводу "стандартных библиотек и классов" я думаю, можно проигнорировать. Даже если "не-можно" то я всё равно проигнорирую, потому что я так хочу.


Последний раз редактировалось profiT Пт фев 29, 2008 23:52, всего редактировалось 1 раз.

Вернуться к началу
  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Пт фев 08, 2008 07:35 
---


Последний раз редактировалось profiT Пт фев 29, 2008 23:52, всего редактировалось 1 раз.

Вернуться к началу
  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Пт фев 08, 2008 10:38 
Не в сети
Administrator
Administrator
Аватара пользователя

Зарегистрирован: Вт май 02, 2006 22:48
Сообщения: 6405
Благодарил (а): 14 раз.
Поблагодарили: 100 раз.
А если в качестве промежуточной точки написать вот это вот самое, но работающее с постфиксной записью? Вобщем, содержимое ячейки передавать на Evaluate.


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Пт фев 08, 2008 12:22 
---


Последний раз редактировалось profiT Пт фев 29, 2008 23:51, всего редактировалось 1 раз.

Вернуться к началу
  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Пт фев 08, 2008 12:55 
Не в сети
Аватара пользователя

Зарегистрирован: Вт мар 20, 2007 23:39
Сообщения: 1255
Благодарил (а): 3 раз.
Поблагодарили: 17 раз.
Хищник писал(а):
А если в качестве промежуточной точки написать вот это вот самое, но работающее с постфиксной записью?

/me так и делает - на кварке.

_________________
Cтоимость сопровождения программного обеспечения пропорциональна квадрату творческих способностей программиста.
Роберт Д. Блисc


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Пт фев 08, 2008 21:34 
Не в сети
Administrator
Administrator
Аватара пользователя

Зарегистрирован: Вт май 02, 2006 22:48
Сообщения: 6405
Благодарил (а): 14 раз.
Поблагодарили: 100 раз.
profiT писал(а):
Хм, не знаю. Думаю, можно. Вот только кода это больше займёт -- для EVALUATE-обработки надо писать преобразовалку в постфикс.

Да нет, я имел в виду написать функциональность электронной таблицы, а для упрощения работы с ячейками хранить там не 2 + 2, а 2 2 +. Это уже за пределами ТЗ, но тем и интересно - ведь не ставится задача получить совместимость с xls? А вот посмотреть на объем кода для постфиксных ячеек, а потом добавить разбор выражений и сравнить, сколько добавилось кода, а сколько - функциональности. Полагаю, что "много" и "мало", соответственно :)


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Пт фев 08, 2008 23:08 
Хищник, абсолютно согласен, что для дизайна программы роли не играет, в инфиксе или постфиксе задаются формулы в ячейка.
Преобразование из скобочного инфикса в постфикс — отдельностоящая задача. На входе строка, на выходе строка; плюс доступ к информации об унарных и бинарных операциях (обозначение, приоритет).

А в качестве начальной точки я даже написал без Eval, а просто вывод формулы из ячейки без изменений. В репозитории devel/~pinka/samples/2007/spreadsheet/


Вернуться к началу
  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Пн фев 11, 2008 08:16 
Не в сети
Moderator
Moderator

Зарегистрирован: Ср май 10, 2006 15:37
Сообщения: 1132
Откуда: Chelyabinsk ( Ural)
Благодарил (а): 0 раз.
Поблагодарили: 9 раз.
Как один из вариантов, можно сделать мини ексель
в качестве плугина к фару и опубликовать в кранилище Far plugin.


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Пн фев 11, 2008 14:29 
Не в сети
Moderator
Moderator

Зарегистрирован: Ср май 10, 2006 15:37
Сообщения: 1132
Откуда: Chelyabinsk ( Ural)
Благодарил (а): 0 раз.
Поблагодарили: 9 раз.
Вот еще ссылка в топик.

http://www.complang.tuwien.ac.at/forth/ ... dsheet.zip


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Пт фев 22, 2008 00:22 
---


Последний раз редактировалось profiT Пт фев 29, 2008 23:50, всего редактировалось 1 раз.

Вернуться к началу
  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Пт фев 22, 2008 10:24 
Не в сети
Аватара пользователя

Зарегистрирован: Вт мар 20, 2007 23:39
Сообщения: 1255
Благодарил (а): 3 раз.
Поблагодарили: 17 раз.
Ой забыл совсем что я тоже участвую :( Надо Хищника подергать на счет обработки строк, введенных с консоли в кварке.

_________________
Cтоимость сопровождения программного обеспечения пропорциональна квадрату творческих способностей программиста.
Роберт Д. Блисc


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Пт фев 22, 2008 14:24 
---


Последний раз редактировалось profiT Пт фев 29, 2008 23:50, всего редактировалось 1 раз.

Вернуться к началу
  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Пн фев 25, 2008 14:26 
---


Последний раз редактировалось profiT Пт фев 29, 2008 23:50, всего редактировалось 1 раз.

Вернуться к началу
  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Сб мар 22, 2008 21:35 
Не в сети
Аватара пользователя

Зарегистрирован: Вт мар 20, 2007 23:39
Сообщения: 1255
Благодарил (а): 3 раз.
Поблагодарили: 17 раз.
Ну вот, и мой вариант, правда я немного отклонился от ТЗ... и немного задержался... :shuffle;
Вобщем вместо выполнения всех условий по ТЗ, захотелось мне вот сделать действительно маленький эксель и с простеньким GUI - еще бы не сделать интерфейс, когда под рукой такой замечательный инструмент, как Quark-Forth http://www.msyst.ru/quarkexe.zip 8) Код не самый-пупер промышленный, скорее даже немного сумбурный и местами не самый эффективный, но он работает, и, кажется, без глюков :shuffle;
Что же получилосЬ в итоге?
Что есть:
Трехмерная таблица 26*38*3: каждая ячейка может одновременно хранить обычное 4-х байтовое число, флоат, и строку('побочный' эффект необходимости одновременно хранить формулу в строке и выводить результат этой формулы), соответствующий тип можно просмотреть кнопками F1-F4 (числа, флоат, строка, NULL - т.е. пустая ячейка, но при этом все данные она продолжает хранить), ввести новое значение можно кнопками F5-F7(продублировано на мышке: ЛКМ, ПКМ, колесо) очистить ячейку по кнопке F8;

Строки можно раскрашивать - по умолчанию используется символ Alt+166, но можно выбрать и любой другой;

Формула в строке вычисляется в случае, если первый символ '=', формат записи - обычный для форта, сначала указываем номер строки, затем через пробел букву столбца, и на стеке будет число из этой ячейки;

Есть две простые формулы
\ +( 0 a 2 b )+ \ Сложить все числа в ячейках 0a,1a,2a,0b,1b,2b
\ *( 0 a 2 b )* \ Перемножить все числа в ячейках 0a,1a,2a,0b,1b,2b

Сохранение и загрузка таблицы - F11,F12;

Есть хелп.

Чего нет:
Обработки ошибок в формуле;
Контроля повторности вычисления формул;
Возможности зацикливания ссылок в ячейках;
Возможно еще что-то пропустил.

Для тех кто в 'танке' напоминаю: код для Кварк-Форта http://www.msyst.ru/quarkexe.zip запускаем и печатаем " file-name.txt" L или в ком строке quark.exe file-name.txt.
Код:
\ Problem K, или небольшой такой 'пухленький' кварк-форт-эксель
\ Автор: VoidVolker
\ Дата:  22.03.2008
\ # Различные настриваемые параметры интерфейса
0xAA7755  VALUE цвет_таблицы
BLACK     VALUE цвет_фона
WHITE     VALUE цвет_выделения
0xEEEEEE  VALUE цвет_текста

0x88FF88  VALUE цвет_чисел
0xFFFF88  VALUE цвет_флоатов
0xFF88FF  VALUE цвет_строк
0x88FFFF  VALUE цвет_ячейки

166 VALUE simbol-colorer  \ Символ указывающий

35  VALUE table-x  \ Позиция основной таблицы
105 VALUE table-y

5   26 MIN 1 MAX VALUE COLS  \ Число столбиков
10   38 MIN 1 MAX VALUE ROWS  \ Число строк
130 VALUE CELLA  \ Длина ячейки
20  VALUE CELLB  \ Высота ячейки

35  VALUE ROWS-NAMEA  \ Длина стобца с номерами строк

\ # Status-box  \ (Надо бы его к основной таблице приклеить)
0   VALUE sbox-x
40  VALUE sbox-y
85  8 * VALUE sbox-a
20  VALUE sbox-b
64  VALUE sbox-data-x

64 VALUE STRING-SIZE  \ Размер строк

\ ##### K: begin
\ Различные переменные
table-x VALUE cell-x  \ Координата X текущей ячейки
table-y VALUE cell-y  \ Координата Y текущей ячейки
QUAN cell'            \ Адрес текущей ячейки

QUAN col-buf          \ Буфер цвета для текста

table-x VALUE last-cell-x
table-y VALUE last-cell-y
CELLA 2 - VALUE last-cell-a
CELLB 2 - VALUE last-cell-b

" abcdefghijklmnopqrstuvwxyz" VALUE "az

\ ### 1.0 Разное
: GOTOCONSOLE 0 0 GOTOXY ;
\ # 1.1 Tools
: 2DUP  OVER OVER ;
: --   CREATE OVER , + DOES> @ + ;
: MOUSEX  MOUSE-X @ ;
: MOUSEY  MOUSE-Y @ ;
: 'SWAP  \ ( a: X  a1: Y -- a: Y  a1: X )
  OVER @ OVER @ >R
  SWAP ! R> SWAP !
;
: 'NOOP ['] NOOP ;
\ # 1.2 Графические примитивы
: FBOX   \ x y a b цвет
  SWAP 0 DO
  3 PICK 3 PICK I + 3 PICK 3 PICK HLINE
  LOOP DROP DROP DROP DROP ;
: BOX   \ x y a b цвет
  4 PICK 4 PICK 4 PICK 3 PICK HLINE
  4 PICK 4 PICK 3 PICK 3 PICK VLINE
  4 PICK 4 PICK 1- 3 PICK + 4 PICK 3 PICK HLINE
  >R 3 XCHG 1- SWAP + SWAP ROT R> VLINE
;

\ # 1.3 Текст
: boxed-textxy  \ ( x y -- x1 y1 )
  >R 5 + R> 3 + ;
: box-textxy  \ ( x y -- )
  boxed-textxy TEXTXY ;

\ # 1.4 Графические примитивы отдельно взятой ячейки
: last-inside-box  \ ( -- x1 y1 a1 b1 ) Внутренний прямоугольник предыдущей активированной ячейки
  last-cell-x 1+  last-cell-y 1+  last-cell-a last-cell-b ;
: hlight  \ Подсвечивает ячейку
  cell-x 1+ cell-y 1+ CELLA 2 - CELLB 2 - цвет_выделения BOX ;
: un-hlight  \ Отменяет подсветку
  last-inside-box цвет_фона BOX ;
: clear-cell  \ Очищает ячейку на экране
  last-inside-box цвет_фона FBOX ;
: cell-textxy \ Печатает текст в текущей ячейке
  cell-x cell-y box-textxy ;

\ ### 2.0 Раскраска
: mem-col GETCOLOR TO col-buf ;
: prev-col  col-buf SETCOLOR ;
: num-color  mem-col цвет_чисел SETCOLOR ;
: float-color  mem-col цвет_флоатов SETCOLOR ;
: string-color  mem-col цвет_строк SETCOLOR ;
: cell-name-color  mem-col цвет_ячейки SETCOLOR ;

\ # 2.1 Цветные строки
: sbgr>num  \ ( str -- n ) Конверитрует стpоковое пpедставление числа в 16-pичном виде в число; берется 6 первых символов
  >R 0
  6 0 DO
   R@ C@ DUP 48 57 WITHIN  \ Число?
    IF
     48 -  \ Код числа >> число
    ELSE
     DUP 65 70 WITHIN  \ Буква?
      IF 55 - ELSE 0 THEN   \ Код буквы >> число
    THEN
    5 I - 4 * LSHIFT +  \ Установка разряда
    R> 1+ >R
  LOOP
  RDROP
;

QUAN cprint-colbuf
: sprev-color  cprint-colbuf SETCOLOR ;
: sset-color \ ( s -- s+7 )
  GETCOLOR TO cprint-colbuf
  DUP sbgr>num SETCOLOR
  7 +
;

CREATE colored1 ' sset-color ,
CREATE colored2 ' sprev-color ,
: CPRINT  \ ( str -- )  \ Печатает строку с учетом цвета "подстрок", цвет подстроки указывается после символа ¦ и подстрока
  BEGIN                 \ ограничивается этим-же символом, например: " [ ¦FF3333 F5¦ Int= " CPRINT  подстрока F5 будет цветом FF3333
   DUP C@ DUP
  WHILE  \ a char
   DUP DUP 166 = SWAP simbol-colorer = OR \ Символ ¦ ?
    IF
     DROP 1+
     colored1 @ EXECUTE
     colored1 colored2 'SWAP
    ELSE
     EMIT 1+
    THEN
  REPEAT
  DROP DROP
;

\ ### 3.0 Структура ячеек и таблицы
: for-cells
   ROWS 0 DO
   COLS 0 DO
      IJ #>' calculated? OFF
   LOOP
  LOOP
;

0
1 CELLS     -- #cell
1 CELLS     -- calculated?  \ Для избегания повторного вычисления ячейки (в данный момент не используется)
1 CELLS     -- class
1 CELLS     -- number
1 FLOATS    -- fnumber
STRING-SIZE -- string
VALUE cell-size

QUAN table-size
QUAN table[]

: #>'  cell-size *  table[] + ;
: '>#  #cell @ ;

: CREATE-TABLE
  COLS ROWS * cell-size * TO table-size
  HERE TO table[]
  table-size ALLOT
  0 table[] table-size CFILL
  ROWS 0 DO
   COLS 0 DO
    IJ DUP #>' #cell !
   LOOP
  LOOP
;

CREATE-TABLE

\ # 3.1 Классы содержимого ячеек
: class-number.  \ 'cell --
  number @ num-color . prev-col ;
: class-fnumber. \ 'cell --
  fnumber F@ float-color F. prev-col ;
: class-string.  \ 'cell --
  string string-color CPRINT prev-col ;

0                 VALUE class-null
' class-number.   VALUE class-number
' class-fnumber.  VALUE class-fnumber
' class-string.   VALUE class-string

: print  \ cell' --
  DUP class @ DUP IF clear-cell OPAQUE ON EXECUTE OPAQUE OFF ELSE DROP DROP THEN ;
: cell-print  cell-textxy cell' print hlight ;

\ # 3.2 Изменение класса ячейки
: set-class-number
  cell' class-number SWAP class ! ;
: set-class-fnumber
  cell' class-fnumber SWAP class ! ;
: set-class-string
  cell' class-string SWAP class ! ;
: set-class-null
  cell' class-null SWAP class !
;

\ # 3.3 Вычисление формул
\ Вероятно потребуется переопределять слова работающие с арифметикой
VECT CELLACTION  \ Этот вектор вызывается "ячейкой" и получает в качестве аргумента адрес этой ячейки и возвращает
\ VECT CALCULATE  \ Этот вектор отвечает за обработку непосредственно формулы в строковом виде; вероятно EVALUATE будет достаточно и он не понадобится
: number@  \ 'cell -- D
  number @ ;
: fumber@  \ 'cell -- F@
  number F@ ;
: formula?  \ 'cell -- ?
  string C@ 61 =  \ char =
;

: calculate  \ 'cell -- cell_D
   DUP >R
   formula?
    IF
   \   DUP calculated? @ NOT
     \   IF
        \  DUP calculated? ON
          R@ string 1 + EVALUATE \ CALCULATE
          \ Если формула правильная, то на стеке должен быть результат - его надо сохранить в ячейку (надо бы добавить проверку глубины стека для определения правильности и 'чистоплотности' формулы)
          R@ number !
          R@ set-class-number
      \ THEN
  \  ELSE
    THEN
  R> number @ \ CELLACTION  <-- это что и зачем тут делает?
;

: col-work
  SWAP COLS * + #>' calculate
;
VECT COL-ACTION  \ #row #col --
: a  0 COL-ACTION ;  : b  1 COL-ACTION ;  : c  2 COL-ACTION ;  : d  3 COL-ACTION ;  : e  4 COL-ACTION ;
: f  5 COL-ACTION ;  : g  6 COL-ACTION ;  : h  7 COL-ACTION ;  : i  8 COL-ACTION ;  : j  9 COL-ACTION ;
: k 10 COL-ACTION ;  : l 11 COL-ACTION ;  : m 12 COL-ACTION ;  : n 13 COL-ACTION ;  : o 14 COL-ACTION ;
: p 15 COL-ACTION ;  : q 16 COL-ACTION ;  : r 17 COL-ACTION ;  : s 18 COL-ACTION ;  : t 19 COL-ACTION ;
: u 20 COL-ACTION ;  : v 21 COL-ACTION ;  : w 22 COL-ACTION ;  : x 23 COL-ACTION ;  : y 24 COL-ACTION ;
: z 25 COL-ACTION ;

\ # 3.4 Вычисление функций (небольшой пример)
QUAN 'vect
QUAN #execs
QUAN 'xt
: dalay-execute 
  -1 +TO #execs
  #execs NOT
   IF 'xt 'vect ! THEN
;

: DEXEC \ xt 'vect D -- \ 'Задержанный' вызов вектора, т.е. будет пропущено D вызовов, затем в вектор 'vect будет записан xt
  TO #execs 1+ TO 'vect TO 'xt
  ['] dalay-execute 'vect !
;

QUAN actbuf
QUAN row1 QUAN col1
QUAN row2 QUAN col2
VECT cells-act
: FOR(  \ xt --
  ['] cells-act 1 DEXEC
  FROM COL-ACTION TO actbuf
  'NOOP TO COL-ACTION
;
: )FOR  \ row1 col1 row2 col2 -- 2 1 4 2
  actbuf TO COL-ACTION
  TO col2 TO row2 TO col1 TO row1
  col1 row1 COLS * +
  row2 row1 1- DO
   col2 col1 1- DO
     OVER #>' calculate cells-act
     >R 1+ R>
   LOOP
   >R COLS + col2 col1 - - 1- R>
  LOOP
;

: +(  \ -- D
  ['] + FOR( ;
: )+  )FOR ;

: *(  \ -- D
  ['] * FOR( ;
: )*  )FOR ;

\ Примеры использования:
\ +( 0 a 2 b )+  \ Сложить все числа в ячейках 0a,1a,2a,0b,1b,2b
\ *( 0 a 2 b )*  \ Перемножить все числа в ячейках 0a,1a,2a,0b,1b,2b

\ ### 4.0 Интерфейс
\ # 4.1 Дополнительные элементы
VARIABLE col-name-buf
: col-name  \ n -- str
  "az + C@ col-name-buf ! col-name-buf ;
: BL.  WHERETEXTXY >R 8 + R> TEXTXY ;
: STATUS-BOX.
  OPAQUE ON
  sbox-x 1+  sbox-y 1+  sbox-a 2 -  sbox-b 2 -  цвет_фона  FBOX  \ Очищение
  sbox-x sbox-y sbox-a sbox-b цвет_таблицы BOX  \ Рамка
  sbox-x 1+  sbox-y 1+ sbox-b + 1- sbox-a 2 -  sbox-b 2 -  цвет_фона  FBOX
  sbox-x sbox-y sbox-b + 1- sbox-a sbox-b цвет_таблицы BOX  \ Рамка для строки
  sbox-x sbox-y box-textxy " Status: " PRINT   \ Текст
  WHERETEXTXY
   sbox-data-x sbox-x +  sbox-y  box-textxy
   " [ ¦FF3333 F5¦ Int= " CPRINT   cell' class-number.
   " ] [ ¦FF3333 F6¦ Float= " CPRINT   cell' class-fnumber.
   " ] [ cell: " PRINT
   cell-name-color
   cell-y table-y - CELLB / .
   cell-x table-x - CELLA / col-name PRINT BL.
   prev-col "  ] " PRINT
   sbox-x sbox-y sbox-b + 1- box-textxy
   " [ ¦FF3333 F7¦ Str= " CPRINT   cell' class-string. BL. " ]" PRINT
  TEXTXY
  OPAQUE OFF
;

\ # 4.2 Отрисовка таблицы
: rows-names.
  ROWS 0 DO
   table-x ROWS-NAMEA -  \ x
   table-y I CELLB * +   \ y
   2DUP box-textxy
   ROWS-NAMEA CELLB  цвет_таблицы  BOX
   I .
  LOOP
;
: cols-names.
  COLS 0 DO
   table-x I CELLA * +   \ x
   table-y CELLB -       \ y
   2DUP box-textxy
   CELLA CELLB  цвет_таблицы  BOX
   I col-name PRINT
  LOOP
;
: "#\N".
  table-x ROWS-NAMEA -
  table-y CELLB -
   2DUP box-textxy " #\N" PRINT
  ROWS-NAMEA
  CELLB
  цвет_таблицы BOX
;

: TABLE.  \ Отрисовка таблицы
  OPAQUE ON
  "#\N".
  rows-names.
  cols-names.
  ROWS 0 DO
   COLS 0 DO
     table-x I CELLA * +
     table-y J CELLB * +
      2DUP box-textxy
     CELLA CELLB цвет_таблицы BOX
      IJ #>' print  \ Отрисовывает содержимое ячеек
   LOOP
  LOOP
  OPAQUE OFF
;

\ # 4.3 Отрисовка всего интерфейса целиком
: that-cell  \ Устанавливает номер текущей ячейки в соответствующую переменную
  cell-x table-x -
  CELLA /
  cell-y table-y -
  CELLB / COLS *
  + #>' TO cell'
;

: DRAW-GUI
  0 0 2048 2048 цвет_фона FBOX
  цвет_текста SETCOLOR
  TABLE.
  that-cell cell-print
  hlight
  STATUS-BOX.
;

\ ### 5.0 Перемещение активной ячейки
: last-col-pos   table-x COLS 1- CELLA * + ;
: last-row-pos   table-y ROWS 1- CELLB * + ;

\ # 5.1 Отрисовка активной ячейки
: this  \ Активирует ячейку под курсором
  MOUSEX table-x MAX  table-x -  CELLA / CELLA *  \ Координата ячейки по горизонтали
  table-x +  last-col-pos  MIN
    TO cell-x
  MOUSEY table-y MAX  table-y -  CELLB / CELLB *  \ Координата ячейки по вертикали
  table-y +  last-row-pos  MIN
    TO cell-y
;

\ # 5.2 Перемещение курсором
: activate  \ Активирует ячейку
  that-cell
  un-hlight
  cell-y TO last-cell-y
  cell-x TO last-cell-x
  hlight
  STATUS-BOX.
;

\ ### 6.0 Ввод/вывод данных
: clear-inputbuf
  0 INPUTBUF 258 CFILL
;
\ # 6.1 Ячейки
: cell-input  \ Ввод обычного числа
  GOTOCONSOLE " Input number" PRINT
  activate  set-class-number
  cell' number INPUT
  DRAW-GUI
;
: cell-finput  \ Ввод флоат числа
  GOTOCONSOLE " Input float" PRINT
  activate  set-class-fnumber
  cell' fnumber FINPUT
  DRAW-GUI
;
: cell-sinput  \ Ввод строки
  GOTOCONSOLE " Input string" PRINT
  activate  set-class-string
  clear-inputbuf
  INPUTDIALOG
    IF
      INPUTBUF cell' string STRING-SIZE CMOVE
      set-class-string clear-inputbuf
      cell' calculate
      DRAW-GUI
    THEN
;
: cell-zeroize  \ Обнуление ячейки
  activate
  set-class-null
  0 cell' number 1 CELLS CFILL
  0 cell' fnumber 1 FLOATS CFILL
  0 cell' string STRING-SIZE CFILL
  clear-cell
  DRAW-GUI
;

: input-mouse  this cell-input ;
: finput-mouse  this cell-finput ;
: sinput-mouse  this cell-sinput ;

: cell-set-class-number
  activate clear-cell set-class-number cell-print ;
: cell-set-class-fnumber
  activate clear-cell set-class-fnumber cell-print ;
: cell-set-class-string
  activate clear-cell set-class-string cell-print ;
: cell-set-class-null
  activate clear-cell set-class-null cell-print ;

\ # 6.2 Файловые операции
VARIABLE num>file-buf
: .FILE  \ D -- file: D  \ Печатает число со стека в файл HF-OUT как бинарные данные
  num>file-buf ! HF-OUT num>file-buf 1 CELLS WRITEFILE DROP ;
: FILE.  \ file: D -- D  \ Читает из файла HF-OUT число как бинарные данные на стек
  HF-OUT num>file-buf 1 CELLS READFILE num>file-buf @ ;
: file-name-print
  " '" PRINT INPUTBUF PRINT " '" PRINT
;

0x51465446 VALUE file-type  \ Quark Forth Table File
: SAVE-TABLE
  GOTOCONSOLE " Save table - enter file-name" PRINT
  clear-inputbuf
  INPUTDIALOG
   IF
     DRAW-GUI
     INPUTBUF NEWFILE TO HF-OUT
    \ " test.txt" NEWFILE TO HF-OUT
     file-type .FILE  \ По-хорошему бы это все надо в один массив сделать
     цвет_таблицы .FILE      цвет_фона .FILE      цвет_выделения .FILE   цвет_текста .FILE
     table-x .FILE      table-y .FILE      COLS .FILE      ROWS .FILE
     CELLA .FILE      CELLB .FILE      ROWS-NAMEA .FILE   sbox-x .FILE
     sbox-y .FILE      sbox-a .FILE      sbox-b .FILE      sbox-data-x .FILE
     STRING-SIZE .FILE      cell-x .FILE      cell-y .FILE            cell' .FILE
     col-buf .FILE      last-cell-x .FILE   last-cell-y .FILE      last-cell-a .FILE
     last-cell-b .FILE
    HF-OUT table[] table-size WRITEFILE
    HF-OUT CLOSE
    DRAW-GUI
    GOTOCONSOLE file-name-print " ¦00FF00 saved...¦" CPRINT
   THEN
;
: LOAD-TABLE
  GOTOCONSOLE " Load table - enter file-name" PRINT
  clear-inputbuf
  INPUTDIALOG
   IF
    DRAW-GUI
    INPUTBUF OPEN TO HF-OUT
   \ " test.txt" OPEN TO HF-OUT
     FILE. file-type =
      IF
       FILE. TO цвет_таблицы   FILE. TO цвет_фона   FILE. TO цвет_выделения   FILE. TO цвет_текста
       FILE. TO table-x      FILE. TO table-y   FILE. TO COLS      FILE. TO ROWS
       FILE. TO CELLA      FILE. TO CELLB      FILE. TO ROWS-NAMEA   FILE. TO sbox-x
       FILE. TO sbox-y      FILE. TO sbox-a      FILE. TO sbox-b      FILE. TO sbox-data-x
       FILE. TO STRING-SIZE   FILE. TO cell-x      FILE. TO cell-y      FILE. TO cell'
       FILE. TO col-buf      FILE. TO last-cell-x   FILE. TO last-cell-y    FILE. TO last-cell-a
       FILE. TO last-cell-b
       CREATE-TABLE
       HF-OUT table[] table-size READFILE
       DRAW-GUI
       GOTOCONSOLE file-name-print " ¦00FF00 loaded...¦" CPRINT
     ELSE
       GOTOCONSOLE file-name-print " ¦0000EE not Quark Forth Table File!¦" CPRINT
     THEN
   THEN
  HF-OUT CLOSE
;

\ ### 7.0 Перемещения
\ # 7.1 Перемещение текущей ячейки
: act-cell-left
  last-cell-x  CELLA - table-x  MAX  TO cell-x
  last-cell-y  TO cell-y
  activate ;
: act-cell-right
  last-cell-x  CELLA +  last-col-pos MIN  TO cell-x
  last-cell-y  TO cell-y
  activate ;
: act-cell-up
  last-cell-x  TO cell-x
  last-cell-y  CELLB - table-y  MAX  TO cell-y
  activate ;
: act-cell-down
  last-cell-x  TO cell-x
  last-cell-y  CELLB + last-row-pos MIN  TO cell-y
  activate
;

\ # 7.2 Перемещение таблицы \ TODO: Необходимо "сместить" только отрисовку содержимого ячеек, имена столбиков и номера строк

\ ### 8.0 Хоткеи
' act-cell-left TO K_LEFT
' act-cell-right TO K_RIGHT
' act-cell-up TO K_UP
' act-cell-down TO K_DOWN

' cell-set-class-number  TO K_F1
' cell-set-class-fnumber TO K_F2
' cell-set-class-string TO K_F3
' cell-set-class-null TO K_F4

' cell-input  TO K_F5
' cell-finput TO K_F6
' cell-sinput TO K_F7
' cell-zeroize TO K_F8

' BYE TO K_F9
' DRAW-GUI TO K_HOME
' SAVE-TABLE TO K_F11
' LOAD-TABLE TO K_F12

' input-mouse  TO <MOUSE_LEFT>
' finput-mouse TO <MOUSE_WHEEL>
' sinput-mouse TO <MOUSE_RIGHT>

\ # 8.1 Помощь
: cell-pos-print \ row col --
  SWAP >R CELLA * table-x +
  R> CELLB * table-y +
  box-textxy CPRINT
;

: help
  FROM COL-ACTION
  ['] cell-pos-print TO COL-ACTION
  " [ ¦DD5544 F1¦:"   0 a   " ¦4455DD show number¦ ]"  0 b
  " [ ¦DD5544 F2¦:"   1 a   " ¦4455DD show float¦ ]"   1 b
  " [ ¦DD5544 F3¦:"   2 a   " ¦4455DD show string¦ ]"  2 b
  " [ ¦DD5544 F4¦:"   3 a   " ¦4455DD show null¦ ]"    3 b
  " [ ¦DD5544 F5¦:"   4 a   " ¦4455DD input number¦ ]" 4 b
  " [ ¦DD5544 F6¦:"   5 a   " ¦4455DD input float¦ ]"  5 b
  " [ ¦DD5544 F7¦:"   0 c   " ¦4455DD input string¦ ]" 0 d
  " [ ¦DD5544 F8¦:"   1 c   " ¦4455DD zeroize¦ ]"      1 d
  " [ ¦DD5544 F9¦:"   2 c   " ¦4455DD exit program¦ ]" 2 d
  " [ ¦DD5544 HOME¦:" 3 c   " ¦4455DD redraw gui¦ ]"   3 d
  " [ ¦DD5544 F11¦:"  4 c   " ¦4455DD save table¦ ]"   4 d
  " [ ¦DD5544 F12¦:"  5 c   " ¦4455DD load table¦ ]"   5 d
  " ¦FFFFFF type¦ ¦FFAA22 ?¦ ¦FFFFFF or¦ ¦FFAA22 help¦" 6 a
  " ¦55DD44 HOME¦ - hide" 7 a
  TO COL-ACTION
  hlight
;
: ? help ;
\ ### 9.0 Выполнение программы
\ ' DRAW-GUI TO OK

\ ' number@ TO CELLACTION
' col-work TO COL-ACTION
DRAW-GUI
help

P.S. Если необходимо - могу урезать до самого минимума и привести в полное соответсвие с ТЗ, вот только неизвестно когда будет на это время.

_________________
Cтоимость сопровождения программного обеспечения пропорциональна квадрату творческих способностей программиста.
Роберт Д. Блисc


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Чт мар 27, 2008 23:11 
Не в сети
Аватара пользователя

Зарегистрирован: Вт мар 20, 2007 23:39
Сообщения: 1255
Благодарил (а): 3 раз.
Поблагодарили: 17 раз.
И что? :? Неужели никто ничего не скажет? Я так старался и хотелось бы хотя бы конструктивную критику/совет услышать, или еще что-нибудь...

_________________
Cтоимость сопровождения программного обеспечения пропорциональна квадрату творческих способностей программиста.
Роберт Д. Блисc


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
Показать сообщения за:  Поле сортировки  
Начать новую тему Ответить на тему  [ Сообщений: 19 ]  На страницу 1, 2  След.

Часовой пояс: UTC + 3 часа [ Летнее время ]


Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 3


Вы не можете начинать темы
Вы можете отвечать на сообщения
Вы не можете редактировать свои сообщения
Вы не можете удалять свои сообщения
Вы не можете добавлять вложения

Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group
phpBB сборка от FladeX // Русская поддержка phpBB