TweetFollow Us on Twitter

Tear-Off
Volume Number:3
Issue Number:12
Column Tag:Pascal Procedures

Tear-Off Menus Explained

By Darryl Lovato, TML Systems, MacTutor Contributing Editor

Hello once again, this month I would like to show how to implement tear-off menus. What is a tear-off menu? It is a menu which can be removed from the menu bar and used as a window. I first saw a tear off menu in a pre-release version of Hypercard by Bill Atkinson. Since I have had a lot of experience creating and using Menu and Window Definition routines, I thought I would try to duplicate his implementation of tear-offs so that MacTutor readers can see how it is done and use them in their own programs.

I assume that you know how menu and window definition routines work. If you are not familiar with them read my articles in the July, August, and October 1986 issues of MacTutor.

The Window Definition routine used in the example is fairly straight forward, and, in fact, really isn’t needed. It’s sole purpose is to NOT look like a regular window. To do this I made the window’s title bar small and solid black. The pattern drawing is not a part of the definition routine. It is handled in a update event as any other window’s contents. The window looks like the one in figure 1.

Figure 1

The Menu Definition routine used in the example is where the special tear-menu code is. The tear-off menu in figure 2 looks very similar to the tear-off window. The size and draw messages are just as you would expect. The choose message, however, has some special coding to implement the tear-off. When we get the choose message, and the mouse is outside of the menu rectangle we check to see how far outside it is. If it is more than 10 pixels outide of the menu rectange, then we do not return from the choose message routine. Instead, we drag a outline of the menu on the desktop region until the mouse comes up, the user moves the mouse over another menu, or the mouse is moved back onto the original menu. If the mouse comes up while we are tracking it, we send a message back to the program telling it to move and re-display the torn window at that point. We communicate this information by posting an event which is unused by the application. I picked event #12, but you could choose any of the application event numbers. We pass the top left coordinate of where to display the pallete window in the Event.message paramter.

When the main event loop gets event 12, it must move the menu to the location passed in the message and display the window.

Figure #2

There are a couple of things that need to be pointed out. First, drawing all the patterns is real slow (even on a MacII!!!). This could be improved a great deal by keeping a offscreen bitmap of the patterns and use copybits instead of drawing them. Second. I know I have done a big no-no by not making the menu and window defs code resources. Third, you should be able to edit the patterns by double clicking on them to bring up a pattern editor window. Fourth, it would be great if the patterns could be in color on a Mac II. I leave the above enhancements to you as an exersize.

The program I used to create the tear-off windows is given below. It was written is TML Pascal, but the techniques shown should be usefull no matter what language your using. Have fun!

Pascal Code Optimizations

I would like to share some secrets with MacTutor readers out there who strive for the fastest, smallest Pascal code. My tricks will not improve your code 500%, as re-designing a algorithm could, but they can help you get the most out of the code generated by your compiler. These tricks are for TML Pascal, but should help you generate better code in any Pascal.

1. Always use Inc(x) and Dec(x) procedures instead of x := x + 1 or x := x - 1. The inc and dec procedures generate one assembler instruction as opposed to 3 for x := x + 1. This saves 6 bytes each time you use it. When inc and dec are used in loops, this can save a lot of execution time. [Unfortuanately, these are not available in other implementations. -Ed]

2. If you pass a structure larger than 4 bytes to a procedure or function, pass it as a static paramter. When you use a static, instead of regular parameters, you save 18 bytes per paramter in code size. This saves a lot of execution time, too. The reason for this is that when you pass a large structure as a static parameter, it is not copied local to the procedure. This is especially usefull if you pass a lot of strings to procedures and functions.

3. In certain if..then..else statements, you can save code by restructuring the statement to eliminate the else, and 4 bytes!

4. For loops are code hogs! Because Pascal compilers check the bounds of ‘for’ loops before entering them, they generate a lot of error checking. By recoding a ‘for’ loop as a repeat loop you can save 16 bytes. Here is an example:

Instead of this:

 for x := 1 to 100 do
   begin
   end;

Do this:

 x := 1;
 repeat
   inc(x);
 until x = 100;

There are a lot of other optimizations that can be done to make faster, smaller Pascal code, but these are the ones that can be used the most. Of course, re-writting the code in assembler would make the biggest diffrence in code size and speed, but that can take a long time and there are a lot of people who do not understand 680x0 assembler.

[The following code has been sanitized to work in both TML Pascal and LS Pascal and has been tested in both. However, one of the functions that returns a rect as an argument tripped up the Turbo Pascal syntax checker, so some modification may be necessary to get the program compiled in Turbo. We are at a loss as to why Turbo should be more picky than LS Pascal, which I thought was the most fussy of all! The code should also work fine in MPW, but we didn’t take the time to actually try it. -Ed]

We welcome Darryl back to MacTutor and present him with our Program of the Month award for this important and timely example of tear-off menus. One reader wanted it so bad, he made me send an advance copy of the article next day air so his department could get to work on it. Thanks Darryl!

{1}
Listing 1 TML & LS Pascal Source Code
PROGRAM TearMenu;

{ Example of tear-off menus}
{ by Darryl Lovato of TML for MacTutor}
{ Inspired by HyperCard}
{ TML Pascal / LS Pascal Version }
{ Some modifications may be required for Turbo Pascal }
{ Turbo Pascal does not seem to like a rect as }
{ a return variable from a function. }

uses MacIntf;    { remove for LS Pascal }

{$T APPL TEAR}   { remove for LS Pascal }
{$B+}   { remove for LS Pascal }
{$L TearMenuRes} { remove for LS Pascal }

{global constants}
CONST
 AppleMenuID = 1;
 FileMenuID = 2;
 EditMenuID = 3;
 graphicalMenu = 4;
 WindResID = 1;
 AboutID = 3000;

