Current line of development release (344 rev. truncated adjusted copy)

git-svn-id: http://svn.miranda-ng.org/main/trunk@1669 1316c22d-e87f-b044-9b9b-93d7a3e3ba9c

1 files changed, 396 insertions, 153 deletions

diff --git a/plugins/Chess4Net/PosBaseUnit.pas b/plugins/Chess4Net/PosBaseUnit.pas
index e45ea46b0c..60f6cba6c4 100644
--- a/plugins/Chess4Net/PosBaseUnit.pas
+++ b/plugins/Chess4Net/PosBaseUnit.pas
@@ -1,9 +1,17 @@
+////////////////////////////////////////////////////////////////////////////////

+// All code below is exclusively owned by author of Chess4Net - Pavel Perminov

+// (packpaul@mail.ru, packpaul1@gmail.com).

+// Any changes, modifications, borrowing and adaptation are a subject for

+// explicit permition from the owner.

+

 unit PosBaseUnit;

 

 interface

 

 uses

-  ChessBoardHeaderUnit, ChessRulesEngine, ChessBoardUnit, Classes;

+  Classes,

+  //

+  ChessRulesEngine;

 

 type

   PMoveEst = ^TMoveEst;

@@ -12,31 +20,42 @@ type
     estimate: LongWord;

   end;

 

-  TFieldNode = packed record

-    bField: byte;

-    bNextNode: byte; // сл. узел

-    wNextNode: word;

-    bNextValue: byte; // сл. значение данных

-    wNextValue: word;

-  end;

+  TReestimate = procedure(moveEsts: TList; nRec: integer);

 

-  TMoveNode = packed record

-    wMove: word;

-    estimate: LongWord;

-    bNextValue: byte; // сл. значение данных

-    wNextValue: word;

+  TPosBaseStream = class

+  private

+    m_iRecordSize: integer;

+    m_iHeaderSize: integer;

+    m_InnerStream: TStream;

+    constructor Create(const strFileName: string; RecordSize: integer);

+    function FGetSize: integer;

+  public

+    destructor Destroy; override;

+    procedure SeekHeader;

+    procedure SeekRec(lwRecordNumber: LongWord);

+    procedure SeekEnd;

+    procedure Write(const Buffer); overload;

+    procedure Write(const Buffer; Count: integer); overload;

+    procedure Read(var Buffer); overload;

+    procedure Read(var Buffer; Count: integer); overload;

+    property Size: integer read FGetSize;

+    property HeaderSize: integer read m_iHeaderSize write m_iHeaderSize;

   end;

 

-  TReestimate = procedure(moveEsts: TList; nRec: integer);

-

   TPosBase = class

   private

-    fPos: file of TFieldNode;

-    fMov: file of TMoveNode;

-    Reestimate: TReestimate;

+    m_iDBVersion: Integer;

+    fPos: TPosBaseStream;

+    fMov: TPosBaseStream;

+    FReestimate: TReestimate;

+    procedure FCreateStreams(const strPosFileName, strMovFileName: string);

+    procedure FDestroyStreams;

+    procedure FSetDBVersion;

+    function FCheckDBVersion: Boolean;

   public

     procedure Add(const posMove: TPosMove); // добавление позиции и хода в базу

-    function Find(const pos: TChessPosition; moveEsts: TList = nil): boolean;

+    function Find(const pos: TChessPosition): boolean; overload;

+    function Find(const pos: TChessPosition; var moveEsts: TList): boolean; overload;

     constructor Create(fileNameNoExt: string; Reestimate: TReestimate = nil);

     destructor Destroy; override;

   end;

@@ -47,15 +66,46 @@ uses
   SysUtils;

 

 type

+  TFieldNode = packed object

+  public

+    btField: byte;

+  private

+    m_btNextNode: byte; // сл. узел

+    m_wNextNode: word;

+    m_btNextValue: byte; // сл. значение данных

+    m_wNextValue: word;

+    function FGetNextNode: LongWord;

+    procedure FSetNextNode(lwValue: LongWord);

+    function FGetNextValue: LongWord;

+    procedure FSetNextValue(lwValue: LongWord);

+  public

+    property NextNode: LongWord read FGetNextNode write FSetNextNode;

+    property NextValue: LongWord read FGetNextValue write FSetNextValue;

+  end;

+

+  TMoveNode = packed object

+  public

+    wMove: word;

+    estimate: LongWord;

+  private

+    m_btNextValue: byte; // сл. значение данных

+    m_wNextValue: word;

