{ -----------------------------------------------------------------------
Tcl Scripting Language Components (Tslc)
Copyright (C) 1996-2002 William Byrne

This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or (at your option) any later version.

This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA

WilliamB@ByrneLitho.com
------------------------------------------------------------------------}
unit DynaElem;

///////////////////////////////////////////////////////////////////////////////
//
//  TclDbTbl.pas
//	Copyright(c) 1995-1997 William Byrne
//		WilliamB@ByrneLitho.com
//		76262.13@CompuServe.com
//
//	All rights reserved.
//  	William Byrne makes no representations about the suitability of this
//    	software for any purpose.  It is provided "as is" without express or
//    	implied warranty.
//
//	Usage
//      I hereby grant to the legal purchasors of the source code contained
//      herein a non-exclusive license for the use of said source code in
//      developing compiled, executable software, and for the distribution of
//      said source code as part of said developed, compiled, executable software.
//
//  Purpose:
//		This file provides for Bde Table Manipulation using the
//		Tcl Scripting Language Components.
//
//	Editor:
//		Tab stops = 4
//		Page width = 132 characters
//		Font = Courier New, 8pt
//
//  Misc:
//      ??? = Note to self

{$Z+}
{$D-,L-,Y-,R-,H+}
{$O+}

interface
uses WinTypes, DynaData;
type


	pTDynaInteger = ^TDynaInteger;
	TDynaInteger = class(TDynaData)
	public
		constructor Create(Delta : word);
		function Get(id : word) : integer;
		procedure SetValue(id : word; value : integer);
		procedure Add(i : integer);
		procedure AddArray(pi : pInteger; count : word);
	end;

	pDouble = ^Double;
    pTDynaDouble = ^TDynaDouble;
    TDynaDouble = class(TDynaData)
    public
    	constructor Create(Delta: word);
        function Get(id: word) : double;
        procedure SetValue(id: word; value: double);
        procedure Add(d: double);
        procedure AddArray(pd: pDouble; count: word);
    end;

	pTDynaBits	= ^TDynaBits;
	TDynaBits = class(TDynaInteger)
	public
		constructor Create(Delta : longInt);
		procedure Add(id : longInt; value : boolean);
		function Get(id : longInt) : boolean;
		procedure SetBit(id : longInt);
		procedure ResetBit(id : longInt);
		procedure Toggle(id : longInt);
	end;

	pTRect = ^TRect;
	pTDynaRect	= ^TDynaRect;
	TDynaRect = class(TDynaData)
	public
		constructor Create(Delta : word);
		function Get(id : word) : TRect;
		procedure Add(rect : TRect);
		procedure AddArray(pRect : pTRect; count : word);
	end;

implementation


{~~~ TDynaInteger ~~~}

constructor TDynaInteger.Create(Delta : word);
begin
	inherited Create( sizeof(integer), Delta);
end;

function TDynaInteger.Get(id : word) : integer;
begin
	Result := pInteger(inherited Get(id))^;
end;

procedure TDynaInteger.SetValue(id : word; value : integer);
begin
	pInteger(inherited Get(id))^ := value;
end;

procedure TDynaInteger.AddArray(pi : pInteger; count : word);
begin
	inherited Add(pi, count);
end;

procedure TDynaInteger.Add(i : integer);
begin
	inherited Add(@i, 1);
end;

{~~~ TDynaDouble ~~~}

constructor TDynaDouble.Create(Delta : word);
begin
	inherited Create( sizeof(double), Delta);
end;

function TDynaDouble.Get(id : word) : double;
begin
	Result := pDouble(inherited Get(id))^;
end;

procedure TDynaDouble.SetValue(id : word; value : double);
begin
	pDouble(inherited Get(id))^ := value;
end;

procedure TDynaDouble.AddArray(pd : pDouble; count : word);
begin
	inherited Add(pd, count);
end;

procedure TDynaDouble.Add(d : double);
begin
	inherited Add(@d, 1);
end;

{~~~ TDynaBits ~~~}

const
{$IFDEF WIN32}
	cBitsInInteger = 32;
  cBitMask	= $FFFFFFFF;
{$ELSE}
	cBitsInInteger = 16;
  cBitMask	= $FFFF;
{$ENDIF}

constructor TDynaBits.Create(Delta : longInt);
begin
	inherited Create( word((Delta + (cBitsInInteger - 1)) div cBitsInInteger));
end;

function TDynaBits.Get(id : longInt) : boolean;
begin
	result := (inherited Get(id div cBitsInInteger) and (1 shl (id mod cBitsInInteger))) <> 0;
end;

procedure TDynaBits.SetBit(id : longInt);
var
	w : word;
begin
	w := id div cBitsInInteger;
	SetValue(w, (inherited Get(w)) or (1 shl (id mod cBitsInInteger)));
end;

procedure TDynaBits.ReSetBit(id : longInt);
var
	w : word;
begin
	w := id div cBitsInInteger;
	setValue(w, (inherited Get(w)) and (cBitMask xor (1 shl (id mod cBitsInInteger))));
end;

procedure TDynaBits.Toggle(id : longInt);
begin
	if Get(id) then ResetBit(id)
	else SetBit(id);
end;

procedure TDynaBits.Add(id : longInt; value : boolean);
var
	w : word;
begin
	w := (id div cBitsInInteger) + 1;
	if w > count then AddArray(nil, w - count);
	if Value then SetBit(id)
	else ResetBit(id);
end;



{~~~ TDynaRect ~~~}

constructor TDynaRect.Create(Delta : word);
begin
	inherited Create( sizeof(TRect), Delta);
end;

function TDynaRect.Get(id : word) : TRect;
begin
	Result := pTRect(inherited Get(id))^;
end;

procedure TDynaRect.AddArray(pRect : pTRect; count : word);
begin
	inherited Add(pRect, count);
end;

procedure TDynaRect.Add(rect : TRect);
begin
	inherited Add(@rect, 1);
end;

end.