{global variables}
VAR
 myMenus : ARRAY[AppleMenuID..EditMenuID] OF MenuHandle;
 Done : Boolean;
 RegWDEFWindow : WindowPtr;
 GrowArea : rect;
 DragArea : rect;
 myWindowPeek : WindowPeek;
 MyGraphicsMenu : menuhandle;
 currentPatWind : WindowPtr;

{ My Window Definition Function }

 FUNCTION MyWindowDef (varCode : Integer;
 theWindow : WindowPtr;
 message : Integer;
 param : LongInt) : LongInt;
 TYPE
 RectPtr = ^Rect;

 VAR
 aRectPtr : RectPtr;
 myWindowPeek : WindowPeek;

{ Nested procedures follow }
 PROCEDURE DoDrawMessage (WindToDraw : WindowPtr;
 DrawParam : LongInt);
 VAR
 TitleBarRect : Rect;
 CurrentY : Integer;
 index : Integer;
 GoAwayBox : Rect;
 Show : boolean;
 WindowRec : WindowPeek;
 BEGIN
 WindowRec := WindowPeek(WindToDraw);
 Show := WindowRec^.visible;
 IF Show THEN
 BEGIN
 TitleBarRect := WindowRec^.strucRgn^^.rgnBBox;
 IF DrawParam <> 0 THEN {just toggle goAway box}
 BEGIN
 WITH TitleBarRect DO
 BEGIN
 top := top + 3;
 left := left + 5;
 bottom := top + 8;
 right := left + 8;
 END;
 InsetRect(TitleBarRect, 1, 1);
 InvertRect(TitleBarRect);
 END
 ELSE {we need to draw the window frame}
 BEGIN
 PenNormal;
 FrameRect(TitleBarRect);
 TitleBarRect.bottom := TitleBarRect.top + 13;

 FrameRect(TitleBarRect);
 InsetRect(TitleBarRect, 1, 1); {shrink by 1}
 EraseRect(TitleBarRect);

 IF WindowRec^.hilited THEN
 BEGIN { add hiliting }
 FillRect(TitleBarRect, black);
 WITH TitleBarRect DO
 BEGIN
 top := top + 2;
 left := left + 4;
 bottom := top + 8;
 right := left + 8;
 END;
 PenMode(patXor);
 FrameRect(TitleBarRect);
 PenNormal;
 END;
 END;
 END;
 END;

 FUNCTION DoHitMessage (WindToTest : WindowPtr;
 theParam : LongInt) : LongInt;
 VAR
 globalPt : Point;
 aRect : Rect;
 GoAwayBox : Rect;
 tempRect : Rect;
 WindowRec : WindowPeek;
 BEGIN
 globalPt.h := LoWord(theParam);
 globalPt.v := HiWord(theParam);
 WindowRec := WindowPeek(WindToTest);
 aRect := WindowRec^.strucRgn^^.rgnBBox;
 aRect.bottom := aRect.top + 12; {create tBar Rect}
 tempRect := WindowRec^.strucRgn^^.rgnBBox;
 IF PtInRect(globalPt, tempRect) THEN {in structure rgn?}
 BEGIN
 tempRect := WindowRec^.contRgn^^.rgnBBox;
 IF PtInRect(globalPt,tempRect) THEN {if content rgn}
 DoHitMessage := wInContent
 ELSE IF PtInRect(globalPt, aRect) THEN {drag}
 BEGIN
 IF WindowRec^.hilited THEN
 BEGIN {we need to check go-away box}
 WITH aRect DO
 BEGIN
 top := top + 2;
 left := left + 4;
 bottom := top + 8;
 right := left + 8;
 END;
 IF PtInRect(globalPt, aRect) THEN
 DoHitMessage := wInGoAway
 ELSE
 DoHitMessage := wInDrag;
 END
 ELSE
 DoHitMessage := wInDrag;
 END
 ELSE {it was in our window frame}
 DoHitMessage := wNoHit;
 END
 ELSE {it wasn’t in our window at all}
 DoHitMessage := wNoHit;
END;

PROCEDURE DoCalcRgnsMessage (WindToCalc : WindowPtr);
 VAR
 tempRect : Rect;
 aWindowPeek : WindowPeek;
 aRgn : RgnHandle;
 WindowRec : WindowPeek;
BEGIN
 tempRect := WindToCalc^.PortRect;
 OffsetRect(tempRect, -WindToCalc^.PortBits.Bounds.Left, -WindToCalc^.PortBits.Bounds.Top);

 TempRect.top := TempRect.top - 1;
 WindowRec := WindowPeek(WindToCalc);
 RectRgn(WindowRec^.contRgn, tempRect);

 InsetRect(tempRect, -1, -1);
 tempRect.top := tempRect.top - 12;
 RectRgn(WindowRec^.strucRgn, tempRect);
END;

{ End of nested procedures }
BEGIN
 MyWindowDef := 0;
 CASE message OF
 wDraw : 
 DoDrawMessage(theWindow, param);
 wHit : 
 MyWindowDef := DoHitMessage(theWindow, param);
 wCalcRgns : 
 DoCalcRgnsMessage(theWindow);
 wNew : 
 ;
 wDispose : 
 ;
 wGrow : 
 ;
 END; {of case}
END;

{ -------------------------------------------- }
{function GetItemRect(item : integer) : rect; }

FUNCTION GetItemRect (item : integer) : rect;
VAR
 tempRect : Rect;
BEGIN
 WITH tempRect DO
 BEGIN
 top := (((item - 1) DIV 8) * 16) - 1;
 bottom := top + 17;
 left := (((item - 1) MOD 8) * 16) - 1;
 right := left + 17;
 END;
 GetItemRect := tempRect;
END;

{procedure DrawPatWindow;   }

PROCEDURE DrawPatWindow;
 VAR
 i : integer;
 currentPat : Pattern;
 currRect : Rect;
BEGIN
 FOR i := 1 TO 96 DO
 BEGIN
 currRect := GetItemRect(i);
 FrameRect(currRect);
 GetIndPattern(currentPat, 100, i);
 FillRect(currRect, currentPat);
 FrameRect(currRect);
 END;
