hedgewars/uCommands.pas
author bovi
Sat, 14 Jan 2012 05:03:21 +0100
changeset 6560 ca07e6be08d0
parent 6450 14224c9b4594
child 6580 6155187bf599
permissions -rw-r--r--
GCI task: cmd.exe
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
4976
088d40d8aba2 Happy 2011 :)
koda
parents: 4900
diff changeset
     1
(*
088d40d8aba2 Happy 2011 :)
koda
parents: 4900
diff changeset
     2
 * Hedgewars, a free turn based strategy game
088d40d8aba2 Happy 2011 :)
koda
parents: 4900
diff changeset
     3
 * Copyright (c) 2004-2011 Andrey Korotaev <unC0Rr@gmail.com>
088d40d8aba2 Happy 2011 :)
koda
parents: 4900
diff changeset
     4
 *
088d40d8aba2 Happy 2011 :)
koda
parents: 4900
diff changeset
     5
 * This program is free software; you can redistribute it and/or modify
088d40d8aba2 Happy 2011 :)
koda
parents: 4900
diff changeset
     6
 * it under the terms of the GNU General Public License as published by
088d40d8aba2 Happy 2011 :)
koda
parents: 4900
diff changeset
     7
 * the Free Software Foundation; version 2 of the License
088d40d8aba2 Happy 2011 :)
koda
parents: 4900
diff changeset
     8
 *
088d40d8aba2 Happy 2011 :)
koda
parents: 4900
diff changeset
     9
 * This program is distributed in the hope that it will be useful,
088d40d8aba2 Happy 2011 :)
koda
parents: 4900
diff changeset
    10
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
088d40d8aba2 Happy 2011 :)
koda
parents: 4900
diff changeset
    11
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
088d40d8aba2 Happy 2011 :)
koda
parents: 4900
diff changeset
    12
 * GNU General Public License for more details.
088d40d8aba2 Happy 2011 :)
koda
parents: 4900
diff changeset
    13
 *
088d40d8aba2 Happy 2011 :)
koda
parents: 4900
diff changeset
    14
 * You should have received a copy of the GNU General Public License
088d40d8aba2 Happy 2011 :)
koda
parents: 4900
diff changeset
    15
 * along with this program; if not, write to the Free Software
088d40d8aba2 Happy 2011 :)
koda
parents: 4900
diff changeset
    16
 * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
088d40d8aba2 Happy 2011 :)
koda
parents: 4900
diff changeset
    17
 *)
088d40d8aba2 Happy 2011 :)
koda
parents: 4900
diff changeset
    18
4373
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    19
{$INCLUDE "options.inc"}
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    20
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    21
unit uCommands;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    22
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    23
interface
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    24
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    25
var isDeveloperMode: boolean;
6450
14224c9b4594 - Improvement to the parser
unc0rr
parents: 5554
diff changeset
    26
type TVariableType = (vtCommand, vtLongInt, vtBoolean);
4373
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    27
     TCommandHandler = procedure (var params: shortstring);
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    28
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    29
procedure initModule;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    30
procedure freeModule;
4398
36d7e4b6ca81 Move some command handlers out of uCommands into more appropriate places, thus removing some dependencies. Ideally uCommands shouldn't depend on anything (except for uTypes and uConsts probably)
unc0rr
parents: 4396
diff changeset
    31
procedure RegisterVariable(Name: shortstring; VType: TVariableType; p: pointer; Trusted: boolean);
4373
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    32
procedure ParseCommand(CmdStr: shortstring; TrustedSource: boolean);
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    33
procedure StopMessages(Message: Longword);
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    34
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    35
implementation
5554
b27ed6c6f538 Revert ParseCommandOverride change since it appears to be badly screwing up scripting. Need to find out why. This backs out 7f57d0c7816a and the recent workaround.
nemo
parents: 5352
diff changeset
    36
uses Types, uConsts, uVariables, uConsole, uUtils, uDebug;
4373
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    37
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    38
type  PVariable = ^TVariable;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    39
      TVariable = record
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    40
                     Next: PVariable;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    41
                     Name: string[15];
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    42
                    VType: TVariableType;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    43
                  Handler: pointer;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    44
                  Trusted: boolean;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    45
                  end;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    46
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    47
var
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    48
      Variables: PVariable;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    49
4398
36d7e4b6ca81 Move some command handlers out of uCommands into more appropriate places, thus removing some dependencies. Ideally uCommands shouldn't depend on anything (except for uTypes and uConsts probably)
unc0rr
parents: 4396
diff changeset
    50
procedure RegisterVariable(Name: shortstring; VType: TVariableType; p: pointer; Trusted: boolean);
4373
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    51
var value: PVariable;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    52
begin
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    53
New(value);
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    54
TryDo(value <> nil, 'RegisterVariable: value = nil', true);
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    55
FillChar(value^, sizeof(TVariable), 0);
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    56
value^.Name:= Name;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    57
value^.VType:= VType;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    58
value^.Handler:= p;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    59
value^.Trusted:= Trusted;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    60
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    61
if Variables = nil then Variables:= value
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    62
                   else begin
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    63
                        value^.Next:= Variables;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    64
                        Variables:= value
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    65
                        end;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    66
