ftp.mactech.com 2010/ftp.mactech.com.tar/ftp.mactech.com/macintosh-pascal/macintoshp-1.2-demos.sit.hqx/chap23pascal_demo/chap19pascal_demoPPC/CDEFandVBLPascalPPC.p

Text File | 1997-01-21 | 18KB | 714 lines

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊
// CDEFandVBLPascal.p
// ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊
//
// This program opens a window containing a slider control panel.  The slider control
// panel contains two radio button controls and a slider control.  The radio buttons
// activate and deactivate the slider control.
//
// The slider control uses a custom control definition function (CDEF).  The CDEF
// utilises a VBL task to delay the drawing of a moved indicator in the graphics port
// until the vertical blank period is entered.  The radio buttons also use a custom CDEF.
// On colour or grayscale displays, the appearance of the controls conforms to that
// specified in the document Apple Grayscale Appearance for System 7.5 published by Apple
// Computer, Inc.
//
// This program also includes a demonstration of an animated cursor which utilises a
// system-based VBL task to increment the frames of the animation.  This demonstration
// is invoked by choosing the VBL Task Animated Cursor item in the Demonstration menu.
//
// The program utilises the following resources:
//
// •   An 'MBAR' resource, and 'MENU' resources for Apple, File, Edit and Demonstration
//       menus (preload, non-purgeable).
//
// •   A 'WIND' resource (purgeable) (initially visible) and a 'wctb' resource (purgeable)
//       for the window containing the slider control panel.
//
// •   'CNTL' resources  (purgeable) for the radio button and slider controls.
//
// •   The 'CDEF' code resources (non-purgeable).
//
// •   An 'acur' resource (purgeable) and 'CURS' resources (purgeable) for the animated
//       cursor.
//
// •   A 'SIZE' resource with the acceptSuspendResumeEvents and doesActivateOnFGcase
//       flags set.
//
// ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ }

program CDEFandVBLPascal(input, output);

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

uses

    Windows, Fonts, Menus, TextEdit, Quickdraw, Dialogs, QuickdrawText, Processes, Types,
    Memory, Events, TextUtils, ToolUtils, OSUtils, Devices, GestaltEqu, Retrace, LowMem,
    Palettes, SegLoad;

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

const

mApple = 128;
 iAbout = 1;
mFile = 129;
 iQuit = 11;
mDemonstration = 131;
 iVBLAnimCursor = 1;
rMenubar = 128;
rWindow = 128;
rFingersCursor = 128;
rStartRadioButton = 128;
rStopRadioButton = 129;
rSliderControl = 130;
kMaxLong = $7FFFFFFF;

{ ………………………………………………………………………………………………………………………………………………………………………………… user-defined types }

type

AnimCurs = record
    numberOfFrames : integer;
    whichFrame : integer;
    frame : array [0..0] of CursHandle;
    end;
AnimCursPtr = ^AnimCurs;
AnimCursHandle = ^AnimCursPtr;

VBLRec = record
    vblTaskRec : VBLTask;
    thisApplicationsA5 : longint;
    end;
VBLRecPtr = ^VBLRec;

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

var

gColorQuickDrawPresent : boolean;
gColorDisplay : boolean;
gDone : boolean;
gSleepTime : longint;
gInBackground : boolean;
gWindowPtr : WindowPtr;
gAnimCursHdl : AnimCursHandle;
gVBLRec : VBLRec;
gVBLCount : integer;
gAnimatedCursorActive : boolean;
gWindowColour : RGBColor;
gSliderControlHdl : ControlHandle;
gStartControlHdl : ControlHandle;
gStopControlHdl : ControlHandle;

theErr : OSErr;
response : longint;
mainDeviceHdl : GDHandle;
bitsPerPixel : integer;
menubarHdl : Handle;
menuHdl : MenuHandle;
eventRec : EventRecord;

animCursVBLTaskRD : VBLUPP;                                                { For PowerPC }

{ …………………………………………………………………………………………………………………………………………………………… in-line glue for GetVBLRec }

{$IFC GENERATING68K}                                                       { For PowerPC }
function GetVBLRec : longint;
    {$IFC NOT GENERATINGCFM}
    inline $2E88;
    {$ENDC}
{$ENDC}                                                                    { For PowerPC }

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

procedure DoInitManagers;

    begin
    MaxApplZone;
    MoreMasters;

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

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

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoStopAnimCursor }

procedure DoStopAnimCursor;

    var
    a : integer;
    theRect : Rect;
    ignored : OSErr;

    begin
    ignored := VRemove(QElemPtr(@gVBLRec.vblTaskRec));

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

    ReleaseResource(Handle(gAnimCursHdl));

    gAnimatedCursorActive := false;
    gSleepTime := kMaxLong;

    SetCursor(qd.arrow);

    SetRect(theRect, 30, 100, 150, 130);
    RGBBackColor(gWindowColour);
    FillRect(theRect, qd.white);
    end;
        {of procedure DoStopAnimCursor}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ AnimCursVBLTask }

procedure AnimCursVBLTask;

    {$IFC GENERATING68K}                                                     { For PowerPC }
    var
    theVBLRecPtr : VBLRecPtr;
    currentA5 : longint;
    {$ENDC}                                                                  { For PowerPC }

    begin
    {$IFC GENERATING68K}                                                     { For PowerPC }
    theVBLRecPtr := VBLRecPtr(GetVBLRec);
    currentA5 := SetA5(theVBLRecPtr^.thisApplicationsA5);
    {$ENDC}                                                                  { For PowerPC }

    SetCursor(gAnimCursHdl^^.frame[gAnimCursHdl^^.whichFrame]^^);
    gAnimCursHdl^^.whichFrame := gAnimCursHdl^^.whichFrame + 1;

    if (gAnimCursHdl^^.whichFrame = gAnimCursHdl^^.numberOfFrames) then
        gAnimCursHdl^^.whichFrame := 0;

    {$IFC GENERATING68K}                                                     { For PowerPC }
    theVBLRecPtr^.vblTaskRec.vblCount := gVBLCount;
    {$ELSEC}                                                                 { For PowerPC }
    gVBLRec.vblTaskRec.vblCount := gVBLCount;                                { For PowerPC }
    {$ENDC}                                                                  { For PowerPC }

    {$IFC GENERATING68K}                                                     { For PowerPC }
    currentA5 := SetA5(currentA5);
    {$ENDC}                                                                  { For PowerPC }
    end;
        {of procedure AnimCursVBLTask}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoInstallSystemVBLTask }

procedure DoInstallSystemVBLTask;

    var
    ignored : OSErr;

    begin
    gVBLRec.vblTaskRec.qType := vType;
    gVBLRec.vblTaskRec.vblAddr := animCursVBLTaskRD;                         { For PowerPC }
    gVBLRec.vblTaskRec.vblCount := gVBLCount;
    gVBLRec.vblTaskRec.vblPhase := 0;

    {$IFC GENERATING68K}                                                     { For PowerPC }
    gVBLRec.thisApplicationsA5 := SetCurrentA5;
    {$ENDC}                                                                  { For PowerPC }

    ignored := VInstall(QElemPtr(@gVBLRec.vblTaskRec));
    end;
        {of procedure DoInstallSystemVBLTask}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoGetAnimCursor }

function DoGetAnimCursor(resourceID : integer) : boolean;

    var
    cursorID, a : integer;
    noError : boolean;

    begin
    a := 0;
    noError := false;

    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
        gAnimCursHdl^^.whichFrame := 0;

    DoGetAnimCursor := noError;
    end;
        {of procedure DoGetAnimCursor}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoStartAnimCursor }

procedure DoStartAnimCursor;

    begin
    gVBLCount := 30;
    gSleepTime := 0;

    if (DoGetAnimCursor(rFingersCursor) = false) then
        ExitToShell;

    DoInstallSystemVBLTask;

    gAnimatedCursorActive := true;

    MoveTo(40, 110);
    DrawString('Press any key to');
    MoveTo(30, 125);
    DrawString('stop animated cursor');
    end;
        {of procedure DoInitManagers}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoDrawControlsPanel }

procedure DoDrawControlsPanel;

    var
    mainDeviceHdl : GDHandle;
    bitsPerPixel : integer;
    fontNum, a : integer;
    gray8 : RGBColor;

    begin
    gray8.red := $7777;
    gray8.blue := $7777;
    gray8.green := $7777;

    GetFNum('Chicago', fontNum);
    TextFont(fontNum);
    TextSize(12);

    mainDeviceHdl := LMGetMainDevice;
    bitsPerPixel := mainDeviceHdl^^.gdPMap^^.pixelSize;
    if (bitsPerPixel > 1) then
        gColorDisplay := true
    else
        gColorDisplay := false;

    for a := 0 to 1 do
        begin
        if (a = 0) then
            ForeColor(whiteColor)
        else begin
            if not (gInBackground) then
                begin
                if (gColorQuickDrawPresent and gColorDisplay) then
                    ForeColor(blackColor)
                else begin
                    ForeColor(blackColor);
                    PenPat(qd.black);
                    TextMode(srcOr);
                    end;
                end
            else begin
                if (gColorQuickDrawPresent and gColorDisplay) then
                    RGBForeColor(gray8)
                else begin
                    ForeColor(blackColor);
                    PenPat(qd.gray);
                    TextMode(grayishTextOr);
                    end;
                end;
            end;

        if not ((a = 0) and not gColorDisplay) then
            begin
            MoveTo(156-a, 22-a);
            LineTo(152-a, 22-a);
            LineTo(152-a, 230-a);
            LineTo(246-a, 230-a);
            LineTo(246-a, 22-a);
            LineTo(242-a, 22-a);

            MoveTo(163-a, 26-a);
            DrawString('Engine RPM');
            end;
        end;

    ForeColor(blackColor);

    GetFNum('Geneva', fontNum);
    TextFont(fontNum);
    TextSize(10);

    PenPat(qd.black);
    TextMode(srcOr);
    end;
        {of procedure DoDrawControlsPanel}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoGetSliderControlSuite }

procedure DoGetSliderControlSuite;

    begin
    gSliderControlHdl := GetNewControl(rSliderControl, gWindowPtr);
    HiliteControl(gSliderControlHdl, 255);

    gStartControlHdl := GetNewControl(rStartRadioButton, gWindowPtr);
    gStopControlHdl := GetNewControl(rStopRadioButton, gWindowPtr);

    DoDrawControlsPanel;
    end;
        {of procedure DoGetSliderControlSuite}

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

procedure DoMenuChoice(menuChoice : longint);

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

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

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

    case (menuID) of

        mApple: begin
            if (menuItem = iAbout) then
                SysBeep(10)
            else begin
                GetMenuItemText(GetMenuHandle(mApple), menuItem, itemName);
                daDriverRefNum := OpenDeskAcc(itemName);
                end;
            end;

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

        mDemonstration: begin
            if (menuItem = iVBLAnimCursor) then
                DoStartAnimCursor;
            end;
        end;
            {of case statement}

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

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoInContent }

procedure DoInContent(var theEvent : EventRecord; theWindowPtr : WindowPtr);

    var
    controlHdl : ControlHandle;
    partCode : integer;
    theRect : Rect;
    theString : string;
    ignored : ControlPartCode;

    begin
    GlobalToLocal(theEvent.where);

    partCode := FindControl(theEvent.where, theWindowPtr, controlHdl);

    if (controlHdl = gSliderControlHdl) then
        begin
        if (partCode = kControlIndicatorPart) then
            ignored := TrackControl(controlHdl, theEvent.where, nil);

        RGBBackColor(gWindowColour);
        SetRect(theRect, 253, 107, 390, 119);
        FillRect(theRect, qd.white);
        MoveTo(255, 117);
        DrawString('Slider Control Value: ');
        NumToString(longint(GetControlValue(controlHdl)), theString);
        DrawString(theString);
        end
    else if ((controlHdl = gStartControlHdl) or (controlHdl = gStopControlHdl)) then
        begin
        if (TrackControl(controlHdl, theEvent.where, nil) <> 0) then
            begin
            if (controlHdl = gStartControlHdl) then
                begin
                HiliteControl(gSliderControlHdl, 0);
                SetControlValue(gStartControlHdl, 1);
                SetControlValue(gStopControlHdl, 0);
                end
            else if (controlHdl = gStopControlHdl) then
                begin
                SetControlValue(gSliderControlHdl, 0);
                HiliteControl(gSliderControlHdl, 255);
                SetControlValue(gStartControlHdl, 0);
                SetControlValue(gStopControlHdl, 1);

                RGBBackColor(gWindowColour);
                SetRect(theRect, 253, 107, 390, 119);
                FillRect(theRect, qd.white);
                end;
            end;
        end;
    end;
        {of procedure DoInContent}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoActivateWindow }

procedure DoActivateWindow(becomingActive : boolean);

    var
    controlVal : integer;

    begin
    if (becomingActive) then
        begin
        controlVal := GetControlValue(gStartControlHdl);
        if (controlVal = 1) then
            HiliteControl(gSliderControlHdl, 0);
        HiliteControl(gStartControlHdl, 0);
        HiliteControl(gStopControlHdl, 0);
        end
    else begin
        HiliteControl(gSliderControlHdl, 255);
        HiliteControl(gStartControlHdl, 255);
        HiliteControl(gStopControlHdl, 255);
        end;

    DoDrawControlsPanel;
    end;
        {of procedure DoActivateWindow}

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

procedure DoOSEvent(var theEvent : EventRecord);

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

        suspendResumeMessage: begin
            gInBackground := BAnd(theEvent.message, resumeFlag) = 0;
            DoActivateWindow(not gInBackground);
            end;

        mouseMovedMessage: begin
            end;
        end;
            {of case statement}
    end;
        {of procedure DoOSEvent}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoUpdate }

