Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/OPBONUS.ZIP/CACHE.LZH/PKCACHE.PAS

Pascal/Delphi Source File | 1990-08-25 | 10.6 KB | 330 lines

unit PkCache;

(* This unit contains an object derived from the picklist object in
   Object Professional that includes the ability to cache item in
   a memory buffer. This technique makes it possible to have a picklist
   that accesses the disk or any other slow device in its ItemString
   procedure and still maintain reasonable performance as the user moves
   around the pick list. The constructors to the CachedPickList are
   exactly like the ones in Object Professional except they take one
   extra parameter that tells the picklist how many items to keep in its
   buffer. An extra method FlushCache has also been added to the PickList,
   call this method when updating an item to have the PickList reload
   the list from the disk.

   Revision history:

    12/21/89 - First released.
    08/25/90 - added storing of IType
             - added overrides ItemString to provide transparent usage

   Donated to the public domain by Scott Hunter
*)

interface

uses
  OpRoot,
  OpCrt,
  OpWindow,
  OpPick;

type
  PickNodePtr = ^PickNode;
  PickNode =
    object(DoubleListNode)
      pnLen    : Byte;
      pnIType  : pkItemType;
      pnItem   : Word;
      pnText   : ^String;

      constructor Init(MaxLen : Byte);
        {-Allocate space for pick node}
      destructor Done; virtual;
        {-Dispose of pick node}
      procedure SetPickNode(Item : Word; IType : pkItemType; S : String);
        {-Set pick node fields}
    end;

  PickCachePtr = ^PickCache;
  PickCache =
    object(DoubleList)
      constructor Init(CacheSize : Word; MaxLen : Byte);
        {-Allocate list of CacheSize PickNodes with MaxLen lengths}
      procedure TopOfCache(PNPtr : PickNodePtr);
        {-Move pick node PNPtr to top of list}
      procedure FlushCache;
        {-Flush contents of cache}
      function FindPickNode(Item : Word) : PickNodePtr;
        {-Check cache for Item and return pointer to item or nil if not found}
      function InCache(Item : Word; var IType : pkItemType; var IString : String) : Boolean;
        {-Check cache for Item and return pointer to item or nil if not found}
      procedure AddToCache(Item : Word; IType : pkItemType; IString : String);
        {-Add pick list item to cache}
    end;

  CachedPickListPtr = ^CachedPickList;
  CachedPickList =
    object(PickList)
      pkCache : PickCache;
      constructor Init(X1, Y1, X2, Y2 : Byte;
                       ItemWidth : Byte;
                       NumItems : Word;
                       StringProc : pkStringProc;
                       Orientation : pkGenlProc;
                       CommandHandler : pkGenlProc;
                       CachedItems : Word);
        {-Initialize a pick window}
      constructor InitCustom(X1, Y1, X2, Y2 : Byte;
                             var Colors : ColorSet;
                             Options : LongInt;
                             ItemWidth : Byte;
                             NumItems : Word;
                             StringProc : pkStringProc;
                             Orientation : pkGenlProc;
                             CommandHandler : pkGenlProc;
                             CachedItems : Word);
        {-Initialize a pick window with custom window options}
      constructor InitDeluxe(X1, Y1, X2, Y2 : Byte;
                             var Colors : ColorSet;
                             Options : LongInt;
                             ItemWidth : Byte;
                             NumItems : Word;
                             StringProc : pkStringProc;
                             Orientation : pkGenlProc;
                             CommandHandler : pkGenlProc;
                             PickOptions : Word;
                             CachedItems : Word);
        {-Initialize a pick window with custom window and pick options}
      destructor Done; virtual;
        {-Dispose of picklist and cache}
      procedure ItemString(Item : Word;
                           Mode : pkMode;
                           var IType : pkItemType;
                           var IString : String); virtual;
        {-Supplies each item string when the list is displayed or searched}
      procedure FlushCache;
        {-Flush contents of cache}
    end;

