TweetFollow Us on Twitter

Finder Icons
Volume Number:5
Issue Number:1
Column Tag:Pascal Procedures

Related Info: Menu Manager Control Manager Memory Manager

Finder Icon Controls

By Jean de Combret, Grenoble, France

Finder-like icon-controls

How to write, debug and use ‘MDEF’ and ‘CDEF’ resources.

Jean de Combret is a former river-hydraulics engineer, who worked with mathematical models human-unfriendly programs. He thinks the Mac could be a solution to make such programs more friendly and has therefore set up “Diadème Ingénierie” and written “ONDULA”. He is a member of “Macintosh Alpes Club”, as well as Didier Guillon, Jörg Langowski [hum... thanks! -JL] and a lot of other interesting folks.

Introduction

While developing my application, it appeared to me I needed an object-interface, somewhat like the Finder’s one, with icons, hierarchy (folders contain other icons), actions (by double-clicking, classifying, throwing away or choosing in a menu). So I decided to write my own objects, and the best way I found to do it was to make them user-controls.

VarCodes

All icons of the family I’ve created bear the same appearance: an icon, and an underlying name. But each member of the family has different properties, which may be done by giving different “varCodes” to each variant. I choose a system of additive varCodes, although not all combinations have sense:

moveable=1;

means the control may be dragged inside its window (like all icons in the Finder);

doubleClickable=2;

means the control may generate an action by double-clicking it: it should then take an “open” appearance (like folders, disks and trash icons that generate a window, or like application icons that start-up applications);

trash=4;

means the control may “swallow up” another one released over its head. It should highlight while the mouse, dragging the control to be swallowed up, is still down and pointing to it (like trash, folders and disks icons in the Finder)

menu=8;

is a new type of control icon I’ve imagined : it should generate a pop-up menu of icons when pressed. This is an alternate technique to the palette menus and tear off menus. The menu is by the way bound to a window.

Some examples of possible combinations are listed below:

• a folder would be declared “movable + doubleClickable + trash” and its varCode would therefore be 7;

• a growing menu of icons would be “menu + trash” i.e. 12 (“menu” for removing or choosing items, “trash” to add items);

• an application icon would be declared “movable + doubleClickable” i.e. 3.

In fact, “menu” is exclusive of “movable” or “doubleClickable”.

Menu definition procedure and pop-up menus

Before building our custom control definition procedure, we must first build our custom icons menus. At that point, the two first problems are

• to write a ‘MDEF’ code resource ;

• to make it work with pop-up menus.

Inside Macintosh indicates p.I-362 how to write ‘MDEF’s for pull-down menus. In my alpha release of the fifth volume (for which the French Macintosh Development Support failed to send me updates), I don’t find anything about pop-up menus nor about custom menus. I just found two significant pieces of information in the Color Menu Manager interface in my LightSpeed Pascal libraries -a new trap declared as

{1}

PROCEDURE PopUpMenuSelect (menu : MenuHandle;
 top , left , popUpItem : INTEGER) : LONGINT;
inline $A80B;
and a constant :

mPopUpMsg=4;      ( sic )

This latter statement appeared later to be false. I learned by disassembling the standard code resource ‘MDEF’ 0 of the new system file, that only values ranging from 0 to 3 are accepted as messages, and that the one corresponding to pop-up menu treatments is 3:

mPopUpMsg=3;     ( right value )

By the way I learned that the routine responds to this new message by calculating “menuRect”, given “menu”, “top”, “left” and “popUpItem” parameters of PopUpMenuSelect transmitted respectively through the “theMenu”, “hitPt” and “whichItem” parameters from the menu definition procedure declaration :

{2}

PROCEDURE MyMenu (message : INTEGER;
 theMenu : MenuHandle;
 VAR menuRect : Rect;
 hitPt : Point;
 VAR whichItem : INTEGER);

Since I wrote most of this article, all of this has been confirmed by TechNote #172 from the November 1987 release. It just took 6 months to get it!

Before getting TechNote #172, I wasn’t quite sure I hadn’t made a mistake, but now I’m sure: hitPt is not a point! Instead it receives “left” and “top” inverted from PopUpMenuSelect.

I also tried the trap with standard text menus. The two hints I shall give follow: ( I found the second by decompiling the ROM patches; next time I’ll first have a look to Inside Macintosh p.351!)

• pass -1 as beforeID parameter to InsertMenu (the same as for hierarchical menus) to indicate that theMenu is in the current menu list, but is not to be drawn in the menu bar.

• pass a positive non-zero integer as MenuID to NewMenu or nothing will ever appear on the screen (you may also store it in the ‘MENU’ resource read by GetMenu, of course).

Debugging A Code Resource (Part 1)

I shall indicate two techniques to test and debug code resources under LightSpeed Pascal. The first one, used here, is the roughest and should never be used for anything else than debugging. I learned the second one from the best Macintosh programming journal I know (I mean the April issue of MacTutor p.17 and p.30), and I should give an example of the use I made of it further in this article.

The problem is to access and debug the source text of a code resource while running a shell program that calls it via Menu Manager routines (or Control Manager routines for ‘CDEF’s). Normally the code resources is compiled separately and accessed through a handle to the ‘MDEF’ resource. The Menu Manager routines use to lock the ‘MDEF’ resource upon entry, dereference the handle, jump to its beginning and unlock it upon exit.

My technique consists in declaring the unit with the ‘MDEF’ source text in the uses statement of a small debugging-purpose shell program, and I create a new menu as follows :

{3}

myMenu := GetMenu(128);
myProcPtr := @main;
myMenu^^.menuProc := @myProcPtr;

