From 194923c172167eb3fc33807ec8009b255f86337e Mon Sep 17 00:00:00 2001 From: Vadim Dashevskiy Date: Mon, 8 Oct 2012 09:10:06 +0000 Subject: Plugin is not adapted until someone can compile it and tell others how to do the same git-svn-id: http://svn.miranda-ng.org/main/trunk@1809 1316c22d-e87f-b044-9b9b-93d7a3e3ba9c --- plugins/!NotAdopted/Chess4Net/PosBaseUnit.pas | 603 ++++++++++++++++++++++++++ 1 file changed, 603 insertions(+) create mode 100644 plugins/!NotAdopted/Chess4Net/PosBaseUnit.pas (limited to 'plugins/!NotAdopted/Chess4Net/PosBaseUnit.pas') diff --git a/plugins/!NotAdopted/Chess4Net/PosBaseUnit.pas b/plugins/!NotAdopted/Chess4Net/PosBaseUnit.pas new file mode 100644 index 0000000000..60f6cba6c4 --- /dev/null +++ b/plugins/!NotAdopted/Chess4Net/PosBaseUnit.pas @@ -0,0 +1,603 @@ +//////////////////////////////////////////////////////////////////////////////// +// 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 + Classes, + // + ChessRulesEngine; + +type + PMoveEst = ^TMoveEst; + TMoveEst = record + move: TMoveAbs; + estimate: LongWord; + end; + + TReestimate = procedure(moveEsts: TList; nRec: integer); + + 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; + + TPosBase = class + private + 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): boolean; overload; + function Find(const pos: TChessPosition; var moveEsts: TList): boolean; overload; + constructor Create(fileNameNoExt: string; Reestimate: TReestimate = nil); + destructor Destroy; override; + end; + +implementation + +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; + end; + +const + POS_FILE_EXT = 'pos'; + MOV_FILE_EXT = 'mov'; + + 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), + (i: 1; j: 5), (i: 1; j: 6), (i: 1; j: 7), (i: 1; j: 8), + (i: 8; j: 8), (i: 8; j: 7), (i: 8; j: 6), (i: 8; j: 5), + (i: 8; j: 4), (i: 8; j: 3), (i: 8; j: 2), (i: 8; j: 1), + (i: 2; j: 1), (i: 2; j: 2), (i: 2; j: 3), (i: 2; j: 4), + (i: 2; j: 5), (i: 2; j: 6), (i: 2; j: 7), (i: 2; j: 8), + (i: 7; j: 8), (i: 7; j: 7), (i: 7; j: 6), (i: 7; j: 5), + (i: 7; j: 4), (i: 7; j: 3), (i: 7; j: 2), (i: 7; j: 1), + (i: 3; j: 1), (i: 3; j: 2), (i: 3; j: 3), (i: 3; j: 4), + (i: 3; j: 5), (i: 3; j: 6), (i: 3; j: 7), (i: 3; j: 8), + (i: 6; j: 8), (i: 6; j: 7), (i: 6; j: 6), (i: 6; j: 5), + (i: 6; j: 4), (i: 6; j: 3), (i: 6; j: 2), (i: 6; j: 1), + (i: 4; j: 1), (i: 4; j: 2), (i: 4; j: 3), (i: 4; j: 4), + (i: 4; j: 5), (i: 4; j: 6), (i: 4; j: 7), (i: 4; j: 8), + (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 + inherited Create; + + self.FReestimate := Reestimate; + + FCreateStreams(fileNameNoExt + '.' + POS_FILE_EXT, + fileNameNoExt + '.' + MOV_FILE_EXT); + FSetDBVersion; +end; + + +destructor TPosBase.Destroy; +begin + 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; + + +function EncodeAddInf(const pos: TChessPosition): byte; +begin + Result := pos.en_passant; + if WhiteKingSide in pos.castling then + Result := Result or $80; + if WhiteQueenSide in pos.castling then + Result := Result or $40; + if BlackKingSide in pos.castling then + Result := Result or $20; + if BlackQueenSide in pos.castling then + Result := Result or $10; +end; + + +function EncodeMove(const move: TMoveAbs): word; +begin + with move do + Result := ((((((((i0-1) shl 3) or (j0-1)) shl 3) or (i-1)) shl 3) or (j-1)) shl 3) or Ord(prom_fig); +end; + + +procedure TPosBase.Add(const posMove: TPosMove); +var + addInf: byte; + fn: TFieldNode; + + procedure AddPosNodes(k: integer; r: integer = -1); + var + l, nr: integer; + mn: TMoveNode; + estList: TList; + begin + // Добавление узлов позиции + if r >= 0 then + 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 + 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.EmptyNode; + mn.wMove := EncodeMove(posMove.move); + + if Assigned(FReestimate) then + begin + estList := TList.Create; + try + estList.Add(Pointer(mn.estimate)); + FReestimate(estList, 0); + mn.estimate := LongWord(estList[0]); + finally + estList.Free; + end; + + end; + fMov.SeekEnd; + fMov.Write(mn); + end; + +var + k, r, pr, rm, moveSet, moveCount: integer; + mv: word; + mn: TMoveNode; + enc_mv: word; + estList: TList; +begin + if (not FCheckDBVersion) then + exit; + + addInf := EncodeAddInf(posMove.pos); + 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 + 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; + estList := TList.Create; + try + rm := r; + enc_mv := EncodeMove(posMove.move); + repeat + pr := r; + fMov.SeekRec(r); + fMov.Read(mn); + + mv := mn.wMove; + if mv = enc_mv then + moveSet := moveCount; + + if Assigned(FReestimate) then + estList.Add(Pointer(mn.estimate)); + + inc(moveCount); + r := mn.NextValue; + until r = 0; + + if moveSet < 0 then // хода нет в списке, добавляем + begin + // связывание нового узла с текущим узлом + r := fMov.Size; + mn.NextValue := r; + fMov.SeekRec(pr); + fMov.Write(mn); + + // Добавление нового узла ходов + mn.EmptyNode; + mn.wMove := enc_mv; + fMov.SeekRec(r); + fMov.Write(mn); + + if Assigned(FReestimate) then + estList.Add(Pointer(mn.estimate)); + moveSet := moveCount; + end; + + if Assigned(FReestimate) then + begin + FReestimate(estList, moveSet); + for k := 0 to estList.Count - 1 do + begin + 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): 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 + with Result do + begin + prom_fig := TFigureName(enc_move and $07); + enc_move := enc_move shr 3; + j := (enc_move and $07) + 1; + enc_move := enc_move shr 3; + i := (enc_move and $07) + 1; + enc_move := enc_move shr 3; + j0 := (enc_move and $07) + 1; + enc_move := enc_move shr 3; + i0 := (enc_move and $07) + 1; + end; + end; + +var + k, r: integer; + fn: TFieldNode; + mn: TMoveNode; + pme: PMoveEst; +label + here; +begin // TPosBase.Find + Result := FALSE; + + 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 +here: + 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 + exit; + + // Filling the moves list + repeat + fMov.SeekRec(r); + fMov.Read(mn); + + new(pme); + pme^.move := DecodeMove(mn.wMove); + pme^.estimate := mn.estimate; + moveEsts.Add(pme); + + 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. -- cgit v1.2.3