end;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    67
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    68
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    69
procedure ParseCommand(CmdStr: shortstring; TrustedSource: boolean);
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    70
var ii: LongInt;
5554
b27ed6c6f538 Revert ParseCommandOverride change since it appears to be badly screwing up scripting. Need to find out why. This backs out 7f57d0c7816a and the recent workaround.
nemo
parents: 5352
diff changeset
    71
    s: shortstring;
4373
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    72
    t: PVariable;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    73
    c: char;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    74
begin
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    75
//WriteLnToConsole(CmdStr);
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    76
if CmdStr[0]=#0 then exit;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    77
c:= CmdStr[1];
6450
14224c9b4594 - Improvement to the parser
unc0rr
parents: 5554
diff changeset
    78
if (c = '/') or (c = '$') then Delete(CmdStr, 1, 1) else c:= '/';
4373
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    79
s:= '';
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    80
SplitBySpace(CmdStr, s);
4900
8ad0e23e6d63 addfilelog <3 debugfile
koda
parents: 4650
diff changeset
    81
AddFileLog('[Cmd] ' + c + CmdStr + ' (' + inttostr(length(s)) + ')');
4373
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    82
t:= Variables;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    83
while t <> nil do
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    84
      begin
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    85
      if t^.Name = CmdStr then
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    86
         begin
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    87
         if TrustedSource or t^.Trusted then
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    88
            case t^.VType of
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    89
              vtCommand: if c='/' then
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    90
                         begin
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    91
                         TCommandHandler(t^.Handler)(s);
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    92
                         end;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    93
              vtLongInt: if c='$' then
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    94
                         if s[0]=#0 then
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    95
                            begin
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    96
                            str(PLongInt(t^.Handler)^, s);
5554
b27ed6c6f538 Revert ParseCommandOverride change since it appears to be badly screwing up scripting. Need to find out why. This backs out 7f57d0c7816a and the recent workaround.
nemo
parents: 5352
diff changeset
    97
                            WriteLnToConsole('$' + CmdStr + ' is "' + s + '"');
b27ed6c6f538 Revert ParseCommandOverride change since it appears to be badly screwing up scripting. Need to find out why. This backs out 7f57d0c7816a and the recent workaround.
nemo
parents: 5352
diff changeset
    98
                            end else val(s, PLongInt(t^.Handler)^);
4373
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    99
             vtBoolean: if c='$' then
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   100
                         if s[0]=#0 then
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   101
                            begin
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   102
                            str(ord(boolean(t^.Handler^)), s);
5554
b27ed6c6f538 Revert ParseCommandOverride change since it appears to be badly screwing up scripting. Need to find out why. This backs out 7f57d0c7816a and the recent workaround.
nemo
parents: 5352
diff changeset
   103
                            WriteLnToConsole('$' + CmdStr + ' is "' + s + '"');
b27ed6c6f538 Revert ParseCommandOverride change since it appears to be badly screwing up scripting. Need to find out why. This backs out 7f57d0c7816a and the recent workaround.
nemo
parents: 5352
diff changeset
   104
                            end else
4373
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   105
                            begin
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   106
                            val(s, ii);
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   107
                            boolean(t^.Handler^):= not (ii = 0)
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   108
                            end;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   109
              end;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   110
         exit
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   111
         end else t:= t^.Next
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   112
      end;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   113
case c of
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   114
     '$': WriteLnToConsole(errmsgUnknownVariable + ': "$' + CmdStr + '"')
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   115
     else WriteLnToConsole(errmsgUnknownCommand  + ': "/' + CmdStr + '"') end
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   116
end;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   117
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   118
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   119
procedure StopMessages(Message: Longword);
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   120
begin
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   121
if (Message and gmLeft) <> 0 then ParseCommand('/-left', true) else
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   122
if (Message and gmRight) <> 0 then ParseCommand('/-right', true) else
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   123
if (Message and gmUp) <> 0 then ParseCommand('/-up', true) else
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   124
if (Message and gmDown) <> 0 then ParseCommand('/-down', true) else
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   125
if (Message and gmAttack) <> 0 then ParseCommand('/-attack', true)
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   126
end;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   127
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   128
procedure initModule;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   129
begin
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   130
    Variables:= nil;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   131
    isDeveloperMode:= true;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   132
end;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   133
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   134
procedure freeModule;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   135
var t, tt: PVariable;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   136
begin
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   137
    tt:= Variables;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   138
    Variables:= nil;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   139
    while tt <> nil do
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   140
    begin
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   141
        t:= tt;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   142
        tt:= tt^.Next;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   143
        Dispose(t)
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   144
    end;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   145
end;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   146
4406
beb4de0af990 Increase teams to 8 to match the 8 colours, fix issue #108, reenable rope length modifier
nemo
parents: 4403
diff changeset
   147
end.