This way, the handle and its dereferenced pointer point to the stack, not at a masterpointer or a block within the heap. The HLock and HUnLock procedures may act on the high order bit of these pointers, it has no influence on the addresses (nevertheless be aware of TechNote #2 item 11). The Memory Manager never knows about the block and never tries to move it.

With this trick, you may freely use all the debugging facilities of LightSpeed Pascal: the Observe and LightsBug windows, the Step mode

Once all the bugs inside the ‘MDEF’ code have been fixed (or at least seam to), you build your ‘MDEF’ code resource. I gave mine a ResID of 128. Under ResEdit, you can see that the compiler gave to this resource a default attribute “purgeable”, you’d never ask it to give. Instead I changed it to “locked” and “preload”, in order to have it always under the hand (a disk access while pulling a menu is not user-friendly) and to keep it in the low region of the application heap.

New Meaning of ‘MENU’ Resource

The ‘MDEF’ and ‘CDEF’ are not the only user resources I wrote for my application. I like the flexibility of building all sort of data resources as well as compiling code resources. In the current example, my menu consists of icons, described by their names and their positions in the menu rectangle. It’s slightly different from the standard ‘MENU’ resource information. But in order to use the Menu Manager routines, I preferred interpreting the same ‘MENU’ resources in a different way, rather than create a completely new resource type. Description of the resource format given p.I-364 of Inside Macintosh should be replaced by :

Number of bytes Contents

2 bytes MenuId

2 bytes Placeholder for menu width

2 bytes Placeholder for menu height

2 bytes Resource ID of ‘MDEF’

2 bytes Place holder for ‘MDEF’ handle

4 bytes EnableFlags

n+1 bytes Title as Pascal string

for each menu item :

m+1 bytes Text of item as Pascal string

2 bytes Vertical coordinate of icon center

2 bytes Horizontal coordinate of center

1 byte 0, indicating end of menu items

(it is also a Pascal null string)

Note that this description occupies the same number of bytes that normal text menus do, which ensures the ability to use the standard procedures.

This description is almost the same as the one you can teach to ResEdit; I created a new ‘TMPL’ resource in the ResEdit file itself, which I gave the name ‘MPOP’. However, in order to use the GetMenu routine, my menu resources shall not be of type ‘MPOP’ but of type ‘MENU’. This is accomplished by creating a new ‘MENU’ resource and opening it with the “Open as ” command to indicate we wish to use the ‘MPOP’ format instead of the ‘MENU’ one to edit our resources (shortcut for “Open as ” is shift-option-double-clicking).

The ‘TMPL’ resource describes the structure of the ‘MPOP’ resource, somewhat like a Pascal record type describes the structure of a Pascal record variable (for more details see the MPW chapter about ResEdit) :

Label Type

MenuID DWRD

width DWRD

height DWRD

procID DWRD

filler DWRD

enableFlags HLNG

title PSTR

***** LSTZ

menuItem PSTR

center.v DWRD

center.h DWRD

***** LSTE

Reading A Resource

In fact this new syntax allowed by ResEdit gives more generality and compactness than Pascal records do: strings in Pascal records always occupy 256 bytes in memory, even if only 10 are actually used. Consequently, Pascal is not able to decipher such resources. So I had to write some inline assembly routines for this purpose. These routines read a chosen type beginning at a given address that might be odd and return a Pascal formatted value on the stack. For strings it returns a StringHandle on the stack, pointing to a string of the actual size in the heap. I give here three of these inline routines :

{4}

FUNCTION GetNextByte
 (VAR LongAddress : LONGINT) : BYTE;

FUNCTION GetNextInteger 
 (VAR LongAddress : LONGINT) : INTEGER;

FUNCTION GetNextString 
 (VAR LongAddress : LONGINT) : StringHandle;

These functions return NIL if allocation failed.

For each of these routines LongAddress is incremented by the amount of bytes read.

The same routines in Pascal would have called BlockMove, which is very efficient for larger blocks but far too long for such a few bytes.

As an example, here is what GetNextByte would look like in Pascal :

{5}

FUNCTION GetNextByte (VAR longAddress : LONGINT) : BYTE;
VARresult : BYTE;
BEGIN
 result := 0;
 BlockMove(POINTER(longAddress), POINTER(ORD(@result ) + 1), 1);
 GetNextByte := result ;
 longAddress:= longAddress+ 1;
END;

I added some other Pascal utilities for easy reading and writing :

{6}

FUNCTION SkipNextString (VAR LongAddress : LONGINT) : BYTE;

PROCEDURE SkipBytes (VAR LongAddress : LONGINT; byteCount : INTEGER);

Routines and Messages

Let’s come to our central topic: the control definition procedure. First of all note that there are 9 messages to the ‘CDEF’ code instead of only 4 to the ‘MDEF’ code. Controls are more complex than menus and hence more versatile.

I find Inside Macintosh not systematic enough in describing the meanings of these messages and I don’t know other information about them. So I decided to build my own complete table of what messages each routine of the Control Manager sends to the ‘CDEF’ code. I wrote a small program to help me in this task by installing a spy a the entry of the ‘CDEF’ code. Figure 1. shows the table resulting from this spying.

Fig. 1 : messages sent by the Control Manager routines

The program I used is listed below and I shall give here some explanations about the way I installed my spy, because it involves the second technique of building ‘CDEF’ resources from the same source file than the host program.

Debugging a Code Resource (Part 2)

Here comes the clean way of doing it (Thanks to Larry Rosenstein and also to Don Melton and Mike Ritter for the basic idea). You create a 6-byte handle and put a JMP $xxxxxx instruction in the block, which jumps to your procedure. Then you declare this block as a ‘CDEF’ resource which you give an unused ID. Then you can pass this ID to NewControl :

{7}

TYPE
 CDEFcodeHdl = ^CDEFcodePtr;
 CDEFcodePtr = ^CDEFcodeRecord;
 CDEFcodeRecord = RECORD
 jump : integer;
 address : ProcPtr;
 END;

VARmyControl : ControlHandle;
 myCDEF : CDEFcodeHdl;  myCDEFid : integer;

FUNCTION ControlDefProc (varCode : INTEGER;
 theControl : ControlHandle; message : INTEGER;
 param : LONGINT) : LONGINT;
BEGIN
 { put here the source of the ‘CDEF’ }
END;

BEGIN { here begins your host program }
 myCDEF := CDEFcodeHdl (NewHandle(6));
 myCDEF^^.jump := $4EF9;
 myCDEF^^.address := @ControlDefProc;
 myCDEFid := UniqueID(‘CDEF’);
AddResource(handle(myCDEF), ‘CDEF’, myCDEFid, ‘’);
{ *************************** }
{ write here the inits of your host program }
{ *************************** }
 myControl := NewControl(theWindow, boundsRect, title, visible, value, 
min, max, myCDEFid * 16 + varCode, refCon);
{ *************************** }
{ write here the body of your host program }
{ *************************** }
 DisposeControl(myControl);
 RmveResource(handle(myCDEF));
 DisposHandle(handle(myCDEF));
{ ****************************** }
{ write here the disposals of your host program }
{ ****************************** }
END.

For more information, you’ll have to refer to the listing given below (e.g. : don’t have a too large UniqueID, it must be less than maxint DIV 16 ).

Another interesting technique is the way of using routines passed by address from Pascal. Although Inside Macintosh says p.I-78 “Only routines written in assembly language can actually call the routine designated by a pointer of type ProcPtr”, it’s very easy to write inline code to do the job within Pascal programs. Suppose you have this function declaration :

{8}

FUNCTION MyFunction (firstArg : firstType;
 secondArg : secondType;
 VAR thirdArg : thirdType) : resultType;

If you want to call it by address (given by @MyFunction, or by a handle if the function is compiled as a code resource) you must declare an inline glue function.

For a function passed by pointer it should be :

{9}

FUNCTION CallMyFunction (firstArg : firstType;
 secondArg : secondType;
 VAR thirdArg : thirdType
 MyFunctionAddress : ProcPtr) : resultType;
INLINE
 $205F, {MOVE.L (A7)+,A0}
 $4E90; {JSR (A0)}

or, for a function passed by handle (after having locked it):

{10}

FUNCTION CallMyFunction (firstArg : firstType;
 secondArg : secondType;
 VAR thirdArg : thirdType
 MyFunctionResource : handle) : resultType;
INLINE
 $205F, {MOVE.L (A7)+,A0}
 $2050, {MOVE.L (A0),A0}
 $4E90; {JSR (A0)}

As you can see the declaration is exactly the same as in the original function, except that we add one last parameter. This technique applies as well to procedures. The number of arguments doesn’t matter, only matters the coherence between the two declarations.

Coming back to our example, you’ll notice a supplementary line in the inline code of my program, because tracing the ‘CDEF’ resource with MacsBug showed that it relied on a function return value being previously cleared.

Implementing the Control Definition Procedure

My goal was to do as much work as possible within the ‘CDEF’ code, in order to simplify the end programmer’s job of writing the host program.

Although “movable” controls should act through the DragControl routine, I grouped all actions of all the variety of controls under the TrackControl routine. I implement also custom initializations and disposals.

Here follows descriptions of :

• what the ControlRecord fields are used to ;

• how the control definition procedure responds to each message ;

• how to use the Control Manager routines to make my controls work correctly.

Control Record fields

• ContrlTitle contains the name that is used to find the related resources such as ‘ICN#’ and ‘MENU’.

• in order to speed up memory access to the icon and menu records related to the control, I store handles to them in the following structure :

{11}

TYPE
 DataHandle = ^DataPointer;
 DataPointer = ^DataRecord;
 DataRecord = RECORD
 theIcon : handle;
 theMenu : MenuHandle;
 END;

and I store the DataHandle in the ContrlData field.

• I use the ContrlRefCon field to store the values returned from the ‘CDEF’ routines :

- the ControlHandle of the “trash” in case the current control has been put in it;

- the choice made from the icon menu, as returned by PopUpMenuSelect.

• ContrlHilite is not used.

• I use 6 levels of ContrlValue ranging from ContrlMin = 0 to ContrlMax = 5. Rather than a continuous scale, they correspond to six different states of the controls (the “ContrlHilite” field could have been used for the same purpose):

This is the data of my icon (of type ‘ICN#’)

This is its mask.

RestState=0; ( same as the data on white background)

SelectState = 1;

OpenState = 2;

SelectOpenState = 3;

Technical note #55 describes how the Finder draws icons in that variety of ways. But in fact it’s not the actual way the old and new Finders do it. I think my algorithm is closer to reality. I’ve studied it using a funny feature of MacsBug -the Step Spy command :

SS 400000 400000

that slows all 68xxx instructions, and is specially recommended to examine graphical aspects of an application.

‘CDEF’ Routines in Response to the Messages

• drawCntl : draws the control with its title and its icon according to the state (i.e. its ContrlValue) ;

• testCntl : tests if the point is inside the icon’s data or mask ;

• calcCRgns : calculates the region, union of the rectangles enclosing the icon and the title. This region is used for any erasing of the control and updating of the underlying pixels, or for drawing the dotted outline when dragging the control ;

• initCntl : stores the handles to the icon and to the menu in a structure, pointed to by another handle which is in turn stored in the ContrlData field, and sets the actionProc parameter to POINTER(-1), to indicate we implement a custom autoTrack routine ;

• dispCntl : disposes the ContrlData handle but not the icon and menu handles which are resources and may be shared by other controls ;

• posCntl : not used, because my controls don’t have any indicator ;

• thumbCntl : not used ;

• dragCntl or autoTrack : the most important routine. First it sets the control to a selected state and deselects any other currently selected control. Then, if the control is “movable”, it detects the movements of the mouse,pulls a dotted outline and highlights the trashes the control flies over. If it was actually moved, it invalidates regions to be updated. If it was released over a “trash”, its value is set to 4 and the trash’s ControlHandle is returned in ContrlRefCon. Then it looks for a double-click in case the control is “double-clickable” and hasn’t been moved. In the other case where the control is a “menu” control, the routine generates the pop-up menu, by calling PopUpMenuSelect as described above and returns the choice in ContrlRefCon.

Note that a small problem arises in these routines when they call in turn other routines of the Control Manager -when the latter returns, the ‘CDEF’ resource is unlocked by the Control Manager, although the next instructions are still in the ‘CDEF’. So it is imperative to re-lock the ‘CDEF’ resource after each call to the Control Manager within the ‘CDEF’. If Apple had used HGetSate / HSetState instead of HLock / HUnLock to bracket the calls to ‘CDEF’, I think this problem would not exist.

Note also I let the user access to this last routine by two ways : TrackControl, which is more logic, and DragControl that calls “drawCntl” only when necessary, as shows figure 1., and thus makes a cleaner interface.

Control Manager Routines User’s Guide

Here is the way the standard routines act on my custom controls:

• NewControl or GetNewControl are used to create the controls with the following values of the parameters :

- boundsRect set to the 32x32 icon’s rectangle ;

- max = 5 ;

- min = 0 ;

- procID = 128 * 16 + varCode ;

- title = ‘CNTL’ resource name

= ‘ICN#’ resource name

= ‘MENU’ resource name ;

• TrackControl is used to make the controls work properly. Pass POINTER(-1) as actionProc, in order to let the Control Manager generate autoTrack messages.

• DragControl is used for the same purpose (see above). Pass anything as bounds, slop and axis.

• GetCRefCon is used to get the choice returned from the pop-up menu or the handle to the “trash” the current control was put in ;

• SetCtlValue is used to close icons :

{12}

SetCtlValue(GetCtlValue(theOpenControl)-2);

or to deselect icons (such as a “trash”) :

{13}

SetCtlValue(GetCtlValue(theSelectedControl)-1);

• HiliteControl doesn’t change anything;

• SizeControl only moves the gravity center of the control;

• never use SetCtlMin and SetCtlMax;

• the other routines (MoveControl, SetCTitle, HideControl, ShowControl) work the way you might expect.

Example Listing

I give hereafter the listing of the ‘MDEF’ and the ‘CDEF’ resources in LightSpeed Pascal as well as a minimum shell program as an example of how to use the custom controls. I apologize for the roughness of its interface: no standard menus, no DA’s It shows at least the simplicity for the end programmer.

Future Extensions

A feature found in the Finder and that I didn’t implement is the ability of editing the title of the icon. It would probably need to define two parts in the control.

In some applications, pop-up menus change their title accordingly to the current choice. It could be possible here at the condition that the menu handle of the control is left unchanged, even though the title or the icon handle are changed.

At last, what would be “vachement classe” and truly up-to-date custom Mac programming is a color-hierarchical-pop-up-icon-user-menu !

Please send me a copy once you’ve written this marvel, or simply send me bug-reports and comments to:

Jean de Combret

Diadème Ingénierie

25, avenue de Constantine

38100 GRENOBLE

France

Listing 1: Control manager example

{**********************************************}
{ SPYING THE CONTROL MANAGER’S MESSAGES TO THE CDEF    }
{**********************************************}

{ Put this file in the project after MacPasLib and MacTraps. }
{ Don’t forget “Use resource file” in “Run options” of menu  }
{ This resource file may be empty, or may contain a copy of }
{ system file reources CDEF 0 and 1 }
{**********************************************}
PROGRAM Controls;
 CONST
 CDEFID = 1;{ 0 for button, 1 for scroll bar }

 TYPE
 CDEFcodeHdl = ^CDEFcodePtr;
 CDEFcodePtr = ^CDEFcodeRecord;
 CDEFcodeRecord = RECORD
 jump : integer;
 address : ProcPtr;
 END;
 VAR
 boundsRect, TextRect : rect;
 myControl, whichControl : ControlHandle;
 theEvent : eventRecord;
 thePoint : point;
 whichPart : integer;
 theWindow, whichWindow : WindowPtr;
 myFakeCDEF : CDEFcodeHdl;
 myFakeCDEFid : integer;
 CDEFProcHandle : handle;
 LABEL
 1, 2;

 FUNCTION DoCDEF (varCode : integer; theControl : ControlHandle; message 
: integer; param : longint; ProcHandle : handle) : longint;
 INLINE
{ CDEF relies on prepared default value of 0 as funct. result:}
 $42AF, $0010,   {CLR.L 10(A7)}

{ JSR to a procedure passed by handle as last argument }
 $205F, {MOVE.L (A7)+,A0}
 $2050, {MOVE.L (A0),A0}
 $4E90; {JSR (A0)}

 FUNCTION ControlProc (varCode : integer; theControl : ControlHandle; 
message : integer; param : longint) : longint;
 BEGIN
 writeln(‘     message= ‘, message, ‘param= ‘, param);
 ControlProc := DoCDEF(varCode, theControl, message, param, CDEFProcHandle);
 END;

BEGIN
{ create a intermediate CDEF resource : }
 myFakeCDEF := CDEFcodeHdl(NewHandle(sizeof(CDEFcodeRecord)));
 IF MemError <> NoErr THEN
 GOTO 2;
 myFakeCDEF^^.jump := $4EF9;
 myFakeCDEF^^.address := @ControlProc;

 REPEAT
 myFakeCDEFid := UniqueID(‘CDEF’);
{ in order to have 16*myFakeCDEFid < maxint : }
 UNTIL myFakeCDEFid < 1000;

 AddResource(handle(myFakeCDEF), ‘CDEF’, myFakeCDEFid, ‘’);
 IF ResError <> NoErr THEN
 GOTO 2;

 SetRect(TextRect, 250, 40, 500, 330);
 SetTextRect(TextRect);
 ShowText;
 SetRect(boundsRect, 40, 40, 200, 200);
 theWindow := NewWindow(NIL, boundsrect, ‘my window’, true, 0, pointer(-1), 
false, 0);
 SetPort(theWindow);
 CDEFProcHandle := GetResource(‘CDEF’, CDEFID);
 IF ResError <> NoErr THEN
 GOTO 1;
 HLock(CDEFProcHandle);
 IF MemError <> NoErr THEN
 GOTO 1;
 SetRect(boundsRect, 10, 10, 90, 26);

{ now we begin to test the Control Manager’s routines : }

writeln(‘NewControl : ‘);
myControl := NewControl(thePort, boundsRect, ‘my control’, true, 0, 0, 
48, myFakeCDEFid * 16, 0);
SetCtlAction(myControl, pointer(-1));
writeln(‘SetCTitle : ‘); SetCTitle(myControl, ‘new name’);
writeln(‘HideControl : ‘); HideControl(myControl);
writeln(‘ShowControl : ‘); ShowControl(myControl);
writeln(‘HiliteControl : ‘); HiliteControl(myControl, 1);
writeln(‘HiliteControl : ‘); HiliteControl(myControl, 255);
writeln(‘HiliteControl : ‘); HiliteControl(myControl, 0);

writeln(‘SetCtlValue : ‘); SetCtlValue(myControl, 1);
writeln(‘SetCtlMax : ‘); SetCtlMax(myControl, 0);
writeln(‘SetCtlMax : ‘); SetCtlMax(myControl, 1);
writeln(‘SetCtlMin : ‘); SetCtlMin(myControl, 1);
writeln(‘SetCtlMin : ‘); SetCtlMin(myControl, 0);
writeln(‘SetCtlValue : ‘); SetCtlValue(myControl, 0);

writeln(‘MoveControl : ‘); MoveControl(myControl, 20, 20);
writeln(‘SizeControl : ‘); SizeControl(myControl, 100, 30);

{ let’s have loop to test “TrackControl” and “FindControl”: }
writeln(‘The user should try actions on the control.’);
writeln(‘End by clicking outside the control.’);
FlushEvents(EveryEvent, 0); InitCursor;
 REPEAT
 REPEAT
 UNTIL GetNextEvent(MDownMask, theEvent);
 thePoint := theEvent.where;
 whichPart := FindWindow(thePoint, whichWindow);
 SetPort(whichWindow); GlobalToLocal(thePoint);
 writeln(‘FindControl : ‘);
 whichPart := 
 FindControl(thePoint, whichWindow, whichControl);
 IF whichControl <> NIL THEN
 BEGIN
 writeln(‘TrackControl : ‘);
 whichPart := 
 TrackControl(whichControl, thePoint, pointer(-1));
 END;
 UNTIL whichControl = NIL;

 FlushEvents(MUpMask, 0);
{ let’s have another loop to test “DragControl” (and “FindControl”) : 
}
 writeln(‘The user should try to drag the control.’);
 writeln(‘End by clicking outside the control.’);
 REPEAT
 REPEAT
 UNTIL GetNextEvent(MDownMask, theEvent);
 thePoint := theEvent.where;
 whichPart := FindWindow(thePoint, whichWindow);
 SetPort(whichWindow); GlobalToLocal(thePoint);
 writeln(‘FindControl : ‘);
 whichPart := 
 FindControl(thePoint, whichWindow, whichControl);
 IF whichControl <> NIL THEN
 WITH whichWindow^ DO
 BEGIN
 writeln(‘DragControl : ‘);
 DragControl(whichControl, thePoint, PortRect, PortRect, noConstraint);
 END;
 UNTIL whichControl = NIL;
 writeln(‘DisposControl : ‘); DisposeControl(myControl);
 writeln(‘end’);

1 :
{ let’s remove our fake CDEF : }
 RmveResource(handle(myFakeCDEF));
 IF ResError <> NoErr THEN
 GOTO 2;
 DisposHandle(handle(myFakeCDEF));

{ error label : }
2 :
END.

{**********************************************}
{   BUILDING THE MDEF CODE RESOURCE       }
{**********************************************}
{ Put this file in the MPOP Project after DAPasLib. }
{ Don’t put MacTraps that would generate unusefull glue for the Memory 
Manager. }
{ I prefer to declare DisposHandle as inline procedure : see below. }
{ Don’t forget to “Use resource file” in “Run options” of menu “Project”. 
}
{ This resource file must contain the MENU and ICN# resources}
{ that the PopTrap Project needs together with the compiled MDEF resource. 
}

{ “Build and save as ” resource code of type MDEF and ID 128 in file 
“MPOP code” }
{**********************************************}
UNIT MPOP;

INTERFACE
{ the name “Main” indicates to LightSpeed Pascal compiler where the entry 
point is }
 PROCEDURE Main (message : integer; theMenu : MenuHandle; VAR menuRect 
: rect; hitPt : point; VAR whichItem : integer);

IMPLEMENTATION
 CONST
 mPopUpMsg = 3;
{ and not 4 as written in early versions of new MenuMgr }

 PROCEDURE CopyMask (srcBits, maskBits, dstBits : BitMap; srcRect, maskRect, 
dstRect : Rect);
 INLINE $A817;

 PROCEDURE DisposHandle (h : handle);
{ to avoid putting the whole Memory Manager glue in our code resource 
 }
 INLINE $205F, $A023, $31C0, $0220;

{***************************************}
{ first some utilities for reading MENU resources : }

 FUNCTION GetNextByte (VAR LongAddress : longint) : byte;
 INLINE
 $205F, { MOVEA.L    (A7)+,A0 }
 $2250, { MOVEA.L    (A0),A1  }
 $5290, { ADDQ.L     #$1,(A0) }
 $204F, { MOVEA.L    A7,A0  }
 $4218, { CLR.B      (A0)+  }
 $1091; { MOVE.B     (A1),(A0)   }

 FUNCTION GetNextInteger (VAR LongAddress : longint) : integer;
 INLINE
 $205F, { MOVEA.L    (A7)+,A0 }
 $2250, { MOVEA.L    (A0),A1  }
 $5490, { ADDQ.L     #$2,(A0) }
 $204F, { MOVEA.L   A7,A0 }
 $10D9, { MOVE.B     (A1)+,(A0)+ }
 $1091; { MOVE.B     (A1),(A0)     }

 FUNCTION GetNextString (VAR LongAddress : longint) : StringHandle;
{ returns NIL if allocation failed }
 INLINE
$205F, { MOVEA.L    (A7)+,A0;A0:=@LongAddress }
$2250, { MOVEA.L    (A0),A1 ;A1:=LongAddress }
$7000, { MOVEQ      #$00,D0 ;countChars:=0 }
$1011, { MOVE.B  (A1),D0 ;countChars:=LongAddress^ }
$2200, { MOVE.L     D0,D1 ;save countChars }
$5200, { ADDQ.B     #$1,D0;length:=countChars+1 }
$D190, { ADD.L      D0,(A0) 
 ;FuturLongAddress:=LongAddress+length }
$A122, { OSTRAP     $A122 ;A0:=NewHandle(D0=length) }
$4A80, { TST.L      D0    ;if MemError }
$660C, { BNE.S      *+$000E ;<>0 goto error }
$2E88, { MOVE.L     A0,(A7) ;GetChaine:=A0 }
$2050, { MOVEA.L    (A0),A0 ;StringPtr }
  { loop;repeat }
$10D9, { MOVE.B     (A1)+,(A0)+  
 ;StringPtr^:=LongAddress^ }
$51C9, $FFFC, { DBF        D1,*-$0002
 ;dec(length); until length<0 }
$6002, { BRA.S      *+$0004 ;goto bottom }
  { error }
$4297; { CLR.L      (A7)  ;GetChaine:=NIL }
  { bottom }

FUNCTION SkipNextString (VAR LongAddress : longint) : byte;
VARlength : byte;
 BEGIN
 length := GetNextByte(LongAddress);
 LongAddress := LongAddress + length;
 SkipNextString := length;
 END;

 PROCEDURE SkipBytes (VAR LongAddress : longint;
 byteCount : integer);
 BEGIN
 LongAddress := LongAddress + byteCount;
 END;

{***************************************}
 PROCEDURE Main;

 FUNCTION GetItemCenter : point;
{ returns the ItemCenter in local coordinates, relative to menuRect }
{ theMenu is already locked }
 VAR
 LongAddress : longint;
 length : byte;
 i : integer;
 ItemCenter : point;
 BEGIN
 LongAddress := ord(theMenu^) + 14;
 length := SkipNextString(LongAddress);
 i := 0;
 REPEAT
 i := i + 1;
 length := SkipNextString(LongAddress);
 IF length > 0 THEN
 BEGIN
 IF i = whichItem THEN
 BEGIN
 ItemCenter.v := GetNextInteger(LongAddress);
 ItemCenter.h := GetNextInteger(LongAddress);
 END
 ELSE
 BEGIN
 SkipBytes(LongAddress, 4);
 END;
 END
 ELSE   { if length<=0 : }
 SetPt(ItemCenter, 0, 0);
 UNTIL (length <= 0) OR (i = whichItem);
 GetItemCenter := ItemCenter;
 END;

{***************************************}
 PROCEDURE DoDrawMessage;

 PROCEDURE PinString (theString : Str255;
 center : point);
 BEGIN
 WITH center DO
 MoveTo(h - StringWidth(theString) DIV 2, v);
 DrawString(theString);
 END;

 PROCEDURE PlotIconDataCopy 
 (theIcon : handle; dstSquare : rect);
 VAR
 srcSquare : rect;
 data : bitmap;
 myPort : GrafPtr;
 BEGIN
 IF (theIcon <> NIL) THEN
 BEGIN
 SetRect(srcSquare, -16, -16, 16, 16);
 data.rowBytes := 4;
 data.baseAddr := ptr(theIcon^);
 data.bounds := srcSquare;
 GetPort(myPort);
 CopyBits(data, myPort^.portbits, srcSquare, dstSquare, srcCopy, NIL);
 END;
 END;

 VAR
 IconRect : rect; IconName : StringHandle;
 LongAddress : longint; NameLength : byte;
 ItemCenter, TextCenter : point;
 theIcon : handle;
 BEGIN
 LongAddress := ord(theMenu^) + 14;
 NameLength := SkipNextString(LongAddress);
 REPEAT
 IconName := GetNextString(LongAddress);
 NameLength := length(IconName^^);
 IF NameLength > 0 THEN
 BEGIN
 theIcon := GetNamedResource(‘ICN#’, IconName^^);
 ItemCenter.v := GetNextInteger(LongAddress) + menuRect.top;
 ItemCenter.h := GetNextInteger(LongAddress) + menuRect.left;
 WITH ItemCenter DO
 BEGIN
 SetRect(IconRect, h - 16, v - 21, h + 16, v + 11);
 SetPt(TextCenter, h, v + 20);
 END;
 PlotIconDataCopy(theIcon, IconRect);
 TextFont(geneva);
 TextSize(9);
 PinString(IconName^^, TextCenter);
 TextFont(systemFont);
 TextSize(12);
 END;
 DisposHandle(handle(IconName));
 UNTIL NameLength <= 0;
 END;   { of DoDrawMessage }

{***************************************}
 PROCEDURE DoChooseMessage;

 FUNCTION GetIconRect : rect;
{ returns the IconRect in global coordinates }
 VAR
 ItemCenter : point;
 IconRect : rect;
 BEGIN
 ItemCenter := GetItemCenter;
 WITH ItemCenter DO
 BEGIN
 IF (h = 0) AND (v = 0) THEN
 SetRect(IconRect, 0, 0, 0, 0)
 ELSE
 SetRect(IconRect, h - 16, v - 21, h + 16, v + 11);
 END;
 WITH menuRect DO
 OffSetRect(IconRect, left, top);
 GetIconRect := IconRect;
 END;   { of GetIconRect }

 PROCEDURE PlotIconMaskXor 
 (theIcon : handle; dstSquare : rect);
 VAR
 srcSquare : rect; mask : bitmap;
 myPort : GrafPtr;
 BEGIN
 IF (theIcon <> NIL) THEN
 BEGIN
 SetRect(srcSquare, -16, -16, 16, 16);
 mask.rowBytes := 4;
 mask.baseAddr := ptr(ord4(theIcon^) + 128);
 mask.bounds := srcSquare; GetPort(myPort);
 CopyBits(mask, myPort^.portbits, srcSquare, dstSquare, srcXOr, NIL);
 END;
 END;   { of PlotIconMaskXor }

 FUNCTION GetIconName (whichItem : integer) : StringHandle; { theMenu 
is already locked }
 VAR
 LongAddress : longint; length : byte;
 i : integer; IconName : StringHandle;
 BEGIN
 LongAddress := ord(theMenu^) + 14;
 length := SkipNextString(LongAddress);
 i := 0;
 REPEAT
 i := i + 1;
 IF i = whichItem THEN
 BEGIN
 IconName := GetNextString(LongAddress);
 END
 ELSE
 BEGIN
 length := SkipNextString(LongAddress);
 IF length > 0 THEN
 SkipBytes(LongAddress, 4)
 ELSE
 IconName := NIL;
 END;
 UNTIL (length <= 0) OR (i = whichItem);
 GetIconName := IconName;
 END;

 PROCEDURE InvertIcon 
 (whichItem : integer; dstSquare : rect);
 VAR
 IconName : StringHandle;
 myIcon : handle;
 BEGIN
 IconName := GetIconName(whichItem);
 myIcon := GetNamedResource(‘ICN#’, IconName^^);
 PlotIconMaskXor(myIcon, dstSquare);
 END;

 VAR
 itemNumber : integer; NameLength : byte;
 LongAddress : longint; ItemCenter : point;
 ItemRect, OldIconRect, IconRect : rect;
 BEGIN  { DoChooseMessage }
 LongAddress := ord(theMenu^) + 14;
 NameLength := SkipNextString(LongAddress);
 itemNumber := 0;
 REPEAT
 itemNumber := itemNumber + 1;
 NameLength := SkipNextString(LongAddress);
 IF NameLength > 0 THEN
 BEGIN
 ItemCenter.v := GetNextInteger(LongAddress);
 ItemCenter.h := GetNextInteger(LongAddress);
 WITH ItemCenter DO
 SetRect(ItemRect, h - 25, v - 25, h + 25, v + 25);
 WITH menuRect DO
 OffSetRect(ItemRect, left, top);
 END;
 UNTIL (NameLength <= 0) OR 
 (PtInRect(hitPt, ItemRect));
 IF NameLength <= 0 THEN  
 { hitPt is not in any item }
 BEGIN
 IF whichItem <> 0 THEN
 BEGIN
 InvertIcon(whichItem, GetIconRect);
 whichItem := 0;
 END;
 END
 ELSE IF itemNumber <> whichItem THEN
 { hitPt is in itemRect }
 BEGIN
 IF whichItem <> 0 THEN
 InvertIcon(whichItem, GetIconRect);
 WITH ItemCenter DO
 SetRect(IconRect, h - 16, v - 21, h + 16, v + 11);
 WITH MenuRect DO
 OffSetRect(IconRect, left, top);
 InvertIcon(itemNumber, IconRect);
 whichItem := itemNumber;
 END;
 END;   { of DoChooseMessage }

{***************************************}
 PROCEDURE DoSizeMessage;
{ theMenu is already locked }

 PROCEDURE RectAndPt (VAR theRect : rect;
 thePoint : point);
 BEGIN
 WITH theRect, thePoint DO
{ we suppose that 0=left<right and 0=top<bottom }
 BEGIN
 IF h > right THEN right := h;
 IF v > bottom THEN bottom := v;
 END;
 END;

 VAR
 LongAddress : longint; length : byte;
 ItemCenter : point; Envelope : rect;
 BEGIN
 LongAddress := ord(theMenu^) + 14;
 length := SkipNextString(LongAddress);
 SetRect(Envelope, 0, 0, 0, 0);
 REPEAT
 length := SkipNextString(LongAddress);
 IF length > 0 THEN
 BEGIN
 ItemCenter.v := GetNextInteger(LongAddress);
 ItemCenter.h := GetNextInteger(LongAddress);
 RectAndPt(envelope, ItemCenter);
 END
 UNTIL (length <= 0);
 WITH theMenu^^, envelope DO
 BEGIN
 menuWidth := right + 25;
 menuHeight := bottom + 25;
 END;
 END;   { of DoSizeMessage }

{***************************************}
 PROCEDURE DoPopUpMessage;
{ on entry: whichItem(=popUpItem) , }
{hitPt (= center of title icon) }
{theMenu (Locked) }
{ on exit : menuRect }
{ ThePort is allready set to WindowManager Port }
 VAR
 ItemCenter, IconCenter : point; dh, dv : integer;
 WMPort : GrafPtr; mBarHeight : ^integer;
 BEGIN
 mBarHeight := pointer($BAA);
 WITH theMenu^^, hitPt DO
SetRect(menuRect, h, v, h + menuWidth, v + MenuHeight);
 IF whichItem > 0 THEN
 BEGIN
 ItemCenter := GetItemCenter;
 WITH ItemCenter DO
 SetPt(IconCenter, h, v - 5);
 WITH IconCenter DO
 IF NOT ((h = 0) AND (v = 0)) THEN
 OffSetRect(menuRect, -h, -v)
 ELSE
 whichItem := 0;
 END;
 IF whichItem <= 0 THEN
 OffSetRect(menuRect, -25, +25);
 GetPort(WMPort);
 WITH WMPort^ DO
 BEGIN
 IF menuRect.right + 8 > PortRect.right THEN
 dh := PortRect.right - menuRect.right - 8
 ELSE IF menuRect.left - 8 < PortRect.left THEN
 dh := PortRect.left - menuRect.left + 8
 ELSE dh := 0;
 
 IF menuRect.bottom + 8 > PortRect.bottom
 THEN
 dv := PortRect.bottom - menuRect.bottom - 8
 ELSE IF 
 menuRect.top - 8 < PortRect.top + mBarHeight^
 THEN
 dv := PortRect.top + mBarHeight^ 
 - menuRect.top + 8
 ELSE dv := 0;
 END;
 OffSetRect(menuRect, dh, dv);
 END;   { of DoPopUpMessage }

{***************************************}
 BEGIN  { of Main }
 CASE message OF
 mSizeMsg :  DoSizeMessage;
 mDrawMsg :  DoDrawMessage;
 mChooseMsg :  DoChooseMessage;
 mPopUpMsg :  DoPopUpMessage;
 END;
 END;

END.
{**********************************************}
{  BUILDING THE CDEF CODE RESOURCE            }
{**********************************************}

{ Put this file in the CDEF Project after DAPasLib, MacTraps, ROM85lib 
and ROM85. }
{ Don’t forget to “Use resource file” in “Run options” of menu “Project”. 
}
{ This resource file must contain the WIND ,CNTL, MENU, ICN#, ICON, MDEF 
}
{ resources that the Shell Project needs together with the compiled CDEF 
resource. }
{ “Build and save as ” resource code of type CDEF and ID 128 in file 
“CDEF code” }
{**********************************************}
UNIT CDEF;
INTERFACE
 USES ROM85;

 FUNCTION Main (varCode : integer;
 theControl : ControlHandle; message : integer;
 param : longint) : longint;
IMPLEMENTATION
 CONST
 RestState = 0; SelectState = 1; OpenState = 2;
 SelectOpenState = 3; ThrownAwayState = 4;
 MenuReturnState = 5;

 movableBit = 1; doubleClickableBit = 2;
 trashBit = 3; menuBit = 4;
 varCodeBase = 200;
 { bit-offset of end of varCode in ControlRecord }
 integerLength = 16;
 TYPE
 DataHandle = ^DataPointer;
 DataPointer = ^DataRecord;
 DataRecord = RECORD
 theIcon : handle;
 theMenu : MenuHandle;
 END;

 FUNCTION PopUpMenuSelect (menu : MenuHandle;
 top, left, popUpItem : integer) : longint;
 INLINE
 $A80B;

 PROCEDURE PlotDoubleIcon (theIcon : handle;
 State : integer; dstSquare : rect);
 VAR
 srcSquare : rect;
 data, mask, destBitMap, scratchBitMap : bitmap;
 theGrafPort : GrafPtr;
 LightGrayIcon, DarkGrayIcon : handle;
 BEGIN
 IF (theIcon <> NIL) THEN
 BEGIN
 SetRect(srcSquare, -16, -16, 16, 16);

 data.rowBytes := 4;
 data.baseAddr := ptr(theIcon^);
 data.bounds := srcSquare;

 mask.rowBytes := 4;
 mask.baseAddr := ptr(ord4(theIcon^) + 128);
 mask.bounds := srcSquare;

 GetPort(theGrafPort);
 destBitMap := theGrafPort^.portbits;
 CASE state OF
 RestState : 
 BEGIN
 CopyBits(mask, destBitMap, srcSquare, dstSquare, srcBic, NIL);
 CopyBits(data, destBitMap, srcSquare, dstSquare, srcOr, NIL);
 END;
 SelectState : 
 BEGIN
{ old finder : }
 CopyBits(mask, destBitMap, srcSquare, dstSquare, srcBic, NIL);
 CopyBits(data, destBitMap, srcSquare, dstSquare, srcOr, NIL);
 CopyBits(mask, destBitMap, srcSquare, dstSquare, srcXOr, NIL);
{ new finder would be : }
{CopyBits(mask, destBitMap, srcSquare, dstSquare, srcOr, nil);}
{CopyBits(data, destBitMap, srcSquare, dstSquare, srcBic, nil);}
 END;
 OpenState : 
 BEGIN
 WITH scratchBitMap DO
 BEGIN
 LightGrayIcon := GetIcon(128);
 BaseAddr := LightGrayIcon^;
 bounds := srcSquare;
 Rowbytes := 4;
 END;
 CopyBits(mask, destBitMap, srcSquare, dstSquare, srcBic, NIL);
 CopyMask(scratchBitMap, mask, destBitMap, srcSquare, srcSquare, dstSquare);
 END;
 SelectOpenState : 
 BEGIN
 WITH scratchBitMap DO
 BEGIN
 DarkGrayIcon := GetIcon(129);
 BaseAddr := DarkGrayIcon^;
 bounds := srcSquare;
 Rowbytes := 4;
 END;
 CopyBits(mask, destBitMap, srcSquare, dstSquare, srcBic, NIL);
 CopyMask(scratchBitMap, mask, destBitMap, srcSquare, srcSquare, dstSquare);
 END;
 OTHERWISE
 END;
 END
 END;   { of PlotDoubleIcon }

{ ***************************************************** }
 FUNCTION distance (startPt, endPt : point) : integer;
 BEGIN
 distance := abs(startPt.h - endPt.h) + abs(startPt.v - endPt.v);
 END;

 FUNCTION InsideIcon (myPoint : point;
 IconCenter : point;
 myIcon : handle) : boolean;
 VAR
 bitOffset : longint;
 scratchMap, dataMap, maskMap, sensitiveMap : bitmap;
 square : rect;
 x, y : integer;
 LABEL
 1;
 BEGIN
 HLock(myIcon);
 SetRect(square, 0, 0, 32, 32);
 WITH scratchMap DO
 BEGIN
 bounds := square;
 BaseAddr := NewPtr(128);
 IF MemError <> NoErr THEN
 GOTO 1;
 RowBytes := 4;
 END;
 WITH sensitiveMap DO
 BEGIN
 bounds := square;
 BaseAddr := NewPtr(128);
 IF MemError <> NoErr THEN
 GOTO 1;
 RowBytes := 4;
 END;
 WITH dataMap DO
 BEGIN
 bounds := square;
 BaseAddr := myIcon^;
 RowBytes := 4;
 END;
 WITH maskMap DO
 BEGIN
 bounds := square;
 BaseAddr := Ptr(ord4(myIcon^) + 128);
 RowBytes := 4;
 END;
 CopyBits(maskMap, scratchMap, square, square, srcCopy, NIL);
 CopyBits(dataMap, scratchMap, square, square, srcOr, NIL);
 CalcMask(scratchMap.baseAddr, sensitiveMap.baseAddr, 4, 4, 32, 2);
 x := myPoint.h - IconCenter.h + 16;
 y := myPoint.v - IconCenter.v + 16;
 IF NOT ((x IN [0..31]) AND (y IN [0..31])) THEN
 InsideIcon := false
 ELSE
 BEGIN
 bitOffset := x + 32 * y;
 InsideIcon := BitTst(sensitiveMap.baseAddr, bitOffset);
 END;
 HUnLock(myIcon);
 DisposPtr(scratchMap.baseAddr);
 DisposPtr(sensitiveMap.baseAddr);
1 :
 IF MemError <> NoErr THEN
 InsideIcon := false;
 END;

 FUNCTION DoubleClick (theControl : ControlHandle;
 startPt : point; startTime : longint; VarCode : integer;
 bounds : rect; VAR IconCenter : point) : boolean;
 VAR
 mouse : point; t : longint; d : integer;
 theEvent : EventRecord; DoubleClicked : boolean;

 PROCEDURE DragSquare (startPt : point;
 VAR IconCenter : point);
 VAR
 oldFrame, frame, bounds : rect;
 delta, mouse : point; theGrafPort : GrafPtr;
 grayPattern : pattern; theTrash : ControlHandle;

 PROCEDURE HighLightTrash (mouse : point);
 VAR
 where : integer; IconCenter : point;
 OverFlownControl : ControlHandle;
 BEGIN
 where := FindControl(mouse, FrontWindow,  OverFlownControl);
 HLock(GetResource(‘CDEF’, 128));
 FrameRect(oldFrame);
 IF theTrash <> OverFlownControl THEN
{ the control the mouse overflyes is no more “theTrash” }
 BEGIN
 IF theTrash <> NIL THEN
{ the mouse has ended overflying a trash }
 BEGIN
 SetCtlValue(theTrash, GetCtlValue(theTrash) - 1);
 HLock(theTrash^^.ContrlDefProc);
 END;
 IF (OverFlownControl <> NIL) THEN
 IF BitTst(pointer(OverFlownControl^), 
 varCodeBase - trashBit) AND 
 (theControl <> OverFlownControl) 
 THEN
 { the mouse begins overflying a trash }
 BEGIN
 SetCtlValue(OverFlownControl,
   GetCtlValue(OverFlownControl) + 1);
 HLock(OverFlownControl^^.ContrlDefProc);
 theTrash := OverFlownControl;
 END
 ELSE
{ the mouse overflies something else than a trash }
 theTrash := NIL
 ELSE
{ the mouse doesn’t overfly anything }
 theTrash := NIL;
 END;
 END;

 BEGIN  { DragSquare }
 theTrash := NIL;
 StuffHex(@grayPattern, ’55AA55AA55AA55AA’);
 GetPort(theGrafPort);
 bounds := theGrafPort^.PortRect;
 InSetRect(bounds, 16, 16);
 delta := IconCenter;
 SubPt(startPt, delta);
 PenMode(PatXor);
 WITH IconCenter DO
 SetRect(oldFrame, h - 16, v - 16, h + 16, v + 16);
 PenPat(grayPattern);
 FrameRect(oldFrame);
{ instead of the surrounding square }
{ we could also drag the icon’s data or mask frame }
 REPEAT
 GetMouse(mouse); IconCenter := mouse;
 AddPt(delta, IconCenter);
 WITH IconCenter, bounds DO
 BEGIN
 IF h < left THEN h := left;
 IF h > right - 1 THEN h := right - 1;
 IF v < top THEN v := top;
 IF v > bottom - 1 THEN v := bottom - 1;
 END;
 WITH IconCenter DO
 SetRect(frame, h - 16, v - 16, h + 16, v + 16);
 IF NOT EqualRect(oldFrame, frame) THEN
 BEGIN
 HighLightTrash(mouse);
 FrameRect(frame); oldFrame := frame;
 END;
 UNTIL NOT WaitMouseUp;
 FrameRect(frame); PenNormal;
 END;

 BEGIN  { DoubleClick }
 DoubleClicked := false;
 BEGIN
{ if doubleClickable or movable : }
 IF (BitTst(@varCode,
 integerLength - doubleClickableBit)) OR 
 (BitTst(@varCode, integerLength - movableBit)) THEN
 REPEAT
 GetMouse(mouse);
 d := distance(startPt, mouse);
 UNTIL (NOT WaitMouseUp OR (d > 3));
 IF (d > 3) AND BitTst(@varCode, integerLength - movableBit) THEN
 DragSquare(startPt, IconCenter)
 ELSE IF BitTst(@varCode, 
 integerLength - doubleClickableBit) THEN
 REPEAT
 GetMouse(mouse);
 d := distance(startPt, mouse);
 t := TickCount - startTime;
 IF GetNextEvent(MDownMask, theEvent) THEN
 DoubleClicked := true;
 UNTIL DoubleClicked OR (d > 3) OR (t > GetDblTime);
 DoubleClick := DoubleClicked;
 END;
 END;

{ ***************************************************** }
 FUNCTION Main;
 VAR
{ color under the title : }
 whitePattern : pattern;

 PROCEDURE DoDrawCntl;
 VAR
 IconCenter, TextCenter : point;
 State, theLength, theHalfLength : integer;
 TextFrame, IconFrame : rect;
 myDataHandle : DataHandle;
 BEGIN
 State := GetCtlValue(theControl);
{ MenuReturnState is drawn like RestState, ThrownAwayState is not re-drawn 
: }
 IF State = MenuReturnState THEN
 State := RestState;
 IF ((State IN [RestState..SelectOpenState]) AND (theControl^^.ContrlVis 
<> 0)) THEN
 BEGIN
 HLock(handle(theControl));
 WITH theControl^^ DO
 BEGIN
 TextFont(geneva); TextFace([]);
 TextMode(SrcOr); TextSize(9);
 theLength := StringWidth(contrlTitle);
 IF theLength < 32 THEN
 theHalfLength := 16
 ELSE
 theHalfLength := theLength DIV 2;
 WITH ContrlRect DO
 SetPt(IconCenter, (right + left) DIV 2,
  (bottom - 12 + top) DIV 2);
{ recalculate the rect surrounding the whole control : }
 WITH IconCenter, ContrlRect DO
 BEGIN
 left := h - theHalfLength; top := v - 16;
 right := h + theHalfLength; bottom := v + 16 + 12;
 END;

 WITH IconCenter, IconFrame DO
 BEGIN
 left := h - 16; top := v - 16;
 right := h + 16; bottom := v + 16;
 END;

 { draw the icon-control’s title : }
 WITH IconCenter DO
 SetPt(TextCenter, h, v + 26);
 WITH TextCenter DO
 SetRect(TextFrame, h - theLength DIV 2, 
 v - 10, h + theLength DIV 2, v + 2);
 StuffHex(@whitePattern, ‘0000000000000000’);
 FillRect(TextFrame, whitePattern);
 WITH TextCenter DO
 MoveTo(h - theLength DIV 2, v);
 DrawString(contrlTitle);
 { draw the icon : }
 myDataHandle := DataHandle(ContrlData);
 HLock(myDataHandle^^.theIcon);
 PlotDoubleIcon
 (myDataHandle^^.theIcon, State, IconFrame);
 HUnLock(myDataHandle^^.theIcon);
 END;
 HUnLock(handle(theControl));
 END;
 Main := 0;
 END;

 PROCEDURE DoTestCntl;
 VAR
 IconCenter, mouse : point;
 myDataHandle : DataHandle;
 BEGIN
 HLock(handle(theControl));
 WITH theControl^^ DO
 BEGIN
 SetPt(mouse, LoWord(param), HiWord(param));
 IF PtInRect(mouse, ContrlRect) THEN
 BEGIN
 WITH ContrlRect DO
 SetPt(IconCenter, (right + left) DIV 2,
  (bottom - 12 + top) DIV 2);
 myDataHandle := DataHandle(ContrlData);
 Main := ord4(InsideIcon(mouse, IconCenter,
  myDataHandle^^.theIcon));
 END
 ELSE
 main := 0;
 END;
 HUnLock(handle(theControl));
 END;

 PROCEDURE DoCalcCRgns;
 CONST
 Lo3Bytes = $00FFFFFF;
 VAR
 IconFrame, TextFrame : rect; theTitle : Str255;
 theLength, theHalfLength, halfWay : integer;
 BEGIN
 GetCTitle(theControl, theTitle);
 theLength := StringWidth(theTitle);
 theHalfLength := theLength DIV 2;
 param := BitAnd(param, Lo3Bytes);
 IconFrame := theControl^^.ContrlRect;
 WITH IconFrame DO
 BEGIN
 bottom := bottom - 12; halfWay := (right + left) DIV 2;
 left := halfWay - 16; right := halfWay + 16;
 SetRect(TextFrame, halfWay - theHalfLength,
  bottom, halfWay + theHalfLength, bottom + 12);
 END;
 OpenRgn;
 FrameRect(IconFrame); FrameRect(TextFrame);
 CloseRgn(RgnHandle(param));
 Main := 0;
 END;

 PROCEDURE DeselectExcept 
 (theControl : ControlHandle);
 VAR
 myWindowPeek : WindowPeek;
 aControl : ControlHandle;
 BEGIN
 myWindowPeek :=
 WindowPeek(theControl^^.ContrlOwner);
 aControl := myWindowPeek^.ControlList;
 WHILE aControl <> NIL DO
 BEGIN
 IF (aControl <> theControl) THEN
 BEGIN
 IF (GetCtlValue(aControl) = 1) THEN
 BEGIN
 SetCtlValue(aControl, 0);
 HLock(aControl^^.ContrlDefProc);
 END
 ELSE IF 
 (GetCtlValue(aControl) = 3) THEN
 BEGIN
 SetCtlValue(aControl, 2);
 HLock(aControl^^.ContrlDefProc);
 END
 END;
 aControl := aControl^^.nextControl;
 END;
 END;

 PROCEDURE DoAutoTrack;
 VAR
 SavedClip, UpDateRegion : RgnHandle;
 PopUpMenuHdl : MenuHandle;
 {MDEFPtr : Ptr;{ for debugging only }
 theTitle : Str255;
 choosenItem, dummy : longint;
 halfWay, theHalfLength, where : integer;
 oldCenter, IconCenter, mouse, MenuTitleCenter : point;
 theGrafPort : GrafPtr;
 theTrash : ControlHandle;
 myDataHandle : DataHandle;
 isAMenu, isDoubleClickable, isMovable : boolean;
 BEGIN
 isAMenu := BitTst(@varCode, integerLength - MenuBit);
 isDoubleClickable := BitTst(@varCode, integerLength - DoubleClickableBit);
 isMovable := BitTst(@varCode, integerLength - MovableBit);
 IF isAMenu OR isDoubleClickable OR isMovable THEN
 BEGIN
 IF GetCtlValue(theControl) = OpenState THEN
 SetCtlValue(theControl, SelectOpenState)
 ELSE IF GetCtlValue(theControl) = RestState
   THEN SetCtlValue(theControl, SelectState);
 HLock(theControl^^.ContrlDefProc);
 END;
 DeselectExcept(theControl);
 GetMouse(mouse);
 WITH theControl^^.ContrlRect DO
 SetPt(IconCenter, (right + left) DIV 2,
  (bottom - 12 + top) DIV 2);
 oldCenter := IconCenter; GetPort(theGrafPort);

{ 1° : DOUBLE-CLICK }
 IF DoubleClick(theControl, mouse, TickCount, varCode, theGrafPort^.PortRect, 
IconCenter) THEN
 BEGIN
 SetCtlValue(theControl, SelectOpenState);
 HLock(theControl^^.ContrlDefProc);
 END

{ 2° : NO DRAGGING }
 ELSE IF EqualPt(oldCenter, IconCenter) THEN
 BEGIN

{ 2.1 : POPUPMENU }
 IF isAMenu THEN
 BEGIN
 myDataHandle := DataHandle(theControl^^.ContrlData);
 PopUpMenuHdl := myDataHandle^^.theMenu;

 WITH theControl^^.ContrlRect, MenuTitleCenter DO
 BEGIN 
 h := (left + right) DIV 2; 
 v := (top + bottom) DIV 2; 
 END;
 LocalToGlobal(MenuTitleCenter);
 WITH MenuTitleCenter DO
 choosenItem := PopUpMenuSelect(PopUpMenuHdl, h, v, 0);
 { re-draw the control as in RestState : }
 SetCtlValue(theControl, MenuReturnState);
 HLock(theControl^^.ContrlDefProc);
 SetCRefCon(theControl, choosenItem);
 END

{ 2.2 : SIMPLE SELECTION OF A DOUBLE-CLICKABLE CONTROL }
{ the Control is already highlighted in the “SelectState” }
 END

{ 3° : DRAGGING }
 ELSE
 BEGIN
 GetMouse(mouse);
 where := FindControl(mouse, FrontWindow, theTrash);
 HLock(GetResource(‘CDEF’, 128));
 IF (theTrash <> NIL) THEN

{ 3.1 : THROWING THE CONTROL AWAY IN A TRASH }
 IF BitTst(pointer(theTrash^),
  varCodeBase - trashBit) 
 AND (theTrash <> theControl)
  THEN
 BEGIN
 { return “theTrash” in CRefCon }
 { without re-drawing it }
 SetCRefCon(theControl, ord(theTrash));
 SetCtlValue(theControl, ThrownAwayState);
 HLock(theControl^^.ContrlDefProc);
 END;
{ 3.2 : MOVING }
 IF (GetCtlValue(theControl) <>
 ThrownAwayState) THEN
 BEGIN
 WITH theControl^^.ContrlRect DO
 theHalfLength := (right - left) DIV 2;
 { move the control without showing it : }
 HideControl(theControl);
 HLock(theControl^^.ContrlDefProc);
 WITH IconCenter DO
 MoveControl(theControl, 
 h - theHalfLength, v - 16);
 HLock(theControl^^.ContrlDefProc);
 theControl^^.ContrlValue := RestState;

{ the UpDate mechanism will do the re-drawing in such a way it lets the 
previously hidden controls appear : }

 SavedClip := NewRgn;
 GetClip(SavedClip);
 SetEmptyRgn(theGrafPort^.ClipRgn);
 ShowControl(theControl);
 HLock(theControl^^.ContrlDefProc);
 SetClip(SavedClip);
 { re-use an initialised region for another purpose : }
 UpDateRegion := SavedClip;
 { send the CalCRgns message to calculate UpDateRegion : }
 dummy := Main(0, theControl,
   calcCRgns, ord4(UpDateRegion));
 EraseRgn(UpDateRegion);
 InValRgn(UpDateRegion);
 DisposeRgn(UpDateRegion);
 END;
 END;
 Main := 0;
 END;

 PROCEDURE DoInitCntl;
 VAR
 myDataHandle : DataHandle;
 theTitle : Str255;
 BEGIN
 GetCTitle(theControl, theTitle);
 myDataHandle := DataHandle(NewHandle(sizeof(DataRecord)));
 HLock(handle(myDataHandle));
 WITH myDataHandle^^ DO
 BEGIN
 theIcon := GetNamedResource(‘ICN#’, theTitle);
 { Initialisation should have called “GetMenu” : }
 theMenu := MenuHandle(GetNamedResource(‘MENU’, theTitle));
 END;
 HUnLock(handle(myDataHandle));
 WITH theControl^^ DO
 BEGIN
 ContrlAction := pointer(-1);
 ContrlData := handle(myDataHandle);
 END;
 END;

 PROCEDURE DoDispCntl;
 BEGIN
 DisposHandle(theControl^^.ContrlData);
 END;

 BEGIN  { Main procedure }
 CASE message OF
 drawCntl : DoDrawCntl;
 testCntl :  DoTestCntl;
 calcCRgns :  DoCalcCRgns;
 initCntl :  DoInitCntl;
 dispCntl :  DoDispCntl;
 dragCntl : { for a smoother interface }
 BEGIN
 DoAutoTrack;
 Main := 1;  { to tell the Control Manager not to use the standard method 
}
 END;
 autoTrack : DoAutoTrack;
 OTHERWISE { dragCntl, posCntl , thumbCntl }
 main := 0;
 END;
 END;
END.

{*********************************************}
{ SEE HOW SIMPLE IT IS FOR THE END-PROGRAMMER }
{      TO CREATE AND USE FINDER-LIKE ICONS!   }
{*********************************************}
{ Put this file in the Shell Project after DAPasLib, MacTraps, ROM85lib 
and ROM85, put also CDEF text if you plan to improve and debug it. Don’t 
forget to “Use resource file” “CDEF Code” in “Run options”  of menu “Project”. 
This resource file must contain the WIND ,CNTL, MENU, ICN#, ICON, MDEF 
and CDEF resource. }
{**********************************************}
PROGRAM shell;
 USES ROM85;
 {    , CDEFIcones; { only for debugging purposes }
 CONST
 RestState = 0; SelectState = 1; OpenState = 2;
 SelectOpenState = 3; ThrownAwayState = 4;
 MenuReturnState = 5;
 TYPE
 CDEFcodeHdl = ^CDEFcodePtr;
 CDEFcodePtr = ^CDEFcodeRecord;
 CDEFcodeRecord = RECORD
 jump : integer;
 address : ProcPtr;
 END;
 VAR
 whichWindow, myWindow : WindowPtr;
 whichControl, theTrash : ControlHandle;
 myCDEF : CDEFcodeHdl; theEvent : EventRecord;
 theControl : ControlHandle; mouse : point;
 FakeRect : rect; done : boolean; i : integer;

 PROCEDURE ProcessMenu (where : longint);
 VAR
 MenuNb, ItemNb : integer; dummy : longint;
 i : integer;
 BEGIN
 MenuNb := HiWord(where);
 ItemNb := LoWord(where);
 CASE MenuNb OF
 1 : 
 FOR i := 1 TO ItemNb DO
 BEGIN
 SysBeep(5);
 Delay(10, dummy);
 END;
 OTHERWISE
 ;
 END;
 END;

 PROCEDURE ProcessEvent;
 VAR
 myWindowPeek : WindowPeek;
 dummy : integer;
 BEGIN
 CASE theEvent.what OF
 UpDateEvt : 
 BEGIN
 whichWindow := WindowPtr(theEvent.message);
 beginUpDate(whichWindow);
 IF whichWindow = myWindow THEN
 BEGIN
 EraseRgn(myWindow^.VisRgn);
 UpdtControl(myWindow, myWindow^.VisRgn);
 END;
 endUpDate(whichWindow);
 END;
 MouseDown : 
 BEGIN
 CASE FindWindow(theEvent.where, whichWindow) OF
 inContent : 
 BEGIN  
 mouse := theEvent.where;
 GlobalToLocal(mouse);
 IF FindControl(mouse, whichWindow,whichControl) <> 0 THEN
 BEGIN
 { choose DragControl or TrackControl as you prefer: }
 { dummy:=TrackControl(theControl,mouse,pointer(-1)) }
 SetRect(FakeRect, 0, 0, 0, 0);
 DragControl(whichControl, mouse, FakeRect, FakeRect, noConstraint);
 IF GetCtlValue(whichControl) = ThrownAwayState THEN
 BEGIN
 theTrash := ControlHandle(GetCRefCon(whichControl));
 SetCtlValue(theTrash, GetCtlValue(theTrash) - 1);
 DisposeControl(whichControl);
 END
 ELSE IF GetCtlValue(whichControl) = MenuReturnState THEN
 BEGIN
 ProcessMenu(GetCRefCon(whichControl));
 { the Control has already been re-drawn in RestState, }
 { so we don’t need to re-redraw it again.}
 whichControl^^.ContrlValue := 0;
 END
 ELSE IF GetCtlValue(whichControl) = SelectOpenState THEN
 BEGIN
 dummy := NoteAlert(128, NIL);
 SetCtlValue(whichControl, RestState);
 END
 ELSE   
 ;
 END;
 END;
 inGoAway : 
 IF TrackGoAway(whichWindow, theEvent.where)
 THEN done := true;
 inDrag : 
 DragWindow(whichWindow, theEvent.where, ScreenBits.bounds);
 OTHERWISE
 ;
 END;
 END;
 OTHERWISE
 ;
 END;
 END;

BEGIN
{ create a intermediate CDEF resource : }
{myCDEF := CDEFcodeHdl(NewHandle(sizeof(CDEFcodeRecord)));     { for 
debugging only }
{myCDEF^^.jump := $4EF9;  { for debugging only }
{myCDEF^^.address := @main; { for debugging only }

{AddResource(handle(myCDEF), ‘CDEF’, 128, ‘’); { for debugging only }

 myWindow := GetNewWindow(128, NIL, pointer(-1));
 SetPort(myWindow);
 {BackPat(gray); { or whatever background pattern you wish }
 InsertMenu(GetMenu(128), -1);
 FOR i := 128 TO 133 DO
 theControl := GetNewControl(i, myWindow);
 done := false;
 SetCursor(arrow);
 FlushEvents(EveryEvent, 0);
 ShowWindow(myWindow);
 REPEAT
 IF GetNextEvent(EveryEvent, theEvent) THEN
 ProcessEvent;
 UNTIL done;
 DisposeWindow(myWindow);
{RmveResource(handle(myCDEF));{ for debugging only }
{DisposHandle(handle(myCDEF));{ for debugging only }
END.

 

Community Search:
MacTech Search:

Software Updates via MacUpdate

Latest Forum Discussions

See All

Tokkun Studio unveils alpha trailer for...
We are back on the MMORPG news train, and this time it comes from the sort of international developers Tokkun Studio. They are based in France and Japan, so it counts. Anyway, semantics aside, they have released an alpha trailer for the upcoming... | Read more »
Win a host of exclusive in-game Honor of...
To celebrate its latest Jujutsu Kaisen crossover event, Honor of Kings is offering a bounty of login and achievement rewards kicking off the holiday season early. [Read more] | Read more »
Miraibo GO comes out swinging hard as it...
Having just launched what feels like yesterday, Dreamcube Studio is wasting no time adding events to their open-world survival Miraibo GO. Abyssal Souls arrives relatively in time for the spooky season and brings with it horrifying new partners to... | Read more »
Ditch the heavy binders and high price t...
As fun as the real-world equivalent and the very old Game Boy version are, the Pokemon Trading Card games have historically been received poorly on mobile. It is a very strange and confusing trend, but one that The Pokemon Company is determined to... | Read more »
Peace amongst mobile gamers is now shatt...
Some of the crazy folk tales from gaming have undoubtedly come from the EVE universe. Stories of spying, betrayal, and epic battles have entered history, and now the franchise expands as CCP Games launches EVE Galaxy Conquest, a free-to-play 4x... | Read more »
Lord of Nazarick, the turn-based RPG bas...
Crunchyroll and A PLUS JAPAN have just confirmed that Lord of Nazarick, their turn-based RPG based on the popular OVERLORD anime, is now available for iOS and Android. Starting today at 2PM CET, fans can download the game from Google Play and the... | Read more »
Digital Extremes' recent Devstream...
If you are anything like me you are impatiently waiting for Warframe: 1999 whilst simultaneously cursing the fact Excalibur Prime is permanently Vault locked. To keep us fed during our wait, Digital Extremes hosted a Double Devstream to dish out a... | Read more »
The Frozen Canvas adds a splash of colou...
It is time to grab your gloves and layer up, as Torchlight: Infinite is diving into the frozen tundra in its sixth season. The Frozen Canvas is a colourful new update that brings a stylish flair to the Netherrealm and puts creativity in the... | Read more »
Back When AOL WAS the Internet – The Tou...
In Episode 606 of The TouchArcade Show we kick things off talking about my plans for this weekend, which has resulted in this week’s show being a bit shorter than normal. We also go over some more updates on our Patreon situation, which has been... | Read more »
Creative Assembly's latest mobile p...
The Total War series has been slowly trickling onto mobile, which is a fantastic thing because most, if not all, of them are incredibly great fun. Creative Assembly's latest to get the Feral Interactive treatment into portable form is Total War:... | Read more »

Price Scanner via MacPrices.net

Early Black Friday Deal: Apple’s newly upgrad...
Amazon has Apple 13″ MacBook Airs with M2 CPUs and 16GB of RAM on early Black Friday sale for $200 off MSRP, only $799. Their prices are the lowest currently available for these newly upgraded 13″ M2... Read more
13-inch 8GB M2 MacBook Airs for $749, $250 of...
Best Buy has Apple 13″ MacBook Airs with M2 CPUs and 8GB of RAM in stock and on sale on their online store for $250 off MSRP. Prices start at $749. Their prices are the lowest currently available for... Read more
Amazon is offering an early Black Friday $100...
Amazon is offering early Black Friday discounts on Apple’s new 2024 WiFi iPad minis ranging up to $100 off MSRP, each with free shipping. These are the lowest prices available for new minis anywhere... Read more
Price Drop! Clearance 14-inch M3 MacBook Pros...
Best Buy is offering a $500 discount on clearance 14″ M3 MacBook Pros on their online store this week with prices available starting at only $1099. Prices valid for online orders only, in-store... Read more
Apple AirPods Pro with USB-C on early Black F...
A couple of Apple retailers are offering $70 (28%) discounts on Apple’s AirPods Pro with USB-C (and hearing aid capabilities) this weekend. These are early AirPods Black Friday discounts if you’re... Read more
Price drop! 13-inch M3 MacBook Airs now avail...
With yesterday’s across-the-board MacBook Air upgrade to 16GB of RAM standard, Apple has dropped prices on clearance 13″ 8GB M3 MacBook Airs, Certified Refurbished, to a new low starting at only $829... Read more
Price drop! Apple 15-inch M3 MacBook Airs now...
With yesterday’s release of 15-inch M3 MacBook Airs with 16GB of RAM standard, Apple has dropped prices on clearance Certified Refurbished 15″ 8GB M3 MacBook Airs to a new low starting at only $999.... Read more
Apple has clearance 15-inch M2 MacBook Airs a...
Apple has clearance, Certified Refurbished, 15″ M2 MacBook Airs now available starting at $929 and ranging up to $410 off original MSRP. These are the cheapest 15″ MacBook Airs for sale today at... Read more
Apple drops prices on 13-inch M2 MacBook Airs...
Apple has dropped prices on 13″ M2 MacBook Airs to a new low of only $749 in their Certified Refurbished store. These are the cheapest M2-powered MacBooks for sale at Apple. Apple’s one-year warranty... Read more
Clearance 13-inch M1 MacBook Airs available a...
Apple has clearance 13″ M1 MacBook Airs, Certified Refurbished, now available for $679 for 8-Core CPU/7-Core GPU/256GB models. Apple’s one-year warranty is included, shipping is free, and each... Read more

Jobs Board

Seasonal Cashier - *Apple* Blossom Mall - J...
Seasonal Cashier - Apple Blossom Mall Location:Winchester, VA, United States (https://jobs.jcp.com/jobs/location/191170/winchester-va-united-states) - Apple Read more
Seasonal Fine Jewelry Commission Associate -...
…Fine Jewelry Commission Associate - Apple Blossom Mall Location:Winchester, VA, United States (https://jobs.jcp.com/jobs/location/191170/winchester-va-united-states) Read more
Seasonal Operations Associate - *Apple* Blo...
Seasonal Operations Associate - Apple Blossom Mall Location:Winchester, VA, United States (https://jobs.jcp.com/jobs/location/191170/winchester-va-united-states) - Read more
Hair Stylist - *Apple* Blossom Mall - JCPen...
Hair Stylist - Apple Blossom Mall Location:Winchester, VA, United States (https://jobs.jcp.com/jobs/location/191170/winchester-va-united-states) - Apple Blossom Read more
Cashier - *Apple* Blossom Mall - JCPenney (...
Cashier - Apple Blossom Mall Location:Winchester, VA, United States (https://jobs.jcp.com/jobs/location/191170/winchester-va-united-states) - Apple Blossom Mall Read more
All contents are Copyright 1984-2011 by Xplain Corporation. All rights reserved. Theme designed by Icreon.