hedgewars/uTriggers.pas
author unc0rr
Sat, 29 Sep 2007 16:39:21 +0000
changeset 614 0e04504bc140
parent 613 e8cf72d0e0f7
child 615 b646b3c43369
permissions -rw-r--r--
- Fix some warnings - Game mode flags to let instance not delayed shotgun fire
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
589
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
     1
(*
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
     2
 * Hedgewars, a worms-like game
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
     3
 * Copyright (c) 2007 Andrey Korotaev <unC0Rr@gmail.com>
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
     4
 *
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
     5
 * This program is free software; you can redistribute it and/or modify
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
     6
 * it under the terms of the GNU General Public License as published by
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
     7
 * the Free Software Foundation; version 2 of the License
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
     8
 *
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
     9
 * This program is distributed in the hope that it will be useful,
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
    10
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
    11
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
    12
 * GNU General Public License for more details.
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
    13
 *
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
    14
 * You should have received a copy of the GNU General Public License
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
    15
 * along with this program; if not, write to the Free Software
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
    16
 * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
    17
 *)
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
    18
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
    19
unit uTriggers;
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
    20
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
    21
interface
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
    22
uses SDLh, uConsts;
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
    23
{$INCLUDE options.inc}
593
1f5e66379a43 Triggers proof-of-concept
unc0rr
parents: 589
diff changeset
    24
const trigTurns = $80000001;
589
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
    25
613
e8cf72d0e0f7 Add 'Successful finish' trigger
unc0rr
parents: 610
diff changeset
    26
type TTrigAction = (taSpawnGear, taSuccessFinish);
595
5ee863f2f568 Triggers PoC: targets are spawned right after the previous damaged
unc0rr
parents: 594
diff changeset
    27
5ee863f2f568 Triggers PoC: targets are spawned right after the previous damaged
unc0rr
parents: 594
diff changeset
    28
procedure AddTriggerSpawner(id, Ticks, Lives: Longword; X, Y: LongInt; GearType: TGearType; GearTriggerId: Longword);
613
e8cf72d0e0f7 Add 'Successful finish' trigger
unc0rr
parents: 610
diff changeset
    29
procedure AddTriggerSuccess(tId: Longword);
593
1f5e66379a43 Triggers proof-of-concept
unc0rr
parents: 589
diff changeset
    30
procedure TickTrigger(id: Longword);
589
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
    31
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
    32
implementation
610
9b5a6200f667 - Training format change
unc0rr
parents: 595
diff changeset
    33
uses uGears, uFloat, uMisc, uWorld;
589
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
    34
type PTrigger = ^TTrigger;
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
    35
     TTrigger = record
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
    36
                id: Longword;
593
1f5e66379a43 Triggers proof-of-concept
unc0rr
parents: 589
diff changeset
    37
                Ticks: Longword;
594
221ffeb92f30 - Fix some triggers bugs
unc0rr
parents: 593
diff changeset
    38
                Lives: Longword;
221ffeb92f30 - Fix some triggers bugs
unc0rr
parents: 593
diff changeset
    39
                TicksPerLife: LongWord;
595
5ee863f2f568 Triggers PoC: targets are spawned right after the previous damaged
unc0rr
parents: 594
diff changeset
    40
                Action: TTrigAction;
5ee863f2f568 Triggers PoC: targets are spawned right after the previous damaged
unc0rr
parents: 594
diff changeset
    41
                X, Y: LongInt;
5ee863f2f568 Triggers PoC: targets are spawned right after the previous damaged
unc0rr
parents: 594
diff changeset
    42
                SpawnGearType: TGearType;
5ee863f2f568 Triggers PoC: targets are spawned right after the previous damaged
unc0rr
parents: 594
diff changeset
    43
                SpawnGearTriggerId: Longword;
589
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
    44
                Next: PTrigger;
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
    45
                end;
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
    46
var TriggerList: PTrigger = nil;
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
    47
613
e8cf72d0e0f7 Add 'Successful finish' trigger
unc0rr
parents: 610
diff changeset
    48
function AddTrigger: PTrigger;
e8cf72d0e0f7 Add 'Successful finish' trigger
unc0rr
parents: 610
diff changeset
    49
var tmp: PTrigger;
e8cf72d0e0f7 Add 'Successful finish' trigger
unc0rr
parents: 610
diff changeset
    50
begin
e8cf72d0e0f7 Add 'Successful finish' trigger
unc0rr
parents: 610
diff changeset
    51
new(tmp);
e8cf72d0e0f7 Add 'Successful finish' trigger
unc0rr
parents: 610
diff changeset
    52
FillChar(tmp^, sizeof(TTrigger), 0);
e8cf72d0e0f7 Add 'Successful finish' trigger
unc0rr
parents: 610
diff changeset
    53
if TriggerList <> nil then tmp^.Next:= TriggerList;
e8cf72d0e0f7 Add 'Successful finish' trigger
unc0rr
parents: 610
diff changeset
    54