END;

{function GetMItemRect(whichRect:Integer;myRect:Rect):Rect;}

FUNCTION GetMItemRect (whichRect : Integer;
 myRect : Rect) : Rect;
 VAR
 ItemRect : Rect;
BEGIN
 ItemRect := GetItemRect(whichRect);
 OffSetRect(itemRect, myRect.left, myRect.top);
 GetMItemRect := ItemRect;
END;

{procedure drawItem(myRect : rect; myItem : integer); }

PROCEDURE drawItem (myRect : rect;
 myItem : integer);
 VAR
 currentPat : pattern;
BEGIN
 IF (myItem > 0) AND (myItem < 97) THEN
 BEGIN
 myRect := GetMItemRect(myItem, myRect);
 GetIndPattern(currentPat, 100, myItem);
 FillRect(myRect, currentPat);
 FrameRect(myRect);
 END;
END;

{procedure clearitem(myRect : Rect; lastCell : integer); }

PROCEDURE clearitem (myRect : Rect;
 lastCell : integer);
BEGIN
 DrawItem(myRect, lastCell - 9);
 DrawItem(myRect, lastCell - 8);
 DrawItem(myRect, lastCell - 7);
 DrawItem(myRect, lastCell - 1);
 DrawItem(myRect, lastCell);
 DrawItem(myRect, lastCell + 1);
 DrawItem(myRect, lastCell + 7);
 DrawItem(myRect, lastCell + 8);
 DrawItem(myRect, lastCell + 9);
END;

{Menu Definition Routine   }

PROCEDURE MyMenuDef (message : Integer;
 theMenu : MenuHandle;
 VAR menuRect : Rect;
 hitPt : Point;
 VAR whichItem : Integer);

{ Begin nested procedrues }
 PROCEDURE DoDrawMessage (myMenu : MenuHandle;
 myRect : Rect);
 CONST
 MBarHeight = 20;
 VAR
 whichRect : Integer;
 currentPat : Pattern;
 currRect : Rect;
 BEGIN
 FOR whichRect := 1 TO 96 DO
 Drawitem(myRect, whichRect);
 END;

 FUNCTION DoChooseMessage (myMenu : MenuHandle;
 myRect : Rect;
 myPoint : Point;
 oldItem : Integer) : Integer;
 VAR
 currRect : Rect;
 alldone : boolean;
 whichRect : Integer;
 oldRect : Rect;
 mPt : Point;
 lastPt : Point;
 lastRect : Rect;
 menuPt : Point;
 tempRect : Rect;
 exitrect : rect;
 saveClip : RgnHandle;
 io : integer;
 BEGIN
 ClipRect(myRect);
 whichRect := 1;
 alldone := false;
 REPEAT
 currRect := GetMItemRect(whichRect, myRect);
 IF PtInRect(myPoint, currRect) THEN
 alldone := true
 ELSE
 whichRect := whichRect + 1;
 UNTIL ((AllDone) OR (whichRect > 96));
 IF AllDone THEN { if we are in a item}
 BEGIN
 IF (whichRect <> oldItem) THEN
 BEGIN
 IF (oldItem <> 0) THEN
 ClearItem(myRect, oldItem);
 InsetRect(currRect, -6, -6);
 PenSize(6, 6);
 PenPat(white);
 FrameRect(currRect);
 PenNormal;
 InsetRect(currRect, -1, -1);
 FrameRect(currRect);
 END;
 DoChooseMessage := whichRect;
 END
 ELSE { we are not in a item}
 BEGIN
 IF oldItem <> 0 THEN { invert the old item}
 clearitem(myRect, oldItem);
 DoChooseMessage := 0;

 PenMode(notPatXOR);
 penpat(gray);
 exitrect := myrect;
 InsetRect(ExitRect, -10, -10);
 ExitRect.top := 20;
 menuPt.h := myRect.left + ((myRect.right - myRect.left) DIV 2);
 menuPt.v := myRect.top + ((myRect.bottom - myRect.top) DIV 2);
 SetRect(tempRect, 0, 0, 0, 0);
 lastRect := tempRect;
 ClipRect(screenbits.bounds);
 REPEAT
 GetMouse(mPt);
 LocalToGlobal(mPt);
 IF ((Longint(mpt) <> Longint(lastPt)) AND (NOT PtInRect(mpt, ExitRect)) 
AND (mPt.v > 20)) THEN
 BEGIN
 lastPt := mPt;
 tempRect := myRect;
 OffSetRect(tempRect, mPt.h - menuPt.h, mPt.v - menuPt.v);
 IF tempRect.top < 20 THEN
 BEGIN
 tempRect.top := 20;
 tempRect.bottom := 20 + 202;
 END;
 FrameRect(lastRect);
 FrameRect(tempRect);
 lastRect := tempRect;
 END;
 UNTIL (NOT button) OR ptInRect(mPt, exitrect) OR (mPt.v < 21);
 FrameRect(lastRect);
 PenNormal;
 IF (NOT PtInRect(mpt, ExitRect)) AND (mPt.v > 20) THEN
 BEGIN
 lastrect.top := lastrect.top + 12;
 io := PostEvent(12,Longint(lastRect.topleft));
        { this communicates back to the main event}
        { loop that a window was just torn from the}
        { menu.  We pass the new topLeft in the message}
 END;
 END;
 END;

 PROCEDURE DoSizeMessage (VAR myMenu : MenuHandle);
 BEGIN
 WITH myMenu^^ DO
 BEGIN
 menuWidth := 127;
 menuHeight := 191;
 END;
 END;

{ End of nested procedures }
BEGIN
 CASE message OF
 mSizeMsg : 
 DoSizeMessage(theMenu);
 mDrawMsg : 
 DoDrawMessage(theMenu, menuRect);
 mChooseMsg : 
 whichItem := DoChooseMessage(theMenu, menuRect, hitPt, whichItem);
 END;
