From 690f5e6d29d1c85c4be72638eb22843964c2f512 Mon Sep 17 00:00:00 2001 From: Alexander Lantsev Date: Fri, 24 Apr 2015 08:21:28 +0000 Subject: All non-working stuff moved from trunk git-svn-id: http://svn.miranda-ng.org/main/trunk@13071 1316c22d-e87f-b044-9b9b-93d7a3e3ba9c --- plugins/!NotAdopted/Chess4Net/ManagerUnit.pas | 2460 ------------------------- 1 file changed, 2460 deletions(-) delete mode 100644 plugins/!NotAdopted/Chess4Net/ManagerUnit.pas (limited to 'plugins/!NotAdopted/Chess4Net/ManagerUnit.pas') diff --git a/plugins/!NotAdopted/Chess4Net/ManagerUnit.pas b/plugins/!NotAdopted/Chess4Net/ManagerUnit.pas deleted file mode 100644 index a20cb4c1bc..0000000000 --- a/plugins/!NotAdopted/Chess4Net/ManagerUnit.pas +++ /dev/null @@ -1,2460 +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 ManagerUnit; - -{$DEFINE GAME_LOG} - -interface - -uses - Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, - Menus, TntMenus, ActnList, TntActnList, ExtCtrls, -{$IFDEF TRILLIAN} - plugin, -{$ENDIF} - // Chess4Net Units - ChessBoardHeaderUnit, ChessRulesEngine, ChessBoardUnit, - GameChessBoardUnit, ConnectorUnit, ConnectingUnit, GameOptionsUnit, - ModalForm, DialogUnit, ContinueUnit, LocalizerUnit, URLVersionQueryUnit; - -type - TManager = class(TForm, ILocalizable) - ActionList: TTntActionList; - LookFeelOptionsAction: TTntAction; - AboutAction: TTntAction; - - ConnectedPopupMenu: TTntPopupMenu; - LookFeelOptionsConnected: TTntMenuItem; - StartStandartGameConnected: TTntMenuItem; - StartPPRandomGameConnected: TTntMenuItem; - GameOptionsConnected: TTntMenuItem; - ChangeColorConnected: TTntMenuItem; - GamePopupMenu: TTntPopupMenu; - AbortGame: TTntMenuItem; - DrawGame: TTntMenuItem; - ResignGame: TTntMenuItem; - N4: TTntMenuItem; - LookFeelOptionsGame: TTntMenuItem; - TakebackGame: TTntMenuItem; - GamePause: TTntMenuItem; - N1: TTntMenuItem; - AboutConnected: TTntMenuItem; - N2: TTntMenuItem; - AboutGame: TTntMenuItem; - StartAdjournedGameConnected: TTntMenuItem; - AdjournGame: TTntMenuItem; - N5: TTntMenuItem; - N6: TTntMenuItem; - - BroadcastAction: TTntAction; - N3: TTntMenuItem; - BroadcastConnected: TTntMenuItem; - N7: TTntMenuItem; - Broadcast: TTntMenuItem; - - ConnectorTimer: TTimer; - - procedure FormCreate(Sender: TObject); - procedure FormDestroy(Sender: TObject); - procedure ActionListUpdate(Action: TBasicAction; - var Handled: Boolean); - procedure LookFeelOptionsActionExecute(Sender: TObject); - procedure AbortGameClick(Sender: TObject); - procedure DrawGameClick(Sender: TObject); - procedure ResignGameClick(Sender: TObject); - procedure ChangeColorConnectedClick(Sender: TObject); - procedure GameOptionsConnectedClick(Sender: TObject); - procedure StartStandartGameConnectedClick(Sender: TObject); - procedure FormClose(Sender: TObject; var Action: TCloseAction); - procedure ConnectorTimerTimer(Sender: TObject); - procedure StartPPRandomGameConnectedClick(Sender: TObject); - procedure TakebackGameClick(Sender: TObject); - procedure GamePauseClick(Sender: TObject); - procedure AboutActionExecute(Sender: TObject); - procedure StartAdjournedGameConnectedClick(Sender: TObject); - procedure AdjournGameClick(Sender: TObject); - procedure GamePopupMenuPopup(Sender: TObject); - procedure BroadcastActionExecute(Sender: TObject); - - private - m_ConnectingForm: TConnectingForm; - m_ContinueForm: TContinueForm; - m_Connector: TConnector; - m_ChessBoard: TGameChessBoard; - m_Dialogs: TDialogs; - - m_ExtBaseList: TStringList; - m_strExtBaseName: string; -{$IFDEF QIP} - iProtoDllHandle: integer; - wAccName: WideString; - QIPConnectionError: boolean; -{$ENDIF} -{$IFDEF TRILLIAN} - contactlistEntry: TTtkContactListEntry; -{$ENDIF} -{$IFDEF SKYPE} - m_bDontShowCredits: boolean; -{$ENDIF} - m_lwOpponentClientVersion: LongWord; - // It's for ChessBoard - you_unlimited, opponent_unlimited: boolean; - you_time, opponent_time, - you_inc, opponent_inc: word; - you_takebacks, opponent_takebacks: boolean; - can_pause_game, can_adjourn_game, move_done: boolean; - - m_strPlayerNick: string; - m_strPlayerNickId: string; - - m_strOpponentNick: string; - m_strOpponentId: string; - m_strOverridedOpponentNickId: string; - - extra_exit: boolean; - m_bConnectionOccured: boolean; - - m_bTransmittable: boolean; - - m_iDontShowLastVersion: integer; - m_iQueriedDontShowLastVersion: integer; - -{$IFDEF GAME_LOG} - // for game log - gameLog: string; - procedure FInitGameLog; - procedure FWriteToGameLog(const s: string); - procedure FlushGameLog; -{$ENDIF} - procedure ChessBoardHandler(e: TGameChessBoardEvent; - d1: pointer = nil; d2: pointer = nil); - procedure SetClock; overload; - procedure SetClock(var sr: string); overload; - - procedure FPopulateExtBaseList; - - function FReadCommonSettings(setToOpponent: boolean): boolean; - procedure FWritePrivateSettings; - procedure FWriteCommonSettings; - - function ClockToStr: string; - procedure ChangeColor; - procedure PauseGame; - procedure ContinueGame; - procedure FAdjournGame; - procedure FExitGameMode; - - procedure FBuildAdjournedStr; - procedure FStartAdjournedGame; - - function FGetAdjournedStr: string; - procedure FSetAdjournedStr(const strValue: string); - - function FGetPlayerColor: TFigureColor; - procedure FSetPlayerColor(Value: TFigureColor); - - function FGetOpponentNickId: string; -{$IFDEF SKYPE} - procedure FShowCredits; -{$ENDIF} - - procedure FSetTransmittable(bValue: boolean); - - procedure FOnURLQueryReady(Sender: TURLVersionQuery); - - property AdjournedStr: string read FGetAdjournedStr write FSetAdjournedStr; - property _PlayerColor: TFigureColor read FGetPlayerColor write FSetPlayerColor; - - protected - constructor RCreate; - - procedure ROnCreate; virtual; abstract; - procedure ROnDestroy; virtual; - - procedure ConnectorHandler(e: TConnectorEvent; - d1: pointer = nil; d2: pointer = nil); virtual; - procedure RCreateChessBoardAndDialogs; - procedure RCreateAndPopulateExtBaseList; - procedure RSetChessBoardToView; - - procedure RReadPrivateSettings; - procedure RShowConnectingForm; - - procedure ILocalizable.Localize = RLocalize; - procedure RLocalize; - - class procedure RSplitStr(s: string; var strLeft: string; var strRight: string); - procedure RHandleConnectorDataCommand(sl: string); virtual; - procedure RSetOpponentClientVersion(lwVersion: LongWord); virtual; - - procedure RSendData(const cmd: string = ''); virtual; abstract; - - procedure RSetConnectionOccured; virtual; - function RGetGameName: string; virtual; - - function RGetGameContextStr: string; - procedure RSetGameContext(const strValue: string); - - procedure RReleaseWithConnectorGracefully; - - procedure RRetransmit(const strCmd: string); virtual; - procedure RBroadcast; virtual; - - procedure RUpdateChessBoardCaption; - - procedure DialogFormHandler(modSender: TModalForm; msgDlgID: TModalFormID); virtual; - - property Connector: TConnector read m_Connector write m_Connector; - property ChessBoard: TGameChessBoard read m_ChessBoard write m_ChessBoard; - - property PlayerNick: string read m_strPlayerNick write m_strPlayerNick; - property PlayerNickId: string read m_strPlayerNickId write m_strPlayerNickId; - property OpponentNick: string read m_strOpponentNick write m_strOpponentNick; - property OpponentId: string read m_strOpponentId write m_strOpponentId; - property OpponentNickId: string read FGetOpponentNickId write m_strOverridedOpponentNickId; - - property Transmittable: boolean read m_bTransmittable write FSetTransmittable; - - property pDialogs: TDialogs read m_Dialogs; - - public -{$IFDEF AND_RQ} - class function Create: TManager; reintroduce; -{$ENDIF} -{$IFDEF QIP} - class function Create(const accName: WideString; const protoDllHandle: integer): TManager; reintroduce; -{$ENDIF} -{$IFDEF TRILLIAN} - class function Create(const vContactlistEntry: TTtkContactListEntry): TManager; reintroduce; -{$ENDIF} - end; - -const - CMD_DELIMITER = '&&'; // CMD_DELIMITER has to be present in arguments - - CMD_VERSION = 'ver'; - CMD_WELCOME = 'wlcm'; // Accept of connection - CMD_GOODBYE = 'gdb'; // Refusion of connection - CMD_TRANSMITTING = 'trnsm'; - CMD_NICK_ID = 'nkid'; - CMD_CONTINUE_GAME = 'cont'; - CMD_GAME_CONTEXT = 'gmctxt'; - -implementation - -{$R *.dfm} -{$J+} - -uses - // Chess4Net - DateUtils, Math, StrUtils, Dialogs, - // - LookFeelOptionsUnit, GlobalsUnit, GlobalsLocalUnit, InfoUnit, ChessClockUnit, - DontShowMessageDlgUnit, IniSettingsUnit, PosBaseChessBoardLayerUnit -{$IFDEF AND_RQ} - , CallExec -{$ENDIF} -{$IFDEF QIP} - , ControlUnit -{$ENDIF} -{$IFDEF SKYPE} - , CreditsFormUnit -{$ENDIF} - ; - -const - USR_BASE_NAME = 'Chess4Net'; - - NO_CLOCK_TIME ='u u'; - - HOUR_TIME_FORMAT = 'h:nn:ss'; - - // Command shorthands for Connector - CMD_ECHO = 'echo'; - CMD_START_GAME = 'strt'; - CMD_GAME_OPTIONS = 'gmopt'; // Doesn't exist from 2007.5 - CMD_CHANGE_COLOR = 'chclr'; -// CMD_NICK_ID = 'nkid'; - CMD_RESIGN = 'res'; - CMD_ABORT = 'abrt'; - CMD_ABORT_ACCEPTED = 'abrtacc'; - CMD_ABORT_DECLINED = 'abrtdec'; - CMD_DRAW = 'draw'; - CMD_DRAW_ACCEPTED = 'drawacc'; - CMD_DRAW_DECLINED = 'drawdec'; - CMD_FLAG = 'flg'; - CMD_FLAG_YES = 'flgyes'; - CMD_FLAG_NO = 'flgno'; - CMD_TAKEBACK = 'tkbk'; - CMD_TAKEBACK_YES = 'tkbkyes'; - CMD_TAKEBACK_NO = 'tkbkno'; - CMD_SWITCH_CLOCK = 'swclck'; - CMD_REPEAT_COMMAND = 'rptcmd'; - CMD_POSITION = 'pos'; -// CMD_VERSION = 'ver'; -// CMD_WELCOME = 'wlcm'; // Accept of connection -// CMD_GOODBYE = 'gdb'; // Refusion of connection - // существует с 2007.5 - CMD_NO_SETTINGS = 'noset'; // If global settings are absent then request from partner's client - CMD_ALLOW_TAKEBACKS = 'alwtkb'; - CMD_SET_CLOCK = 'clck'; // Change of timing - CMD_SET_TRAINING = 'trnng'; // Setting training mode - // Существует с 2007.6 - CMD_CAN_PAUSE_GAME = 'canpaus'; - CMD_PAUSE_GAME = 'paus'; - CMD_PAUSE_GAME_YES = 'pausyes'; - CMD_PAUSE_GAME_NO = 'pausno'; -// CMD_CONTINUE_GAME = 'cont'; - // Существует с 2008.1 - CMD_CAN_ADJOURN_GAME = 'canadj'; - CMD_SET_ADJOURNED = 'setadj'; // Setting of adj. position and timing - CMD_ADJOURN_GAME = 'adj'; - CMD_ADJOURN_GAME_YES = 'adjyes'; - CMD_ADJOURN_GAME_NO = 'adjno'; - CMD_START_ADJOURNED_GAME = 'strtadj'; - - // CMD_DELIMITER = '&&'; // CMD_DELIMITER has to be present in arguments - // CMD_CLOSE = 'ext' - IS RESERVED - -type - TManagerDefault = class(TManager) // TODO: TRILLIAN, AND_RQ, QIP-> own classes - protected - procedure ROnCreate; override; - procedure ROnDestroy; override; - procedure RSendData(const cmd: string = ''); override; - public -{$IFDEF AND_RQ} - constructor Create; reintroduce; -{$ENDIF} -{$IFDEF QIP} - constructor Create(const accName: WideString; const protoDllHandle: integer); reintroduce; -{$ENDIF} -{$IFDEF TRILLIAN} - constructor Create(const vContactlistEntry: TTtkContactListEntry); reintroduce; -{$ENDIF} - end; - -//////////////////////////////////////////////////////////////////////////////// -// TManager - -procedure TManager.RCreateChessBoardAndDialogs; -begin -// m_ChessBoard := TGameChessBoard.Create(self, ChessBoardHandler, Chess4NetPath + USR_BASE_NAME); - m_ChessBoard := TGameChessBoard.Create(nil, ChessBoardHandler, Chess4NetGamesLogPath + USR_BASE_NAME); - m_Dialogs := TDialogs.Create(ChessBoard, DialogFormHandler); -end; - - -procedure TManager.FormCreate(Sender: TObject); -begin -{$IFNDEF SKYPE} - BroadcastAction.Visible := TRUE; -{$ENDIF} - ROnCreate; -end; - - -procedure TManager.RShowConnectingForm; -begin - m_ConnectingForm := (m_Dialogs.CreateDialog(TConnectingForm) as TConnectingForm); - m_ConnectingForm.Show; -end; - - -procedure TManager.ChessBoardHandler(e: TGameChessBoardEvent; - d1: pointer = nil; d2: pointer = nil); -var - s: string; - wstrMsg1, wstrMsg2: WideString; - strSwitchClockCmd: string; -begin - case e of - cbeKeyPressed: - if extra_exit and (Word(d1) = VK_ESCAPE) then - begin -{$IFDEF GAME_LOG} - if (ChessBoard.Mode = mGame) then - begin - FWriteToGameLog('*'); - FlushGameLog; - end; -{$ENDIF} - Release; - end; - - cbeExit: - Close; - - cbeMenu: - if (not m_Dialogs.Showing) then - begin - if ((ChessBoard.Mode = mView) or Transmittable) then - begin - if (Connector.connected) then - ConnectedPopupMenu.Popup(Mouse.CursorPos.X, Mouse.CursorPos.Y); - end - else if (ChessBoard.Mode = mGame) then - begin - GamePopupMenu.Popup(Mouse.CursorPos.X, Mouse.CursorPos.Y); - end; - end; - - cbeMoved: - begin - if (not Transmittable) then - begin - RSendData(PString(d1)^); - RRetransmit(PString(d1)^); - end; -{$IFDEF GAME_LOG} - if (ChessBoard.PositionColor = fcBlack) or (not move_done) then - begin - FWriteToGameLog(' ' + IntToStr(ChessBoard.NMoveDone) + '.'); - if (ChessBoard.PositionColor = fcWhite) then - FWriteToGameLog(' ...'); - end; - FWriteToGameLog(' ' + PString(d1)^); -{$ENDIF} - move_done := TRUE; - TakebackGame.Enabled := TRUE; - end; - - cbeMate: - with ChessBoard do - begin - FExitGameMode; -{$IFDEF GAME_LOG} - FWriteToGameLog('#'); - if (PositionColor = fcWhite) then - FWriteToGameLog(sLineBreak + '0 - 1') - else - FWriteToGameLog(sLineBreak + '1 - 0'); - FlushGameLog; -{$ENDIF} - with TLocalizer.Instance do - begin - if (Transmittable) then - begin - if (PositionColor = fcWhite) then - wstrMsg1 := GetMessage(36) // White is checkmated. - else - wstrMsg1 := GetMessage(37); // Black is checkmated. - wstrMsg2 := wstrMsg1; - end - else // not Transmittable - begin - if (PositionColor = fcWhite) then - begin - wstrMsg1 := GetMessage(0); // White is checkmated. You win. - wstrMsg2 := GetMessage(1); // White is checkmated. You loose. - end - else - begin - wstrMsg1 := GetMessage(2); // Black is checkmated. You win. - wstrMsg2 := GetMessage(3); // Black is checkmated. You loose. - end; - end; - end; // with - - if ((_PlayerColor <> fcWhite) and (PositionColor = fcWhite)) or - ((_PlayerColor <> fcBlack) and (PositionColor = fcBlack)) then - begin - m_Dialogs.MessageDlg(wstrMsg1, mtCustom, [mbOK], mfNone); - ChessBoard.WriteGameToBase(grWin); - end - else - begin - m_Dialogs.MessageDlg(wstrMsg2, mtCustom, [mbOK], mfNone); - ChessBoard.WriteGameToBase(grLost); - end; - end; - - cbeStaleMate: - begin - FExitGameMode; -{$IFDEF GAME_LOG} - FWriteToGameLog('=' + sLineBreak + '1/2 - 1/2'); - FlushGameLog; -{$ENDIF} - if (Transmittable) then - wstrMsg1 := TLocalizer.Instance.GetMessage(35) // Stalemate. - else - wstrMsg1 := TLocalizer.Instance.GetMessage(4); // It's stalemate. No one wins. - m_Dialogs.MessageDlg(wstrMsg1, mtCustom, [mbOK], mfNone); - ChessBoard.WriteGameToBase(grDraw); - end; - - cbeClockSwitched: - begin - if (Transmittable) then - exit; - with ChessBoard do - begin - if (move_done and (ClockColor = PositionColor)) then - begin - if (ClockColor <> _PlayerColor) then - begin - Time[_PlayerColor] := IncSecond(Time[_PlayerColor], you_inc); - s := TChessClock.ConvertToFullStr(Time[_PlayerColor]); - - if ((not Unlimited[_PlayerColor]) or (m_lwOpponentClientVersion < 200706)) then - begin - strSwitchClockCmd := CMD_SWITCH_CLOCK + ' ' + s; - RSendData(strSwitchClockCmd); - RRetransmit(strSwitchClockCmd); - end; - end - else - begin - if (_PlayerColor = fcWhite) then - Time[fcBlack] := IncSecond(Time[fcBlack], opponent_inc) - else - Time[fcWhite] := IncSecond(Time[fcWhite], opponent_inc); - end; - end; - end; { with } - end; - - cbeTimeOut: - begin - if (not Transmittable) then - RSendData(CMD_FLAG); - end; - - cbeActivate: - begin - m_Dialogs.BringToFront; - end; - - cbeFormMoving: - begin - m_Dialogs.MoveForms(integer(d1), integer(d2)); - end; - end; -end; - - -class procedure TManager.RSplitStr(s: string; var strLeft: string; var strRight: string); -var - x: integer; -begin - x := pos(' ', s); - strLeft := copy(s, 1, sign(x) * (x - 1) + (1 - sign(x)) * length(s)); - strRight := copy(s, length(strLeft) + 2, length(s)); -end; - - -procedure TManager.SetClock(var sr: string); -var - sl: string; - - - procedure NSetOpponentTime; - begin - RSplitStr(sr, sl, sr); - if (sl = 'u') then - opponent_unlimited := TRUE - else - begin - opponent_unlimited:= FALSE; - opponent_time:= StrToInt(sl); - RSplitStr(sr, sl, sr); - opponent_inc := StrToInt(sl); - end; - end; - - procedure NSetYouTime; - begin - RSplitStr(sr, sl, sr); - if (sl = 'u') then - you_unlimited:= TRUE - else - begin - you_unlimited := FALSE; - you_time := StrToInt(sl); - RSplitStr(sr, sl, sr); - you_inc := StrToInt(sl); - end; - end; - -begin // TManager.SetClock - if (Transmittable) then - begin - NSetYouTime; - NSetOpponentTime; - end - else - begin - NSetOpponentTime; - NSetYouTime; - end; - - SetClock; -end; - - -procedure TManager.ConnectorHandler(e: TConnectorEvent; d1: pointer = nil; d2: pointer = nil); -var - strCmd: string; - strLeft: string; -begin - case e of - ceConnected: - begin - if (Assigned(m_ConnectingForm)) then - m_ConnectingForm.Shut; - RSendData(CMD_VERSION + ' ' + IntToStr(CHESS4NET_VERSION)); - end; - - ceDisconnected: - begin - if (not Connector.connected) then - exit; - - if (Transmittable) then - begin - m_Dialogs.CloseNoneDialogs; - m_Dialogs.MessageDlg(TLocalizer.Instance.GetMessage(34), mtCustom, - [mbOK], mfMsgLeave); // Broadcaster leaves. Transmition will be closed. - end; - - case ChessBoard.Mode of - mView: - begin - m_Dialogs.MessageDlg(TLocalizer.Instance.GetMessage(5), mtCustom, [mbOK], - mfMsgLeave); // 'Your opponent leaves.' - end; - mGame: - begin -{$IFDEF GAME_LOG} - FWriteToGameLog('*'); - FlushGameLog; -{$ENDIF} - m_Dialogs.MessageDlg(TLocalizer.Instance.GetMessage(6), mtWarning, - [mbOK], mfMsgLeave); // Your opponent leaves. The game is aborted. - end; - end; - end; { ceDisconnected } - - ceError: - begin -{$IFDEF GAME_LOG} - if ChessBoard.Mode = mGame then - begin - FWriteToGameLog('*'); - FlushGameLog; - end; -{$ENDIF} - m_Dialogs.MessageDlg(TLocalizer.Instance.GetMessage(7), mtWarning, - [mbOk], mfMsgLeave); // An error during connection occured. - end; -{$IFDEF QIP} - ceQIPError: - begin - QIPConnectionError := TRUE; - // TODO: Localize - m_Dialogs.MessageDlg('Special message channel is not responding.' + sLineBreak + - 'This can happen due to the following reasons:' + sLineBreak + - ' 1) Your partner is using an IM other than QIP Infium. OR' + sLineBreak + - ' 2) Your partner is offline. OR' + sLineBreak + - ' 3) Protocol doesn''t support multiple channels. OR' + sLineBreak + - ' 4) Other reasons.' + sLineBreak + - 'Chess4Net won''t start.', mtWarning, [mbOk], mfMsgLeave); - end; -{$ENDIF} - - ceData: - begin - strCmd := PString(d1)^; - repeat - strLeft := LeftStr(strCmd, pos(CMD_DELIMITER, strCmd) - 1); - strCmd := RightStr(strCmd, length(strCmd) - length(strLeft) - length(CMD_DELIMITER)); - - RHandleConnectorDataCommand(strLeft); - until (strCmd = ''); - - end; { ceData } - - end; { case ChessBoard.Mode } -end; - - -procedure TManager.RSetOpponentClientVersion(lwVersion: LongWord); -begin - m_lwOpponentClientVersion := lwVersion; -end; - - -procedure TManager.RSetConnectionOccured; -begin - m_bConnectionOccured := TRUE; -{$IFNDEF TESTING} - with TURLVersionQuery.Create do - begin - OnQueryReady := FOnURLQueryReady; - {$IFDEF SKYPE} - Query(aidSkype, CHESS4NET_VERSION, osidWindows); - {$ELSE} - Free; // TODO: URL query for other clients - {$ENDIF} - end; -{$ENDIF} -end; - - -procedure TManager.FOnURLQueryReady(Sender: TURLVersionQuery); -begin - if (not Assigned(Sender)) then - exit; - - try - if ((Sender.LastVersion <= m_iDontShowLastVersion)) then - exit; - - if (Sender.Info <> '') then - begin - with TDontShowMessageDlg.Create(m_Dialogs, Sender.Info) do - begin - m_iQueriedDontShowLastVersion := Sender.LastVersion; - Show; - end; - end; - - finally - Sender.Free; - end; - -end; - - -procedure TManager.RUpdateChessBoardCaption; -begin - if (m_bConnectionOccured and Assigned(ChessBoard)) then - ChessBoard.Caption := RGetGameName; -end; - - -procedure TManager.RHandleConnectorDataCommand(sl: string); -var - AMode: TMode; - sr: string; - strSavedCmd: string; - wstrMsg: WideString; -begin - strSavedCmd := sl; - - RSplitStr(sl, sl, sr); - - if (Assigned(ChessBoard)) then - AMode := ChessBoard.Mode - else - AMode := mView; - - case AMode of - mView: - if (sl = CMD_VERSION) then - begin - RSplitStr(sr, sl, sr); - RSetOpponentClientVersion(StrToIntDef(sl, CHESS4NET_VERSION)); - RSendData(CMD_WELCOME); - if (m_lwOpponentClientVersion < CHESS4NET_VERSION) then - begin - m_Dialogs.MessageDlg(TLocalizer.Instance.GetMessage(8), mtWarning, - [mbOK], mfNone); // Your opponent is using an older version of Chess4Net. ... - end; - // 2007.4 is the first client with a backward compatibility - // For incompatible versions: - // else RSendData(CMD_GOODBYE); - end - else if (sl = CMD_WELCOME) then - begin - RSendData(CMD_NICK_ID + ' ' + OpponentNickId); - if (Assigned(ChessBoard)) then - ChessBoard.InitPosition; - SetClock; - RSetConnectionOccured; - end - else if (sl = CMD_GOODBYE) then // For the future versions - begin - m_Dialogs.MessageDlg(TLocalizer.Instance.GetMessage(9) , mtWarning, [mbOK], mfIncompatible); // The current version of Chess4Net is incompatible ... - end - else if (sl = CMD_START_GAME) then - begin - with ChessBoard do - begin - if (Transmittable) then - m_Dialogs.CloseNoneDialogs; - // Starting from 2007.6 only white can start the game - if ((m_lwOpponentClientVersion >= 200706) and (_PlayerColor = fcWhite) and - (not Transmittable)) then - begin - ChangeColor; - end; - SetClock; - ResetMoveList; - move_done:= FALSE; - TakebackGame.Enabled := FALSE; - Mode := mGame; - SwitchClock(PositionColor); -{$IFDEF GAME_LOG} - FInitGameLog; -{$ENDIF} - end; - RRetransmit(strSavedCmd); - end - else if (sl = CMD_START_ADJOURNED_GAME) then - begin - FStartAdjournedGame; - RRetransmit(CMD_GAME_CONTEXT + ' ' + RGetGameContextStr); - RRetransmit(CMD_CONTINUE_GAME); - end - else if (sl = CMD_CONTINUE_GAME) then - begin - if (Transmittable) then - begin - m_Dialogs.CloseNoneDialogs; - ChessBoard.Mode := mGame; - ContinueGame; - end; - end - else if (sl = CMD_ALLOW_TAKEBACKS) then - begin - RSplitStr(sr, sl, sr); - opponent_takebacks := (sl = '1'); - TakebackGame.Visible := (opponent_takebacks or ChessBoard.pTrainingMode); - end - else if (sl = CMD_CAN_PAUSE_GAME) then - begin - RSplitStr(sr, sl, sr); - can_pause_game := (sl = '1'); - GamePause.Visible := can_pause_game; - end - else if (sl = CMD_CAN_ADJOURN_GAME) then - begin - RSplitStr(sr, sl, sr); - can_adjourn_game := (sl = '1'); - end - else if (sl = CMD_SET_CLOCK) then - begin - SetClock(sr); - RRetransmit(CMD_SET_CLOCK + ' ' + ClockToStr); - end - else if (sl = CMD_SET_TRAINING) then - begin - RSplitStr(sr, sl, sr); - ChessBoard.pTrainingMode := (sl = '1'); - TakebackGame.Visible := (opponent_takebacks or ChessBoard.pTrainingMode); - end - else if (sl = CMD_GAME_OPTIONS) then // 2007.4 - begin - SetClock(sr); - RSplitStr(sr, sl, sr); - opponent_takebacks := (sl = '1'); - RSplitStr(sr, sl, sr); - ChessBoard.pTrainingMode := (sl = '1'); - TakebackGame.Visible := (opponent_takebacks or ChessBoard.pTrainingMode); - end - else if (sl = CMD_SET_ADJOURNED) then // 2008.1 - begin - if ((AdjournedStr = '') or (CompareStr(PlayerNickId, OpponentNickId) > 0)) then - begin - if (pos('&w&', sr) > 0) then - sr := StringReplace(sr, '&w&', '&b&', []) // White -> Black - else - sr := StringReplace(sr, '&b&', '&w&', []); // Black -> White - AdjournedStr := sr; - end; - end - else if (sl = CMD_CHANGE_COLOR) then - begin - ChangeColor; - RRetransmit(strSavedCmd); - end - else if (sl = CMD_NICK_ID) then - begin - m_strPlayerNickId := sr; - if (CompareStr(PlayerNickId, OpponentNickId) < 0) then - begin - StartStandartGameConnected.Enabled := TRUE; - StartPPRandomGameConnected.Enabled := TRUE; - _PlayerColor := fcWhite; - if (not FReadCommonSettings(TRUE)) then - RSendData(CMD_NO_SETTINGS); - end - else - begin - StartStandartGameConnected.Enabled := FALSE; - StartPPRandomGameConnected.Enabled := FALSE; - _PlayerColor := fcBlack; - FReadCommonSettings(FALSE); - end; // if CompareStr - - RUpdateChessBoardCaption; - end - else if (sl = CMD_POSITION) then - begin - if (Assigned(ChessBoard)) then - ChessBoard.SetPosition(sr); - RRetransmit(strSavedCmd); - end - else if (sl = CMD_NO_SETTINGS) then - begin - FReadCommonSettings(TRUE); - end - else if (sl = CMD_TRANSMITTING) then - begin - m_Dialogs.MessageDlg(TLocalizer.Instance.GetMessage(33), - mtCustom, [mbOK], mfMsgLeave); // Game transmition is not supported by this client! - end; - - mGame: - if (sl = CMD_DRAW) then - begin - m_Dialogs.MessageDlg(TLocalizer.Instance.GetMessage(10), mtConfirmation, - [mbYes, mbNo], mfMsgDraw) // Draw? - end - else if (sl = CMD_ABORT) then - begin - m_Dialogs.MessageDlg(TLocalizer.Instance.GetMessage(11), mtConfirmation, - [mbYes, mbNo], mfMsgAbort); // Can we abort the game? - end - else if (sl = CMD_RESIGN) then - begin - FExitGameMode; -{$IFDEF GAME_LOG} - if (_PlayerColor = fcWhite) then - FWriteToGameLog(sLineBreak + 'Black resigns' + sLineBreak + '1 - 0') - else - FWriteToGameLog(sLineBreak + 'White resigns' + sLineBreak + '0 - 1'); - FlushGameLog; -{$ENDIF} - if (Transmittable) then - begin - RSplitStr(sr, sl, sr); - if (sl = 'w') then - wstrMsg := TLocalizer.Instance.GetMessage(31) // White resigns. - else // (sl = 'b') - wstrMsg := TLocalizer.Instance.GetMessage(32) // Black resigns. - end - else - wstrMsg := TLocalizer.Instance.GetMessage(12); // I resign. You win this game. Congratulations! - - m_Dialogs.MessageDlg(wstrMsg, mtCustom, [mbOK], mfNone); - ChessBoard.WriteGameToBase(grWin); - - RRetransmit(CMD_RESIGN + IfThen((_PlayerColor = fcWhite), ' b', ' w')); - end - else if (sl = CMD_ABORT_ACCEPTED) then - begin - FExitGameMode; -{$IFDEF GAME_LOG} - FWriteToGameLog('*'); - FlushGameLog; -{$ENDIF} - m_Dialogs.MessageDlg(TLocalizer.Instance.GetMessage(13), mtCustom, - [mbOK], mfNone); // The game is aborted. - RRetransmit(strSavedCmd); - end - else if (sl = CMD_ABORT_DECLINED) then - begin - m_Dialogs.MessageDlg(TLocalizer.Instance.GetMessage(14), - mtCustom, [mbOK], mfNone) // Sorry, but we have to finish this game. - end - else if (sl = CMD_DRAW_ACCEPTED) then - begin - FExitGameMode; -{$IFDEF GAME_LOG} - FWriteToGameLog('=' + sLineBreak + '1/2 - 1/2'); - FlushGameLog; -{$ENDIF} - m_Dialogs.MessageDlg(TLocalizer.Instance.GetMessage(15), mtCustom, [mbOK], mfNone); // The game is drawn. - ChessBoard.WriteGameToBase(grDraw); - - RRetransmit(strSavedCmd); - end - else if (sl = CMD_DRAW_DECLINED) then - begin - m_Dialogs.MessageDlg(TLocalizer.Instance.GetMessage(16), mtCustom, [mbOK], mfNone) // No draw, sorry. - end - else if (sl = CMD_SWITCH_CLOCK) then - begin - with ChessBoard do - begin - RSplitStr(sr, sl, sr); - - if (Transmittable) then - begin - if (PositionColor = fcWhite) then - Time[fcBlack] := TChessClock.ConvertFromFullStr(sl) - else - Time[fcWhite] := TChessClock.ConvertFromFullStr(sl); - end - else - begin - if (_PlayerColor = fcWhite) then - Time[fcBlack] := TChessClock.ConvertFromFullStr(sl) - else - Time[fcWhite] := TChessClock.ConvertFromFullStr(sl); - end; - end; // with - RRetransmit(strSavedCmd); - end - else if (sl = CMD_FLAG) then - with ChessBoard do - begin - if (Time[_PlayerColor] = 0.0) then - begin - RSendData(CMD_FLAG_YES); - RRetransmit(CMD_FLAG_YES); - - FExitGameMode; -{$IFDEF GAME_LOG} - if (_PlayerColor = fcWhite) then - FWriteToGameLog(sLineBreak + 'White forfeits on time') - else - FWriteToGameLog(sLineBreak + 'Black forfeits on time'); - FlushGameLog; -{$ENDIF} - m_Dialogs.MessageDlg(TLocalizer.Instance.GetMessage(17), mtCustom, [mbOK], mfNone); // You forfeited on time. - ChessBoard.WriteGameToBase(grLostTime); - end - else - RSendData(CMD_FLAG_NO); - end // with - else - if (sl = CMD_FLAG_YES) then - begin - FExitGameMode; -{$IFDEF GAME_LOG} - if (_PlayerColor = fcWhite) then - FWriteToGameLog(sLineBreak + 'Black forfeits on time') - else - FWriteToGameLog(sLineBreak + 'White forfeits on time'); - FlushGameLog; -{$ENDIF} - if (Transmittable) then - begin - if (_PlayerColor = fcWhite) then - wstrMsg := TLocalizer.Instance.GetMessage(29) // Black forfeits on time. - else - wstrMsg := TLocalizer.Instance.GetMessage(30); // White forfeits on time. - end - else - wstrMsg := TLocalizer.Instance.GetMessage(18); // Your opponent forfeited on time. - - m_Dialogs.MessageDlg(wstrMsg, mtCustom, [mbOK], mfNone); - ChessBoard.WriteGameToBase(grWinTime); - - RRetransmit(strSavedCmd); - end - else if (sl = CMD_FLAG_NO) then - with ChessBoard do - begin - case _PlayerColor of - fcWhite: - if (Time[fcBlack] = 0.0) then - RSendData(CMD_FLAG); - fcBlack: - if (Time[fcWhite] = 0.0) then - RSendData(CMD_FLAG); - end // case - end // with - else if (sl = CMD_PAUSE_GAME) then - begin - m_Dialogs.MessageDlg(TLocalizer.Instance.GetMessage(19), mtConfirmation, - [mbYes, mbNo], mfCanPause); // Can we pause the game? - end - else if (sl = CMD_PAUSE_GAME_YES) then - begin - PauseGame; - RRetransmit(strSavedCmd); - end - else if (sl = CMD_PAUSE_GAME_NO) then - begin - m_Dialogs.MessageDlg(TLocalizer.Instance.GetMessage(20), mtCustom, - [mbOk], mfNone); // No pause, sorry. - end - else if (sl = CMD_CONTINUE_GAME) then - begin - if (Assigned(m_ContinueForm)) then - m_ContinueForm.Shut; - if (Transmittable) then - m_Dialogs.CloseNoneDialogs; - ContinueGame; - RRetransmit(strSavedCmd); - end - else if (sl = CMD_TAKEBACK) then - begin - if (you_takebacks or ChessBoard.pTrainingMode) then - begin - m_Dialogs.MessageDlg(TLocalizer.Instance.GetMessage(21), - mtConfirmation, [mbYes, mbNo], mfMsgTakeBack); // 'May I take back last move?' - end - else - RSendData(CMD_TAKEBACK_NO) - end - else if (sl = CMD_ADJOURN_GAME) then - begin - m_Dialogs.MessageDlg(TLocalizer.Instance.GetMessage(22), - mtConfirmation, [mbYes, mbNo], mfMsgAdjourn); // Can we adjourn this game? - end - else if (sl = CMD_ADJOURN_GAME_YES) then - begin - FAdjournGame; - RRetransmit(strSavedCmd); - end - else if (sl = CMD_ADJOURN_GAME_NO) then - begin - m_Dialogs.MessageDlg(TLocalizer.Instance.GetMessage(23), mtCustom, [mbOk], - mfNone); // No adjourns, sorry. - end - else - if (sl = CMD_TAKEBACK_YES) then - begin - ChessBoard.TakeBack; - FBuildAdjournedStr; - TakebackGame.Enabled:= (ChessBoard.NMoveDone > 0); -{$IFDEF GAME_LOG} - FWriteToGameLog(' '); -{$ENDIF} - ChessBoard.SwitchClock(ChessBoard.PositionColor); - RRetransmit(strSavedCmd); - end - else if (sl = CMD_TAKEBACK_NO) then - begin - m_Dialogs.MessageDlg(TLocalizer.Instance.GetMessage(24), mtCustom, - [mbOK], mfNone); // Sorry, no takebacks! - end - else if (sl = CMD_POSITION) then - begin - if (CompareStr(PlayerNickId, OpponentNickId) > 0) then - begin - ChessBoard.StopClock; - ChessBoard.Mode := mView; - ChessBoard.SetPosition(sr); - end; - RRetransmit(strSavedCmd); - end - else - begin - with ChessBoard do - begin - if ((_PlayerColor <> PositionColor) or Transmittable) then - begin - if (DoMove(sl)) then - begin -{$IFDEF GAME_LOG} - if ((PositionColor = fcBlack) or (not move_done)) then - begin - FWriteToGameLog(' ' + IntToStr(NMoveDone) + '.'); - if (PositionColor = fcWhite) then - FWriteToGameLog(' ...'); - end; - FWriteToGameLog(' ' + sl); -{$ENDIF} - move_done := TRUE; - TakebackGame.Enabled := TRUE; - FBuildAdjournedStr; // AdjournedStr помечается только при входящем ходе противника - end; // if (DoMove... - end; // if (_Player... - end; // with ChessBoard - - RRetransmit(strSavedCmd); - end; - end; // case ChessBoard.Mode -end; - - -procedure TManager.RRetransmit(const strCmd: string); -begin -end; - - -procedure TManager.ROnDestroy; -begin - TLocalizer.Instance.DeleteSubscriber(self); - - if (m_bConnectionOccured) then - begin - FWritePrivateSettings; - if (not Transmittable) then - FWriteCommonSettings; - end; - - m_ExtBaseList.Free; - - if (Assigned(ChessBoard)) then - begin - ChessBoard.Release; - m_ChessBoard := nil; - end; - m_Dialogs.Free; - - TIniSettings.FreeInstance; -end; - - -procedure TManager.FormDestroy(Sender: TObject); -begin - ROnDestroy; -end; - - -procedure TManager.LookFeelOptionsActionExecute(Sender: TObject); -var - lookFeelOptionsForm: TLookFeelOptionsForm; -begin - lookFeelOptionsForm := (m_Dialogs.CreateDialog(TLookFeelOptionsForm) as TLookFeelOptionsForm); - with lookFeelOptionsForm, ChessBoard do - begin - AnimationComboBox.ItemIndex := ord(animation); - HilightLastMoveBox.Checked := LastMoveHilighted; - FlashIncomingMoveBox.Checked := FlashOnMove; - CoordinatesBox.Checked := CoordinatesShown; - StayOnTopBox.Checked := StayOnTop; - ExtraExitBox.Checked := extra_exit; - end; - lookFeelOptionsForm.Show; -end; - - -procedure TManager.AbortGameClick(Sender: TObject); -begin - RSendData(CMD_ABORT); -end; - -procedure TManager.DrawGameClick(Sender: TObject); -begin - RSendData(CMD_DRAW); -end; - -procedure TManager.ResignGameClick(Sender: TObject); -begin - m_Dialogs.MessageDlg(TLocalizer.Instance.GetMessage(25), - mtConfirmation, [mbYes, mbNo], mfMsgResign); // Do you really want to resign? -end; - - -procedure TManager.ChangeColorConnectedClick(Sender: TObject); -begin - if (Transmittable) then - begin - ChangeColor; - end - else if (ChessBoard.Mode = mView) then - begin - ChangeColor; - - RSendData(CMD_CHANGE_COLOR); - RRetransmit(CMD_CHANGE_COLOR); - end; -end; - - -procedure TManager.GameOptionsConnectedClick(Sender: TObject); -var - GameOptionsForm: TGameOptionsForm; - i: integer; -begin - GameOptionsForm := (m_Dialogs.CreateDialog(TGameOptionsForm) as TGameOptionsForm); - with GameOptionsForm do - begin - EqualTimeCheckBox.Checked := ((you_unlimited = opponent_unlimited) and - (you_time = opponent_time) and (you_inc = opponent_inc)); - YouUnlimitedCheckBox.Checked:= you_unlimited; - OpponentUnlimitedCheckBox.Checked:= opponent_unlimited; - YouMinUpDown.Position := you_time; - YouIncUpDown.Position := you_inc; - OpponentMinUpDown.Position := opponent_time; - OpponentIncUpDown.Position := opponent_inc; - AutoFlagCheckBox.Checked := ChessBoard.AutoFlag; - TakeBackCheckBox.Checked := you_takebacks; - TrainingEnabledCheckBox.Checked := ChessBoard.pTrainingMode; - for i := 1 to m_ExtBaseList.Count - 1 do - begin - ExtBaseComboBox.Items.Append(m_ExtBaseList[i]); - if (m_strExtBaseName = m_ExtBaseList[i]) then - ExtBaseComboBox.ItemIndex := i; - end; - UsrBaseCheckBox.Checked := ChessBoard.pUseUserBase; - GamePauseCheckBox.Checked := (can_pause_game and (m_lwOpponentClientVersion >= 200706)); - GameAdjournCheckBox.Checked := (can_adjourn_game and (m_lwOpponentClientVersion >= 200801)); - Show; - end; // with -end; - - -procedure TManager.StartStandartGameConnectedClick(Sender: TObject); -var - strPositionCmd: string; -begin - with ChessBoard do - begin - SetClock; - InitPosition; - ResetMoveList; - - strPositionCmd := CMD_POSITION + ' ' + GetPosition; - RSendData(strPositionCmd); - RSendData(CMD_START_GAME); - - move_done:= FALSE; - TakebackGame.Enabled := FALSE; - Mode := mGame; - SwitchClock(ChessBoard.PositionColor); - - RRetransmit(strPositionCmd); - RRetransmit(CMD_START_GAME); - end; -{$IFDEF GAME_LOG} - FInitGameLog; -{$ENDIF} -end; - - -procedure TManager.SetClock; -begin - if (not Assigned(ChessBoard)) then - exit; - - with ChessBoard do - begin - Unlimited[_PlayerColor] := you_unlimited; - Time[_PlayerColor] := EncodeTime(you_time div 60, you_time mod 60, 0,0); - if (_PlayerColor = fcWhite) then - begin - Unlimited[fcBlack] := opponent_unlimited; - Time[fcBlack] := EncodeTime(opponent_time div 60, - opponent_time mod 60, 0,0); - end - else - begin - Unlimited[fcWhite] := opponent_unlimited; - Time[fcWhite] := EncodeTime(opponent_time div 60, - opponent_time mod 60, 0,0); - end; - end; -end; - -procedure TManager.RSetChessBoardToView; -var - clockTime: string; -begin - with ChessBoard do - begin - clockTime := NO_CLOCK_TIME; - SetClock(clockTime); - Mode := mView; - Caption := CHESS4NET_TITLE; - ChessBoard.icon := Chess4NetIcon; - InitPosition; - - Left:= (Screen.Width - Width) div 2; - Top:= (Screen.Height - Height) div 2; - Show; - end; -end; - - -procedure TManager.FormClose(Sender: TObject; var Action: TCloseAction); -begin - if (Assigned(Connector) and Connector.connected) then - begin - if (Assigned(m_Dialogs)) then - begin - m_Dialogs.MessageDlg(TLocalizer.Instance.GetMessage(26), mtConfirmation, [mbYes, mbNo], mfMsgClose); // Do you want to exit? - Action:= caNone; - end - else - Release; - end - else -// Release; - Action := caFree; -end; - - -procedure TManager.RReleaseWithConnectorGracefully; -begin - ConnectorTimer.Enabled := TRUE; - if (Assigned(Connector)) then - Connector.Close; -end; - - -procedure TManager.ConnectorTimerTimer(Sender: TObject); -begin - ConnectorTimer.Enabled := FALSE; - Release; -end; - - -procedure TManager.StartPPRandomGameConnectedClick(Sender: TObject); -var - strPositionCmd: string; -begin - with ChessBoard do - begin - SetClock; - PPRandom; - ResetMoveList; - - strPositionCmd := CMD_POSITION + ' ' + GetPosition; - RSendData(strPositionCmd); - RSendData(CMD_START_GAME); - - Mode := mGame; - move_done := FALSE; - TakebackGame.Enabled := FALSE; - SwitchClock(ChessBoard.PositionColor); - - RRetransmit(strPositionCmd); - RRetransmit(CMD_START_GAME); - end; -{$IFDEF GAME_LOG} - FInitGameLog; -{$ENDIF} -end; - - -procedure TManager.TakebackGameClick(Sender: TObject); -begin - RSendData(CMD_TAKEBACK); -end; - - -constructor TManager.RCreate; -begin -// inherited Create(Application); - inherited Create(nil); -end; - - -{$IFDEF AND_RQ} -class function TManager.Create: TManager; -begin - Result := TManagerDefault.Create; -end; -{$ENDIF} - -{$IFDEF QIP} -class function TManager.Create(const accName: WideString; const protoDllHandle: integer): TManager; -begin - Result := TManagerDefault.Create(accName, protoDllHandle); -end; -{$ENDIF} - -{$IFDEF TRILLIAN} -class function TManager.Create(const vContactlistEntry: TTtkContactListEntry): TManager; -begin - Result := TManagerDefault.Create(vContactlistEntry); -end; -{$ENDIF} - -procedure TManager.DialogFormHandler(modSender: TModalForm; msgDlgID: TModalFormID); -var - modRes: TModalResult; - s, prevClock: string; - strCmd: string; -begin - modRes := modSender.ModalResult; - case msgDlgID of - mfNone: ; - - mfMsgClose: - begin - if modRes = mrYes then - begin -{$IFDEF GAME_LOG} - if ChessBoard.Mode = mGame then - begin - FWriteToGameLog('*'); - FlushGameLog; - end; -{$ENDIF} -{$IFDEF SKYPE} - FShowCredits; -{$ENDIF} - Release; - end; - end; - - mfMsgLeave, mfIncompatible: - begin -{$IFDEF SKYPE} - FShowCredits; -{$ENDIF} - if (Assigned(Connector) and Connector.Connected) then - RReleaseWithConnectorGracefully - else - Close; - end; - - mfMsgAbort: - begin - if ChessBoard.Mode = mGame then - begin - if (modRes = mrNo) or (modRes = mrNone) then - RSendData(CMD_ABORT_DECLINED) - else - begin - RSendData(CMD_ABORT_ACCEPTED); - RRetransmit(CMD_ABORT_ACCEPTED); - FExitGameMode; -{$IFDEF GAME_LOG} - FWriteToGameLog('*'); - FlushGameLog; -{$ENDIF} - m_Dialogs.MessageDlg(TLocalizer.Instance.GetMessage(13), mtCustom, - [mbOK], mfNone); // The game is aborted. - end; - end; - end; - - mfMsgResign: - begin - if ChessBoard.Mode = mGame then - begin - if modRes = mrYes then - begin - FExitGameMode; - RSendData(CMD_RESIGN); - RRetransmit(CMD_RESIGN + IfThen((_PlayerColor = fcWhite), ' w', ' b')); - ChessBoard.WriteGameToBase(grLost); -{$IFDEF GAME_LOG} - if (_PlayerColor = fcWhite) then - FWriteToGameLog(sLineBreak + 'White resigns' + sLineBreak + '0 - 1') - else - FWriteToGameLog(sLineBreak + 'Black resigns' + sLineBreak + '1 - 0'); - FlushGameLog; -{$ENDIF} - end; - end; - end; - - mfMsgDraw: - begin - if ChessBoard.Mode = mGame then - begin - if (modRes = mrNo) or (modRes = mrNone) then - RSendData(CMD_DRAW_DECLINED) - else - begin - RSendData(CMD_DRAW_ACCEPTED); - RRetransmit(CMD_DRAW_ACCEPTED); - - FExitGameMode; -{$IFDEF GAME_LOG} - FWriteToGameLog('=' + sLineBreak + '1/2 - 1/2'); - FlushGameLog; -{$ENDIF} - m_Dialogs.MessageDlg(TLocalizer.Instance.GetMessage(15), mtCustom, [mbOK], mfNone); - ChessBoard.WriteGameToBase(grDraw); // The game is drawn. - end; - end; - end; - - mfMsgTakeBack: - begin - if ChessBoard.Mode = mGame then - begin - if modRes = mrYes then - begin - RSendData(CMD_TAKEBACK_YES); - RRetransmit(CMD_TAKEBACK_YES); - - ChessBoard.TakeBack; - FBuildAdjournedStr; - TakebackGame.Enabled:= (ChessBoard.NMoveDone > 0); -{$IFDEF GAME_LOG} - FWriteToGameLog(' '); -{$ENDIF} - ChessBoard.SwitchClock(ChessBoard.PositionColor); - end - else - RSendData(CMD_TAKEBACK_NO); - end; - end; - - mfMsgAdjourn: - begin - if ChessBoard.Mode = mGame then - begin - if modRes = mrYes then - begin - RSendData(CMD_ADJOURN_GAME_YES); - RRetransmit(CMD_ADJOURN_GAME_YES); - FAdjournGame; - end - else - RSendData(CMD_ADJOURN_GAME_NO); - end; - end; - - mfConnecting: - begin - m_ConnectingForm := nil; - if modRes = mrAbort then - Close; // ConnectionAbort; - end; - - mfGameOptions: - begin - if (ChessBoard.Mode <> mGame) and (modRes = mrOK) then - with (modSender as TGameOptionsForm) do - begin - prevClock := ClockToStr; - you_unlimited := YouUnlimitedCheckBox.Checked; - opponent_unlimited := OpponentUnlimitedCheckBox.Checked; - you_time := StrToInt(YouMinEdit.Text); - you_inc := StrToInt(YouIncEdit.Text); - opponent_time := StrToInt(OpponentMinEdit.Text); - opponent_inc := StrToInt(OpponentIncEdit.Text); - ChessBoard.AutoFlag := AutoFlagCheckBox.Checked; - // Отображение на доске - SetClock; - // синхронизация времени у оппонента - s := ClockToStr; - if (m_lwOpponentClientVersion >= 200705) then - begin - if (prevClock <> s) then - begin - strCmd := CMD_SET_CLOCK + ' ' + s; - RSendData(strCmd); - RRetransmit(strCmd); - end; - RSendData(CMD_ALLOW_TAKEBACKS + IfThen(TakeBackCheckBox.Checked, ' 1', ' 0')); - end; - you_takebacks := TakeBackCheckBox.Checked; - if (m_lwOpponentClientVersion >= 200706) then - begin - if can_pause_game <> GamePauseCheckBox.Checked then - begin - can_pause_game := GamePauseCheckBox.Checked; - RSendData(CMD_CAN_PAUSE_GAME + IfThen(can_pause_game, ' 1', ' 0')) - end; - end; - if (m_lwOpponentClientVersion >= 200801) then - begin - if can_adjourn_game <> GameAdjournCheckBox.Checked then - begin - can_adjourn_game := GameAdjournCheckBox.Checked; - RSendData(CMD_CAN_ADJOURN_GAME + IfThen(can_adjourn_game, ' 1', ' 0')) - end; - end; - // Training mode - if (m_lwOpponentClientVersion >= 200705) and (ChessBoard.pTrainingMode <> TrainingEnabledCheckBox.Checked) then - begin - RSendData(CMD_SET_TRAINING + IfThen(TrainingEnabledCheckBox.Checked, ' 1', ' 0')); - end; - ChessBoard.pTrainingMode := TrainingEnabledCheckBox.Checked; - m_strExtBaseName := m_ExtBaseList[ExtBaseComboBox.ItemIndex]; - if (m_strExtBaseName <> '') then - ChessBoard.SetExternalBase(Chess4NetPath + m_strExtBaseName) - else - ChessBoard.UnsetExternalBase; - ChessBoard.pUseUserBase := UsrBaseCheckBox.Checked; - GamePause.Visible := can_pause_game; - TakebackGame.Visible := (ChessBoard.pTrainingMode or opponent_takebacks); - - if (m_lwOpponentClientVersion < 200705) then // 2007.4 - begin - if ChessBoard.pTrainingMode then - s := s + ' 1 1' - else - s := s + IfThen(you_takebacks, ' 1 0', ' 0 0'); - RSendData(CMD_GAME_OPTIONS + ' ' + s); - end; - end; - end; - - mfLookFeel: - begin - with (modSender as TLookFeelOptionsForm), ChessBoard do - begin - animation := TAnimation(AnimationComboBox.ItemIndex); - LastMoveHilighted := HilightLastMoveBox.Checked; - FlashOnMove := FlashIncomingMoveBox.Checked; - CoordinatesShown := CoordinatesBox.Checked; - StayOnTop := StayOnTopBox.Checked; - extra_exit := ExtraExitBox.Checked; - end; - end; - - mfContinue: - begin - m_ContinueForm := nil; - if modRes = mrOk then - begin - RSendData(CMD_CONTINUE_GAME); - RRetransmit(CMD_CONTINUE_GAME); - ContinueGame; - end; - end; - - mfCanPause: - begin - if modRes = mrYes then - begin - RSendData(CMD_PAUSE_GAME_YES); - RRetransmit(CMD_PAUSE_GAME_YES); - PauseGame; - end - else // modRes = mrNo - RSendData(CMD_PAUSE_GAME_NO); - end; - - mfDontShowDlg: - begin - if ((modSender as TDontShowMessageDlg).DontShow) then - m_iDontShowLastVersion := m_iQueriedDontShowLastVersion; - end; - - end; -end; - -{$IFDEF GAME_LOG} -procedure TManager.FInitGameLog; -var - s: string; -begin - if ((not m_bConnectionOccured) or m_bTransmittable) then - exit; - - gameLog := ''; - - LongTimeFormat := HOUR_TIME_FORMAT; - FWriteToGameLog('[' + DateTimeToStr(Now) + ']' + sLineBreak); - - FWriteToGameLog(RGetGameName); - - if not (you_unlimited and opponent_unlimited) then - begin - FWriteToGameLog(' ('); - case _PlayerColor of - fcWhite: - begin - if (not you_unlimited) then - begin - FWriteToGameLog(IntToStr(you_time)); - if (you_inc > 0) then - FWriteToGameLog('.' + IntToStr(you_inc)); - end - else - FWriteToGameLog('inf'); - - FWriteToGameLog(':'); - - if (not opponent_unlimited) then - begin - FWriteToGameLog(IntToStr(opponent_time)); - if (opponent_inc > 0) then - FWriteToGameLog('.' + IntToStr(opponent_inc)); - end - else - FWriteToGameLog('inf'); - end; - - fcBlack: - begin - if (not opponent_unlimited) then - begin - FWriteToGameLog(IntToStr(opponent_time)); - if (opponent_inc > 0) then - FWriteToGameLog('.' + IntToStr(opponent_inc)); - end - else - FWriteToGameLog('inf'); - - FWriteToGameLog(':'); - - if (not you_unlimited) then - begin - FWriteToGameLog(IntToStr(you_time)); - if (you_inc > 0) then - FWriteToGameLog('.' + IntToStr(you_inc)); - end - else - FWriteToGameLog('inf'); - end; - end; - FWriteToGameLog(')'); - end; - FWriteToGameLog(sLineBreak); - - s := ChessBoard.GetPosition; - if (s <> INITIAL_CHESS_POSITION) then - FWriteToGameLog(s + sLineBreak); -end; - - -procedure TManager.FWriteToGameLog(const s: string); -begin - if ((not m_bConnectionOccured) or m_bTransmittable) then - exit; - - gameLog := gameLog + s; -end; - - -procedure TManager.FlushGameLog; -var - gameLogFile: TextFile; -begin - if ((not m_bConnectionOccured) or m_bTransmittable) then - exit; - - if (not move_done) then - exit; - - AssignFile(gameLogFile, Chess4NetGamesLogPath + GAME_LOG_FILE); -{$I-} - Append(gameLogFile); -{$I+} - if (IOResult <> 0) then - begin - Rewrite(gameLogFile); - if (IOResult = 0) then - writeln(gameLogFile, gameLog); - end - else - writeln(gameLogFile, sLineBreak + gameLog); - - CloseFile(gameLogFile); -{$IFDEF SKYPE} - CreateLinkForGameLogFile; -{$ENDIF} -end; -{$ENDIF} - -procedure TManager.FPopulateExtBaseList; -var - sr: TSearchRec; - extBaseName: string; -begin - m_ExtBaseList.Append(''); - if (FindFirst(Chess4NetPath + '*.pos', faAnyFile, sr) = 0) then - begin - repeat - extBaseName := LeftStr(sr.Name, length(sr.Name) - length(ExtractFileExt(sr.Name))); - if (extBaseName <> USR_BASE_NAME) and FileExists(Chess4NetPath + extBaseName + '.mov') then - m_ExtBaseList.Append(extBaseName); - until FindNext(sr) <> 0; - end; // if - FindClose(sr); -end; - - -procedure TManager.RCreateAndPopulateExtBaseList; -begin - m_ExtBaseList := TStringList.Create; - FPopulateExtBaseList; - m_strExtBaseName := ''; -end; - - -procedure TManager.RReadPrivateSettings; -var - initialClockTime: string; -begin - // Общие настройки по умолчанию - initialClockTime := INITIAL_CLOCK_TIME; - SetClock(initialClockTime); - - ChessBoard.AutoFlag := TRUE; - you_takebacks := FALSE; - opponent_takebacks := FALSE; - - // Reading private settings - ChessBoard.animation := TIniSettings.Instance.Animation; - ChessBoard.LastMoveHilighted := TIniSettings.Instance.LastMoveHilighted; - ChessBoard.FlashOnMove := TIniSettings.Instance.FlashOnMove; - ChessBoard.CoordinatesShown := TIniSettings.Instance.CoordinatesShown; - // TODO: read screen position and size - ChessBoard.StayOnTop := TIniSettings.Instance.StayOnTop; - extra_exit := TIniSettings.Instance.ExtraExit; - TLocalizer.Instance.ActiveLanguage := TIniSettings.Instance.ActiveLanguage; - m_iDontShowLastVersion := TIniSettings.Instance.DontShowLastVersion; -{$IFDEF SKYPE} - m_bDontShowCredits := TIniSettings.Instance.DontShowCredits; -{$ENDIF} -end; - - -function TManager.FReadCommonSettings(setToOpponent: boolean): boolean; -var - strClock: string; - bFlag: boolean; -begin - if (m_lwOpponentClientVersion < 200705) then // For 2007.4 common settings are not applied - begin - Result := TRUE; - exit; - end; - - Result := FALSE; - - TIniSettings.Instance.SetOpponentId(OpponentId); - if (not TIniSettings.Instance.HasCommonSettings) then - exit; - - if (setToOpponent) then - begin - if (_PlayerColor = TIniSettings.Instance.PlayerColor) then // Every time change the saved color to opposite one - begin - ChangeColor; - RSendData(CMD_CHANGE_COLOR); - RRetransmit(CMD_CHANGE_COLOR); - end; - - strClock := TIniSettings.Instance.Clock; - if (strClock <> ClockToStr) then - begin - SetClock(strClock); - RSendData(CMD_SET_CLOCK + ' ' + ClockToStr); - end; - - bFlag := TIniSettings.Instance.TrainingMode; - if (ChessBoard.pTrainingMode <> bFlag) then - begin - ChessBoard.pTrainingMode := bFlag; - RSendData(CMD_SET_TRAINING + IfThen(ChessBoard.pTrainingMode, ' 1', ' 0')); - end; - - if (m_lwOpponentClientVersion >= 200706) then - begin - bFlag := TIniSettings.Instance.CanPauseGame; - if (can_pause_game <> bFlag) then - begin - can_pause_game := bFlag; - RSendData(CMD_CAN_PAUSE_GAME + IfThen(can_pause_game, ' 1', ' 0')); - end; - end; { if opponentClientVersion >= 200706} - - if (m_lwOpponentClientVersion >= 200801) then - begin - bFlag := TIniSettings.Instance.CanAdjournGame; - if (can_adjourn_game <> bFlag) then - begin - can_adjourn_game := bFlag; - RSendData(CMD_CAN_ADJOURN_GAME + IfThen(can_adjourn_game, ' 1', ' 0')); - end; - end; { opponentClientVersion >= 200801 } - end; { if setToOpponent } - - m_strExtBaseName := TIniSettings.Instance.ExternalBaseName; - if (m_strExtBaseName <> '') then - ChessBoard.SetExternalBase(Chess4NetPath + m_strExtBaseName) - else - ChessBoard.UnsetExternalBase; - - ChessBoard.pUseUserBase := TIniSettings.Instance.UseUserBase; - - bFlag := TIniSettings.Instance.AllowTakebacks; - if (you_takebacks <> bFlag) then - begin - you_takebacks := bFlag; - RSendData(CMD_ALLOW_TAKEBACKS + IfThen(you_takebacks, ' 1', ' 0')); - end; - - ChessBoard.AutoFlag := TIniSettings.Instance.AutoFlag; - - TakebackGame.Visible := (opponent_takebacks or ChessBoard.pTrainingMode); - GamePause.Visible := can_pause_game; - - if (m_lwOpponentClientVersion >= 200801) then - begin - if (AdjournedStr <> '') then - begin - RSendData(CMD_SET_ADJOURNED + ' ' + AdjournedStr); - end; - end; - - Result := TRUE; -end; - - -procedure TManager.FWritePrivateSettings; -begin - // Write private settings - TIniSettings.Instance.Animation := ChessBoard.Animation; - TIniSettings.Instance.LastMoveHilighted := ChessBoard.LastMoveHilighted; - TIniSettings.Instance.FlashOnMove := ChessBoard.FlashOnMove; - TIniSettings.Instance.CoordinatesShown := ChessBoard.CoordinatesShown; - // TODO: write screen position - TIniSettings.Instance.StayOnTop := ChessBoard.StayOnTop; - TIniSettings.Instance.ExtraExit := extra_exit; - TIniSettings.Instance.ActiveLanguage := TLocalizer.Instance.ActiveLanguage; - if (m_iDontShowLastVersion > CHESS4NET_VERSION) then - TIniSettings.Instance.DontShowLastVersion := m_iDontShowLastVersion; -{$IFDEF SKYPE} - if (m_bDontShowCredits) then - TIniSettings.Instance.DontShowCredits := m_bDontShowCredits; -{$ENDIF} -end; - - -procedure TManager.FWriteCommonSettings; -begin - TIniSettings.Instance.SetOpponentId(OpponentId); - - TIniSettings.Instance.PlayerColor := _PlayerColor; - TIniSettings.Instance.Clock := ClockToStr; - TIniSettings.Instance.TrainingMode := ChessBoard.pTrainingMode; - TIniSettings.Instance.ExternalBaseName := m_strExtBaseName; - TIniSettings.Instance.UseUserBase := ChessBoard.pUseUserBase; - TIniSettings.Instance.AllowTakebacks := you_takebacks; - TIniSettings.Instance.CanPauseGame := can_pause_game; - TIniSettings.Instance.CanAdjournGame := can_adjourn_game; - TIniSettings.Instance.AutoFlag := ChessBoard.AutoFlag; -end; - - -function TManager.ClockToStr: string; -var - s: string; -begin - if (you_unlimited) then - s := 'u' - else - s := IntToStr(you_time) + ' ' + IntToStr(you_inc); - if (opponent_unlimited) then - s := s + ' u' - else - s := s + ' ' + IntToStr(opponent_time) + ' ' + IntToStr(opponent_inc); - - Result := s; -end; - - -procedure TManager.ChangeColor; -begin - with ChessBoard do - begin - if (_PlayerColor = fcWhite) then - begin - StartStandartGameConnected.Enabled := FALSE; - StartPPRandomGameConnected.Enabled := FALSE; - _PlayerColor := fcBlack; - end - else // fcBlack - begin - StartStandartGameConnected.Enabled := TRUE; - StartPPRandomGameConnected.Enabled := TRUE; - _PlayerColor := fcWhite; - end; - RUpdateChessBoardCaption; - SetClock; - end; -end; - - -procedure TManager.GamePauseClick(Sender: TObject); -begin - RSendData(CMD_PAUSE_GAME); -end; - - -procedure TManager.PauseGame; -begin - ChessBoard.StopClock; - if (not Transmittable) then - begin - m_ContinueForm := (m_Dialogs.CreateDialog(TContinueForm) as TContinueForm); - m_ContinueForm.Show; - end; -end; - - -procedure TManager.ContinueGame; -begin - ChessBoard.SwitchClock(ChessBoard.PositionColor); -end; - -procedure TManager.AboutActionExecute(Sender: TObject); -begin - ShowInfo; -end; - -procedure TManager.AdjournGameClick(Sender: TObject); -begin - RSendData(CMD_ADJOURN_GAME); -end; - -procedure TManager.StartAdjournedGameConnectedClick(Sender: TObject); -begin - if (AdjournedStr <> '') then - begin - RSendData(CMD_START_ADJOURNED_GAME); - FStartAdjournedGame; - RRetransmit(CMD_GAME_CONTEXT + ' ' + RGetGameContextStr); - RRetransmit(CMD_CONTINUE_GAME); - end; -end; - - -procedure TManager.FAdjournGame; -begin - if (ChessBoard.Mode <> mGame) then - exit; - FBuildAdjournedStr; - ChessBoard.StopClock; - ChessBoard.Mode := mView; -{$IFDEF GAME_LOG} - FWriteToGameLog('*'); - FlushGameLog; -{$ENDIF} - m_Dialogs.MessageDlg(TLocalizer.Instance.GetMessage(27), mtCustom, [mbOK], mfNone); // The game is adjourned. -end; - -procedure TManager.FExitGameMode; -begin - ChessBoard.StopClock; - ChessBoard.Mode := mView; - if (move_done) then - AdjournedStr := ''; -end; - - -function TManager.RGetGameContextStr: string; -var - str: string; -begin - // Result ::= &&