(****************************************************************************)
(*                                                                          *)
(* HPool.pas                                                           1.0  *)
(*                                                                          *)
(* Generic pool container.                                                  *)
(*                                                                          *)
(****************************************************************************)
Unit HPool;

interface

  (****************************************************************)
  (*                                                              *)
  (*  A Pool is a simple generic container that provides fast     *)
  (*  lookup and insertion/removal. They are used by the high     *)
  (*  level library to implement glyph bitmap and outline         *)
  (*  caches.                                                     *)
  (*                                                              *)

const
  (****************************************************************)
  (*  the maximum number of elements per pool slice               *)
  (*                                                              *)
  Max_Pool_Slice_Elements = 8;

  (****************************************************************)
  (*  the number of hash buckets per pool                         *)
  (*                                                              *)
  Max_Pool_Buckets = 32;

type
  TPool_Element = record
    key  : integer;
    data : Pointer;
  end;

  PPool_Slice = ^TPool_Slice;
  TPool_Slice = record
    next  : PPool_Slice;
    count : integer;
    items : array[0..Max_Pool_Slice_Elements-1] of TPool_Element;
  end;

  TPool_Iterator = function( key   : integer;
                             data  : Pointer;
                             param : Pointer ) : Boolean;

  PPool = ^TPool;
  TPool = object
            constructor Init( destroyer : TPool_Iterator );

            (**************************************************)
            (*  Add a new element, with key 'key' to the pool *)
            (*                                                *)
            function add( key  : integer;
                          data : Pointer ) : Boolean;

            (**************************************************)
            (*  Replace an element in the pool with another   *)
            (*                                                *)
            function replace( key          : integer;
                              data         : Pointer;
                              var old_data : Pointer ) : Boolean;

            (**************************************************)
            (*  Retrieve an element from the pool             *)
            (*                                                *)
            function retrieve( key : integer ) : Pointer;

            (**************************************************)
            (*  Iterate an operation on all pool elements     *)
            (*                                                *)
            function iterate( iterator  : TPool_Iterator;
                              parameter : Pointer       ) : Boolean;

            destructor Done; virtual;

          private
            buckets : array[0..Max_Pool_Buckets-1] of PPool_Slice;
            destroy : TPool_Iterator;
          end;


  POutline_Pool = ^TOutline_Pool;
  TOutline_Pool = object(TPool)
                    constructor Init;
                  end;

  PBitmap_Pool = ^TOutline_Pool;
  TBitmap_Pool = object(TPool)
                    constructor Init;
                 end;

  PPixmap_Pool = ^TPixmap_Pool;
  TPixmap_Pool = object(TPool)
                   constructor Init;
                 end;

implementation

