WebSVN – plumbers – Diff – /trunk/Win32_Player/Game.pas


unit Game;
 
interface
 
uses
  SysUtils, Classes, Forms, GameBinStruct;
 
type
  TPictureType = (ptDia, ptDecision);
 
  THotspotIndex = 0..2;
 
  TGame = class;
  PHotspot = ^THotspot;
  THotspot = record
    game: TGame;
    lpAction: PActionDef;
    cHotspotTopLeft: TCoord;
    cHotspotBottomRight: TCoord;
  end;
 
  TShowPictureCallback = procedure(Game: TGame; AFilename: string; AType: TPictureType) of object;
  TPlaySoundCallback = procedure(Game: TGame; AFilename: string) of object;
  TSimpleCallback = procedure(Game: TGame) of object;
  TWaitCallback = function(Game: TGame; AMilliseconds: integer): boolean of object;
  TSetHotspotCallback = procedure(Game: TGame; AIndex: THotspotIndex; AHotspot: THotspot) of object;
  TClearHotspotsCallback = procedure(Game: TGame) of object;
 
  TGame = class(TObject)
  private
    FPictureShowCallback: TShowPictureCallback;
    FAsyncSoundCallback: TPlaySoundCallback;
    FExitCallback: TSimpleCallback;
    FWaitCallback: TWaitCallback;
    FSetHotspotCallback: TSetHotspotCallback;
    FClearHotspotsCallback: TClearHotspotsCallback;
    FDirectory: string;
    FScore: integer;
    CurDecisionScene, PrevDecisionScene: PSceneDef;
    procedure TryExit;
    procedure PrevDecisionScene;
  protected
    GameData: TGameBinFile;
    function Wait(AMilliseconds: integer): boolean;
    procedure PlayScene(scene: PSceneDef; goToDecision: boolean);
  public
    procedure PerformAction(action: PActionDef);
    property PictureShowCallback: TShowPictureCallback read FPictureShowCallback write FPictureShowCallback;
    property AsyncSoundCallback: TPlaySoundCallback read FAsyncSoundCallback write FAsyncSoundCallback;
    property ExitCallback: TSimpleCallback read FExitCallback write FExitCallback;
    property WaitCallback: TWaitCallback read FWaitCallback write FWaitCallback;
    property SetHotspotCallback: TSetHotspotCallback read FSetHotspotCallback write FSetHotspotCallback;
    property ClearHotspotsCallback: TClearHotspotsCallback read FClearHotspotsCallback write FClearHotspotsCallback;
    property Directory: string read FDirectory;
    property Score: integer read FScore;
    constructor Create(ADirectory: string);
    procedure Run;
  end;
 
implementation
 
{ TGame }
 
constructor TGame.Create(ADirectory: string);
var
  fs: TFileStream;
  gameBinFilename: string;
begin
  FDirectory := ADirectory;
 
  gameBinFilename := IncludeTrailingPathDelimiter(ADirectory) + 'GAME.BIN';
  if not FileExists(gameBinFilename) then
  begin
    raise Exception.Create('Cannot find GAME.BIN');
  end;
 
  fs := TFileStream.Create(gameBinFilename, fmOpenRead);
  try
    fs.ReadBuffer(GameData, SizeOf(GameData));
  finally
    FreeAndNil(fs);
  end;
end;
 
procedure TGame.TryExit;
begin
  if Assigned(ExitCallback) then ExitCallback(Self);
end;
 
procedure TGame.PrevDecisionScene;
begin
  if Assigned(PrevDecisionScene) then PlayScene(PrevDecisionScene, true)
end;
 
procedure TGame.PerformAction(action: PActionDef);
var
  nextScene: PSceneDef;
begin
  Inc(FScore, action^.scoreDelta);
  if action^.nextSceneID = SCENEID_PREVDECISION then
    PrevDecisionScene
  else if action^.nextSceneID = SCENEID_ENDGAME then
    TryExit
  else
  begin
    nextScene := GameData.FindScene(action^.nextSceneID);
    if Assigned(nextScene) then
      PlayScene(nextScene, action^.sceneSegment=SEGMENT_DECISION)
    (*
    else
      raise Exception.CreateFmt('Scene %d was not found in GAME.BIN', [action^.nextSceneID]);
    *)
  end;
end;
 
function TGame.Wait(AMilliseconds: integer): boolean;
begin
  if Assigned(WaitCallback) then
  begin
    result := WaitCallback(Self, AMilliseconds)
  end
  else
  begin
    Sleep(AMilliseconds);
    result := false; // don't cancel
  end;
