1 (*

     2  * Hedgewars, a free turn based strategy game

     3  * Copyright (c) 2007 Andrey Korotaev <unC0Rr@gmail.com>

     4  *

     5  * This program is free software; you can redistribute it and/or modify

     6  * it under the terms of the GNU General Public License as published by

     7  * the Free Software Foundation; version 2 of the License

     8  *

     9  * This program is distributed in the hope that it will be useful,

    10  * but WITHOUT ANY WARRANTY; without even the implied warranty of

    11  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the

    12  * GNU General Public License for more details.

    13  *

    14  * You should have received a copy of the GNU General Public License

    15  * along with this program; if not, write to the Free Software

    16  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA

    17  *)

    18 

    19 {$INCLUDE "options.inc"}

    20 

    21 unit uTriggers;

    22 

    23 interface

    24 uses SDLh, uConsts;

    25 

    26 type TTrigAction = (taSpawnGear, taSuccessFinish, taFailFinish);

    27 

    28 procedure init_uTriggers;

    29 procedure free_uTriggers;

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

    31 procedure AddTriggerSuccess(id, Ticks, Lives: Longword);

    32 procedure AddTriggerFail(id, Ticks, Lives: Longword);

    33 procedure TickTrigger(id: Longword);

    34 

    35 implementation

    36 uses uGears, uFloat, uMisc, uWorld;

    37 type PTrigger = ^TTrigger;

    38      TTrigger = record

    39                 id: Longword;

    40                 Ticks: Longword;

    41                 Lives: Longword;

    42                 TicksPerLife: LongWord;

    43                 Action: TTrigAction;

    44                 X, Y: LongInt;

    45                 SpawnGearType: TGearType;

    46                 SpawnGearTriggerId: Longword;

    47                 Next: PTrigger;

    48                 end;

    49 var TriggerList: PTrigger;

    50 

    51 function AddTrigger(id, Ticks, Lives: Longword): PTrigger;

    52 var tmp: PTrigger;

    53 begin

    54 new(tmp);

    55 FillChar(tmp^, sizeof(TTrigger), 0);

    56 

    57 tmp^.id:= id;

    58 tmp^.Ticks:= Ticks;

    59 tmp^.TicksPerLife:= Ticks;

    60 tmp^.Lives:= Lives;

    61 

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

    63 TriggerList:= tmp;

    64 AddTrigger:= tmp

    65 end;

    66 

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

    68 var tmp: PTrigger;

    69 begin

    70 if (Ticks = 0) or (Lives = 0) then exit;

    71 

    72 tmp:= AddTrigger(id, Ticks, Lives);

    73 tmp^.Action:= taSpawnGear;

    74 tmp^.X:= X;

    75 tmp^.Y:= Y;

    76 tmp^.SpawnGearType:= GearType;

    77 tmp^.SpawnGearTriggerId:= GearTriggerId

    78 end;

    79 

    80 procedure AddTriggerSuccess(id, Ticks, Lives: Longword);

    81 begin

    82 with AddTrigger(id, Ticks, Lives)^ do

    83      Action:= taSuccessFinish

    84 end;

    85 

    86 procedure AddTriggerFail(id, Ticks, Lives: Longword);

    87 begin

    88 with AddTrigger(id, Ticks, Lives)^ do

    89      Action:= taFailFinish

    90 end;

    91 

    92 procedure TickTriggerT(Trigger: PTrigger);

    93 begin

    94 {$IFDEF DEBUGFILE}AddFileLog('Tick trigger (type: ' + inttostr(LongWord(Trigger^.Action)) + ')');{$ENDIF}

    95 with Trigger^ do

    96   case Action of

    97      taSpawnGear: begin

    98                   FollowGear:= AddGear(X, Y, SpawnGearType, 0, _0, _0, 0);

    99                   FollowGear^.TriggerId:= SpawnGearTriggerId

   100                   end;

   101  taSuccessFinish: begin

   102                   GameState:= gsExit

   103                   end;

   104     taFailFinish: begin

   105                   GameState:= gsExit

   106                   end

   107   end

   108 end;

   109 

   110 procedure TickTrigger(id: Longword);

   111 var t, pt, nt: PTrigger;

   112 begin

   113 t:= TriggerList;

   114 pt:= nil;

   115 

   116 while (t <> nil) do

   117   begin

   118   nt:= t^.Next;

   119   if (t^.id = id) then

   120     begin

   121     dec(t^.Ticks);

   122     if (t^.Ticks = 0) then

   123        begin

   124        TickTriggerT(t);

   125        dec(t^.Lives);

   126        t^.Ticks:= t^.TicksPerLife;

   127        if (t^.Lives = 0) then

   128           begin

   129           if t = TriggerList then

   130              begin

   131              TriggerList:= nt;

   132              Dispose(t)

   133              end

   134           else

   135              begin

   136              pt^.Next:= nt;

   137              Dispose(t);

   138              t:= pt

   139              end

   140           end

   141        end

   142     end;

   143   pt:= t;

   144   t:= nt

   145   end

   146 end;

   147 

   148 procedure init_uTriggers;

   149 begin

   150     TriggerList:= nil;

   151 end;

   152 

   153 procedure free_uTriggers;

   154 begin

   155 

   156 end;

   157 

   158 end.