home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l040 / 10.ddi / CHESS.ZIP / TVSTATUS.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1992-10-27  |  9.2 KB  |  366 lines
  1. {************************************************}
  2. {                                                }
  3. {   Turbo Vision Chess Demo                      }
  4. {   Copyright (c) 1992 by Borland International  }
  5. {                                                }
  6. {************************************************}
  7.  
  8. unit TVStatus;
  9.  
  10. interface
  11.  
  12. {$IFDEF DPMI}
  13. uses Objects, Views, Dialogs, ChessDLL, CTimers, MoveList;
  14. {$ELSE}
  15. uses Objects, Views, Dialogs, ChessInf, CTimers, MoveList;
  16. {$ENDIF}
  17.  
  18. type
  19.   TTimerColor = (tcWhite, tcBlack, tcTotal);
  20.  
  21. { TTimerView }
  22.  
  23.   PTimerView = ^TTimerView;
  24.   TTimerView = object(TParamText)
  25.     Color: TTimerColor;
  26.     constructor Init(var Bounds: TRect; AText: String; AParamCount:
  27.       Integer; AColor: TTimerColor);
  28.     constructor Load(var S: TStream);
  29.     function GetPalette: PPalette; virtual;
  30.     procedure Store(var S: TStream);
  31.   end;
  32.  
  33. { TTurnText }
  34.  
  35.   PTurnText = ^TTurnText;
  36.   TTurnText = object(TTimerView)
  37.     function DataSize: Word; virtual;
  38.     procedure SetData(var Rec); virtual;
  39.   end;
  40.  
  41. { TBestLine }
  42.  
  43.   PBestLine = ^TBestLine;
  44.   TBestLine = object(TParamText)
  45.     function GetPalette: PPalette; virtual;
  46.   end;
  47.  
  48. { TMoveListBox }
  49.  
  50.   PMoveListBox = ^TMoveListBox;
  51.   TMoveListBox = object(TListViewer)
  52.     List: PMoveList;
  53.     constructor Init(var Bounds: TRect; AScrollBar: PScrollBar);
  54.     function GetText(Item: Integer; AMaxLen: Integer): String; virtual;
  55.     procedure Update(AMoveList: PMoveList);
  56.   end;
  57.  
  58. { TStatusDialog }
  59.  
  60.   PStatusDialog = ^TStatusDialog;
  61.   TStatusDialog = object(TDialog)
  62.     LastNodes: Longint;
  63.     LastSec: Word;
  64.     MoveListBox: PMoveListBox;
  65.     constructor Init(var Bounds: TRect);
  66.     function GetPalette: PPalette; virtual;
  67.     procedure Update(Game: HChess; ATimers: array of PChessTimer;
  68.       Nodes: Longint; MoveNumber: Integer; GMode: Word);
  69.     procedure UpdateList(AMoveList: PMoveList);
  70.   end;
  71.  
  72.   PGameStatus = ^TGameStatus;
  73.   TGameStatus = record
  74.     MoveColor: TColor;
  75.     MoveNo:   Longint;
  76.     ToMove:   PString;
  77.     Mode:     PString;
  78.     GameTime: PString;
  79.     WhtTime:  PString;
  80.     BlkTime:  PString;
  81.     Value:    Longint;
  82.     Nodes:    Longint;
  83.     NodesSec: Longint;
  84.     SearchSt: PString;
  85.     MainLine: PString;
  86.   end;
  87.  
  88. const
  89.   StatusDialog: PStatusDialog = nil;
  90.  
  91.   CurPlayer: String[5] = '';
  92.   BestLine: String = '';
  93.   GTime: String[11] = '';
  94.   TimeStrs: array [TColor] of String[11] = ('', '');
  95.   GameMode: String[11] = '';
  96.   SearchStatus: String[14] = '';
  97.   GameStatus: TGameStatus = (
  98.     MoveColor: cWhite;
  99.     MoveNo:   0;
  100.     ToMove:   @CurPlayer;
  101.     Mode:     @GameMode;
  102.     GameTime: @GTime;
  103.     WhtTime:  @TimeStrs[cWhite];
  104.     BlkTime:  @TimeStrs[cBlack];
  105.     Value:    0;
  106.     Nodes:    0;
  107.     NodesSec: 0;
  108.     SearchSt: @SearchStatus;
  109.     MainLine: @BestLine
  110.   );
  111.  
  112. implementation
  113.  
  114. uses Strings, TVChsCmd, Drivers;
  115.  
  116. { TTimerView }
  117.  
  118. constructor TTimerView.Init(var Bounds: TRect; AText: String;
  119.   AParamCount: Integer; AColor: TTimerColor);
  120. begin
  121.   inherited Init(Bounds, AText, AParamCount);
  122.   Color := AColor;
  123. end;
  124.  
  125. constructor TTimerView.Load(var S: TStream);
  126. begin
  127.   inherited Load(S);
  128.   S.Read(Color, SizeOf(Color));
  129. end;
  130.  
  131. function TTimerView.GetPalette: PPalette;
  132. const
  133.   P: array[TTimerColor] of String[Length(CWTimerView)] = (
  134.     CWTimerView, CBTimerView, CGTimerView);
  135. begin
  136.   GetPalette := @P[Color];
  137. end;
  138.  
  139. procedure TTimerView.Store(var S: TStream);
  140. begin
  141.   inherited Store(S);
  142.   S.Write(Color, SizeOf(Color));
  143. end;
  144.  
  145. { TTurnText }
  146.  
  147. function TTurnText.DataSize: Word;
  148. begin
  149.   DataSize := SizeOf(Color) + inherited DataSize;
  150. end;
  151.  
  152. procedure TTurnText.SetData(var Rec);
  153. begin
  154.   Color := TTimerColor(Rec);
  155.   ParamList := Ptr(Seg(Rec), Ofs(Rec) + SizeOf(Color));
  156.   DrawView;
  157. end;
  158.  
  159. { TBestLine }
  160.  
  161. function TBestLine.GetPalette: PPalette;
  162. const
  163.   P: string[Length(CBestLine)] = CBestLine;
  164. begin
  165.   GetPalette := @P;
  166. end;
  167.  
  168. { TMoveListBox }
  169.  
  170. constructor TMoveListBox.Init(var Bounds: TRect; AScrollBar: PScrollBar);
  171. begin
  172.   inherited Init(Bounds, 1, nil, AScrollBar);
  173.   List := nil;
  174.   SetRange(0);
  175. end;
  176.  
  177. {$V-}
  178. function TMoveListBox.GetText(Item: Integer; AMaxLen: Integer): String;
  179. var
  180.   White, Black: String[6];
  181.   P: array[0..2] of Longint;
  182.   Str: array[0..6] of Char;
  183.   Entry: String;
  184. begin
  185.   if (List <> nil) and (List^.Count >= Item * 2) then
  186.   begin
  187.     P[0] := Item + 1;
  188.     MoveToStr(PMove(List^.At(Item * 2))^, Str);
  189.     White := StrPas(Str);
  190.     if List^.Count > Item * 2 + 1 then
  191.     begin
  192.       MoveToStr(PMove(List^.At(Item * 2 + 1))^, Str);
  193.       Black := StrPas(Str);
  194.     end else Black := '';
  195.     P[1] := Longint(@White);
  196.     P[2] := Longint(@Black);
  197.     FormatStr(Entry, '%3d  %6s  %6s', P);
  198.   end else Entry := '';
  199.   GetText := Copy(Entry, 1, AMaxLen);
  200. end;
  201. {$V+}
  202.  
  203. procedure TMoveListBox.Update(AMoveList: PMoveList);
  204. var
  205.   ARange: Integer;
  206.   AUndoPos: Integer;
  207.   OldRange: Integer;
  208. begin
  209.   List := AMoveList;
  210.   if List <> nil then
  211.   begin
  212.     ARange := (List^.Count + 1) div 2;
  213.     AUndoPos := List^.UndoPos div 2;
  214.     OldRange := Range;
  215.     SetRange(ARange);
  216.     FocusItem(AUndoPos);
  217.     if OldRange = ARange then DrawView;
  218.   end else SetRange(0);
  219. end;
  220.  
  221. { TStatusDialog }
  222.  
  223. constructor TStatusDialog.Init(var Bounds: TRect);
  224. var
  225.   R: TRect;
  226.   SB: PScrollBar;
  227. begin
  228.   inherited Init(Bounds, '');
  229.   Flags := 0;
  230.  
  231.   R.Assign(1, 1, 7, 2);
  232.   Insert(New(PStaticText, Init(R, 'Turn:')));
  233.   R.Assign(7, 1, Size.X - 8, 2);
  234.   Insert(New(PTurnText, Init(R, ' %-3d   %s', 2, tcWhite)));
  235.  
  236.   Inc(R.A.Y); Inc(R.B.Y);
  237.   R.Assign(1, R.A.Y, Size.X - 1, R.B.Y);
  238.   Insert(New(PParamText, Init(R, 'Mode: %s', 1)));
  239.  
  240.   Inc(R.A.Y); Inc(R.B.Y);
  241.   R.Assign(Size.X div 4, R.A.Y, Size.X div 2 + Size.X div 4 - 1, R.B.Y);
  242.   Insert(New(PTimerView, Init(R, ^C'%s', 1, tcTotal)));
  243.  
  244.   Inc(R.A.Y); Inc(R.B.Y);
  245.   R.Assign(1, R.A.Y, (Size.X) div 2, R.B.Y);
  246.   Insert(New(PTimerView, Init(R, ^C'%s', 1, tcWhite)));
  247.  
  248.   R.Assign(Size.X div 2, R.A.Y, Size.X - 1, R.B.Y);
  249.   Insert(New(PTimerView, Init(R, ^C'%s', 1, tcBlack)));
  250.  
  251.   Inc(R.A.Y, 2); Inc(R.B.Y, 2);
  252.   R.Assign(1, R.A.Y, Size.X - 1, R.B.Y);
  253.   Insert(New(PParamText, Init(R, 'Value: %6d', 1)));
  254.  
  255.   Inc(R.A.Y); Inc(R.B.Y);
  256.   R.Assign(1, R.A.Y, Size.X - 1, R.B.Y);
  257.   Insert(New(PParamText, Init(R, 'Nodes: %6d %5d/sec', 2)));
  258.  
  259.   Inc(R.A.Y);
  260.   R.Assign(Size.X - 1, R.A.Y, Size.X, Size.Y - 9);
  261.   SB := New(PScrollBar, Init(R));
  262.   Insert(SB);
  263.  
  264.   R.Assign(1, R.A.Y, Size.X - 1, R.B.Y);
  265.   MoveListBox := New(PMoveListBox, Init(R, SB));
  266.   Insert(MoveListBox);
  267.  
  268.   R.Assign(1, Size.Y - 9, Size.X - 1, Size.Y - 8);
  269.   Insert(New(PParamText, Init(R, 'Bestline: %s', 1)));
  270.   R.Assign(1, Size.Y - 8, Size.X - 1, Size.Y - 1);
  271.   Insert(New(PBestLine, Init(R, '%s', 1)));
  272.  
  273.   SetData(GameStatus);
  274. end;
  275.  
  276. function TStatusDialog.GetPalette: PPalette;
  277. const
  278.   P: string[Length(CStatusDialog)] = CStatusDialog;
  279. begin
  280.   GetPalette := @P;
  281. end;
  282.  
  283. {$V-}
  284. procedure TStatusDialog.Update(Game: HChess; ATimers: array of PChessTimer;
  285.   Nodes: Longint; MoveNumber: Integer; GMode: Word);
  286. var
  287.   MLine: array[0..10] of TMove;
  288.   MainValue: Integer;
  289.   Str: array[0..20] of Char;
  290.   I: Integer;
  291.   Params: array[0..3] of Longint;
  292.   LastSrch, SrchStat: TSearchStatus;
  293.  
  294.   procedure GetTime(TickTime: Longint;
  295.     var Hours, Minutes, Seconds, Ticks: Longint);
  296.   var
  297.     H, M, S, T: Word;
  298.   begin
  299.     ConvertTicks(TickTime, H, M, S, T);
  300.     Hours := H;
  301.     Minutes := M;
  302.     Seconds := S;
  303.     Ticks := T;
  304.   end;
  305.  
  306. begin
  307.   GameStatus.MoveColor := GetPlayer(Game);
  308.   if GameStatus.MoveColor = cWhite then
  309.     CurPlayer := 'White'
  310.   else CurPlayer := 'Black';
  311.   GameStatus.MoveNo := MoveNumber;
  312.   GameStatus.Nodes := Nodes;
  313.   LastSrch := SrchStat;
  314.   SrchStat := GetSearchStatus(Game);
  315.   case SrchStat of
  316.     ssMoveSearch: SearchStatus := 'Thinking';
  317.     ssThinkAhead: SearchStatus := 'Thinking ahead';
  318.   else
  319.     SearchStatus := '';
  320.   end;
  321.   if GMode and gmDemo <> 0 then
  322.     GameMode := 'Demo'
  323.   else if GMode = gmOnePlay then
  324.     GameMode := 'One Player'
  325.   else GameMode := 'Two Player';
  326.   GetTime(ATimers[Ord(cWhite)]^.GetCurrentTicks + ATimers[Ord(cBlack)]^.GetCurrentTicks,
  327.     Params[0], Params[1], Params[2], Params[3]);
  328.   FormatStr(GTime, '%02d:%02d:%02d.%02d', Params);
  329.   if (SrchStat in [ssMoveSearch, ssThinkAhead]) and
  330.     (LastSec <> Params[2]) then
  331.   begin
  332.     LastSec := Params[2];
  333.     if LastSrch = SrchStat then
  334.       GameStatus.NodesSec := Nodes - LastNodes
  335.     else
  336.       GameStatus.NodesSec := 0;
  337.     LastNodes := Nodes;
  338.   end;
  339.   for I := Low(ATimers) to High(ATimers) do
  340.   begin
  341.     GetTime(ATimers[I]^.GetCurrentTicks, Params[0], Params[1], Params[2], Params[3]);
  342.     FormatStr(TimeStrs[TColor(I)], '%02d:%02d:%02d.%02d', Params);
  343.   end;
  344.   BestLine := '';
  345.   GetMainLine(Game, MainValue, MLine);
  346.   GameStatus.Value := MainValue;
  347.   if Settings.Hints and hoBestLine <> 0 then
  348.   begin
  349.     for I := Low(MLine) to High(MLine) do
  350.     begin
  351.       if MLine[I].Change.Piece <> pEmpty then
  352.       begin
  353.         MoveToStr(MLine[I], Str);
  354.         BestLine := BestLine + StrPas(Str) + ' ';
  355.       end else Break;
  356.     end;
  357.   end;
  358.   SetData(GameStatus);
  359. end;
  360.  
  361. procedure TStatusDialog.UpdateList(AMoveList: PMoveList);
  362. begin
  363.   MoveListBox^.Update(AMoveList);
  364. end;
  365.  
  366. end.