END;

{ ---------------------------------- }
{ShowAbout procedure  }

PROCEDURE ShowAbout;
 VAR
 theDlog : DialogPtr;
 theItem : Integer;
BEGIN
 theDlog := GetNewDialog(AboutID, NIL, Pointer(-1));
 ModalDialog(NIL, theItem);
 DisposDialog(theDlog);
END;

{  ProcessMenu procedure   }

PROCEDURE ProcessMenu (codeWord : Longint);
 TYPE
 PatPtr = ^Pattern;
 VAR
 menuNum : Integer;
 itemNum : Integer;
 NameHolder : str255;
 dummy : Integer;
 yuck : boolean;
 myPattern : Pattern;
 DeskPatternPtr : PatPtr;
 savePort, aPort : grafPtr;
 theRgn1, theRgn2 : RgnHandle;
BEGIN
IF codeWord <> 0 THEN
 BEGIN
 menuNum := HiWord(codeWord);
 itemNum := LoWord(codeWord);
 CASE menuNum OF { the different menus}
 AppleMenuID : 
 IF itemNum < 3 THEN
 ShowAbout
 ELSE
 BEGIN
 GetItem(myMenus[AppleMenuID], itemNum, NameHolder);
 dummy := OpenDeskAcc(NameHolder);
 END;
 FileMenuID : 
 Done := true;
 EditMenuID : 
 yuck := SystemEdit(itemNum - 1);
 GraphicalMenu : 
 IF ItemNum <> 0 THEN
 BEGIN
 GetIndPattern(myPattern, 100, ItemNum);
 SetPort(currentPatWind);
 BackPat(myPattern);
 EraseRect(currentPatWind^.portRect);
 END;
 END;
 HiliteMenu(0);
 END;
END;

{Deal With Mouse Downs procedure }

 PROCEDURE DealWithMouseDowns (theEvent : EventRecord);
 VAR
 location : Integer;
 windowPointedTo : WindowPtr;
 mouseLoc : point;
 windowLoc : integer;
 VandH : Longint;
 Height : Integer;
 Width : Integer;
 currRect, myRect : Rect;
 newcell, LastCell : integer;
 thePt, LastPt : Point;
 i : integer;
 myPattern : Pattern;
 BEGIN
 mouseLoc := theEvent.where;
 windowLoc := FindWindow(mouseLoc, windowPointedTo);
 CASE windowLoc OF
 inMenuBar : 
 ProcessMenu(MenuSelect(mouseLoc));
 inSysWindow : 
 SystemClick(theEvent, windowPointedTo);
 inContent : 
 IF windowPointedTo <> FrontWindow THEN
 SelectWindow(windowPointedTo)
 ELSE
 BEGIN
 IF RegWDEFWindow = windowPointedTo THEN
 BEGIN
 SetPort(RegWDEFWindow);
 GetMouse(lastPt);
 newCell := 0;
 lastCell := 0;
 myRect := RegWDEFWindow^.portRect;
 WHILE waitmouseup DO {track in pattern wind}
 BEGIN
 GetMouse(thePt);
 IF NOT PtInRect(thePt, myRect) THEN
 BEGIN {we moved outside the window}
 IF lastCell <> 0 THEN
 clearItem(myRect, lastCell);
 lastCell := 0;
 END
 ELSE
 BEGIN
 FOR i := 1 TO 96 DO
 IF PtInRect(thePt, GetItemRect(i)) THEN
 newCell := i;
 IF newCell <> lastCell THEN
 BEGIN
 IF (lastCell <> 0) THEN
 Clearitem(myRect, lastCell);
 currRect := GetItemRect(newCell);
 InsetRect(currRect, -6, -6);
 PenSize(6, 6);
 PenPat(white);
 FrameRect(currRect);
 PenNormal;
 InsetRect(currRect, -1, -1);
 FrameRect(currRect);
 lastCell := newCell;
 END;
 END;
 END;
 Clearitem(myRect, lastCell);
 GetIndPattern(myPattern, 100, newCell);
 SetPort(currentPatWind);
 BackPat(myPattern);
 EraseRect(currentPatWind^.portRect);
 END;
 END;
 inDrag : 
 BEGIN
 DragWindow(windowPointedTo, mouseLoc, DragArea);
 SelectWindow(windowPointedTo);
 END;
 inGoAway : 
 IF TrackGoAway(windowPointedTo, mouseLoc) THEN
 HideWindow(windowPointedTo);
 END;
END;

{Deal With Key Downs procedure}

 PROCEDURE DealWithKeyDowns (theEvent : EventRecord);
 TYPE
 Trick = PACKED RECORD
 CASE boolean OF
 true:(
 long : Longint
 );
 false : (
 chr3, chr2, chr1, chr0 : char
 )
 END;
 VAR
 CharCode : char;
 TrickVar : Trick;
 BEGIN
 TrickVar.long := theEvent.message;
 CharCode := TrickVar.chr0;
 IF BitAnd(theEvent.modifiers, CmdKey) = CmdKey THEN           
 {check for a menu selection}
 ProcessMenu(MenuKey(CharCode))
 END;

{Deal With Updates procedure}

 PROCEDURE DealWithUpdates (theEvent : EventRecord);
 VAR
 UpDateWindow : WindowPtr;
 tempPort : WindowPtr;

 BEGIN
 UpDateWindow := WindowPtr(theEvent.message);
 GetPort(tempPort);
 SetPort(UpDateWindow);
 BeginUpDate(UpDateWindow);
 EraseRect(UpDateWindow^.portRect);
 IF UpdateWindow <> currentPatWind THEN
 DrawPatWindow;
 EndUpDate(UpDateWindow);
 SetPort(tempPort);
 END;

