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

Text File | 1999-04-05 | 31KB | 1,198 lines

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊
// ListsPascal.p
// ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊
//
// This program allows the user to open a dialog box by choosing the Dialog With Lists
// item in the Demonstration menu.
//
// The dialog box contains two lists.  The cells of one list contain text.  The cells of
// the other list contain icon-like pictures and their titles.
//
// The text list uses the default list definition procedure.
//
// The picture list uses a custom list definition procedure.  The source code for the
// custom list definition procedure is at the file LDEFPascal.p in the LDEFPascal folder.
//
// The currently active list is outlined by a two-pixel-wide border.  The currently
// active list can be changed by clicking in the non-active list or by pressing the tab
// key.
//
// The text list uses the default cell-selection algorithm; accordingly, multiple cells,
// including discontiguous multiple cells, may be selected.  The picture list also
// supports arrow key selection (of single or multiple cells) and type selection.
//
// The constant lOnlyOne is assigned to the selFlags field of the picture list's list
// record.  Accordingly, the selection of multiple items is not possible in this list.
// Arrow key selection (of single cells) is, however, supported.
//
// When the dialog is dismissed by clicking on the OK button, or by double-clicking on a
// cell in the active list, the user's selections are displayed in a window opened by the
// program at program launch.  (Note that the use of the Return, Enter, Esc and
// Command-period keys as alternatives to clicking the OK and Cancel buttons in the
// dialog box is not supported in this program.)
//
// The program utilizes 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) for the window in which the
//        user's selections are displayed.
//
// •    A'DLOG' resource (purgeable) and associated 'DITL' resource (purgeable) for the
//        dialog box.
//
// •    'STR#' resources (purgeable) containing the text strings for the text list.
//
// •    'PICT' resources (non-purgeable) containing the images for the picture list.
//
// •    An 'LDEF' resource (non-purgeable) containing the custom list definition procedure
//        used by the picture list.
//
// •    A 'SIZE' resource with the acceptSuspendResumeEvents and doesActivateOnFGSwitch
//        flags set.
//
// ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ }

program ListsPascal(input, output);

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

uses

    Windows, Fonts, Menus, TextEdit, Quickdraw, Dialogs, QuickdrawText, Processes, Types,
    Memory, Events, TextUtils, ToolUtils, OSUtils, Devices, Lists, LowMem, SegLoad, Sound;

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

const

mApple = 128;
 iAbout = 1;
mFile = 129;
 iQuit = 11;
mDemonstration = 131;
 iDialog = 1;

rMenubar = 128;
rWindow = 128;
rDialog = 129;
 iOK = 1;
 iCancel = 2;
 iUserItemText = 3;
 iUserItemPict = 4;
rListCellStrings = 128;
rListCellPicts = 128;
rListCellPictTitles = 129;

kUpArrow = $1e;
kDownArrow = $1f;
kTab = $09;
kScrollBarWidth = 15;
kMaxKeyThresh = 120;

kSystemLDEF = 0;
kCustomLDEF = 128;

kMaxLong = $7FFFFFFF;

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

type

ListsRec = record
    textListHdl : ListRef;
    pictListHdl : ListRef;
    end;

ListsRecPtr = ^ListsRec;
ListsRecHandle = ^ListsRecPtr;

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

var

gDone : boolean;
gInBackground : boolean;
gWindowPtr : WindowPtr;
gCurrentListHdl : ListRef;
gTSString : string;
gTSResetThreshold : integer;
gTSLastKeyTime : longint;
gTSLastListHit : ListRef;

menubarHdl : Handle;
menuHdl : MenuHandle;
eventRec : EventRecord;

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

procedure DoInitManagers;

    begin
    MaxApplZone;
    MoreMasters;

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

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

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoDrawDialogDefaultButton }

procedure DoDrawDialogDefaultButton(theDialogPtr : DialogPtr);

    var
    oldPort : WindowPtr;
    oldPenState : PenState;
    itemType : integer;
    itemHandle : Handle;
    itemRect : Rect;
    buttonOval : integer;

    begin
    GetPort(oldPort);
    GetPenState(oldPenState);

    GetDialogItem(theDialogPtr, iOK, itemType, itemHandle, itemRect);
    SetPort(ControlHandle(itemHandle)^^.contrlOwner);
    InsetRect(itemRect, -4, -4);
    buttonOval := (itemRect.bottom - itemRect.top) div 2 + 2;

    if (ControlHandle(itemHandle)^^.contrlHilite = 255) then
        PenPat(qd.gray)
    else
        PenPat(qd.black);

    PenSize(3, 3);
    FrameRoundRect(itemRect, buttonOval, buttonOval);

    SetPenState(oldPenState);
    SetPort(oldPort);
    end;
        {of procedure DoDrawDialogDefaultButton}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoAddRowsAndDataToPictList }

procedure DoAddRowsAndDataToPictList(pictListHdl : ListRef; pictListID : integer);

    var
    rowNumber, pictIndex : integer;
    pictureHdl : PicHandle;
    theCell : Cell;

    begin
    rowNumber := pictListHdl^^.dataBounds.bottom;

    for pictIndex := pictListID to (pictListID + 5) do
        begin
        pictureHdl := GetPicture(pictIndex);

        rowNumber := LAddRow(1, rowNumber, pictListHdl);
        SetPt(theCell, 0, rowNumber);
        LSetCell(@pictureHdl, sizeof(PicHandle), theCell, pictListHdl);

        rowNumber := rowNumber + 1;
        end;
    end;
        {of procedure DoAddRowsAndDataToPictList}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoCreatePictList }

function DoCreatePictList(theDialogPtr : DialogPtr; listRect : Rect;
                                                numCols, lDef : integer) : ListRef;

    var
    dataBounds : Rect;
    cellSize : Point;
    pictListHdl : ListRef;
    theCell : Cell;

    begin
    SetRect(dataBounds, 0, 0, numCols, 0);
    SetPt(cellSize, 48, 48);

    listRect.right := listRect.right - kScrollBarWidth;

    pictListHdl := LNew(listRect, dataBounds, cellSize, lDef, theDialogPtr, true,
                                                                false, false, true);

    pictListHdl^^.selFlags := lOnlyOne;

    DoAddRowsAndDataToPictList(pictListHdl, rListCellPicts);

    SetPt(theCell, 0, 0);
    LSetSelect(true, theCell, pictListHdl);

    DoCreatePictList := pictListHdl;
    end;
        {of function DoCreatePictList}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoAddTextItemAlphabetically }

procedure DoAddTextItemAlphabetically(listHdl : ListRef; theString : string);

    var
    found : boolean;
    totalRows, currentRow, cellDataOffset, cellDataLength : integer;
    aCell : Cell;

    begin
    found := false;

    totalRows := listHdl^^.dataBounds.bottom - listHdl^^.dataBounds.top;
    currentRow := -1;

    while not (found) do
        begin
        currentRow := currentRow + 1;
        if (currentRow = totalRows) then
            found := true
        else begin
            SetPt(aCell, 0, currentRow);
            LGetCellDataLocation(cellDataOffset, cellDataLength, aCell, listHdl);

            MoveHHi(Handle(listHdl^^.cells));
            HLock(Handle(listHdl^^.cells));

            if (IUMagPString(Ptr(longint(@theString) + 1),
                        (Ptr(longint(@listHdl^^.cells) + cellDataOffset)),
                                integer(theString[0]), cellDataLength, nil) = -1) then
                begin
                found := true;
                end;

            HUnlock(Handle(listHdl^^.cells));
            end;
        end;

    currentRow := LAddRow(1, currentRow, listHdl);
    SetPt(aCell, 0, currentRow);

    LSetCell((Ptr(longint(@theString) + 1)), integer(theString[0]), aCell, listHdl);
    end;
        {of procedure DoAddTextAlphabetically}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoAddRowsAndDataToTextList }

procedure DoAddRowsAndDataToTextList(textListHdl : ListRef; stringListID : integer);

    var
    stringIndex : integer;
    theString : string;

    begin
    for stringIndex := 1 to 15 do
        begin
        GetIndString(theString, stringListID, stringIndex);
        DoAddTextItemAlphabetically(textListHdl, theString);
        end;
    end;
        {of procedure DoAddRowsAndDataToTextList}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoResetTypeSelection }

procedure DoResetTypeSelection;

    begin
    gTSString[0] := char(0);
    gTSLastListHit := nil;
    gTSLastKeyTime := 0;
    gTSResetThreshold := 2 * LMGetKeyThresh;
    if (gTSResetThreshold > kMaxKeyThresh) then
        gTSResetThreshold := kMaxKeyThresh;
    end;
        {of procedure DoResetTypeSelection}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoCreateTextList }

function DoCreateTextList(theDialogPtr : DialogPtr; listRect : Rect;
                                    numCols, lDef : integer) : ListRef;

    var
    dataBounds : Rect;
    cellSize : Point;
    textListHdl : ListRef;
    theCell : Cell;

    begin
    SetRect(dataBounds, 0, 0, numCols, 0);
    SetPt(cellSize, 0, 0);

    listRect.right := listRect.right - kScrollBarWidth;

    textListHdl := LNew(listRect, dataBounds, cellSize, lDef, theDialogPtr,
                                                        true, false, false, true);

    DoAddRowsAndDataToTextList(textListHdl, rListCellStrings);

    SetPt(theCell, 0, 0);
    LSetSelect(true, theCell, textListHdl);

    DoResetTypeSelection;

    DoCreateTextList := textListHdl;
    end;
        {of function DoCreateTextList}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoAdjustMenus }

procedure DoAdjustMenus;

    var
    fileMenuHdl, demoMenuHdl : MenuHandle;

    begin
    fileMenuHdl := GetMenuHandle(mFile);
    demoMenuHdl := GetMenuHandle(mDemonstration);

    if (WindowPeek(FrontWindow)^.windowKind = dialogKind) then
        begin
        DisableItem(fileMenuHdl, 0);
        DisableItem(demoMenuHdl, 0);
        end
    else begin
        EnableItem(fileMenuHdl, 0);
        EnableItem(demoMenuHdl, 0);
        end;

    DrawMenuBar;
    end;
        {of procedure DoAdjustMenus}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoCreateDialogWithLists }

procedure DoCreateDialogWithLists;

    var
    modalDlgPtr : DialogPtr;
    listsRecHdl : ListsRecHandle;
    fontNum, itemType : integer;
    itemHdl : Handle;
    itemRect : Rect;
    textListHdl, pictListHdl : ListRef;

    begin
    modalDlgPtr := GetNewDialog(rDialog, nil, WindowPtr(-1));
    if (modalDlgPtr = nil) then
        ExitToShell;

    listsRecHdl := ListsRecHandle(NewHandle(sizeof(ListsRec)));
    if (listsRecHdl = nil) then
        ExitToShell;
    SetWRefCon(modalDlgPtr, longint(listsRecHdl));

    SetPort(modalDlgPtr);

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

    GetDialogItem(modalDlgPtr, iUserItemText, itemType, itemHdl, itemRect);
    textListHdl := DoCreateTextList(modalDlgPtr, itemRect, 1, kSystemLDEF);

    GetDialogItem(modalDlgPtr, iUserItemPict, itemType, itemHdl, itemRect);
    pictListHdl := DoCreatePictList(modalDlgPtr, itemRect, 1, kCustomLDEF);

    listsRecHdl^^.textListHdl := textListHdl;
    listsRecHdl^^.pictListHdl := pictListHdl;

    textListHdl^^.refCon := longint(pictListHdl);
    pictListHdl^^.refCon := longint(textListHdl);

    gCurrentListHdl := textListHdl;

    ShowWindow(modalDlgPtr);
    DoAdjustMenus;

    end;
        {of procedure DoCreateDialogWithLists}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ 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
                gDone := true;
            end;

        mDemonstration: begin
            if (menuItem = iDialog) then
                begin
                SetPort(gWindowPtr);
                EraseRect(gWindowPtr^.portRect);
                DoCreateDialogWithLists;
                end;
            end;
        end;
            {of case statement}

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

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoDisplaySelections }

procedure DoDisplaySelections;

    var
    listsRecHdl : ListsRecHandle;
    textListHdl, pictListHdl : ListRef;
    nextLine, cellIndex : integer;
    theCell : Cell;
    theString : string;
    offset, dataLen : integer;
    ignored : boolean;

    begin
    nextLine := 15;
    listsRecHdl := ListsRecHandle(GetWRefCon(FrontWindow));
    textListHdl := listsRecHdl^^.textListHdl;
    pictListHdl := listsRecHdl^^.pictListHdl;

    HideWindow(FrontWindow);
    SetPort(gWindowPtr);

    MoveTo(10, nextLine);
    DrawString('TIMBER:');
    MoveTo(120, nextLine);
    DrawString('TOOL:');

    for cellIndex := 0 to (textListHdl^^.dataBounds.bottom - 1) do
        begin
        SetPt(theCell, 0, cellIndex);
        if (LGetSelect(false, theCell, textListHdl)) then
            begin
            LGetCellDataLocation(offset, dataLen, theCell, textListHdl);
            LGetCell(Ptr(longint(@theString) + 1), dataLen, theCell, textListHdl);
            theString[0] := char(dataLen);

            nextLine := nextLine + 15;
            MoveTo(10, nextLine);
            DrawString(theString);
            end;
        end;

    SetPt(theCell, 0, 0);
    ignored := LGetSelect(true, theCell, pictListHdl);
    GetIndString(theString, rListCellPictTitles, theCell.v + 1);
    MoveTo(120, 30);
    DrawString(theString);
    end;
        {of procedure DoDisplaySelections}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoDrawActiveListBorder }

procedure DoDrawActiveListBorder(listHdl : ListRef);

    var
    oldPenState : PenState;
    borderRect : Rect;

    begin
    GetPenState(oldPenState);
    PenSize(2, 2);

    borderRect := listHdl^^.rView;
    borderRect.right := borderRect.right + kScrollBarWidth;
    InsetRect(borderRect, -4, -4);

    if ((listHdl = gCurrentListHdl) and listHdl^^.lActive) then
        PenPat(qd.black)
    else
        PenPat(qd.white);

    FrameRect(borderRect);

    SetPenState(oldPenState);
    end;
        {of procedure DoDrawActiveListBorder}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoDrawListsBorders }

procedure DoDrawListsBorders(textListHdl, pictListHdl : ListRef);

    var
    oldPenState : PenState;
    borderRect : Rect;

    begin
    GetPenState(oldPenState);
    PenSize(1, 1);

    borderRect := textListHdl^^.rView;
    InsetRect(borderRect, -1, -1);
    FrameRect(borderRect);

    borderRect := pictListHdl^^.rView;
    InsetRect(borderRect, -1, -1);
    FrameRect(borderRect);

    SetPenState(oldPenState);
    end;
        {of procedure DoDrawListsBorders}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoRotateCurrentList }

procedure DoRotateCurrentList;

    var
    myWindowPtr : WindowPtr;
    oldListHdl, newListHdl : ListRef;

    begin
    myWindowPtr := FrontWindow;
    if (WindowPeek(myWindowPtr)^.windowKind <> dialogKind) then
        Exit(DoRotateCurrentList);

    oldListHdl := gCurrentListHdl;
    newListHdl := ListRef(gCurrentListHdl^^.refCon);
    gCurrentListHdl := newListHdl;

    DoDrawActiveListBorder(oldListHdl);
    DoDrawActiveListBorder(newListHdl);
    end;
        {of procedure DoRotateCurrentList}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoFindNewCellLoc }

procedure DoFindNewCellLoc(listHdl : ListRef; oldCellLoc : Cell; var newCellLoc : Cell;
                            charCode : UInt8; moveToTopBottom : boolean);

    var
    listRows : integer;

    begin
    listRows := listHdl^^.dataBounds.bottom - listHdl^^.dataBounds.top;
    newCellLoc := oldCellLoc;

    if (moveToTopBottom) then
         begin
        if (charCode = kUpArrow) then
            newCellLoc.v := 0
        else if (charCode = kDownArrow) then
            newCellLoc.v := listRows - 1;
        end
    else begin
        if (charCode =  kUpArrow) then
            begin
            if (oldCellLoc.v <> 0) then
                newCellLoc.v := oldCellLoc.v - 1;
            end
        else if (charCode = kDownArrow) then
            begin
            if (oldCellLoc.v <> listRows - 1) then
                newCellLoc.v := oldCellLoc.v + 1;
            end;
        end;
    end;
        {of procedure DoFindNewCellLoc}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoFindFirstSelectedCell }

function DoFindFirstSelectedCell(listHdl : ListRef; var theCell : Cell) : boolean;

    var
    result : boolean;

    begin
    SetPt(theCell, 0, 0);
    result := LGetSelect(true, theCell, listHdl);

    DoFindFirstSelectedCell := result;
    end;
        {of function DoFindFirstSelectedCell}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoFindLastSelectedCell }

procedure DoFindLastSelectedCell(listHdl : ListRef; var theCell : Cell);

    var
    aCell : Cell;
    moreCellsInList : boolean;

    begin
    if (DoFindFirstSelectedCell(listHdl, aCell)) then
        begin
        while (LGetSelect(true, aCell, listHdl)) do
            begin
            theCell := aCell;
            moreCellsInList := LNextCell(true, true, aCell, listHdl);
            end;
        end;
    end;
        {of procedure DoFindLastSelectedCell}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoMakeCellVisible }

procedure DoMakeCellVisible(listHdl : ListRef; newSelection : Cell);

    var
    visibleRect : Rect;
    dRows : integer;

    begin
    visibleRect := listHdl^^.visible;

    if not(PtInRect(newSelection, visibleRect)) then
        begin
        if (newSelection.v > visibleRect.bottom - 1) then
            dRows := newSelection.v - visibleRect.bottom + 1
        else if (newSelection.v < visibleRect.top) then
            dRows := newSelection.v - visibleRect.top;

        LScroll(0, dRows, listHdl);
        end;
    end;
        {of procedure DoMakeCellVisible}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoSelectOneCell }

procedure DoSelectOneCell(listHdl : ListRef; theCell : Cell) ;

    var
    nextSelectedCell : Cell;
    moreCellsInList : boolean;

    begin
    if (DoFindFirstSelectedCell(listHdl, nextSelectedCell)) then
        begin
        while(LGetSelect(true, nextSelectedCell, listHdl)) do
            begin
            if (nextSelectedCell.v <> theCell.v) then
                LSetSelect(false, nextSelectedCell, listHdl)
            else
                moreCellsInList := LNextCell(true, true, nextSelectedCell, listHdl);
            end;

        LSetSelect(true, theCell, listHdl);
        end;
    end;
        {of procedure DoSelectOneCell}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoSearchPartialMatch }

function DoSearchPartialMatch(searchDataPtr, cellDataPtr : Ptr;
                                     cellDataLen, searchDataLen : integer ) : integer;

    var
    result : integer;

    begin
    if ((cellDataLen > 0) and (cellDataLen >= searchDataLen)) then
        result := IUMagIDString(cellDataPtr, searchDataPtr, searchDataLen, searchDataLen)
    else
        result := 1;

    DoSearchPartialMatch := result;
    end;
        {of function DoSearchPartialMatch}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoTypeSelectSearch }

procedure DoTypeSelectSearch( listHdl : ListRef; var theEvent : EventRecord);

    var
    newChar : char;
    theCell : Cell;

    begin
    newChar := chr(BAnd(theEvent.message, charCodeMask));

    if ((gTSLastListHit <> listHdl) or ((theEvent.when - gTSLastKeyTime) >=
         gTSResetThreshold) or (integer(gTSString[0]) = 255)) then
        DoResetTypeSelection;

    gTSLastListHit := listHdl;
    gTSLastKeyTime := theEvent.when;

    gTSString[0] := char(integer(gTSString[0]) + 1);
    gTSString[integer(gTSString[0])] := newChar;

    SetPt(theCell, 0, 0);

    if (LSearch(Ptr(longint(@gTSString) + 1), integer(gTSString[0]), @DoSearchPartialMatch,
                                    theCell, listHdl)) then
        begin
        LSetSelect(true, theCell, listHdl);
        DoSelectOneCell(listHdl, theCell);
        DoMakeCellVisible(listHdl, theCell);
        end;
    end;
        {of procedure DoTypeSelectSearch}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoArrowKeyExtendSelection }

procedure DoArrowKeyExtendSelection(listHdl : ListRef; charCode : UInt8;
                                            moveToTopBottom : boolean);

    var
    currentSelection, newSelection : Cell;

    begin
    if (DoFindFirstSelectedCell(listHdl, currentSelection)) then
        begin
        if (charCode = kDownArrow) then
            DoFindLastSelectedCell(listHdl, currentSelection);

        DoFindNewCellLoc(listHdl, currentSelection, newSelection, charCode,
                                                                moveToTopBottom);

        if not (LGetSelect(false, newSelection, listHdl)) then
            LSetSelect(true, newSelection, listHdl);

        DoMakeCellVisible(listHdl, newSelection);
        end;
    end;
        {of procedure DoArrowKeyExtendSelection}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoArrowKeyMoveSelection }

procedure DoArrowKeyMoveSelection(listHdl : ListRef; charCode : UInt8;
                                            moveToTopBottom : boolean);

    var
    currentSelection, newSelection : Cell;

    begin
    if (DoFindFirstSelectedCell(listHdl, currentSelection)) then
        begin
        if (charCode = kDownArrow) then
            DoFindLastSelectedCell(listHdl, currentSelection);

        DoFindNewCellLoc(listHdl, currentSelection, newSelection, charCode,
                                                                moveToTopBottom);

        DoSelectOneCell(listHdl, newSelection);
        DoMakeCellVisible(listHdl, newSelection);
        end;
    end;
        {of procedure DoArrowKeyMoveSelection}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoHandleArrowKey }

procedure DoHandleArrowKey(charCode : UInt8; var theEvent : EventRecord;
                                            allowExtendSelect : boolean);

    var
    moveToTopBottom : boolean;

    begin
    moveToTopBottom := false;

    if (BAnd(theEvent.modifiers, cmdKey) <> 0) then
        moveToTopBottom := true;

    if (allowExtendSelect and (BAnd(theEvent.modifiers, shiftKey) <> 0)) then
        DoArrowKeyExtendSelection(gCurrentListHdl, charCode, moveToTopBottom)
    else
        DoArrowKeyMoveSelection(gCurrentListHdl, charCode, moveToTopBottom);
    end;
        {of procedure DoHandleArrowKey}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoItemHitInDialog }

procedure DoItemHitInDialog(myDialogPtr : DialogPtr; itemHit : integer);

    var
    listsRecHdl : ListsRecHandle;

    begin
    if ((itemHit = iOK) or (itemHit = iCancel)) then
        begin
        if (itemHit = iOK) then
            DoDisplaySelections;

        listsRecHdl := ListsRecHandle(GetWRefCon(myDialogPtr));

        LDispose(listsRecHdl^^.textListHdl);
        LDispose(listsRecHdl^^.pictListHdl);
        DisposeHandle(Handle(listsRecHdl));
        DisposeDialog(myDialogPtr);

        DoAdjustMenus;
        end;
    end;
        {of procedure DoItemHitInDialog}

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

