/* AmigaE Intuition IDCMP ghh 2024 */
/* Intuition IDCMP pozice kliknuti v okne */
MODULE 'intuition/intuition'
MODULE 'utility/tagitem'
PROC main()
DEF win:PTR TO window
DEF class
DEF imess:PTR TO intuimessage
DEF quit
win:= OpenWindowTagList(NIL, /* taglist je v hranatych zavorkach */
[WA_Left, 10, /* pozice X */
WA_Top, 14, /* pozice Y */
WA_Width, 320, /* sirka */
WA_Height, 160, /* vyska */
WA_CloseGadget, TRUE, /* gadget zavreni okna */
WA_DragBar, TRUE, /* okno se da uchopit a pretahnout */
WA_DepthGadget, TRUE, /* gadget prepinani oken vpred-vzad */
WA_SizeBBottom, TRUE, /* dolni lista okna */
WA_SizeGadget, TRUE, /* gadget zmeny velikosti */
WA_RMBTrap, TRUE, /* umozni hlasit zmacknuti praveho tlacitka mysi */
WA_IDCMP, IDCMP_CLOSEWINDOW OR /* okno lze zavrit gadgetem (Intuition IDCMP) */
IDCMP_MOUSEBUTTONS, /* Intuition bude hlasit akce s mysi */
WA_Title, 'IDCMP Pozice', /* titulek na liste okna */
WA_MinWidth, 100, /* minimalni sirka okna */
WA_MinHeight, 50, /* minimalni vyska okna */
WA_MaxWidth, -1, /* maximalni sirka -1 = neomezene */
WA_MaxHeight, -1, /* maximalni vyska -1 = neomezene */
WA_Activate, TRUE, /* okno bude aktivni pri spusteni */
TAG_DONE, 0]) /* konec taglistu */
quit:= FALSE
WHILE quit = FALSE /* smycka bezi dokud neobdrzi pokyn (quit:= TRUE) */
class:= NIL
IF imess:= GetMsg(win.userport) /* prijima zpravu z msg portu okna */
class:= imess.class /* imess.class - podle toho co je nastaveno v WA_IDCMP */
SELECT class /* podle obsahu zpravy se provede akce */
CASE IDCMP_MOUSEBUTTONS /* zprava obsahuje akci s mysi */
tlacitka(imess) /* funkce co obsluhuje hlaseni tlacitek */
CASE IDCMP_CLOSEWINDOW /* pokud zprava obsahuje pokyn k zavreni okna */
quit:= TRUE /* tak prerusit smycku */
ENDSELECT
ReplyMsg(imess) /* odesle odpoved na svuj port */
ELSE
WaitPort(win.userport) /* ceka na zpravu z msg portu okna */
ENDIF
ENDWHILE /* konec smycky */
CloseWindow(win) /* zavre okno az se prerusi smycka */
ENDPROC
PROC tlacitka(imess:PTR TO intuimessage)
DEF code
/* Intuition vyplnuje strukturu intuimessage kde jsou */
/* udaje o pozici kurzoru mysi a dalsi uzitecne veci */
/* Udaje cteme pres ukazatel imess */
code:= imess.code /* kod akce */
SELECT code /* podle kodu se provede akce */
CASE SELECTDOWN /* leve tlacitko bylo zmacknuto */
WriteF('LMB pozice x:\d y:\d\n', imess.mousex, imess.mousey)
CASE SELECTUP /* leve tlacitko bylo uvolneno */
WriteF('LMB uvolneno pozice x:\d y:\d\n', imess.mousex, imess.mousey)
CASE MENUDOWN /* prave tlacitko bylo zmacknuto */
WriteF('RMB pozice x:\d y:\d\n', imess.mousex, imess.mousey)
CASE MENUUP /* prave tlacitko bylo uvolneno */
WriteF('RMB uvolneno pozice x:\d y:\d\n', imess.mousex, imess.mousey)
CASE MIDDLEDOWN /* prostredni tlacitko bylo zmacknuto */
WriteF('MMB pozice x:\d y:\d\n', imess.mousex, imess.mousey)
CASE MIDDLEUP /* prostredni tlacitko bylo uvolneno */
WriteF('MMB uvolneno pozice x:\d y:\d\n', imess.mousex, imess.mousey)
ENDSELECT
ENDPROC
|