257 lines
7.0 KiB
Plaintext
257 lines
7.0 KiB
Plaintext
MODULE 'exec/nodes', 'exec/ports',
|
|
'intuition/intuition',
|
|
'gadtools', 'libraries/gadtools'
|
|
|
|
ENUM ER_NONE, ER_NOGT, ER_NOSCRN, ER_NOVISUAL, ER_NOMENUS, ER_NOINITWIN
|
|
|
|
ENUM CM_NONE,
|
|
CM_NEW, CM_QUIT,
|
|
CM_NEXT, CM_PREV, CM_ZOOM, CM_BACK, CM_FRONT, CM_CLOSE
|
|
|
|
OBJECT wininfolist
|
|
head: LONG
|
|
tail: LONG
|
|
tailpred: LONG
|
|
ENDOBJECT
|
|
|
|
OBJECT wininfo
|
|
succ: LONG
|
|
pred: LONG
|
|
winptr: LONG
|
|
ENDOBJECT
|
|
|
|
DEF winlist: PTR TO wininfolist, /* linked list of windows */
|
|
menuptr = NIL: PTR TO menu, /* menus built by GadTools */
|
|
scr = NIL, /* pointer to default screen */
|
|
visual = NIL /* pointer to VisualInfo */
|
|
|
|
/* Display an error using an EasyRequest */
|
|
PROC errmsg(msgptr)
|
|
EasyRequestArgs(0, [20, 0, 'Error', msgptr, 'OK'], 0, 0)
|
|
ENDPROC
|
|
|
|
/* Open a new window */
|
|
PROC openwin()
|
|
DEF wi: PTR TO wininfo, w: PTR TO window,
|
|
success = FALSE
|
|
|
|
/* Get some memory for the node */
|
|
wi := New(SIZEOF wininfo)
|
|
|
|
IF wi
|
|
IF (w := OpenWindowTagList(NIL,
|
|
[WA_LEFT, Rnd(300), WA_TOP, Rnd(100),
|
|
WA_WIDTH, 340, WA_HEIGHT, 156,
|
|
WA_MINWIDTH, 160, WA_MINHEIGHT, 70,
|
|
WA_MAXWIDTH, -1, WA_MAXHEIGHT, -1,
|
|
WA_TITLE, 'A window',
|
|
WA_FLAGS, WFLG_SIMPLE_REFRESH OR WFLG_ACTIVATE OR WFLG_DRAGBAR OR
|
|
WFLG_CLOSEGADGET OR WFLG_DEPTHGADGET OR WFLG_SIZEGADGET,
|
|
WA_IDCMP, IDCMP_CLOSEWINDOW OR IDCMP_MENUPICK,
|
|
WA_SCREENTITLE, 'Multi-Windows Example by David Higginson',
|
|
NIL, NIL])) = NIL
|
|
errmsg('Could not open window.')
|
|
Dispose(wi)
|
|
ELSE
|
|
IF SetMenuStrip(w, menuptr)
|
|
wi.winptr := w
|
|
success := TRUE
|
|
ELSE
|
|
CloseWindow(w)
|
|
Dispose(wi)
|
|
errmsg('Could not attach menus to new window.')
|
|
ENDIF
|
|
ENDIF
|
|
ELSE
|
|
errmsg('Out of memory.')
|
|
ENDIF
|
|
|
|
/* Link it in */
|
|
IF success THEN AddHead(winlist, wi)
|
|
/* N.B. New nodes MUST be added at head of list */
|
|
ENDPROC success
|
|
|
|
PROC cm_new()
|
|
IF openwin() = FALSE THEN errmsg('Could not open window.')
|
|
ENDPROC
|
|
|
|
PROC cm_next(wi: PTR TO wininfo)
|
|
wi := wi.succ
|
|
IF wi.succ = FALSE THEN wi := winlist.head
|
|
IF wi.succ THEN ActivateWindow(wi.winptr)
|
|
ENDPROC
|
|
|
|
PROC cm_prev(wi: PTR TO wininfo)
|
|
wi := wi.pred
|
|
IF wi.pred = FALSE THEN wi := winlist.tailpred
|
|
IF wi.pred THEN ActivateWindow(wi.winptr)
|
|
ENDPROC
|
|
|
|
/* Set up libraries, screens, menus */
|
|
PROC setup()
|
|
/* Open gadtools library */
|
|
IF (gadtoolsbase := OpenLibrary('gadtools.library', 37)) = NIL THEN
|
|
Raise(ER_NOGT)
|
|
|
|
/* Set up exec list to hold window information */
|
|
winlist := [0, 0, 0]
|
|
winlist.head := Mul(winlist + 4,1)
|
|
winlist.tailpred := winlist
|
|
|
|
/* Get default screen and visualinfo info */
|
|
IF (scr := LockPubScreen(NIL)) = NIL THEN Raise(ER_NOSCRN)
|
|
IF (visual := GetVisualInfoA(scr, NIL)) = NIL THEN Raise(ER_NOVISUAL)
|
|
|
|
/* Create menus */
|
|
IF (menuptr := CreateMenusA([NM_TITLE, 0, 'Project', 0, 0, 0, 0,
|
|
NM_ITEM, 0, 'New...', 'N', 0, 0, CM_NEW,
|
|
NM_ITEM, 0, NM_BARLABEL, 0 , 0, 0, 0,
|
|
NM_ITEM, 0, 'Quit', 'Q', 0, 0, CM_QUIT,
|
|
NM_TITLE, 0, 'Window', 0 , 0, 0, 0,
|
|
NM_ITEM, 0, 'Next', ',', 0, 0, CM_NEXT,
|
|
NM_ITEM, 0, 'Previous', '.', 0, 0, CM_PREV,
|
|
NM_ITEM, 0, NM_BARLABEL, 0 , 0, 0, 0,
|
|
NM_ITEM, 0, 'Zoom', 'Z', 0, 0, CM_ZOOM,
|
|
NM_ITEM, 0, NM_BARLABEL, 0 , 0, 0, 0,
|
|
NM_ITEM, 0, 'Bring to front', '>', 0, 0, CM_FRONT,
|
|
NM_ITEM, 0, 'Send to back', '<', 0, 0, CM_BACK,
|
|
NM_ITEM, 0, NM_BARLABEL, 0 , 0, 0, 0,
|
|
NM_ITEM, 0, 'Close', 'K', 0, 0, CM_CLOSE,
|
|
NM_END, 0, 0, 0, 0, 0, 0]:newmenu, NIL)) = NIL THEN Raise(ER_NOMENUS)
|
|
|
|
IF LayoutMenusA(menuptr, visual, NIL) = FALSE THEN Raise(ER_NOMENUS)
|
|
|
|
/* Open initial window */
|
|
IF openwin() = FALSE THEN Raise(ER_NOINITWIN)
|
|
ENDPROC
|
|
|
|
/* Wait for messages */
|
|
PROC eventloop()
|
|
DEF quit = FALSE,
|
|
msg: PTR TO intuimessage, class,
|
|
sig, bitmask, recalc_bitmask = TRUE,
|
|
close_this_win,
|
|
wi: PTR TO wininfo, tempwi: PTR TO wininfo,
|
|
w: PTR TO window, u: PTR TO mp,
|
|
item: PTR TO menuitem, code, id
|
|
|
|
REPEAT
|
|
/* Recalculate mask formed by ORing all sigbits */
|
|
IF recalc_bitmask
|
|
bitmask := 0
|
|
wi := winlist.head
|
|
WHILE wi.succ
|
|
w := wi.winptr
|
|
u := w.userport
|
|
bitmask := bitmask OR Shl(1,u.sigbit)
|
|
wi := wi.succ
|
|
ENDWHILE
|
|
ENDIF
|
|
|
|
/* Wait for something to happen */
|
|
sig := Wait(bitmask)
|
|
|
|
/* Now test all windows' sigbits */
|
|
wi := winlist.head
|
|
WHILE wi.succ
|
|
tempwi := wi.succ
|
|
w := wi.winptr
|
|
u := w.userport
|
|
IF sig AND Shl(1,u.sigbit)
|
|
/* Message(s) received from this window */
|
|
|
|
close_this_win := FALSE
|
|
|
|
WHILE u
|
|
IF msg:=GetMsg(u)
|
|
class := msg.class
|
|
code := MENUNULL
|
|
|
|
SELECT class
|
|
|
|
CASE IDCMP_CLOSEWINDOW
|
|
/* User selected close gadget */
|
|
/* Can't close yet because msgport would disappear */
|
|
close_this_win := TRUE
|
|
|
|
CASE IDCMP_MENUPICK
|
|
code := msg.code
|
|
|
|
ENDSELECT
|
|
|
|
ReplyMsg(msg)
|
|
|
|
/* Process menu events after messaged replied */
|
|
WHILE code <> MENUNULL
|
|
item := ItemAddress(menuptr, code)
|
|
IF item
|
|
id := Long(item + 34)
|
|
SELECT id
|
|
CASE CM_NEW; cm_new()
|
|
CASE CM_QUIT; quit := TRUE
|
|
CASE CM_NEXT; cm_next(wi)
|
|
CASE CM_PREV; cm_prev(wi)
|
|
CASE CM_ZOOM; IF w THEN ZipWindow(w)
|
|
CASE CM_FRONT; IF w THEN WindowToFront(w)
|
|
CASE CM_BACK; IF w THEN WindowToBack(w)
|
|
CASE CM_CLOSE; close_this_win := TRUE
|
|
ENDSELECT
|
|
code := item.nextselect
|
|
ELSE
|
|
code := MENUNULL
|
|
ENDIF
|
|
ENDWHILE
|
|
|
|
IF close_this_win
|
|
recalc_bitmask := TRUE
|
|
|
|
ClearMenuStrip(w)
|
|
CloseWindow(w)
|
|
Remove(wi)
|
|
Dispose(wi)
|
|
|
|
IF winlist.tailpred = winlist THEN quit := TRUE
|
|
u := NIL
|
|
|
|
ENDIF
|
|
ELSE
|
|
u := NIL /* No more messages */
|
|
ENDIF
|
|
ENDWHILE
|
|
ENDIF
|
|
|
|
wi := tempwi
|
|
|
|
ENDWHILE
|
|
|
|
UNTIL quit
|
|
ENDPROC
|
|
|
|
PROC shutdown()
|
|
DEF wi: PTR TO wininfo
|
|
WHILE wi := RemTail(winlist)
|
|
ClearMenuStrip(wi.winptr)
|
|
CloseWindow(wi.winptr)
|
|
Dispose(wi)
|
|
ENDWHILE
|
|
FreeMenus(menuptr)
|
|
FreeVisualInfo(visual)
|
|
UnlockPubScreen(scr, NIL)
|
|
CloseLibrary(gadtoolsbase)
|
|
ENDPROC
|
|
|
|
PROC main() HANDLE
|
|
DEF erlist:PTR TO LONG
|
|
setup()
|
|
eventloop()
|
|
Raise(ER_NONE)
|
|
EXCEPT
|
|
shutdown()
|
|
erlist := ['This program requires gadtools library.',
|
|
'Could not find default public screen.',
|
|
'Could not get visual info for screen.',
|
|
'Could not create menus.',
|
|
'Could not create initial window.']
|
|
IF exception>0 THEN errmsg(erlist[exception - 1])
|
|
ENDPROC
|