procedure DoInContent(var theEvent : EventRecord);

    var
    oldPort : GrafPtr;
    listsRecHdl : ListsRecHandle;
    textListHdl, pictListHdl : ListRef;
    textListRect, pictListRect, gCurrentListRect : Rect;
    mouseXY : Point;
    isDoubleClick : boolean;
    theDialogPtr : DialogPtr;
    itemHit : integer;

    begin
    GetPort(oldPort);

    listsRecHdl := ListsRecHandle(GetWRefCon(FrontWindow));
    textListHdl := listsRecHdl^^.textListHdl;
    pictListHdl := listsRecHdl^^.pictListHdl;

    textListRect := listsRecHdl^^.textListHdl^^.rView;
    pictListRect := listsRecHdl^^.pictListHdl^^.rView;
    gCurrentListRect := gCurrentListHdl^^.rView;
    textListRect.right := textListRect.right + kScrollBarWidth;
    pictListRect.right := pictListRect.right + kScrollBarWidth;
    gCurrentListRect.right := gCurrentListRect.right + kScrollBarWidth;

    mouseXY := theEvent.where;
    GlobalToLocal(mouseXY);

    if ((PtInRect(mouseXY, textListRect) and (gCurrentListHdl <> textListHdl)) or
         (PtInRect(mouseXY, pictListRect) and (gCurrentListHdl <> pictListHdl))) then
        begin
        DoRotateCurrentList;
        end
    else if (PtInRect(mouseXY, gCurrentListRect)) then
        begin
        SetPort(gCurrentListHdl^^.port);
        isDoubleClick := LClick(mouseXY, theEvent.modifiers, gCurrentListHdl);
        if (isDoubleClick) then
            DoItemHitInDialog(FrontWindow, iOK);
        end
    else begin
        if (DialogSelect(theEvent, theDialogPtr, itemHit)) then
            DoItemHitInDialog(theDialogPtr, itemHit);
        end;

    SetPort(oldPort);

    end;
        {of procedure DoInContent}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoActivateDialog }

procedure DoActivateDialog(myWindowPtr : WindowPtr; becomingActive : Boolean);

    var
    listRecsHdl : ListsRecHandle;
    textListHdl, pictListHdl : ListRef;
    itemType : integer;
    itemHdl : Handle;
    itemRect : Rect;

    begin
    listRecsHdl := ListsRecHandle(GetWRefCon(myWindowPtr));
    textListHdl := listRecsHdl^^.textListHdl;
    pictListHdl := listRecsHdl^^.pictListHdl;

    if (becomingActive) then
        begin
        GetDialogItem(DialogPtr(myWindowPtr), iOK, itemType, itemHdl, itemRect);
        HiliteControl(ControlHandle(itemHdl), 0);
        GetDialogItem(DialogPtr(myWindowPtr), iCancel, itemType, itemHdl, itemRect);
        HiliteControl(ControlHandle(itemHdl), 0);
        DoDrawDialogDefaultButton(myWindowPtr);

        LActivate(true, textListHdl);
        LActivate(true, pictListHdl);

        DoDrawActiveListBorder(gCurrentListHdl);
        DoResetTypeSelection;
        end
    else begin
        GetDialogItem(DialogPtr(myWindowPtr), iOK, itemType, itemHdl, itemRect);
        HiliteControl(ControlHandle(itemHdl), 255);
        GetDialogItem(DialogPtr(myWindowPtr), iCancel, itemType, itemHdl, itemRect);
        HiliteControl(ControlHandle(itemHdl), 255);
        DoDrawDialogDefaultButton(myWindowPtr);

        LActivate(false, textListHdl);
        LActivate(false, pictListHdl);

        DoDrawActiveListBorder(gCurrentListHdl);
        end;
    end;
        {of procedure DoActivateDialog}

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

procedure DoOSEvent(var theEvent : EventRecord);

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

        suspendResumeMessage:
            begin
            gInBackground := BAnd(theEvent.message, resumeFlag) = 0;
            if (WindowPeek(FrontWindow)^.windowKind = dialogKind) then
                DoActivateDialog(FrontWindow, not (gInBackground));
            end;

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

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

procedure DoActivate(var theEvent : EventRecord);

    var
    myWindowPtr : WindowPtr;
    becomingActive : boolean;

    begin
    myWindowPtr := WindowPtr(theEvent.message);
    becomingActive := (BAnd(theEvent.modifiers, activeFlag) = activeFlag);

    if (WindowPeek(myWindowPtr)^.windowKind = dialogKind) then
        DoActivateDialog(myWindowPtr, becomingActive);
    end;
        {of procedure DoActivate}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoUpdateLists }

