hedgewars/uTriggers.pas
author unc0rr
Sat, 06 Mar 2010 10:59:20 +0000
changeset 2948 3f21a9dc93d0
parent 2716 b9ca1bfca24f
permissions -rw-r--r--
Replace tabs with spaces using 'expand -t 4' command
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
589
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
     1
(*
1066
1f1b3686a2b0 Update copyright headers a bit
unc0rr
parents: 615
diff changeset
     2
 * Hedgewars, a free turn based strategy game
589
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
2630
079ef82eac75 revamped file access and debug display
koda
parents: 2599
diff changeset
    19
{$INCLUDE "options.inc"}
079ef82eac75 revamped file access and debug display
koda
parents: 2599
diff changeset
    20
589
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
    21
unit uTriggers;
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
    22
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
    23
interface
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
    24
uses SDLh, uConsts;
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
    25
615
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
    26
type TTrigAction = (taSpawnGear, taSuccessFinish, taFailFinish);
595
5ee863f2f568 Triggers PoC: targets are spawned right after the previous damaged
unc0rr
parents: 594
diff changeset
    27
2699
249adefa9c1c replace initialization/finalization statements with custom init functions
koda
parents: 2630
diff changeset
    28
procedure init_uTriggers;
2716
b9ca1bfca24f complete the replacement of init/free wrappers for every unit
koda
parents: 2699
diff changeset
    29
procedure free_uTriggers;
615
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
    30
procedure AddTriggerSpawner(id, Ticks, Lives: Longword; GearType: TGearType; X, Y: LongInt; GearTriggerId: Longword);
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
    31
procedure AddTriggerSuccess(id, Ticks, Lives: Longword);
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
    32
procedure AddTriggerFail(id, Ticks, Lives: Longword);
593
1f5e66379a43 Triggers proof-of-concept
unc0rr
parents: 589
diff changeset
    33
procedure TickTrigger(id: Longword);
589
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
    34
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
    35
implementation
610
9b5a6200f667 - Training format change
unc0rr
parents: 595
diff changeset
    36
uses uGears, uFloat, uMisc, uWorld;
589
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
    37
type PTrigger = ^TTrigger;
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
    38
     TTrigger = record
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
    39
                id: Longword;
593
1f5e66379a43 Triggers proof-of-concept
unc0rr
parents: 589
diff changeset
    40
                Ticks: Longword;
594
221ffeb92f30 - Fix some triggers bugs
unc0rr
parents: 593
diff changeset
    41
                Lives: Longword;
221ffeb92f30 - Fix some triggers bugs
unc0rr
parents: 593
diff changeset
    42
                TicksPerLife: LongWord;
595
5ee863f2f568 Triggers PoC: targets are spawned right after the previous damaged
unc0rr
parents: 594
diff changeset
    43
                Action: TTrigAction;
5ee863f2f568 Triggers PoC: targets are spawned right after the previous damaged
unc0rr
parents: 594
diff changeset
    44
                X, Y: LongInt;
5ee863f2f568 Triggers PoC: targets are spawned right after the previous damaged
unc0rr
parents: 594
diff changeset
    45
                SpawnGearType: TGearType;
5ee863f2f568 Triggers PoC: targets are spawned right after the previous damaged
unc0rr
parents: 594
diff changeset
    46
                SpawnGearTriggerId: Longword;
589
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
    47
                Next: PTrigger;
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
    48
                end;
2699
249adefa9c1c replace initialization/finalization statements with custom init functions
koda
parents: 2630
diff changeset
    49
var TriggerList: PTrigger;
589
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
    50
615
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
    51
function AddTrigger(id, Ticks, Lives: Longword): PTrigger;
613
e8cf72d0e0f7 Add 'Successful finish' trigger
unc0rr
parents: 610
diff changeset
    52
var tmp: PTrigger;
e8cf72d0e0f7 Add 'Successful finish' trigger
unc0rr
parents: 610
diff changeset
    53
begin
e8cf72d0e0f7 Add 'Successful finish' trigger
unc0rr
parents: 610
diff changeset
    54
new(tmp);
e8cf72d0e0f7 Add 'Successful finish' trigger
unc0rr
parents: 610
diff changeset
    55
FillChar(tmp^, sizeof(TTrigger), 0);
615
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
    56
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
    57
tmp^.id:= id;
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
    58
tmp^.Ticks:= Ticks;
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
    59
tmp^.TicksPerLife:= Ticks;
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
    60
tmp^.Lives:= Lives;
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
    61
613
e8cf72d0e0f7 Add 'Successful finish' trigger
unc0rr
parents: 610
diff changeset
    62
if TriggerList <> nil then tmp^.Next:= TriggerList;
e8cf72d0e0f7 Add 'Successful finish' trigger
unc0rr
parents: 610
diff changeset
    63
TriggerList:= tmp;
e8cf72d0e0f7 Add 'Successful finish' trigger
unc0rr
parents: 610
diff changeset
    64
AddTrigger:= tmp
e8cf72d0e0f7 Add 'Successful finish' trigger
unc0rr
parents: 610
diff changeset
    65
end;
e8cf72d0e0f7 Add 'Successful finish' trigger
unc0rr
parents: 610
diff changeset
    66
615
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
    67
procedure AddTriggerSpawner(id, Ticks, Lives: Longword; GearType: TGearType; X, Y: LongInt; GearTriggerId: Longword);
589
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
    68
var tmp: PTrigger;
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
    69
begin
594
221ffeb92f30 - Fix some triggers bugs
unc0rr
parents: 593
diff changeset
    70
if (Ticks = 0) or (Lives = 0) then exit;
589
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
    71
615
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
    72
tmp:= AddTrigger(id, Ticks, Lives);
595
5ee863f2f568 Triggers PoC: targets are spawned right after the previous damaged
unc0rr
parents: 594
diff changeset
    73
tmp^.Action:= taSpawnGear;
5ee863f2f568 Triggers PoC: targets are spawned right after the previous damaged
unc0rr
parents: 594
diff changeset
    74
tmp^.X:= X;
5ee863f2f568 Triggers PoC: targets are spawned right after the previous damaged
unc0rr
parents: 594
diff changeset
    75
tmp^.Y:= Y;
5ee863f2f568 Triggers PoC: targets are spawned right after the previous damaged
unc0rr
parents: 594
diff changeset
    76
tmp^.SpawnGearType:= GearType;
613
e8cf72d0e0f7 Add 'Successful finish' trigger
unc0rr
parents: 610
diff changeset
    77
tmp^.SpawnGearTriggerId:= GearTriggerId
e8cf72d0e0f7 Add 'Successful finish' trigger
unc0rr
parents: 610
diff changeset
    78
end;
e8cf72d0e0f7 Add 'Successful finish' trigger
unc0rr
parents: 610
diff changeset
    79
615
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
    80
procedure AddTriggerSuccess(id, Ticks, Lives: Longword);
613
e8cf72d0e0f7 Add 'Successful finish' trigger
unc0rr
parents: 610
diff changeset
    81
begin
615
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
    82
with AddTrigger(id, Ticks, Lives)^ do
613
e8cf72d0e0f7 Add 'Successful finish' trigger
unc0rr
parents: 610
diff changeset
    83
     Action:= taSuccessFinish
615
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
    84
end;
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
    85
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
    86
procedure AddTriggerFail(id, Ticks, Lives: Longword);
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
    87
begin
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
    88
with AddTrigger(id, Ticks, Lives)^ do
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
    89
     Action:= taFailFinish
589
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
    90
end;
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
    91
593
1f5e66379a43 Triggers proof-of-concept
unc0rr
parents: 589
diff changeset
    92
procedure TickTriggerT(Trigger: PTrigger);
1f5e66379a43 Triggers proof-of-concept
unc0rr
parents: 589
diff changeset
    93
begin
615
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
    94
{$IFDEF DEBUGFILE}AddFileLog('Tick trigger (type: ' + inttostr(LongWord(Trigger^.Action)) + ')');{$ENDIF}
595
5ee863f2f568 Triggers PoC: targets are spawned right after the previous damaged
unc0rr
parents: 594
diff changeset
    95
with Trigger^ do
5ee863f2f568 Triggers PoC: targets are spawned right after the previous damaged
unc0rr
parents: 594
diff changeset
    96
  case Action of
610
9b5a6200f667 - Training format change
unc0rr
parents: 595
diff changeset
    97
     taSpawnGear: begin
9b5a6200f667 - Training format change
unc0rr
parents: 595
diff changeset
    98
                  FollowGear:= AddGear(X, Y, SpawnGearType, 0, _0, _0, 0);
9b5a6200f667 - Training format change
unc0rr
parents: 595
diff changeset
    99
                  FollowGear^.TriggerId:= SpawnGearTriggerId
613
e8cf72d0e0f7 Add 'Successful finish' trigger
unc0rr
parents: 610
diff changeset
   100
                  end;
e8cf72d0e0f7 Add 'Successful finish' trigger
unc0rr
parents: 610
diff changeset
   101
 taSuccessFinish: begin
e8cf72d0e0f7 Add 'Successful finish' trigger
unc0rr
parents: 610
diff changeset
   102
                  GameState:= gsExit
615
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
   103
                  end;
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
   104
    taFailFinish: begin
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
   105
                  GameState:= gsExit
610
9b5a6200f667 - Training format change
unc0rr
parents: 595
diff changeset
   106
                  end
595
5ee863f2f568 Triggers PoC: targets are spawned right after the previous damaged
unc0rr
parents: 594
diff changeset
   107
  end
593
1f5e66379a43 Triggers proof-of-concept
unc0rr
parents: 589
diff changeset
   108
end;
1f5e66379a43 Triggers proof-of-concept
unc0rr
parents: 589
diff changeset
   109
1f5e66379a43 Triggers proof-of-concept
unc0rr
parents: 589
diff changeset
   110
procedure TickTrigger(id: Longword);
594
221ffeb92f30 - Fix some triggers bugs
unc0rr
parents: 593
diff changeset
   111
var t, pt, nt: PTrigger;
589
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
   112
begin
593
1f5e66379a43 Triggers proof-of-concept
unc0rr
parents: 589
diff changeset
   113
t:= TriggerList;
594
221ffeb92f30 - Fix some triggers bugs
unc0rr
parents: 593
diff changeset
   114
pt:= nil;
593
1f5e66379a43 Triggers proof-of-concept
unc0rr
parents: 589
diff changeset
   115
1f5e66379a43 Triggers proof-of-concept
unc0rr
parents: 589
diff changeset
   116
while (t <> nil) do
1f5e66379a43 Triggers proof-of-concept
unc0rr
parents: 589
diff changeset
   117
  begin
594
221ffeb92f30 - Fix some triggers bugs
unc0rr
parents: 593
diff changeset
   118
  nt:= t^.Next;
221ffeb92f30 - Fix some triggers bugs
unc0rr
parents: 593
diff changeset
   119
  if (t^.id = id) then
593
1f5e66379a43 Triggers proof-of-concept
unc0rr
parents: 589
diff changeset
   120
    begin
1f5e66379a43 Triggers proof-of-concept
unc0rr
parents: 589
diff changeset
   121
    dec(t^.Ticks);
1f5e66379a43 Triggers proof-of-concept
unc0rr
parents: 589
diff changeset
   122
    if (t^.Ticks = 0) then
1f5e66379a43 Triggers proof-of-concept
unc0rr
parents: 589
diff changeset
   123
       begin
1f5e66379a43 Triggers proof-of-concept
unc0rr
parents: 589
diff changeset
   124
       TickTriggerT(t);
594
221ffeb92f30 - Fix some triggers bugs
unc0rr
parents: 593
diff changeset
   125
       dec(t^.Lives);
221ffeb92f30 - Fix some triggers bugs
unc0rr
parents: 593
diff changeset
   126
       t^.Ticks:= t^.TicksPerLife;
221ffeb92f30 - Fix some triggers bugs
unc0rr
parents: 593
diff changeset
   127
       if (t^.Lives = 0) then
221ffeb92f30 - Fix some triggers bugs
unc0rr
parents: 593
diff changeset
   128
          begin
615
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
   129
          if t = TriggerList then
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
   130
             begin
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
   131
             TriggerList:= nt;
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
   132
             Dispose(t)
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
   133
             end
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
   134
          else
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
   135
             begin
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
   136
             pt^.Next:= nt;
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
   137
             Dispose(t);
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
   138
             t:= pt
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
   139
             end
594
221ffeb92f30 - Fix some triggers bugs
unc0rr
parents: 593
diff changeset
   140
          end
593
1f5e66379a43 Triggers proof-of-concept
unc0rr
parents: 589
diff changeset
   141
       end
594
221ffeb92f30 - Fix some triggers bugs
unc0rr
parents: 593
diff changeset
   142
    end;
221ffeb92f30 - Fix some triggers bugs
unc0rr
parents: 593
diff changeset
   143
  pt:= t;
221ffeb92f30 - Fix some triggers bugs
unc0rr
parents: 593
diff changeset
   144
  t:= nt
593
1f5e66379a43 Triggers proof-of-concept
unc0rr
parents: 589
diff changeset
   145
  end
589
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
   146
end;
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
   147
2699
249adefa9c1c replace initialization/finalization statements with custom init functions
koda
parents: 2630
diff changeset
   148
procedure init_uTriggers;
249adefa9c1c replace initialization/finalization statements with custom init functions
koda
parents: 2630
diff changeset
   149
begin
2948
3f21a9dc93d0 Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents: 2716
diff changeset
   150
    TriggerList:= nil;
2699
249adefa9c1c replace initialization/finalization statements with custom init functions
koda
parents: 2630
diff changeset
   151
end;
249adefa9c1c replace initialization/finalization statements with custom init functions
koda
parents: 2630
diff changeset
   152
2716
b9ca1bfca24f complete the replacement of init/free wrappers for every unit
koda
parents: 2699
diff changeset
   153
procedure free_uTriggers;
b9ca1bfca24f complete the replacement of init/free wrappers for every unit
koda
parents: 2699
diff changeset
   154
begin
b9ca1bfca24f complete the replacement of init/free wrappers for every unit
koda
parents: 2699
diff changeset
   155
b9ca1bfca24f complete the replacement of init/free wrappers for every unit
koda
parents: 2699
diff changeset
   156
end;
b9ca1bfca24f complete the replacement of init/free wrappers for every unit
koda
parents: 2699
diff changeset
   157
2599
c7153d2348f3 move compiler directives to standard pascal
koda
parents: 1066
diff changeset
   158
end.