Login | ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/plumbers/trunk/Win32_Player/Game.pas
Revision: 24
Committed: Mon Jun 29 08:31:03 2020 UTC (2 years, 4 months ago) by daniel-marschall
Content type: text/x-pascal
File size: 6542 byte(s)
Log Message:
Release compiled version (Win95 compatible)

File Contents

# Content
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;
25 TWaitCallback = function(Game: TGame; AMilliseconds: Cardinal): boolean of object;
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;
39 FCurDecisionScene: PSceneDef;
40 FPrevDecisionScene: PSceneDef;
41 procedure TryExit;
42 procedure PrevDecisionScene;
43 protected
44 GameData: TGameBinFile;
45 function Wait(AMilliseconds: integer): boolean;
46 procedure PlayScene(scene: PSceneDef; goToDecision: boolean);
47 function WavePrefix: string;
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
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
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
106 if Assigned(FPrevDecisionScene) then PlayScene(FPrevDecisionScene, true)
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
120 nextScene := GameData.FindScene(action^.nextSceneID);
121 if Assigned(nextScene) then
122 PlayScene(nextScene, action^.sceneSegment=SEGMENT_DECISION)
123 (*
124 else
125 raise Exception.CreateFmt('Scene %d was not found in GAME.BIN', [action^.nextSceneID]);
126 *)
127 end;
128 end;
129
130 function TGame.Wait(AMilliseconds: integer): boolean;
131 begin
132 if Assigned(WaitCallback) then
133 begin
134 result := WaitCallback(Self, AMilliseconds)
135 end
136 else
137 begin
138 Sleep(AMilliseconds);
139 result := false; // don't cancel
140 end;
141 end;
142
143 function TGame.WavePrefix: string;
144 begin
145 if Supports16BitWaveout then
146 result := ''
147 else
148 result := 'E';
149 end;
150
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) +
165 scene^.szSceneFolder + PathDelim + WavePrefix + scene^.szDialogWav);
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;
174 if Wait(GameData.pictures[i].duration * 100) then
175 begin
176 // Wait was cancelled by VK_RETURN
177 AsyncSoundCallback(Self, '');
178 break;
179 end;
180 if Application.Terminated then Abort;
181 end;
182 end;
183 if scene^.szDecisionBmp <> '' then
184 begin
185 FPrevDecisionScene := FCurDecisionScene;
186 FCurDecisionScene := scene;
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.