Changeset 160 for trunk/AI/StdAI/Pile.pas

Timestamp:

Mar 6, 2019, 8:10:23 AM (5 years ago)

Author:

chronos

Message:

• Added: StdAI from original game. Previously used only AI dev kit.

File:

• trunk/AI/StdAI/Pile.pas (modified) (2 diffs)

trunk/AI/StdAI/Pile.pas

@@ -1 @@
-{ single instance priority queue
-  main parts contributed by Rassim Eminli }
+{single instance priority queue
+main parts contributed by Rassim Eminli}
 
 {$INCLUDE Switches.inc}
+
 unit Pile;
 
@@ -14 +15 @@
 function Get(var Item, Value: integer): boolean;
 
+
 implementation
 
 const
-  MaxSize = 9600;
+MaxSize=9600;
 
 type
-  TheapItem = record
-    Item: integer;
-    Value: integer;
-  end;
+TheapItem = record
+        Item:   integer;
+        Value:  integer;
+end;
 
 var
-  bh: array [0 .. MaxSize - 1] of TheapItem;
-  Ix: array [0 .. MaxSize - 1] of integer;
-  n, CurrentSize: integer;
-{$IFDEF DEBUG}InUse: boolean; {$ENDIF}
+bh: array[0..MaxSize-1] of TheapItem;
+Ix: array[0..MaxSize-1] of integer;
+n, CurrentSize: integer;
+{$IFDEF DEBUG}InUse: boolean;{$ENDIF}
+
 
 procedure Create(Size: integer);
 begin
-{$IFDEF DEBUG}assert(not InUse, 'Pile is a single instance class, ' + 'no multiple usage possible. Always call Pile.Free after use.'); {$ENDIF}
-  assert(Size <= MaxSize);
-  if (n <> 0) or (Size > CurrentSize) then
-  begin
-    FillChar(Ix, Size * sizeOf(integer), 255);
-    n := 0;
-  end;
-  CurrentSize := Size;
-{$IFDEF DEBUG}InUse := true; {$ENDIF}
+        {$IFDEF DEBUG}assert(not InUse, 'Pile is a single instance class, '
+          +'no multiple usage possible. Always call Pile.Free after use.');{$ENDIF}
+        assert(Size<=MaxSize);
+        if (n <> 0) or (Size > CurrentSize) then
+        begin
+                FillChar(Ix, Size*sizeOf(integer), 255);
+                n := 0;
+        end;
+        CurrentSize := Size;
+        {$IFDEF DEBUG}InUse:=true;{$ENDIF}
 end;
 
 procedure Free;
 begin
-{$IFDEF DEBUG}assert(InUse);
-  InUse := false; {$ENDIF}
+        {$IFDEF DEBUG}assert(InUse);InUse:=false;{$ENDIF}
 end;
 
 procedure Empty;
 begin
-  if n <> 0 then
-  begin
-    FillChar(Ix, CurrentSize * sizeOf(integer), 255);
-    n := 0;
-  end;
+        if n <> 0 then
+        begin
+                FillChar(Ix, CurrentSize*sizeOf(integer), 255);
+                n := 0;
+        end;
 end;
 
-// Parent(i) = (i-1)/2.
-function Put(Item, Value: integer): boolean; // O(lg(n))
+//Parent(i) = (i-1)/2.
+function Put(Item, Value: integer): boolean; //O(lg(n))
 var
-  i, j: integer;
+        i, j:   integer;
 begin
-  assert(Item < CurrentSize);
-  i := Ix[Item];
-  if i >= 0 then
-  begin
-    if bh[i].Value <= Value then
-    begin
-      result := false;
-      exit;
-    end;
-  end
-  else
-  begin
-    i := n;
-    Inc(n);
-  end;
+        assert(Item<CurrentSize);
+        i := Ix[Item];
+        if i >= 0 then
+        begin
+                if bh[i].Value <= Value then
+                begin
+                        result := False;
+                        exit;
+                end;
+        end
+        else
+        begin
+                i := n;
+                Inc(n);
+        end;
 
