hedgewars/uTriggers.pas
author nemo
Sun, 24 Jan 2010 16:25:10 +0000
changeset 2708 84bf57349d46
parent 2699 249adefa9c1c
child 2716 b9ca1bfca24f
permissions -rw-r--r--
forgot Themes CMakeLists file
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;
615
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
    29
procedure AddTriggerSpawner(id, Ticks, Lives: Longword; GearType: TGearType; X, Y: LongInt; GearTriggerId: Longword);
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
    30
procedure AddTriggerSuccess(id, Ticks, Lives: Longword);
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
    31
procedure AddTriggerFail(id, Ticks, Lives: Longword);
593
1f5e66379a43 Triggers proof-of-concept
unc0rr
parents: 589
diff changeset
    32
procedure TickTrigger(id: Longword);
589
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
    33
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
    34
implementation
610
9b5a6200f667 - Training format change
unc0rr
parents: 595
diff changeset
    35
uses uGears, uFloat, uMisc, uWorld;
589
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
    36
type PTrigger = ^TTrigger;
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
    37
     TTrigger = record
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
    38
                id: Longword;
593
1f5e66379a43 Triggers proof-of-concept
unc0rr
parents: 589
diff changeset
    39
                Ticks: Longword;
594
221ffeb92f30 - Fix some triggers bugs
unc0rr
parents: 593
diff changeset
    40
                Lives: Longword;
221ffeb92f30 - Fix some triggers bugs
unc0rr
parents: 593
diff changeset
    41
                TicksPerLife: LongWord;
595
5ee863f2f568 Triggers PoC: targets are spawned right after the previous damaged
unc0rr
parents: 594
diff changeset
    42
                Action: TTrigAction;
5ee863f2f568 Triggers PoC: targets are spawned right after the previous damaged
unc0rr
parents: 594
diff changeset
    43
                X, Y: LongInt;
5ee863f2f568 Triggers PoC: targets are spawned right after the previous damaged
unc0rr
parents: 594
diff changeset
    44
                SpawnGearType: TGearType;
5ee863f2f568 Triggers PoC: targets are spawned right after the previous damaged
unc0rr
parents: 594
diff changeset
    45
                SpawnGearTriggerId: Longword;
589
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
    46
                Next: PTrigger;
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
    47
                end;
2699
249adefa9c1c replace initialization/finalization statements with custom init functions
koda
parents: 2630
diff changeset
    48
var TriggerList: PTrigger;
589
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
    49
615
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
    50
function AddTrigger(id, Ticks, Lives: Longword): PTrigger;
613
e8cf72d0e0f7 Add 'Successful finish' trigger
unc0rr
parents: 610
diff changeset
    51
var tmp: PTrigger;
e8cf72d0e0f7 Add 'Successful finish' trigger
unc0rr
parents: 610
diff changeset
    52
begin
e8cf72d0e0f7 Add 'Successful finish' trigger
unc0rr
parents: 610
diff changeset
    53
new(tmp);
e8cf72d0e0f7 Add 'Successful finish' trigger
unc0rr
parents: 610
diff changeset
    54
FillChar(tmp^, sizeof(TTrigger), 0);
615
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
    55
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
    56
tmp^.id:= id;
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
    57
tmp^.Ticks:= Ticks;
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
    58
tmp^.TicksPerLife:= Ticks;
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
    59
tmp^.Lives:= Lives;
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
    60
613
e8cf72d0e0f7 Add 'Successful finish' trigger
unc0rr
parents: 610
diff changeset
    61
if TriggerList <> nil then tmp^.Next:= TriggerList;
e8cf72d0e0f7 Add 'Successful finish' trigger
unc0rr
parents: 610
diff changeset
    62
TriggerList:= tmp;
e8cf72d0e0f7 Add 'Successful finish' trigger
unc0rr
parents: 610
diff changeset
    63
AddTrigger:= tmp
e8cf72d0e0f7 Add 'Successful finish' trigger
unc0rr
parents: 610
diff changeset
    64
end;
e8cf72d0e0f7 Add 'Successful finish' trigger
unc0rr
parents: 610
diff changeset
    65
615
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
    66
procedure AddTriggerSpawner(id, Ticks, Lives: Longword; GearType: TGearType; X, Y: LongInt; GearTriggerId: Longword);
589
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
    67
var tmp: PTrigger;
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
    68