+    function FGetNextValuePos: LongWord;

+    procedure FSetNextValuePos(lwValue: LongWord);

+  public

+    procedure EmptyNode;

+    property NextValue: LongWord read FGetNextValuePos write FSetNextValuePos;

+  end;

+

   TCoord = record

-    i,j: integer;

+    i, j: integer;

   end;

 

 const

   POS_FILE_EXT = 'pos';

   MOV_FILE_EXT = 'mov';

-  EMPTY_MOVE_NODE: TMoveNode =

-    (wMove: 0; estimate: 0; bNextValue: 0; wNextValue: 0);

+

+  DB_VERSION = 1;

 

   FIELD_SEQ: array[1..64] of TCoord = // 13617 kb

     ((i: 1; j: 1), (i: 1; j: 2), (i: 1; j: 3), (i: 1; j: 4),

@@ -75,33 +125,77 @@ const
      (i: 5; j: 1), (i: 5; j: 2), (i: 5; j: 3), (i: 5; j: 4),

      (i: 5; j: 5), (i: 5; j: 6), (i: 5; j: 7), (i: 5; j: 8));

 

+////////////////////////////////////////////////////////////////////////////////

+// TPosBase

+

 constructor TPosBase.Create(fileNameNoExt: string; Reestimate: TReestimate = nil);

 begin

-  AssignFile(fPos, fileNameNoExt + '.' + POS_FILE_EXT);

-{$I-}

-  Reset(fPos);

-{$I+}

-  if IOResult <> 0 then

-    Rewrite(fPos);

-

-  AssignFile(fMov, fileNameNoExt + '.' + MOV_FILE_EXT);    

-{$I-}

-  Reset(fMov);

-{$I+}

-  try

-    if IOResult <> 0 then

-      Rewrite(fMov);

-  except

-    Close(fPos);

-    raise;

-  end;

-  self.Reestimate := Reestimate;

+  inherited Create;

+

+  self.FReestimate := Reestimate;

+

+  FCreateStreams(fileNameNoExt + '.' + POS_FILE_EXT,

+    fileNameNoExt + '.' + MOV_FILE_EXT);

+  FSetDBVersion;

 end;

 

+

 destructor TPosBase.Destroy;

 begin

-  CloseFile(fPos); // TODO: Here occurs an error if client is closed unforced

-  CloseFile(fMov);

+  FDestroyStreams;

+  inherited;

+end;

+

+

+procedure TPosBase.FSetDBVersion;

+var

+  btData: byte;

+  wVersion: word;

+begin

+  m_iDBVersion := DB_VERSION; // default version

+

+  if (fPos.Size > 0) then

+  begin

+    fPos.SeekHeader;

+    fPos.Read(btData, SizeOf(btData));

+    if (btData <> $FF) then

+    begin

+      m_iDBVersion := 0;

+      fPos.HeaderSize := 0;

+      exit;

+    end;

+    fPos.Read(wVersion, SizeOf(wVersion));

+    m_iDBVersion := wVersion;

+  end

+  else

+  begin

+    btData := $FF;

+    wVersion := m_iDBVersion;

+    fPos.Write(btData, SizeOf(btData));

+    fPos.Write(wVersion, SizeOf(wVersion));

+  end;

+

+  fPos.HeaderSize := SizeOf(byte) + SizeOf(word);

+end;

+

+

+function TPosBase.FCheckDBVersion: Boolean;

+begin

+  Result := (m_iDBVersion <= DB_VERSION);

+end;

+

+

+procedure TPosBase.FCreateStreams(const strPosFileName, strMovFileName: string);

+begin

+  fPos := TPosBaseStream.Create(strPosFileName, SizeOf(TFieldNode));

+  fMov := TPosBaseStream.Create(strMovFileName, SizeOf(TMoveNode));

+end;

+

+

+procedure TPosBase.FDestroyStreams;

+begin

+  fMov.Free;

+  fPos.Free;

 end;

 

 

@@ -139,53 +233,52 @@ var
   begin

     // Добавление узлов позиции

     if r >= 0 then

-      begin

-        nr := FileSize(fPos);

-        fn.bNextValue := nr and $FF;

-        fn.wNextValue := nr shr 8;

-        Seek(fPos, r);

-        write(fPos, fn);

-        Seek(fPos, nr);

-      end

+    begin

+      nr := fPos.Size;

+      fn.NextValue := nr;

+      fPos.SeekRec(r);

+      fPos.Write(fn);

+      fPos.SeekRec(nr);