end;
 
procedure TGame.PlayScene(scene: PSceneDef; goToDecision: boolean);
var
  i: integer;
  hotspot: THotspot;
begin
  if Assigned(ClearHotspotsCallback) then
  begin
    ClearHotspotsCallback(Self);
  end;
  if not goToDecision then
  begin
    if Assigned(AsyncSoundCallback) then
    begin
      AsyncSoundCallback(Self, IncludeTrailingPathDelimiter(FDirectory) +
        scene^.szSceneFolder + PathDelim + scene^.szDialogWav);
    end;
    for i := scene^.pictureIndex to scene^.pictureIndex + scene^.numPics - 1 do
    begin
      if Assigned(PictureShowCallback) then
      begin
        PictureShowCallback(Self, IncludeTrailingPathDelimiter(FDirectory) +
          scene^.szSceneFolder + PathDelim + GameData.pictures[i].szBitmapFile, ptDia);
      end;
      if Wait(GameData.pictures[i].duration * 100) then
      begin
        AsyncSoundCallback(Self, '');
        break;
      end;
      if Application.Terminated then Abort;
    end;
  end;
  if scene^.szDecisionBmp <> '' then
  begin
    PrevDecisionScene := CurDecisionScene;
    CurDecisionScene := scene;
    if Assigned(PictureShowCallback) then
    begin
      PictureShowCallback(Self, IncludeTrailingPathDelimiter(FDirectory) +
        scene^.szSceneFolder + PathDelim + scene^.szDecisionBmp, ptDecision);
    end;
    if Assigned(SetHotspotCallback) then
    begin
      for i := 0 to scene^.numActions - 1 do
      begin
        hotspot.Game := Self;
        hotspot.lpAction := @scene^.actions[i];
        hotspot.cHotspotTopLeft.X := scene^.actions[i].cHotspotTopLeft.X;
        hotspot.cHotspotTopLeft.Y := scene^.actions[i].cHotspotTopLeft.Y;
        hotspot.cHotspotBottomRight.X := scene^.actions[i].cHotspotBottomRight.X;
        hotspot.cHotspotBottomRight.Y := scene^.actions[i].cHotspotBottomRight.Y;        
        SetHotspotCallback(Self, i, hotspot);
      end;
    end;
  end
  else
  begin
    if scene^.numActions > 0 then PerformAction(@scene^.actions[0]);
  end;
end;
 
procedure TGame.Run;
begin
  if GameData.numScenes = 0 then exit;
  PlayScene(@GameData.Scenes[0], false);
end;
 
end.
 

