home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l040 / 10.ddi / CHESS.ZIP / TVCHSAPP.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-10-27  |  10.6 KB  |  372 lines
  1. {************************************************}
  2. {                                                }
  3. {   Turbo Vision Chess Demo                      }
  4. {   Copyright (c) 1992 by Borland International  }
  5. {                                                }
  6. {************************************************}
  7.  
  8. unit TVChsApp;
  9.  
  10. interface
  11.  
  12. uses App, Views, Dialogs, Menus, Objects, Drivers, Dos;
  13.  
  14. type
  15.   PChessApp = ^TChessApp;
  16.   TChessApp = object(TApplication)
  17.     ConfigFile: PathStr;
  18.     constructor Init;
  19.     destructor Done; virtual;
  20.     procedure ChangeColors;
  21.     function GetPalette: PPalette; virtual;
  22.     procedure HandleEvent(var Event: TEvent); virtual;
  23.     procedure Idle; virtual;
  24.     procedure InitChessBoard;
  25.     procedure InitMenuBar; virtual;
  26.     procedure InitStatusLine; virtual;
  27.     procedure InitDesktop; virtual;
  28.     procedure InitStatusDialog;
  29.     procedure InitScreenMode;
  30.     procedure LoadConfig;
  31.     procedure SaveConfig;
  32.     procedure ShowAbout;
  33.   end;
  34.  
  35. implementation
  36.  
  37. uses TVChsCmd, TVStatus, TVBoard, TVPieces, MoveList, TVChsDlg, TVChstat,
  38.   Strings, ColorSel, HistList;
  39.  
  40. const
  41.   ChessPalettes: array[apColor..apMonochrome] of string[Length(CChessAppColor)] =
  42.     (CChessAppColor, CChessAppBlackWhite, CChessAppMonochrome);
  43.  
  44.   ConfigSignature : array [0..33] of Char = 'Turbo Vision Chess Configuration'#26#0;
  45.   ConfigName = 'TVCHESS.CFG';
  46.  
  47. constructor TChessApp.Init;
  48. begin
  49.   inherited Init;
  50.   InitScreenMode;
  51.   LoadConfig;
  52.   InitStatusDialog;
  53.   InitChessBoard;
  54.   if ChessBoard <> nil then Insert(ChessBoard);
  55.   if StatusDialog <> nil then InsertWindow(StatusDialog);
  56.   RegisterType(RMoveList);
  57. end;
  58.  
  59. destructor TChessApp.Done;
  60. begin
  61.   SaveConfig;
  62.   inherited Done;
  63. end;
  64.  
  65. procedure TChessApp.ChangeColors;
  66. var
  67.   D: PColorDialog;
  68.   R: TRect;
  69.   P: PView;
  70.   AGroups: PColorGroup;
  71. begin
  72.   AGroups :=
  73.     ColorGroup('Desktop',
  74.       ColorItem('Color',             1, nil),
  75.     ColorGroup('Dialogs',
  76.       ColorItem('Frame/background',  33,
  77.       ColorItem('Frame icons',       34,
  78.       ColorItem('Scroll bar page',   35,
  79.       ColorItem('Scroll bar icons',  36,
  80.       ColorItem('Static text',       37,
  81.       ColorItem('Label normal',      38,
  82.       ColorItem('Label selected',    39,
  83.       ColorItem('Label shortcut',    40,
  84.       ColorItem('Label disabled',     135,
  85.       ColorItem('Button normal',     41,
  86.       ColorItem('Button default',    42,
  87.       ColorItem('Button selected',   43,
  88.       ColorItem('Button disabled',   44,
  89.       ColorItem('Button shortcut',   45,
  90.       ColorItem('Button shadow',     46,
  91.       ColorItem('Cluster normal',    47,
  92.       ColorItem('Cluster selected',  48,
  93.       ColorItem('Cluster shortcut',  49,
  94.       ColorItem('Cluster disabled',  62,
  95.       ColorItem('Input normal',      50,
  96.       ColorItem('Input selected',    51,
  97.       ColorItem('Input arrow',       52,
  98.       ColorItem('Input disabled',    136,
  99.       ColorItem('History button',    53,
  100.       ColorItem('History sides',     54,
  101.       ColorItem('History bar page',  55,
  102.       ColorItem('History bar icons', 56,
  103.       ColorItem('List normal',       57,
  104.       ColorItem('List focused',      58,
  105.       ColorItem('List selected',     59,
  106.       ColorItem('List divider',      60,
  107.       ColorItem('Information pane',  61,
  108.       nil)))))))))))))))))))))))))))))))),
  109.     ColorGroup('Menus',
  110.       ColorItem('Normal',            2,
  111.       ColorItem('Disabled',          3,
  112.       ColorItem('Shortcut',          4,
  113.       ColorItem('Selected',          5,
  114.       ColorItem('Selected disabled', 6,
  115.       ColorItem('Shortcut selected', 7, nil)))))),
  116.     ColorGroup('Board',
  117.       ColorItem('Border',           128,
  118.       ColorItem('Black square',     130,
  119.       ColorItem('White square',     129,
  120.       ColorItem('Black hint',       147,
  121.       ColorItem('White hint',       146, nil))))),
  122.     ColorGroup('Pieces',
  123.       ColorItem('Black piece',      131,
  124.       ColorItem('White piece',      132,
  125.       ColorItem('Black in jeopardy',133,
  126.       ColorItem('White in jeopardy',134, nil)))),
  127.     ColorGroup('Glyph buttons',
  128.       ColorItem('Background',        137,
  129.       ColorItem('Black piece',       139,
  130.       ColorItem('White piece',       138,
  131.       ColorItem('Black selected',    141,
  132.       ColorItem('White selected',    140, nil))))),
  133.     ColorGroup('Status window',
  134.       ColorItem('Frame/background',  97,
  135.       ColorItem('Frame icons',       98,
  136.       ColorItem('Scroll bar page',   99,
  137.       ColorItem('Scroll bar icons',  100,
  138.       ColorItem('Static text',       101,
  139.       ColorItem('List normal',       121,
  140.       ColorItem('List focused',      122,
  141.       ColorItem('List selected',     123,
  142.       ColorItem('List divider',      124,
  143.       ColorItem('Bestline',          142,
  144.       ColorItem('White timer',       143,
  145.       ColorItem('Black timer',       144,
  146.       ColorItem('Game timer',        145, nil))))))))))))),
  147.     nil)))))));
  148.  
  149.   D := New(PColorDialog, Init('' , AGroups));
  150.  
  151.   D^.SetData(ChessPalettes[AppPalette]);
  152.   if Application^.ExecView(D) <> cmCancel then
  153.   begin
  154.     D^.GetData(ChessPalettes[AppPalette]);
  155.     Redraw;
  156.     ChessBoard^.Redraw;
  157.   end;
  158.  
  159.   Dispose(D, Done);
  160. end;
  161.  
  162.  
  163. function TChessApp.GetPalette: PPalette;
  164. begin
  165.   GetPalette := @ChessPalettes[AppPalette];
  166. end;
  167.  
  168. procedure TChessApp.HandleEvent(var Event: TEvent);
  169. var
  170.   D: PDialog;
  171. begin
  172.   inherited HandleEvent(Event);
  173.   case Event.What of
  174.     evCommand:
  175.       case Event.Command of
  176.         cmSettings:
  177.           begin
  178.             D := CreateSettingsDlg;
  179.             D^.SetData(Settings);
  180.             if ExecView(ValidView(D)) <> cmCancel then
  181.               D^.GetData(Settings);
  182.             Dispose(D, Done);
  183.             ClearEvent(Event);
  184.             with ChessBoard^ do
  185.             begin
  186.               ResetValidMoves;
  187.               GameMode := (GameMode and not gmTwoPlay) or Settings.Players;
  188.             end;
  189.           end;
  190.         cmAbout: ShowAbout;
  191.         cmColors: ChangeColors;
  192.       else
  193.         Exit;
  194.       end;
  195.   end;
  196.   ClearEvent(Event);
  197. end;
  198.  
  199. procedure TChessApp.Idle;
  200. begin
  201.   inherited Idle;
  202.   if ChessBoard <> nil then ChessBoard^.DoThink;
  203. end;
  204.  
  205. procedure TChessApp.InitChessBoard;
  206. var
  207.   R: TRect;
  208. begin
  209.   GetExtent(R);
  210.   R.B.X := R.B.X - 28;
  211.   ChessBoard := New(PChessBoard, Init(R));
  212. end;
  213.  
  214. procedure TChessApp.InitMenuBar;
  215. var
  216.   R: TRect;
  217. begin
  218.   GetExtent(R);
  219.   R.B.Y := R.A.Y + 1;
  220.   R.A.X := R.B.X - 28;
  221.   MenuBar := New(PMenuBar, Init(R, NewMenu(
  222.     NewSubMenu('~G~ame', hcNoContext, NewMenu(
  223.       NewItem('~N~ew', '', kbNoKey, cmNew, hcNoContext,
  224.       NewItem('~L~oad', 'F3', kbF3, cmOpen, hcNoContext,
  225.       NewItem('~S~ave', 'F2', kbF2, cmSave, hcNoContext,
  226.       NewItem('Save ~a~s', '', kbNoKey, cmSaveAs, hcNoContext,
  227.       NewLine(
  228.       NewItem('~R~un demo', '', kbNoKey, cmRunDemo, hcNoContext,
  229.       NewItem('S~t~op', 'Alt+T', kbAltT, cmStop, hcNoContext,
  230.       NewLine(
  231.       NewItem('E~x~it', 'Alt+X', kbAltX, cmQuit, hcNoContext,
  232.       nil)))))))))),
  233.     NewSubMenu('~M~ove', hcNoContext, NewMenu(
  234.       NewItem('~U~ndo', 'Alt+Bksp', kbAltBack, cmUndo, hcNoContext,
  235.       NewItem('~R~edo', 'Ctrl+Bksp', kbCtrlBack, cmRedo, hcNoContext,
  236.       NewLine(
  237.       NewItem('~C~omputer move', 'Alt+C', kbAltC, cmComputerMove, hcNoContext,
  238.       NewItem('~E~nter move...', 'Alt+E', kbAltE, cmEnterMove, hcNoContext,
  239.       NewItem('~S~how hint', 'Alt+S', kbAltS, cmShowHint, hcNoContext,
  240.       nil))))))),
  241.     NewSubMenu('~O~ptions', hcNoContext, NewMenu(
  242.       NewItem('~S~ettings', '', kbNoKey, cmSettings, hcNoContext,
  243.       NewItem('~C~olors', '', kbNoKey, cmColors, hcNoContext,
  244.       nil))),
  245.     NewSubMenu('~H~elp', hcNoContext, NewMenu(
  246.       NewItem('~A~bout', '', kbNoKey, cmAbout, hcNoContext,
  247.       nil)), nil)))))));
  248. end;
  249.  
  250. procedure TChessApp.InitStatusLine;
  251. var
  252.   R: TRect;
  253. begin
  254.   GetExtent(R);
  255.   R.A.Y := R.B.Y - 1;
  256.   R.A.X := R.B.X - 28;
  257.   StatusLine := New(PChessStatusLine, Init(R,
  258.     NewStatusDef($0, $FFFF,
  259.       StdStatusKeys(nil), nil)));
  260. end;
  261.  
  262. procedure TChessApp.InitDesktop;
  263. var
  264.   R: TRect;
  265. begin
  266.   GetExtent(R);
  267.   R.Grow(0, -1);
  268.   R.A.X := R.B.X - 28;
  269.   Desktop := New(PDesktop, Init(R));
  270. end;
  271.  
  272. procedure TChessApp.InitStatusDialog;
  273. var
  274.   R: TRect;
  275. begin
  276.   R.Assign(0, 0, Desktop^.Size.X, Size.Y - 2);
  277.   StatusDialog := New(PStatusDialog, Init(R));
  278. end;
  279.  
  280. procedure TChessApp.InitScreenMode;
  281. begin
  282.   ShadowSize.X := 2;
  283.   SetScreenMode(ScreenMode and (not smFont8x8));
  284. end;
  285.  
  286. procedure TChessApp.LoadConfig;
  287. var
  288.   S: PBufStream;
  289.   CfgName: PathStr;
  290.   Dir: DirStr;
  291.   Name: NameStr;
  292.   Ext: ExtStr;
  293.   Test: array [0..SizeOf(ConfigSignature)] of Char;
  294.   NSettings: TSettings;
  295.   TempPalettes: array[apColor..apMonochrome] of
  296.     String[Length(CChessAppColor)];
  297.   I: Integer;
  298. begin
  299.   Dir := '';
  300.   CfgName := ParamStr(0);
  301.   if CfgName = '' then CfgName := FSearch('TVCHESS.EXE', GetEnv('PATH'));
  302.   if CfgName <> '' then
  303.     FSplit(CfgName, Dir, Name, Ext);
  304.   CfgName := Dir + ConfigName;
  305.   S := New(PBufStream, Init(CfgName, stOpenRead, 1024));
  306.   if S^.Status = stOK then
  307.   begin
  308.     S^.Read(Test, SizeOf(ConfigSignature));
  309.     if (S^.Status = stOK) and
  310.       (StrLComp(ConfigSignature, Test, SizeOf(ConfigSignature)) = 0) then
  311.     begin
  312.       S^.Read(NSettings, SizeOf(NSettings));
  313.       S^.Read(TempPalettes, SizeOf(TempPalettes));
  314.       LoadIndexes(S^);
  315.       LoadHistory(S^);
  316.       if S^.Status = stOK then
  317.       begin
  318.         Settings := NSettings;
  319.         ConfigFile := CfgName;
  320.         for I := apColor to apMonochrome do
  321.           ChessPalettes[I] := TempPalettes[I];
  322.       end;
  323.     end;
  324.   end;
  325.   Dispose(S, Done);
  326. end;
  327.  
  328. procedure TChessApp.SaveConfig;
  329. var
  330.   S: PBufStream;
  331. begin
  332.   if ConfigFile = '' then ConfigFile := ConfigName;
  333.   S := New(PBufStream, Init(ConfigFile, stCreate, 1024));
  334.   S^.Write(ConfigSignature, SizeOf(ConfigSignature));
  335.   S^.Write(Settings, SizeOf(Settings));
  336.   S^.Write(ChessPalettes, SizeOf(ChessPalettes));
  337.   StoreIndexes(S^);
  338.   StoreHistory(S^);
  339.   Dispose(S, Done);
  340. end;
  341.  
  342. procedure TChessApp.ShowAbout;
  343. var
  344.   D: PDialog;
  345.   R: TRect;
  346.   Control: PView;
  347. begin
  348.   R.Assign(21, 0, 58, 11);
  349.   D := New(PDialog, Init(R, 'About'));
  350.   with D^ do
  351.   begin
  352.     Options := Options or ofCentered;
  353.  
  354.     R.Assign(1, 2, Size.X - 1, 3);
  355.     Insert(New(PStaticText, Init(R, ^C'Turbo Vision Chess Demo')));
  356.  
  357.     Inc(R.A.Y, 2); Inc(R.B.Y, 2);
  358.     Insert(New(PStaticText, Init(R, ^C'Copyright (c) 1992 by')));
  359.  
  360.     Inc(R.A.Y, 2); Inc(R.B.Y, 2);
  361.     Insert(New(PStaticText, Init(R, ^C'Borland International, Inc.')));
  362.  
  363.     R.Assign(13, 8, 23, 10);
  364.     Insert(New(PButton, Init(R, 'O~K~',cmOk, bfNormal)));
  365.   end;
  366.  
  367.   Application^.ExecView(D);
  368.   Dispose(D, Done);
  369. end;
  370.  
  371. end.
  372.