/* Kurs E, czėōź 5 -- GTExample v1.0 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Program pokazuje jak siė posīugiwaź bibliotekā gadtools.library -- czyli budowaź wīasny interfejs uūytkownika. Ūródīo wymaga uzupeīnienia przez Ciebie! (ale da siė skompilowaź i uruchomiź) */ ENUM ER_OK,ER_NODFLIB,ER_NOGTLIB,ER_NOMEM,ER_NOFONT,ER_WB, ER_VISUAL,ER_CONTEXT,ER_MENUS,ER_GADGET,ER_WINDOW ENUM GA_SLIDER0=1,GA_LISTV0 MODULE 'diskfont','graphics/text' MODULE 'intuition/intuition','gadtools','libraries/gadtools' MODULE 'intuition/gadgetclass','exec/nodes','intuition/screens' DEF diskfontbase,mojfont,tmp,wys,tekst[200]:STRING,mymenu,mymenuitem DEF mojtextattr:PTR TO textattr,mojtext:PTR TO intuitext DEF scr:PTR TO screen,visual,wnd:PTR TO window,glist,g DEF type,infos,listv:PTR TO LONG,menu,tutaj CONST MINSYSTEM=39 RAISE ER_NOMEM IF New()=NIL PROC main() HANDLE openinterface() REPEAT wait4message() StringF(tekst,'typ: \d, gadget: \h ',type,infos) wypisz(5,tutaj,tekst) SELECT type CASE IDCMP_MENUPICK mymenu:=infos AND %11111 mymenuitem:=Shr(infos AND %11111100000,5) SELECT mymenuitem CASE 0 wypisz(5,tutaj,'Wybrales Open .LHA file ') CASE 1 wypisz(5,tutaj,'Wybrales Open .LHA file ') /* 2 to "szlaczek" */ CASE 3 wypisz(5,tutaj,'Wybrales About ') CASE 4 type:=IDCMP_CLOSEWINDOW ENDSELECT ENDSELECT UNTIL type=IDCMP_CLOSEWINDOW Raise(ER_OK) EXCEPT IF mojfont THEN CloseFont(mojfont) IF diskfontbase THEN CloseLibrary(diskfontbase) IF wnd THEN ClearMenuStrip(wnd) IF menu THEN FreeMenus(menu) IF visual THEN FreeVisualInfo(visual) IF wnd THEN CloseWindow(wnd) IF glist THEN FreeGadgets(glist) IF scr THEN UnlockPubScreen(NIL,scr) IF gadtoolsbase THEN CloseLibrary(gadtoolsbase) IF exception SELECT exception CASE ER_NODFLIB WriteF('Cannot open diskfont.library.\n') CASE ER_NOGTLIB WriteF('Cannot open gadtools.library.\n') CASE ER_WB WriteF('Cannot lock Workbench screen.\n') CASE ER_VISUAL WriteF('Cannot get visual info.\n') CASE ER_CONTEXT WriteF('Cannot get gadget context.\n') CASE ER_NOMEM WriteF('No memory for program operation.\n') CASE ER_NOFONT WriteF('Cannot open \s.\n',mojtextattr.name) CASE ER_MENUS WriteF('Cannot create menus.\n') CASE ER_GADGET WriteF('Cannot create gadget(s).\n') CASE ER_WINDOW WriteF('Cannot open window.\n') DEFAULT WriteF('Unknown exception: \d \h "\s".\n',exception,exception,[exception,0]) ENDSELECT ENDIF ENDPROC PROC openinterface() IF (diskfontbase:=OpenLibrary('diskfont.library',37))=NIL THEN Raise(ER_NODFLIB) IF (gadtoolsbase:=OpenLibrary('gadtools.library',37))=NIL THEN Raise(ER_NOGTLIB) IF (scr:=LockPubScreen('Workbench'))=NIL THEN Raise(ER_WB) IF (visual:=GetVisualInfoA(scr,NIL))=NIL THEN Raise(ER_VISUAL) mojtextattr:=New(SIZEOF textattr) mojtextattr.name:='scala.font' mojtextattr.ysize:=13 mojtextattr.style:=FS_NORMAL /* FSF_BOLD+FSF_ITALIC */ mojtextattr.flags:=FPF_DESIGNED mojtext:=New(SIZEOF intuitext) IF (mojfont:=OpenDiskFont(mojtextattr))=NIL THEN Raise(ER_NOFONT) wys:=5 IF (g:=CreateContext({glist}))=NIL THEN Raise(ER_CONTEXT) IF (menu:=CreateMenusA( [NM_TITLE,NIL,'Project',NIL,NIL,NIL,NIL, NM_ITEM,NIL,'Open .LHA file','l',NIL,NIL,NIL, NM_ITEM,NIL,'Save .LHA file','s',NM_ITEMDISABLED,NIL,NIL, NM_ITEM,NIL,NM_BARLABEL,NIL,NIL,NIL,NIL, NM_ITEM,NIL,'About','a',NIL,NIL,NIL, NM_ITEM,NIL,'Quit','q',NIL,NIL,NIL, NM_END,NIL,NIL,NIL,NIL,NIL,NIL]:newmenu,NIL))=NIL THEN Raise(ER_MENUS) IF LayoutMenusA(menu,visual,NIL)=FALSE THEN Raise(ER_MENUS) IF (g:=CreateGadgetA(SCROLLER_KIND,g, [5,wys,200,mojtextattr.ysize+4,NIL,NIL,GA_SLIDER0,0,visual,0]:newgadget, [GTSC_TOP,2, GTSC_VISIBLE,3, GTSC_TOTAL,10, GTSC_ARROWS,22, PGA_FREEDOM,LORIENT_HORIZ, GA_RELVERIFY,TRUE, GA_IMMEDIATE,TRUE,0]))=NIL THEN Raise(ER_GADGET) wys:=wys+mojtextattr.ysize+14 listv:=[0,0,0,0]; listv[0]:=listv+4; listv[2]:=listv AddTail(listv,[0,0,0,0,'Magazyn AMIGA']:ln) AddTail(listv,[0,0,0,0,'Enter']:ln) AddTail(listv,[0,0,0,0,'PCkurier']:ln) AddTail(listv,[0,0,0,0,'Net Forum']:ln) AddTail(listv,[0,0,0,0,'Unix Forum']:ln) AddTail(listv,[0,0,0,0,'Gambler']:ln) AddTail(listv,[0,0,0,0,'Mīody Technik']:ln) AddTail(listv,[0,0,0,0,'CADCAM Forum']:ln) AddTail(listv,[0,0,0,0,'Magazyn AMIGA']:ln) AddTail(listv,[0,0,0,0,'Enter']:ln) AddTail(listv,[0,0,0,0,'PCkurier']:ln) AddTail(listv,[0,0,0,0,'Net Forum']:ln) AddTail(listv,[0,0,0,0,'Unix Forum']:ln) AddTail(listv,[0,0,0,0,'Gambler']:ln) AddTail(listv,[0,0,0,0,'Mīody Technik']:ln) AddTail(listv,[0,0,0,0,'CADCAM Forum']:ln) IF (g:=CreateGadgetA(LISTVIEW_KIND,g, [5,wys,200,mojtextattr.ysize*10+4,NIL,NIL,GA_LISTV0,0,visual,0]:newgadget, [GTLV_SCROLLWIDTH,20, GTLV_LABELS,listv,0]))=NIL THEN Raise(ER_GADGET) wys:=mojtextattr.ysize*10+wys+6 tutaj:=wys IF (wnd:=OpenWindowTagList(NIL, [WA_IDCMP,IDCMP_MENUPICK+IDCMP_CLOSEWINDOW+IDCMP_REFRESHWINDOW+SCROLLERIDCMP, WA_WIDTH,400, WA_HEIGHT,wys+36, WA_TITLE,'Make GUIs!', WA_GADGETS,glist, WA_FLAGS,WFLG_GIMMEZEROZERO+WFLG_DRAGBAR+WFLG_DEPTHGADGET+WFLG_CLOSEGADGET, NIL,NIL]))=NIL THEN Raise(ER_WINDOW) IF SetMenuStrip(wnd,menu)=FALSE THEN Raise(ER_MENUS) Gt_RefreshWindow(wnd,NIL) ENDPROC PROC wait4message() DEF mes:PTR TO intuimessage,g:PTR TO gadget REPEAT type:=0 IF mes:=Gt_GetIMsg(wnd.userport) type:=mes.class IF type=IDCMP_MENUPICK infos:=mes.code IF infos=-1 THEN type:=0 ELSEIF (type=IDCMP_GADGETDOWN) OR (type=IDCMP_GADGETUP) g:=mes.iaddress infos:=g.gadgetid ELSEIF type=IDCMP_REFRESHWINDOW Gt_BeginRefresh(wnd) Gt_EndRefresh(wnd,TRUE) type:=0 ELSEIF type<>IDCMP_CLOSEWINDOW type:=0 ENDIF Gt_ReplyIMsg(mes) ELSE Wait(-1) ENDIF UNTIL type ENDPROC PROC wypisz(xoff,yoff,wypisztekst) mojtext.frontpen:=0 mojtext.frontpen:=1 mojtext.drawmode:=AUTODRAWMODE mojtext.leftedge:=0 mojtext.topedge:=0 mojtext.itextfont:=mojtextattr mojtext.itext:=wypisztekst mojtext.nexttext:=0 PrintIText(wnd.rport,mojtext,xoff,yoff) ENDPROC