+    end

     else

       nr := 0;

     for l := k to 66 do // 65 - доп. инф, 66 - цвет.

+    begin

+      if l = 66 then

       begin

-        if l = 66 then

-          begin

-            fn.bField := ord(posMove.pos.color);

-            nr := FileSize(fMov);

-          end

-        else

-          begin

-            if l <= 64 then

-              fn.bField := ord(posMove.pos.board[FIELD_SEQ[l].i, FIELD_SEQ[l].j])

-            else // l = 65

-              fn.bField := addInf;

-            inc(nr);

-          end;

-        fn.bNextNode := nr and $FF;

-        fn.wNextNode := nr shr 8;

-        fn.bNextValue := 0;

-        fn.wNextValue := 0;

-        write(fPos, fn);

+        fn.btField := ord(posMove.pos.color);

+        nr := fMov.Size;

+      end

+      else

+      begin

+        if l <= 64 then

+          fn.btField := ord(posMove.pos.board[FIELD_SEQ[l].i, FIELD_SEQ[l].j])

+        else // l = 65

+          fn.btField := addInf;

+        inc(nr);

       end;

+      fn.NextNode := nr;

+      fn.NextValue := 0;

+      fPos.Write(fn);

+    end;

     // формирование записи хода

-    mn := EMPTY_MOVE_NODE;

+    mn.EmptyNode;

     mn.wMove := EncodeMove(posMove.move);

-    if Assigned(Reestimate) then

+

+    if Assigned(FReestimate) then

     begin

       estList := TList.Create;

       try

         estList.Add(Pointer(mn.estimate));

-        Reestimate(estList, 0);

+        FReestimate(estList, 0);

         mn.estimate := LongWord(estList[0]);

       finally

         estList.Free;

-      end;  

+      end;

+

     end;

-    Seek(fMov, FileSize(fMov));

-    write(fMov, mn);

+    fMov.SeekEnd;

+    fMov.Write(mn);

   end;

 

 var

@@ -195,34 +288,38 @@ var
   enc_mv: word;

   estList: TList;

 begin

+  if (not FCheckDBVersion) then

+    exit;

+

   addInf := EncodeAddInf(posMove.pos);

-  if FileSize(fPos) = 0 then

-    begin

-      AddPosNodes(1);

-      exit;

-    end;

+  if (fPos.Size = 0) then

+  begin

+    AddPosNodes(1);

+    exit;

+  end;

   r := 0;

   for k := 1 to 66 do // 65 - доп. инф, 66 - цвет.

+  begin

+    fPos.SeekRec(r);

+    fPos.Read(fn);

+

+    while ((k <= 64) and (fn.btField <> ord(posMove.pos.board[FIELD_SEQ[k].i, FIELD_SEQ[k].j]))) or

+          ((k = 65) and (fn.btField <> addInf)) or

+          ((k = 66) and (fn.btField <> ord(posMove.pos.color))) do

     begin

-      Seek(fPos, r);

-      read(fPos, fn);

-      while ((k <= 64) and (fn.bField <> ord(posMove.pos.board[FIELD_SEQ[k].i, FIELD_SEQ[k].j]))) or

-            ((k = 65) and (fn.bField <> addInf)) or

-            ((k = 66) and (fn.bField <> ord(posMove.pos.color))) do

-        begin

-          pr := r;

-          r := (fn.wNextValue shl 8) or fn.bNextValue;

-          if r = 0 then

-            begin

-              AddPosNodes(k, pr);

-              exit;

-            end;

-          Seek(fPos, r);

-          read(fPos, fn);

-        end; { while }

-      // значение в цепочке найдено

-      r := (fn.wNextNode shl 8) or fn.bNextNode;

-    end;

+      pr := r;

+      r := fn.NextValue;

+      if (r = 0) then

+      begin

+        AddPosNodes(k, pr);

+        exit;

+      end;

+      fPos.SeekRec(r);

+      fPos.Read(fn);

+    end; { while }

+    // значение в цепочке найдено

+    r := fn.NextNode;

+  end;

 

   moveCount := 0;

   moveSet := -1;

@@ -232,62 +329,72 @@ begin
     enc_mv := EncodeMove(posMove.move);

     repeat

       pr := r;

-      Seek(fMov, r);

-      read(fMov, mn);

+      fMov.SeekRec(r);

+      fMov.Read(mn);

 

       mv := mn.wMove;

       if mv = enc_mv then

         moveSet := moveCount;

 

-      if Assigned(Reestimate) then