-  while i > 0 do
-  begin
-    j := (i - 1) shr 1; // Parent(i) = (i-1)/2
-    if Value >= bh[j].Value then
-      break;
-    bh[i] := bh[j];
-    Ix[bh[i].Item] := i;
-    i := j;
-  end;
-  // Insert the new Item at the insertion point found.
-  bh[i].Value := Value;
-  bh[i].Item := Item;
-  Ix[bh[i].Item] := i;
-  result := true;
+        while i > 0 do
+        begin
+                j := (i-1) shr 1;       //Parent(i) = (i-1)/2
+                if Value >= bh[j].Value then    break;
+                bh[i] := bh[j];
+                Ix[bh[i].Item] := i;
+                i := j;
+        end;
+        //      Insert the new Item at the insertion point found.
+        bh[i].Value := Value;
+        bh[i].Item := Item;
+        Ix[bh[i].Item] := i;
+        result := True;
 end;
 
 function TestPut(Item, Value: integer): boolean;
 var
-  i: integer;
+        i: integer;
 begin
-  assert(Item < CurrentSize);
-  i := Ix[Item];
-  result := (i < 0) or (bh[i].Value > Value);
+        assert(Item<CurrentSize);
+        i := Ix[Item];
+        result := (i < 0) or (bh[i].Value > Value);
 end;
 
-// Left(i) = 2*i+1.
-// Right(i) = 2*i+2 => Left(i)+1
-function Get(var Item, Value: integer): boolean; // O(lg(n))
+//Left(i) = 2*i+1.
+//Right(i) = 2*i+2 => Left(i)+1
+function Get(var Item, Value: integer): boolean; //O(lg(n))
 var
-  i, j: integer;
-  last: TheapItem;
+        i, j:   integer;
+        last:   TheapItem;
 begin
-  if n = 0 then
-  begin
-    result := false;
-    exit;
-  end;
+        if n = 0 then
+        begin
+                result := False;
+                exit;
+        end;
 
-  Item := bh[0].Item;
-  Value := bh[0].Value;
+        Item := bh[0].Item;
+        Value := bh[0].Value;
 
-  Ix[Item] := -1;
+        Ix[Item] := -1;
 
-  dec(n);
-  if n > 0 then
-  begin
-    last := bh[n];
-    i := 0;
-    j := 1;
-    while j < n do
-    begin
-      // Right(i) = Left(i)+1
-      if (j < n - 1) and (bh[j].Value > bh[j + 1].Value) then
-        Inc(j);
-      if last.Value <= bh[j].Value then
-        break;
+        dec(n);
+        if n > 0 then
+        begin
+                last := bh[n];
+                i := 0;         j := 1;
+                while j < n do
+                begin
+                                                                                //      Right(i) = Left(i)+1
+                        if(j < n-1) and (bh[j].Value > bh[j + 1].Value)then
+                                inc(j);
+                        if last.Value <= bh[j].Value then               break;
 
-      bh[i] := bh[j];
-      Ix[bh[i].Item] := i;
-      i := j;
-      j := j shl 1 + 1; // Left(j) = 2*j+1
-    end;
+                        bh[i] := bh[j];
+                        Ix[bh[i].Item] := i;
+                        i := j;
+                        j := j shl 1+1; //Left(j) = 2*j+1
+                end;
 
-    // Insert the root in the correct place in the heap.
-    bh[i] := last;
-    Ix[last.Item] := i;
-  end;
-  result := true
+                // Insert the root in the correct place in the heap.
+                bh[i] := last;
+                Ix[last.Item] := i;
+        end;
+        result := True
 end;
 
 initialization
+        n:=0;
+        CurrentSize:=0;
+        {$IFDEF DEBUG}InUse:=false;{$ENDIF}
+end.
 
-n := 0;
-CurrentSize := 0;
-{$IFDEF DEBUG}InUse := false; {$ENDIF}
-
-end.