home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / E / TFF-A32R.LZX / AmigaE3.2a / PdSrc / mweg.e < prev    next >
Encoding:
Text File  |  1996-08-29  |  7.0 KB  |  257 lines
  1. MODULE 'exec/nodes', 'exec/ports',
  2.        'intuition/intuition',
  3.        'gadtools', 'libraries/gadtools'
  4.  
  5. ENUM ER_NONE, ER_NOGT, ER_NOSCRN, ER_NOVISUAL, ER_NOMENUS, ER_NOINITWIN
  6.  
  7. ENUM CM_NONE,
  8.      CM_NEW, CM_QUIT,
  9.      CM_NEXT, CM_PREV, CM_ZOOM, CM_BACK, CM_FRONT, CM_CLOSE
  10.  
  11. OBJECT wininfolist
  12.   head:     LONG
  13.   tail:     LONG
  14.   tailpred: LONG
  15. ENDOBJECT
  16.  
  17. OBJECT wininfo
  18.   succ:     LONG
  19.   pred:     LONG
  20.   winptr:   LONG
  21. ENDOBJECT
  22.  
  23. DEF winlist: PTR TO wininfolist, /* linked list of windows    */
  24.     menuptr = NIL: PTR TO menu,  /* menus built by GadTools   */
  25.     scr = NIL,                   /* pointer to default screen */
  26.     visual = NIL                 /* pointer to VisualInfo     */
  27.  
  28. /* Display an error using an EasyRequest */
  29. PROC errmsg(msgptr)
  30.   EasyRequestArgs(0, [20, 0, 'Error', msgptr, 'OK'], 0, 0)
  31. ENDPROC
  32.  
  33. /* Open a new window */
  34. PROC openwin()
  35.   DEF wi: PTR TO wininfo, w: PTR TO window,
  36.       success = FALSE
  37.  
  38.   /* Get some memory for the node */
  39.   wi := New(SIZEOF wininfo)
  40.  
  41.   IF wi
  42.     IF (w := OpenWindowTagList(NIL,
  43.       [WA_LEFT, Rnd(300), WA_TOP, Rnd(100),
  44.        WA_WIDTH,    340, WA_HEIGHT,    156,
  45.        WA_MINWIDTH, 160, WA_MINHEIGHT,  70,
  46.        WA_MAXWIDTH,  -1, WA_MAXHEIGHT,  -1,
  47.        WA_TITLE, 'A window',
  48.        WA_FLAGS, WFLG_SIMPLE_REFRESH OR WFLG_ACTIVATE OR WFLG_DRAGBAR OR
  49.                  WFLG_CLOSEGADGET OR WFLG_DEPTHGADGET OR WFLG_SIZEGADGET,
  50.        WA_IDCMP, IDCMP_CLOSEWINDOW OR IDCMP_MENUPICK,
  51.        WA_SCREENTITLE, 'Multi-Windows Example by David Higginson',
  52.        NIL, NIL])) = NIL 
  53.       errmsg('Could not open window.')
  54.       Dispose(wi)
  55.     ELSE
  56.       IF SetMenuStrip(w, menuptr)
  57.         wi.winptr := w
  58.         success := TRUE
  59.       ELSE
  60.         CloseWindow(w)
  61.         Dispose(wi)
  62.         errmsg('Could not attach menus to new window.')
  63.       ENDIF
  64.     ENDIF
  65.   ELSE
  66.     errmsg('Out of memory.')
  67.   ENDIF
  68.  
  69.   /* Link it in */
  70.   IF success THEN AddHead(winlist, wi)
  71.   /* N.B. New nodes MUST be added at head of list */
  72. ENDPROC success
  73.  
  74. PROC cm_new()
  75.   IF openwin() = FALSE THEN errmsg('Could not open window.')
  76. ENDPROC
  77.  
  78. PROC cm_next(wi: PTR TO wininfo)
  79.   wi := wi.succ
  80.   IF wi.succ = FALSE THEN wi := winlist.head
  81.   IF wi.succ THEN ActivateWindow(wi.winptr)
  82. ENDPROC
  83.  
  84. PROC cm_prev(wi: PTR TO wininfo)
  85.   wi := wi.pred
  86.   IF wi.pred = FALSE THEN wi := winlist.tailpred
  87.   IF wi.pred THEN ActivateWindow(wi.winptr)
  88. ENDPROC
  89.  
  90. /* Set up libraries, screens, menus */
  91. PROC setup()
  92.   /* Open gadtools library */
  93.   IF (gadtoolsbase := OpenLibrary('gadtools.library', 37)) = NIL THEN
  94.     Raise(ER_NOGT)
  95.  
  96.   /* Set up exec list to hold window information */
  97.   winlist := [0, 0, 0]
  98.   winlist.head := Mul(winlist + 4,1)
  99.   winlist.tailpred := winlist
  100.  
  101.   /* Get default screen and visualinfo info */
  102.   IF (scr := LockPubScreen(NIL)) = NIL THEN Raise(ER_NOSCRN)
  103.   IF (visual := GetVisualInfoA(scr, NIL)) = NIL THEN Raise(ER_NOVISUAL)
  104.  
  105.   /* Create menus */
  106.   IF (menuptr := CreateMenusA([NM_TITLE, 0, 'Project', 0, 0, 0, 0,
  107.     NM_ITEM, 0, 'New...',           'N', 0, 0, CM_NEW,
  108.     NM_ITEM, 0, NM_BARLABEL,         0 , 0, 0, 0,
  109.     NM_ITEM, 0, 'Quit',             'Q', 0, 0, CM_QUIT,
  110.     NM_TITLE, 0, 'Window',           0 , 0, 0, 0,
  111.     NM_ITEM, 0, 'Next',             ',', 0, 0, CM_NEXT,
  112.     NM_ITEM, 0, 'Previous',         '.', 0, 0, CM_PREV,
  113.     NM_ITEM, 0, NM_BARLABEL,         0 , 0, 0, 0,
  114.     NM_ITEM, 0, 'Zoom',             'Z', 0, 0, CM_ZOOM,
  115.     NM_ITEM, 0, NM_BARLABEL,         0 , 0, 0, 0,
  116.     NM_ITEM, 0, 'Bring to front',   '>', 0, 0, CM_FRONT,
  117.     NM_ITEM, 0, 'Send to back',     '<', 0, 0, CM_BACK,
  118.     NM_ITEM, 0, NM_BARLABEL,         0 , 0, 0, 0,
  119.     NM_ITEM, 0, 'Close',            'K', 0, 0, CM_CLOSE,
  120.     NM_END, 0, 0, 0, 0, 0, 0]:newmenu, NIL)) = NIL THEN Raise(ER_NOMENUS)
  121.  
  122.   IF LayoutMenusA(menuptr, visual, NIL) = FALSE THEN Raise(ER_NOMENUS)
  123.  
  124.   /* Open initial window */
  125.   IF openwin() = FALSE THEN Raise(ER_NOINITWIN)
  126. ENDPROC
  127.  
  128. /* Wait for messages */
  129. PROC eventloop()
  130.   DEF quit = FALSE,
  131.       msg: PTR TO intuimessage, class,
  132.       sig, bitmask, recalc_bitmask = TRUE,
  133.       close_this_win,
  134.       wi: PTR TO wininfo, tempwi: PTR TO wininfo,
  135.       w: PTR TO window, u: PTR TO mp,
  136.       item: PTR TO menuitem, code, id
  137.  
  138.   REPEAT
  139.     /* Recalculate mask formed by ORing all sigbits */
  140.     IF recalc_bitmask
  141.       bitmask := 0
  142.       wi := winlist.head
  143.       WHILE wi.succ
  144.         w := wi.winptr
  145.         u := w.userport
  146.         bitmask := bitmask OR Shl(1,u.sigbit)
  147.         wi := wi.succ
  148.       ENDWHILE
  149.     ENDIF
  150.  
  151.     /* Wait for something to happen */
  152.     sig := Wait(bitmask)
  153.  
  154.     /* Now test all windows' sigbits */
  155.     wi := winlist.head
  156.     WHILE wi.succ
  157.       tempwi := wi.succ
  158.       w := wi.winptr
  159.       u := w.userport
  160.       IF sig AND Shl(1,u.sigbit)
  161.         /* Message(s) received from this window */
  162.  
  163.         close_this_win := FALSE
  164.  
  165.         WHILE u
  166.           IF msg:=GetMsg(u)
  167.             class := msg.class
  168.             code := MENUNULL
  169.  
  170.             SELECT class
  171.  
  172.               CASE IDCMP_CLOSEWINDOW
  173.                 /* User selected close gadget */
  174.                 /* Can't close yet because msgport would disappear */
  175.                 close_this_win := TRUE
  176.  
  177.               CASE IDCMP_MENUPICK
  178.                 code := msg.code
  179.  
  180.             ENDSELECT
  181.  
  182.             ReplyMsg(msg)
  183.  
  184.             /* Process menu events after messaged replied */
  185.             WHILE code <> MENUNULL
  186.               item := ItemAddress(menuptr, code)
  187.               IF item
  188.                 id := Long(item + 34)
  189.                 SELECT id
  190.                   CASE CM_NEW;    cm_new()
  191.                   CASE CM_QUIT;   quit := TRUE
  192.                   CASE CM_NEXT;   cm_next(wi)
  193.                   CASE CM_PREV;   cm_prev(wi)
  194.                   CASE CM_ZOOM;   IF w THEN ZipWindow(w)
  195.                   CASE CM_FRONT;  IF w THEN WindowToFront(w)
  196.                   CASE CM_BACK;   IF w THEN WindowToBack(w)
  197.                   CASE CM_CLOSE;  close_this_win := TRUE
  198.                 ENDSELECT
  199.                 code := item.nextselect
  200.               ELSE
  201.                 code := MENUNULL
  202.               ENDIF
  203.             ENDWHILE
  204.  
  205.             IF close_this_win
  206.               recalc_bitmask := TRUE
  207.  
  208.               ClearMenuStrip(w)
  209.               CloseWindow(w)
  210.               Remove(wi)
  211.               Dispose(wi)
  212.             
  213.               IF winlist.tailpred = winlist THEN quit := TRUE
  214.               u := NIL
  215.  
  216.             ENDIF
  217.           ELSE
  218.             u := NIL /* No more messages */
  219.           ENDIF        
  220.         ENDWHILE
  221.       ENDIF
  222.       
  223.       wi := tempwi
  224.  
  225.     ENDWHILE
  226.  
  227.   UNTIL quit
  228. ENDPROC
  229.  
  230. PROC shutdown()
  231.   DEF wi: PTR TO wininfo
  232.   WHILE wi := RemTail(winlist)
  233.     ClearMenuStrip(wi.winptr)
  234.     CloseWindow(wi.winptr)
  235.     Dispose(wi)
  236.   ENDWHILE
  237.   FreeMenus(menuptr)
  238.   FreeVisualInfo(visual)
  239.   UnlockPubScreen(scr, NIL)
  240.   CloseLibrary(gadtoolsbase)
  241. ENDPROC
  242.   
  243. PROC main() HANDLE
  244.   DEF erlist:PTR TO LONG
  245.   setup()
  246.   eventloop()
  247.   Raise(ER_NONE)
  248. EXCEPT
  249.   shutdown()
  250.   erlist := ['This program requires gadtools library.',
  251.              'Could not find default public screen.',
  252.              'Could not get visual info for screen.',
  253.              'Could not create menus.',
  254.              'Could not create initial window.']
  255.   IF exception>0 THEN errmsg(erlist[exception - 1])
  256. ENDPROC
  257.