procedure DoUpdate(var theEvent : EventRecord);

    var
    theWindowPtr : WindowPtr;

    begin
    theWindowPtr := WindowPtr(theEvent.message);

    BeginUpdate(theWindowPtr);

    SetPort(theWindowPtr);
    UpdateControls(theWindowPtr, theWindowPtr^.visRgn);
    DoDrawControlsPanel;

    EndUpdate(theWindowPtr);
    end;
        {of procedure DoUpdate}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoActivate }

procedure DoActivate(var theEvent : EventRecord);

    var
    theWindowPtr : WindowPtr;
    becomingActive : boolean;

    begin
    theWindowPtr := WindowPtr(theEvent.message);

    becomingActive := (BAnd(theEvent.modifiers, activeFlag) = activeFlag);
    DoActivateWindow(becomingActive);
    end;
        {of procedure DoActivate}

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

procedure DoMouseDown(var theEvent : EventRecord);

    var
    partCode : integer;
    theWindowPtr : WindowPtr;
    menuHdl : MenuHandle;

    begin
    partCode := FindWindow(theEvent.where, theWindowPtr);
    menuHdl := GetMenuHandle(mDemonstration);

    case (partCode) of

        inMenuBar: begin
            if (gAnimatedCursorActive) then
                DisableItem(menuHdl, iVBLAnimCursor)
            else
                EnableItem(menuHdl, iVBLAnimCursor);
            DoMenuChoice(MenuSelect(theEvent.where));
            end;

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

        inContent: begin
            if (theWindowPtr <> FrontWindow) then
                SelectWindow(theWindowPtr)
            else
                DoInContent(theEvent, theWindowPtr);
            end;

        inDrag: begin
            DragWindow(theWindowPtr, theEvent.where, qd.screenBits.bounds);
            end;
        end;
            {of case statement}
    end;
        {of procedure DoMouseDown}

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

procedure DoEvents(var theEvent : EventRecord);

    begin
    case (theEvent.what) of

        mouseDown: begin
            DoMouseDown(theEvent);
            end;

        keyDown, autoKey: begin
            if (gAnimatedCursorActive) then
                DoStopAnimCursor;
            end;

        updateEvt: begin
            DoUpdate(theEvent);
            end;

        activateEvt: begin
            DoActivate(theEvent);
            end;

        osEvt: begin
            DoOSEvent(theEvent);
            HiliteMenu(0);
            end;
        end;
            {of case statement}
    end;
        {of procedure DoEvents}

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

begin

gColorQuickDrawPresent := false;
gColorDisplay := false;
gAnimatedCursorActive := false;
gWindowColour.red := $DDDD;
gWindowColour.green := $DDDD;
gWindowColour.blue := $DDDD;

    { …………………………………………………………………………………………………………………………………………………………………… initialise managers }

    DoInitManagers;

    { …………………………………………………………………………………………………………………………………………………… create routine descriptor }

    animCursVBLTaskRD := NewVBLProc(ProcPtr(@AnimCursVBLTask));            { For PowerPC }

    { …………………………………………………………………………………………………………………………………………………… check for Color QuickDraw }

    theErr := Gestalt(gestaltQuickdrawVersion, response);
    if (response >= gestalt8BitQD) then
        begin
        gColorQuickDrawPresent := true;

        mainDeviceHdl := LMGetMainDevice;
        bitsPerPixel := mainDeviceHdl^^.gdPMap^^.pixelSize;
        if (bitsPerPixel > 1) then
            gColorDisplay := true;
        end;

    { …………………………………………………………………………………………………………………………………………………… 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 }

    if (gColorQuickDrawPresent) then
        begin
        gWindowPtr := GetNewCWindow(rWindow, nil, WindowPtr(-1));
        if (gWindowPtr = nil) then
            ExitToShell;
        end
    else begin
        gWindowPtr := GetNewWindow(rWindow, nil, WindowPtr(-1));
        if (gWindowPtr = nil) then
            ExitToShell;
        end;

    SetPort(gWindowPtr);

    { ……………………………………………………………………………………………………………………………………………………… get slider control suite }

    DoGetSliderControlSuite;

    { ……………………………………………………………………………………………………………………………………………………………………………… enter eventLoop }

    gDone := false;
    gSleepTime := kMaxLong;

    while not (gDone) do
        begin
        if (WaitNextEvent(everyEvent, eventRec, gSleepTime, nil)) then
            DoEvents(eventRec);
        end;

end.
    {of main program block}

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