Login | ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/plumbers/trunk/FileFormat/Delphi/GameBinStruct.pas
Revision: 12
Committed: Wed Oct 4 21:37:56 2017 UTC (4 years ago) by daniel-marschall
Content type: text/x-pascal
File size: 11957 byte(s)

File Contents

# Content
1 unit GameBinStruct;
2
3 {$A-}
4
5 interface
6
7 const
8 SCENEID_PREVDECISION = -1;
9 SCENEID_ENDGAME = 32767;
10
11 SEGMENT_BEGINNING = 0;
12 SEGMENT_DECISION = 1;
13
14 type
15 PCoord = ^TCoord;
16 TCoord = packed record
17 x: Word;
18 y: Word;
19 end;
20
21 PActionDef = ^TActionDef;
22 TActionDef = packed record
23 scoreDelta: Integer;
24 nextSceneID: SmallInt; // will jump to the scene with the name "SCxx",
25 // where xx stands for nextSceneID (2 digits at least)
26 // 7FFF (32767) = end game
27 // FFFF ( -1) = go back to the last decision
28 sceneSegment: SmallInt; // 0 = scene from beginning, 1 = decision page
29 cHotspotTopLeft: TCoord;
30 cHotspotBottomRight: TCoord;
31 end;
32
33 PAnsiFileName = ^TAnsiFileName;
34 TAnsiFileName = array[0..13] of AnsiChar;
35
36 PSceneDef = ^TSceneDef;
37 TSceneDef = packed record
38 numPics: Word;
39 pictureIndex: Word;
40 numActions: Word;
41 szSceneFolder: TAnsiFileName; // Foldername *must* be "SCxx" (case sensitive) where xx stands for a 2 digit ID
42 szDialogWav: TAnsiFileName;
43 szDecisionBmp: TAnsiFileName;
44 actions: array[0..2] of TActionDef;
45 end;
46
47 PPictureDef = ^TPictureDef;
48 TPictureDef = packed record
49 duration: Word; // deciseconds
50 szBitmapFile: TAnsiFileName;
51 end;
52
53 PGameBinFile = ^TGameBinFile;
54 TGameBinFile = packed record
55 unknown1: array[0..6] of Word;
56 numScenes: Word;
57 numPics: Word;
58 unknown2: array[0..1] of Word;
59 scenes: array[0..99] of TSceneDef; // Scenes start at 0x0016
60 pictures: array[0..1999] of TPictureDef; // Pictures start at 0x2596
61
62 class function MaxSceneCount: integer; static;
63 class function MaxPictureCount: integer; static;
64
65 function AddSceneAtEnd(SceneID: integer): PSceneDef;
66 function FindScene(SceneID: integer): PSceneDef;
67 function FindSceneIndex(SceneID: integer): integer;
68 procedure DeleteScene(SceneIndex: integer);
69 procedure SwapScene(IndexA, IndexB: integer);
70 procedure DeletePicture(PictureIndex: integer);
71 procedure SwapPicture(IndexA, IndexB: integer);
72 function AddPictureBetween(Index: integer; assignToUpperScene: boolean=true): PPictureDef;
73 function RealPictureCount: integer;
74 function RealActionCount: integer;
75 function Defrag(OnlyCheck: boolean=false): boolean;
76 function BiggestUsedPictureIndex: integer;
77 end;
78
79 procedure _WriteStringToFilename(x: PAnsiFileName; s: AnsiString);
80
81 implementation
82
83 uses
84 Windows, SysUtils, Math;
85
86 procedure _WriteStringToFilename(x: PAnsiFileName; s: AnsiString);
87 begin
88 ZeroMemory(x, Length(x^));
89 StrPLCopy(x^, s, Length(x^));
90 end;
91
92 { TGameBinFile }
93
94 function TGameBinFile.BiggestUsedPictureIndex: integer;
95 var
96 iScene, candidate: integer;
97 begin
98 result := -1;
99 for iScene := 0 to Self.numScenes - 1 do
100 begin
101 candidate := Self.scenes[iScene].pictureIndex + Self.scenes[iScene].numPics - 1;
102 if candidate > result then result := candidate;
103 end;
104 end;
105
106 resourcestring
107 S_INVALID_SCENE_ID = 'Invalid scene ID';
108
109 function TGameBinFile.AddSceneAtEnd(SceneID: integer): PSceneDef;
110 resourcestring
111 S_SCENE_FULL = 'Not enough space for another scene';
112 begin
113 if Self.numScenes >= Length(Self.scenes) then raise Exception.Create(S_SCENE_FULL);
114 if SceneID = $7FFF {Terminate program} then raise Exception.Create(S_INVALID_SCENE_ID);
115 if SceneID = $FFFF {Previous decision} then raise Exception.Create(S_INVALID_SCENE_ID);
116 result := @Self.scenes[Self.numScenes];
117 ZeroMemory(result, SizeOf(TSceneDef));
118 _WriteStringToFilename(@result.szSceneFolder, AnsiString(Format('SC%.2d', [sceneID])));
119 Inc(Self.numScenes);
120 end;
121
122 function TGameBinFile.FindSceneIndex(SceneID: integer): integer;
123 var
124 i: integer;
125 begin
126 if SceneID = $7FFF {Terminate program} then raise Exception.Create(S_INVALID_SCENE_ID);
127 if SceneID = $FFFF {Previous decision} then raise Exception.Create(S_INVALID_SCENE_ID);
128 for i := 0 to Self.numScenes - 1 do
129 begin
130 if Self.scenes[i].szSceneFolder = Format('SC%.2d', [SceneID]) then
131 begin
132 result := i;
133 exit;
134 end;
135 end;
136 result := -1;
137 end;
138
139 function TGameBinFile.FindScene(SceneID: integer): PSceneDef;
140 var
141 idx: integer;
142 begin
143 idx := FindSceneIndex(SceneID);
144 if idx >= 0 then
145 result := @Self.scenes[idx]
146 else
147 result := nil;
148 end;
149
150 procedure TGameBinFile.DeleteScene(SceneIndex: integer);
151 resourcestring
152 S_INVALID_SC_IDX = 'Invalid scene index';
153 begin
154 if ((SceneIndex < 0) or (SceneIndex >= Length(Self.scenes))) then raise Exception.Create(S_INVALID_SC_IDX);
155 If SceneIndex < Length(Self.scenes)-1 then
156 begin
157 CopyMemory(@Self.scenes[SceneIndex], @Self.scenes[SceneIndex+1], (Length(Self.scenes)-SceneIndex-1)*SizeOf(TSceneDef));
158 end;
159 ZeroMemory(@Self.scenes[Length(Self.scenes)-1], SizeOf(TSceneDef));
160 Dec(Self.numScenes);
161 end;
162
163 class function TGameBinFile.MaxPictureCount: integer;
164 var
165 dummy: TGameBinFile;
166 begin
167 dummy.numScenes := 1; // avoid compiler give a warning
168 result := Length(dummy.pictures);
169 end;
170
171 class function TGameBinFile.MaxSceneCount: integer;
172 var
173 dummy: TGameBinFile;
174 begin
175 dummy.numScenes := 1; // avoid compiler give a warning
176 result := Length(dummy.scenes);
177 end;
178
179 function TGameBinFile.RealActionCount: integer;
180 var
181 iScene: integer;
182 begin
183 result := 0;
184 for iScene := 0 to Self.numScenes - 1 do
185 begin
186 result := result + Self.scenes[iScene].numActions;
187 end;
188 end;
189
190 function TGameBinFile.RealPictureCount: integer;
191 var
192 iScene: integer;
193 begin
194 result := 0;
195 for iScene := 0 to Self.numScenes - 1 do
196 begin
197 result := result + Self.scenes[iScene].numPics;
198 end;
199 end;
200
201 procedure TGameBinFile.SwapScene(IndexA, IndexB: integer);
202 var
203 bakScene: TSceneDef;
204 begin
205 if IndexA = IndexB then exit;
206 if ((Min(IndexA, IndexB) < 0) or (Max(IndexA, IndexB) >= Length(Self.scenes))) then raise Exception.Create('Invalid scene index');
207 CopyMemory(@bakScene, @Self.scenes[IndexA], SizeOf(TSceneDef));
208 CopyMemory(@Self.scenes[IndexA], @Self.scenes[IndexB], SizeOf(TSceneDef));
209 CopyMemory(@Self.scenes[IndexB], @bakScene, SizeOf(TSceneDef));
210 end;
211
212 function TGameBinFile.Defrag(OnlyCheck: boolean=false): boolean;
213 var
214 iPicture, iScene, iScene2: integer;
215 isGap: boolean;
216 begin
217 result := false;
218 for iPicture := MaxPictureCount - 1 downto 0 do
219 begin
220 isGap := true;
221 for iScene := 0 to Self.numScenes - 1 do
222 begin
223 if (iPicture >= Self.scenes[iScene].pictureIndex) and
224 (iPicture <= Self.scenes[iScene].pictureIndex + Self.scenes[iScene].numPics - 1) then
225 begin
226 isGap := false;
227 break;
228 end;
229 end;
230 if isGap then
231 begin
232 result := true;
233 if not OnlyCheck then
234 begin
235 {$REGION 'Close the gap'}
236 for iScene2 := 0 to Self.numScenes - 1 do
237 begin
238 if (iPicture < Self.scenes[iScene2].pictureIndex) then
239 begin
240 Dec(Self.scenes[iScene2].pictureIndex);
241 end;
242 end;
243 CopyMemory(@Self.pictures[iPicture], @Self.pictures[iPicture+1], (Length(Self.pictures)-iPicture-1)*SizeOf(TPictureDef));
244 ZeroMemory(@Self.pictures[Length(Self.pictures)-1], SizeOf(TPictureDef));
245 {$ENDREGION}
246 end;
247 end;
248 end;
249 end;
250
251 procedure TGameBinFile.DeletePicture(PictureIndex: integer);
252 var
253 iScene, iScene2: integer;
254 protection: integer; // prevents that two scenes get the same picture index when all pictures in a scene are deleted
255 begin
256 if (PictureIndex < 0) or (PictureIndex >= Length(Self.pictures)) then raise Exception.Create('Invalid picture index');
257
258 protection := 0;
259 for iScene := 0 to Self.numScenes-1 do
260 begin
261 if (PictureIndex >= Self.scenes[iScene].pictureIndex) and
262 (PictureIndex <= Self.scenes[iScene].pictureIndex + Self.scenes[iScene].numPics - 1) then
263 begin
264 Dec(Self.scenes[iScene].numPics);
265 if Self.scenes[iScene].numPics = 0 then
266 begin
267 for iScene2 := 0 to Self.numScenes-1 do
268 begin
269 if Self.scenes[iScene2].pictureIndex = PictureIndex+1 then
270 begin
271 protection := 1;
272 break;
273 end;
274 end;
275 end;
276 end
277 else if (PictureIndex+protection < Self.scenes[iScene].pictureIndex) then
278 begin
279 Dec(Self.scenes[iScene].pictureIndex);
280 end;
281 end;
282
283 If (PictureIndex < Length(Self.pictures)-1) and (protection = 0) then
284 begin
285 CopyMemory(@Self.pictures[PictureIndex], @Self.pictures[PictureIndex+1], (Length(Self.pictures)-PictureIndex-1)*SizeOf(TPictureDef));
286 ZeroMemory(@Self.pictures[Length(Self.pictures)-1], SizeOf(TPictureDef));
287 end;
288
289 Dec(Self.numPics);
290 end;
291
292 procedure TGameBinFile.SwapPicture(IndexA, IndexB: integer);
293 var
294 bakPicture: TPictureDef;
295 begin
296 // QUE: should we forbid that a picture between "scene borders" are swapped?
297
298 if IndexA = IndexB then exit;
299 if ((Min(IndexA, IndexB) < 0) or (Max(IndexA, IndexB) >= Length(Self.pictures))) then raise Exception.Create('Invalid picture index');
300
301 CopyMemory(@bakPicture, @Self.pictures[IndexA], SizeOf(TPictureDef));
302 CopyMemory(@Self.pictures[IndexA], @Self.pictures[IndexB], SizeOf(TPictureDef));
303 CopyMemory(@Self.pictures[IndexB], @bakPicture, SizeOf(TPictureDef));
304 end;
305
306 function TGameBinFile.AddPictureBetween(Index: integer; assignToUpperScene: boolean=true): PPictureDef;
307
308 function _HasBuffer(Index: integer): boolean;
309 var
310 iScene: integer;
311 begin
312 for iScene := 0 to Self.numScenes-1 do
313 begin
314 if Self.scenes[iScene].pictureIndex = Index+1 then
315 begin
316 result := true;
317 exit;
318 end;
319 end;
320 result := false;
321 end;
322
323 resourcestring
324 S_INVALID_PIC_IDX = 'Invalid picture index';
325 S_PIC_FULL_DEFRAG = 'Not enough space for another picture. Please defrag to fill the gaps first.';
326 S_PIC_FULL = 'Not enough space for another picture. Maximum limit reached.';
327 var
328 iScene: integer;
329 begin
330 if ((Index < 0) or (Index >= Length(Self.pictures))) then raise Exception.Create(S_INVALID_PIC_IDX);
331
332 if (BiggestUsedPictureIndex = MaxPictureCount-1) and Defrag(true) then
333 raise Exception.Create(S_PIC_FULL_DEFRAG);
334
335 if Self.numPics >= MaxPictureCount then
336 raise Exception.Create(S_PIC_FULL);
337
338 if assignToUpperScene then
339 begin
340 // Sc1 Sc2 Sc1 Sc2
341 // A B | C ==> A B | X C
342 // ^
343 for iScene := 0 to Self.numScenes-1 do
344 begin
345 if (Index >= Self.scenes[iScene].pictureIndex) and
346 (index <= Self.scenes[iScene].pictureIndex + Max(0,Self.scenes[iScene].numPics - 1)) then
347 begin
348 Inc(Self.scenes[iScene].numPics);
349 end
350 else if (index < Self.scenes[iScene].pictureIndex) and not _HasBuffer(index) then
351 begin
352 Inc(Self.scenes[iScene].pictureIndex);
353 end;
354 end;
355 end
356 else
357 begin
358 // Sc1 Sc2 Sc1 Sc2
359 // A B | C ==> A B X | C
360 // ^
361 for iScene := 0 to Self.numScenes-1 do
362 begin
363 if (Index >= 1 + Self.scenes[iScene].pictureIndex) and
364 (index <= 1 + Self.scenes[iScene].pictureIndex + Max(0,Self.scenes[iScene].numPics-1)) then
365 begin
366 Inc(Self.scenes[iScene].numPics);
367 end
368 else if (index <= Self.scenes[iScene].pictureIndex) and not _HasBuffer(index) then
369 begin
370 Inc(Self.scenes[iScene].pictureIndex);
371 end;
372 end;
373 end;
374
375 result := @Self.pictures[Index];
376 if not _HasBuffer(index) then
377 begin
378 CopyMemory(@Self.pictures[Index+1], result, (Length(Self.pictures)-Index-1)*SizeOf(TPictureDef));
379 end;
380
381 ZeroMemory(result, SizeOf(TPictureDef));
382
383 Inc(Self.numPics);
384 end;
385
386 end.