hedgewars/uTriggers.pas
author unc0rr
Mon, 29 Sep 2008 22:14:23 +0000
changeset 1301 c6fe8a4bfd34
parent 1066 1f1b3686a2b0
child 2599 c7153d2348f3
permissions -rw-r--r--
Fix a bug screwing team selection up in network game (REMOVETEAM message doesn't have teamID, and after removing the team QMap still contains old info, when add and remove team with the same name, total hedgehogs number will be decreased by first team hh number)

(*
 * Hedgewars, a free turn based strategy game
 * Copyright (c) 2007 Andrey Korotaev <unC0Rr@gmail.com>
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; version 2 of the License
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
 *)

unit uTriggers;

interface
uses SDLh, uConsts;
{$INCLUDE options.inc}
const trigTurns = $80000001;

type TTrigAction = (taSpawnGear, taSuccessFinish, taFailFinish);

procedure AddTriggerSpawner(id, Ticks, Lives: Longword; GearType: TGearType; X, Y: LongInt; GearTriggerId: Longword);
procedure AddTriggerSuccess(id, Ticks, Lives: Longword);
procedure AddTriggerFail(id, Ticks, Lives: Longword);
procedure TickTrigger(id: Longword);

implementation
uses uGears, uFloat, uMisc, uWorld;
type PTrigger = ^TTrigger;
     TTrigger = record
                id: Longword;
                Ticks: Longword;
                Lives: Longword;
                TicksPerLife: LongWord;
                Action: TTrigAction;
                X, Y: LongInt;
                SpawnGearType: TGearType;
                SpawnGearTriggerId: Longword;
                Next: PTrigger;
                end;
var TriggerList: PTrigger = nil;

function AddTrigger(id, Ticks, Lives: Longword): PTrigger;
var tmp: PTrigger;
begin
new(tmp);
FillChar(tmp^, sizeof(TTrigger), 0);

tmp^.id:= id;
tmp^.Ticks:= Ticks;
tmp^.TicksPerLife:= Ticks;
tmp^.Lives:= Lives;

if TriggerList <> nil then tmp^.Next:= TriggerList;
TriggerList:= tmp;
AddTrigger:= tmp
end;

procedure AddTriggerSpawner(id, Ticks, Lives: Longword; GearType: TGearType; X, Y: LongInt; GearTriggerId: Longword);
var tmp: PTrigger;
begin
if (Ticks = 0) or (Lives = 0) then exit;

tmp:= AddTrigger(id, Ticks, Lives);
tmp^.Action:= taSpawnGear;
tmp^.X:= X;
tmp^.Y:= Y;
tmp^.SpawnGearType:= GearType;
tmp^.SpawnGearTriggerId:= GearTriggerId
end;

procedure AddTriggerSuccess(id, Ticks, Lives: Longword);
begin
with AddTrigger(id, Ticks, Lives)^ do
     Action:= taSuccessFinish
end;

procedure AddTriggerFail(id, Ticks, Lives: Longword);
begin
with AddTrigger(id, Ticks, Lives)^ do
     Action:= taFailFinish
end;

procedure TickTriggerT(Trigger: PTrigger);
begin
{$IFDEF DEBUGFILE}AddFileLog('Tick trigger (type: ' + inttostr(LongWord(Trigger^.Action)) + ')');{$ENDIF}
with Trigger^ do
  case Action of
     taSpawnGear: begin
                  FollowGear:= AddGear(X, Y, SpawnGearType, 0, _0, _0, 0);
                  FollowGear^.TriggerId:= SpawnGearTriggerId
                  end;
 taSuccessFinish: begin
                  GameState:= gsExit
                  end;
    taFailFinish: begin
                  GameState:= gsExit
                  end
  end
end;

procedure TickTrigger(id: Longword);
var t, pt, nt: PTrigger;
begin
t:= TriggerList;
pt:= nil;

while (t <> nil) do
  begin
  nt:= t^.Next;
  if (t^.id = id) then
    begin
    dec(t^.Ticks);
    if (t^.Ticks = 0) then
       begin
       TickTriggerT(t);
       dec(t^.Lives);
       t^.Ticks:= t^.TicksPerLife;
       if (t^.Lives = 0) then
          begin
          if t = TriggerList then
             begin
             TriggerList:= nt;
             Dispose(t)
             end
          else
             begin
             pt^.Next:= nt;
             Dispose(t);
             t:= pt
             end
          end
       end
    end;
  pt:= t;
  t:= nt
  end
end;

end.