Über die haben wir ja schonmal ein paar mal philosophiert. Ich habe - teils über die letzten Wochen verteilt, größtenteils aber in den letzten Stunden - endliche welche implementiert. Ich weiß nicht, ob der eine oder andere vielleicht schon welche selbst gebastelt hat - aber schaden kann es ja nicht, wenn ich sie hier zur Schau stelle.
Ist leider noch völlig ohne Kommentare. Ich hoffe aber, das meiste ist selbsterklärend. Außerdem möchte ich darauf hinweisen, dass das nicht getestet ist, sprich, noch grobe Fehler enthalten könnte (hey, das sind immerhin 284 Zeilen!).
unit GlobalArrays;
uses GlobalUtil, Assertions;
type
TGlobalArray = TDataHolder;
TGlobArrTypes = (gatBool, gatDouble, gatInt, gatStr);
TGlobalArray_Iter = record
arr: TGlobalArray;
current: Integer;
type_: TGlobArrTypes;
end;
function GA_GetLength(GA: TGlobalArray): Integer; forward;
function GA_GetType(GA: TGlobalArray): TGlobArrTypes; forward;
procedure GA_SetSize(GA: TGlobalArray; newSize: Integer); forward;
procedure GA_SetBool(GA: TGlobalArray; Idx: Integer; Val: Boolean); forward;
procedure GA_SetDouble(GA: TGlobalArray; Idx: Integer; Val: Double); forward;
procedure GA_SetInt(GA: TGlobalArray; Idx, Val: Integer); forward;
procedure GA_SetStr(GA: TGlobalArray; Idx: Integer; Val: String); forward;
procedure GA_RemoveBool(GA: TGlobalArray; Idx: Integer); forward;
procedure GA_RemoveDouble(GA: TGlobalArray; Idx: Integer); forward;
procedure GA_RemoveInt(GA: TGlobalArray; Idx: Integer); forward;
procedure GA_RemoveStr(GA: TGlobalArray; Idx: Integer); forward;
procedure GA_TypeAssert(GA: TGlobalArray; itemType: TGlobArrTypes);
begin
assert( GA_GetType(GA) = itemType,
Format('Attempt to use TGlobalArray of %s as TGlobalArray of %s.',
[itemType, GA_GetType(GA)]) );
end;
function gatToStr(gat: TGlobArrTypes): String;
begin
case gat of
gatStr: result:= 'Str';
gatInt: result:= 'Int';
gatDouble: result:= 'Double';
gatBool: result:= 'Bool';
end;
end;
function StrToGat(gat: String): TGlobArrTypes;
begin
case gat of
'Str': result:= gatStr;
'Int': result:= gatInt;
'Double': result:= gatDouble;
'Bool': result:= gatBool;
end;
end;
function GA_GetGA(Name: String): TGlobalArray;
begin
Result:= TGlobalArray(game_api_GetObject(Name));
end;
procedure GA_SaveGA(Name: String; GA: TGlobalArray);
begin
if not GlobalVarExists(Name) then game_api_registerObject(Name);
game_api_SetObject(Name, GA);
end;
function GA_GetType(GA: TGlobalArray): TGlobArrTypes;
begin
Result:= StrToGat(GA.GetString('T'));
end;
function GA_HasItemVirtually(GA: TDataHolder; Idx: Integer): Boolean;
begin
Result:= Idx < GA.GetInteger('VIRTUAL_L')-1;
end;
function GA_CreateGA(Name: String; gat: TGlobArrTypes; Size: Integer)
: TGlobalArray;
begin
Result.RegisterInteger('L');
Result.SetInteger('L', 0);
Result.RegisterInteger('VIRTUAL_L');
Result.SetInteger('VIRTUAL_L', 0);
Result.RegisterString('T');
Result.SetString('T', gatToStr(gat));
GA_SetSize(Result, Size);
game_api_registerObject(Name);
end;
function GA_GetLength(GA: TGlobalArray): Integer;
begin
Result:= GA.GetInteger('Length');
end;
procedure GA_SetSize(GA: TGlobalArray; newSize: Integer);
var
i: Integer;
begin
if newSize < GA_GetLength(GA)-1 then
begin
GA.SetInteger('VIRTUAL_L', GA_GetLength(GA));
for i:=GA_GetLength(GA) to newSize do
begin
case GA_GetType(GA) of
gatBool: GA_RemoveBool(GA, i);
gatDouble: GA_RemoveDouble(GA, i);
gatInt: GA_RemoveInt(GA, i);
gatStr: GA_RemoveStr(GA, i);
end;
end;
end
else
begin
GA.SetInteger('L',newSize);
for i:=newSize to GA_GetLength(GA)-1 do
begin
case GA_GetType(GA) of
gatBool:
begin
if not GA_HasItemVirtually(GA, i) then
begin
GA.RegisterBoolean('ITEM'+IntToStr(i));
end;
GA_SetBool(GA, i, False);
end;
gatDouble:
begin
if not GA_HasItemVirtually(GA, i) then
begin
GA.RegisterDouble('ITEM'+IntToStr(i));
end;
GA_SetDouble(GA, i, 0.0);
end;
gatInt:
begin
if not GA_HasItemVirtually(GA, i) then
begin
GA.RegisterInteger('ITEM'+IntToStr(i));
end;
GA_SetInt(GA, i, 0);
end;
gatStr:
begin
if not GA_HasItemVirtually(GA, i) then
begin
GA.RegisterString('ITEM'+IntToStr(i));
end;
GA_SetStr(GA, i, '');
end;
end;
end;
end;
end;
function GA_GetBool(GA: TGlobalArray; Idx: Integer): Boolean;
begin
GA_TypeAssert(GA, gatBool);
assert(Idx < GA_GetLength(GA), Format('Index out of Bounds for TGlobalArray '
+'of %s',[GatToStr(gatBool)]) );
Result:= GA.GetBoolean('ITEM'+IntToStr(Idx));
end;
function GA_GetDouble(GA: TGlobalArray; Idx: Integer): Double;
begin
GA_TypeAssert(GA, gatDouble);
assert(Idx < GA_GetLength(GA), Format('Index out of Bounds for TGlobalArray '
+'of %s',[GatToStr(gatDouble)]) );
Result:= GA.GetDouble('ITEM'+IntToStr(Idx));
end;
function GA_GetInt(GA: TGlobalArray; Idx: Integer): Integer;
begin
GA_TypeAssert(GA, gatInt);
assert(Idx < GA_GetLength(GA), Format('Index out of Bounds for TGlobalArray '
+'of %s',[GatToStr(gatInt)]) );
Result:= GA.GetInteger('ITEM'+IntToStr(Idx));
end;
function GA_GetStr(GA: TGlobalArray; Idx: Integer): String;
begin
GA_TypeAssert(GA, gatStr);
assert(Idx < GA_GetLength(GA), Format('Index out of Bounds for TGlobalArray '
+'of %s',[GatToStr(gatStr)]) );
Result:= GA.GetString('ITEM'+IntToStr(Idx));
end;
procedure GA_SetBool(GA: TGlobalArray; Idx: Integer; Val: Boolean);
begin
GA_TypeAssert(GA, gatBool);
assert(Idx < GA_GetLength(GA), Format('Index out of Bounds for TGlobalArray '
+'of %s',[GatToStr(gatBool)]) );
GA.SetBoolean('ITEM'+IntToStr(Idx), Val);
end;
procedure GA_SetDouble(GA: TGlobalArray; Idx: Integer; Val: Double);
begin
GA_TypeAssert(GA, gatDouble);
assert(Idx < GA_GetLength(GA), Format('Index out of Bounds for TGlobalArray '
+'of %s',[GatToStr(gatDouble)]) );
GA.SetDouble('ITEM'+IntToStr(Idx), Val);
end;
procedure GA_SetInt(GA: TGlobalArray; Idx, Val: Integer);
begin
GA_TypeAssert(GA, gatBool);
assert(Idx < GA_GetLength(GA), Format('Index out of Bounds for TGlobalArray '
+'of %s',[GatToStr(gatInt)]) );
GA.SetInteger('ITEM'+IntToStr(Idx), Val);
end;
procedure GA_SetStr(GA: TGlobalArray; Idx: Integer; Val: String);
begin
GA_TypeAssert(GA, gatStr);
assert(Idx < GA_GetLength(GA), Format('Index out of Bounds for TGlobalArray '
+'of %s',[GatToStr(gatStr)]) );
GA.SetString('ITEM'+IntToStr(Idx), Val);
end;
procedure GA_RemoveBool(GA: TGlobalArray; Idx: Integer);
begin
GA_TypeAssert(GA, gatBool);
GA.SetBoolean('ITEM'+IntToStr(Idx),False);
end;
procedure GA_RemoveDouble(GA: TGlobalArray; Idx: Integer);
begin
GA_TypeAssert(GA, gatDouble);
GA.SetDouble('ITEM'+IntToStr(Idx), 0.00);
end;
procedure GA_RemoveInt(GA: TGlobalArray; Idx: Integer);
begin
GA_TypeAssert(GA, gatInt);
GA.setInteger('ITEM'+IntToStr(Idx), 0);
end;
procedure GA_RemoveStr(GA: TGlobalArray; Idx: Integer);
begin
GA_TypeAssert(GA, gatStr);
GA.SetString('ITEM'+IntToStr(Idx), '');
end;
function GA_iter(GA: TGlobalArray; gat: TGlobArrTypes): TGlobalArray_Iter;
begin
Result.arr:= GA;
Result.current:= 0;
Result.type_:= GA_GetType(GA);
GA_TypeAssert(result.arr, gat);
end;
function GA_HasNext(GA: TGlobalArray_Iter): Boolean;
begin
Result:= GA.current < GA_GetLength(GA.arr)-1;
end;
function GA_nextBool(GA: TGlobalArray_Iter): Boolean;
begin
GA_TypeAssert(GA.arr, gatDouble);
inc(GA.current);
Result:= GA_GetBool(GA.arr, ga.current);
end;
function GA_nextDouble(GA: TGlobalArray_Iter): Double;
begin
GA_TypeAssert(GA.arr, gatDouble);
inc(GA.current);
Result:= GA_GetDouble(GA.arr, ga.current);
end;
function GA_nextInt(GA: TGlobalArray_Iter): Integer;
begin
GA_TypeAssert(GA.arr, gatInt);
inc(GA.current);
Result:= GA_GetInt(GA.arr, ga.current);
end;
function GA_nextStr(GA: TGlobalArray_Iter): String;
begin
GA_TypeAssert(GA.arr, gatStr);
inc(GA.current);
Result:= GA_GetStr(GA.arr, ga.current);
end;
begin
end.
Das benötigt zwei triviale Funktionen aus meinem sonstigen Fundus, assert und GlobalVarExists. assert sieht so aus:
procedure assert(Cond: Boolean; FailMsg: String);
begin
{$IFDEF DEBUG}
if not Cond then
begin
game_api_MessageBox(Format('Assertion failed in %s:' #13#10
+FailMsg, [mission_GetSelf().MissionName]));
end;
{$ENDIF}
end;
Und GlobalVarExists ist noch simpler:
function GlobalVarExists(Name: String): Boolean;
begin
Result:= game_api_CheckGlobalVar(Name) <> gvtNotDefined;
end;
Kritik, Vorschläge, Korrekturen, usw. und vielleicht sogar Lob sind willkommen =)
verfasst am: 21.06.2010, 20:59
