home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / E / TFF-A32R.LZX / AmigaE3.2a / Src / Tools / qItemAddress / test.e < prev   
Encoding:
Text File  |  1994-12-08  |  5.0 KB  |  169 lines
  1. /*----------------------------------------------------------*
  2.   Demo of qualifiedItemAddress module.
  3.  
  4.   E Source generated by SRCGEN v0.1
  5.  
  6.   CHANGES TO ORIGINAL GEN'ED CODE:
  7.     - inclusion of module 'other/qualifiedItemAddress'
  8.     - localization of some global variables to the functions
  9.       wait4message() and main()
  10.     - restructured wait4message() to return multiple values
  11.       when a IDCMP_MENUPICK message is received
  12.     - restructured main() to process (correctly) multiply
  13.       selected menu items in a single event
  14.     - minor changes to the CreateMenusA() arguments
  15.  
  16.   Source modified by B. Wills, Dec 12, 1994.
  17.   Placed in public domain.
  18.  *----------------------------------------------------------*/
  19.  
  20. OPT OSVERSION=37
  21. OPT REG=5
  22.  
  23. MODULE 'gadtools',
  24.        'libraries/gadtools',
  25.        'intuition/intuition',
  26.        'intuition/screens',
  27.        'intuition/gadgetclass',
  28.        'graphics/text'
  29.  
  30. MODULE 'other/qualifiedItemAddress'
  31.  
  32. ENUM NONE,NOCONTEXT,NOGADGET,NOWB,NOVISUAL,OPENGT,NOWINDOW,NOMENUS
  33.  
  34. DEF     project0wnd:PTR TO window,
  35.         project0menus,
  36.         project0glist,
  37.         scr:PTR TO screen,
  38.         visual=NIL,
  39.         offx,offy,tattr
  40.  
  41. PROC setupscreen()
  42.   IF (gadtoolsbase:=OpenLibrary('gadtools.library',37))=NIL THEN RETURN OPENGT
  43.   IF (scr:=LockPubScreen('Workbench'))=NIL THEN RETURN NOWB
  44.   IF (visual:=GetVisualInfoA(scr,NIL))=NIL THEN RETURN NOVISUAL
  45.   offy:=scr.wbortop+Int(scr.rastport+58)-10
  46.   tattr:=['topaz.font',8,0,0]:textattr
  47. ENDPROC
  48.  
  49. PROC closedownscreen()
  50.   IF visual THEN FreeVisualInfo(visual)
  51.   IF scr THEN UnlockPubScreen(NIL,scr)
  52.   IF gadtoolsbase THEN CloseLibrary(gadtoolsbase)
  53. ENDPROC
  54.  
  55. PROC openproject0window()
  56.   DEF g:PTR TO gadget
  57.   IF (g:=CreateContext({project0glist}))=NIL THEN RETURN NOCONTEXT
  58.   IF (project0menus:=
  59.     CreateMenusA([1,0,'M1',0,$0,0,0,
  60.     2,0,'I1',   'a',$0,0,0,
  61.     2,0,'I2',   'A',$0,0,0,
  62.     2,0,'I3',   NIL,$0,0,0,
  63.     3,0,'I3.1', 'b',$0,0,0,
  64.     3,0,'I3.2', 'B',$0,0,0,
  65.     2,0,'I4',   NIL,$0,0,0,
  66.     3,0,'I4.1', 'C',$0,0,0,
  67.     3,0,'I4.2', 'c',$0,0,0,
  68.     1,0,'M2',   NIL,$0,0,0,
  69.     2,0,'I1',   'd',$0,0,0,
  70.     2,0,'I2',   'E',$0,0,0,
  71.     2,0,'I3',   NIL,$0,0,0,
  72.     3,0,'I3.1', 'D',$0,0,0,
  73.     3,0,'I3.2', 'e',$0,0,0,
  74.     2,0,'I4',   'f',$0,0,0,
  75.     2,0,'I5',   'G',$0,0,0,
  76.     0,0,0,0,0,0,0]:newmenu,NIL))=NIL THEN RETURN NOMENUS
  77.   IF LayoutMenusA(project0menus,visual,NIL)=FALSE THEN RETURN NOMENUS
  78.   IF (project0wnd:=OpenWindowTagList(NIL,
  79.     [WA_LEFT,10,
  80.      WA_TOP,15,
  81.      WA_WIDTH,offx+400,
  82.      WA_HEIGHT,offy+89,
  83.      WA_IDCMP,$24C077E,
  84.      WA_FLAGS,$100F,
  85.      WA_TITLE,'Try Hotkeys AND Mouse',
  86.      WA_CUSTOMSCREEN,scr,
  87.      WA_MINWIDTH,67,
  88.      WA_MINHEIGHT,21,
  89.      WA_MAXWIDTH,$2C0,
  90.      WA_MAXHEIGHT,$226,
  91.      WA_AUTOADJUST,1,
  92.      WA_AUTOADJUST,1,
  93.      NIL]))=NIL THEN RETURN NOWINDOW
  94.   IF SetMenuStrip(project0wnd,project0menus)=FALSE THEN RETURN NOMENUS
  95.   Gt_RefreshWindow(project0wnd,NIL)
  96.   SetStdRast(project0wnd.rport)
  97.   Colour(1)
  98. ENDPROC
  99.  
  100. PROC closeproject0window()
  101.   IF project0wnd THEN ClearMenuStrip(project0wnd)
  102.   IF project0menus THEN FreeMenus(project0menus)
  103.   IF project0wnd THEN CloseWindow(project0wnd)
  104.   IF project0glist THEN FreeGadgets(project0glist)
  105. ENDPROC
  106.  
  107. PROC reporterr(er)
  108.   DEF erlist:PTR TO LONG
  109.   IF er
  110.     erlist:=['get context','create gadget','lock wb','get visual infos',
  111.       'open "gadtools.library" v37+','open window','create menus']
  112.     EasyRequestArgs(0,[20,0,0,'Could not \s!','ok'],0,[erlist[er-1]])
  113.   ENDIF
  114. ENDPROC er
  115.  
  116. PROC wait4message(win:PTR TO window)
  117.   DEF mes:PTR TO intuimessage, class, code, qualifier
  118.   REPEAT
  119.     class:=0
  120.     IF mes:=Gt_GetIMsg(win.userport)
  121.       class:=mes.class
  122.       IF class=IDCMP_MENUPICK
  123.         code:=mes.code
  124.         qualifier:=mes.qualifier
  125.       ELSEIF (class=IDCMP_GADGETDOWN) OR (class=IDCMP_GADGETUP)
  126.         code:=mes.iaddress
  127.       ELSEIF class=IDCMP_REFRESHWINDOW
  128.         Gt_BeginRefresh(win)
  129.         Gt_EndRefresh(win,TRUE)
  130.         class:=0
  131.       ELSEIF class<>IDCMP_CLOSEWINDOW  /* remove these if you like */
  132.         class:=0
  133.       ENDIF
  134.       Gt_ReplyIMsg(mes)
  135.     ELSE
  136.       WaitPort(win.userport)
  137.     ENDIF
  138.   UNTIL class
  139. ENDPROC class,code,qualifier
  140.  
  141. PROC main()
  142.   DEF done=FALSE, class, code, qualifier, iaddress=NIL:PTR TO menuitem
  143.   IF reporterr(setupscreen())=0
  144.     reporterr(openproject0window())
  145.     REPEAT
  146.       class,code,qualifier:=wait4message(project0wnd)
  147.       SELECT class
  148.         CASE IDCMP_CLOSEWINDOW
  149.           done:=TRUE
  150.         CASE IDCMP_MENUPICK
  151.           WHILE code<>-1 ->MENUNULL doesn't work since
  152.                          -> terminal nextselect is -1 in E, vice 65535 in C.
  153.             IF iaddress:=qualifiedItemAddress(project0menus, code, qualifier)
  154.               TextF(4, 30, 'MenuId=\d Char=\c Qual=$\h       ',
  155.                     code, iaddress.command, qualifier)
  156.               code:=iaddress.nextselect
  157.               Delay(50) ->allow time to read the menu info
  158.             ELSE
  159.               code:=-1
  160.             ENDIF
  161.             IF CtrlC() THEN code:=-1
  162.           ENDWHILE
  163.       ENDSELECT
  164.     UNTIL done
  165.     closeproject0window()
  166.   ENDIF
  167.   closedownscreen()
  168. ENDPROC
  169.