home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / E / TFF-A32R.LZX / AmigaE3.2a / RkrmSrc / GadTools / simplegtgadget.e < prev   
Encoding:
Text File  |  1996-08-29  |  3.7 KB  |  104 lines
  1. -> simplegtgadget.e - Simple example of a GadTools gadget.
  2.  
  3. OPT OSVERSION=37
  4.  
  5. MODULE 'gadtools',
  6.        'exec/ports',
  7.        'graphics/text',
  8.        'intuition/intuition',
  9.        'intuition/screens',
  10.        'libraries/gadtools'
  11.  
  12. ENUM ERR_NONE, ERR_GAD, ERR_LIB, ERR_PUB, ERR_VIS, ERR_WIN
  13.  
  14. RAISE ERR_GAD IF CreateGadgetA()=NIL,
  15.       ERR_LIB IF OpenLibrary()=NIL,
  16.       ERR_PUB IF LockPubScreen()=NIL,
  17.       ERR_VIS IF GetVisualInfoA()=NIL,
  18.       ERR_WIN IF OpenWindowTagList()=NIL
  19.  
  20. CONST MYGAD_BUTTON=4
  21.  
  22. -> Open all libraries and run.  Clean up when finished or on error..
  23. PROC main() HANDLE
  24.   gadtoolsbase:=OpenLibrary('gadtools.library', 37)
  25.   gadtoolsWindow()
  26. EXCEPT DO
  27.   IF gadtoolsbase THEN CloseLibrary(gadtoolsbase)
  28.   SELECT exception
  29.   CASE ERR_GAD; WriteF('Error: Could not create gadget\n')
  30.   CASE ERR_LIB; WriteF('Error: Could not open gadtools.library\n')
  31.   CASE ERR_PUB; WriteF('Error: Could not lock public screen\n')
  32.   CASE ERR_VIS; WriteF('Error: Could not get visual info\n')
  33.   CASE ERR_WIN; WriteF('Error: Could not open window\n')
  34.   ENDSELECT
  35. ENDPROC
  36.  
  37. -> Prepare for using GadTools, set up gadgets and open window.
  38. -> Clean up and when done or on error.
  39. PROC gadtoolsWindow() HANDLE
  40.   DEF mysc=NIL:PTR TO screen, mywin=NIL, glist=NIL, gad, vi=NIL
  41.   mysc:=LockPubScreen(NIL)
  42.   vi:=GetVisualInfoA(mysc, [NIL])
  43.   -> GadTools gadgets require this step to be taken
  44.   gad:=CreateContext({glist})
  45.  
  46.   -> Create a button gadget centered below the window title
  47.   gad:=CreateGadgetA(BUTTON_KIND, gad,
  48.                     [150, (20+mysc.wbortop+mysc.font.ysize+1),
  49.                      100, 12,
  50.                      'Click Here', ['topaz.font', 8, 0, 0]:textattr,
  51.                      MYGAD_BUTTON, 0,
  52.                      vi, NIL]:newgadget,
  53.                     [NIL])
  54.   mywin:=OpenWindowTagList(NIL,
  55.                           [WA_TITLE,     'GadTools Gadget Demo',
  56.                            WA_GADGETS,   glist, WA_AUTOADJUST,    TRUE,
  57.                            WA_WIDTH,     400,   WA_INNERHEIGHT,    100,
  58.                            WA_DRAGBAR,   TRUE,  WA_DEPTHGADGET,   TRUE,
  59.                            WA_ACTIVATE,  TRUE,  WA_CLOSEGADGET,   TRUE,
  60.                            WA_IDCMP, IDCMP_CLOSEWINDOW OR
  61.                                      IDCMP_REFRESHWINDOW OR BUTTONIDCMP,
  62.                            WA_PUBSCREEN, mysc,
  63.                            NIL])
  64.   Gt_RefreshWindow(mywin, NIL)
  65.   process_window_events(mywin)
  66. EXCEPT DO
  67.   IF mywin THEN CloseWindow(mywin)
  68.   -> FreeGadgets() must be called after the context has been created.
  69.   -> It does nothing if glist is NIL
  70.   FreeGadgets(glist)
  71.   IF vi THEN FreeVisualInfo(vi)
  72.   IF mysc THEN UnlockPubScreen(NIL, mysc)
  73.   ReThrow()  -> E-Note: pass on exception if it is an error
  74. ENDPROC
  75.  
  76. -> Standard message handling loop with GadTools message handling functions
  77. -> used (Gt_GetIMsg() and Gt_ReplyIMsg()).
  78. PROC process_window_events(mywin:PTR TO window)
  79.   DEF imsg:PTR TO intuimessage, gad:PTR TO gadget, terminated=FALSE, class
  80.   REPEAT
  81.     Wait(Shl(1, mywin.userport.sigbit))
  82.  
  83.     -> Use Gt_GetIMsg() and Gt_ReplyIMsg() for handling IntuiMessages
  84.     -> with GadTools gadgets.
  85.     WHILE (terminated=FALSE) AND (imsg:=Gt_GetIMsg(mywin.userport))
  86.       -> Gt_ReplyIMsg() at end of loop
  87.       class:=imsg.class
  88.       SELECT class
  89.       CASE IDCMP_GADGETUP  -> Buttons only report GADGETUP
  90.         gad:=imsg.iaddress
  91.         IF gad.gadgetid=MYGAD_BUTTON THEN WriteF('Button was pressed\n')
  92.       CASE IDCMP_CLOSEWINDOW
  93.         terminated:=TRUE
  94.       CASE IDCMP_REFRESHWINDOW
  95.         -> This handling is REQUIRED with GadTools.
  96.         Gt_BeginRefresh(mywin)
  97.         Gt_EndRefresh(mywin, TRUE)
  98.       ENDSELECT
  99.       -> Use the toolkit message-replying function here...
  100.       Gt_ReplyIMsg(imsg)
  101.     ENDWHILE
  102.   UNTIL terminated
  103. ENDPROC
  104.