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/Chess4Net/PosBaseUnit.pas | 603 -------------------------------------- 1 file changed, 603 deletions(-) delete mode 100644 plugins/Chess4Net/PosBaseUnit.pas (limited to 'plugins/Chess4Net/PosBaseUnit.pas') diff --git a/plugins/Chess4Net/PosBaseUnit.pas b/plugins/Chess4Net/PosBaseUnit.pas deleted file mode 100644 index 60f6cba6c4..0000000000 --- a/plugins/Chess4Net/PosBaseUnit.pas +++ /dev/null @@ -1,603 +0,0 @@ -//////////////////////////////////////////////////////////////////////////////// -// 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