hedgewars/uCommands.pas
author koda
Sat, 04 Dec 2010 08:52:57 +0100
changeset 4454 42bfc1a70968
parent 4414 cb90b7f82cd5
child 4555 85150dfb5959
permissions -rw-r--r--
more retina support and multitasking support
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
4373
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
     1
{$INCLUDE "options.inc"}
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
     2
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
     3
unit uCommands;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
     4
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
     5
interface
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
     6
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
     7
var isDeveloperMode: boolean;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
     8
type TVariableType = (vtCommand, vtLongInt, vthwFloat, vtBoolean);
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
     9
     TCommandHandler = procedure (var params: shortstring);
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    10
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    11
procedure initModule;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    12
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
    13
procedure RegisterVariable(Name: shortstring; VType: TVariableType; p: pointer; Trusted: boolean);
4373
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    14
procedure ParseCommand(CmdStr: shortstring; TrustedSource: boolean);
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    15
procedure StopMessages(Message: Longword);
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    16
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    17
implementation
4414
cb90b7f82cd5 Move doPut into uIO (not a very bad place really)
unc0rr
parents: 4413
diff changeset
    18
uses Types, uConsts, uVariables, uConsole, uUtils, uDebug;
4373
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    19
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    20
type  PVariable = ^TVariable;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    21
      TVariable = record
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    22
                     Next: PVariable;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    23
                     Name: string[15];
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    24
                    VType: TVariableType;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    25
                  Handler: pointer;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    26
                  Trusted: boolean;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    27
                  end;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    28
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    29
var
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    30
      Variables: PVariable;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    31
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
    32
procedure RegisterVariable(Name: shortstring; VType: TVariableType; p: pointer; Trusted: boolean);
4373
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    33
var value: PVariable;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    34
begin
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    35
New(value);
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    36
TryDo(value <> nil, 'RegisterVariable: value = nil', true);
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    37
FillChar(value^, sizeof(TVariable), 0);
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    38
value^.Name:= Name;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    39
value^.VType:= VType;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    40
value^.Handler:= p;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    41
value^.Trusted:= Trusted;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    42
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    43
if Variables = nil then Variables:= value
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    44
                   else begin
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    45
                        value^.Next:= Variables;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    46
                        Variables:= value
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    47
                        end;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    48
end;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    49
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    50
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    51
procedure ParseCommand(CmdStr: shortstring; TrustedSource: boolean);
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    52
var ii: LongInt;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    53
    s: shortstring;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    54
    t: PVariable;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    55
    c: char;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    56
begin
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    57
//WriteLnToConsole(CmdStr);
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    58
if CmdStr[0]=#0 then exit;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    59
{$IFDEF DEBUGFILE}AddFileLog('ParseCommand "' + CmdStr + '"');{$ENDIF}
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    60
c:= CmdStr[1];
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    61
if c in ['/', '$'] then Delete(CmdStr, 1, 1) else c:= '/';
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    62
s:= '';
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    63
SplitBySpace(CmdStr, s);
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    64
t:= Variables;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    65
while t <> nil do
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    66
      begin
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    67
      if t^.Name = CmdStr then
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    68
         begin
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    69
         if TrustedSource or t^.Trusted then
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    70
            case t^.VType of
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    71
              vtCommand: if c='/' then
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    72
                         begin
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    73
                         TCommandHandler(t^.Handler)(s);
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    74
                         end;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    75
              vtLongInt: if c='$' then
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    76
                         if s[0]=#0 then
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    77
                            begin
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    78
                            str(PLongInt(t^.Handler)^, s);
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    79
                            WriteLnToConsole('$' + CmdStr + ' is "' + s + '"');
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    80
                            end else val(s, PLongInt(t^.Handler)^);
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    81
              vthwFloat: if c='$' then
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    82
                         if s[0]=#0 then
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    83
                            begin
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    84
                            //str(PhwFloat(t^.Handler)^:4:6, s);
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    85
                            WriteLnToConsole('$' + CmdStr + ' is "' + s + '"');
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    86
                            end else; //val(s, PhwFloat(t^.Handler)^, i);
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    87
             vtBoolean: if c='$' then
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    88
                         if s[0]=#0 then
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    89
                            begin
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    90
                            str(ord(boolean(t^.Handler^)), s);
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    91
                            WriteLnToConsole('$' + CmdStr + ' is "' + s + '"');
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    92
                            end else
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    93
                            begin
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    94
                            val(s, ii);
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    95
                            boolean(t^.Handler^):= not (ii = 0)
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    96
                            end;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    97
              end;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    98
         exit
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
    99
         end else t:= t^.Next
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   100
      end;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   101
case c of
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   102
     '$': WriteLnToConsole(errmsgUnknownVariable + ': "$' + CmdStr + '"')
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   103
     else WriteLnToConsole(errmsgUnknownCommand  + ': "/' + CmdStr + '"') end
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   104
end;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   105
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   106
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   107
procedure StopMessages(Message: Longword);
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   108
begin
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   109
if (Message and gmLeft) <> 0 then ParseCommand('/-left', true) else
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   110
if (Message and gmRight) <> 0 then ParseCommand('/-right', true) else
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   111
if (Message and gmUp) <> 0 then ParseCommand('/-up', true) else
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   112
if (Message and gmDown) <> 0 then ParseCommand('/-down', true) else
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   113
if (Message and gmAttack) <> 0 then ParseCommand('/-attack', true)
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   114
end;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   115
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   116
procedure initModule;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   117
begin
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   118
    Variables:= nil;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   119
    isDeveloperMode:= true;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   120
end;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   121
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   122
procedure freeModule;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   123
var t, tt: PVariable;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   124
begin
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   125
    tt:= Variables;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   126
    Variables:= nil;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   127
    while tt <> nil do
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   128
    begin
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   129
        t:= tt;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   130
        tt:= tt^.Next;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   131
        Dispose(t)
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   132
    end;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   133
end;
fe0e3903bb9e Introduce uCommands.pas
unC0Rr
parents:
diff changeset
   134
4406
beb4de0af990 Increase teams to 8 to match the 8 colours, fix issue #108, reenable rope length modifier
nemo
parents: 4403
diff changeset
   135
end.