TriggerList:= tmp;
e8cf72d0e0f7 Add 'Successful finish' trigger
unc0rr
parents: 610
diff changeset
    55
AddTrigger:= tmp
e8cf72d0e0f7 Add 'Successful finish' trigger
unc0rr
parents: 610
diff changeset
    56
end;
e8cf72d0e0f7 Add 'Successful finish' trigger
unc0rr
parents: 610
diff changeset
    57
595
5ee863f2f568 Triggers PoC: targets are spawned right after the previous damaged
unc0rr
parents: 594
diff changeset
    58
procedure AddTriggerSpawner(id, Ticks, Lives: Longword; X, Y: LongInt; GearType: TGearType; GearTriggerId: Longword);
589
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
    59
var tmp: PTrigger;
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
    60
begin
594
221ffeb92f30 - Fix some triggers bugs
unc0rr
parents: 593
diff changeset
    61
if (Ticks = 0) or (Lives = 0) then exit;
595
5ee863f2f568 Triggers PoC: targets are spawned right after the previous damaged
unc0rr
parents: 594
diff changeset
    62
{$IFDEF DEBUGFILE}AddFileLog('Add spawner trigger: ' + inttostr(id) + ', gear triggers  ' + inttostr(GearTriggerId));{$ENDIF}
589
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
    63
613
e8cf72d0e0f7 Add 'Successful finish' trigger
unc0rr
parents: 610
diff changeset
    64
tmp:= AddTrigger;
589
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
    65
tmp^.id:= id;
593
1f5e66379a43 Triggers proof-of-concept
unc0rr
parents: 589
diff changeset
    66
tmp^.Ticks:= Ticks;
594
221ffeb92f30 - Fix some triggers bugs
unc0rr
parents: 593
diff changeset
    67
tmp^.TicksPerLife:= Ticks;
221ffeb92f30 - Fix some triggers bugs
unc0rr
parents: 593
diff changeset
    68
tmp^.Lives:= Lives;
595
5ee863f2f568 Triggers PoC: targets are spawned right after the previous damaged
unc0rr
parents: 594
diff changeset
    69
tmp^.Action:= taSpawnGear;
5ee863f2f568 Triggers PoC: targets are spawned right after the previous damaged
unc0rr
parents: 594
diff changeset
    70
tmp^.X:= X;
5ee863f2f568 Triggers PoC: targets are spawned right after the previous damaged
unc0rr
parents: 594
diff changeset
    71
tmp^.Y:= Y;
5ee863f2f568 Triggers PoC: targets are spawned right after the previous damaged
unc0rr
parents: 594
diff changeset
    72
tmp^.SpawnGearType:= GearType;
613
e8cf72d0e0f7 Add 'Successful finish' trigger
unc0rr
parents: 610
diff changeset
    73
tmp^.SpawnGearTriggerId:= GearTriggerId
e8cf72d0e0f7 Add 'Successful finish' trigger
unc0rr
parents: 610
diff changeset
    74
end;
e8cf72d0e0f7 Add 'Successful finish' trigger
unc0rr
parents: 610
diff changeset
    75
e8cf72d0e0f7 Add 'Successful finish' trigger
unc0rr
parents: 610
diff changeset
    76
procedure AddTriggerSuccess(tId: Longword);
e8cf72d0e0f7 Add 'Successful finish' trigger
unc0rr
parents: 610
diff changeset
    77
begin
e8cf72d0e0f7 Add 'Successful finish' trigger
unc0rr
parents: 610
diff changeset
    78
with AddTrigger^ do
e8cf72d0e0f7 Add 'Successful finish' trigger
unc0rr
parents: 610
diff changeset
    79
     begin
e8cf72d0e0f7 Add 'Successful finish' trigger
unc0rr
parents: 610
diff changeset
    80
     id:= tId;
e8cf72d0e0f7 Add 'Successful finish' trigger
unc0rr
parents: 610
diff changeset
    81
     Ticks:= 1;
e8cf72d0e0f7 Add 'Successful finish' trigger
unc0rr
parents: 610
diff changeset
    82
     TicksPerLife:= 1;
e8cf72d0e0f7 Add 'Successful finish' trigger
unc0rr
parents: 610
diff changeset
    83
     Action:= taSuccessFinish
e8cf72d0e0f7 Add 'Successful finish' trigger
unc0rr
parents: 610
diff changeset
    84
     end
589
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
    85
end;
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
    86
593
1f5e66379a43 Triggers proof-of-concept
unc0rr
parents: 589
diff changeset
    87
procedure TickTriggerT(Trigger: PTrigger);
1f5e66379a43 Triggers proof-of-concept
unc0rr
parents: 589
diff changeset
    88
begin
595
5ee863f2f568 Triggers PoC: targets are spawned right after the previous damaged
unc0rr
parents: 594
diff changeset
    89
with Trigger^ do
5ee863f2f568 Triggers PoC: targets are spawned right after the previous damaged
unc0rr
parents: 594
diff changeset
    90
  case Action of
610
9b5a6200f667 - Training format change
unc0rr
parents: 595
diff changeset
    91
     taSpawnGear: begin
9b5a6200f667 - Training format change
unc0rr
parents: 595
diff changeset
    92
                  FollowGear:= AddGear(X, Y, SpawnGearType, 0, _0, _0, 0);
9b5a6200f667 - Training format change
unc0rr
parents: 595
diff changeset
    93
                  FollowGear^.TriggerId:= SpawnGearTriggerId
613
e8cf72d0e0f7 Add 'Successful finish' trigger
unc0rr
parents: 610
diff changeset
    94
                  end;
e8cf72d0e0f7 Add 'Successful finish' trigger
unc0rr
parents: 610
diff changeset
    95
 taSuccessFinish: begin
e8cf72d0e0f7 Add 'Successful finish' trigger
unc0rr
parents: 610
diff changeset
    96
                  GameState:= gsExit
610
9b5a6200f667 - Training format change
unc0rr
parents: 595
diff changeset
    97
                  end
595
5ee863f2f568 Triggers PoC: targets are spawned right after the previous damaged
unc0rr
parents: 594
diff changeset
    98
  end
593
1f5e66379a43 Triggers proof-of-concept
unc0rr
parents: 589
diff changeset
    99
end;
1f5e66379a43 Triggers proof-of-concept
unc0rr
parents: 589
diff changeset
   100
1f5e66379a43 Triggers proof-of-concept
unc0rr
parents: 589
diff changeset
   101
procedure TickTrigger(id: Longword);
594
221ffeb92f30 - Fix some triggers bugs
unc0rr
parents: 593
diff changeset
   102
var t, pt, nt: PTrigger;
589
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
   103
begin
593
1f5e66379a43 Triggers proof-of-concept
unc0rr
parents: 589
diff changeset
   104
t:= TriggerList;
594
221ffeb92f30 - Fix some triggers bugs
unc0rr
parents: 593
diff changeset
   105
pt:= nil;
593
1f5e66379a43 Triggers proof-of-concept
unc0rr
parents: 589
diff changeset
   106
1f5e66379a43 Triggers proof-of-concept
unc0rr
parents: 589
diff changeset
   107
while (t <> nil) do
1f5e66379a43 Triggers proof-of-concept
unc0rr
parents: 589
diff changeset
   108
  begin
594
221ffeb92f30 - Fix some triggers bugs
unc0rr
parents: 593
diff changeset
   109
  nt:= t^.Next;
221ffeb92f30 - Fix some triggers bugs
unc0rr
parents: 593
diff changeset
   110
  if (t^.id = id) then
593
1f5e66379a43 Triggers proof-of-concept
unc0rr
parents: 589
diff changeset
   111
    begin
1f5e66379a43 Triggers proof-of-concept
unc0rr
parents: 589
diff changeset
   112
    dec(t^.Ticks);
1f5e66379a43 Triggers proof-of-concept
unc0rr
parents: 589
diff changeset
   113
    if (t^.Ticks = 0) then
1f5e66379a43 Triggers proof-of-concept
unc0rr
parents: 589
diff changeset
   114
       begin
1f5e66379a43 Triggers proof-of-concept
unc0rr
parents: 589
diff changeset
   115
       TickTriggerT(t);
594
221ffeb92f30 - Fix some triggers bugs
unc0rr
parents: 593
diff changeset
   116
       dec(t^.Lives);
221ffeb92f30 - Fix some triggers bugs
unc0rr
parents: 593
diff changeset
   117
       t^.Ticks:= t^.TicksPerLife;
221ffeb92f30 - Fix some triggers bugs
unc0rr
parents: 593
diff changeset
   118
       if (t^.Lives = 0) then
221ffeb92f30 - Fix some triggers bugs
unc0rr
parents: 593
diff changeset
   119
          begin
221ffeb92f30 - Fix some triggers bugs
unc0rr
parents: 593
diff changeset
   120
          if t = TriggerList then TriggerList:= nt
221ffeb92f30 - Fix some triggers bugs
unc0rr
parents: 593
diff changeset
   121
                             else pt^.Next:= nt;
221ffeb92f30 - Fix some triggers bugs
unc0rr
parents: 593
diff changeset
   122
          Dispose(t)
221ffeb92f30 - Fix some triggers bugs
unc0rr
parents: 593
diff changeset
   123
          end
593
1f5e66379a43 Triggers proof-of-concept
unc0rr
parents: 589
diff changeset
   124
       end
594
221ffeb92f30 - Fix some triggers bugs
unc0rr
parents: 593
diff changeset
   125
    end;
221ffeb92f30 - Fix some triggers bugs
unc0rr
parents: 593
diff changeset
   126
  pt:= t;
221ffeb92f30 - Fix some triggers bugs
unc0rr
parents: 593
diff changeset
   127
  t:= nt
593
1f5e66379a43 Triggers proof-of-concept
unc0rr
parents: 589
diff changeset
   128
  end
589
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
   129
end;
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
   130
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
   131
end.