+      if Assigned(FReestimate) then

         estList.Add(Pointer(mn.estimate));

 

       inc(moveCount);

-      r := (mn.wNextValue shl 8) or mn.bNextValue;

+      r := mn.NextValue;

     until r = 0;

 

     if moveSet < 0 then // хода нет в списке, добавляем

       begin

         // связывание нового узла с текущим узлом

-        r := FileSize(fMov);

-        mn.bNextValue := r and $FF;

-        mn.wNextValue := r shr 8;

-        Seek(fMov, pr);

-        write(fMov, mn);

+        r := fMov.Size;

+        mn.NextValue := r;

+        fMov.SeekRec(pr);

+        fMov.Write(mn);

+

         // Добавление нового узла ходов

-        mn := EMPTY_MOVE_NODE;

+        mn.EmptyNode;

         mn.wMove := enc_mv;

-        Seek(fMov, r);

-        write(fMov, mn);

+        fMov.SeekRec(r);

+        fMov.Write(mn);

 

-        if Assigned(Reestimate) then

+        if Assigned(FReestimate) then

           estList.Add(Pointer(mn.estimate));

         moveSet := moveCount;

       end;

 

-      if Assigned(Reestimate) then

+      if Assigned(FReestimate) then

+      begin

+        FReestimate(estList, moveSet);

+        for k := 0 to estList.Count - 1 do

         begin

-          Reestimate(estList, moveSet);

-          for k := 0 to estList.Count - 1 do

-            begin

-              Seek(fMov, rm);

-              read(fMov, mn);

-              if mn.estimate <> LongWord(estList[k]) then

-                begin

-                  mn.estimate := LongWord(estList[k]);

-                  Seek(fMov, rm);

-                  write(fMov, mn);

-                end;

-              rm := (mn.wNextValue shl 8) or mn.bNextValue;

-            end;

+          fMov.SeekRec(rm);

+          fMov.Read(mn);

+          if (mn.estimate <> LongWord(estList[k])) then

+          begin

+            mn.estimate := LongWord(estList[k]);

+            fMov.SeekRec(rm);

+            fMov.Write(mn);

+          end;

+          rm := mn.NextValue;

         end;

+      end;

+      

   finally

     estList.Free;

   end;  

 end;

 

 

-function TPosBase.Find(const pos: TChessPosition; moveEsts: TList = nil): boolean;

+function TPosBase.Find(const pos: TChessPosition): boolean;

+var

+  lstDummy: TList;

+begin

+  lstDummy := nil;

+  Result := Find(pos, lstDummy);

+end;

+

+

+function TPosBase.Find(const pos: TChessPosition; var moveEsts: TList): boolean;

 

   function DecodeMove(enc_move: word): TMoveAbs;

   begin

@@ -312,49 +419,185 @@ var
   pme: PMoveEst;

 label

   here;

-begin

+begin // TPosBase.Find

   Result := FALSE;

-  for k := 0 to moveEsts.Count - 1 do

-    dispose(moveEsts[k]);

-  moveEsts.Clear;

-  if FileSize(fPos) = 0 then

+

+  if (not FCheckDBVersion) then

+    exit;

+

+  if (Assigned(moveEsts)) then

+  begin

+    for k := 0 to moveEsts.Count - 1 do

+      Dispose(moveEsts[k]);

+    moveEsts.Clear;

+  end;

+

+  if (fPos.Size = 0) then

     exit;

 

   r := 0;

   for k := 1 to 66 do // 65 - доп. инф, 66 - цвет.

-    begin

+  begin

 here:

-      Seek(fPos, r);

-      read(fPos, fn);

-      r := (fn.wNextNode shl 8) or fn.bNextNode;

-      while ((k <= 64) and (fn.bField <> ord(pos.board[FIELD_SEQ[k].i, FIELD_SEQ[k].j]))) or

-            ((k = 65) and (fn.bField <> EncodeAddInf(pos))) or

-            ((k = 66) and (fn.bField <> ord(pos.color))) do

-        begin

-          r := (fn.wNextValue shl 8) or fn.bNextValue;

-          if r = 0 then

-            exit

-          else

-            goto here;

-        end; { while }

-    end; { for }

+    fPos.SeekRec(r);

+    fPos.Read(fn);

+

+    r := fn.NextNode;

+    while ((k <= 64) and (fn.btField <> ord(pos.board[FIELD_SEQ[k].i, FIELD_SEQ[k].j]))) or

