home *** CD-ROM | disk | FTP | other *** search
/ QBasic & Borland Pascal & C / Delphi5.iso / Pascal / BPASCAL.700 / D12 / CHESSTV.ZIP / CHESSAPP.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-10-01  |  4.0 KB  |  158 lines
  1. unit ChessApp;
  2.  
  3. interface
  4.  
  5. uses App, Views, Dialogs, Menus, Objects, Drivers;
  6.  
  7. type
  8.   PChessApp = ^TChessApp;
  9.   TChessApp = object(TApplication)
  10.     constructor Init;
  11.     function GetPalette: PPalette; virtual;
  12.     procedure HandleEvent(var Event: TEvent); virtual;
  13.     procedure Idle; virtual;
  14.     procedure InitChessBoard;
  15.     procedure InitMenuBar; virtual;
  16.     procedure InitStatusLine; virtual;
  17.     procedure InitDesktop; virtual;
  18.     procedure InitStatusDialog;
  19.     procedure InitScreenMode;
  20.   end;
  21.  
  22. implementation
  23.  
  24. uses ChessCmd, Status, Board, Pieces, MoveList, ChessDlg, ChessSt;
  25.  
  26. constructor TChessApp.Init;
  27. begin
  28.   inherited Init;
  29.   InitScreenMode;
  30.   InitStatusDialog;
  31.   InitChessBoard;
  32.   if ChessBoard <> nil then Insert(ChessBoard);
  33.   if StatusDialog <> nil then InsertWindow(StatusDialog);
  34.   RegisterObjects;
  35.   RegisterViews;
  36.   RegisterType(RChessPiece);
  37.   RegisterType(RMoveList);
  38.   RegisterType(RTimeLabel);
  39.   RegisterType(RTimeInput);
  40.   RegisterType(RSettingsDlg);
  41. end;
  42.  
  43. function TChessApp.GetPalette: PPalette;
  44. const
  45.   P: array[apColor..apMonochrome] of string[Length(CChessAppColor)] =
  46.     (CChessAppColor, CChessAppBlackWhite, CChessAppMonochrome);
  47. begin
  48.   GetPalette := @P[AppPalette];
  49. end;
  50.  
  51. procedure TChessApp.HandleEvent(var Event: TEvent);
  52. var
  53.   D: PDialog;
  54. begin
  55.   inherited HandleEvent(Event);
  56.   case Event.What of
  57.     evCommand:
  58.       case Event.Command of
  59.         cmSettings:
  60.           begin
  61.             D := CreateSettingsDlg;
  62.             D^.SetData(Settings);
  63.             if ExecView(ValidView(D)) <> cmCancel then
  64.               D^.GetData(Settings);
  65.             Dispose(D, Done);
  66.             ClearEvent(Event);
  67.           end;
  68.       end;
  69.   end;
  70. end;
  71.  
  72. procedure TChessApp.Idle;
  73. begin
  74.   inherited Idle;
  75.   if ChessBoard <> nil then ChessBoard^.DoThink;
  76. end;
  77.  
  78. procedure TChessApp.InitChessBoard;
  79. var
  80.   R: TRect;
  81. begin
  82.   GetExtent(R);
  83.   R.B.X := R.B.X - 28;
  84.   ChessBoard := New(PChessBoard, Init(R));
  85. end;
  86.  
  87. procedure TChessApp.InitMenuBar;
  88. var
  89.   R: TRect;
  90. begin
  91.   GetExtent(R);
  92.   R.B.Y := R.A.Y + 1;
  93.   R.A.X := R.B.X - 28;
  94.   MenuBar := New(PMenuBar, Init(R, NewMenu(
  95.     NewSubMenu('~G~ame', hcNoContext, NewMenu(
  96.       NewItem('~N~ew', '', kbNoKey, cmNew, hcNoContext,
  97.       NewItem('~L~oad', 'F3', kbF3, cmOpen, hcNoContext,
  98.       NewItem('~S~ave', 'F2', kbF2, cmSave, hcNoContext,
  99.       NewItem('Save ~a~s', '', kbNoKey, cmSaveAs, hcNoContext,
  100.       NewLine(
  101.       NewItem('~R~un demo', '', kbNoKey, cmRunDemo, hcNoContext,
  102.       NewItem('S~t~op', 'Alt+T', kbAltT, cmStop, hcNoContext,
  103.       NewLine(
  104.       NewItem('E~x~it', 'Alt+X', kbAltX, cmQuit, hcNoContext,
  105.       nil)))))))))),
  106.     NewSubMenu('~M~ove', hcNoContext, NewMenu(
  107.       NewItem('~U~ndo', 'Alt+Bksp', kbAltBack, cmUndo, hcNoContext,
  108.       NewItem('~R~edo', 'Ctrl+Bksp', kbCtrlBack, cmRedo, hcNoContext,
  109.       NewLine(
  110.       NewItem('~C~omputer move', 'Alt+C', kbAltC, cmComputerMove, hcNoContext,
  111.       NewItem('~E~nter move...', 'Alt+E', kbAltE, cmEnterMove, hcNoContext,
  112.       NewItem('~S~how hint', 'Alt+H', kbAltH, cmShowHint, hcNoContext,
  113.       nil))))))),
  114.     NewSubMenu('~O~ptions', hcNoContext, NewMenu(
  115.       NewItem('~S~ettings', '', kbNoKey, cmSettings, hcNoContext,
  116.       NewItem('~C~olors', '', kbNoKey, cmColors, hcNoContext,
  117.       nil))), nil))))));
  118. end;
  119.  
  120. procedure TChessApp.InitStatusLine;
  121. var
  122.   R: TRect;
  123. begin
  124.   GetExtent(R);
  125.   R.A.Y := R.B.Y - 1;
  126.   R.A.X := R.B.X - 28;
  127.   StatusLine := New(PChessStatusLine, Init(R,
  128.     NewStatusDef($0, $FFFF,
  129.       StdStatusKeys(nil), nil)));
  130. end;
  131.  
  132. procedure TChessApp.InitDesktop;
  133. var
  134.   R: TRect;
  135. begin
  136.   GetExtent(R);
  137.   R.Grow(0, -1);
  138.   R.A.X := R.B.X - 28;
  139.   Desktop := New(PDesktop, Init(R));
  140. end;
  141.  
  142. procedure TChessApp.InitStatusDialog;
  143. var
  144.   R: TRect;
  145. begin
  146.   R.Assign(0, 0, Desktop^.Size.X, Size.Y - 2);
  147.   StatusDialog := New(PStatusDialog, Init(R));
  148. end;
  149.  
  150. procedure TChessApp.InitScreenMode;
  151. begin
  152.   ShadowSize.X := 2;
  153.   SetScreenMode(ScreenMode and (not smFont8x8));
  154. end;
  155.  
  156.  
  157. end.
  158.