implementation


  constructor PickNode.Init(MaxLen : Byte);
    {-Allocate space for pick node}
  begin
    if (not DoubleListNode.Init) then Fail;
    pnLen := MaxLen;
    if (not GetMemCheck(pnText, Succ(pnLen))) then
      begin
        Done;
        InitStatus := epFatal+ecOutOfMemory;
        Fail;
      end;
    pnItem := 0;
  end;


  destructor PickNode.Done;
    {-Dispose of pick node}
  begin
    FreeMemCheck(pnText, Succ(pnLen));
    DoubleListNode.Done;
  end;


  procedure PickNode.SetPickNode(Item : Word; IType : pkItemType; S : String);
    {-Set pick node fields}
  begin
    pnItem := Item;
    if (Length(S) > pnLen) then S[0] := Char(pnLen);
    pnText^ := S;
    pnIType := IType;
  end;


  constructor PickCache.Init(CacheSize : Word; MaxLen : Byte);
    {-Allocate list of CacheSize PickNodes with MaxLen lengths}
  var
    Node : Word;

  begin
    if (not DoubleList.Init) then Fail;
    for Node := 1 to CacheSize do
      Append(New(PickNodePtr, Init(MaxLen)));
    if (Size <> CacheSize) then
      begin
        Done;
        InitStatus := epFatal+ecOutOfMemory;
        Fail;
      end;
  end;


  procedure PickCache.TopOfCache(PNPtr : PickNodePtr);
    {-Move pick node PNPtr to top of list}
  begin
    Remove(PNPtr);
    Insert(PNPtr);
  end;


  procedure PickCache.FlushCache;
    {-Flush contents of cache}
  var
    PNPtr : PickNodePtr;

  begin
    PNPtr := PickNodePtr(Head);
    while (PNPtr <> Nil) do
      begin
        PNPtr^.SetPickNode(0, pkNormal, '');
        PNPtr := PickNodePtr(Next(PNPtr));
      end;
  end;


  function PickCache.FindPickNode(Item : Word) : PickNodePtr;
    {-Check cache for Item and return pointer to item or nil if not found}
  var
    PNPtr : PickNodePtr;

  begin
    FindPickNode := Nil;
    PNPtr := PickNodePtr(Head);
    while (PNPtr <> Nil) and (PNPtr^.pnItem <> 0) do
      begin
        if (PNPtr^.pnItem = Item) then
          begin
            FindPickNode := PNPtr;
            Exit;
          end;
        PNPtr := PickNodePtr(Next(PNPtr));
      end;
  end;


  function PickCache.InCache(Item : Word; var IType : pkItemType; var IString : String) : Boolean;
    {-Check cache for Item, if found return true and set IType and IString}
  var
    PNPtr : PickNodePtr;

  begin
    PNPtr := FindPickNode(Item);
    if (PNPtr = Nil) then
      InCache := False
    else
      begin
        InCache := True;
        IString := PNPtr^.pnText^;
        IType := PNPtr^.pnIType;
        TopOfCache(PNPtr);
      end;
  end;


  procedure PickCache.AddToCache(Item : Word; IType : pkItemType; IString : String);
    {-Add pick list item to cache}
  begin
    PickNodePtr(Tail)^.SetPickNode(Item, IType, IString);
    TopOfCache(PickNodePtr(Tail));
  end;


  constructor CachedPickList.Init(X1, Y1, X2, Y2 : Byte;
                                  ItemWidth : Byte;
                                  NumItems : Word;
                                  StringProc : pkStringProc;
                                  Orientation : pkGenlProc;
                                  CommandHandler : pkGenlProc;
                                  CachedItems : Word);
    {-Initialize a pick window}
  begin
    if (not CachedPickList.InitDeluxe(X1, Y1, X2, Y2,
                                     DefaultColorSet, DefWindowOptions,
                                     ItemWidth, NumItems,
                                     StringProc, Orientation,
                                     CommandHandler, DefPickOptions,
                                     CachedItems)) then
      Fail;
  end;


  constructor CachedPickList.InitCustom(X1, Y1, X2, Y2 : Byte;
                                        var Colors : ColorSet;
                                        Options : LongInt;
                                        ItemWidth : Byte;
                                        NumItems : Word;
                                        StringProc : pkStringProc;
                                        Orientation : pkGenlProc;
                                        CommandHandler : pkGenlProc;
                                        CachedItems : Word);
    {-Initialize a pick window with custom window options}
  begin
    if (not CachedPickList.InitDeluxe(X1, Y1, X2, Y2,
                                    Colors, Options,
                                    ItemWidth, NumItems,
                                    StringProc, Orientation,
                                    CommandHandler, DefPickOptions,
                                    CachedItems)) then
      Fail;
  end;


  constructor CachedPickList.InitDeluxe(X1, Y1, X2, Y2 : Byte;
                                        var Colors : ColorSet;
                                        Options : LongInt;
                                        ItemWidth : Byte;
                                        NumItems : Word;
                                        StringProc : pkStringProc;
                                        Orientation : pkGenlProc;
                                        CommandHandler : pkGenlProc;
                                        PickOptions : Word;
                                        CachedItems : Word);
    {-Initialize a pick window with custom window and pick options}
  begin
    if (not PickList.InitDeluxe(X1, Y1, X2, Y2, Colors, Options, ItemWidth,
                               NumItems, StringProc, Orientation,
                               CommandHandler, PickOptions)) then
      Fail;
    if (not pkCache.Init(CachedItems, ItemWidth)) then
      begin
        PickList.Done;
        Fail;
      end;
  end;


  destructor CachedPickList.Done;
    {-Dispose of picklist}
  begin
    pkCache.Done;
    PickList.Done;
  end;


  procedure CachedPickList.ItemString(Item : Word;
                                      Mode : pkMode;
                                      var IType : pkItemType;
                                      var IString : String);
    {-Supplies each item string when the list is displayed or searched}
  begin
    if (not pkCache.InCache(Item, IType, IString)) then
      begin
        pkString(Item, Mode, IType, IString, @Self);
        pkCache.AddToCache(Item, IType, IString);
      end;
  end;


  procedure CachedPickList.FlushCache;
    {-Flush contents of cache}
  begin
    pkCache.FlushCache;
  end;


end.