+          ((k = 65) and (fn.btField <> EncodeAddInf(pos))) or

+          ((k = 66) and (fn.btField <> ord(pos.color))) do

+    begin

+      r := fn.NextValue;

+      if r = 0 then

+        exit

+      else

+        goto here;

+    end; { while }

+  end; { for }

 

   Result := TRUE;

-  if not Assigned(moveEsts) then

+  if (not Assigned(moveEsts)) then

     exit;

 

-  // Заполнение списка ходов

+  // Filling the moves list

   repeat

-    Seek(fMov, r);

-    read(fMov, mn);

+    fMov.SeekRec(r);

+    fMov.Read(mn);

 

     new(pme);

     pme^.move := DecodeMove(mn.wMove);

     pme^.estimate := mn.estimate;

     moveEsts.Add(pme);

 

-    r := (mn.wNextValue shl 8) or mn.bNextValue;

-  until r = 0;

+    r := mn.NextValue;

+  until (r = 0);

+  

+end;

+

+////////////////////////////////////////////////////////////////////////////////

+// TFieldNode

+

+function TFieldNode.FGetNextNode: LongWord;

+begin

+  Result := (m_wNextNode shl 8) or m_btNextNode;

+end;

+

+

+procedure TFieldNode.FSetNextNode(lwValue: LongWord);

+begin

+  m_btNextNode := lwValue and $FF;

+  m_wNextNode := lwValue shr 8;

+end;

+

+

+function TFieldNode.FGetNextValue: LongWord;

+begin

+  Result := (m_wNextValue shl 8) or m_btNextValue;

+end;

+

+

+procedure TFieldNode.FSetNextValue(lwValue: LongWord);

+begin

+  m_btNextValue := lwValue and $FF;

+  m_wNextValue := lwValue shr 8;

+end;

+

+////////////////////////////////////////////////////////////////////////////////

+// TMoveNode

+

+

+function TMoveNode.FGetNextValuePos: LongWord;

+begin

+  Result := (m_wNextValue shl 8) or m_btNextValue;

+end;

+

+

+procedure TMoveNode.FSetNextValuePos(lwValue: LongWord);

+begin

+  m_btNextValue := lwValue and $FF;

+  m_wNextValue := lwValue shr 8;

+end;

+

+

+procedure TMoveNode.EmptyNode;

+begin

+  FillChar(self, SizeOf(self), 0);

+end;

+

+////////////////////////////////////////////////////////////////////////////////

+// TPosBaseStream

+

+constructor TPosBaseStream.Create(const strFileName: string; RecordSize: integer);

+var

+  FileHandle: Integer;

+begin

+  inherited Create;

+

+  m_iRecordSize := RecordSize;

+

+  if (not FileExists(strFileName)) then

+  begin

+    FileHandle := FileCreate(strFileName);

+    FileClose(FileHandle);

+  end;

+

+  m_InnerStream := TFileStream.Create(strFileName, fmOpenReadWrite,

+    fmShareDenyWrite);

+end;

+

+

+destructor TPosBaseStream.Destroy;

+begin

+  m_InnerStream.Free;

+  inherited;

+end;

+

+

+function TPosBaseStream.FGetSize: integer;

+begin

+  Result := (m_InnerStream.Size - m_iHeaderSize) div m_iRecordSize;

+end;

+

+

+procedure TPosBaseStream.SeekHeader;

+begin

+  m_InnerStream.Seek(0, soFromBeginning);

+end;

+

+

+procedure TPosBaseStream.SeekRec(lwRecordNumber: LongWord);

+begin

+  m_InnerStream.Seek(m_iHeaderSize + lwRecordNumber * m_iRecordSize, soFromBeginning);

+end;

+

+

+procedure TPosBaseStream.SeekEnd;

+begin

+  m_InnerStream.Seek(0, soFromEnd);

+end;

+

+

+procedure TPosBaseStream.Write(const Buffer);

+begin

+  m_InnerStream.WriteBuffer(Buffer, m_iRecordSize);

+end;

+

+

+procedure TPosBaseStream.Write(const Buffer; Count: integer);

+begin

+  m_InnerStream.WriteBuffer(Buffer, Count);

+end;

+

+

+procedure TPosBaseStream.Read(var Buffer);

+begin

+  m_InnerStream.ReadBuffer(Buffer, m_iRecordSize);

+end;

+

+

+procedure TPosBaseStream.Read(var Buffer; Count: integer);

+begin

+  m_InnerStream.ReadBuffer(Buffer, Count);

 end;

 

 end.