Related Info: List Manager Dialog Manager

Long Text Lists in Object Pascal

Here's how you can do very big lists without using the List Manager.

By David Rand

About the author

David Rand is a programmer at the Centre de recherches mathématiques of the Université de Montréal.

The purpose of this article is to present a scrollable vertical list of text implemented in Object Pascal without using the List Manager. The list appears in a sort of modeless dialog box, but without using the Dialog Manager. I will refer to this type of dialog box as a “pseudo-dialog”. Several other objects are also included in order to give a more general overview of the implementation of custom “dialog” items as objects. The result is a very small class library whose hierarchy is illustrated in Figure 1. The two main objects, both direct descendants of the generic object type TObject, are the type TPseudoDialog which implements the window, and the type TPDialogItem which represents a generic pseudo-dialog item and is the parent of all other object types in the hierarchy.

This demonstration illustrates the following:

• an application “shell” which manages events appropriately;

• activation and deactivation of most items as well as the pseudo-dialog as a whole;

• the use of distinct fonts, font sizes and font styles for the different items;

• communication between the main program and the objects in the pseudo-dialog;

• a one-dimensional scrollable text list whose contents are not limited to 32 K in size and whose font, font size and font style are chosen from menus;

• a variety of buttons, including toggle buttons and buttons with a three-dimensional appearance, with command key equivalents;

• a static text item;

• an icon item;

• a simple animation item;

• a simple installation method for items, allowing the programmer to configure other pseudo-dialogs using the items included here or one’s own implementations of new descendants of TPDialogItem.

Figure 1

Naming Conventions

All object type identifiers begin with the capital letter “T”. All object field names begin with lower case “f”. Every object includes an initialization method whose name is identical to the object’s type identifier except that the “T” is replaced by “I”. Parameters to such routines are the same as field names but with the ”f” replaced by “i”. For example, the method TIcon.IIcon(iBorder: Rect; iIconID: INTEGER) is used to initialize an instance of an object of type TIcon by assigning values to fields fBorder and fIconID.

The Pseudo-Dialog

The pseudo-dialog is illustrated in Figures 2 and 3. In Figure 2 BigList is the active application, whereas in the other figure BigList is in the background. The deactivation is visible in several ways: the unhighlighting of the title bar, the graying of the window’s border, the disappearance of the list’s scroll bar, the changed highlighting of the list’s selection, the graying of the button titles, and the graying of the static text’s border.

The way in which this demonstration program reacts to hits in the various items (via the mouse or the keyboard) can be seen in the routine ProcessTheReply in BigList.p.

Figure 2

The Objects

We now consider each of the objects in the hierarchy illustrated in Figure 1.

TObject

The generic object type defined in Object Pascal and ancestor of all other objects types.

TPseudoDialog

An instance of this type is a pseudo-dialog box such as the one illustrated in Figures 2 and 3. The window (stored in field fWindow) is implemented without use of the Dialog Manager, so the object’s methods must include activation, deactivation, update and idle routines, as well as routines which respond to mouse clicks. See the method HandleMouseEvents in BLObject.p. The method ItemInformation calls the Information method of each item (see type TPDialogItem below) and displays the results in a temporary window for debugging purposes. The items are stored as a linked list of objects to which the field fItems gives access. The field fActive indicates whether the window is or is not the active window.

TPDialogItem

This object type defines a generic pseudo-dialog item. No instance of it is ever created, but it is necessary in order to declare basic fields and methods common to all its descendants. The field fNexThing “points” to the next item in the linked list of pseudo-dialog items, fItsValue is the item number, fFlag stores three Boolean flags, and fBorder is the item’s rectangle. The three flags indicate whether the item is active (in the window-activation sense), whether it is enabled (i.e., can it respond to mouse clicks?) and whether it is animated (i.e., does it currently require idling?). The object’s methods include many which resemble those of object type TPseudoDialog; i.e., activation, deactivation, etc. The Information method returns a string briefly describing the item and is useful for debugging.

The objects discussed below are pseudo-dialog items, i.e., descendants of the generic item object TPDialogItem.

Figure 3

TVerticalList