{MainEventLoop procedure  }

 PROCEDURE MainEventLoop;
 VAR
 Event : EventRecord;
 ProcessIt : boolean;
 where : Point;
 BEGIN
 REPEAT
 SystemTask;
 IF GetNextEvent(everyEvent, Event) THEN
 CASE Event.what OF
 mouseDown : 
 DealWithMouseDowns(Event);
 AutoKey : 
 DealWithKeyDowns(Event);
 KeyDown : 
 DealWithKeyDowns(Event);
 UpdateEvt : 
 DealWithUpdates(Event);
 12 : 
 BEGIN { we return this when a window torn}
 where := Point(Event.message);
 HideWindow(RegWDefWindow);
 MoveWindow(RegWDefWindow, where.h, where.v, true);
 ShowWindow(RegWDEFWindow);
 END;
 OTHERWISE
 BEGIN
 END;
 END; {of case}
 UNTIL Done;
 END;

{SetupMemory procedure      }

 PROCEDURE SetupMemory;
 VAR
 x : Longint;
 BEGIN
{x := ORD4(ApplicZone) + 128000;}
{SetApplLimit(Pointer(x));}
 MaxApplZone;
 MoreMasters;
 MoreMasters;
 MoreMasters;
 END;

{ SetupLimits    }

 PROCEDURE SetupLimits;
 VAR
 Screen : Rect;
 BEGIN
 Screen := ScreenBits.bounds;
 WITH Screen DO
 BEGIN
 SetRect(DragArea, left+4, top+24, right-4, bottom-4);
 SetRect(GrowArea, left, top + 24, right, bottom);
 END;
 END;

{MakeMenus procedure   }

 PROCEDURE MakeMenus;
 VAR
 index : Integer;
 BEGIN
 FOR index := AppleMenuID TO EditMenuID DO
 BEGIN
 myMenus[index] := GetMenu(index);
 InsertMenu(myMenus[index], 0);
 END;
 AddResMenu(myMenus[AppleMenuID], ‘DRVR’);
 MyGraphicsMenu := NewMenu(4, ‘Graphics’);
 MyGraphicsMenu^^.menuProc := NewHandle(0);
 MyGraphicsMenu^^.menuProc^ := Ptr(@MyMenuDef);
 CalcMenuSize(MyGraphicsMenu);
 Insertmenu(MyGraphicsMenu, 0);
 DrawMenuBar;
 END;

 PROCEDURE crash;
 BEGIN
 ExitToShell;
 END;

{ ---------------------------------- }
{Main Program Excecution Starts Here }

BEGIN
 InitGraf(@thePort);
 InitFonts;
 InitWindows;
 InitMenus;
 TEInit;
 InitDialogs(@crash);
 InitCursor;
 Done := false;
 FlushEvents(everyEvent, 0);

 SetupLimits;
 SetupMemory;
 MakeMenus;

 RegWDEFWindow := GetNewWindow(WindResID, NIL, Pointer(-1));
 myWindowPeek := WindowPeek(RegWDEFWindow);
 myWindowPeek^.windowDefProc := NewHandle(0);
 myWindowPeek^.windowDefProc^ := Ptr(@MyWindowDef);
 SetWRefCon(RegWDEFWIndow, Ord4(MyGraphicsMenu));
 currentPatWind := GetNewWindow(2, NIL, pointer(-1));
 SetPort(currentPatWind);
 BackPat(gray);
 EraseRect(currentPatWind^.portRect);

 MainEventLoop;
END. {thats all folkes!}
{2}
Listing 2: TML Link File (Ignore for LS Pascal )
!PAS$Xfer

/Globals -4
TearMenu
PAS$Library
macintf
MacIntfGlue
/Resources
TearMenuRes
/Bundle
/Type  APPL TEAR
/End


Listing 3: REZ version resource file

resource ‘BNDL’ (128) {
 ‘TEAR’,
 0,
 { /* array TypeArray: 2 elements */
 /* [1] */
 ‘ICN#’,
 { /* array IDArray: 1 elements */
 /* [1] */
 0, 128
 },
 /* [2] */
 ‘FREF’,
 { /* array IDArray: 1 elements */
 /* [1] */
 0, 128
 }
 }
};

resource ‘DITL’ (3000) {
 { /* array DITLarray: 3 elements */
 /* [1] */
 {155, 142, 180, 205},
 Button {
 enabled,
 “Okay”
 },
 /* [2] */
 {6, 5, 112, 361},
 StaticText {
 disabled,
 “                                 - Tear “
 “Menu -\n\nWritten by Darryl Lovato of TML “
 “Systems, Inc.\n\nThis program shows how to”
 “ make a window tear off of a menu.  Idea”
 “ from Hypercard by Bill Atkinson.\n”
 },
 /* [3] */
 {115, 5, 149, 361},
 StaticText {
 enabled,
 “Complete Pascal source code for this pro”
 “gram is available from MacTutor Magazine”
 “.”
 }
 }
};

resource ‘DLOG’ (3000, preload) {
 {58, 74, 244, 436},
 dBoxProc,
 visible,
 goAway,
 0x0,
 3000,
 “New Dialog”
};