uses FTOutln, FTBitmap;

  function outline_destroy( key       : integer;
                            data      : Pointer;
                            parameter : Pointer ) : Boolean;
  begin
    (* XXXX: to do *)
  end;

  function bitmap_destroy( key       : integer;
                           data      : Pointer;
                           parameter : Pointer ) : Boolean;
  begin
    (* XXXX: to do *)
  end;

  function pixmap_destroy( key       : integer;
                           data      : Pointer;
                           parameter : Pointer ) : Boolean;
  begin
    (* XXXX: to do *)
  end;

  constructor TPool.Init;
  var
    n : integer;
  begin
    for n := 0 to Max_Pool_Buckets-1 do
      buckets[n] := nil;

    destroy := destroyer;
  end;

  constructor TOutline_Pool.Init;
  begin
    inherited Init( outline_destroy );
  end;

  constructor TBitmap_Pool.Init;
  begin
    inherited Init( bitmap_destroy );
  end;

  constructor TPixmap_Pool.Init;
  begin
    inherited Init( pixmap_destroy );
  end;
  function TPool.add( key : integer; data : Pointer ) : Boolean;
  var
    hash  : integer;
    n     : integer;
    old   : PPool_Slice;
    slice : PPool_Slice;
  begin
    hash  := key mod Max_Pool_Buckets;
    slice := buckets[hash];

    if slice = nil then
      begin
        New( slice );
        slice^.count  := 0;
        slice^.next   := nil;
        buckets[hash] := slice;
      end;

    old := nil;
    while slice <> nil do
    begin

      (* check that the key isn't already in the pool *)
      for n := 0 to slice^.count-1 do
        if slice^.items[n].key = key then
        begin
          (* we found the key in the pool, exit with error *)
          add := False;
          exit;
        end;

      old   := slice;
      slice := slice^.next;
    end;

    if old^.count >= Max_Pool_Slice_Elements-1 then
    begin
      New( slice );
      slice^.count := 0;
      slice^.next  := nil;
      old^.next    := slice;
    end
    else
      slice := old;

    slice^.items[slice^.count].key  := key;
    slice^.items[slice^.count].data := data;
    inc( slice^.count );

    add := True;
  end;


  function  TPool.replace( key          : integer;
                           data         : Pointer;
                           var old_data : Pointer ) : Boolean;
  var
    hash  : integer;
    n     : integer;
    slice : PPool_Slice;
  label
    Fail;
  begin
    (* find key in pool and replace element *)
    hash  := key mod Max_Pool_Buckets;
    slice := buckets[hash];

    (* the element isn't in the pool, exit with failure *)
    if slice = nil then
      goto Fail;

    while slice <> nil do
    begin

      for n := 0 to slice^.count-1 do
        if slice^.items[n].key = key then
          begin
            old_data := slice^.items[n].data;
            slice^.items[n].data := data;
            replace := True;
            exit;
          end;

      slice := slice^.next;
    end;

  Fail:
    old_data := nil;
    replace  := False;
  end;


  function  TPool.retrieve( key : integer ) : Pointer;
  var
    hash  : integer;
    n, m  : integer;
    old   : PPool_Slice;
    last  : PPool_Slice;
    slice : PPool_Slice;
  label
    Fail;
  begin
    retrieve := nil;

    hash  := key mod Max_Pool_Buckets;
    slice := buckets[hash];

    (* the element isn't in the pool, exit with failure *)
    if slice = nil then
      goto Fail;

    old := nil;
    while slice <> nil do
    begin

      for n := 0 to slice^.count-1 do
        if slice^.items[n].key = key then
          begin
            retrieve := slice^.items[n].data;

            (* now get last pool element and move it there *)
            last := slice;
            while last^.next <> nil do
              begin
                old  := last;
                last := last^.next;
              end;

            m               := last^.count-1;
            slice^.items[n] := last^.items[m];
            last^.count     := m;

            (* destroy last slice if it is now empty *)
            if m = 0 then
              begin
                Dispose( last );
                old^.next := nil;
              end;

            exit;
          end;

      old   := slice;
      slice := slice^.next;
    end;

  Fail:
    retrieve := nil;
  end;


  function  TPool.iterate( iterator  : TPool_Iterator;
                           parameter : Pointer       ) : Boolean;
  var
    n, m  : integer;
    slice : PPool_Slice;
  begin
    for n := 0 to Max_Pool_Buckets-1 do
    begin
      slice := buckets[n];
      while slice <> nil do
      begin
        for m := 0 to slice^.count-1 do
          iterator( slice^.items[m].key, slice^.items[m].data, parameter );
        slice := slice^.next;
      end;
    end;

    iterate := True;
  end;



  destructor TPool.done;
  var
    n    : integer;
    cur  : PPool_Slice;
    next : PPool_Slice;
  begin
    (* if a destroyer was given when the pool was created, use it *)
    (* to destroy all items in the pool. the 'param' field is set *)
    (* to nil during the iteration                                *)
    if @destroy <> nil then
      iterate( destroy, nil );

    (* now, simply releases the pool slices *)
    for n := 0 to Max_Pool_Buckets-1 do
    begin
      cur := buckets[n];
      while cur <> nil do
        begin
          next       := cur^.next;
          cur^.count := 0;
          Dispose(cur);
          cur        := next;
        end;
    end;
  end;


end.
