ftp.mactech.com 2010/ftp.mactech.com.tar/ftp.mactech.com/macintosh-pascal/macintoshp-1.2-demos.sit.hqx/chap12pascal_demo/GWorldPicCursIconPascal.p

Text File | 1999-04-05 | 20KB | 879 lines

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊
// GWorldPicCursIconPascal.p
// ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊
//
// This program:
//
// •   Opens a window in which the results of various drawing operations are displayed,
//       and in which regions are established for a cursor shape change demonstration.
//
// •   Demonstrates offscreen graphics world, picture, cursor, animated cursor, and icon
//       operations as a result of the user choosing items from a Demonstration menu.
//
// •   Quits when the user chooses Quit or clicks the window's close box.
//
// The program utilizes the following resources:
//
// •   'MBAR' resource and associated 'MENU' resources (preload, non-purgeable).
//
// •   A 'WIND' resource (purgeable) (initially visible).
//
// •   An 'acur' resource (purgeable).
//
// •   'CURS' resources associated with the 'acur' resource (purgeable).
//
// •   An 'ALRT' resource (purgeable) and associated 'DITL' resource (purgeable) for an
//       About GWorldPicCursIcon… alert box, which is used to demonstrate the display of
//       icons in alert boxes.
//
// •   'ICON', 'cicn', and 'SICN' resources (purgeable) for the display of icons in menu
//       items and the About GWorldPicCursIcon… alert box.
//
// •   A 'SIZE' resource with the acceptSuspendResumeEvents & is32BitCompatible flags set.
//
// ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ }

program GWorldPicCursIconPascal(input, output);

{ ………………………………………………………………………………………………………………… include the following Universal Interfaces }

uses

    Windows, Fonts, Menus, TextEdit, Quickdraw, Dialogs, QuickdrawText, Processes, Types,
    Memory, Events, TextUtils, ToolUtils, OSUtils, Devices, QDOffscreen, Resources, Icons,
    GestaltEqu, PictUtils, SegLoad, Sound;

{ ………………………………………………………………………………………………………………………………………………… define the following constants }

const

mApple = 128;
    iAbout = 1;
mFile = 129;
    iQuit = 11;
mDemonstration = 131;
    iWithoutOffScreenGWorld = 1;
    iWithOffScreenGWorld = 2;
    iPicture = 3;
    iCursor = 4;
    iAnimatedCursor = 5;
    iIcon = 6;

rAlert = 128;
rMenubar = 128;
rWindow = 128;
rBeachBallCursor = 128;
rIcon = 257;

kBeachBallTickInterval = 5;

kMaxLong = $7FFFFFFF;

{ ……………………………………………………………………………………………………………………………………………………………………………………… type definitions }

type

animCurs = record
    numberOfFrames : integer;
    whichFrame : integer;
    frame : array [0..8] of CursHandle;
    end;
animCursPtr = ^animCurs;
animCursHandle = ^animCursPtr;

{ ……………………………………………………………………………………………………………………………………………………………………………………… global variables }

var

gDone : boolean;
gWindowPtr : WindowPtr;
gSleepTime : longint;
gCursorRegion : RgnHandle;
gInBackground : boolean;
gCursorRegionsActive : boolean;
gAnimCursHdl : animCursHandle;
gAnimCursActive : boolean;
gAnimCursTickInterval : integer;
gAnimCursLastTick : longint;
menubarHdl : Handle;
menuHdl : MenuHandle;

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoInitManagers }

procedure DoInitManagers;

    begin
    MaxApplZone;
    MoreMasters;

    InitGraf(@qd.thePort);
    InitFonts;
    InitWindows;
    InitMenus;
    TEInit;
    InitDialogs(nil);

    InitCursor;
    FlushEvents(everyEvent, 0);
    end;
        {of procedure DoInitManagers}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoIcon }

procedure DoIcon;

    var
    theErr : OSErr;
    response : longint;
    finalTicks : UInt32;
    a : integer;
    theRect : Rect;
    iconHdl : Handle;
    cIconHdl : CIconHandle;

    begin
    BackColor(whiteColor);
    FillRect(gWindowPtr^.portRect, qd.white);

    SetRect(theRect, 2, 130, 34, 162);

    theErr := Gestalt(gestaltQuickdrawVersion, response);
    if (response < gestalt8BitQD)
        then    begin
                iconHdl := GetIcon(257);
                for a := 1 to 19 do
                    begin
                    PlotIcon(theRect, iconHdl);
                    InsetRect(theRect, a*(-1), a*(-2));
                    OffsetRect(theRect, a*4, 0);
                    Delay(20, finalTicks);
                    end
                end
        else    begin
                cIconHdl := GetCIcon(257);
                for a := 1 to 19 do
                    begin
                    PlotCIcon(theRect, cIconHdl);
                    InsetRect(theRect, a*(-1), a*(-2));
                    OffsetRect(theRect, a*4, 0);
                    Delay(20, finalTicks);
                    end;
                DisposeCIcon(cIconHdl);
                end;
    end;
        {of procedure DoIcon}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ ReleaseAnimCursor }

procedure ReleaseAnimCursor;

    var
    a : integer;

    begin
    for a := 0 to (gAnimCursHdl^^.numberOfFrames - 1) do
        ReleaseResource(Handle(gAnimCursHdl^^.frame[a]));

    ReleaseResource(Handle(gAnimCursHdl));
    end;
        {of procedure ReleaseAnimCursor}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ SpinAnimCursor }

procedure SpinAnimCursor;

    var
    newTick : longint;

    begin
    newTick := TickCount;
    if (newTick < (gAnimCursLastTick + gAnimCursTickInterval)) then
        Exit(SpinAnimCursor);

    SetCursor(gAnimCursHdl^^.frame[gAnimCursHdl^^.whichFrame]^^);
    gAnimCursHdl^^.whichFrame := gAnimCursHdl^^.whichFrame + 1;
    if (gAnimCursHdl^^.whichFrame = gAnimCursHdl^^.numberOfFrames) then
        gAnimCursHdl^^.whichFrame := 0;

    gAnimCursLastTick := newTick;
    end;
        {of procedure SpinAnimCursor}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ GetAnimCursor }

function GetAnimCursor(resourceID, tickInterval : integer) : boolean;

    var
    cursorID, a : integer;
    noError : boolean;

    begin
    noError := false;
    a := 0;

    gAnimCursHdl := animCursHandle(GetResource('acur', resourceID));
    if (gAnimCursHdl <> nil) then
        begin
        noError := true;
        while ((a < gAnimCursHdl^^.numberOfFrames)  and noError) do
            begin
            cursorID := integer(HiWord(longint(gAnimCursHdl^^.frame[a])));
            gAnimCursHdl^^.frame[a] := GetCursor(cursorID);
            if (gAnimCursHdl^^.frame[a] <> nil)
                then a := a + 1
                else noError := false;
            end;
        end;

    if (noError) then
        begin
        gAnimCursTickInterval := tickInterval;
        gAnimCursLastTick := TickCount;
        gAnimCursHdl^^.whichFrame := 0;
        end;

    GetAnimCursor := noError;
    end;
        {of function GetAnimCursor}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoAnimCursor }

procedure DoAnimCursor;

    var
    animCursResourceID, animCursTickInterval : integer;

    begin
    BackColor(whiteColor);
    FillRect(gWindowPtr^.portRect, qd.white);

    animCursResourceID     := rBeachBallCursor;
    animCursTickInterval := kBeachBallTickInterval;

    if (GetAnimCursor(animCursResourceID, animCursTickInterval))
        then    begin
                gAnimCursActive := true;
                gSleepTime := animCursTickInterval;
                end
        else    SysBeep(10);
    end;
        {of procedure DoAnimCursor}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ ChangeCursor }

