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

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

Subversion Repositories plumbers

plumbers/trunk/Win32_Player/Game.pas – Rev 24