Виртуальные кнопки для Protona.
Все обновления будут лежать здесь же.
Минимальный (джентельменский) набор, для кнопок.
Есть пример создания кнопок.
* 19.06.2007
Все создаваемые кнопки автоматически прописываются в массиве указателей кнопок. Теперь не надо в слово "РисоватьКнопки" вручную их все записывать.
* 21.06.2007
Добавлено слово .PRINT для написания текста с прозрачным фоном
* 03.07.2007
Оформлено в виде библиотеки. Немного переделано слово "СоздатьКнопку"
Библиотека Graph.fpm:
Код:
: DUPS // Arr[1..M] M --> Arr[1..M] Arr[1..M]
DUP 0 DO
DUP PICK SWAP
LOOP
DROP
;
: 2DUPS // a b --> a b a b
OVER OVER
;
: DROPS // Arr[1..M] M -->
0 DO DROP LOOP
;
// Графика
: RGB-> // Color --> R G B
65536 /MOD
256 /MOD
ROT ROT SWAP
;
: Box // x y ширина высота цвет -->
4 PICK 4 PICK
2 DUPS
6 PICK 5 PICK HLINE
3 PICK 3 PICK VLINE
4 PICK 3 PICK + 4 PICK 3 PICK 1+ 3 PICK VLINE
4 PICK 4 PICK 3 PICK + 4 PICK 1+ 3 PICK HLINE
5 DROPS
;
: FillBox // x y ширина высота цвет -->
3 PICK 2 PICK + 4 PICK DO
4 PICK I 4 PICK 3 PICK HLINE
LOOP
5 DROPS
;
: Gradient // Percent Color1 Color2 --> Color
// Переход от цвета1 к цвету2
// Percent - 0..100
SWAP RGB->
3 PICK RGB-> // DS: Percent Color2 R1 G1 B1 R2 G2 B2
3 PICK - 7 PICK * 100 / 3 PICK + 3 XCHG DROP // DS: Percent Color2 R1 G1 Bnew R2 G2
3 PICK - 6 PICK * 100 / 3 PICK + 3 XCHG DROP // DS: Percent Color2 R1 Gnew Bnew R2
3 PICK - 5 PICK * 100 / 3 PICK + 3 XCHG DROP // DS: Percent Color2 Rnew Gnew Bnew
RGB
2 XCHG DROP DROP
;
: GradientBox // x y ширина высота цвет1 цвет2 -->
4 PICK 3 PICK + 5 PICK DO
5 PICK I // x i
5 PICK // ширина
OVER 8 PICK - 100 * 6 PICK / // Percent=(i-y)/высота
5 PICK 5 PICK Gradient // Percent цвет1 цвет2 --> color
HLINE
LOOP
6 DROPS
;
: +X // n -->
WHERETEXTXY ROT ROT + SWAP TEXTXY
;
: +Y // n -->
WHERETEXTXY ROT + TEXTXY
;
-1 VALUE TextOpaque
-1 VALUE BackOpaque
// Печать текста с прозрачным фоном
// Работает аналогоично слову PRINT
: .PRINT // p --->
DUP C@ IF
BEGIN
DUP C@ 16 * SYMBOLS +
16 0 DO
DUP I + C@
0x80
8 0 DO
OVER OVER AND IF
TextOpaque NOT IF WHERETEXTXY GETCOLOR PIXEL THEN
ELSE
BackOpaque NOT IF WHERETEXTXY GETBGCOLOR PIXEL THEN
THEN
2/
1 +X
LOOP
DROP DROP
-8 +X
1 +Y
LOOP
DROP
8 +X
-16 +Y
1+ DUP C@ 0 = UNTIL
THEN
DROP
;
: strLen // p --> len
0
OVER C@ IF
BEGIN 1+ OVER OVER + C@ 0 = UNTIL
THEN
SWAP DROP
;
: gPRINT // p -->
DUP strLen
WHERETEXTXY ROT // x y len
8 * 16
GETCOLOR GETBGCOLOR
GradientBox
BackOpaque TextOpaque GETBGCOLOR
0 TO BackOpaque
-1 TO TextOpaque
3 PICK .PRINT
SETBGCOLOR TO TextOpaque TO BackOpaque
DROP
;
Библиотека самих кнопок
Код:
" Graph.fpm" L
: FIELD
CREATE
OVER , +
DOES>
@ +
;
: int
4 FIELD
;
0
int ->кнХ
int ->кнУ
int ->кнШирина
int ->кнВысота
int ->кнРаботай
int ->кнНадпись
int ->кнЦвет1
int ->кнЦвет2
CONSTANT Кнопка
100 VALUE MaxButtons
QUAN CurButtons
CREATE Buttons[] MaxButtons 4 * ALLOT
: СоздатьКнопку // IT: str -->
HERE
CREATE Кнопка ALLOT
25 OVER ->кнХ !
25 OVER ->кнУ !
96 OVER ->кнШирина !
32 OVER ->кнВысота !
0xBFBFBF OVER ->кнЦвет1 !
0x707070 OVER ->кнЦвет2 !
" Button" OVER ->кнНадпись !
['] NOOP OVER ->кнРаботай !
CurButtons
SWAP OVER 4 * Buttons[] + !
1+ TO CurButtons
;
0 CONSTANT обычную
1 CONSTANT подсвеченую
2 CONSTANT нажатую
QUAN кнАдрес
QUAN dbLigth
: КнопкуРисуй // addr Подсвечивать? -->
TO dbLigth
TO кнАдрес
кнАдрес ->кнХ @
кнАдрес ->кнУ @
кнАдрес ->кнШирина @
кнАдрес ->кнВысота @
dbLigth обычную = NOT IF
0xFFFFFF
ELSE
50
кнАдрес ->кнЦвет1 @
кнАдрес ->кнЦвет2 @
Gradient
THEN
FillBox
кнАдрес ->кнХ @ 3 +
кнАдрес ->кнУ @ 3 +
кнАдрес ->кнШирина @ 6 -
кнАдрес ->кнВысота @ 6 -
кнАдрес ->кнЦвет1 @
кнАдрес ->кнЦвет2 @
dbLigth нажатую = IF SWAP THEN
GradientBox
// Надпись на кнопке
кнАдрес ->кнХ @ 15 +
кнАдрес ->кнУ @ кнАдрес ->кнВысота @ SHR SHR +
TEXTXY
50 кнАдрес ->кнЦвет1 @ кнАдрес ->кнЦвет2 @ Gradient SETBGCOLOR
0x000000 SETCOLOR
-1 TO BackOpaque
0 TO TextOpaque
кнАдрес ->кнНадпись @ .PRINT
0 TO BackOpaque
0x000000 SETBGCOLOR
0x00FF00 SETCOLOR
;
: ПроверитьКнопку // addr --> 0 | -1
TO кнАдрес
0
MOUSE-X @
кнАдрес ->кнХ @ DUP
кнАдрес ->кнШирина @ +
WITHIN IF
MOUSE-Y @
кнАдрес ->кнУ @ DUP
кнАдрес ->кнВысота @ +
WITHIN IF
DROP -1
THEN
THEN
;
: Нажата? // addr -->
DUP ПроверитьКнопку IF
DUP нажатую КнопкуРисуй
->кнРаботай @ EXECUTE
ELSE DROP THEN
;
: Подсветить? // addr -->
DUP ПроверитьКнопку IF
подсвеченую КнопкуРисуй
ELSE DROP THEN
;
: РисоватьКнопки
CurButtons IF
CurButtons 0 DO
Buttons[] I 4 * + @ обычную КнопкуРисуй
LOOP
THEN
;
: ЧтоНажато? // -->
CurButtons IF
CurButtons 0 DO
Buttons[] I 4 * + @ Нажата?
LOOP
THEN
;
: ЧтоПодсветить? // -->
CurButtons IF
CurButtons 0 DO
Buttons[] I 4 * + @ Подсветить?
LOOP
THEN
;
: LeftClick
РисоватьКнопки
ЧтоНажато?
;
' LeftClick TO <MOUSE_LEFT>
: MouseMove
РисоватьКнопки
ЧтоПодсветить?
;
' MouseMove TO <MOUSE_MOVE>
// Пример использования
СоздатьКнопку кнопка
: Работать!!!
0 0 GOTOXY
" Да работаю, работаю!" PRINT
;
' Работать!!! кнопка ->кнРаботай !
СоздатьКнопку рычалка
75 рычалка ->кнУ !
0x7F7FFF рычалка ->кнЦвет1 !
0x0000FF рычалка ->кнЦвет2 !
: Рычать
0 0 GOTOXY
" Рыыы-ры-ры-ры-рыыы!" PRINT
;
' Рычать рычалка ->кнРаботай !
CLS