procedure ChangeCursor(gWindowPtr : WindowPtr; cursorRegion : RgnHandle);

    var
    cursorRect : Rect;
    arrowCursorRgn : RgnHandle;
    ibeamCursorRgn : RgnHandle;
    crossCursorRgn : RgnHandle;
    plusCursorRgn : RgnHandle;
    mousePosition : Point;

    begin
    arrowCursorRgn := NewRgn;
    ibeamCursorRgn := NewRgn;
    crossCursorRgn := NewRgn;
    plusCursorRgn     := NewRgn;

    SetRectRgn(arrowCursorRgn, -32768, -32768, 32766, 32766);

    cursorRect := gWindowPtr^.portRect;
    LocalToGlobal(cursorRect.topLeft);
    LocalToGlobal(cursorRect.botRight);

    InsetRect(cursorRect, 40, 40);
    RectRgn(ibeamCursorRgn, cursorRect);
    DiffRgn(arrowCursorRgn, ibeamCursorRgn, arrowCursorRgn);

    InsetRect(cursorRect, 40, 40);
    RectRgn(crossCursorRgn, cursorRect);
    DiffRgn(ibeamCursorRgn, crossCursorRgn, ibeamCursorRgn);

    InsetRect(cursorRect, 40, 40);
    RectRgn(plusCursorRgn, cursorRect);
    DiffRgn(crossCursorRgn, plusCursorRgn, crossCursorRgn);

    GetMouse(mousePosition);
    LocalToGlobal(mousePosition);

    if (PtInRgn(mousePosition, ibeamCursorRgn)) then
        begin
        SetCursor(GetCursor(iBeamCursor)^^);
        CopyRgn(ibeamCursorRgn, cursorRegion);
        end
    else if (PtInRgn(mousePosition, crossCursorRgn)) then
        begin
        SetCursor(GetCursor(crossCursor)^^);
        CopyRgn(crossCursorRgn, cursorRegion);
        end
    else if (PtInRgn(mousePosition, plusCursorRgn)) then
        begin
        SetCursor(GetCursor(plusCursor)^^);
        CopyRgn(plusCursorRgn, cursorRegion);
        end
    else
        begin
        SetCursor(qd.arrow);
        CopyRgn(arrowCursorRgn, cursorRegion);
        end;

    DisposeRgn(arrowCursorRgn);
    DisposeRgn(ibeamCursorRgn);
    DisposeRgn(crossCursorRgn);
    DisposeRgn(plusCursorRgn);
    end;
        {of procedure ChangeCursor}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoCursor }

procedure DoCursor;

    var
    cursorRect : Rect;
    a : integer;

    begin
    BackColor(whiteColor);
    FillRect(gWindowPtr^.portRect, qd.white);

    cursorRect := gWindowPtr^.portRect;
    PenPat(qd.gray);
    PenSize(1, 1);
    ForeColor(redColor);

    for a := 0 to 2 do
        begin
        InsetRect(cursorRect, 40, 40);
        FrameRect(cursorRect);
        end;

    MoveTo(10, 20);
    DrawString('Arrow cursor region');
    MoveTo(50, 60);
    DrawString('IBeam cursor region');
    MoveTo(90, 100);
    DrawString('Cross cursor region');
    MoveTo(130, 140);
    DrawString('Plus cursor region');

    gCursorRegionsActive := true;
    gCursorRegion := NewRgn;
    end;
        {of procedure DoCursor}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoPicture }

procedure DoPicture;

    var
    pictureRect : Rect;
    picParams : OpenCPicParams;
    pictureHdl : PicHandle;
    trianglePoly : PolyHandle;
    pictureInfo : PictInfo;
    pictInfoString : string;
    ignored : OSErr;

    begin
    BackColor(whiteColor);
    FillRect(gWindowPtr^.portRect, qd.white);

    pictureRect := gWindowPtr^.portRect;
    InsetRect(pictureRect, 50, 50);

    picParams.srcRect := pictureRect;
    picParams.hRes := $00480000;
    picParams.vRes := $00480000;
    picParams.version := -2;

    pictureHdl := OpenCPicture(picParams);

    ClipRect(gWindowPtr^.portRect);

    ForeColor(blueColor);
    FillRect(pictureRect, qd.dkGray);
    ForeColor(yellowColor);
    FillOval(pictureRect, qd.gray);

    trianglePoly := OpenPoly;
    MoveTo(pictureRect.left, pictureRect.bottom);
    LineTo(trunc(pictureRect.left + ((pictureRect.right - pictureRect.left) / 2)),
                     pictureRect.top);
    LineTo(pictureRect.right, pictureRect.bottom);
    ClosePoly;

    PenPat(qd.black);
    ForeColor(redColor);
    PaintPoly(trianglePoly);
    KillPoly(trianglePoly);

    ForeColor(blackColor);
    TextSize(30);
    TextFont(systemFont);
    MoveTo(115, 230);
    DrawString('Recorded Picture');
    ForeColor(whiteColor);
    MoveTo(112, 227);
    DrawString('Recorded Picture');

    ClosePicture;

    DrawPicture(pictureHdl, pictureRect);

    SetWTitle(gWindowPtr, 'Click Mouse for Picture Information');

    while not (Button) do ;

    FillRect(gWindowPtr^.portRect, qd.white);
    SetWTitle(gWindowPtr, 'Offscreen Graphics Worlds, Pictures and Cursors');

    TextFont(1);
    TextSize(10);

    ignored := GetPictInfo(pictureHdl, pictureInfo, returnPalette, 8, systemMethod, 0);
    ForeColor(blackColor);
    MoveTo(180, 50);
    DrawString('Some Picture Information:');

    MoveTo(180, 80);
    DrawString('TextStrings: ');
    NumToString(pictureInfo.textCount, pictInfoString);
    DrawString(pictInfoString);

    MoveTo(180, 95);
    DrawString('Rectangles: ');
    NumToString(pictureInfo.rectCount, pictInfoString);
    DrawString(pictInfoString);

    MoveTo(180, 110);
    DrawString('Round Rectangles: ');
    NumToString(pictureInfo.rRectCount, pictInfoString);
    DrawString(pictInfoString);

    MoveTo(180, 125);
    DrawString('Ovals: ');
    NumToString(pictureInfo.ovalCount, pictInfoString);
    DrawString(pictInfoString);

    MoveTo(180, 140);
    DrawString('Arcs: ');
    NumToString(pictureInfo.arcCount, pictInfoString);
    DrawString(pictInfoString);

    MoveTo(180, 155);
    DrawString('Polygons: ');
    NumToString(pictureInfo.polyCount, pictInfoString);
    DrawString(pictInfoString);

    MoveTo(180, 170);
    DrawString('Unique Fonts: ');
    NumToString(pictureInfo.uniqueFonts, pictInfoString);
    DrawString(pictInfoString);

    KillPicture(pictureHdl);

    TextFont(1);
    TextSize(10);

    end;
        {of procedure DoPicture}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoGWorldDrawing }

procedure DoGWorldDrawing;

    var
    a, b, c, i, j : integer;
    theRect : Rect;

    begin
    PenPat(qd.black);
    PenSize(1, 1);

    for a := 0 to 7 do
        for i := 0 to 15 do
            begin
            b := i * 30 + 12;
            for j := 0 to 15 do
                begin
                c := j * 18 + 5;
                SetRect(theRect, b+a, c+a, b+28-a, c+16-a);
                if (a < 3)
                    then     ForeColor(redColor)
                    else     if ((a > 2) and (a < 6))
                                then     ForeColor(greenColor)
                                else     if(a > 5) then
                                            ForeColor(blueColor);
                FrameRect(theRect);
                end;
                    {of j-for loop}
            end;
                {of i-for loop}
    end;
        {of procedure DoGWorldDrawing}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoWithoutOffScreenGWorld }

procedure DoWithoutOffScreenGWorld;

    begin
    BackColor(whiteColor);
    FillRect(gWindowPtr^.portRect, qd.white);

    DoGWorldDrawing;
    end;
        {of procedure DoWithoutOffScreenGWorld}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoWithOffScreenGWorld }

procedure DoWithOffScreenGWorld;

    var
    windowPortPtr : CGrafPtr;
    deviceHdl : GDHandle;
    quickDrawErr : QDErr;
    gworldPortPtr : GWorldPtr;
    gworldPixMapHdl : PixMapHandle;
    lockPixResult : boolean;
    sourceRect, destRect : Rect;

    begin
    BackColor(whiteColor);
    FillRect(gWindowPtr^.portRect, qd.white);

    ForeColor(blackColor);
    MoveTo(130, 140);
    DrawString('Please Wait.  Drawing in offscreen graphics port.');

    SetCursor(GetCursor(watchCursor)^^);

    GetGWorld(windowPortPtr, deviceHdl);

    quickDrawErr := NewGWorld(gworldPortPtr, 0, gWindowPtr^.portRect, nil, nil, 0);
    if ((gworldPortPtr = nil) or (quickDrawErr <> noErr)) then
        begin
        SysBeep(10);
        Exit(DoWithOffScreenGWorld);
        end;

    SetGWorld(gworldPortPtr, nil);

    gworldPixMapHdl := GetGWorldPixMap(gworldPortPtr);

    lockPixResult := LockPixels(gworldPixMapHdl);
    if not (lockPixResult) then
        begin
        SysBeep(10);
        Exit(DoWithOffScreenGWorld);
        end;

    EraseRect(gworldPortPtr^.portRect);

    DoGWorldDrawing;

    SetGWorld(windowPortPtr, deviceHdl);

    sourceRect := gworldPortPtr^.portRect;
    destRect := windowPortPtr^.portRect;

    CopyBits(GrafPtr(gworldPortPtr)^.portBits, GrafPtr(windowPortPtr)^.portBits,
                     sourceRect, destRect, srcCopy, nil);

    if (QDError <> noErr) then
        SysBeep(10);

    UnlockPixels(gworldPixMapHdl);
    DisposeGWorld(gworldPortPtr);

    SetCursor(qd.arrow);

    end;
        {of procedure DoWithOffScreenGWorld}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoIdle }

procedure DoIdle;

    begin
    if (gAnimCursActive = true) then
        SpinAnimCursor;
    end;
        {of procedure DoIdle}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoDemonstrationMenu }

procedure DoDemonstrationMenu(menuItem : integer);

    begin
    case (menuItem) of

        iWithoutOffScreenGWorld:
            begin
            DoWithoutOffScreenGWorld;
            end;

        iWithOffScreenGWorld:
            begin
            DoWithOffScreenGWorld;
            end;

        iPicture:
            begin
            DoPicture;
            end;

        iCursor:
            begin
            DoCursor;
            end;

        iAnimatedCursor:
            begin
            DoAnimCursor;
            end;

        iIcon:
            begin
            DoIcon;
            end;
        end;
            {of case statement}
    end;
         {of procedure DoDemonstrationMenu}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoMenuChoice }

procedure DoMenuChoice(menuChoice : longint);

    var
    menuID, menuItem : integer;
    itemName : string;
    daDriverRefNum : integer;
    ignored : OSErr;

    begin
    menuID := HiWord(menuChoice);
    menuItem := LoWord(menuChoice);

    if (menuID = 0) then
        Exit(DoMenuChoice);

    if (gAnimCursActive = true) then
        begin
        gAnimCursActive := false;
        SetCursor(qd.arrow);
        ReleaseAnimCursor;
        gSleepTime := kMaxLong;
        end;

    if (gCursorRegionsActive = true) then
        begin
        gCursorRegionsActive := false;
        DisposeRgn(gCursorRegion);
        gCursorRegion := nil;
        end;

    case (menuID) of

        mApple:
            begin
            if (menuItem = iAbout)
                then     ignored := Alert(rAlert, nil)
                else     begin
                        GetMenuItemText(GetMenuHandle(mApple), menuItem, itemName);
                        daDriverRefNum := OpenDeskAcc(itemName);
                        end;
            end;

        mFile:
            begin
            if (menuItem = iQuit) then
                gDone := true;
            end;

        mDemonstration:
            begin
            DoDemonstrationMenu(menuItem);
            end;
        end;
            {of case statement}

    HiliteMenu(0);
    end;
        {of procedure DoMenuChoice}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoOSEvent }

procedure DoOSEvent(var eventRec : EventRecord);

    begin
    case (BAnd(BSR(eventRec.message, 24), $000000FF)) of

        suspendResumeMessage:
            begin
            if (BAnd(eventRec.message, resumeFlag) = 1)
                then gInBackground := false
                else gInBackground := true;
            end;

        mouseMovedMessage:
            begin
            if (gCursorRegionsActive) then
                ChangeCursor(gWindowPtr, gCursorRegion);
            end;
        end;
            {of case statement}
    end;
        {of procedure DoOSEvent}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoMouseDown }

procedure DoMouseDown(var eventRec : EventRecord);

    var
    theWindowPtr : WindowPtr;
    partCode : integer;

    begin
    partCode := FindWindow(eventRec.where, theWindowPtr);

    case (partCode) of

        inMenuBar:
            begin
            DoMenuChoice(MenuSelect(eventRec.where));
            end;

        inSysWindow:
            begin
            SystemClick(eventRec, theWindowPtr);
            end;

        inContent:
            begin
            if (theWindowPtr <> FrontWindow) then
                SelectWindow(theWindowPtr);
            end;

        inDrag:
            begin
            DragWindow(theWindowPtr, eventRec.where, qd.screenBits.bounds);
            end;

        inGoAway:
            begin
            if (TrackGoAway(theWindowPtr, eventRec.where)) then
                gDone := true;
            end;
        end;
            {of case statement}
    end;
        {of procedure DoMouseDown}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoEvents }

procedure DoEvents(var eventRec : EventRecord);

    var
    theWindowPtr : WindowPtr;
    charCode : char;

    begin
    theWindowPtr := WindowPtr(eventRec.message);

    case (eventRec.what) of

        mouseDown:
            begin
            DoMouseDown(eventRec);
            end;

        keyDown, autoKey:
            begin
            charCode := chr(BAnd(eventRec.message, charCodeMask));
            if (BAnd(eventRec.modifiers, cmdKey) <> 0) then
                DoMenuChoice(MenuKey(charCode));
            end;

        updateEvt:
            begin
            BeginUpdate(theWindowPtr);
            EndUpdate(theWindowPtr);
            end;

        osEvt:
            begin
            DoOSEvent(eventRec);
            end;

        end;
            {of case statement}
    end;
        {of procedure DoEvents}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ EventLoop }

procedure EventLoop;

    var
    eventRec : EventRecord;
    gotEvent : boolean;

    begin
    gDone := false;
    gSleepTime := kMaxLong;
    gCursorRegion := nil;

    while not (gDone) do
        begin
        gotEvent := WaitNextEvent(everyEvent, eventRec, gSleepTime, gCursorRegion);
        if (gotEvent)
            then DoEvents(eventRec)
            else DoIdle;
        end;
    end;
        {of procedure EventLoop}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ start of main program }

begin

gCursorRegionsActive := false;
gAnimCursActive := false;

    { …………………………………………………………………………………………………………………………………………………………………… initialize managers }

    DoInitManagers;

    { …………………………………………………………………………………………………………………………………………………… set up menu bar and menus }

    menubarHdl := GetNewMBar(rMenubar);
    if (menubarHdl = nil) then
        ExitToShell;
    SetMenuBar(menubarHdl);
    DrawMenuBar;
    menuHdl := GetMenuHandle(mApple);
    if (menuHdl = nil)
        then ExitToShell
        else AppendResMenu(menuHdl, 'DRVR');

    { ………………………………………………………………………………………………………………………………………………………………………………………… open window }

    gWindowPtr := GetNewWindow(rWindow, nil, WindowPtr(-1));
    if (gWindowPtr = nil) then
        ExitToShell;

    SetPort(gWindowPtr);
    TextSize(10);

    { …………………………………………………………………………………………………………………………………………………………………………… enter event loop }

    EventLoop;

end.
    {of main program}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ }