rltsvr.pas

一般的数据库管理系统 uses Classes, SConnectEx, TltConst, ExtCtrls, MMSystem, Types, windows, TltLogic , Sy

function TTltManager.GetPlayerByID(PlayerID: String): TPlayer;
var
  I : integer;
  Player : TPlayer;
begin
  Result := nil;
  for I := 0 to FPlayerList.Count -1 do
  begin
    Player := TPlayer(FPlayerList[i]);
    if PlayerID = Player.ID then
    begin
      Result := Player;
      Exit;
    end;
  end;
end;
function TTltManager.GetClientByPlayer(Player : TPlayer) : TTltClient;
var
  I : integer;
  Client : TTltClient;
begin
  Result := nil;
  for I := 0 to FPlayerList.Count -1 do
  begin
    Client := TTltClient(FTltClients[i]);
    if Client.HasPlayer(Player) then
    begin
      Result := Client;
      Exit;
    end;
  end;

end;

function TTltManager.GetState: TRoundState;
begin
  Result := Round.State;
end;

function TTltManager.GetColorIndex(Num : integer): integer;
begin
  result := -1;
  case Num of
    1, 3,5,7,9,12,14,16,18,19,21,23,25,27,30,32,34,36:
      Result := 0;
    2,4,6,8,10,11,13,15,17,20,22,24,26,28,29,31,33,35:
      Result := 1;
    0: Result := 2;
    else Result := -1;
  end;
end;

procedure TTltManager.InitRound;
begin
  FPauseAtRoundEnd := false;
  FTickCount := GetTickCount;
  FWheelStartTickCount := FTickCount;
  FillChar(FFlag, sizeof(FFlag), #0);
  Round.CountDown := FCountDown;
  Round.State :=  rsBeting;
  Round.Main := FRoundMain;
  if FTimeSettingModified then UpdateTimeSetting;
end;

function TTltManager.LoginPlayer(APlayer: TPlayer): boolean;
var
  Player : TPlayer;
  I, Index : integer;
begin
  I := 0;
  while I < FPlayerList.Count do
  begin
    if TPlayer(FPlayerList[i]).ID = APlayer.ID then
    begin
      LogoffPlayer(APlayer.ID);
    end else inc(I);
  end;
  FPlayerList.Add(APlayer);
  APlayer.State := psActive;
  APlayer.Modified := true;
end;

function TTltManager.LoginPlayer(PlayerID, Password: String; AClient: TtltClient): boolean;
var
  Player : TPlayer;
  Index : integer;
begin
  Result := false;
  Player := TPlayer.Create;
  try
    Player.ID := PlayerID;
    if not DALoadPlayer(Player) then
    begin
      Result := false;
      Exit;
    end;
    if Password = Player.Password then
    begin
      Result := true;
      AClient.AddPlayer(Player);
      LoginPlayer(Player);
    end;

  finally
    if not Result then Player.Free;
  end;

end;

procedure TTltManager.LogoffPlayer(PlayerID: String);
var
  Player : TPlayer;
begin
  Player := GetPlayerByID(PlayerID);
  if Player<>nil then
  begin
    FPlayerList.Remove(Player);
    Player.Client.RemovePlayer(Player);
    DASavePlayer(Player);
    Player.Free;
  end;
end;

function TTltManager.GetRandomNumByColor(ColorIndex : integer): integer;
const Nums : array[0..36] of integer =( 1, 3,5,7,9,12,14,16,18,19,21,23,25,27,30,32,34,36,
    2,4,6,8,10,11,13,15,17,20,22,24,26,28,29,31,33,35,0);
begin
  Result := -1;
  case ColorIndex of
  0:begin
    Result := Nums[random(16)];
  end;
  1:begin
    Result := Nums[random(16)+16];
  end;
  2:begin
    Result := 0;
  end;
  end;
end;

function TTltManager.NextState: TRoundState;
begin
  with Round do
  case State of
    rsPaused:
    begin
      State := rsBeting;
    end;
    rsDemo:
    begin
      State := rsBeting;
    end;
    rsBeting:
    begin
      State := rsBeforeWheel;
    end;
    rsBeforeWheel:
    begin
      State := rsWheeling;
    end;
    rsWheeling:
    begin
      State := rsScore;
    end;
    rsScore:
    begin
      State := rsBeting;
      InitRound;
    end;
  end;
  Level2 :=1;  
end;

procedure TTltManager.RemoveClient(Client: TTltClient);
begin
  if not Assigned(Client) then Exit;
  while Client.PlayerList.Count>0 do
  begin
    LogoffPlayer(TPlayer(Client.PlayerList[0]).ID);
  end;
  FTltClients.Remove(Client);
end;

procedure TTltManager.ResetWheel;
begin
  InitRound;
end;

function TTltManager.SetOpenNumber(ANum: integer): integer;
begin
  Round.WheelResult := ANum;
end;

procedure TTltManager.StartRound;
begin


end;
procedure TTltManager.Update;
var
  NowTime : DWord;
  DltTime : DWord;
  function ChkTime: boolean;
  begin
    NowTime := GetTickCount;
    DltTime := NowTime - FTickCount;
    if DltTime<0 then
    begin
      DltTime := 1000;
      NowTime := 1000;
      FTickCount := 0
    end;
    if DltTime > 20000 then //系统超时,强制重启本轮
    begin
      ResetWheel;
      Result := false;
      Exit;
    end;
    FTickCount := NowTime;

    Result := True;
  end;
  function UpDateState: boolean ;
  begin//计算状态变更
    with TimeSetting do
    begin
      if (state = rsBeting) and (Round.CountDown >= BetTimeSet) then NextState
      else
      if (state = rsBeforeWheel) and (Round.CountDown >= BeforeWheelTimeSet) then NextState
      else
      if (state = rsWheeling) and (Round.CountDown >= WheelingTimeSet) then NextState
      else
      if (state = rsScore) and (Round.CountDown >= ScoreTimeSet) then NextState;

    end;
  end;
const
  CRedBet = 0;
  CBlackBet = 1;
  CGreenBet = 2;
var
  I : integer;
begin
  if NeedResetPlayerBet then ResetPlayerBet;

  with Round do
  begin
    if not ChkTime then Exit; //检查时间
    if State in [rsBeting..rsScore] then
      Round.CountDown := (FTickCount - FWheelStartTickCount ) div 1000;

    if state = rsBeting then DoBeting;
    if State = rsBeforeWheel then DoBeforeWheel;
    if State = rsWheeling then DoWheeling;
    if State = rsScore then DoScore;
    if State = rsStop then DoStop;
    if State = rsPaused then DoPaused;

  //  if State = rsBeginToWait then DoBeginToWait;
    UpDateState;
    FTickCount := NowTime; //累加时间
  end;

  //更新下注量
  FillChar(BetCount, sizeof(BetCount), #0);
  for i := 0 to FPlayerList.Count -1 do
  begin
    with TPlayer(FPlayerList[i]) do
    begin
      inc(BetCount[btRed], Bet[btRed]);
      inc(BetCount[btBlack], Bet[btBlack]);
      inc(BetCount[btGreen], Bet[btGreen]);
    end;
  end;
  //

  Log;
//  inc
end;

procedure TTltManager.UpdateClients(Proc: TClientProc);
var
  I : integer;
  rltInterpreter : TrltServerInterpreter;
begin
  if Assigned(Proc) then
  begin
    for I := 0 to SocketForm.ConnectionList.Items.Count -1 do
    begin
      rltInterpreter := SocketForm.GetrltInterpreter(I);
      rltInterpreter.CallProc(Proc);
    end;
  end;
end;

procedure TTltManager.UpdateCountDown;
begin
//  FWheelCounter := GetTickCount - FWheelStartTickCount]
  //inc(FCountDown);
end;

procedure TTltManager.UpdateCounter;
begin

end;

procedure TTltManager.UpdateLogic;
begin

end;

procedure TTltManager.UpdateTimeSetting;
begin
  with TimeSetting do
  begin
    BetTimeSet := FBetTimeSetting;
    BeforeWheelTimeSet := BetTimeSet + FBeforeWheelTimeSetting;
    WheelingTimeSet := BeforeWheelTimeSet + FWheelingTimeSetting;
    ScoreTimeSet := WheelingTimeSet + FScoreTimeSetting;
    WheelEndSet := ScoreTimeSet;
  end;
end;


procedure TTltManager.Log;
begin
  if SocketForm = nil then Exit;
  SocketForm.Label8.Caption := Format('r:%d b:%d g:%d r:%d',[BetCount[btRed], BetCount[btBlack], BetCount[btGreen], Round.WheelResult]);
  SocketForm.Label9.Caption := Format('值:%d 期望:%d ',[FTotalValue, FObjectValue]);
  SocketForm.Label10.Caption := Format('User:%d ',[FPlayerList.Count]);
end;

function TTltManager.GetResult: integer;
var
  BetTotle : longint;
  DT : longint;
  NewObjectValue : longint;
  ColorIndex : integer;
  ExpectedValue :array[TBetType] of longint;
  Power : array[TBetType] of longint;
  TotalPower  : longint;
//  Mul : int64;
  function GetPowerRandom(v1,v2,v3 : integer):integer;//0..2
  var
    tt : integer;
    v : integer;
//    dt : integer;
  begin
    if v1<0 then v1 :=0;
    if v2<0 then v2 :=0;
    if v3<0 then v3 :=0;
    tt := v1 + v2 + v3;
    if tt <>0 then
    begin//带权随机
      v := Random(tt);
      if v< v1 then Result := 0;
      if (v>=v1) and(v<v1+v2) then Result := 1;
      if (v>=v1+v2) then Result :=2;
    end else
    begin
      v := Random(37); //正常随机
      Result := GetColorIndex(v);
    end;
  end;
begin
//计算结果
//1下注量
  FillChar(Power, sizeOf(Power), #0);
  BetTotle := BetCount[btRed] + BetCount[btBlack] + BetCount[btGreen];
  //利润期望
  NewObjectValue := (BetTotle) * FRate div 100 + FObjectValue;
  //（理想利润）
  DT := NewObjectValue - FTotalValue  ;
  //DT 差额；
  ;
  //单次可能利润；
  ExpectedValue[btRed] := - BetCount[btRed] + BetCount[btBlack] + BetCount[btGreen];
  ExpectedValue[btBlack] :=  BetCount[btRed] - BetCount[btBlack] + BetCount[btGreen];
  ExpectedValue[btGreen] :=  BetCount[btRed] + BetCount[btBlack] - BetCount[btGreen] * 35;
  //与预期利润的差距，
  //
  if (ExpectedValue[btRed]>=0) or (ExpectedValue[btRed] - DT>0) then
    Power[btRed] := 18;
  if (ExpectedValue[btBlack]>=0) or (ExpectedValue[btBlack] - DT>=0) then
    Power[btBlack] := 18;
  if (ExpectedValue[btGreen]>=0) or (ExpectedValue[btGreen] - DT>=0) then
    Power[btGreen] := 1;
  //越接近预期利润差，概率越大
  ExpectedValue[btRed] :=  ExpectedValue[btRed] - DT;    //0        10
  ExpectedValue[btBlack] :=  ExpectedValue[btBlack] - DT; //-10     10
  ExpectedValue[btGreen] :=  ExpectedValue[btGreen] - DT; //1000    350

  if (abs(ExpectedValue[btRed])<abs(ExpectedValue[btBlack])) then
  begin
    if (abs(ExpectedValue[btRed])>abs(ExpectedValue[btGreen])) then
      Power[btGreen] := Power[btGreen] * 2   //如果绿色最小
    else if (abs(ExpectedValue[btRed])<abs(ExpectedValue[btGreen])) then
      Power[btRed] := Power[btRed] * 2; //如果红色最小
  end
  else if(abs(ExpectedValue[btRed])>abs(ExpectedValue[btBlack])) then
  begin
    if (abs(ExpectedValue[btBlack])>abs(ExpectedValue[btGreen])) then
      Power[btGreen] := Power[btGreen] * 2 //如果绿色最小
    else if(abs(ExpectedValue[btBlack])<abs(ExpectedValue[btGreen])) then
      Power[btBlack] := Power[btBlack] * 2;//如果黑色最小
  end;
  //如果为正，表示可以参与随机,差距小的可能性大，差距大的可能性小
  //结果校正：如果差距为负，重新随机；
  if ExpectedValue[btRed] <0 then Power[btRed] := 0;
  if ExpectedValue[btBlack] <0 then Power[btBlack] := 0;
  if ExpectedValue[btGreen] <0 then Power[btGreen] := 0;

  ColorIndex := GetPowerRandom(Power[btRed], Power[btBlack], Power[btGreen]);
  Result := GetRandomNumByColor(ColorIndex);

end;

function TTltManager.GetWheelParams(State: TRoundState): TWheelParams;
var
  i : integer;
  DT : integer;
begin
  DT := GetTickCount - FLastWheelParamGetTime;
  Result := WheelParams;
  Result.ParamsCount := 2;
  case State of
  rsBeting:
  begin
    with Result.Params[0] do
    begin
      FrameTime := 0;
      TimeDuration := FBetTimeSetting ;
      WheelTheta := FWheelTheta ;
      WheelA := 0;
      WheelV :=0;//.1;
      BallV := 0;//.1;
      BallTheta := FBallTheta;
      BallHeight := 0;
      BallR := 0;
      BallA := 0;
      FWheelTheta :=FWheelTheta + TimeDuration * WheelV
        + WheelA * TimeDuration * TimeDuration /2;
      FBallTheta := FBallTheta + BallV * TimeDuration
        + BallA * TimeDuration * TimeDuration /2;
    end;
    with Result.Params[1] do
    begin
      FrameTime := FBetTimeSetting;
      TimeDuration := 100000 ;
      WheelTheta := FWheelTheta ;
      WheelA := 0;
      WheelV :=0;
      BallV := 0;
      BallTheta := FBallTheta;
      BallHeight := 0;
      BallR := 0;
      BallA := 0;
    end;
  end;
  rsBeforeWheel:
  begin
  //在改变结果时存在变迁
    if GetTickCount - GetTickCount>= TimeSetting.BeforeWheelTimeSet*1000 then
    begin
      with Result.Params[0] do
      begin
        FrameTime := TimeSetting.BetTimeSet ;
        TimeDuration := 1;
        WheelTheta := FWheelTheta;
        WheelA := 0;
        BallA := 0;
        BallTheta := FBallTheta;
        BallHeight := 0;
        BallR := 0;
        FWheelTheta :=FWheelTheta + TimeDuration * WheelV
          + WheelA * TimeDuration * TimeDuration /2;
        FBallTheta := FBallTheta + BallV * TimeDuration
          + BallA * TimeDuration * TimeDuration /2;
      end;
      with Result.Params[1] do
      begin
        FrameTime := Result.Params[0].FrameTime + Result.Params[0].TimeDuration;
        TimeDuration := TimeSetting.BeforeWheelTimeSet-FrameTime;
        WheelTheta := FWheelTheta;
        WheelA := 0;
        BallA := 0;
        WheelV := 0;
        BallV := 0;
        BallTheta := FBallTheta;
        BallHeight := 0;
        BallR := 0;
        FWheelTheta :=FWheelTheta + TimeDuration * WheelV
          + WheelA * TimeDuration * TimeDuration /2;
        FBallTheta := FBallTheta + BallV * TimeDuration
          + BallA * TimeDuration * TimeDuration /2;
      end;
      FLastWheelParamGetTime := GetTickCount;
    end;
  end;
  rsWheeling:
  begin
    //初期加速,ball fly out
    Result.ParamsCount := 5;

    with Result.Params[0] do
    begin
      FrameTime := TimeSetting.BeforeWheelTimeSet;
      TimeDuration := 1;
      WheelTheta := FWheelTheta;
      WheelA := -1;
      BallA := 0.5;
      WheelV :=6;//no change
      BallV := -6.000;
      BallTheta := FBallTheta;
//      BallHeight := 1.5;
      BallR := 11;
      FWheelTheta :=FWheelTheta + TimeDuration * WheelV
        + WheelA * TimeDuration * TimeDuration /2;
      FBallTheta := FBallTheta + BallV * TimeDuration
        + BallA * TimeDuration * TimeDuration /2;
    end;
    //+速 culute to win;
    with Result.Params[1] do
    begin
      FrameTime := Result.Params[0].FrameTime + Result.Params[0].TimeDuration;
      TimeDuration := 1;
      WheelTheta := FWheelTheta;
      WheelA := -1;
      BallA := 0.5;
      WheelV := Result.Params[0].WheelV + Result.Params[0].WheelA
        * Result.Params[0].TimeDuration;
      BallV := Result.Params[0].BallV + Result.Params[0].BallA
        * Result.Params[0].TimeDuration;
      BallTheta := FBallTheta;
      BallHeight := 0;
      BallR := 11;
      FWheelTheta :=FWheelTheta + TimeDuration * WheelV
        + WheelA * TimeDuration * TimeDuration /2;
      FBallTheta := FBallTheta + BallV * TimeDuration
        + BallA * TimeDuration * TimeDuration /2;
    end;
    //--
    with Result.Params[2] do
    begin
      FrameTime := Result.Params[1].FrameTime + Result.Params[1].TimeDuration;
      TimeDuration := 1;
      WheelTheta := FWheelTheta;
      WheelA := -1;
      BallA := 0.5;
      WheelV := Result.Params[1].WheelV + Result.Params[1].WheelA
        * Result.Params[1].TimeDuration;
      BallV := Result.Params[1].BallV + Result.Params[1].BallA
        * Result.Params[1].TimeDuration;