1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309:
310:
311:
312:
313:
314:
315:
316:
317:
318:
319:
320:
321:
322:
323:
324:
325:
326:
327:
328:
329:
330:
331:
332:
333:
334:
335:
336:
337:
338:
339:
340:
341:
342:
343:
344:
345:
346:
347:
348:
349:
350:
351:
352:
353:
354:
355:
356:
357:
358:
359:
360:
361:
362:
363:
364:
365:
366:
367:
368:
369:
370:
371:
372:
373:
374:
375:
376:
377:
378:
379:
380:
381:
382:
383:
384:
385:
386:
387:
388:
389:
390:
391:
392:
393:
394:
395:
396:
397:
398:
399:
400:
401:
402:
403:
404:
405:
406:
407:
408:
409:
410:
411:
412:
413:
414:
415:
416:
417:
418:
419:
420:
421:
422:
423:
424:
425:
426:
427:
428:
429:
430:
431:
432:
433:
434:
435:
436:
437:
438:
439:
440:
441:
442:
443:
444:
445:
446:
447:
448:
449:
450:
451:
452:
453:
454:
455:
456:
457:
458:
459:
460:
461:
462:
463:
464:
465:
466:
467:
468:
469:
470:
471:
472:
473:
474:
475:
476:
477:
478:
479:
480:
481:
482:
483:
484:
485:
486:
487:
488:
489:
490:
491:
492:
493:
494:
495:
496:
497:
498:
499:
500:
501:
502:
503:
504:
505:
506:
507:
508:
509:
510:
511:
512:
513:
514:
515:
516:
517:
518:
519:
520:
521:
522:
523:
524:
525:
526:
527:
528:
529:
530:
531:
532:
533:
534:
535:
536:
537:
538:
539:
540:
541:
542:
543:
544:
545:
546:
547:
548:
549:
550:
551:
552:
553:
554:
555:
556:
557:
558:
559:
560:
561:
562:
563:
564:
565:
566:
567:
568:
569:
570:
571:
572:
573:
574:
575:
576:
577:
578:
579:
580:
581:
582:
583:
584:
585:
586:
587:
588:
589:
590:
591:
592:
593:
594:
595:
596:
597:
598:
599:
600:
601:
602:
603:
604:
605:
606:
607:
608:
609:
610:
611:
612:
613:
614:
615:
616:
617:
618:
619:
620:
621:
622:
623:
624:
625:
| unit Unit1;
interface
{$WARNINGS OFF}
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, F2D_Core, F2D_Objects, DXClass, inifiles, math;
type
TForm1 = class(TForm)
DXTimer1: TDXTimer;
procedure DXTimer1Timer(Sender: TObject; LagCount: Integer);
procedure FormCreate(Sender: TObject);
function LoadStuff: Integer;
procedure FormClick(Sender: TObject);
procedure Gamesel_Control;
procedure FormDestroy(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure FormKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
private
Engine: TEngine;
public
end;
type TGame = class(TObject)
game_name: string;
Number: Integer;
Enemy1, Enemy2: string;
Player: string;
shot: string;
kind: Integer;
music: string;
BG: string;
cant_lose: Boolean;
procedure Render(pEngine: TEngine);
procedure Init;
end;
var
Form1: TForm1;
path: string;
menux, game, screen, timer, selection: Integer;
time_spent, game_num, page: Integer;
O_Quality, O_Quantity, O_QoverQ, O_Menu : TSimpleObject;
O_Player, O_Enemy1, O_Enemy2, O_Shot, O_BG: TSimpleObject;
AO_Expl: TAnimObj;
the_game: TGame;
sprites: TStringList;
musics: THashedStringList;
StuffLoaded, released: Boolean;
Buttons: array[1..6] of Boolean;
player_x_vel, shot_y_vel, enemy1_y_vel, enemy2_y_vel: single;
shot_on_its_way, enemy1_is_here, enemy2_is_here, player_alive,
enemy1_alive, enemy2_alive: Boolean;
const
game_kinds: Integer = 1;
name_kinds: Integer = 1;
player_x_maxspeed: single = 150;
player_x_acc: single = 15;
player_x_friction: single = 3;
player_x_antiphantomvel: single = 2;
shot_y_acc: single = 4;
shot_y_maxspeed: single = 200;
enemy_frequency: Integer = 250; enemy_y_acc: single = 1;
enemy_y_maxspeed: single = 250;
implementation
{$R *.dfm}
procedure StopSounds; var
i: Integer;
begin
for i := 0 to Form1.Engine.SoundManager.Sounds.Count - 1 do
Form1.Engine.SoundManager.StopSound(Form1.Engine.SoundManager.Sounds[i]);
end;
procedure TGame.Render(pEngine: TEngine);
begin
pEngine.SoundManager.StopSound('crappy_title');
pEngine.SoundManager.PlaySound(self.music, true, true);
case self.kind of
1:
begin
if player_alive then
O_Player.Draw(true);
if Buttons[3] then begin
player_x_vel := player_x_vel - player_x_acc;
end;
if Buttons[4] then begin
player_x_vel := player_x_vel + player_x_acc;
end;
if Buttons[6] and (not shot_on_its_way) then
begin
shot_on_its_way := true;
shot_y_vel := 0;
O_shot.Position.X := O_Player.Position.X;
O_Shot.Position.Y := O_Player.Position.Y - O_Player.Size.Y / 2;
end;
if Buttons[5] then begin
if AO_Expl.GetAnimation('explosion').Finished then
AO_Expl.ResetAnimation('explosion');
AO_Expl.Animation := 'explosion';
AO_Expl.Position.X := Form1.ClientWidth / 2;
AO_Expl.Position.y := Form1.ClientHeight / 2;
AO_Expl.Draw(true);
AO_Expl.Play('explosion', false);
end;
if shot_on_its_way then begin
O_Shot.Draw(true);
if shot_y_vel < shot_y_maxspeed then
shot_y_vel := shot_y_vel + shot_y_acc;
O_Shot.Position.Y := O_Shot.Position.Y - (shot_y_vel / pEngine.TimeStep) / 1000;
if O_Shot.Position.Y < -(O_Shot.Size.Y / 2) then
shot_on_its_way := false;
end;
if enemy1_is_here then
begin
if enemy1_alive then
O_Enemy1.Draw(true);
enemy1_y_vel := enemy1_y_vel + enemy_y_acc;
if enemy1_y_vel > enemy_y_maxspeed then
enemy1_y_vel := enemy_y_maxspeed;
O_Enemy1.Position.y := O_Enemy1.Position.y + (enemy1_y_vel / pEngine.TimeStep) / 1000;
if self.cant_lose then
begin
end
else begin
if (abs(O_Enemy1.Position.X - O_Player.Position.X) < (O_Player.Size.X - 15)) and
(O_Enemy1.Position.Y >= (O_Player.Position.Y)) then
begin player_x_vel := 0;
enemy1_y_vel := 0;
player_alive := false;
enemy1_alive := false;
AO_Expl.Animation := 'explosion';
AO_Expl.Position := O_Player.Position;
if AO_Expl.GetAnimation('explosion').Finished then
AO_Expl.ResetAnimation('explosion');
AO_Expl.Draw(true);
AO_Expl.Play('explosion', false);
if AO_Expl.GetAnimation('explosion').Finished then
begin
StopSounds;
menux := 1;
end;
end;
end;
if O_Enemy1.Position.Y > Form1.ClientHeight + O_Enemy1.Size.Y / 2 then
enemy1_is_here := false;
end
else if random(enemy_frequency) = 1 then
begin enemy1_is_here := true;
Form1.Caption := IntToStr(RandSeed);
O_Enemy1.Position.X := random(Form1.ClientWidth - 100) + 50;
O_Enemy1.Position.Y := 0;
enemy1_y_vel := 0;
enemy1_alive := true;
end;
if abs(player_x_vel) > player_x_antiphantomvel then
if (player_x_vel < 0) then
player_x_vel := player_x_vel + player_x_friction
else
player_x_vel := player_x_vel - player_x_friction
else
player_x_vel := 0;
if abs(player_x_vel) > player_x_maxspeed then
if player_x_vel < 0 then
player_x_vel := -1 * player_x_maxspeed
else
player_x_vel := player_x_maxspeed;
if abs(player_x_vel) > player_x_antiphantomvel then
O_Player.Position.X := O_Player.Position.X + (player_x_vel / pEngine.TimeStep) / 1000;
end;
end;
end;
procedure TGame.Init;
begin
RandSeed := self.Number;
Form1.Caption := IntToStr(RandSeed); player_alive := true;
O_Player.Texture := self.Player;
O_Enemy1.Texture := self.Enemy1;
O_Enemy2.Texture := self.Enemy2;
O_Shot.Texture := self.Shot;
O_Player.Position.X := Form1.ClientWidth / 2;
O_Player.Position.Y := 550;
player_x_vel := 0;
shot_on_its_way := false;
enemy1_is_here := false;
enemy2_is_here := false;
end;
function generate_game(Seed: Integer): TGame;
function remove_numbers(s: string): string;
var i: Integer;
begin
result := s;
for i := 0 to 9 do begin
result := StringReplace(result, IntToStr(i), '', [rfReplaceAll]);
end;
end;
var
namekind: Integer;
begin
RandSeed := 12345 * Seed;
result := TGame.Create;
result.kind := random(game_kinds - 1) + 1;
namekind := random(name_kinds - 1) + 1;
case result.kind of
1:
begin
case namekind of
1:
begin result.Player := 'x_' + sprites[random(sprites.Count - 1)];
result.Enemy1 := 'y_' + sprites[random(sprites.Count - 1)];
result.Enemy2 := 'asd';
result.Enemy2 := 'y_' + sprites[random(sprites.Count - 1)];
result.shot := 'x_' + sprites[random(sprites.Count - 1)];
result.Number := Seed;
result.cant_lose := (random(2) = 1);
result.music := musics[random(musics.Count - 1)];
result.game_name := 'The ' + copy(result.shot, 3, length(result.shot))
+ 'y ' + copy(result.Player, 3, length(result.Player)) +
' from Space and the evil ' + copy(result.Enemy1, 3, length(result.Enemy1));
result.game_name := remove_numbers(result.game_name);
end;
end;
end;
end;
end;
function TForm1.LoadStuff: Integer;
function CutExt(aStr: string): string;
var
I: Integer;
begin
Result := aStr;
for I := Length(aStr) downto 1 do
if aStr[i] = '.' then
begin
Result := Copy(aStr, 1, I - 1);
Exit;
end;
end;
var
SR: TSearchRec;
begin
result := GetTickCount;
path := ExtractFilePath(ParamStr(0));
Engine.TextureManager.AddTexturesInDir(path + 'gfx\', '*', false);
Engine.SoundManager.AddSoundsInDir(path + 'sfx\', '*', false);
O_Quantity := TSimpleObject.Create(Engine);
with O_Quantity do
begin
size.X := 800;
size.y := 600;
position.x := Clientwidth / 2;
position.y := Clientheight / 2;
texture := 'Quantity';
end;
O_QoverQ := TSimpleObject.Create(Engine);
with O_QoverQ do
begin
size.X := 800;
size.y := 600;
position.x := Clientwidth / 2;
position.y := Clientheight / 2;
texture := 'Qb4Q';
end;
O_Menu := TSimpleObject.Create(Engine);
with O_Menu do
begin
size.X := 800;
size.y := 600;
position.x := Clientwidth / 2;
position.y := Clientheight / 2;
texture := 'menu';
end;
O_Player := TSimpleObject.Create(Engine);
with O_Player do
begin
size.X := 80;
size.Y := 80;
alphatest := true;
end;
O_Enemy1 := TSimpleObject.Create(Engine);
with O_Enemy1 do
begin
size.X := 80;
size.Y := 80;
alphatest := true;
end;
O_Enemy2 := TSimpleObject.Create(Engine);
with O_Enemy2 do
begin
size.X := 80;
size.Y := 80;
alphatest := true;
end;
O_Shot := TSimpleObject.Create(Engine);
with O_Shot do
begin
size.X := 60;
size.Y := 80;
alphatest := true;
end;
O_BG := TSimpleObject.Create(Engine);
with O_BG do
begin
size.X := 800;
size.Y := 600;
position := O_Menu.position;
alphatest := true;
end;
AO_Expl := TAnimObj.Create(Engine);
AO_Expl.AddAnimation('explosion', 'explosion');
AO_Expl.AlphaTest := True;
AO_Expl.Size.X := 100;
AO_Expl.Size.Y := 100;
with AO_Expl.GetAnimation('explosion') do
begin
AnimCountY := 10;
AnimCountX := 1;
Duration := 1000;
Reset;
end;
Engine.FontManager.AddFont('default', 'Courier', 20, []);
sprites := TStringList.Create;
if FindFirst(path + 'gfx\x_*', faAnyFile - faDirectory, SR) = 0 then
try
repeat
sprites.Add(StringReplace(CutExt(SR.Name), 'x_', '', []));
until FindNext(SR) <> 0;
finally
FindClose(SR);
end;
musics := Engine.Soundmanager.Sounds;
Result := GetTickCount - Result;
StuffLoaded := true;
end;
procedure TForm1.Gamesel_Control;
begin
if released then
begin
if GetAsyncKeyState(VK_UP) < 0 then
begin
selection := selection - 1;
if selection < 1 then
selection := 1;
released := false;
end;
if GetAsyncKeyState(VK_down) < 0 then
begin
selection := selection + 1;
released := false;
end;
if GetAsyncKeyState(VK_left) < 0 then
begin
selection := selection - 10;
if selection < 1 then
selection := 1;
released := false;
end;
if GetAsyncKeyState(VK_right) < 0 then
begin
selection := selection + 10;
released := false;
end;
end
else
released := not ((GetAsyncKeyState(VK_right) < 0) or
(GetAsyncKeyState(VK_left) < 0) or
(GetAsyncKeyState(VK_down) < 0) or
(GetAsyncKeyState(VK_UP) < 0));
page := (selection - 1) div 20;
if GetAsyncKeyState(VK_RETURN) < 0 then
begin
the_game := generate_game(selection);
the_game.Init;
menux := 2;
end;
end;
procedure TForm1.DXTimer1Timer(Sender: TObject; LagCount: Integer);
var
x: Integer;
begin
Engine.DoBegin;
if (menux = 0) then begin
case screen of
0: begin
O_Quality.Draw(true);
if not StuffLoaded then
time_spent := LoadStuff;
inc(timer);
if timer > Round((2.5 - (time_spent / 1000)) / Engine.TimeStep) then
begin
timer := 0;
screen := 1;
end;
end;
1: begin
O_Quantity.Draw(true);
inc(timer);
if timer > Round(2.5 / Engine.TimeStep) then
begin
timer := 0;
screen := 2;
end;
end;
2: begin
O_QoverQ.Draw(true);
Engine.FontManager.BindFont('default', clBlack);
Engine.TextOut(ClientWidth / 2, 500, 'Press Space to select game', false, true);
if GetAsyncKeyState(VK_SPACE) < 0 then
menux := 1;
end;
end;
end;
if menux = 1 then begin
Engine.SoundManager.PlaySound('crappy_title', true, true);
O_Menu.Draw(true);
game_num := page * 20 + 1;
Gamesel_Control;
for x := 0 to 9 do
begin
if game_num = selection then
Engine.FontManager.BindFont('default', clRed)
else
Engine.FontManager.BindFont('default', clWhite);
Engine.TextOut(50, 180 + x * 31, IntToStr(game_num) + '. ' + generate_game(game_num).game_name);
inc(game_num);
end;
for x := 0 to 9 do
begin
if game_num = selection then
Engine.FontManager.BindFont('default', clRed)
else
Engine.FontManager.BindFont('default', clWhite);
Engine.TextOut(450, 180 + x * 31, IntToStr(game_num) + '. ' + generate_game(game_num).game_name);
inc(game_num);
end;
end;
if menux = 2 then begin
the_game.Render(Engine);
end;
Engine.DoEnd;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Engine := TEngine.Create(true);
ClientWidth := 800;
ClientHeight := 600;
Engine.Init(self);
Engine.TextureManager.AddTexture(ExtractFilePath(ParamStr(0)) + 'gfx\Quality.jpg', 'Quality');
O_Quality := TSimpleObject.Create(Engine);
with O_Quality do
begin
size.X := 800;
size.y := 600;
position.x := Clientwidth / 2;
position.y := Clientheight / 2;
texture := 'Quality';
end;
menux := 0;
game := 0;
screen := 0;
timer := 0;
selection := 7;
game_num := 1;
page := 0;
StuffLoaded := False;
DXTimer1.Enabled := True;
released := true;
end;
procedure TForm1.FormClick(Sender: TObject);
begin
menux := 1; end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
O_Quality.Free; sprites.Free; O_Quantity.Free;
O_QoverQ.Free;
O_Menu.Free;
Engine.Free;
end;
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if key = VK_UP then
Buttons[1] := true;
if key = VK_Down then
Buttons[2] := true;
if key = VK_left then
Buttons[3] := true;
if key = VK_right then
Buttons[4] := true;
if key = Ord('A') then
Buttons[5] := true;
if key = ord('B') then
Buttons[6] := true;
end;
procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if key = VK_UP then
Buttons[1] := false;
if key = VK_Down then
Buttons[2] := false;
if key = VK_left then
Buttons[3] := false;
if key = VK_right then
Buttons[4] := false;
if key = Ord('A') then
Buttons[5] := false;
if key = ord('B') then
Buttons[6] := false;
end;
end. |
JayEff hat folgendes geschrieben 
: