unit dmBuffer;
(*
Copyright (c) 1997-2003 HREF Tools Corp.

Permission is hereby granted, on 1-Nov-2003, free of charge, to any person
obtaining a copy of this file (the "Software"), to deal in the Software
without restriction, including without limitation the rights to use, copy,
modify, merge, publish, distribute, sublicense, and/or sell copies of the
Software, and to permit persons to whom the Software is furnished to do so,
subject to the following conditions:

The above copyright notice and this permission notice shall be included in
all copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
THE SOFTWARE.

Author of original version of this file: Michael Ax
*)

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  dmBasic, TpMenu, UpdateOk, tpAction, IniLink;

const
  cBufSize=500;

type
  TdmBufferedDataModule = class(TdmBasicDatamodule)
  private
    { Private declarations }
    fBufferCapacity: integer;
    fBufferRead,
    fBufferHits: integer;
    fLastLookup: integer;
    fLastIndex: integer;
    fLastFound: boolean;
    //
    fPreparedBuffer: boolean;
    fPreparedLast: integer;
  protected
    function BufferLookup(Key:Integer):String;
    procedure SetBufferCapacity(Value:integer);
    function GetBufferSize:integer;
  public
    constructor Create(aOwner:TComponent); override;
    procedure PrepareBegin;
    procedure PrepareMoveToEnd;
    procedure PrepareFinished;
    procedure BufferFlush;
    procedure BufferAssert(Key:Integer;const Value:String);
    property BufferCapacity: Integer read fBufferCapacity write SetBufferCapacity;
    property BufferSize: Integer read GetBufferSize;
    property BufferHits: Integer read fBufferHits;
    property BufferRead: Integer read fBufferRead;
    property LastFound: Boolean read fLastFound;
    end;

var
  dmBufferedDataModule: TdmBufferedDataModule;

implementation

{$R *.DFM}

//------------------------------------------------------------------------------

constructor TdmBufferedDataModule.Create(aOwner:TComponent);
begin
  inherited Create(aOwner);
  fBufferCapacity:=cBufSize;
  fLastLookup:=-1;
end;

procedure TdmBufferedDataModule.SetBufferCapacity(Value:integer);
begin
  fBufferCapacity:=Value;
  fBufferHits:=0;
  fBufferRead:=0;  
  if fBufferCapacity>0 then
    with List do
      while Count>=fBufferCapacity do
        Delete(0)
  else
    BufferFlush;
end;

procedure TdmBufferedDataModule.BufferFlush;
begin
  List.Clear;
  fBufferHits:=0;
  fBufferRead:=0;
  fLastLookup:=-1;
  fLastFound:=false;
end;

function TdmBufferedDataModule.GetBufferSize:Integer;
begin
  Result:=List.Count;
end;

//

procedure TdmBufferedDataModule.PrepareBegin;
//call this proc when you've added new items to the cache
//and want to look them up in reverse order (expecting multiple new items)
begin
  fPreparedBuffer:=True;
  fPreparedLast:=pred(List.Count);
end;

procedure TdmBufferedDataModule.PrepareFinished;
//finished looking up multiple new items.
begin
  fPreparedBuffer:=False;
  fPreparedLast:=-1;
end;

procedure TdmBufferedDataModule.PrepareMoveToEnd;
//move an existing item to the end of the buffer
begin
  //this is called in response to us 'pinging' the buffer which
  //increments the hit counter. adjust it here so the number stays right.
  dec(fBufferRead);
  dec(fBufferHits);
  //move from the beginning to the end, but always one before the last one.
  //there's no point in moving the last one back to the front on round two.
  if fLastIndex<fPreparedLast then begin
    List.Exchange(fLastIndex,fPreparedLast);
    dec(fPreparedLast);
    end;
end;

//

function TdmBufferedDataModule.BufferLookup(Key:Integer):String;
begin
  if fBufferCapacity<=0 then begin
    Result:='';
    exit;
    end;
  inc(fBufferRead);
  fLastLookup:=Key;
  with List do begin
    //it may be a generally good idea to look up from the end!
    //if fPreparedBuffer then
      fLastIndex:=ReverseLinearObjectSearch(TObject(fLastLookup));
    //else
    //  fLastIndex:=FindByObject(TObject(fLastLookup));
    fLastFound:= fLastIndex>=0;
    if fLastFound then begin
      inc(fBufferHits);
      Result:=Strings[fLastIndex];
      end
    else
      Result:='';
    end;
end;

procedure TdmBufferedDataModule.BufferAssert(Key:Integer;const Value:String);
begin
  if (Key=fLastLookup) and fLastFound //reasserting the last value
  or (fBufferCapacity<=0) then        //no buffer
    exit;
  with List do begin
    if Sorted then
      //lets not mess with sorted lists yet
      exit;
    while Count>=fBufferCapacity do
      //limit the buffer size (fifo)
      Delete(0);
    //add the item to the buffer
    AddObject(Value,tObject(Key));
    end;
end;

//------------------------------------------------------------------------------
end.