hedgewars/uTriggers.pas
author nemo
Sun, 24 Jan 2010 16:46:06 +0000
changeset 2712 8f4527c9137c
parent 2699 249adefa9c1c
child 2716 b9ca1bfca24f
permissions -rw-r--r--
Minor tweak, try to make long flavour text last longer, move the hurt self messages to unused messages group, so they don't get wiped by crate an instant later.
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.