procedure DoUpdateLists(myWindowPtr : WindowPtr);

    var
    listsRecHdl : ListsRecHandle;
    textListHdl, pictListHdl : ListRef;

    begin
    listsRecHdl := ListsRecHandle(GetWRefCon(myWindowPtr));

    textListHdl := listsRecHdl^^.textListHdl;
    pictListHdl := listsRecHdl^^.pictListHdl;

    SetPort(textListHdl^^.port);

    LUpdate(textListHdl^^.port^.visRgn, textListHdl);
    LUpdate(pictListHdl^^.port^.visRgn, pictListHdl);

    DoDrawListsBorders(textListHdl, pictListHdl);
    DoDrawActiveListBorder(textListHdl);
    DoDrawActiveListBorder(pictListHdl);
    end;
        {of procedure DoUpdateLists}

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

procedure DoUpdate(var theEvent : EventRecord);

    var
    myWindowPtr : WindowPtr;

    begin
    myWindowPtr := WindowPtr(theEvent.message);

    BeginUpdate(myWindowPtr);

    if (WindowPeek(myWindowPtr)^.windowKind = dialogKind) then
        begin
        UpdateDialog(myWindowPtr, myWindowPtr^.visRgn);
        DoDrawDialogDefaultButton(myWindowPtr);
        DoUpdateLists(myWindowPtr);
        end;

    EndUpdate(myWindowPtr);

    end;
        {of procedure DoUpdate}

{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoKeyDown }

procedure DoKeyDown(charCode : UInt8; var theEvent : EventRecord);

    var
    listsRecHdl : ListsRecHandle;
    allowExtendSelect : boolean;

    begin
    if (WindowPeek(FrontWindow)^.windowKind = dialogKind) then
        begin
        listsRecHdl := ListsRecHandle(GetWRefCon(FrontWindow));

        if (charCode = kTab) then
            DoRotateCurrentList
        else if ((charCode = kUpArrow) or (charCode = kDownArrow)) then
            begin
            if (gCurrentListHdl = listsRecHdl^^.textListHdl) then
                allowExtendSelect := true
            else
                allowExtendSelect := false;
            DoHandleArrowKey(charCode, theEvent, allowExtendSelect);
            end
        else begin
            if (gCurrentListHdl = listsRecHdl^^.textListHdl) then
                DoTypeSelectSearch(listsRecHdl^^.textListHdl, theEvent);
            end;
        end;
    end;
        {of procedure DoKeyDown}
{ ◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊◊ DoMouseDown }

procedure DoMouseDown(var theEvent : EventRecord);

    var
    partCode : integer;
    myWindowPtr : WindowPtr;

    begin
    partCode := FindWindow(theEvent.where, myWindowPtr);

    case (partCode) of

        inMenuBar: begin
            DoAdjustMenus;
            DoMenuChoice(MenuSelect(theEvent.where));
            end;

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

        inContent: begin
            if (myWindowPtr <> FrontWindow) then
                begin
                if (WindowPeek(FrontWindow)^.windowKind = dialogKind) then
                     SysBeep(10)
                else SelectWindow(myWindowPtr);
                end
            else begin
                if (WindowPeek(FrontWindow)^.windowKind = dialogKind) then
                    DoInContent(theEvent);
                end;
            end;

        inDrag: begin
            if ((WindowPeek(FrontWindow)^.windowKind = dialogKind) and
                 (WindowPeek(myWindowPtr)^.windowKind <> dialogKind)) then
                begin
                SysBeep(10);
                Exit(DoMouseDown);
                end;
            DragWindow(myWindowPtr, theEvent.where, qd.screenBits.bounds);
            end;
        end;
            {of statement}
    end;
        {of procedure DoMouseDown}

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

procedure DoEvents(var theEvent : EventRecord);

    var
    charCode : UInt8;

    begin
    case (theEvent.what) of

        mouseDown: begin
            DoMouseDown(theEvent);
            end;

        keyDown, autoKey: begin
            charCode := UInt8(BAnd(theEvent.message, charCodeMask));
            if (BAnd(theEvent.modifiers, cmdKey) <> 0) then
                begin
                DoAdjustMenus;
                DoMenuChoice(MenuKey(char(charCode)));
                end;
            DoKeyDown(charCode, theEvent);
            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

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

    gDone := false;

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

end.

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