begin
594
221ffeb92f30 - Fix some triggers bugs
unc0rr
parents: 593
diff changeset
    69
if (Ticks = 0) or (Lives = 0) then exit;
589
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
    70
615
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
    71
tmp:= AddTrigger(id, Ticks, Lives);
595
5ee863f2f568 Triggers PoC: targets are spawned right after the previous damaged
unc0rr
parents: 594
diff changeset
    72
tmp^.Action:= taSpawnGear;
5ee863f2f568 Triggers PoC: targets are spawned right after the previous damaged
unc0rr
parents: 594
diff changeset
    73
tmp^.X:= X;
5ee863f2f568 Triggers PoC: targets are spawned right after the previous damaged
unc0rr
parents: 594
diff changeset
    74
tmp^.Y:= Y;
5ee863f2f568 Triggers PoC: targets are spawned right after the previous damaged
unc0rr
parents: 594
diff changeset
    75
tmp^.SpawnGearType:= GearType;
613
e8cf72d0e0f7 Add 'Successful finish' trigger
unc0rr
parents: 610
diff changeset
    76
tmp^.SpawnGearTriggerId:= GearTriggerId
e8cf72d0e0f7 Add 'Successful finish' trigger
unc0rr
parents: 610
diff changeset
    77
end;
e8cf72d0e0f7 Add 'Successful finish' trigger
unc0rr
parents: 610
diff changeset
    78
615
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
    79
procedure AddTriggerSuccess(id, Ticks, Lives: Longword);
613
e8cf72d0e0f7 Add 'Successful finish' trigger
unc0rr
parents: 610
diff changeset
    80
begin
615
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
    81
with AddTrigger(id, Ticks, Lives)^ do
613
e8cf72d0e0f7 Add 'Successful finish' trigger
unc0rr
parents: 610
diff changeset
    82
     Action:= taSuccessFinish
615
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
    83
end;
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
    84
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
    85
procedure AddTriggerFail(id, Ticks, Lives: Longword);
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
    86
begin
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
    87
with AddTrigger(id, Ticks, Lives)^ do
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
    88
     Action:= taFailFinish
589
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
    89
end;
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
    90
593
1f5e66379a43 Triggers proof-of-concept
unc0rr
parents: 589
diff changeset
    91
procedure TickTriggerT(Trigger: PTrigger);
1f5e66379a43 Triggers proof-of-concept
unc0rr
parents: 589
diff changeset
    92