This is the the most complex of the object types in Figure 1 and is illustrated on the left side of the pseudo-dialog box in Figures 2 and 3. It contains a long vertical list which is scrollable and in which a single entry can be selected at a time. The list contents are stored in a single relocatable block accessed via the object’s fData field. For the purposes of this demonstration a list of 10,000 entries is generated, each entry containing a number and a word. (The program has been tested with up to 100,000 entries, corresponding to about 1 Meg. of data in the list.) The entries must be separated by a blank character (ASCII #32) and the first and last bytes in the data must also be blanks. The following features are supported: drag-selecting; choice of font, font size and font style via the Font and Style menus; activation and deactivation (affecting the appearance of both the scroll bar and the selection); selection via the keyboard; and response to double-clicking. Selection from the keyboard starts at the first visible entry. For example in Figure 1, if the user typed “735” then the entry containing “7350•What” would be selected. When the user double-clicks in an entry, the object’s Click routine returns not only its item number in the function result’s low word, but also the code doubleClick in the high word. The application may then take whatever action is appropriate. In this demo, BigList reacts by calling the pseudo-dialog object’s RequestResponse method which then calls the list’s Response method in order to display the currently selected entry in an alert box.

TIcon

This is a simple object which, when enabled, draws an icon in its rectangle. The icon is read from a resource.

TAnimation

This object illustrates idling. It uses several frames (read from ‘PICT’ resources, numbered fBaseID + i, where i = 1, ,fNumber) to draw a simple back-and-forth animation sequence. When the object’s fFlag[animate] is false, the animation is halted, showing only the current frame.

TStaticTex

This simple object just draws a string of text in its rectangle and frames the rectangle with either a solid line (if the item is active) or a dotted line (if inactive). The object has its own font, font size and font style which are assigned when the instance is initialized.

TPlainButton

This object implements a plain button similar to that of the Dialog Manager but allowing choice of font, etc. It is also the ancestor of the three more complicated buttons described below. It has three fields: its title fTitle; the command key equivalents fEquiv (an array of two characters to permit use of upper and lower case); and fFont which stores the font, font size and font style to be used for the title. If the button’s rectangle is initially of zero height, then the initialization method IPlainButton will compute an appropriate value based on the title’s height. The command key fEquiv[1] is drawn (unless it is null) on the right end of the button, and the system font is always used (not the title’s font). The method VisualFeedback simulates a mouse click and is used when one of the button’s command keys is hit. In Figures 2 and 3, the first button, entitled “About ”, is of this type. Its command key is “1”. In this demonstration, BigList responds to a hit in this button by displaying the program’s about box.

TToggleButton

This object is very similar to its parent TPlainButton except for the additional field fStatus which takes values toggleOff and toggleOn. Thus it has the functionality of a checkBox, indicating an on-or-off status. When on, a second outline is drawn inside the button’s main outline. In Figures 2 and 3 the button entitled “Icon” is of this type and is shown “on”. Its command keys are “I” and “i”. In this demonstration, BigList responds to a hit in this button by toggling the enable flag of the TIcon item, causing it to appear or disappear.

TThreeDButton

The graphic response of this object when hit (by the mouse, or using an appropriate command key) simulates a three-dimensional button which is pushed down by the hit and then pops back up when released. This object contains no additional fields. It has the same functionality as its parent TPlainButton, but is more attractive. In this demonstration, BigList responds to a hit in this button by calling the pseudo-dialog’s ItemInformation method.

TToggl3DButton

This object type is a direct descendant of the previous type TThreeDButton and differs from it only in the addition of the field fStatus. Thus it has the functionality of type TToggleButton but is more attractive. (It would be more appropriate to implement this object as a descendant of both TToggleButton and TThreeDButton, but unfortunately Object Pascal does not allow multiple inheritance.) The “on” status of the button is visually indicated in two ways: the border is darkened and the button remains partially pushed down. (In fact the depth of button movement in the “off” and “on” positions is set by global constants shadow3Doff and shadow3Don in BLObject.P.) In Figures 2 and 3, the instance of this button is entitled “Animation” and is shown “on” (in its “off” state it would be identical to the button immediately above it). In this demonstration, BigList responds to a hit in this button by toggling the animate flag of the TAnimation item, causing it to start or stop moving.

Suggestions for further development

This program demonstrates several useful features, but does not however include those listed below. As they say in mathematics text books, the following are “left as an exercise for the reader”.

• handling of Apple events;

• the ability to edit the selected entry in the list, or to add or remove entries;

• a 2-dimensional list with contents not limited to 32 K;

• an editable text item (the field fFlag[animate] could be used to indicate whether the caret should flash);

• the ability to change the size of the vertical list, or the size of the pseudo-dialog itself (in fact, a method TVerticalList.Resize appears in BLObject.p, but is never used);

• selectability, i.e., the user’s ability to select a particular item in the pseudo-dialog so that subsequent events would apply to that item (for example, if the pseudo-dialog included a second list or an editable text item, selectability would be necessary in order to change the font in one item without affecting the other);

• Rez-compatible declarations of the pseudo-dialog and its items, which would allow resource-based configuration (rather than configuration in the Pascal code).

In this version of BigList, the only code used in the high word of the function result of Click and KeyIt methods is the code doubleClick. As more complicated pseudo-dialog items are implemented, further codes can be defined as needed.

Listing: BLObject.P
UNIT BLObject;
{••••• Objects, plus a few utility routines •••••}

INTERFACE

USES  Memtypes,QuickDraw,OSIntf,ToolIntf, 
      PackIntf,FixMath,ObjIntf;

CONST menuCount     =   5;
      ovalSize      =  16;  {For “FrameRoundRect”}
      shadow3Doff   =   3;
      shadow3Don    =   1;
      shadow3Ddiff  = shadow3Doff - shadow3Don;
      minBtnHeight  =  16;
      minBtnDescent =   4;
      scrWidth      =  15;
      scrBarMax     =1000;
      noItemHit     =  -1;
      hiliteMode    =$938;    {Color highlighting}
      textMarge     =   4;
      null          = CHR(0);
      vertListDelay =   4;
      threeDDelay   =   2;
      feedbackDelay =  10;
      animThreshold =   2;  {Ticks between frames}
      listKeyLeng   =  15;
      doubleClick   =   1;
      endOfStyle    =   9;
      origV  =  40;
      origH  =   2;
      toggleOff   =  0;
      toggleOn    =  1;
      scrBarShow  =    0;
      scrBarHide  =  255;
      {------------- RESOURCE ID’S --------------}
      alert1ID    =  129;
      blApplID    = 1000;
      exclamationBaseID = 1000;
      exclamationNumber =    7; {Number of frames}
      {------------- Menu resources -------------}
      applMID  =  1001;
      fileMID  =  applMID + 1;
      editMID  =  fileMID + 1;
      fontMID  =  editMID + 1;
      stylMID  =  fontMID + 1;

TYPE
   Str1        =  String[1];
   StrListKey  =  String[listKeyLeng];
   CharacterSet=  SET OF CHAR;
   FontIdent   =  PACKED RECORD
                     n : INTEGER;    {Font number}
                     s : Byte;         {Font size}
                     y : Style;       {Font style}
                  END;
   MouseIndex  =  (before, now);
   MouseFlags  =
      PACKED ARRAY[MouseIndex] OF BOOLEAN;
   ActivationType =  (active, enable, animate);
   PDItemFlagType =
      PACKED ARRAY[ActivationType] OF BOOLEAN;

   {------------------ Objects ------------------}
   TPseudoDialog = OBJECT (TObject)
      fWindow : WindowPtr;
      fItems  : TPDialogItem;
      fActive : BOOLEAN;
      PROCEDURE Free; OverRide;
      PROCEDURE IPseudoDialog
                (iBounds : Rect;
                  iTitle : Str255;
                 iWithGA : BOOLEAN;
                   iFont : FontIdent);
      PROCEDURE InstallItem(chose:TPDialogItem);
      PROCEDURE ItemInformation;
      PROCEDURE EnableDisableItem
                (index : INTEGER);
      PROCEDURE AnimateStuff;
      PROCEDURE DrawBorder;
      PROCEDURE ActivateWindow;
      PROCEDURE DeactivateWindow;
      PROCEDURE UpdateWindKernel;
      PROCEDURE UpdateWindow;
      PROCEDURE Idling;
      PROCEDURE SetFont;
      FUNCTION  Keying(c : CHAR;
                   modif : INTEGER) : LongInt;
      FUNCTION  MouseInContent(p : Point;
                modif : INTEGER) : LongInt;
      PROCEDURE MouseInDrag(p : Point);
      FUNCTION  HandleMouseEvents
                     (p : Point;
                  modif : INTEGER;
                thePart : INTEGER) : LongInt;
      PROCEDURE RequestResponse
                (theItem, theKind : INTEGER);
   END;

   TPDialogItem = OBJECT (TObject)
      fNexThing : TPDialogItem;
      fItsValue : INTEGER;
      fFlag     : PDItemFlagType;
      fBorder   : Rect;
      PROCEDURE Free; OverRide;
      PROCEDURE IPDialogItem(iBorder : Rect);
      FUNCTION  Information : Str255;
      PROCEDURE EnableDisable(index : INTEGER);
      PROCEDURE AnimateIt;
      PROCEDURE GetRectangle(VAR r : Rect);
      PROCEDURE Draw;
      PROCEDURE UpdateIt;
      PROCEDURE ActivateIt;
      PROCEDURE DeactivateIt;
      PROCEDURE Idle;
      PROCEDURE SetItemFont;
      FUNCTION  Click(p : Point;
                  modif : INTEGER) : LongInt;
      FUNCTION  KeyIt(c : CHAR;
                  modif : INTEGER) : LongInt;
      PROCEDURE Response(theItem,
                         theKind : INTEGER);
   END;

   TVerticalList = OBJECT (TPDialogItem)
      fLength,             {Entries in list}
      fSelect,             {Nº of selected entry}
      fOffLin : LongInt;   {Scrolled off top}
      fOffByt : LongInt;   {Before first visible}
      fData   : Handle;    {The entries}
      fFont   : FontIdent;
      fHeight,             {Cell height, pixels}
      fDescent: INTEGER;   {Font descent, pixels}
      fPort   : WindowPtr;
      fScroll : ControlHandle;

      fUserHitKeys : StrListKey;
      fLastKeyTime : LongInt;

      PROCEDURE Free; OverRide;
      PROCEDURE IVerticalList
                (iBorder : Rect;
                   iPort : WindowPtr);
      FUNCTION  Information : Str255; OverRide;
      PROCEDURE SetMeasures;
      PROCEDURE GetRectangle(VAR r : Rect);
                OverRide;
      FUNCTION  VisibleLines : INTEGER;
      PROCEDURE InstallData(theText : Handle);
      PROCEDURE DrawOneEntry(x,y : LongInt);
      PROCEDURE DrawEntries;
      FUNCTION  GetSelection : Str63;
      PROCEDURE SelectionRectangle(VAR r:Rect);
      PROCEDURE HiliteSelection;
      PROCEDURE ActivationSel(activate:BOOLEAN);
      PROCEDURE DrawEntsAndSel;
      PROCEDURE DrawBorder;
      PROCEDURE Draw; OverRide;
      PROCEDURE ActivateIt; OverRide;
      PROCEDURE DeactivateIt; OverRide;
      PROCEDURE SetItemFont; OverRide;
      PROCEDURE CheckScrollability;
      PROCEDURE SetScrollValue;
      PROCEDURE OneLineLess;
      PROCEDURE OneLineMore;
      PROCEDURE RecalOffByte;
      PROCEDURE OnePageLess;
      PROCEDURE OnePageMore;
      PROCEDURE Thumbing(p : Point);
      PROCEDURE Scrolling(part : INTEGER);
      PROCEDURE DragSelecting;
      FUNCTION  Click(p : Point;
                  modif : INTEGER) : LongInt;
                  OverRide;
      PROCEDURE CancelSelection;
      PROCEDURE SetSelection(newSel : LongInt);
      PROCEDURE ShowSelection;
      PROCEDURE InitKeyStuff;
      PROCEDURE SelectCellStart(c : CHAR);
      FUNCTION  KeyIt(c : CHAR;
                  modif : INTEGER) : LongInt;
                  OverRide;
      PROCEDURE Response(theItem,
                theKind : INTEGER); OverRide;
      PROCEDURE Resize(hauteur : INTEGER);
   END;

   TPlainButton = OBJECT (TPDialogItem)
      fTitle : Str15;
      fEquiv : PACKED ARRAY[1..2] OF CHAR;
      fFont  : FontIdent;
      PROCEDURE IPlainButton(iBorder : Rect;
                              iTitle : Str15;
                              iEquiv : CHAR;
                               iFont : FontIdent);
      FUNCTION  KeyInfo : Str15;
      FUNCTION  ButtonInfo : Str255;
      FUNCTION  Information : Str255; OverRide;
      FUNCTION  ExtraHeight : INTEGER;
      PROCEDURE DrawTitle(r : Rect);
      PROCEDURE Draw; OverRide;
      PROCEDURE ActivateIt; OverRide;
      PROCEDURE DeactivateIt; OverRide;
      FUNCTION  Click(p : Point;
                  modif : INTEGER) : LongInt;
                  OverRide;
      PROCEDURE Invert(r : Rect);
      FUNCTION  MouseReleasedHere : BOOLEAN;
      PROCEDURE VisualFeedback;
      FUNCTION  KeyIt(c : CHAR;
                  modif : INTEGER) : LongInt;
                  OverRide;
   END;

   TToggleButton = OBJECT (TPlainButton)
      fStatus : INTEGER;
      PROCEDURE IToggleButton(iBorder : Rect;
                               iTitle : Str15;
                               iEquiv : CHAR;
                                iFont : FontIdent;
                              iStatus : INTEGER);
      FUNCTION  ButtonInfo : Str255; OverRide;
      FUNCTION  ExtraHeight : INTEGER; OverRide;
      PROCEDURE Draw; OverRide;
      FUNCTION  Click(p : Point;
                  modif : INTEGER) : LongInt;
                  OverRide;
      PROCEDURE VisualFeedback; OverRide;
   END;

   TThreeDButton = OBJECT (TPlainButton)
      PROCEDURE IThreeDButton
                (iBorder : Rect;
                  iTitle : Str15;
                  iEquiv : CHAR;
                   iFont : FontIdent);
      FUNCTION  ButtonInfo : Str255; OverRide;
      FUNCTION  ExtraHeight : INTEGER; OverRide;
      PROCEDURE FancyBorder(r : Rect;
                      hilited : BOOLEAN);
      PROCEDURE DropShadow(r : Rect;
                       depth : INTEGER);
      PROCEDURE Draw; OverRide;
      PROCEDURE PushDown(VAR r : Rect;
                         depth : INTEGER);
      PROCEDURE PopUp(VAR r : Rect;
                      depth : INTEGER);
      FUNCTION  MouseReleasedHere : BOOLEAN;
                OverRide;
      PROCEDURE VisualFeedback; OverRide;
   END;

   TToggl3DButton = OBJECT (TThreeDButton)
      fStatus : INTEGER;
      PROCEDURE IToggl3DButton
                (iBorder : Rect;
                  iTitle : Str15;
                  iEquiv : CHAR;
                   iFont : FontIdent;
                 iStatus : INTEGER);
      FUNCTION  ButtonInfo : Str255; OverRide;
      PROCEDURE Draw; OverRide;
      FUNCTION  MouseReleasedHere : BOOLEAN;
                OverRide;
      FUNCTION  Click(p : Point;
                  modif : INTEGER) : LongInt;
                  OverRide;
      PROCEDURE VisualFeedback; OverRide;
   END;

   TIcon = OBJECT (TPDialogItem)
      fIconID : INTEGER;
      PROCEDURE IIcon(iBorder : Rect;
                      iIconID : INTEGER);
      FUNCTION  Information : Str255; OverRide;
      PROCEDURE Draw; OverRide;
   END;

   TAnimation = OBJECT (TPDialogItem)
      fBaseID  : INTEGER;
      fNumber  : INTEGER;
      fCurrent : INTEGER;
      fForward : BOOLEAN; {Direction of animation}
      fLastTim : LongInt;
      PROCEDURE IAnimation(iBorder : Rect;
                           iBaseID : INTEGER;
                           iNumber : INTEGER);
      FUNCTION  Information : Str255; OverRide;
      PROCEDURE NextFrame;
      PROCEDURE Idle; OverRide;
      PROCEDURE Draw; OverRide;
   END;

   TStaticText = OBJECT (TPDialogItem)
      fContents : Str255;
      fFont     : FontIdent;
      PROCEDURE IStaticText(iBorder : Rect;
                              iFont : FontIdent;
                          iContents : Str255);
      FUNCTION  Information : Str255; OverRide;
      PROCEDURE DrawBorder;
      PROCEDURE Draw; OverRide;
      PROCEDURE ActivateIt; OverRide;
      PROCEDURE DeactivateIt; OverRide;
   END;

VAR
   myMenus    : ARRAY[1..menuCount] OF MenuHandle;
   theFontMenu,
   theStylMenu: MenuHandle;
   styleVector: PACKED ARRAY[2..8] OF StyleItem;
   fakeDlg    : TPseudoDialog;
   theEvent   : EventRecord;
   weAreDone,
   inBckGrnd,
   wneExists,
   dublClick  : BOOLEAN;
   forNowFI,
   defaultFI  : FontIdent;
   entr,
   cRet,
   left,
   right,
   up,
   down,
   blnkChr    : CHAR;
   blnkPtr    : Ptr;
   zoomArea,
   dragArea   : Rect;
   XCursor,
   waitCursor : CursHandle;
   lastClikPoint : Point;
   lastClikTime  : LongInt;

PROCEDURE SetFontIdent(font : FontIdent);
PROCEDURE SetFontSizeFace(fn,fs : INTEGER;
                             fy : Style);
PROCEDURE GetFontIdent(VAR font : FontIdent);
PROCEDURE SetFontMenu;
PROCEDURE SetSizeMenu;
PROCEDURE SetStylMenu;
PROCEDURE FontMenuEvent(theItem : INTEGER);
PROCEDURE StyleMenuEvent(theItem : INTEGER);
 FUNCTION MakeStr1(c : CHAR) : Str1;
 FUNCTION IntString(x : LongInt)  :  Str15;
 FUNCTION StringInt(s : Str15) : LongInt;
 FUNCTION NumericStr(s : Str255)  :  BOOLEAN;
PROCEDURE MyInvertRect(r : Rect);
PROCEDURE RestoreClip;
PROCEDURE FrameTop(r : Rect);
PROCEDURE FrameBot(r : Rect);
PROCEDURE CentreRect(VAR r : Rect);
 FUNCTION ScrollBarShowHide(b : BOOLEAN) : Byte;
PROCEDURE SimpleAlert(s : Str255);
 FUNCTION GetKind(w : WindowPtr) : INTEGER;
PROCEDURE CheckMultipleClicks(p : Point);

IMPLEMENTATION
{$S Main}
{••••••••••••••••••••••••••••••••••••••••••••••••}
{ Routines for getting and setting the font,     }
{ font size, and font style in the current port. }
{••••••••••••••••••••••••••••••••••••••••••••••••}
PROCEDURE SetFontIdent(font : FontIdent);
BEGIN
   WITH font DO BEGIN
      TextFont(n);
      TextSize(s);
      TextFace(y);
   END;
END;

PROCEDURE SetFontSizeFace(fn,fs : INTEGER;
                             fy : Style);
BEGIN
   TextFont(fn);
   TextSize(fs);
   TextFace(fy);
END;

PROCEDURE GetFontIdent(VAR font : FontIdent);
BEGIN
   WITH font,thePort^ DO BEGIN
      n:= txFont;
      s:= txSize;
      y:= txFace;
   END;
END;

{••••••••••••••••••••••••••••••••••••••••••••••••}
{ Routines which manage the Font and Style menus,}
{ including highlighting of font sizes in second }
{ half of Style menu. The current font, size and }
{ style are stored in global “forNowFI”.         }
{••••••••••••••••••••••••••••••••••••••••••••••••}
PROCEDURE SetFontMenu;
VAR   fontName,
      itemName  :  Str255;
      i,size    :  INTEGER;
BEGIN
   GetFontName(forNowFI.n,fontName);
   i:= CountMItems(theFontMenu);
   WHILE i > 0 DO BEGIN
      GetItem(theFontMenu,i,itemName);
      CheckItem(theFontMenu,i,itemName=fo ntName);
      i:= i - 1;
   END;
   i:= CountMItems(theStylMenu);
   WHILE i > endOfStyle DO BEGIN
      GetItem(theStylMenu,i,itemName);
      IF NumericStr(itemName) THEN BEGIN
         size:= StringInt(itemName);
         IF RealFont(forNowFI.n,size) THEN
            SetItemStyle(theStylMenu,
            i,[bold,outline])
         ELSE SetItemStyle(theStylMenu,i,[]);
      END;
      i:= i - 1;
   END;
END;

PROCEDURE SetSizeMenu;
VAR   i  :  INTEGER;
      fSize  :  String[3];
      iSize  :  Str255;
BEGIN
   fSize:= IntString(forNowFI.s);
   i:= CountMItems(theStylMenu);
   WHILE i > endOfStyle DO BEGIN
      GetItem(theStylMenu,i,iSize);
      CheckItem(theStylMenu,i,iSize = fSize);
      i:= i - 1;
   END;
END;

PROCEDURE SetStylMenu;
VAR   i  :  INTEGER;
BEGIN
   CheckItem(theStylMenu,1,(forNowFI.y  = []));
   FOR i:= 2 TO endOfStyle-1 DO CheckItem
      (theStylMenu,i,
       (styleVector[i] IN forNowFI.y));
END;

{••••••••••••••••••••••••••••••••••••••••••••••••}
{ Routines which respond to mouse hits in the    }
{ Font and Style menus.                          }
{••••••••••••••••••••••••••••••••••••••••••••••••}
PROCEDURE FontMenuEvent(theItem : INTEGER);
VAR   theName  :  Str255;
BEGIN
   GetItem(theFontMenu,theItem,theName );
   GetFNum(theName,theItem);
   IF theItem <> forNowFI.n THEN BEGIN
      forNowFI.n:= theItem;
      SetFontMenu;
   END;
END;

PROCEDURE StyleMenuEvent(theItem : INTEGER);
VAR   theName  :  Str255;
      theStyle :  StyleItem;
BEGIN
   IF theItem < endOfStyle THEN BEGIN
      IF theItem = 1 THEN forNowFI.y:= []
      ELSE BEGIN
         theStyle:= styleVector[theItem];
         IF theStyle IN forNowFI.y THEN
            forNowFI.y:= forNowFI.y - [theStyle]
         ELSE BEGIN
            forNowFI.y:= forNowFI.y + [theStyle];
            IF theStyle = condense THEN
               forNowFI.y:= forNowFI.y - [extend]
            ELSE IF theStyle = extend THEN
               forNowFI.y:= forNowFI.y-[condense];
         END;
      END;
      SetStylMenu;
   END
   ELSE IF theItem > endOfStyle THEN BEGIN
      GetItem(theStylMenu,theItem,theName );
      IF NumericStr(theName) THEN BEGIN
         theItem:= StringInt(theName);
         IF theItem <> forNowFI.s THEN BEGIN
            forNowFI.s:= theItem;
            SetSizeMenu;
         END;
      END
      ELSE SysBeep(1);
   END;
END;

{••••••••••••••••••••••••••••••••••••••••••••••••}
{ Various string-conversion routines.            }
{••••••••••••••••••••••••••••••••••••••••••••••••}
FUNCTION MakeStr1(c : CHAR) : Str1;
VAR   s  :  Str1;
BEGIN
   s[0]:= CHR(1);
   s[1]:= c;
   MakeStr1:= s;
END;

{ “IntString” converts "x" to string. }
FUNCTION IntString(x : LongInt)  :  Str15;
VAR   s  :  Str255;
BEGIN
   NumToString(x,s);
   IF Length(s) > 15 THEN s[0]:= CHR(15);
   IntString:= s;
END;

{ “StringInt” converts numeric “s” to LongInt}
FUNCTION StringInt(s : Str15) : LongInt;
VAR   x  :  LongInt;
BEGIN StringToNum(s,x); StringInt:= x; END;

{ “NumericStr” is a Boolean function, TRUE
  if and only if “s” is entirely numeric,
  with no leading sign, & of length at least 1. }
FUNCTION NumericStr(s : Str255)  :  BOOLEAN;
VAR   i  :  INTEGER;
BEGIN
   NumericStr:= FALSE;  {Default}
   i:= Length(s);
   IF i = 0 THEN Exit(NumericStr);
   REPEAT
      IF NOT (s[i] IN ['0'..'9']) THEN
         Exit(NumericStr);
      i:= i - 1;
   UNTIL i = 0;
   NumericStr:= TRUE;
END;

{••••••••••••••••••••••••••••••••••••••••••••••••}
{ Various graphic routines.                      }
{••••••••••••••••••••••••••••••••••••••••••••••••}
PROCEDURE MyInvertRect(r : Rect);
BEGIN
   BitClr(Ptr(hiliteMode),pHiliteBit); 
   InvertRect(r);
END;

PROCEDURE RestoreClip;
VAR   i  :  INTEGER;
      r  :  Rect;
BEGIN
   i:= MaxInt DIV 2;
   SetRect(r,-i,-i,i,i);
   ClipRect(r);
END;

PROCEDURE FrameTop(r : Rect);
BEGIN
   MoveTo(r.left,   r.bottom-1);
   LineTo(r.left,   r.top);
   LineTo(r.right-1,r.top);
END;

PROCEDURE FrameBot(r : Rect);
BEGIN
   MoveTo(r.left,   r.bottom-1);
   LineTo(r.right-1,r.bottom-1);
   LineTo(r.right-1,r.top);
END;

PROCEDURE CentreRect(VAR r : Rect);
VAR   x,y  :  INTEGER;
BEGIN
   WITH zoomArea DO BEGIN
      x:= ((right -left)-(r.right -r.left)) DIV 2;
      y:= ((bottom-top )-(r.bottom-r.top )) DIV 2;
   END;
   OffsetRect(r,x,y+origV);
END;

FUNCTION ScrollBarShowHide(b : BOOLEAN) : Byte;
BEGIN
   IF b THEN ScrollBarShowHide:= scrBarShow
        ELSE ScrollBarShowHide:= scrBarHide;
END;

{••••••••••••••••••••••••••••••••••••••••••••••••}
{ Miscellaneous routines                         }
{••••••••••••••••••••••••••••••••••••••••••••••••}
{ Alert box with one message & OK button }
PROCEDURE SimpleAlert(s : Str255);
VAR   g :  GrafPtr;
BEGIN
   GetPort(g);
   SetCursor(arrow);
   ParamText(s,'','','');
   IF NoteAlert(alert1ID,NIL) = ok THEN {Nada};
   SetCursor(waitCursor^^);
   SetPort(g);
END;

{ Returns windowKind of “w”. Zero if “w” is NIL.}
FUNCTION GetKind(w : WindowPtr) : INTEGER;
BEGIN
   IF w = NIL THEN GetKind:= 0
   ELSE GetKind:= WindowPeek(w)^.windowKind;
END;

{ Check for double clicks }
PROCEDURE CheckMultipleClicks(p : Point);
CONST clickSeuil = 4;
BEGIN
   dublClick:=
      (theEvent.when-lastClikTime) <= GetDblTime;
   IF dublClick THEN BEGIN
      SubPt(lastClikPoint,p);
      dublClick:= (ABS(p.h) < clickSeuil) AND
                  (ABS(p.v) < clickSeuil);
      { Don’t report a double-click until
        the mouse button is released. }
      IF dublClick THEN
         REPEAT UNTIL NOT WaitMouseUp;
   END;
   lastClikPoint:= theEvent.where;
   lastClikTime := theEvent.when;
END;

{ Encode low-word & high-word into a LongInt }
FUNCTION MakeLongInt(lo,hi : INTEGER) : LongInt;
BEGIN MakeLongInt:= lo + hi*$00010000; END;

{••••••••••••••••••••••••••••••••••••••••••••••••}
{ METHODS OF OBJECT TYPE “TPseudoDialog”.        }
{••••••••••••••••••••••••••••••••••••••••••••••••}
PROCEDURE TPseudoDialog.Free;
VAR   p  :  Ptr;
BEGIN
   IF fItems <> NIL THEN fItems.Free;
   p:= Ptr(fWindow);
   CloseWindow(fWindow);
   DisposPtr(p);
   INHERITED Free;
END;

PROCEDURE TPseudoDialog.IPseudoDialog
                   (iBounds : Rect;
                     iTitle : Str255;
                    iWithGA : BOOLEAN;
                      iFont : FontIdent);
VAR   wStorage  :  Ptr;
BEGIN
   wStorage:= NewPtr(SizeOf(WindowRecord));
   IF wStorage = NIL THEN ExitToShell;
   fWindow:= NewWindow(wStorage,iBounds,
      iTitle,FALSE,noGrowDocProc,
      WindowPtr(-1),iWithGA,ORD(SELF));
   SetPort(fWindow);
   SetFontIdent(iFont);
   fItems:= NIL;
   fActive:= FALSE;
END;

{ Install “chose” at end of linked list
  headed by “fItems”;
  also initialize “chose.fItsValue”.}
PROCEDURE TPseudoDialog.InstallItem
          (chose : TPDialogItem);
VAR   scan  :  TPDialogItem;
BEGIN
   IF fItems = NIL THEN BEGIN
      chose.fItsValue:= 1;
      fItems:= chose;
   END
   ELSE BEGIN
      chose.fItsValue:= 2;
      scan:= fItems;
      WHILE scan.fNexThing <> NIL DO BEGIN
         chose.fItsValue:= chose.fItsValue + 1;
         scan:= scan.fNexThing;
      END;
      scan.fNexThing:= chose;
   END;
END;

PROCEDURE TPseudoDialog.ItemInformation;
CONST lineHeight = 15;
VAR   w  :  WindowPtr;
      r  :  Rect;
      s  :  Str255;
      p  :  TPDialogItem;
      i  :  INTEGER;
BEGIN
   DeactivateWindow;
   SetRect(r,0,0,420,250);  CentreRect(r);
   GetWTitle(fWindow,s);
   s:= Concat('Items in “',s,'”');
   w:= NewWindow(NIL,r,s,TRUE,noGrowDocProc,
      WindowPtr(-1),FALSE,0);
   SetPort(w);
   SetFontSizeFace(geneva,9,[bold]);
   i:= 0;
   r:= w^.portRect;  r.left:= r.left + 5;
   p:= fItems;
   WHILE p <> NIL DO BEGIN
      i:= i + 1;
      r.top:= r.top + lineHeight;
      MoveTo(r.left,r.top);
      s:= p.Information;
      s:= Concat(IntString(i),'. ',s);
      IF i < 10 THEN s:= Concat(blnkChr,s);
      DrawString(s);
      p:= p.fNexThing;
   END;
   REPEAT SystemTask UNTIL Button;
   FlushEvents(everyEvent,0);
   DisposeWindow(w);
END;

PROCEDURE TPseudoDialog.EnableDisableItem
          (index : INTEGER);
BEGIN
   IF fItems <> NIL THEN BEGIN
      SetPort(fWindow);
      fItems.EnableDisable(index);
   END;
END;

PROCEDURE TPseudoDialog.AnimateStuff;
BEGIN
   IF fItems <> NIL THEN BEGIN
      SetPort(fWindow);
      fItems.AnimateIt;
   END;
END;

PROCEDURE TPseudoDialog.DrawBorder;
VAR   r  :  Rect;
BEGIN
   r:= fWindow^.portRect;
   InsetRect(r,2,2);
   PenSize(2,2);
   IF fActive THEN PenPat(black)
              ELSE PenPat(gray);
   FrameRect(r);
   PenNormal;
END;

PROCEDURE TPseudoDialog.ActivateWindow;
BEGIN
   {Following line prevents multiple activation}
   IF fActive THEN Exit(ActivateWindow);
   fActive:= TRUE;
   SetPort(fWindow);
   DrawBorder;
   IF fItems <> NIL THEN fItems.ActivateIt;
END;

PROCEDURE TPseudoDialog.DeactivateWindow;
BEGIN
   {Following line prevents multiple deactivation}
   IF NOT fActive THEN Exit(DeactivateWindow);
   fActive:= FALSE;
   SetPort(fWindow);
   DrawBorder;
   IF fItems <> NIL THEN fItems.DeactivateIt;
END;

PROCEDURE TPseudoDialog.UpdateWindKernel;
BEGIN
   DrawBorder;
   IF fItems <> NIL THEN fItems.UpdateIt;
END;

PROCEDURE TPseudoDialog.UpdateWindow;
VAR   g  :  GrafPtr;
BEGIN
   GetPort(g);
   SetPort(fWindow);
   BeginUpdate(fWindow);
   UpdateWindKernel;
   EndUpdate(fWindow);
   SetPort(g);
END;

PROCEDURE TPseudoDialog.Idling;
BEGIN
   IF fItems <> NIL THEN fItems.Idle;
END;

PROCEDURE TPseudoDialog.SetFont;
VAR   g  :  GrafPtr;
BEGIN
   GetPort(g);
   SetPort(fWindow);
   fItems.SetItemFont;
   SetPort(g);
END;

FUNCTION TPseudoDialog.Keying
         (c : CHAR;   modif : INTEGER) : LongInt;
VAR   result  :  INTEGER;
BEGIN
   IF fItems = NIL
      THEN Keying:= noItemHit
      ELSE Keying:= fItems.KeyIt(c,modif);
END;

FUNCTION TPseudoDialog.MouseInContent(p : Point;
                       modif : INTEGER) : LongInt;
BEGIN
   MouseInContent:= noItemHit;   {Default}
   IF fItems = NIL THEN Exit(MouseInContent);
   CheckMultipleClicks(p);
   GlobalToLocal(p);
   MouseInContent:= fItems.Click(p,modif);
END;

PROCEDURE TPseudoDialog.MouseInDrag(p : Point);
BEGIN DragWindow(fWindow,p,dragArea); END;

FUNCTION TPseudoDialog.HandleMouseEvents
               (p : Point;
            modif : INTEGER;
          thePart : INTEGER) : LongInt;
BEGIN
   HandleMouseEvents:= noItemHit; {Default}
   CASE thePart OF
     inContent:IF fWindow <> FrontWindow
                  THEN SelectWindow(fWindow)
                  ELSE HandleMouseEvents:=
                     MouseInContent(p,modif);
        inDrag:MouseInDrag(p);
   END;
END;

PROCEDURE TPseudoDialog.RequestResponse
          (theItem, theKind : INTEGER);
BEGIN
   IF fItems <> NIL THEN
      fItems.Response(theItem,theKind);
END;

{••••••••••••••••••••••••••••••••••••••••••••••••}
{ METHODS OF OBJECT TYPE “TPDialogItem”.         }
{••••••••••••••••••••••••••••••••••••••••••••••••}
PROCEDURE TPDialogItem.Free;
BEGIN
   IF fNexThing <> NIL THEN fNexThing.Free;
   INHERITED Free;
END;

PROCEDURE TPDialogItem.IPDialogItem(iBorder:Rect);
BEGIN
   fNexThing:= NIL;  fItsValue:= noItemHit;
   { The above will be re-initialized
     by “TPseudoDialog.InstallItem” }
   fFlag[active] := FALSE;
   fFlag[enable] := FALSE;
   fFlag[animate]:= FALSE;
   fBorder:= iBorder;
END;

FUNCTION TPDialogItem.Information : Str255;
BEGIN
   Information:= '[Generic item]';
END;

PROCEDURE TPDialogItem.EnableDisable
          (index : INTEGER);
BEGIN
   IF index = fItsValue THEN BEGIN
      fFlag[enable]:= NOT fFlag[enable];
      Draw;
   END
   ELSE IF fNexThing <> NIL THEN
      fNexThing.EnableDisable(index);
END;

PROCEDURE TPDialogItem.AnimateIt;
BEGIN
   fFlag[animate]:= NOT fFlag[animate];
   IF fNexThing <> NIL THEN fNexThing.AnimateIt;
END;

PROCEDURE TPDialogItem.GetRectangle(VAR r:Rect);
BEGIN r:= fBorder; END;

PROCEDURE TPDialogItem.Draw; {Dummy ancestor}
BEGIN  SysBeep(1);  END;

{ Method “UpdateIt” must be sandwiched
  between “BeginUpdate” & “EndUpdate”.}
PROCEDURE TPDialogItem.UpdateIt;
BEGIN
   Draw;
   IF fNexThing <> NIL THEN fNexThing.UpdateIt;
END;

PROCEDURE TPDialogItem.ActivateIt;
BEGIN
   IF fNexThing <> NIL THEN fNexThing.ActivateIt;
END;

PROCEDURE TPDialogItem.DeactivateIt;
BEGIN
   IF fNexThing<>NIL THEN fNexThing.DeactivateIt;
END;

PROCEDURE TPDialogItem.Idle;
BEGIN
   IF fNexThing <> NIL THEN fNexThing.Idle;
END;

PROCEDURE TPDialogItem.SetItemFont;
BEGIN
   IF fNexThing <> NIL THEN fNexThing.SetItemFont;
END;

FUNCTION TPDialogItem.Click
         (p : Point;  modif : INTEGER) : LongInt;
VAR   r  :  Rect;
BEGIN
   GetRectangle(r);
   IF PtInRect(p,r) THEN BEGIN
      IF fFlag[enable] THEN Click:= fItsValue
                       ELSE Click:= noItemHit;
   END
   ELSE IF fNexThing = NIL THEN Click:= noItemHit
   ELSE Click:= fNexThing.Click(p,modif);
END;

{ Method “KeyIt” is a function so we can return an
  item number if appropriate for a particular key}
FUNCTION TPDialogItem.KeyIt
         (c : CHAR;  modif : INTEGER) : LongInt;
BEGIN
   IF fNexThing = NIL THEN KeyIt:= noItemHit
   ELSE KeyIt:= fNexThing.KeyIt(c,modif);
END;

PROCEDURE TPDialogItem.Response
          (theItem,theKind : INTEGER);
BEGIN
   IF fNexThing <> NIL THEN
      fNexThing.Response(theItem,theKind) ;
END;

{••••••••••••••••••••••••••••••••••••••••••••••••}
{ METHODS OF OBJECT TYPE “TVerticalList”.        }
{••••••••••••••••••••••••••••••••••••••••••••••••}
PROCEDURE TVerticalList.Free;
BEGIN
   IF fData <> NIL THEN DisposHandle(fData);
   INHERITED Free;
END;

PROCEDURE TVerticalList.IVerticalList
          (iBorder : Rect;  iPort : WindowPtr);
BEGIN
   IPDialogItem(iBorder);
   fFlag[enable]:= TRUE;   {Override the default}
   fLength:= 0;
   fSelect:= 0;
   fOffLin:= 0;
   fOffByt:= 0;
   fData  := NIL;
   fFont  := forNowFI;
   SetMeasures;
   iBorder.left:= iBorder.right - scrWidth + 1;
   InsetRect(iBorder,-1,-1);
   fPort  := iPort;
   fScroll:= NewControl(iPort,iBorder,'',FALSE,
      0,0,scrBarMax,scrollBarProc,0);
   InitKeyStuff;
END;

FUNCTION TVerticalList.Information : Str255;
VAR   s  :  Str255;
BEGIN
   s:= Concat('List, ',
      IntString(fLength),' entries, ');
   IF fSelect = 0 THEN
      s:= Concat(s,'nothing selected, ')
   ELSE s:= Concat(s,'#',
      IntString(fSelect),' selected, ');
   s:= Concat(s,IntString(fOffLin),
      ' entries scrolled off top.');
   Information:= s;
END;

PROCEDURE TVerticalList.SetMeasures;
VAR   f  :  FontIdent;
      fm :  FMetricRec;
BEGIN
   f:= fFont;
   SetFontIdent(f);
   FontMetrics(fm);
   WITH fm DO BEGIN
      fHeight := FixRound(ascent+descent+leading);
      fDescent:= FixRound(descent);
   END;
END;

PROCEDURE TVerticalList.GetRectangle(VAR r:Rect);
BEGIN
   r:= fBorder;
   r.right:= r.right - scrWidth;
END;

FUNCTION TVerticalList.VisibleLines : INTEGER;
BEGIN
   VisibleLines:=
      (fBorder.bottom - fBorder.top) DIV fHeight;
END;

PROCEDURE TVerticalList.InstallData
          (theText : Handle);
VAR   x,lastOne,nextOne  :  LongInt;
BEGIN
   fLength:= 0;
   fSelect:= 0;
   fOffLin:= 0;
   fOffByt:= 0;
   IF fData <> NIL THEN DisposHandle(fData);
   fData:= theText;
   IF fData = NIL THEN Exit(InstallData);
   HLock(fData);
   x:= GetHandleSize(fData)-1; {Blank at end}
   nextOne:= 0;
   WHILE nextOne < x DO BEGIN
      lastOne:= nextOne + 1;
      nextOne:=
         Munger(fData,lastOne,blnkPtr,1,NIL, 0);
      fLength:= fLength + 1;
      IF nextOne < 0 THEN nextOne:= x; {Error!}
   END;
   HUnLock(fData);
   Draw;
END;

PROCEDURE TVerticalList.DrawOneEntry(x,y:LongInt);
BEGIN
   y:= y - x;
   IF y > MaxInt THEN y:= MaxInt;
   DrawText(Ptr(ORD(fData^)+x),0,y);
END;

{ “DrawEntries” just draws the entries, with
  port, clip & font maintenance done elsewhere. }
PROCEDURE TVerticalList.DrawEntries;
VAR   i,lastOne,nextOne,y  :  LongInt;
      x  :  INTEGER;
   PROCEDURE ExitDE;
   BEGIN HUnLock(fData); Exit(DrawEntries); END;
BEGIN
   i:= fOffLin;
   x:= fBorder.left + textMarge;
   nextOne:= fOffByt;
   HLock(fData);
   WHILE i < fLength DO BEGIN
      i:= i + 1;
      lastOne:= nextOne + 1;
      nextOne:=
         Munger(fData,lastOne,blnkPtr,1,NIL, 0);
      IF nextOne < 0 THEN ExitDE; {Error!}
      IF i > fOffLin THEN BEGIN
         y:= fBorder.top + (i-fOffLin)*fHeight;
         IF y > fBorder.bottom  THEN ExitDE;
         MoveTo(x,y-fDescent);
         DrawOneEntry(lastOne,nextOne);
      END;
   END;
   ExitDE;
END;

FUNCTION TVerticalList.GetSelection : Str63;
VAR   s  :  Str63;
      i  :  INTEGER;
      x,lastOne,nextOne  :  LongInt;
   PROCEDURE ExitGS;
   BEGIN
      HUnLock(fData);
      GetSelection:= s;
      Exit(GetSelection);
   END;
BEGIN
   s:= '';
   x:= fOffLin;
   nextOne:= fOffByt;
   HLock(fData);
   WHILE x < fSelect DO BEGIN
      x:= x + 1;
      lastOne:= nextOne + 1;
      nextOne:=
         Munger(fData,lastOne,blnkPtr,1,NIL, 0);
      IF nextOne < 0 THEN ExitGS; {Error!}
   END;
   i:= nextOne - lastOne;
   IF i > 63 THEN i:= 63;
   BlockMove(Ptr(ORD(fData^)+lastOne), 
      Ptr(ORD(@s)+1),i);
   s[0]:= CHR(i);
   ExitGS;
END;

PROCEDURE TVerticalList.SelectionRectangle
          (VAR r : Rect);
VAR   i  :  LongInt;
   PROCEDURE SelectionNotVisible;
   BEGIN
      SetRect(r,0,0,0,0);
      Exit(SelectionRectangle);
   END;
BEGIN
   i:= fSelect - fOffLin;
   IF i <= 0 THEN SelectionNotVisible;
   GetRectangle(r);
   i:= r.top + i*fHeight;
   IF i > r.bottom THEN SelectionNotVisible;
   r.bottom:= i;
   r.top:= i - fHeight;
END;

PROCEDURE TVerticalList.HiliteSelection;
VAR   r  :  Rect;
BEGIN
   SelectionRectangle(r);
   IF EqualPt(r.topLeft,r.botRight) THEN
      Exit(HiliteSelection);
   BitClr(Ptr(hiliteMode),pHiliteBit); 
   IF fFlag[active] THEN InvertRect(r)
   ELSE BEGIN
      PenSize(2,2);
      FrameRect(r);
      PenNormal;
   END;
END;

PROCEDURE TVerticalList.ActivationSel
          (activate : BOOLEAN);
VAR   r  :  Rect;
BEGIN
   IF fFlag[active] = activate THEN
      Exit(ActivationSel);
   fFlag[active]:= activate;
   SelectionRectangle(r);
   IF EqualPt(r.topLeft,r.botRight) THEN
      Exit(ActivationSel);
   InsetRect(r,2,2);
   MyInvertRect(r);
END;

PROCEDURE TVerticalList.DrawEntsAndSel;
VAR   r  :  Rect;
BEGIN
   GetRectangle(r);
   ClipRect(r);
   EraseRect(r);
   IF fData <> NIL THEN BEGIN
      DrawEntries;
      HiliteSelection;
   END;
   RestoreClip;
END;

PROCEDURE TVerticalList.DrawBorder;
VAR   r  :  Rect;
BEGIN
   GetRectangle(r);
   InsetRect(r,-1,-1);
   FrameRect(r);
END;

PROCEDURE TVerticalList.Draw;
VAR   r  :  Rect;
      f  :  FontIdent;
BEGIN
   f:= fFont;
   SetFontIdent(f);
   DrawBorder;
   DrawEntsAndSel;
   Draw1Control(fScroll);
END;

PROCEDURE TVerticalList.ActivateIt;
BEGIN
   ActivationSel(TRUE);
   ShowControl(fScroll);
   INHERITED ActivateIt;
END;

PROCEDURE TVerticalList.DeactivateIt;
VAR   r  :  Rect;
BEGIN
   ActivationSel(FALSE);
   HideControl(fScroll);
   DrawBorder;
   INHERITED DeactivateIt;
END;

PROCEDURE TVerticalList.SetItemFont;
BEGIN
   fFont:= forNowFI;
   SetMeasures;
   Draw;
   INHERITED SetItemFont;
END;

PROCEDURE TVerticalList.CheckScrollability;
VAR   vis  :  INTEGER;
BEGIN
   IF fData = NIL THEN
      HiliteControl(fScroll,scrBarHide)
   ELSE IF fOffLin > 0 THEN
      HiliteControl(fScroll,scrBarShow)
   ELSE BEGIN
      vis:= VisibleLines;
      HiliteControl(fScroll,
         ScrollBarShowHide(fLength > vis));
   END;
END;

PROCEDURE TVerticalList.SetScrollValue;
VAR   max,
      min,
      vis  :  INTEGER;
      ratio  :  Fract;
BEGIN
   min:= GetCtlMin(fScroll);
   max:= GetCtlMax(fScroll);
   vis:= VisibleLines;
   IF fLength <= vis THEN SetCtlValue(fScroll,min)
   ELSE BEGIN
      ratio:= FracDiv(fOffLin, fLength-vis);
      SetCtlValue(fScroll,FracMul(ratio,max-min));
   END;
END;

PROCEDURE TVerticalList.OneLineLess;
VAR   r  :  Rect;
      rgn  :  RgnHandle;
   PROCEDURE DrawFirstLine;
   VAR   i  :  LongInt;
         c  :  Str1;
   BEGIN
      i:= fOffByt;
      REPEAT
         i:= i - 1;
         IF i < 0 THEN Exit(DrawFirstLine);
         BlockMove(Ptr(ORD(fData^)+i),@c,1); 
      UNTIL c[0] = blnkChr;
      MoveTo(r.left+textMarge,
             r.top+fHeight-fDescent);
      DrawOneEntry(i+1,fOffByt);
      IF fSelect = fOffLin THEN BEGIN
         r.bottom:= r.top + fHeight;
         MyInvertRect(r);
      END;
      fOffLin:= fOffLin - 1;
      fOffByt:= i;
   END;
   PROCEDURE EraseLastLine;
   VAR   saveTop  :  INTEGER;
   BEGIN
      saveTop:= r.top;
      r.top:= r.top + VisibleLines*fHeight;
      EraseRect(r);
      r.top:= saveTop;
   END;
BEGIN
   IF fOffLin <= 0 THEN Exit(OneLineLess);
   GetRectangle(r);
   ClipRect(r);
   rgn:= NewRgn;
   ScrollRect(r,0,fHeight,rgn);
   EraseLastLine;
   DisposeRgn(rgn);
   HLock(fData);
   DrawFirstLine;
   HUnLock(fData);
   RestoreClip;
END;

PROCEDURE TVerticalList.OneLineMore;
VAR   r  :  Rect;
      rgn  :  RgnHandle;
      vis  :  INTEGER;
   PROCEDURE DrawLastLine;
   VAR   thisLine,
         lastLine,
         lastOne,
         nextOne  :  LongInt;
   BEGIN
      fOffLin:= fOffLin + 1;
      fOffByt:=
         Munger(fData,fOffByt+1,blnkPtr,1,NIL,0);
      IF nextOne < 0 THEN Exit(DrawLastLine);

      thisLine:= fOffLin;
      lastLine:= fOffLin + vis;
      nextOne:= fOffByt;
      WHILE thisLine < lastLine DO BEGIN
         thisLine:= thisLine + 1;
         lastOne:= nextOne + 1;
         nextOne:=
            Munger(fData,lastOne,blnkPtr,1,NIL,0);
         IF nextOne < 0 THEN Exit(DrawLastLine);
      END;
      r.bottom:= r.top + vis*fHeight;
      MoveTo(r.left+textMarge,r.bottom-fDescent);
      DrawOneEntry(lastOne,nextOne);
      IF fSelect = lastLine THEN BEGIN
         r.top:= r.bottom - fHeight;
         MyInvertRect(r);
      END;
   END;
BEGIN
   vis:= VisibleLines;
   IF fOffLin>=fLength-vis THEN Exit(OneLineMore);
   GetRectangle(r);
   ClipRect(r);
   rgn:= NewRgn;
   ScrollRect(r,0,-fHeight,rgn);
   DisposeRgn(rgn);
   HLock(fData);
   DrawLastLine;
   HUnLock(fData);
   RestoreClip;
END;

{ “RecalOffByte” recalculates "fOffByt". }
PROCEDURE TVerticalList.RecalOffByte;
VAR   i,lastOne  :  LongInt;
   PROCEDURE ExitROB;
   BEGIN HUnLock(fData); Exit(RecalOffByte);END;
BEGIN
   SetCursor(waitCursor^^);
   i:= 0;
   fOffByt:= 0;
   HLock(fData);
   WHILE i < fOffLin DO BEGIN
      i:= i + 1;
      lastOne:= fOffByt + 1;
      fOffByt:=
         Munger(fData,lastOne,blnkPtr,1,NIL, 0);
      IF fOffByt < 0 THEN BEGIN
         fOffLin:= 0;
         fOffByt:= 0;
         ExitROB;
      END;
   END;
   ExitROB;
END;

PROCEDURE TVerticalList.OnePageLess;
VAR   newOffLine  :  LongInt;
      c  :  Str1;
BEGIN
   IF fOffLin <= 0 THEN Exit(OnePageLess);
   newOffLine:= fOffLin - (VisibleLines-1);
   IF newOffLine <= 0 THEN BEGIN
      fOffLin:= 0;
      fOffByt:= 0;
   END
   ELSE WHILE fOffLin > newOffLine DO BEGIN
      fOffLin:= fOffLin - 1;
      REPEAT
         fOffByt:= fOffByt - 1;
         BlockMove(Ptr(ORD(fData^)+fOffByt),@c,1);
      UNTIL c[0] = blnkChr;
   END;
   DrawEntsAndSel;
END;

PROCEDURE TVerticalList.OnePageMore;
VAR   vis  :  INTEGER;
      max,
      newOffLine  :  LongInt;
BEGIN
   vis:= VisibleLines;
   max:= fLength - vis;
   IF fOffLin >= max THEN Exit(OnePageMore);
   newOffLine:= fOffLin + (vis-1);
   IF newOffLine > max THEN newOffLine:= max;
   WHILE fOffLin < newOffLine DO BEGIN
      fOffLin:= fOffLin + 1;
      fOffByt:=
         Munger(fData,fOffByt+1,blnkPtr,1,NIL,0);
   END;
   DrawEntsAndSel;
END;

PROCEDURE TVerticalList.Thumbing(p : Point);
VAR   min,
      apres  :  INTEGER;
      vis,
      avant  :  LongInt;
      ratio  :  Fract;
BEGIN
   min:= GetCtlMin(fScroll);
   avant:= GetCtlValue(fScroll);
   apres:= TrackControl(fScroll,p,NIL);
   apres:= GetCtlValue(fScroll);
   IF apres <> avant THEN BEGIN
      vis:= VisibleLines;
      IF fLength <= vis THEN
         SetCtlValue(fScroll,min)
      ELSE BEGIN
         avant:= fOffLin;
         ratio:= FracDiv(apres-min,
            GetCtlMax(fScroll)-min);
         vis:= fLength - vis;
         fOffLin:= FracMul(ratio,vis);
         IF fOffLin < 0 THEN fOffLin:= 0
         ELSE IF fOffLin>vis THEN fOffLin:= vis;
         IF fOffLin <> avant THEN BEGIN
            RecalOffByte;
            CheckScrollability;
            DrawEntsAndSel;
         END;
      END;
   END;
END;

PROCEDURE TVerticalList.Scrolling(part : INTEGER);
VAR   x  :  LongInt;
      r  :  Rect;
BEGIN
   CASE part OF
      inUpButton:
         BEGIN
            HiliteControl(fScroll,part);
            WHILE StillDown DO BEGIN
               Delay(vertListDelay,x);
               OneLineLess;
               SetScrollValue;
            END;
            HiliteControl(fScroll,toggleOff);
         END;
      inDownButton:
         BEGIN
            HiliteControl(fScroll,part);
            WHILE StillDown DO BEGIN
               Delay(vertListDelay,x);
               OneLineMore;
               SetScrollValue;
            END;
            HiliteControl(fScroll,toggleOff);
            GetRectangle(r);
            r.top:= r.top + VisibleLines*fHeight;
            InvalRect(r);
         END;
      inPageUp:
         WHILE StillDown DO BEGIN
            Delay(vertListDelay,x);
            OnePageLess;
            SetScrollValue;
         END;
      inPageDown:
         WHILE StillDown DO BEGIN
            Delay(vertListDelay,x);
            OnePageMore;
            SetScrollValue;
         END;
   END;
   CheckScrollability;
END;

PROCEDURE TVerticalList.DragSelecting;
VAR   r  :  Rect;
      p  :  Point;
      vis  :  INTEGER;
      lineHit  :  LongInt;
BEGIN
   GetRectangle(r);
   vis:= (r.bottom - r.top) DIV fHeight;
   REPEAT
      GetMouse(p);
      IF PtInRect(p,r) THEN BEGIN
         lineHit:=
            fOffLin + (p.v-r.top) DIV fHeight + 1;
         SetSelection(lineHit);
      END
      ELSE IF p.v < r.top THEN BEGIN
         OneLineLess;
         SetScrollValue;
         SetSelection(fOffLin+1);
      END
      ELSE IF p.v > r.bottom THEN BEGIN
         OneLineMore;
         SetScrollValue;
         SetSelection(fOffLin+vis);
      END;
   UNTIL NOT StillDown;
END;

FUNCTION TVerticalList.Click
         (p : Point;  modif : INTEGER) : LongInt;
VAR   r  :  Rect;
      f  :  FontIdent;
      c  :  ControlHandle;
      part  :  INTEGER;
   PROCEDURE ClickInEntries;
   VAR   i  :  INTEGER;
         lineHit  :  LongInt;
   BEGIN
      SetFontIdent(f);
      Click:= fItsValue;
      i:= (p.v - r.top) DIV fHeight + 1;
      lineHit:= fOffLin + i;
      IF BAnd(modif,shiftKey) = 0 THEN BEGIN
         SetSelection(lineHit);
         IF dublClick THEN BEGIN
            GetMouse(p);
            r.bottom:= r.top + i*fHeight;
            r.top   := r.bottom - fHeight;
            IF PtInRect(p,r) THEN Click:=
               MakeLongInt(fItsValue,doubleClick); 
         END
         ELSE IF StillDown THEN DragSelecting;
      END
      { Below, shift-clicking }
      ELSE IF fSelect=lineHit THEN
         CancelSelection
      ELSE SetSelection(lineHit);
   END;
BEGIN
   GetRectangle(r);
   part:= FindControl(p,fPort,c);
   f:= fFont;
   IF c = fScroll THEN BEGIN
      SetFontIdent(f);
      Click:= fItsValue;
      IF part = inThumb THEN Thumbing(p)
                        ELSE Scrolling(part);
   END
   ELSE IF PtInRect(p,r) THEN ClickInEntries
   ELSE IF fNexThing = NIL THEN Click:= noItemHit
   ELSE Click:= fNexThing.Click(p,modif);
END;

PROCEDURE TVerticalList.CancelSelection;
BEGIN
   IF fSelect = 0 THEN Exit(CancelSelection);
   HiliteSelection;
   fSelect:= 0;
END;

PROCEDURE TVerticalList.SetSelection
          (newSel : LongInt);
VAR   i  :  LongInt;
      g  :  GrafPtr;
BEGIN
   IF newSel = fSelect THEN Exit(SetSelection);
   GetPort(g);
   SetPort(fPort);
   CancelSelection;
   IF (newSel>=0) AND (newSel<=fLength)
   THEN BEGIN
      fSelect:= newSel;
      HiliteSelection;
   END;
   SetPort(g);
END;

PROCEDURE TVerticalList.ShowSelection;
VAR   i  :  LongInt;
      v  :  INTEGER;
BEGIN
   IF fSelect = 0 THEN Exit(ShowSelection);
   i:= fSelect - fOffLin;
   v:= VisibleLines;
   IF (i>0) AND (i<=v) THEN Exit(ShowSelection);
   v:= v DIV 2;      {Centre vertically}
   IF v = 0 THEN v:= 1;
   fOffLin:= fSelect - v;
   IF fOffLin < 0 THEN fOffLin:= 0;
   RecalOffByte;
   SetScrollValue;
   Draw;
END;

PROCEDURE TVerticalList.InitKeyStuff;
BEGIN
   fUserHitKeys:= '';
   fLastKeyTime:= 0;
END;

PROCEDURE TVerticalList.SelectCellStart(c : CHAR);
VAR   sUser  :  StrListKey;
      iUser  :  INTEGER;
   FUNCTION NewKeyString : BOOLEAN;
   VAR   x  :  LongInt;
   BEGIN
      x:= TickCount;
      iUser:= Length(sUser);
      IF iUser = 0 THEN NewKeyString:= TRUE
      ELSE IF iUser = listKeyLeng THEN
         NewKeyString:= TRUE
      ELSE NewKeyString:=
         (x - fLastKeyTime > GetDblTime);
      fLastKeyTime:= x;
   END;
   PROCEDURE ScanForMatch;
   VAR   sList  :  StrListKey;
         iList,     {Use a LongInt to be safe}
         i,
         lastOne,
         nextOne,
         timeHere  :  LongInt;
      PROCEDURE ExitSCS;
      BEGIN
         HUnLock(fData);
         {Compensate for time spent here}
         fLastKeyTime:=
            fLastKeyTime + (TickCount-timeHere);
         Exit(SelectCellStart);
      END;
   BEGIN
      timeHere:= TickCount;
      SetCursor(waitCursor^^);
      i:= fOffLin; nextOne:= fOffByt; {From top}
      HLock(fData);
      WHILE i < fLength DO BEGIN
         i:= i + 1;
         lastOne:= nextOne + 1;
         nextOne:=
            Munger(fData,lastOne,blnkPtr,1,NIL,0);
         IF nextOne < 0 THEN ExitSCS;     {Error!}
         iList:= nextOne - lastOne;
         IF iList > iUser THEN iList:= iUser;
         BlockMove(Ptr(ORD(fData^)+lastOne), 
            Ptr(ORD(@sList)+1),iList);
         sList[0]:= CHR(iList);
         IF IUEqualString(sList,sUser) = 0 THEN
         BEGIN
            SetSelection(i);
            ShowSelection;
            ExitSCS;
         END;
      END;
      ExitSCS;
   END;
BEGIN
   CancelSelection;
   sUser:= fUserHitKeys;
   IF NewKeyString THEN sUser:= MakeStr1(c)
   ELSE sUser:= Concat(sUser,MakeStr1(c));
   iUser:= Length(sUser);
   fUserHitKeys:= sUser;
   ScanForMatch;
END;

FUNCTION TVerticalList.KeyIt
         (c : CHAR;  modif : INTEGER) : LongInt;
BEGIN
   IF c IN [left,right,up,down] THEN BEGIN
      KeyIt:= fItsValue;
      IF c= up THEN SetSelection(fSelect-1)
      ELSE IF c = down THEN
         SetSelection(fSelect+1);
      ShowSelection;
   END
   ELSE IF c IN [entr,cRet] THEN BEGIN
      ShowSelection;
      KeyIt:= MakeLongInt(fItsValue,doubleClick); 
   END
   ELSE IF BAnd(modif,cmdKey) <> 0 THEN
      KeyIt:= INHERITED KeyIt(c,modif)
   ELSE IF c >= blnkChr THEN BEGIN
      KeyIt:= fItsValue;
      SelectCellStart(c);
   END
   ELSE KeyIt:= INHERITED KeyIt(c,modif);
END;

PROCEDURE TVerticalList.Response
          (theItem,theKind : INTEGER);
VAR   s  :  Str255;
BEGIN
   IF theItem <> fItsValue THEN
      INHERITED Response(theItem,theKind)
   ELSE IF theKind = doubleClick THEN BEGIN
      IF (fSelect<fOffLin) OR (fSelect<=0) THEN
         SysBeep(1)
      ELSE BEGIN
         s:= GetSelection;
         s:= Concat('Entry #',
            IntString(fSelect),' is:',cRet,s);
         SetDAFont(fFont.n);
         SimpleAlert(s);
         SetDAFont(systemFont);
      END;
   END;
END;

PROCEDURE TVerticalList.Resize(hauteur:INTEGER);
VAR   r  :  Rect;
      g  :  GrafPtr;
BEGIN
   r:= fBorder;
   fBorder.bottom:= fBorder.top + hauteur;
   IF fBorder.bottom > r.bottom THEN BEGIN
      GetPort(g);
      SetPort(fPort);
      r.top:= r.bottom;
      r.bottom:= fBorder.bottom;
      InvalRect(r);
      SetPort(g);
   END;
   SizeControl(fScroll,scrWidth+1,hauteur+2);
   CheckScrollability;
END;

END.

Listing:  BLInit.P
UNIT  BLInit; {•••• Initialization routines ••••}

INTERFACE

USES  Memtypes,QuickDraw,OSIntf,ToolIntf, 
      PackIntf,FixMath,ObjIntf,BLObject;

PROCEDURE InitBigList;
PROCEDURE SetUpMenus;
PROCEDURE SetUpPseudoDialog;

IMPLEMENTATION
{$S SegInit}
{••••••••••••••••••••••••••••••••••••••••••••••••}
PROCEDURE InitBigList;
   PROCEDURE SetUpMultiFinder;   {Set “wneExists”}
   CONST WNETrapNum= $60; {Nº of “WaitNextEvent”}
         UnImplTrap = $9F;  {Unimplemented trap #}
   VAR   world  :  SysEnvRec;
         error  :  OSErr;
   BEGIN
      error:= SysEnvirons(1,world);
      IF error = noErr THEN BEGIN
         IF world.machineType<0 THEN ExitToShell;
         wneExists:= (world.machineType >= 0) AND
           (NGetTrapAddress(WNETrapNum,ToolTrap)<>
            NGetTrapAddress(UnImplTrap,ToolTrap));
      END
      ELSE wneExists:= FALSE;
   END;
BEGIN
   {Basic toolbox initializations}
   MaxApplZone;
   InitGraf(@thePort);
   InitFonts;
   InitWindows;
   InitMenus;
   TEInit;
   InitDialogs(NIL);
   {Event-management globals}
   weAreDone:= FALSE;
   inBckGrnd:= FALSE;
   SetUpMultiFinder;
   dublClick:= FALSE;
   SetPt(lastClikPoint,0,0);
   lastClikTime:= 0;
   FlushEvents(everyEvent,0);
   {Initialize the cursors}
   XCursor:= GetCursor(crossCursor);
   HLock(Handle(XCursor));
   waitCursor:= GetCursor(watchCursor);
   HLock(Handle(waitCursor));
   SetCursor(waitCursor^^);
   {Init. “styleVector” for top of Style menu}
   styleVector[2]:= bold;
   styleVector[3]:= italic;
   styleVector[4]:= underline;
   styleVector[5]:= outline;
   styleVector[6]:= shadow;
   styleVector[7]:= condense;
   styleVector[8]:= extend;
   {Other stuff}
   forNowFI.n:= systemFont;
   forNowFI.s:= 12;
   forNowFI.y:= [];
   defaultFI:= forNowFI;
   entr := CHR( 3);
   cRet := CHR(13);
   left := CHR(28);
   right:= CHR(29);
   up   := CHR(30);
   down := CHR(31);
   blnkChr:= ' ';
   blnkPtr:= Ptr(ORD(@blnkChr)+1);  {With Munger}
   WITH screenBits.bounds DO BEGIN
      SetRect(zoomArea,left+origH,top+origV,
         right-origH,bottom-origH);
      SetRect(dragArea,left+4,top+24,
         right-4,bottom-4);
   END;
END;
{••••••••••••••••••••••••••••••••••••••••••••••••}
PROCEDURE SetUpMenus;
BEGIN
   myMenus[1]:= GetMenu(applMID);
   AddResMenu(myMenus[1],'DRVR');
   InsertMenu(myMenus[1],0);
   myMenus[2]:= GetMenu(fileMID);
   InsertMenu(myMenus[2],0);
   myMenus[3]:= GetMenu(editMID);
   InsertMenu(myMenus[3],0);
   myMenus[4]:= GetMenu(fontMID);
   AddResMenu(myMenus[4],'FONT');
   InsertMenu(myMenus[4],0);
   theFontMenu:= myMenus[4];
   myMenus[5]:= GetMenu(stylMID);
   InsertMenu(myMenus[5],0);
   theStylMenu:= myMenus[5];
   SetFontMenu;
   SetSizeMenu;
   SetStylMenu;
   DrawMenuBar;
END;
{••••••••••••••••••••••••••••••••••••••••••••••••}
PROCEDURE CheckMemError;
VAR   e  :  OSErr;
BEGIN
   e:= MemError;
   IF e = noErr THEN Exit(CheckMemError);
   SimpleAlert(Concat('Error #',IntString(e)));
   ExitToShell;
END;
{••••••••••••••••••••••••••••••••••••••••••••••••}
{ THE DATA MUST START & END WITH A BLANK. }
PROCEDURE InstallSomeDataInList(v:TVerticalList);
CONST numberOfEntries = 10000;
VAR   h  :  Handle;
      s  :  Str255;
      i,x  :  LongInt;
BEGIN
   h:= NewHandle(1);
   CheckMemError;
   s[0]:= blnkChr;
   BlockMove(@s,h^,1);
   x:= 1;
   FOR i:= 1 TO numberOfEntries DO BEGIN
      CASE i MOD 5 OF
       0:s:= 'What';
       1:s:= 'fools';
       2:s:= 'these';
       3:s:= 'mortals';
       4:s:= 'be!';
      END;
      s:= Concat(IntString(i),'•',s,blnkChr);
      x:= Munger(h,x,NIL,0,Ptr(ORD(@s)+1),
         Length(s));
      CheckMemError;
   END;
   v.InstallData(h);
END;
{••••••••••••••••••••••••••••••••••••••••••••••••}
PROCEDURE SetUpPseudoDialog;
VAR   r  :  Rect;
      f  :  FontIdent;
      theVL  :  TVerticalList;
      thePB  :  TPlainButton;
      theTB  :  TToggleButton;
      the3D  :  TThreeDButton;
      theT3  :  TToggl3DButton;
      theST  :  TStaticText;
      theIC  :  TIcon;
      theAN  :  TAnimation;
   PROCEDURE SetF(nn:INTEGER;ss:Byte;yy:Style);
   BEGIN f.n:= nn; f.s:= ss; f.y:= yy; END;
BEGIN
   New(fakeDlg);
   SetRect(r,105,50,405,300);
   SetF(systemFont,12,[]);
   fakeDlg.IPseudoDialog(r,
      'Big List Demonstration',FALSE,f);
   New(theVL);
   SetRect(r, 10, 10,110,240);
   theVL.IVerticalList(r,fakeDlg.fWindow);
   InstallSomeDataInList(theVL);
   fakeDlg.InstallItem(theVL);
   New(thePB);
   SetRect(r,125,10,280,10); {Force computation}
   SetF(geneva,9,[bold,extend]);
   thePB.IPlainButton(r,'About ','1',f);
   fakeDlg.InstallItem(thePB);
   New(theTB);
   SetRect(r,125,45,280,45); {Force computation}
   SetF(systemFont,12,[bold]);
   theTB.IToggleButton(r,'Icon','I',f, toggleOff);
   fakeDlg.InstallItem(theTB);
   New(the3D);
   SetRect(r,125,80,280,80); {Force computation}
   SetF(systemFont,12,[italic]);
   the3D.IThreeDButton(r,'Window info','W',f);
   fakeDlg.InstallItem(the3D);
   New(theT3);
   SetRect(r,125,115,280,115); {Force computation}
   SetF(monaco,12,[outline]);
   theT3.IToggl3DButton(r,'Animation', 'A',f,
      toggleOff);
   fakeDlg.InstallItem(theT3);
   New(theST);
   SetRect(r,125,160,280,190);
   SetF(geneva,9,[]);
   theST.IStaticText(r,f,
'Alas & alack, these words are but static text.');
   fakeDlg.InstallItem(theST);
   New(theIC);
   SetRect(r,140,208,140,208);{Only top,left used}
   theIC.IIcon(r,blApplID);
   fakeDlg.InstallItem(theIC);
   New(theAN);
   SetRect(r,230,190,280,240);{Only top,left used}
   theAN.IAnimation(r,exclamationBaseID,
      exclamationNumber);
   fakeDlg.InstallItem(theAN);
   ShowWindow(fakeDlg.fWindow);
END;

END.

Listing:  BigList.P
PROGRAM BigList; {Main event-management routines}

USES  Memtypes,QuickDraw,OSIntf,ToolIntf, 
      PackIntf,FixMath,ObjIntf,BLObject,BLInit;

CONST theSignature      = 'BLDR';
      {Constants for event management}
      kOSEvent          = app4Evt;
      kSuspResmMessage  =   1;
      kResumeMask       =   1;
      kMouseMovMessage  = $FA;

PROCEDURE _DataInit;  EXTERNAL;

{$S SegAbout}
{••••••••••••••••••••••••••••••••••••••••••••••••}
{ Routines for the About box }
FUNCTION NameOfSoftWare : Str255;
VAR   s  :  Str255;
      i  :  INTEGER;
      h  :  Handle;
BEGIN
   h:= GetResource(theSignature,0);
   IF (h <> NIL) AND (ResError = noErr)
      THEN s:= StringHandle(h)^^
      ELSE GetAppParms(s,i,h);
   NameOfSoftWare:= s;
END;

PROCEDURE AboutBox;
BEGIN SimpleAlert(NameOfSoftWare); END;

{$S Main}
{••••••••••••••••••••••••••••••••••••••••••••••••}
PROCEDURE DoIdleProcessing;
VAR   w  :  WindowPtr;
      k  :  INTEGER;
BEGIN
   fakeDlg.Idling;
   IF inBckGrnd THEN Exit(DoIdleProcessing);
   w:= FrontWindow;
   k:= GetKind(w);    {Will be zero if "w" is NIL}
   IF k = dialogKind THEN
      TEIdle(DialogPeek(w)^.textH);
END;

PROCEDURE SuspendOrResume;
BEGIN
   inBckGrnd:=
      (BAnd(theEvent.message,kResumeMask)  = 0);
   IF FrontWindow = fakeDlg.fWindow THEN BEGIN
      IF inBckGrnd THEN fakeDlg.DeactivateWindow
                   ELSE fakeDlg.ActivateWindow;
   END;
END;

PROCEDURE DoCommand(mResult : LONGINT);
VAR   theItem,
      theMenu  :  INTEGER;
   PROCEDURE OuvrirAccessoire;
   VAR   g  :  GrafPtr;
         s  :  Str255;
   BEGIN
      GetPort(g);
      GetItem(myMenus[1],theItem,s);
      theItem:= OpenDeskAcc(s);
      SetPort(g);
   END;
BEGIN
   SetCursor(waitCursor^^);
   theMenu:= HiWord(mResult);
   theItem:= LoWord(mResult);
   CASE theMenu OF
      applMID:IF theItem=1 THEN AboutBox
                           ELSE OuvrirAccessoire;
      fileMID:weAreDone:= (theItem = 1);
      editMID:IF SystemEdit(theItem-1) THEN;
      fontMID:BEGIN
                 FontMenuEvent(theItem);
                 IF fakeDlg <> NIL THEN
                    fakeDlg.SetFont;
              END;
      stylMID:BEGIN
                 StyleMenuEvent(theItem);
                 IF fakeDlg <> NIL THEN
                    fakeDlg.SetFont;
              END;
   END;
   HiliteMenu(0);
END;

PROCEDURE ProcessTheReply(theReply : LongInt);
CONST m = 'Congratulations, you just hit the ';
VAR   x,y  :  INTEGER;
BEGIN
   x:= LoWord(theReply);
   y:= HiWord(theReply);
   IF y = 0 THEN CASE x OF
      1: {Single click in list, do nothing};
      2: AboutBox;
      3: fakeDlg.EnableDisableItem(7);
      4: fakeDlg.ItemInformation;
      5: fakeDlg.AnimateStuff;
      6: SimpleAlert(Concat(m,'static text.'));
      7: SimpleAlert(Concat(m,'icon.'));
      8: SimpleAlert(Concat(m,'animation.')) ;
   END
   ELSE fakeDlg.RequestResponse(x,y);
END;

PROCEDURE PerformMouse;
VAR   w  :  WindowPtr;
      k  :  LongInt;
      p  :  Point;
BEGIN
   p:= theEvent.where;
   k:= FindWindow(p,w);
   CASE k OF
        inDesk:SysBeep(1);
     inMenuBar:DoCommand(MenuSelect(p)); 
   inSysWindow:SystemClick(theEvent,w) ;
     inContent,
        inDrag:IF w = fakeDlg.fWindow THEN BEGIN
                  k:= fakeDlg.HandleMouseEvents
                      (p,theEvent.modifiers,k);
                  ProcessTheReply(k);
               END;
      inZoomIn,
     inZoomOut,
        inGrow: {Nothing};
      inGoAway: {Nothing};
   END;
END;

PROCEDURE PerformKey;
VAR   c  :  CHAR;
      x  :  LongInt;

   PROCEDURE MaybeInFakeDlg;
   BEGIN
      IF FrontWindow = fakeDlg.fWindow THEN
         ProcessTheReply(
            fakeDlg.Keying(c,theEvent.modifiers));
   END;

BEGIN
   c:= CHR(BAnd(theEvent.message,charCodeMask));
   IF BAnd(theEvent.modifiers,cmdKey) = 0 THEN
      MaybeInFakeDlg
   ELSE BEGIN
      x:= MenuKey(c);
      IF HiWord(x) = 0 THEN MaybeInFakeDlg
                       ELSE DoCommand(x);
   END;
END;

PROCEDURE PerformActivate(w : WindowPtr);
BEGIN
   IF w = fakeDlg.fWindow THEN BEGIN
      IF Odd(theEvent.modifiers)
         THEN fakeDlg.ActivateWindow
         ELSE fakeDlg.DeactivateWindow;
   END;
END;

PROCEDURE PerformUpdate(w : WindowPtr);
BEGIN
   IF w = fakeDlg.fWindow THEN
      fakeDlg.UpdateWindow;
END;

PROCEDURE ProcessDiskEvent(evtMessage : LongInt);
VAR   e  :  OSErr;
      p  :  Point;
BEGIN
   SetPt(p,100,100);
   IF HiWord(evtMessage) <> noErr THEN
      e:= DIBadMount(p,evtMessage);
END;

PROCEDURE ProcessOsEvent;
BEGIN
   CASE BAnd(BRotL(theEvent.message,8),$FF) OF
      kMouseMovMessage : DoIdleProcessing;
      kSuspResmMessage : SuspendOrResume;
   END;
END;

PROCEDURE DoEventProcessing;
VAR   x  :  LongInt;
BEGIN
   x:= theEvent.message;
   CASE theEvent.what OF
      nullEvent   : DoIdleProcessing;
      mouseDown   : PerformMouse;
      keyDown,
      autoKey     : PerformKey;
      activateEvt : PerformActivate(WindowPtr(x));
      updateEvt   : PerformUpdate(WindowPtr(x));
      diskEvt     : ProcessDiskEvent(x);
      kOSEvent    : ProcessOsEvent;
   END;
END;

PROCEDURE MainEventLoop;
CONST sleep = 2;
VAR   gotEvent :  BOOLEAN;
BEGIN
   WHILE NOT weAreDone DO BEGIN
      SetCursor(arrow);
      IF wneExists THEN
         gotEvent:= WaitNextEvent
         (everyEvent,theEvent,sleep,NIL)
      ELSE BEGIN
         SystemTask;
         gotEvent:= GetNextEvent
            (everyEvent,theEvent);
      END;
      IF gotEvent THEN DoEventProcessing
                  ELSE DoIdleProcessing;
   END;
END;
{••••••• P R I N C I P A L     B L O C K ••••••••}
BEGIN
   UnloadSeg(@_DataInit);
   InitBigList;
   SetUpMenus;
   SetUpPseudoDialog;
   UnLoadSeg(@InitBigList);     {SegInit}
   InitCursor;
   MainEventLoop;
   fakeDlg.Free;
END.