Rev 19	Rev 20
1	unit Game;	1	unit Game;
2		2
3	interface	3	interface
4		4
5	uses	5	uses
6	SysUtils, Classes, Forms, GameBinStruct;	6	SysUtils, Classes, Forms, GameBinStruct;
7		7
8	type	8	type
9	TPictureType = (ptDia, ptDecision);	9	TPictureType = (ptDia, ptDecision);
10		10
11	THotspotIndex = 0..2;	11	THotspotIndex = 0..2;
12		12
13	TGame = class;	13	TGame = class;
14	PHotspot = ^THotspot;	14	PHotspot = ^THotspot;
15	THotspot = record	15	THotspot = record
16	game: TGame;	16	game: TGame;
17	lpAction: PActionDef;	17	lpAction: PActionDef;
18	cHotspotTopLeft: TCoord;	18	cHotspotTopLeft: TCoord;
19	cHotspotBottomRight: TCoord;	19	cHotspotBottomRight: TCoord;
20	end;	20	end;
21		21
22	TShowPictureCallback = procedure(Game: TGame; AFilename: string; AType: TPictureType) of object;	22	TShowPictureCallback = procedure(Game: TGame; AFilename: string; AType: TPictureType) of object;
23	TPlaySoundCallback = procedure(Game: TGame; AFilename: string) of object;	23	TPlaySoundCallback = procedure(Game: TGame; AFilename: string) of object;
24	TSimpleCallback = procedure(Game: TGame) of object;	24	TSimpleCallback = procedure(Game: TGame) of object;
25	TWaitCallback = function(Game: TGame; AMilliseconds: integer): boolean of object;	25	TWaitCallback = function(Game: TGame; AMilliseconds: integer): boolean of object;
26	TSetHotspotCallback = procedure(Game: TGame; AIndex: THotspotIndex; AHotspot: THotspot) of object;	26	TSetHotspotCallback = procedure(Game: TGame; AIndex: THotspotIndex; AHotspot: THotspot) of object;
27	TClearHotspotsCallback = procedure(Game: TGame) of object;	27	TClearHotspotsCallback = procedure(Game: TGame) of object;
28		28
29	TGame = class(TObject)	29	TGame = class(TObject)
30	private	30	private
31	FPictureShowCallback: TShowPictureCallback;	31	FPictureShowCallback: TShowPictureCallback;
32	FAsyncSoundCallback: TPlaySoundCallback;	32	FAsyncSoundCallback: TPlaySoundCallback;
33	FExitCallback: TSimpleCallback;	33	FExitCallback: TSimpleCallback;
34	FWaitCallback: TWaitCallback;	34	FWaitCallback: TWaitCallback;
35	FSetHotspotCallback: TSetHotspotCallback;	35	FSetHotspotCallback: TSetHotspotCallback;
36	FClearHotspotsCallback: TClearHotspotsCallback;	36	FClearHotspotsCallback: TClearHotspotsCallback;
37	FDirectory: string;	37	FDirectory: string;
38	FScore: integer;	38	FScore: integer;
39	CurDecisionScene, LastDecisionScene: PSceneDef;	39	CurDecisionScene, PrevDecisionScene: PSceneDef;
40	procedure TryExit;	40	procedure TryExit;
41	procedure PrevDecisionScene;	41	procedure PrevDecisionScene;
42	protected	42	protected
43	GameData: TGameBinFile;	43	GameData: TGameBinFile;
44	function Wait(AMilliseconds: integer): boolean;	44	function Wait(AMilliseconds: integer): boolean;
45	procedure PlayScene(scene: PSceneDef; goToDecision: boolean);	45	procedure PlayScene(scene: PSceneDef; goToDecision: boolean);
46	public	46	public
47	procedure PerformAction(action: PActionDef);	47	procedure PerformAction(action: PActionDef);
48	property PictureShowCallback: TShowPictureCallback read FPictureShowCallback write FPictureShowCallback;	48	property PictureShowCallback: TShowPictureCallback read FPictureShowCallback write FPictureShowCallback;
49	property AsyncSoundCallback: TPlaySoundCallback read FAsyncSoundCallback write FAsyncSoundCallback;	49	property AsyncSoundCallback: TPlaySoundCallback read FAsyncSoundCallback write FAsyncSoundCallback;
50	property ExitCallback: TSimpleCallback read FExitCallback write FExitCallback;	50	property ExitCallback: TSimpleCallback read FExitCallback write FExitCallback;
51	property WaitCallback: TWaitCallback read FWaitCallback write FWaitCallback;	51	property WaitCallback: TWaitCallback read FWaitCallback write FWaitCallback;
52	property SetHotspotCallback: TSetHotspotCallback read FSetHotspotCallback write FSetHotspotCallback;	52	property SetHotspotCallback: TSetHotspotCallback read FSetHotspotCallback write FSetHotspotCallback;
53	property ClearHotspotsCallback: TClearHotspotsCallback read FClearHotspotsCallback write FClearHotspotsCallback;	53	property ClearHotspotsCallback: TClearHotspotsCallback read FClearHotspotsCallback write FClearHotspotsCallback;
54	property Directory: string read FDirectory;	54	property Directory: string read FDirectory;
55	property Score: integer read FScore;	55	property Score: integer read FScore;
56	constructor Create(ADirectory: string);	56	constructor Create(ADirectory: string);
57	procedure Run;	57	procedure Run;
58	end;	58	end;
59		59
60	implementation	60	implementation
61		61
62	{ TGame }	62	{ TGame }
63		63
64	constructor TGame.Create(ADirectory: string);	64	constructor TGame.Create(ADirectory: string);
65	var	65	var
66	fs: TFileStream;	66	fs: TFileStream;
67	gameBinFilename: string;	67	gameBinFilename: string;
68	begin	68	begin
69	FDirectory := ADirectory;	69	FDirectory := ADirectory;
70		70
71	gameBinFilename := IncludeTrailingPathDelimiter(ADirectory) + 'GAME.BIN';	71	gameBinFilename := IncludeTrailingPathDelimiter(ADirectory) + 'GAME.BIN';
72	if not FileExists(gameBinFilename) then	72	if not FileExists(gameBinFilename) then
73	begin	73	begin
74	raise Exception.Create('Cannot find GAME.BIN');	74	raise Exception.Create('Cannot find GAME.BIN');
75	end;	75	end;
76		76
77	fs := TFileStream.Create(gameBinFilename, fmOpenRead);	77	fs := TFileStream.Create(gameBinFilename, fmOpenRead);
78	try	78	try
79	fs.ReadBuffer(GameData, SizeOf(GameData));	79	fs.ReadBuffer(GameData, SizeOf(GameData));
80	finally	80	finally
81	FreeAndNil(fs);	81	FreeAndNil(fs);
82	end;	82	end;
83	end;	83	end;
84		84
85	procedure TGame.TryExit;	85	procedure TGame.TryExit;
86	begin	86	begin
87	if Assigned(ExitCallback) then ExitCallback(Self);	87	if Assigned(ExitCallback) then ExitCallback(Self);
88	end;	88	end;
89		89
90	procedure TGame.PrevDecisionScene;	90	procedure TGame.PrevDecisionScene;
91	begin	91	begin
92	if Assigned(LastDecisionScene) then PlayScene(LastDecisionScene, true)	92	if Assigned(PrevDecisionScene) then PlayScene(PrevDecisionScene, true)
93	end;	93	end;
94		94
95	procedure TGame.PerformAction(action: PActionDef);	95	procedure TGame.PerformAction(action: PActionDef);
96	var	96	var
97	nextScene: PSceneDef;	97	nextScene: PSceneDef;
98	begin	98	begin
99	Inc(FScore, action^.scoreDelta);	99	Inc(FScore, action^.scoreDelta);
100	if action^.nextSceneID = SCENEID_PREVDECISION then	100	if action^.nextSceneID = SCENEID_PREVDECISION then
101	PrevDecisionScene	101	PrevDecisionScene
102	else if action^.nextSceneID = SCENEID_ENDGAME then	102	else if action^.nextSceneID = SCENEID_ENDGAME then
103	TryExit	103	TryExit
104	else	104	else
105	begin	105	begin
106	nextScene := GameData.FindScene(action^.nextSceneID);	106	nextScene := GameData.FindScene(action^.nextSceneID);
107	if Assigned(nextScene) then	107	if Assigned(nextScene) then
108	PlayScene(nextScene, action^.sceneSegment=SEGMENT_DECISION)	108	PlayScene(nextScene, action^.sceneSegment=SEGMENT_DECISION)
109	(*	109	(*
110	else	110	else
111	raise Exception.CreateFmt('Scene %d was not found in GAME.BIN', [action^.nextSceneID]);	111	raise Exception.CreateFmt('Scene %d was not found in GAME.BIN', [action^.nextSceneID]);
112	*)	112	*)
113	end;	113	end;
114	end;	114	end;
115		115
116	function TGame.Wait(AMilliseconds: integer): boolean;	116	function TGame.Wait(AMilliseconds: integer): boolean;
117	begin	117	begin
118	if Assigned(WaitCallback) then	118	if Assigned(WaitCallback) then
119	begin	119	begin
120	result := WaitCallback(Self, AMilliseconds)	120	result := WaitCallback(Self, AMilliseconds)
121	end	121	end
122	else	122	else
123	begin	123	begin
124	Sleep(AMilliseconds);	124	Sleep(AMilliseconds);
125	result := false; // don't cancel	125	result := false; // don't cancel
126	end;	126	end;
127	end;	127	end;
128		128
129	procedure TGame.PlayScene(scene: PSceneDef; goToDecision: boolean);	129	procedure TGame.PlayScene(scene: PSceneDef; goToDecision: boolean);
130	var	130	var
131	i: integer;	131	i: integer;
132	hotspot: THotspot;	132	hotspot: THotspot;
133	begin	133	begin
134	if Assigned(ClearHotspotsCallback) then	134	if Assigned(ClearHotspotsCallback) then
135	begin	135	begin
136	ClearHotspotsCallback(Self);	136	ClearHotspotsCallback(Self);
137	end;	137	end;
138	if not goToDecision then	138	if not goToDecision then
139	begin	139	begin
140	if Assigned(AsyncSoundCallback) then	140	if Assigned(AsyncSoundCallback) then
141	begin	141	begin
142	AsyncSoundCallback(Self, IncludeTrailingPathDelimiter(FDirectory) +	142	AsyncSoundCallback(Self, IncludeTrailingPathDelimiter(FDirectory) +
143	scene^.szSceneFolder + PathDelim + scene^.szDialogWav);	143	scene^.szSceneFolder + PathDelim + scene^.szDialogWav);
144	end;	144	end;
145	for i := scene^.pictureIndex to scene^.pictureIndex + scene^.numPics - 1 do	145	for i := scene^.pictureIndex to scene^.pictureIndex + scene^.numPics - 1 do
146	begin	146	begin
147	if Assigned(PictureShowCallback) then	147	if Assigned(PictureShowCallback) then
148	begin	148	begin
149	PictureShowCallback(Self, IncludeTrailingPathDelimiter(FDirectory) +	149	PictureShowCallback(Self, IncludeTrailingPathDelimiter(FDirectory) +
150	scene^.szSceneFolder + PathDelim + GameData.pictures[i].szBitmapFile, ptDia);	150	scene^.szSceneFolder + PathDelim + GameData.pictures[i].szBitmapFile, ptDia);
151	end;	151	end;
152	if Wait(GameData.pictures[i].duration * 100) then	152	if Wait(GameData.pictures[i].duration * 100) then
153	begin	153	begin
154	AsyncSoundCallback(Self, '');	154	AsyncSoundCallback(Self, '');
155	break;	155	break;
156	end;	156	end;
157	if Application.Terminated then Abort;	157	if Application.Terminated then Abort;
158	end;	158	end;
159	end;	159	end;
160	if scene^.szDecisionBmp <> '' then	160	if scene^.szDecisionBmp <> '' then
161	begin	161	begin
162	LastDecisionScene := CurDecisionScene;	162	PrevDecisionScene := CurDecisionScene;
163	CurDecisionScene := scene;	163	CurDecisionScene := scene;
164	if Assigned(PictureShowCallback) then	164	if Assigned(PictureShowCallback) then
165	begin	165	begin
166	PictureShowCallback(Self, IncludeTrailingPathDelimiter(FDirectory) +	166	PictureShowCallback(Self, IncludeTrailingPathDelimiter(FDirectory) +
167	scene^.szSceneFolder + PathDelim + scene^.szDecisionBmp, ptDecision);	167	scene^.szSceneFolder + PathDelim + scene^.szDecisionBmp, ptDecision);
168	end;	168	end;
169	if Assigned(SetHotspotCallback) then	169	if Assigned(SetHotspotCallback) then
170	begin	170	begin
171	for i := 0 to scene^.numActions - 1 do	171	for i := 0 to scene^.numActions - 1 do
172	begin	172	begin
173	hotspot.Game := Self;	173	hotspot.Game := Self;
174	hotspot.lpAction := @scene^.actions[i];	174	hotspot.lpAction := @scene^.actions[i];
175	hotspot.cHotspotTopLeft.X := scene^.actions[i].cHotspotTopLeft.X;	175	hotspot.cHotspotTopLeft.X := scene^.actions[i].cHotspotTopLeft.X;
176	hotspot.cHotspotTopLeft.Y := scene^.actions[i].cHotspotTopLeft.Y;	176	hotspot.cHotspotTopLeft.Y := scene^.actions[i].cHotspotTopLeft.Y;
177	hotspot.cHotspotBottomRight.X := scene^.actions[i].cHotspotBottomRight.X;	177	hotspot.cHotspotBottomRight.X := scene^.actions[i].cHotspotBottomRight.X;
178	hotspot.cHotspotBottomRight.Y := scene^.actions[i].cHotspotBottomRight.Y;	178	hotspot.cHotspotBottomRight.Y := scene^.actions[i].cHotspotBottomRight.Y;
179	SetHotspotCallback(Self, i, hotspot);	179	SetHotspotCallback(Self, i, hotspot);
180	end;	180	end;
181	end;	181	end;
182	end	182	end
183	else	183	else
184	begin	184	begin
185	if scene^.numActions > 0 then PerformAction(@scene^.actions[0]);	185	if scene^.numActions > 0 then PerformAction(@scene^.actions[0]);
186	end;	186	end;
187	end;	187	end;
188		188
189	procedure TGame.Run;	189	procedure TGame.Run;
190	begin	190	begin
191	if GameData.numScenes = 0 then exit;	191	if GameData.numScenes = 0 then exit;
192	PlayScene(@GameData.Scenes[0], false);	192	PlayScene(@GameData.Scenes[0], false);
193	end;	193	end;
194		194
195	end.	195	end.
196		196

Subversion Repositories plumbers

plumbers/trunk/Win32_Player/Game.pas – Rev 19 → 20