resource ‘FREF’ (128) {
 ‘APPL’,
 0,
 “”
};
resource ‘ICN#’ (128, purgeable, preload) {
 { /* array: 2 elements */
 /* [1] */
 $”000F F400 007A FD00 01FF F780 05FF 7FE0"
 $”07FF FFB0 0BFB FFD8 0FFF B578 1FDF F6FC”
 $”1F7E E8BC 1E77 A074 3E37 807C 1C00 006C”
 $”3FF0 3E3C 2E38 633C 3DE0 3C24 1E60 4C24"
 $”1400 4004 1C00 0004 0C00 4008 0400 0038"
 $”0404 6028 0001 8038 0200 0078 0008 1050"
 $”0103 C060 0180 0140 0780 0040 7D20 0440"
 $”4510 0820 4887 E050 4980 0088 7FFF FFF8",
 /* [2] */
 $”000F F400 007F FD00 01FF FF80 05FF FFE0"
 $”07FF FFF0 0FFF FFF8 0FFF FFF8 1FFF FFFC”
 $”1FFF FFFC 1FFF FFFC 3FFF FFFC 1FFF FFFC”
 $”3FFF FFFC 3FFF FFFC 3FFF FFFC 1FFF FFFC”
 $”1FFF FFFC 1FFF FFFC 0FFF FFF8 07FF FFF8"
 $”07FF FFF8 03FF FFF8 03FF FFF8 01FF FFF0"
 $”01FF FFE0 01FF FFC0 07FF FFC0 7FFF FFC0"
 $”7FFF FFE0 7FFF FFF0 7FFF FFF8 7FFF FFF8"
 }
};
resource ‘MENU’ (1) {
 1,
 textMenuProc,
 0x7FFFFFFD,
 enabled,
 apple,
 { /* array: 2 elements */
 /* [1] */
 “About Tear Menu...”, noIcon, “”, “”, plain,
 /* [2] */
 “-”, noIcon, “”, “”, plain
 }
};
resource ‘MENU’ (2) {
 2,
 textMenuProc,
 0x7FFFFFF5,
 enabled,
 “File”,
 { /* array: 1 elements */
 /* [1] */
 “Quit”, noIcon, “Q”, “”, plain
 }
};
resource ‘MENU’ (3) {
 3,
 textMenuProc,
 0x7FFFFFFD,
 enabled,
 “Edit”,
 { /* array: 6 elements */
 /* [1] */
 “Undo”, noIcon, “Z”, “”, plain,
 /* [2] */
 “-”, noIcon, “”, “”, plain,
 /* [3] */
 “Cut”, noIcon, “X”, “”, plain,
 /* [4] */
 “Copy”, noIcon, “C”, “”, plain,
 /* [5] */
 “Paste”, noIcon, “V”, “”, plain,
 /* [6] */
 “Clear”, noIcon, “”, “”, plain
 }
};
resource ‘WIND’ (1) {
 {100, 100, 292, 228},
 documentProc,
 invisible,
 goAway,
 0x0,
 “”
};
resource ‘WIND’ (2) {
 {81, 143, 224, 327},
 documentProc,
 visible,
 goAway,
 0x0,
 “Current Pattern”
};
data ‘TEAR’ (0) {
 $”1B54 6561 7220 4D65 6E75 2C20 6279 2044" 
 $”6172 7279 6C20 4C6F 7661 746F” 
};
resource ‘PAT#’ (100, purgeable) {
 { /* array PatArray: 96 elements */
 /* [1] */
 $”FFFF FFFF FFFF FFFF”,
 /* [2] */
 $”DDFF 77FF DDFF 77FF”,
 /* [3] */
 $”DD77 DD77 DD77 DD77",
 /* [4] */
 $”AA55 AA55 AA55 AA55",
 /* [5] */
 $”55FF 55FF 55FF 55FF”,
 /* [6] */
 $”AAAA AAAA AAAA AAAA”,
 /* [7] */
 $”EEDD BB77 EEDD BB77",
 /* [8] */
 $”8888 8888 8888 8888",
 /* [9] */
 $”B130 031B D8C0 0C8D”,
 /* [10] */
 $”8010 0220 0108 4004",
 /* [11] */
 $”FF88 8888 FF88 8888",
 /* [12] */
 $”FF80 8080 FF08 0808",
 /* [13] */
 $”80",
 /* [14] */
 $”8040 2000 0204 08",
 /* [15] */
 $”8244 3944 8201 0101",
 /* [16] */
 $”F874 2247 8F17 2271",
 /* [17] */
 $”55A0 4040 550A 0404",
 /* [18] */
 $”2050 8888 8888 0502",
 /* [19] */
 $”BF00 BFBF B0B0 B0B0",
 /* [20] */
 $””,
 /* [21] */
 $”8000 0800 8000 08",
 /* [22] */
 $”8800 2200 8800 22",
 /* [23] */
 $”8822 8822 8822 8822",
 /* [24] */
 $”AA00 AA00 AA00 AA”,
 /* [25] */
 $”FF00 FF00 FF00 FF”,
 /* [26] */
 $”1122 4488 1122 4488",
 /* [27] */
 $”FF00 0000 FF”,
 /* [28] */
 $”0102 0408 1020 4080",
 /* [29] */
 $”AA00 8000 8800 80",
 /* [30] */
 $”FF80 8080 8080 8080",
 /* [31] */
 $”081C 22C1 8001 0204",
 /* [32] */
 $”8814 2241 8800 AA”,
 /* [33] */
 $”40A0 0000 040A”,
 /* [34] */
 $”0384 4830 0C02 0101",
 /* [35] */
 $”8080 413E 0808 14E3",
 /* [36] */
 $”1020 54AA FF02 0408",
 /* [37] */
 $”8000 0000 08",
 /* [38] */
 $”80",
 /* [39] */
 $”0002 4000 0000 0080",
 /* [40] */
 $”0002 4000 0000 0880",
 /* [41] */
 $”8000 1000 8002 0020",
 /* [42] */
 $”8002 0010 8002 0010",
 /* [43] */
 $”0092 0000 9200 0092",
 /* [44] */
 $”0092 0008 8220 0092",
 /* [45] */
 $”0092 0028 8228 0092",
 /* [46] */
 $”1082 1082 1082 1082",
 /* [47] */
 $”2288 2288 2288 2288",
 /* [48] */
 $”2288 22A8 2288 2288",
 /* [49] */
 $”2288 22A8 2288 2A88",
 /* [50] */
 $”228A 22A8 2288 2A88",
 /* [51] */
 $”228A 22A8 2288 AA88",
 /* [52] */
 $”228A A2A8 2288 AA88",
 /* [53] */
 $”228A AAA8 2288 AAA8",
 /* [54] */
 $”228A AAA8 228A AAA8",
 /* [55] */
 $”AA11 AA45 AA11 AA54",
 /* [56] */
 $”AA51 AA45 AA11 AA55",
 /* [57] */
 $”AA55 AA45 AA55 AA54",
 /* [58] */
 $”AA55 AA45 AA55 AA55",
 /* [59] */
 $”AA55 AA55 AA55 AA55",
 /* [60] */
 $”AA55 BA55 AA55 AA55",
 /* [61] */
 $”AA55 BA55 AA55 AB55",
 /* [62] */
 $”AA55 BA55 AA55 AB75",
 /* [63] */
 $”EE55 BA55 EA55 AB55",
 /* [64] */
 $”EE55 BA55 EE55 AB55",
 /* [65] */
 $”EE55 BA55 EE55 BB55",
 /* [66] */
 $”EE55 BB55 EE55 BB55",
 /* [67] */
 $”EE55 BB55 EE5D BB55",
 /* [68] */
 $”EE55 BB55 EE5D FB55",
 /* [69] */
 $”EE55 FB55 EE5D FB55",
 /* [70] */
 $”EE55 FF55 EE55 FF55",
 /* [71] */
 $”FF55 FF55 FF55 FF55",
 /* [72] */
 $”FF55 FF5D FF55 FF55",
 /* [73] */
 $”FF55 FF5D FF55 FFD5",
 /* [74] */
 $”FF55 FFDD FF55 FFD5",
 /* [75] */
 $”FF55 FFDD FF55 FFDD”,
 /* [76] */
 $”FF57 FF5D FF75 FFD5",
 /* [77] */
 $”FF57 FF7D FF7D FFD7",
 /* [78] */
 $”FFDD FFFF FFF7 FF7F”,
 /* [79] */
 $”FFDF FFFF FFF7 FF7F”,
 /* [80] */
 $”FFFF FFF7 FFFF FF7F”,
 /* [81] */
 $”FFFF FFFF FFFF FF7F”,
 /* [82] */
 $”FFFF FFFF FFFF FFFF”,
 /* [83] */
 $”7FBF DFBF 6BDD BD7B”,
 /* [84] */
 $”FF03 0509 1121 4181",
 /* [85] */
 $”FF83 4529 1129 4583",
 /* [86] */
 $”FF93 5539 FF39 5593",
 /* [87] */
 $”FE93 5539 EF39 5593",
 /* [88] */
 $”FE93 1139 EF39 1193",
 /* [89] */
 $”1010 1038 EF38 1010",
 /* [90] */
 $”1192 5438 EF38 5492",
 /* [91] */
 $”1192 5438 EF38 5492",
 /* [92] */
 $”55AA 55BA 6DBA 55AA”,
 /* [93] */
 $”5FA9 51A3 458A 55AA”,
 /* [94] */
 $”55EA 7DA6 65BE 57AA”,
 /* [95] */
 $”55AA 4182 4182 55AA”,
 /* [96] */
 $”46A6 FFFF 4686 57AE”
 }
 /** Extra bytes follow.. */
 /* $”0000 0034 0001 1400"
};
 

Community Search:
MacTech Search:

Software Updates via MacUpdate

calibre 4.17.0 - Complete e-book library...
Calibre is a complete e-book library manager. Organize your collection, convert your books to multiple formats, and sync with all of your devices. Let Calibre be your multi-tasking digital librarian... Read more
MacPilot 11.1.4 - $15.96
MacPilot gives you the power of UNIX and the simplicity of Macintosh, which means a phenomenal amount of untapped power in your hands! Use MacPilot to unlock over 1,200 features, and access them all... Read more
Transmission 3.00 - Popular BitTorrent c...
Transmission is a fast, easy, and free multi-platform BitTorrent client. Transmission sets initial preferences so things "just work", while advanced features like watch directories, bad peer blocking... Read more
Doom 3 1.3.1 - First-person shooter acti...
A massive demonic invasion has overwhelmed the Union Aerospace Corporation's (UAC) Mars Research Facility, leaving only chaos and horror in its wake. As one of only a few survivors, you must fight... Read more
Box Sync 4.0.8004 - Online synchronizati...
Box Sync gives you a hard-drive in the Cloud for online storage. Note: You must first sign up to use Box. What if the files you need are on your laptop -- but you're on the road with your iPhone? No... Read more
LibreOffice 6.4.4.2 - Free, open-source...
LibreOffice is an office suite (word processor, spreadsheet, presentations, drawing tool) compatible with other major office suites. The Document Foundation is coordinating development and... Read more
Day One 4.14 - Maintain a daily journal.
Day One is an easy, great-looking way to use a journal / diary / text-logging application. Day One is well designed and extremely focused to encourage you to write more through quick Menu Bar entry,... Read more
Doxie 2.12.2 - Scan, share, and store do...
Introducing Doxie, the new, modern paper scanner that's so simple, it'll revolutionize the way you think about sharing and storing docs and photos forever. Doxie is ultra-portable, fully automatic,... Read more
Tinderbox 8.7.0 - Store and organize you...
Tinderbox is a personal content management assistant. It stores your notes, ideas, and plans. It can help you organize and understand them. And Tinderbox helps you share ideas through Web journals... Read more
Viber 13.0.0 - Send messages and make fr...
Viber lets you send free messages and make free calls to other Viber users, on any device and network, in any country! Viber syncs your contacts, messages and call history with your mobile device, so... Read more

Latest Forum Discussions

See All

SINoALICE, Yoko Taro and Pokelabo's...
Yoko Taro and developer Pokelabo's SINoALICE has now opened for pre-registration over on the App Store. It's already amassed 1.5 million Android pre-registrations, and it's currently slated to launch on July 1st. [Read more] | Read more »
Masketeers: Idle Has Fallen's lates...
Masketeers: Idle Has Fallen is the latest endeavour from Appxplore, the folks behind Crab War, Thor: War of Tapnarok and Light A Way. It's an idle RPG that's currently available for Android in Early Access and will head to iOS at a later date. [... | Read more »
Evil Hunter Tycoon celebrates 2 million...
Evil Hunter Tycoon has proved to be quite the hit since launching back in March, with its most recent milestone being 2 million downloads. To celebrate the achievement, developer Super Planet has released a new updated called Darkness' Front Yard... | Read more »
Peak's Edge is an intriguing roguel...
Peak's Edge is an upcoming roguelike puzzle game from developer Kenny Sun that's heading for both iOS and Android on June 4th as a free-to-play title. It will see players rolling a pyramid shape through a variety of different levels. [Read more] | Read more »
Clash Royale: The Road to Legendary Aren...
Supercell recently celebrated its 10th anniversary and their best title, Clash Royale, is as good as it's ever been. Even for lapsed players, returning to the game is as easy as can be. If you want to join us in picking the game back up, we've put... | Read more »
The Magic Gladiator class arrives in MU...
The Magic Gladiator class is now available in MU Origin 2 following the most recent patch. It also marks the start of Abyss Season 11 and the introduction of Couple Skills and Couple Dungeons. [Read more] | Read more »
The 5 Best Racing Games
With KartRider Rush+ making a splash this past week, we figured it was high time we updated our list of the best mobile racing games out there. From realistic racing sims to futuristic arcade racers (and even racing management games!), check out... | Read more »
KartRider Rush+ Guide - Tips for new rac...
KartRider Rush+ continues to be a surprisingly refreshing and fun kart racer that's entirely free-to-play. The main reason for this is just how high its skill ceiling is. Check out the video above if you're curious to know what top level play looks... | Read more »
KartRider Rush+ might be good, actually?
It's hard to find good racing games on mobile. Most of them are free-to-play, and free-to-play racers generally suck. Even Nintendo couldn't put together a competent Mario Kart game, opting instead for a weird score chaser that resembles--but feels... | Read more »
LifeAfter, NetEase's popular surviv...
A new map will be making its way into NetEase's popular survival game LifeAfter. The map is set to arrive on May 28th and will introduce a volcano that's teetering on the verge of eruption, bringing a host of added challenges to the game. [Read... | Read more »

Price Scanner via MacPrices.net

Memorial Day Weekend Sale: Take $300 off thes...
Apple resellers are offering $300 discounts on select 16″ MacBook Pros as part of their Memorial Day Weekend 2020 sales. Prices start at $2099: – 16″ 2.6GHz 6-Core Space Gray MacBook Pro: $2099 at... Read more
Best Memorial Day Weekend 2020 Apple AirPods...
Apple resellers are offering discounts ranging up to $50 off MSRP on AirPods as part of their Memorial Day Weekend 2020 sales. These are the best deals today on various AirPods models. See our... Read more
Memorial Day Weekend Sale: 10″ Apple iPads fo...
Amazon is offering new 10.2″ iPads for $80-$100 off Apple’s MSRP as part of their Memorial Day Weekend 2020 sale, with prices starting at only $249. These are the same iPads sold by Apple in their... Read more
Memorial Day Weekend Sale: 2020 Apple iPhone...
Sprint is offering Apple’s new 2020 64GB iPhone SE for $0 per month for 18 months as part of their Memorial Day Weekend 2020 sale. New line of service and trade-in required. Offer is valid from 5/22/... Read more
Amazon’s popular $100 Apple Watch Series 5 di...
Amazon has Apple Watch Series 5 GPS + Cellular models on sale for up to $100 off Apple’s MSRP today. Shipping is free. These are the same Apple Watch models sold by Apple in their retail and online... Read more
2020 13″ 4-Core MacBook Air on sale for $949,...
Apple reseller Adorama has the new 2020 13″ 1.1GHz 4-Core Space Gray MacBook Air on sale today for $949 shipped. Their price is $50 off Apple’s MSRP, and it’s the lowest price currently available for... Read more
Apple Retail Chief Announces Staggered Reopen...
NEWS: 05.20.20 – In the midst of a global pandemic, after its retail outlets were shuttered temporarily in mid-March as a mitigation measure enacted by Apple during the peak of the spread of COVID-19... Read more
Apple’s Pro Display XDR models in stock today...
Abt Electronics has Apple’s new 32″ Pro Display XDR models in stock and on sale today for up to $305 off MSRP. Shipping is free. Their prices are currently the lowest available for these new models... Read more
Apple restocks refurbished iPhone 8 for $339
Apple has restocked Apple Certified Refurbished 64GB iPhone 8 models for only $339. Apple dropped their price on this phone last month by $160, from $499 to $339. Each refurbished iPhone comes with a... Read more
New at AT&T: 50% off iPhone 11 for new cu...
AT&T is offering a 50% off the 64GB iPhone 11 for new customers who switch to AT&T and open a new line of service. Discount applied over a 30 month period The fine print: “iPhone 11 64GB for... Read more

Jobs Board

Cub Foods - *Apple* Valley - Now Hiring Par...
Cub Foods - Apple Valley - Now Hiring Part Time! United States of America, Minnesota, Apple Valley New Retail Operations Post Date 5 days ago Requisition # Read more
Senior Data Engineer - *Apple* - Theorem, L...
Job Summary Apple is seeking an experienced, detail-minded data engineeringconsultant to join our worldwide business development and strategy team. If you are Read more
Cub Foods - *Apple* Valley - Now Hiring Par...
Cub Foods - Apple Valley - Now Hiring Part Time! United States of America, Minnesota, Apple Valley New Retail Operations Post Date 4 days ago Requisition # Read more
Medical Screener - *Apple* Hill - Evenings...
Medical Screener - Apple Hill - Evenings Tracking Code D-MS-AH-E Job Description Medical Screener - Temporary We Are Hiring: WellSpan Health has a temporary Medical Read more
*Apple* Systems Administrator - Solidus Tech...
Solidus is searching for an Apple Systems Engineer. The engineer will be responsible for desktop and server infrastructure. This includes support for operating Read more
All contents are Copyright 1984-2011 by Xplain Corporation. All rights reserved. Theme designed by Icreon.