hedgewars/uAIActions.pas
changeset 1 30f2d1037d5d
child 4 bcbd7adb4e4b
equal deleted inserted replaced
0:475c0f2f9d17 1:30f2d1037d5d
       
     1 (*
       
     2  * Hedgewars, a worms-like game
       
     3  * Copyright (c) 2005 Andrey Korotaev <unC0Rr@gmail.com>
       
     4  *
       
     5  * Distributed under the terms of the BSD-modified licence:
       
     6  *
       
     7  * Permission is hereby granted, free of charge, to any person obtaining a copy
       
     8  * of this software and associated documentation files (the "Software"), to deal
       
     9  * with the Software without restriction, including without limitation the
       
    10  * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
       
    11  * sell copies of the Software, and to permit persons to whom the Software is
       
    12  * furnished to do so, subject to the following conditions:
       
    13  *
       
    14  * 1. Redistributions of source code must retain the above copyright notice,
       
    15  *    this list of conditions and the following disclaimer.
       
    16  * 2. Redistributions in binary form must reproduce the above copyright notice,
       
    17  *    this list of conditions and the following disclaimer in the documentation
       
    18  *    and/or other materials provided with the distribution.
       
    19  * 3. The name of the author may not be used to endorse or promote products
       
    20  *    derived from this software without specific prior written permission.
       
    21  *
       
    22  * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED
       
    23  * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
       
    24  * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO
       
    25  * EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
       
    26  * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
       
    27  * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
       
    28  * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
       
    29  * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
       
    30  * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
       
    31  * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
       
    32  *)
       
    33 
       
    34 unit uAIActions;
       
    35 interface
       
    36 {$INCLUDE options.inc}
       
    37 const aia_none       = 0;
       
    38       aia_Left       = 1;
       
    39       aia_Right      = 2;
       
    40       aia_Timer      = 3;
       
    41       aia_Slot       = 4;
       
    42       aia_attack     = 5;
       
    43       aia_Up         = 6;
       
    44       aia_Down       = 7;
       
    45 
       
    46       aia_Weapon     = $80000000;
       
    47       aia_WaitX      = $80000001;
       
    48       aia_WaitY      = $80000002;
       
    49       aia_LookLeft   = $80000003;
       
    50       aia_LookRight  = $80000004;
       
    51 
       
    52       aim_push       = $80000000;
       
    53       aim_release    = $80000001;
       
    54       ai_specmask    = $80000000;
       
    55 
       
    56 type PAction = ^TAction;
       
    57      TAction = record
       
    58                Action, Param: Longword;
       
    59                Time: Longword;
       
    60                Next: PAction;
       
    61                end;
       
    62 
       
    63 function AddAction(Action, Param, TimeDelta: Longword): PAction;
       
    64 procedure FreeActionsList;
       
    65 function IsActionListEmpty: boolean;
       
    66 procedure ProcessAction;
       
    67 
       
    68 implementation
       
    69 uses uMisc, uConsts, uConsole, uTeams;
       
    70 
       
    71 const ActionIdToStr: array[0..7] of string[16] = (
       
    72 {aia_none}           '',
       
    73 {aia_Left}           'left',
       
    74 {aia_Right}          'right',
       
    75 {aia_Timer}          'timer',
       
    76 {aia_slot}           'slot',
       
    77 {aia_attack}         'attack',
       
    78 {aia_Up}             'up',
       
    79 {aia_Down}           'down'
       
    80       );
       
    81 
       
    82 
       
    83 var ActionList,
       
    84     FinAction: PAction;
       
    85 
       
    86 function AddAction(Action, Param, TimeDelta: Longword): PAction;
       
    87 begin
       
    88 New(Result);
       
    89 TryDo(Result <> nil, errmsgDynamicVar, true);
       
    90 FillChar(Result^, sizeof(TAction), 0);
       
    91 Result.Action:= Action;
       
    92 Result.Param:= Param;
       
    93 if ActionList = nil then
       
    94    begin
       
    95    Result.Time:= GameTicks + TimeDelta;
       
    96    ActionList:= Result;
       
    97    FinAction := Result
       
    98    end else
       
    99    begin
       
   100    Result.Time:= TimeDelta;
       
   101    FinAction.Next:= Result;
       
   102    FinAction:= Result
       
   103    end
       
   104 end;
       
   105 
       
   106 procedure DeleteCurrAction;
       
   107 var t: PAction;
       
   108 begin
       
   109 t:= ActionList;
       
   110 ActionList:= ActionList.Next;
       
   111 if ActionList = nil then FinAction:= nil
       
   112                     else inc(ActionList.Time, t.Time);
       
   113 Dispose(t)
       
   114 end;
       
   115 
       
   116 function IsActionListEmpty: boolean;
       
   117 begin
       
   118 Result:= ActionList = nil
       
   119 end;
       
   120 
       
   121 procedure FreeActionsList;
       
   122 begin
       
   123 while ActionList <> nil do DeleteCurrAction;
       
   124 end;
       
   125 
       
   126 procedure SetWeapon(weap: Longword);
       
   127 var t: integer;
       
   128 begin
       
   129 t:= 0;
       
   130 with CurrentTeam^ do
       
   131      with Hedgehogs[CurrHedgehog] do
       
   132           while Ammo[CurSlot, CurAmmo].AmmoType <> TAmmotype(weap) do
       
   133                 begin
       
   134                 ParseCommand('/slot ' + chr(49 + Ammoz[TAmmoType(weap)].Slot));
       
   135                 inc(t);
       
   136                 if t > 10 then OutError('AI: incorrect try to change weapon!', true)
       
   137                 end
       
   138 end;
       
   139 
       
   140 procedure ProcessAction;
       
   141 var s: shortstring;
       
   142 begin
       
   143 if ActionList = nil then exit;
       
   144 with ActionList^ do
       
   145      begin
       
   146      if Time > GameTicks then exit;
       
   147      if (Action and ai_specmask) <> 0 then
       
   148         case Action of
       
   149            aia_Weapon: SetWeapon(Param);
       
   150             aia_WaitX: with CurrentTeam^ do
       
   151                             with Hedgehogs[CurrHedgehog] do
       
   152                                  if round(Gear.X) = Param then Time:= GameTicks
       
   153                                                           else exit;
       
   154             aia_WaitY: with CurrentTeam^ do
       
   155                             with Hedgehogs[CurrHedgehog] do
       
   156                                  if round(Gear.Y) = Param then Time:= GameTicks
       
   157                                                           else exit;
       
   158          aia_LookLeft: with CurrentTeam^ do
       
   159                             with Hedgehogs[CurrHedgehog] do
       
   160                                  if Gear.dX >= 0 then
       
   161                                     begin
       
   162                                     ParseCommand('+left');
       
   163                                     exit
       
   164                                     end else ParseCommand('-left');
       
   165         aia_LookRight: with CurrentTeam^ do
       
   166                             with Hedgehogs[CurrHedgehog] do
       
   167                                  if Gear.dX < 0 then
       
   168                                     begin
       
   169                                     ParseCommand('+right');
       
   170                                     exit
       
   171                                     end else ParseCommand('-right');
       
   172              end else
       
   173         begin
       
   174         s:= ActionIdToStr[Action];
       
   175         if (Param and ai_specmask) <> 0 then
       
   176            case Param of
       
   177              aim_push: s:= '+' + s;
       
   178           aim_release: s:= '-' + s;
       
   179              end
       
   180           else if Param <> 0 then s:= s + ' ' + inttostr(Param);
       
   181         ParseCommand(s)
       
   182         end
       
   183      end;
       
   184 DeleteCurrAction
       
   185 end;
       
   186 
       
   187 end.