Сегодня утром, в
чате.
Цитата:
[Pretorian] Мне надо скажем сдублировать 5 параметров на стеке, т.к. их съест апи функция, если в спф какое нибудь слово для этого?
[mrack] как вариант обратится к облости стека напримую
[mrack] SP@ помоему
[mrack] и пятикратно считать пятый параметр
[Pretorian] Пришлось сдублировать параметры и отправить на хранение в стек возратов
[Pretorian] Хотя наверное обратиться к области стека через PICK быстрее
[mrack] тогда может лучше использовать локальные переменные ?
[profit1984] Pretorian, зачем тебе нужно сдублировать 5 значений на стеке?..
[profit1984] Что за функция?
[Pretorian] FillConsoleOutputAttribute в цикле нужна
[Pretorian] Тоже самое и для FillConsoleOutputCharacterA
[Pretorian] Самый оптимальный какой будет способ?
[Pretorian] profit1984 FillConsoleOutputAttribute в цикле нужна. Самый оптимальный какой будет способ?
[profit1984] Ну с самого начала понятно что параметр hConsoleOutput изменяться не будет.
[profit1984] Поэтому:
[profit1984] 0 VALUE hConsole
[profit1984] bla-bla TO hConsole
[profit1984] : blabla hConsole FillConsoleOutputAttribute ;
[profit1984] Далее..
[Pretorian] У меня есть H-STDOUT
[Pretorian] Мне надо 3 параметра сохранить
[Pretorian] А хендл и 0 в конце мне не к чему сохранять
[Pretorian] Я это делаю через стек возратов
[Pretorian] Но мне кажется что лучше через PICK растиражировать в стеке?
[Pretorian] AttrWindow ( x y lenght height color background -> ) Color->N SWAP >R 2SWAP XY->N 0 SWAP 2SWAP R> 0 DO DUP >R OVER >R 2 PICK >R H-STDOUT FillConsoleOutputAttribute DROP 0 R> 0x10000 + R> R> LOOP 2DROP 2DROP ;
А теперь такое решение (внизу будет ещё одно, ещё более короткое и ясное):
Код:
REQUIRE { lib/ext/locals.f
REQUIRE #define ~af/lib/c/define.f
#define FOREGROUND_BLUE 1
#define FOREGROUND_GREEN 2
#define FOREGROUND_RED 4
#define FOREGROUND_INTENSITY 8
#define BACKGROUND_BLUE 16
#define BACKGROUND_GREEN 32
#define BACKGROUND_RED 64
#define BACKGROUND_INTENSITY 128
WINAPI: FillConsoleOutputAttribute KERNEL32
: xy ( x y -- xy ) 16 LSHIFT + ;
: setColorsInRow ( x y n color -- )
2>R xy ( xy R: n color )
RP@ \ получили адрес ячейки в стеке возвратов, так как функции
\ нужен адрес переменной куда она будет писать, всё равно какой
SWAP 2R@ ( addr xy n color )
H-STDOUT FillConsoleOutputAttribute DROP RDROP RDROP ;
\ 10 0 200 FOREGROUND_RED BACKGROUND_GREEN OR setColorsInRow
: setColorsForBlock ( x y w h c -- ) { c -- }
ROT TUCK + SWAP DO 2DUP I SWAP c setColorsInRow LOOP 2DROP ;
10 0 7 3 FOREGROUND_RED BACKGROUND_GREEN OR setColorsForBlock
А теперь как я к этому пришёл. Посмотрев на имена параметров в слове AttrWindow
Pretorian'а я понял что нужно для прямоугольной области консольной окна задаваемой (x,y)-(x+w,y+h) выставлять параметры цвета.
Первым делом начал внимательно (слева-направо, сверху-вниз, не пропуская буквы и слова) читать соответсвующую функции FillConsoleOutputAttribute статью в MSDN. Оттуда стало ясно:
1. Первый параметр не меняется, его задавать не надо.
2. Последний параметр тоже не надо задавать, это адрес ячейки памяти куда FillConsoleOutputAttribute запишет сколько на самом деле она поставила цветовых свойств у символов.
3. Цветовые свойства (цвет фона и цвет текста) нужно задавать не двумя значениями на стеке, а одним.
Затем я написал набросок слова которое в ряду y начиная с позиции x ставит n символов цветами color:
Код:
: setColorsInRow ( x y n color -- )
...
( addr xy n color ) \ в этом порядке должны стоять параметры функции к данному моменту
H-STDOUT FillConsoleOutputAttribute DROP
...
;
10 0 200 FOREGROUND_RED BACKGROUND_GREEN OR setColorsInRow
Ясно что для того чтобы достать до x y превратить их в одно значение xy и ещё подложить под него адрес ячейки памяти addr нужно на время убрать два значения n color. Хорошо, убираем, кидая их на R-стек:
Код:
: setColorsInRow ( x y n color -- )
2>R xy ( xy R: n color )
... \ здесь возьмём значение addr
( xy addr R: n color )
SWAP 2R> ( addr xy n color )
( addr xy n color ) \ в этом порядке должны стоять параметры функции к данному моменту
H-STDOUT FillConsoleOutputAttribute DROP
;
В принципе как addr можно было подсунуть нолик, но лучше я на это полагаться не буду (в справке про это ни слова не сказано). Как вариант можно было дать адрес какой-нибудь переменной, какую не жалко (всё равно анализировать это дело не будем):
Код:
VAIRABLE tmp
: setColorsInRow ( x y n color -- )
2>R xy ( xy R: n color )
tmp \ здесь возьмём значение addr
( xy addr R: n color )
SWAP 2R> ( addr xy n color )
( addr xy n color ) \ в этом порядке должны стоять параметры функции к данному моменту
H-STDOUT FillConsoleOutputAttribute DROP
;
Но я чтобы не мусорить в словаре, предпочёл подсовывать функции ненужную ячейку из стека возвратов, как оно и указано в окончательном варианте setColorsInRow вверху.
Дальше. Мы написали слово которое ставит цвета внутри одного ряда. Как теперь этим словом закрасить прямоугольный блок?.. Я взял ручку и написал на лежавшей рядом бумажке:
Цитата:
xy:(10,0), wh:(5,3)
x y l
10 0 5
10 1 5
10 2 5
Структура цикла стала ясна, инвариантами цикла (неизменяемыми параметрами) будут x и w, а в цикле будем проходить от y до y+h.
Пишем набросок слова с параметрами и его использование:
Код:
: setColorsForBlock ( x y w h -- )
... ( x w y+h y )
DO ... LOOP ... ;
10 0 5 3 setColorsForBlock
Раскрываем первое многоточие:
Код:
: setColorsForBlock ( x y w h -- )
ROT TUCK + SWAP ( x w y+h y )
DO ... LOOP ... ;
Затем обращаем внимание на тело цикла. Указываем инварианты цикла:
Код:
: setColorsForBlock ( x y w h -- )
ROT TUCK + SWAP ( x w y+h y )
DO ( x w ) ... LOOP
( x w ) 2DROP ;
Раскрываем последнее многоточие в теле цикла и проверяем работу написанного выводом стека (на самом деле, я к этому моменту запускал/проверял/писал-дальше программу уже раз двадцать):
Код:
: setColorsForBlock ( x y w h -- )
ROT TUCK + SWAP ( x w y+h y )
DO I SWAP ( x i w ) CR DEPTH .SN NIP LOOP
( x w ) 2DROP ;
10 0 5 3 setColorsForBlock
Выводит нужную таблицу такую же как накалякал я только что. Затем вместо обычного вывода стека вписываем наше слово setColorsInRow (стек меняется так как это слово снимает со стека свои параметры и тогда получается что инварианты нужно дополнительно дублировать в каждой итерации):
Код:
: setColorsForBlock ( x y w h -- )
ROT TUCK + SWAP ( x w y+h y )
DO 2DUP I SWAP ( x w x i w )
... \ достаём значение цвета
( x w x i w color ) setColorsInRow LOOP
( x w ) 2DROP ;
10 0 5 3 setColorsForBlock
Осталось только разобраться с передачей цвета из параметров внутрь цикла. Не мудря на ровном месте сделал локальными переменными (на R-стек записывать не получится, т. к. цикла у нас DO ... LOOP).
А есть и более простое решение как избежать всей этой "мышиной возни" на стеке (пусть это и не "стековая эквилибристика", как было изначально у
Pretorian'а). Можно просто убрать x, y и color в глобальные переменные:
Код:
\ На "бис", ещё более простой вариант
VARIABLE XY
XY 0!
: setXY ( x y -- ) xy XY ! ;
: move ( dx dy -- ) xy XY +! ;
: moveDown 0 1 move ;
VARIABLE color
: setColor ( c -- ) color ! ;
: setColorsInRow ( n -- )
0 >R RP@ SWAP XY @ SWAP color @ H-STDOUT FillConsoleOutputAttribute DROP RDROP ;
BACKGROUND_RED FOREGROUND_GREEN OR setColor
15 0 setXY
\ 3 setColorsInRow
: setColorsForBlock ( w h -- )
XY @ >R \ сохраняем значение курсора, т.к. оно меняется
0 DO DUP setColorsInRow moveDown LOOP DROP
R> XY ! ;
8 5 setColorsForBlock
Едва ли тут что-то требует уже объяснений.
Вход
Регистрация
Благодарности
Forth-FAQ
