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