begin
615
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
    93
{$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
    94
with Trigger^ do
5ee863f2f568 Triggers PoC: targets are spawned right after the previous damaged
unc0rr
parents: 594
diff changeset
    95
  case Action of
610
9b5a6200f667 - Training format change
unc0rr
parents: 595
diff changeset
    96
     taSpawnGear: begin
9b5a6200f667 - Training format change
unc0rr
parents: 595
diff changeset
    97
                  FollowGear:= AddGear(X, Y, SpawnGearType, 0, _0, _0, 0);
9b5a6200f667 - Training format change
unc0rr
parents: 595
diff changeset
    98
                  FollowGear^.TriggerId:= SpawnGearTriggerId
613
e8cf72d0e0f7 Add 'Successful finish' trigger
unc0rr
parents: 610
diff changeset
    99
                  end;
e8cf72d0e0f7 Add 'Successful finish' trigger
unc0rr
parents: 610
diff changeset
   100
 taSuccessFinish: begin
e8cf72d0e0f7 Add 'Successful finish' trigger
unc0rr
parents: 610
diff changeset
   101
                  GameState:= gsExit
615
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
   102
                  end;
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
   103
    taFailFinish: begin
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
   104
                  GameState:= gsExit
610
9b5a6200f667 - Training format change
unc0rr
parents: 595
diff changeset
   105
                  end
595
5ee863f2f568 Triggers PoC: targets are spawned right after the previous damaged
unc0rr
parents: 594
diff changeset
   106
  end
593
1f5e66379a43 Triggers proof-of-concept
unc0rr
parents: 589
diff changeset
   107
end;
1f5e66379a43 Triggers proof-of-concept
unc0rr
parents: 589
diff changeset
   108
1f5e66379a43 Triggers proof-of-concept
unc0rr
parents: 589
diff changeset
   109
procedure TickTrigger(id: Longword);
594
221ffeb92f30 - Fix some triggers bugs
unc0rr
parents: 593
diff changeset
   110
var t, pt, nt: PTrigger;
589
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
   111
begin
593
1f5e66379a43 Triggers proof-of-concept
unc0rr
parents: 589
diff changeset
   112
t:= TriggerList;
594
221ffeb92f30 - Fix some triggers bugs
unc0rr
parents: 593
diff changeset
   113
pt:= nil;
593
1f5e66379a43 Triggers proof-of-concept
unc0rr
parents: 589
diff changeset
   114
1f5e66379a43 Triggers proof-of-concept
unc0rr
parents: 589
diff changeset
   115
while (t <> nil) do
1f5e66379a43 Triggers proof-of-concept
unc0rr
parents: 589
diff changeset
   116
  begin
594
221ffeb92f30 - Fix some triggers bugs
unc0rr
parents: 593
diff changeset
   117
  nt:= t^.Next;
221ffeb92f30 - Fix some triggers bugs
unc0rr
parents: 593
diff changeset
   118
  if (t^.id = id) then
593
1f5e66379a43 Triggers proof-of-concept
unc0rr
parents: 589
diff changeset
   119
    begin
1f5e66379a43 Triggers proof-of-concept
unc0rr
parents: 589
diff changeset
   120
    dec(t^.Ticks);
1f5e66379a43 Triggers proof-of-concept
unc0rr
parents: 589
diff changeset
   121
    if (t^.Ticks = 0) then
1f5e66379a43 Triggers proof-of-concept
unc0rr
parents: 589
diff changeset
   122
       begin
1f5e66379a43 Triggers proof-of-concept
unc0rr
parents: 589
diff changeset
   123
       TickTriggerT(t);
594
221ffeb92f30 - Fix some triggers bugs
unc0rr
parents: 593
diff changeset
   124
       dec(t^.Lives);
221ffeb92f30 - Fix some triggers bugs
unc0rr
parents: 593
diff changeset
   125
       t^.Ticks:= t^.TicksPerLife;
221ffeb92f30 - Fix some triggers bugs
unc0rr
parents: 593
diff changeset
   126
       if (t^.Lives = 0) then
221ffeb92f30 - Fix some triggers bugs
unc0rr
parents: 593
diff changeset
   127
          begin
615
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
   128
          if t = TriggerList then
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
   129
             begin
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
   130
             TriggerList:= nt;
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
   131
             Dispose(t)
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
   132
             end
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
   133
          else
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
   134
             begin
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
   135
             pt^.Next:= nt;
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
   136
             Dispose(t);
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
   137
             t:= pt
b646b3c43369 - Add 'Mission Fail' trigger type
unc0rr
parents: 613
diff changeset
   138
             end
594
221ffeb92f30 - Fix some triggers bugs
unc0rr
parents: 593
diff changeset
   139
          end
593
1f5e66379a43 Triggers proof-of-concept
unc0rr
parents: 589
diff changeset
   140
       end
594
221ffeb92f30 - Fix some triggers bugs
unc0rr
parents: 593
diff changeset
   141
    end;
221ffeb92f30 - Fix some triggers bugs
unc0rr
parents: 593
diff changeset
   142
  pt:= t;
221ffeb92f30 - Fix some triggers bugs
unc0rr
parents: 593
diff changeset
   143
  t:= nt
593
1f5e66379a43 Triggers proof-of-concept
unc0rr
parents: 589
diff changeset
   144
  end
589
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
   145
end;
f382c41f658a Start implementing triggers in engine
unc0rr
parents:
diff changeset
   146
2699
249adefa9c1c replace initialization/finalization statements with custom init functions
koda
parents: 2630
diff changeset
   147
procedure init_uTriggers;
249adefa9c1c replace initialization/finalization statements with custom init functions
koda
parents: 2630
diff changeset
   148
begin
249adefa9c1c replace initialization/finalization statements with custom init functions
koda
parents: 2630
diff changeset
   149
	TriggerList:= nil;
249adefa9c1c replace initialization/finalization statements with custom init functions
koda
parents: 2630
diff changeset
   150
end;
249adefa9c1c replace initialization/finalization statements with custom init functions
koda
parents: 2630
diff changeset
   151
2599
c7153d2348f3 move compiler directives to standard pascal
koda
parents: 1066
diff changeset
   152
end.