src/game/g_console.pas

   1 (* Copyright (C)  Doom 2D: Forever Developers
   2  *
   3  * This program is free software: you can redistribute it and/or modify
   4  * it under the terms of the GNU General Public License as published by
   5  * the Free Software Foundation, either version 3 of the License, or
   6  * (at your option) any later version.
   7  *
   8  * This program is distributed in the hope that it will be useful,
   9  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11  * GNU General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU General Public License
  14  * along with this program.  If not, see <http://www.gnu.org/licenses/>.
  15  *)
  16 {$INCLUDE ../shared/a_modes.inc}
  17 unit g_console;
  18
  19 interface
  20
  21 uses
  22   utils; // for SSArray
  23
  24   const
  25     ACTION_JUMP = 0;
  26     ACTION_MOVELEFT = 1;
  27     ACTION_MOVERIGHT = 2;
  28     ACTION_LOOKDOWN = 3;
  29     ACTION_LOOKUP = 4;
  30     ACTION_ATTACK = 5;
  31     ACTION_SCORES = 6;
  32     ACTION_ACTIVATE = 7;
  33     ACTION_STRAFE = 8;
  34     ACTION_WEAPNEXT = 9;
  35     ACTION_WEAPPREV = 10;
  36
  37     FIRST_ACTION = ACTION_JUMP;
  38     LAST_ACTION = ACTION_WEAPPREV;
  39
  40 procedure g_Console_Init ();
  41 procedure g_Console_Update ();
  42 procedure g_Console_Draw ();
  43 procedure g_Console_Switch ();
  44 procedure g_Console_Char (C: AnsiChar);
  45 procedure g_Console_Control (K: Word);
  46 procedure g_Console_Process (L: AnsiString; quiet: Boolean=false);
  47 procedure g_Console_Add (L: AnsiString; show: Boolean=false);
  48 procedure g_Console_Clear ();
  49 function  g_Console_CommandBlacklisted (C: AnsiString): Boolean;
  50 procedure g_Console_ReadConfig (filename: String);
  51
  52 function  g_Console_Interactive: Boolean;
  53 function  g_Console_Action (action: Integer): Boolean;
  54 procedure g_Console_ProcessBind (key: Integer; down: Boolean);
  55
  56 procedure conwriteln (const s: AnsiString; show: Boolean=false);
  57 procedure conwritefln (const s: AnsiString; args: array of const; show: Boolean=false);
  58
  59 // <0: no arg; 0/1: true/false
  60 function conGetBoolArg (p: SSArray; idx: Integer): Integer;
  61
  62 procedure g_Console_Chat_Switch (team: Boolean=false);
  63
  64 procedure conRegVar (const conname: AnsiString; pvar: PBoolean; const ahelp: AnsiString; const amsg: AnsiString; acheat: Boolean=false; ahidden: Boolean=false); overload;
  65 procedure conRegVar (const conname: AnsiString; pvar: PSingle; amin, amax: Single; const ahelp: AnsiString; const amsg: AnsiString; acheat: Boolean=false; ahidden: Boolean=false); overload;
  66 procedure conRegVar (const conname: AnsiString; pvar: PInteger; const ahelp: AnsiString; const amsg: AnsiString; acheat: Boolean=false; ahidden: Boolean=false); overload;
  67
  68 // poor man's floating literal parser; i'm sorry, but `StrToFloat()` sux cocks
  69 function conParseFloat (var res: Single; const s: AnsiString): Boolean;
  70
  71
  72 var
  73   gConsoleShow: Boolean = false; // True - êîíñîëü îòêðûòà èëè îòêðûâàåòñÿ
  74   gChatShow: Boolean = false;
  75   gChatTeam: Boolean = false;
  76   gAllowConsoleMessages: Boolean = true;
  77   gJustChatted: Boolean = false; // ÷òîáû àäìèí â èíòåðå ÷àòÿñü íå ïðîìàòûâàë ñòàòèñòèêó
  78   gPlayerAction, gDefaultAction: Array [0..1, 0..LAST_ACTION] of Boolean; // [player, action]
  79
  80 implementation
  81
  82 uses
  83   g_textures, g_main, e_graphics, e_input, g_game,
  84   SysUtils, g_basic, g_options, Math, g_touch,
  85   g_menu, g_language, g_net, g_netmsg, e_log, conbuf;
  86
  87
  88 type
  89   PCommand = ^TCommand;
  90
  91   TCmdProc = procedure (p: SSArray);
  92   TCmdProcEx = procedure (me: PCommand; p: SSArray);
  93
  94   TCommand = record
  95     cmd: AnsiString;
  96     proc: TCmdProc;
  97     procEx: TCmdProcEx;
  98     help: AnsiString;
  99     hidden: Boolean;
 100     ptr: Pointer; // various data
 101     msg: AnsiString; // message for var changes
 102     cheat: Boolean;
 103     action: Integer; // >= 0 for action commands
 104     player: Integer; // used for action commands
 105   end;
 106
 107   TAlias = record
 108     name: AnsiString;
 109     commands: SSArray;
 110   end;
 111
 112
 113 const
 114   Step = 32;
 115   Alpha = 25;
 116   MsgTime = 144;
 117   MaxScriptRecursion = 16;
 118
 119   DEBUG_STRING = 'DEBUG MODE';
 120
 121 var
 122   ID: DWORD;
 123   RecursionDepth: Word = 0;
 124   RecursionLimitHit: Boolean = False;
 125   Cons_Y: SmallInt;
 126   Cons_Shown: Boolean; // Ðèñîâàòü ëè êîíñîëü?
 127   Line: AnsiString;
 128   CPos: Word;
 129   //ConsoleHistory: SSArray;
 130   CommandHistory: SSArray;
 131   Whitelist: SSArray;
 132   commands: Array of TCommand = nil;
 133   Aliases: Array of TAlias = nil;
 134   CmdIndex: Word;
 135   conSkipLines: Integer = 0;
 136   MsgArray: Array [0..4] of record
 137                               Msg: AnsiString;
 138                               Time: Word;
 139                             end;
 140
 141   bindDown, bindProcess: Boolean;
 142   gInputBinds: Array [0..e_MaxInputKeys - 1] of record
 143     commands: SSArray;
 144   end;
 145
 146
 147 // poor man's floating literal parser; i'm sorry, but `StrToFloat()` sux cocks
 148 function conParseFloat (var res: Single; const s: AnsiString): Boolean;
 149 var
 150   pos: Integer = 1;
 151   frac: Single = 1;
 152   slen: Integer;
 153 begin
 154   result := false;
 155   res := 0;
 156   slen := Length(s);
 157   while (slen > 0) and (s[slen] <= ' ') do Dec(slen);
 158   while (pos <= slen) and (s[pos] <= ' ') do Inc(pos);
 159   if (pos > slen) then exit;
 160   if (slen-pos = 1) and (s[pos] = '.') then exit; // single dot
 161   // integral part
 162   while (pos <= slen) do
 163   begin
 164     if (s[pos] < '0') or (s[pos] > '9') then break;
 165     res := res*10+Byte(s[pos])-48;
 166     Inc(pos);
 167   end;
 168   if (pos <= slen) then
 169   begin
 170     // must be a dot
 171     if (s[pos] <> '.') then exit;
 172     Inc(pos);
 173     while (pos <= slen) do
 174     begin
 175       if (s[pos] < '0') or (s[pos] > '9') then break;
 176       frac := frac/10;
 177       res += frac*(Byte(s[pos])-48);
 178       Inc(pos);
 179     end;
 180   end;
 181   if (pos <= slen) then exit; // oops
 182   result := true;
 183 end;
 184
 185
 186 // ////////////////////////////////////////////////////////////////////////// //
 187 // <0: no arg; 0/1: true/false; 666: toggle
 188 function conGetBoolArg (p: SSArray; idx: Integer): Integer;
 189 begin
 190   if (idx < 0) or (idx > High(p)) then begin result := -1; exit; end;
 191   result := 0;
 192   if (p[idx] = '1') or (CompareText(p[idx], 'on') = 0) or (CompareText(p[idx], 'true') = 0) or
 193      (CompareText(p[idx], 'tan') = 0) or (CompareText(p[idx], 'yes') = 0) then result := 1
 194   else if (CompareText(p[idx], 'toggle') = 0) or (CompareText(p[idx], 'switch') = 0) or
 195           (CompareText(p[idx], 't') = 0) then result := 666;
 196 end;
 197
 198
 199 procedure boolVarHandler (me: PCommand; p: SSArray);
 200   procedure binaryFlag (var flag: Boolean; msg: AnsiString);
 201   begin
 202     if (Length(p) > 2) then
 203     begin
 204       conwritefln('too many arguments to ''%s''', [p[0]]);
 205     end
 206     else
 207     begin
 208       case conGetBoolArg(p, 1) of
 209         -1: begin end;
 210          0: if not me.cheat or conIsCheatsEnabled then flag := false else begin conwriteln('not available'); exit; end;
 211          1: if not me.cheat or conIsCheatsEnabled then flag := true else begin conwriteln('not available'); exit; end;
 212          666: if not me.cheat or conIsCheatsEnabled then flag := not flag else begin conwriteln('not available'); exit; end;
 213       end;
 214       if (Length(msg) = 0) then msg := p[0] else msg += ':';
 215       if flag then conwritefln('%s tan', [msg]) else conwritefln('%s ona', [msg]);
 216     end;
 217   end;
 218 begin
 219   binaryFlag(PBoolean(me.ptr)^, me.msg);
 220 end;
 221
 222
 223 procedure intVarHandler (me: PCommand; p: SSArray);
 224   procedure binaryFlag (var flag: Boolean; msg: AnsiString);
 225   begin
 226     if (Length(p) > 2) then
 227     begin
 228       conwritefln('too many arguments to ''%s''', [p[0]]);
 229     end
 230     else
 231     begin
 232       case conGetBoolArg(p, 1) of
 233         -1: begin end;
 234          0: if not me.cheat or conIsCheatsEnabled then flag := false else begin conwriteln('not available'); exit; end;
 235          1: if not me.cheat or conIsCheatsEnabled then flag := true else begin conwriteln('not available'); exit; end;
 236          666: if not me.cheat or conIsCheatsEnabled then flag := not flag else begin conwriteln('not available'); exit; end;
 237       end;
 238       if (Length(msg) = 0) then msg := p[0] else msg += ':';
 239       if flag then conwritefln('%s tan', [msg]) else conwritefln('%s ona', [msg]);
 240     end;
 241   end;
 242 begin
 243   if (Length(p) <> 2) then
 244   begin
 245     conwritefln('%s %d', [me.cmd, PInteger(me.ptr)^]);
 246   end
 247   else
 248   begin
 249     try
 250       PInteger(me.ptr)^ := StrToInt(p[1]);
 251     except
 252       conwritefln('invalid integer value: "%s"', [p[1]]);
 253     end;
 254   end;
 255 end;
 256
 257
 258 procedure conRegVar (const conname: AnsiString; pvar: PBoolean; const ahelp: AnsiString; const amsg: AnsiString; acheat: Boolean=false; ahidden: Boolean=false); overload;
 259 var
 260   f: Integer;
 261   cp: PCommand;
 262 begin
 263   f := Length(commands);
 264   SetLength(commands, f+1);
 265   cp := @commands[f];
 266   cp.cmd := LowerCase(conname);
 267   cp.proc := nil;
 268   cp.procEx := boolVarHandler;
 269   cp.help := ahelp;
 270   cp.hidden := ahidden;
 271   cp.ptr := pvar;
 272   cp.msg := amsg;
 273   cp.cheat := acheat;
 274   cp.action := -1;
 275   cp.player := -1;
 276 end;
 277
 278
 279 procedure conRegVar (const conname: AnsiString; pvar: PInteger; const ahelp: AnsiString; const amsg: AnsiString; acheat: Boolean=false; ahidden: Boolean=false); overload;
 280 var
 281   f: Integer;
 282   cp: PCommand;
 283 begin
 284   f := Length(commands);
 285   SetLength(commands, f+1);
 286   cp := @commands[f];
 287   cp.cmd := LowerCase(conname);
 288   cp.proc := nil;
 289   cp.procEx := intVarHandler;
 290   cp.help := ahelp;
 291   cp.hidden := ahidden;
 292   cp.ptr := pvar;
 293   cp.msg := amsg;
 294   cp.cheat := acheat;
 295   cp.action := -1;
 296   cp.player := -1;
 297 end;
 298
 299
 300 // ////////////////////////////////////////////////////////////////////////// //
 301 type
 302   PVarSingle = ^TVarSingle;
 303   TVarSingle = record
 304     val: PSingle;
 305     min, max, def: Single; // default will be starting value
 306   end;
 307
 308
 309 procedure singleVarHandler (me: PCommand; p: SSArray);
 310 var
 311   pv: PVarSingle;
 312   nv: Single;
 313   msg: AnsiString;
 314 begin
 315   if (Length(p) > 2) then
 316   begin
 317     conwritefln('too many arguments to ''%s''', [me.cmd]);
 318     exit;
 319   end;
 320   pv := PVarSingle(me.ptr);
 321   if (Length(p) = 2) then
 322   begin
 323     if me.cheat and (not conIsCheatsEnabled) then begin conwriteln('not available'); exit; end;
 324     if (CompareText(p[1], 'default') = 0) or (CompareText(p[1], 'def') = 0) or
 325        (CompareText(p[1], 'd') = 0) or (CompareText(p[1], 'off') = 0) or
 326        (CompareText(p[1], 'ona') = 0) then
 327     begin
 328       pv.val^ := pv.def;
 329     end
 330     else
 331     begin
 332       if not conParseFloat(nv, p[1]) then
 333       begin
 334         conwritefln('%s: ''%s'' doesn''t look like a floating number', [me.cmd, p[1]]);
 335         exit;
 336       end;
 337       if (nv < pv.min) then nv := pv.min;
 338       if (nv > pv.max) then nv := pv.max;
 339       pv.val^ := nv;
 340     end;
 341   end;
 342   msg := me.msg;
 343   if (Length(msg) = 0) then msg := me.cmd else msg += ':';
 344   conwritefln('%s %s', [msg, pv.val^]);
 345 end;
 346
 347
 348 procedure conRegVar (const conname: AnsiString; pvar: PSingle; amin, amax: Single; const ahelp: AnsiString; const amsg: AnsiString; acheat: Boolean=false; ahidden: Boolean=false); overload;
 349 var
 350   f: Integer;
 351   cp: PCommand;
 352   pv: PVarSingle;
 353 begin
 354   GetMem(pv, sizeof(TVarSingle));
 355   pv.val := pvar;
 356   pv.min := amin;
 357   pv.max := amax;
 358   pv.def := pvar^;
 359   f := Length(commands);
 360   SetLength(commands, f+1);
 361   cp := @commands[f];
 362   cp.cmd := LowerCase(conname);
 363   cp.proc := nil;
 364   cp.procEx := singleVarHandler;
 365   cp.help := ahelp;
 366   cp.hidden := ahidden;
 367   cp.ptr := pv;
 368   cp.msg := amsg;
 369   cp.cheat := acheat;
 370   cp.action := -1;
 371   cp.player := -1;
 372 end;
 373
 374
 375 // ////////////////////////////////////////////////////////////////////////// //
 376 function GetStrACmd(var Str: AnsiString): AnsiString;
 377 var
 378   a: Integer;
 379 begin
 380   Result := '';
 381   for a := 1 to Length(Str) do
 382     if (a = Length(Str)) or (Str[a+1] = ';') then
 383     begin
 384       Result := Copy(Str, 1, a);
 385       Delete(Str, 1, a+1);
 386       Str := Trim(Str);
 387       Exit;
 388     end;
 389 end;
 390
 391 function ParseAlias(Str: AnsiString): SSArray;
 392 begin
 393   Result := nil;
 394
 395   Str := Trim(Str);
 396
 397   if Str = '' then
 398     Exit;
 399
 400   while Str <> '' do
 401   begin
 402     SetLength(Result, Length(Result)+1);
 403     Result[High(Result)] := GetStrACmd(Str);
 404   end;
 405 end;
 406
 407 procedure ConsoleCommands(p: SSArray);
 408 var
 409   cmd, s: AnsiString;
 410   a, b: Integer;
 411   (* F: TextFile; *)
 412 begin
 413   cmd := LowerCase(p[0]);
 414   s := '';
 415
 416   if cmd = 'clear' then
 417   begin
 418     //ConsoleHistory := nil;
 419     cbufClear();
 420     conSkipLines := 0;
 421
 422     for a := 0 to High(MsgArray) do
 423       with MsgArray[a] do
 424       begin
 425         Msg := '';
 426         Time := 0;
 427       end;
 428   end;
 429
 430   if cmd = 'clearhistory' then
 431     CommandHistory := nil;
 432
 433   if cmd = 'showhistory' then
 434     if CommandHistory <> nil then
 435     begin
 436       g_Console_Add('');
 437       for a := 0 to High(CommandHistory) do
 438         g_Console_Add('  '+CommandHistory[a]);
 439     end;
 440
 441   if cmd = 'commands' then
 442   begin
 443     g_Console_Add('');
 444     g_Console_Add('commands list:');
 445     for a := High(commands) downto 0 do
 446     begin
 447       if (Length(commands[a].help) > 0) then
 448       begin
 449         g_Console_Add('  '+commands[a].cmd+' -- '+commands[a].help);
 450       end
 451       else
 452       begin
 453         g_Console_Add('  '+commands[a].cmd);
 454       end;
 455     end;
 456   end;
 457
 458   if cmd = 'time' then
 459     g_Console_Add(TimeToStr(Now), True);
 460
 461   if cmd = 'date' then
 462     g_Console_Add(DateToStr(Now), True);
 463
 464   if cmd = 'echo' then
 465     if Length(p) > 1 then
 466       begin
 467         if p[1] = 'ololo' then
 468           gCheats := True
 469         else
 470         begin
 471           s := '';
 472           for a := 1 to High(p) do
 473             s := s + p[a] + ' ';
 474           g_Console_Add(b_Text_Format(s), True);
 475         end;
 476       end
 477     else
 478       g_Console_Add('');
 479
 480   if cmd = 'dump' then
 481   begin
 482     (*
 483     if ConsoleHistory <> nil then
 484     begin
 485       if Length(P) > 1 then
 486         s := P[1]
 487       else
 488         s := GameDir+'/console.txt';
 489
 490       {$I-}
 491       AssignFile(F, s);
 492       Rewrite(F);
 493       if IOResult <> 0 then
 494       begin
 495         g_Console_Add(Format(_lc[I_CONSOLE_ERROR_WRITE], [s]));
 496         CloseFile(F);
 497         Exit;
 498       end;
 499
 500       for a := 0 to High(ConsoleHistory) do
 501         WriteLn(F, ConsoleHistory[a]);
 502
 503       CloseFile(F);
 504       g_Console_Add(Format(_lc[I_CONSOLE_DUMPED], [s]));
 505       {$I+}
 506     end;
 507     *)
 508   end;
 509
 510   if cmd = 'exec' then
 511   begin
 512     // exec <filename>
 513     if Length(p) = 2 then
 514     begin
 515       s := GameDir + '/' + p[1];
 516       g_Console_ReadConfig(s);
 517     end
 518     else
 519       g_Console_Add('exec <script file>');
 520   end;
 521
 522   if (cmd = 'ver') or (cmd = 'version') then
 523   begin
 524     conwriteln('Doom 2D: Forever v. ' + GAME_VERSION);
 525     conwritefln('Net protocol v. %d', [NET_PROTOCOL_VER]);
 526     conwritefln('Build date: %s at %s', [GAME_BUILDDATE, GAME_BUILDTIME]);
 527   end;
 528
 529   if cmd = 'alias' then
 530   begin
 531     // alias [alias_name] [commands]
 532     if Length(p) > 1 then
 533     begin
 534       for a := 0 to High(Aliases) do
 535         if Aliases[a].name = p[1] then
 536         begin
 537           if Length(p) > 2 then
 538             Aliases[a].commands := ParseAlias(p[2])
 539           else
 540             for b := 0 to High(Aliases[a].commands) do
 541               g_Console_Add(Aliases[a].commands[b]);
 542           Exit;
 543         end;
 544       SetLength(Aliases, Length(Aliases)+1);
 545       a := High(Aliases);
 546       Aliases[a].name := p[1];
 547       if Length(p) > 2 then
 548         Aliases[a].commands := ParseAlias(p[2])
 549       else
 550         for b := 0 to High(Aliases[a].commands) do
 551           g_Console_Add(Aliases[a].commands[b]);
 552     end else
 553       for a := 0 to High(Aliases) do
 554         if Aliases[a].commands <> nil then
 555           g_Console_Add(Aliases[a].name);
 556   end;
 557
 558   if cmd = 'call' then
 559   begin
 560     // call <alias_name>
 561     if Length(p) > 1 then
 562     begin
 563       if Aliases = nil then
 564         Exit;
 565       for a := 0 to High(Aliases) do
 566         if Aliases[a].name = p[1] then
 567         begin
 568           if Aliases[a].commands <> nil then
 569           begin
 570             // with this system proper endless loop detection seems either impossible
 571             // or very dirty to implement, so let's have this instead
 572             // prevents endless loops
 573             for b := 0 to High(Aliases[a].commands) do
 574             begin
 575               Inc(RecursionDepth);
 576               RecursionLimitHit := (RecursionDepth > MaxScriptRecursion) or RecursionLimitHit;
 577               if not RecursionLimitHit then
 578                 g_Console_Process(Aliases[a].commands[b], True);
 579               Dec(RecursionDepth);
 580             end;
 581             if (RecursionDepth = 0) and RecursionLimitHit then
 582             begin
 583               g_Console_Add(Format(_lc[I_CONSOLE_ERROR_CALL], [s]));
 584               RecursionLimitHit := False;
 585             end;
 586           end;
 587           Exit;
 588         end;
 589     end
 590     else
 591       g_Console_Add('call <alias name>');
 592   end;
 593
 594   if cmd = '//' then
 595     Exit;
 596 end;
 597
 598 procedure WhitelistCommand(cmd: AnsiString);
 599 var
 600   a: Integer;
 601 begin
 602   SetLength(Whitelist, Length(Whitelist)+1);
 603   a := High(Whitelist);
 604   Whitelist[a] := LowerCase(cmd);
 605 end;
 606
 607 procedure segfault (p: SSArray);
 608 var
 609   pp: PByte = nil;
 610 begin
 611   pp^ := 0;
 612 end;
 613
 614 procedure BindCommands (p: SSArray);
 615   var cmd, key, act: AnsiString; i, j: Integer;
 616 begin
 617   cmd := LowerCase(p[0]);
 618   case cmd of
 619   'bind':
 620     // bind <key> <action>
 621     if Length(p) = 3 then
 622     begin
 623       key := LowerCase(p[1]);
 624       i := 0;
 625       while (i < e_MaxInputKeys) and (key <> LowerCase(e_KeyNames[i])) do inc(i);
 626       if i < e_MaxInputKeys then
 627         gInputBinds[i].commands := ParseAlias(p[2])
 628     end;
 629   'bindlist':
 630     for i := 0 to e_MaxInputKeys - 1 do
 631     begin
 632       if gInputBinds[i].commands <> nil then
 633       begin
 634         act := gInputBinds[i].commands[0];
 635         for j := 1 to High(gInputBinds[i].commands) do
 636           act := act + ' ;' + gInputBinds[i].commands[j];
 637         g_Console_Add(LowerCase(e_KeyNames[i]) + ' "' + act + '"')
 638       end
 639     end;
 640   'unbind':
 641     // unbind <key>
 642     if Length(p) = 2 then
 643     begin
 644       key := LowerCase(p[1]);
 645       i := 0;
 646       while (i < e_MaxInputKeys) and (key <> LowerCase(e_KeyNames[i])) do inc(i);
 647       if i < e_MaxInputKeys then
 648         gInputBinds[i].commands := nil
 649     end;
 650   'unbindall':
 651     for i := 0 to e_MaxInputKeys - 1 do
 652       if gInputBinds[i].commands <> nil then
 653         gInputBinds[i].commands := nil;
 654   'bindkeys':
 655     for i := 0 to e_MaxInputKeys - 1 do
 656       if e_KeyNames[i] <> '' then
 657         g_Console_Add(LowerCase(e_KeyNames[i]));
 658   end
 659 end;
 660
 661 procedure AddCommand(cmd: AnsiString; proc: TCmdProc; ahelp: AnsiString=''; ahidden: Boolean=false; acheat: Boolean=false);
 662 var
 663   a: Integer;
 664   cp: PCommand;
 665 begin
 666   SetLength(commands, Length(commands)+1);
 667   a := High(commands);
 668   cp := @commands[a];
 669   cp.cmd := LowerCase(cmd);
 670   cp.proc := proc;
 671   cp.procEx := nil;
 672   cp.help := ahelp;
 673   cp.hidden := ahidden;
 674   cp.ptr := nil;
 675   cp.msg := '';
 676   cp.cheat := acheat;
 677   cp.action := -1;
 678   cp.player := -1;
 679 end;
 680
 681 procedure AddAction (cmd: AnsiString; action: Integer; help: AnsiString = ''; hidden: Boolean = False; cheat: Boolean = False);
 682   const
 683     PrefixList: array [0..1] of AnsiString = ('+', '-');
 684     PlayerList: array [0..1] of Integer = (1, 2);
 685   var
 686     s: AnsiString;
 687     i: Integer;
 688
 689   procedure NewAction (cmd: AnsiString; player: Integer);
 690     var cp: PCommand;
 691   begin
 692     SetLength(commands, Length(commands) + 1);
 693     cp := @commands[High(commands)];
 694     cp.cmd := LowerCase(cmd);
 695     cp.proc := nil;
 696     cp.procEx := nil;
 697     cp.help := help;
 698     cp.hidden := hidden;
 699     cp.ptr := nil;
 700     cp.msg := '';
 701     cp.cheat := cheat;
 702     cp.action := action;
 703     cp.player := player;
 704   end;
 705
 706 begin
 707   ASSERT(action >= 0);
 708   ASSERT(action <= LAST_ACTION);
 709   for s in PrefixList do
 710   begin
 711     NewAction(s + cmd, 0);
 712     for i in PlayerList do
 713       NewAction(s + 'p' + IntToStr(i) + '_' + cmd, i - 1)
 714   end
 715 end;
 716
 717 procedure g_Console_Init();
 718   var
 719     a: Integer;
 720 begin
 721   g_Texture_CreateWAD(ID, GameWAD+':TEXTURES\CONSOLE');
 722   Cons_Y := -(gScreenHeight div 2);
 723   gConsoleShow := False;
 724   gChatShow := False;
 725   Cons_Shown := False;
 726   CPos := 1;
 727
 728   for a := 0 to High(MsgArray) do
 729     with MsgArray[a] do
 730     begin
 731       Msg := '';
 732       Time := 0;
 733     end;
 734
 735   AddCommand('segfault', segfault, 'make segfault');
 736
 737   AddCommand('bind', BindCommands);
 738   AddCommand('bindlist', BindCommands);
 739   AddCommand('unbind', BindCommands);
 740   AddCommand('unbindall', BindCommands);
 741   AddCommand('bindkeys', BindCommands);
 742
 743   AddAction('jump', ACTION_JUMP);
 744   AddAction('moveleft', ACTION_MOVELEFT);
 745   AddAction('moveright', ACTION_MOVERIGHT);
 746   AddAction('lookup', ACTION_LOOKUP);
 747   AddAction('lookdown', ACTION_LOOKDOWN);
 748   AddAction('attack', ACTION_ATTACK);
 749   AddAction('scores', ACTION_SCORES);
 750   AddAction('activate', ACTION_ACTIVATE);
 751   AddAction('strafe', ACTION_STRAFE);
 752   AddAction('weapnext', ACTION_WEAPNEXT);
 753   AddAction('weapprev', ACTION_WEAPPREV);
 754
 755   AddCommand('clear', ConsoleCommands, 'clear console');
 756   AddCommand('clearhistory', ConsoleCommands);
 757   AddCommand('showhistory', ConsoleCommands);
 758   AddCommand('commands', ConsoleCommands);
 759   AddCommand('time', ConsoleCommands);
 760   AddCommand('date', ConsoleCommands);
 761   AddCommand('echo', ConsoleCommands);
 762   AddCommand('dump', ConsoleCommands);
 763   AddCommand('exec', ConsoleCommands);
 764   AddCommand('alias', ConsoleCommands);
 765   AddCommand('call', ConsoleCommands);
 766   AddCommand('ver', ConsoleCommands);
 767   AddCommand('version', ConsoleCommands);
 768
 769   AddCommand('d_window', DebugCommands);
 770   AddCommand('d_sounds', DebugCommands);
 771   AddCommand('d_frames', DebugCommands);
 772   AddCommand('d_winmsg', DebugCommands);
 773   AddCommand('d_monoff', DebugCommands);
 774   AddCommand('d_botoff', DebugCommands);
 775   AddCommand('d_monster', DebugCommands);
 776   AddCommand('d_health', DebugCommands);
 777   AddCommand('d_player', DebugCommands);
 778   AddCommand('d_joy', DebugCommands);
 779   AddCommand('d_mem', DebugCommands);
 780
 781   AddCommand('p1_name', GameCVars);
 782   AddCommand('p2_name', GameCVars);
 783   AddCommand('p1_color', GameCVars);
 784   AddCommand('p2_color', GameCVars);
 785   AddCommand('r_showfps', GameCVars);
 786   AddCommand('r_showtime', GameCVars);
 787   AddCommand('r_showscore', GameCVars);
 788   AddCommand('r_showlives', GameCVars);
 789   AddCommand('r_showstat', GameCVars);
 790   AddCommand('r_showkillmsg', GameCVars);
 791   AddCommand('r_showspect', GameCVars);
 792   AddCommand('r_showping', GameCVars);
 793   AddCommand('g_gamemode', GameCVars);
 794   AddCommand('g_friendlyfire', GameCVars);
 795   AddCommand('g_weaponstay', GameCVars);
 796   AddCommand('g_allow_exit', GameCVars);
 797   AddCommand('g_allow_monsters', GameCVars);
 798   AddCommand('g_bot_vsmonsters', GameCVars);
 799   AddCommand('g_bot_vsplayers', GameCVars);
 800   AddCommand('g_scorelimit', GameCVars);
 801   AddCommand('g_timelimit', GameCVars);
 802   AddCommand('g_maxlives', GameCVars);
 803   AddCommand('g_warmuptime', GameCVars);
 804   AddCommand('net_interp', GameCVars);
 805   AddCommand('net_forceplayerupdate', GameCVars);
 806   AddCommand('net_predictself', GameCVars);
 807   AddCommand('sv_name', GameCVars);
 808   AddCommand('sv_passwd', GameCVars);
 809   AddCommand('sv_maxplrs', GameCVars);
 810   AddCommand('sv_public', GameCVars);
 811   AddCommand('sv_intertime', GameCVars);
 812
 813   AddCommand('quit', GameCommands);
 814   AddCommand('exit', GameCommands);
 815   AddCommand('pause', GameCommands);
 816   AddCommand('endgame', GameCommands);
 817   AddCommand('restart', GameCommands);
 818   AddCommand('addbot', GameCommands);
 819   AddCommand('bot_add', GameCommands);
 820   AddCommand('bot_addlist', GameCommands);
 821   AddCommand('bot_addred', GameCommands);
 822   AddCommand('bot_addblue', GameCommands);
 823   AddCommand('bot_removeall', GameCommands);
 824   AddCommand('chat', GameCommands);
 825   AddCommand('teamchat', GameCommands);
 826   AddCommand('game', GameCommands);
 827   AddCommand('host', GameCommands);
 828   AddCommand('map', GameCommands);
 829   AddCommand('nextmap', GameCommands);
 830   AddCommand('endmap', GameCommands);
 831   AddCommand('goodbye', GameCommands);
 832   AddCommand('suicide', GameCommands);
 833   AddCommand('spectate', GameCommands);
 834   AddCommand('ready', GameCommands);
 835   AddCommand('kick', GameCommands);
 836   AddCommand('kick_id', GameCommands);
 837   AddCommand('ban', GameCommands);
 838   AddCommand('permban', GameCommands);
 839   AddCommand('ban_id', GameCommands);
 840   AddCommand('permban_id', GameCommands);
 841   AddCommand('unban', GameCommands);
 842   AddCommand('connect', GameCommands);
 843   AddCommand('disconnect', GameCommands);
 844   AddCommand('reconnect', GameCommands);
 845   AddCommand('say', GameCommands);
 846   AddCommand('tell', GameCommands);
 847   AddCommand('overtime', GameCommands);
 848   AddCommand('rcon_password', GameCommands);
 849   AddCommand('rcon', GameCommands);
 850   AddCommand('callvote', GameCommands);
 851   AddCommand('vote', GameCommands);
 852   AddCommand('clientlist', GameCommands);
 853   AddCommand('event', GameCommands);
 854   AddCommand('screenshot', GameCommands);
 855   AddCommand('togglechat', GameCommands);
 856   AddCommand('toggleteamchat', GameCommands);
 857   AddCommand('weapon', GameCommands);
 858   AddCommand('p1_weapon', GameCommands);
 859   AddCommand('p2_weapon', GameCommands);
 860
 861   AddCommand('god', GameCheats);
 862   AddCommand('notarget', GameCheats);
 863   AddCommand('give', GameCheats); // "exit" too ;-)
 864   AddCommand('open', GameCheats);
 865   AddCommand('fly', GameCheats);
 866   AddCommand('noclip', GameCheats);
 867   AddCommand('speedy', GameCheats);
 868   AddCommand('jumpy', GameCheats);
 869   AddCommand('noreload', GameCheats);
 870   AddCommand('aimline', GameCheats);
 871   AddCommand('automap', GameCheats);
 872
 873   WhitelistCommand('say');
 874   WhitelistCommand('tell');
 875   WhitelistCommand('overtime');
 876   WhitelistCommand('ready');
 877   WhitelistCommand('map');
 878   WhitelistCommand('nextmap');
 879   WhitelistCommand('endmap');
 880   WhitelistCommand('restart');
 881   WhitelistCommand('kick');
 882   WhitelistCommand('ban');
 883
 884   WhitelistCommand('addbot');
 885   WhitelistCommand('bot_add');
 886   WhitelistCommand('bot_addred');
 887   WhitelistCommand('bot_addblue');
 888   WhitelistCommand('bot_removeall');
 889
 890   WhitelistCommand('g_gamemode');
 891   WhitelistCommand('g_friendlyfire');
 892   WhitelistCommand('g_weaponstay');
 893   WhitelistCommand('g_allow_exit');
 894   WhitelistCommand('g_allow_monsters');
 895   WhitelistCommand('g_scorelimit');
 896   WhitelistCommand('g_timelimit');
 897
 898   g_Console_ReadConfig(GameDir + '/dfconfig.cfg');
 899   g_Console_ReadConfig(GameDir + '/autoexec.cfg');
 900
 901   g_Console_Add(Format(_lc[I_CONSOLE_WELCOME], [GAME_VERSION]));
 902   g_Console_Add('');
 903 end;
 904
 905 procedure g_Console_Update();
 906 var
 907   a, b: Integer;
 908 begin
 909   if Cons_Shown then
 910   begin
 911   // Â ïðîöåññå îòêðûòèÿ:
 912     if gConsoleShow and (Cons_Y < 0) then
 913     begin
 914       Cons_Y := Cons_Y+Step;
 915     end;
 916
 917   // Â ïðîöåññå çàêðûòèÿ:
 918     if (not gConsoleShow) and
 919        (Cons_Y > -(gScreenHeight div 2)) then
 920       Cons_Y := Cons_Y-Step;
 921
 922   // Îêîí÷àòåëüíî îòêðûëàñü:
 923     if Cons_Y > 0 then
 924       Cons_Y := 0;
 925
 926   // Îêîí÷àòåëüíî çàêðûëàñü:
 927     if Cons_Y <= (-(gScreenHeight div 2)) then
 928     begin
 929       Cons_Y := -(gScreenHeight div 2);
 930       Cons_Shown := False;
 931     end;
 932   end;
 933
 934   a := 0;
 935   while a <= High(MsgArray) do
 936   begin
 937     if MsgArray[a].Time > 0 then
 938     begin
 939       if MsgArray[a].Time = 1 then
 940         begin
 941           if a < High(MsgArray) then
 942           begin
 943             for b := a to High(MsgArray)-1 do
 944               MsgArray[b] := MsgArray[b+1];
 945
 946             MsgArray[High(MsgArray)].Time := 0;
 947
 948             a := a - 1;
 949           end;
 950         end
 951       else
 952         Dec(MsgArray[a].Time);
 953     end;
 954
 955     a := a + 1;
 956   end;
 957 end;
 958
 959
 960 procedure drawConsoleText ();
 961 var
 962   CWidth, CHeight: Byte;
 963   ty: Integer;
 964   sp, ep: LongWord;
 965   skip: Integer;
 966
 967   procedure putLine (sp, ep: LongWord);
 968   var
 969     p: LongWord;
 970     wdt, cw: Integer;
 971   begin
 972     p := sp;
 973     wdt := 0;
 974     while p <> ep do
 975     begin
 976       cw := e_TextureFontCharWidth(cbufAt(p), gStdFont);
 977       if wdt+cw > gScreenWidth-8 then break;
 978       //e_TextureFontPrintChar(X, Y: Integer; Ch: Char; FontID: DWORD; Shadow: Boolean = False);
 979       Inc(wdt, cw);
 980       cbufNext(p);
 981     end;
 982     if p <> ep then putLine(p, ep); // do rest of the line first
 983     // now print our part
 984     if skip = 0 then
 985     begin
 986       ep := p;
 987       p := sp;
 988       wdt := 2;
 989       while p <> ep do
 990       begin
 991         cw := e_TextureFontCharWidth(cbufAt(p), gStdFont);
 992         e_TextureFontPrintCharEx(wdt, ty, cbufAt(p), gStdFont);
 993         Inc(wdt, cw);
 994         cbufNext(p);
 995       end;
 996       Dec(ty, CHeight);
 997     end
 998     else
 999     begin
1000       Dec(skip);
1001     end;
1002   end;
1003
1004 begin
1005   e_TextureFontGetSize(gStdFont, CWidth, CHeight);
1006   ty := (gScreenHeight div 2)-4-2*CHeight-Abs(Cons_Y);
1007   skip := conSkipLines;
1008   cbufLastLine(sp, ep);
1009   repeat
1010     putLine(sp, ep);
1011     if ty+CHeight <= 0 then break;
1012   until not cbufLineUp(sp, ep);
1013 end;
1014
1015 procedure g_Console_Draw();
1016 var
1017   CWidth, CHeight: Byte;
1018   mfW, mfH: Word;
1019   a, b: Integer;
1020 begin
1021   e_TextureFontGetSize(gStdFont, CWidth, CHeight);
1022
1023   for a := 0 to High(MsgArray) do
1024     if MsgArray[a].Time > 0 then
1025       e_TextureFontPrintFmt(0, CHeight*a, MsgArray[a].Msg,
1026         gStdFont, True);
1027
1028   if not Cons_Shown then
1029   begin
1030     if gChatShow then
1031     begin
1032       if gChatTeam then
1033       begin
1034         e_TextureFontPrintEx(0, gScreenHeight - CHeight - 1, 'say team> ' + Line,
1035           gStdFont, 255, 255, 255, 1, True);
1036         e_TextureFontPrintEx((CPos + 9)*CWidth, gScreenHeight - CHeight - 1, '_',
1037           gStdFont, 255, 255, 255, 1, True);
1038       end
1039       else
1040       begin
1041         e_TextureFontPrintEx(0, gScreenHeight - CHeight - 1, 'say> ' + Line,
1042           gStdFont, 255, 255, 255, 1, True);
1043         e_TextureFontPrintEx((CPos + 4)*CWidth, gScreenHeight - CHeight - 1, '_',
1044           gStdFont, 255, 255, 255, 1, True);
1045       end;
1046     end;
1047     Exit;
1048   end;
1049
1050   if gDebugMode then
1051   begin
1052     e_CharFont_GetSize(gMenuFont, DEBUG_STRING, mfW, mfH);
1053     a := (gScreenWidth - 2*mfW) div 2;
1054     b := Cons_Y + ((gScreenHeight div 2) - 2*mfH) div 2;
1055     e_CharFont_PrintEx(gMenuFont, a div 2, b div 2, DEBUG_STRING,
1056                        _RGB(128, 0, 0), 2.0);
1057   end;
1058
1059   e_DrawSize(ID, 0, Cons_Y, Alpha, False, False, gScreenWidth, gScreenHeight div 2);
1060   e_TextureFontPrint(0, Cons_Y+(gScreenHeight div 2)-CHeight-4, '> '+Line, gStdFont);
1061
1062   drawConsoleText();
1063   (*
1064   if ConsoleHistory <> nil then
1065   begin
1066     b := 0;
1067     if CHeight > 0 then
1068       if Length(ConsoleHistory) > ((gScreenHeight div 2) div CHeight)-1 then
1069         b := Length(ConsoleHistory)-((gScreenHeight div 2) div CHeight)+1;
1070
1071     b := Max(b-Offset, 0);
1072     d := Max(High(ConsoleHistory)-Offset, 0);
1073
1074     c := 2;
1075     for a := d downto b do
1076     begin
1077       e_TextureFontPrintFmt(0, (gScreenHeight div 2)-4-c*CHeight-Abs(Cons_Y), ConsoleHistory[a],
1078                            gStdFont, True);
1079       c := c + 1;
1080     end;
1081   end;
1082   *)
1083
1084   e_TextureFontPrint((CPos+1)*CWidth, Cons_Y+(gScreenHeight div 2)-21, '_', gStdFont);
1085 end;
1086
1087 procedure g_Console_Switch();
1088 begin
1089   gChatShow := False;
1090   gConsoleShow := not gConsoleShow;
1091   Cons_Shown := True;
1092   g_Touch_ShowKeyboard(gConsoleShow or gChatShow);
1093 end;
1094
1095 procedure g_Console_Chat_Switch(Team: Boolean = False);
1096 begin
1097   if not g_Game_IsNet then Exit;
1098   gConsoleShow := False;
1099   gChatShow := not gChatShow;
1100   gChatTeam := Team;
1101   Line := '';
1102   CPos := 1;
1103   g_Touch_ShowKeyboard(gConsoleShow or gChatShow);
1104 end;
1105
1106 procedure g_Console_Char(C: AnsiChar);
1107 begin
1108 //  if gChatShow then
1109 //    Exit;
1110   Insert(C, Line, CPos);
1111   CPos := CPos + 1;
1112 end;
1113
1114
1115 var
1116   tcomplist: array of AnsiString = nil;
1117   tcompidx: array of Integer = nil;
1118
1119 procedure Complete ();
1120 var
1121   i, c: Integer;
1122   tused: Integer;
1123   ll, lpfx, cmd: AnsiString;
1124 begin
1125   if (Length(Line) = 0) then
1126   begin
1127     g_Console_Add('');
1128     for i := 0 to High(commands) do
1129     begin
1130       // hidden commands are hidden when cheats aren't enabled
1131       if commands[i].hidden and not conIsCheatsEnabled then continue;
1132       if (Length(commands[i].help) > 0) then
1133       begin
1134         g_Console_Add('  '+commands[i].cmd+' -- '+commands[i].help);
1135       end
1136       else
1137       begin
1138         g_Console_Add('  '+commands[i].cmd);
1139       end;
1140     end;
1141     exit;
1142   end;
1143
1144   ll := LowerCase(Line);
1145   lpfx := '';
1146
1147   if (Length(ll) > 1) and (ll[Length(ll)] = ' ') then
1148   begin
1149     ll := Copy(ll, 0, Length(ll)-1);
1150     for i := 0 to High(commands) do
1151     begin
1152       // hidden commands are hidden when cheats aren't enabled
1153       if commands[i].hidden and not conIsCheatsEnabled then continue;
1154       if (commands[i].cmd = ll) then
1155       begin
1156         if (Length(commands[i].help) > 0) then
1157         begin
1158           g_Console_Add('  '+commands[i].cmd+' -- '+commands[i].help);
1159         end;
1160       end;
1161     end;
1162     exit;
1163   end;
1164
1165   // build completion list
1166   tused := 0;
1167   for i := 0 to High(commands) do
1168   begin
1169     // hidden commands are hidden when cheats aren't enabled
1170     if commands[i].hidden and not conIsCheatsEnabled then continue;
1171     cmd := commands[i].cmd;
1172     if (Length(cmd) >= Length(ll)) and (ll = Copy(cmd, 0, Length(ll))) then
1173     begin
1174       if (tused = Length(tcomplist)) then
1175       begin
1176         SetLength(tcomplist, Length(tcomplist)+128);
1177         SetLength(tcompidx, Length(tcompidx)+128);
1178       end;
1179       tcomplist[tused] := cmd;
1180       tcompidx[tused] := i;
1181       Inc(tused);
1182       if (Length(cmd) > Length(lpfx)) then lpfx := cmd;
1183     end;
1184   end;
1185
1186   // get longest prefix
1187   for i := 0 to tused-1 do
1188   begin
1189     cmd := tcomplist[i];
1190     for c := 1 to Length(lpfx) do
1191     begin
1192       if (c > Length(cmd)) then break;
1193       if (cmd[c] <> lpfx[c]) then begin lpfx := Copy(lpfx, 0, c-1); break; end;
1194     end;
1195   end;
1196
1197   if (tused = 0) then exit;
1198
1199   if (tused = 1) then
1200   begin
1201     Line := tcomplist[0]+' ';
1202     CPos := Length(Line)+1;
1203   end
1204   else
1205   begin
1206     // has longest prefix?
1207     if (Length(lpfx) > Length(ll)) then
1208     begin
1209       Line := lpfx;
1210       CPos:= Length(Line)+1;
1211     end
1212     else
1213     begin
1214       g_Console_Add('');
1215       for i := 0 to tused-1 do
1216       begin
1217         if (Length(commands[tcompidx[i]].help) > 0) then
1218         begin
1219           g_Console_Add('  '+tcomplist[i]+' -- '+commands[tcompidx[i]].help);
1220         end
1221         else
1222         begin
1223           g_Console_Add('  '+tcomplist[i]);
1224         end;
1225       end;
1226     end;
1227   end;
1228 end;
1229
1230
1231 procedure g_Console_Control(K: Word);
1232 begin
1233   case K of
1234     IK_BACKSPACE:
1235       if (Length(Line) > 0) and (CPos > 1) then
1236       begin
1237         Delete(Line, CPos-1, 1);
1238         CPos := CPos-1;
1239       end;
1240     IK_DELETE:
1241       if (Length(Line) > 0) and (CPos <= Length(Line)) then
1242         Delete(Line, CPos, 1);
1243     IK_LEFT, IK_KPLEFT, VK_LEFT:
1244       if CPos > 1 then
1245         CPos := CPos - 1;
1246     IK_RIGHT, IK_KPRIGHT, VK_RIGHT:
1247       if CPos <= Length(Line) then
1248         CPos := CPos + 1;
1249     IK_RETURN, IK_KPRETURN, VK_OPEN, VK_FIRE:
1250     begin
1251       if Cons_Shown then
1252         g_Console_Process(Line)
1253       else
1254         if gChatShow then
1255         begin
1256           if (Length(Line) > 0) and g_Game_IsNet then
1257           begin
1258             if gChatTeam then
1259             begin
1260               if g_Game_IsClient then
1261                 MC_SEND_Chat(b_Text_Format(Line), NET_CHAT_TEAM)
1262               else
1263                 MH_SEND_Chat('[' + gPlayer1Settings.name + ']: ' + b_Text_Format(Line),
1264                   NET_CHAT_TEAM, gPlayer1Settings.Team);
1265             end
1266             else
1267             begin
1268               if g_Game_IsClient then
1269                 MC_SEND_Chat(b_Text_Format(Line), NET_CHAT_PLAYER)
1270               else
1271                 MH_SEND_Chat('[' + gPlayer1Settings.name + ']: ' + b_Text_Format(Line),
1272                 NET_CHAT_PLAYER);
1273             end;
1274           end;
1275
1276           Line := '';
1277           CPos := 1;
1278           gChatShow := False;
1279           gJustChatted := True;
1280           g_Touch_ShowKeyboard(gConsoleShow or gChatShow);
1281         end;
1282     end;
1283     IK_TAB:
1284       if not gChatShow then
1285         Complete();
1286     IK_DOWN, IK_KPDOWN, VK_DOWN:
1287       if not gChatShow then
1288         if (CommandHistory <> nil) and
1289            (CmdIndex < Length(CommandHistory)) then
1290         begin
1291           if CmdIndex < Length(CommandHistory)-1 then
1292             CmdIndex := CmdIndex + 1;
1293           Line := CommandHistory[CmdIndex];
1294           CPos := Length(Line) + 1;
1295         end;
1296     IK_UP, IK_KPUP, VK_UP:
1297       if not gChatShow then
1298         if (CommandHistory <> nil) and
1299            (CmdIndex <= Length(CommandHistory)) then
1300         begin
1301           if CmdIndex > 0 then
1302             CmdIndex := CmdIndex - 1;
1303           Line := CommandHistory[CmdIndex];
1304           Cpos := Length(Line) + 1;
1305         end;
1306     IK_PAGEUP, IK_KPPAGEUP, VK_PREV: // PgUp
1307       if not gChatShow then Inc(conSkipLines);
1308     IK_PAGEDN, IK_KPPAGEDN, VK_NEXT: // PgDown
1309       if not gChatShow and (conSkipLines > 0) then Dec(conSkipLines);
1310     IK_HOME, IK_KPHOME:
1311       CPos := 1;
1312     IK_END, IK_KPEND:
1313       CPos := Length(Line) + 1;
1314   end;
1315 end;
1316
1317 function GetStr(var Str: AnsiString): AnsiString;
1318 var
1319   a, b: Integer;
1320 begin
1321   Result := '';
1322   if Str[1] = '"' then
1323   begin
1324     for b := 1 to Length(Str) do
1325       if (b = Length(Str)) or (Str[b+1] = '"') then
1326       begin
1327         Result := Copy(Str, 2, b-1);
1328         Delete(Str, 1, b+1);
1329         Str := Trim(Str);
1330         Exit;
1331       end;
1332   end;
1333
1334   for a := 1 to Length(Str) do
1335     if (a = Length(Str)) or (Str[a+1] = ' ') then
1336     begin
1337       Result := Copy(Str, 1, a);
1338       Delete(Str, 1, a+1);
1339       Str := Trim(Str);
1340       Exit;
1341     end;
1342 end;
1343
1344 function ParseString(Str: AnsiString): SSArray;
1345 begin
1346   Result := nil;
1347
1348   Str := Trim(Str);
1349
1350   if Str = '' then
1351     Exit;
1352
1353   while Str <> '' do
1354   begin
1355     SetLength(Result, Length(Result)+1);
1356     Result[High(Result)] := GetStr(Str);
1357   end;
1358 end;
1359
1360 procedure g_Console_Add (L: AnsiString; show: Boolean=false);
1361
1362   procedure conmsg (s: AnsiString);
1363   var
1364     a: Integer;
1365   begin
1366     if length(s) = 0 then exit;
1367     for a := 0 to High(MsgArray) do
1368     begin
1369       with MsgArray[a] do
1370       begin
1371         if Time = 0 then
1372         begin
1373           Msg := s;
1374           Time := MsgTime;
1375           exit;
1376         end;
1377       end;
1378     end;
1379     for a := 0 to High(MsgArray)-1 do MsgArray[a] := MsgArray[a+1];
1380     with MsgArray[High(MsgArray)] do
1381     begin
1382       Msg := L;
1383       Time := MsgTime;
1384     end;
1385   end;
1386
1387 var
1388   f: Integer;
1389 begin
1390   // put it to console
1391   cbufPut(L);
1392   if (length(L) = 0) or ((L[length(L)] <> #10) and (L[length(L)] <> #13)) then cbufPut(#10);
1393
1394   // now show 'em out of console too
1395   show := show and gAllowConsoleMessages;
1396   if show and gShowMessages then
1397   begin
1398     // Âûâîä ñòðîê ñ ïåðåíîñàìè ïî î÷åðåäè
1399     while length(L) > 0 do
1400     begin
1401       f := Pos(#10, L);
1402       if f <= 0 then f := length(L)+1;
1403       conmsg(Copy(L, 1, f-1));
1404       Delete(L, 1, f);
1405     end;
1406   end;
1407
1408   //SetLength(ConsoleHistory, Length(ConsoleHistory)+1);
1409   //ConsoleHistory[High(ConsoleHistory)] := L;
1410
1411   (*
1412 {$IFDEF HEADLESS}
1413   e_WriteLog('CON: ' + L, MSG_NOTIFY);
1414 {$ENDIF}
1415   *)
1416 end;
1417
1418
1419 var
1420   consolewriterLastWasEOL: Boolean = false;
1421
1422 procedure consolewriter (constref buf; len: SizeUInt);
1423 var
1424   b: PByte;
1425 begin
1426   if (len < 1) then exit;
1427   b := PByte(@buf);
1428   consolewriterLastWasEOL := (b[len-1] = 13) or (b[len-1] = 10);
1429   while (len > 0) do
1430   begin
1431     if (b[0] <> 13) and (b[0] <> 10) then
1432     begin
1433       cbufPut(AnsiChar(b[0]));
1434     end
1435     else
1436     begin
1437       if (len > 1) and (b[0] = 13) then begin len -= 1; b += 1; end;
1438       cbufPut(#10);
1439     end;
1440     len -= 1;
1441     b += 1;
1442   end;
1443 end;
1444
1445
1446 // returns formatted string if `writerCB` is `nil`, empty string otherwise
1447 //function formatstrf (const fmt: AnsiString; args: array of const; writerCB: TFormatStrFCallback=nil): AnsiString;
1448 //TFormatStrFCallback = procedure (constref buf; len: SizeUInt);
1449 procedure conwriteln (const s: AnsiString; show: Boolean=false);
1450 begin
1451   g_Console_Add(s, show);
1452 end;
1453
1454
1455 procedure conwritefln (const s: AnsiString; args: array of const; show: Boolean=false);
1456 begin
1457   if show then
1458   begin
1459     g_Console_Add(formatstrf(s, args), true);
1460   end
1461   else
1462   begin
1463     consolewriterLastWasEOL := false;
1464     formatstrf(s, args, consolewriter);
1465     if not consolewriterLastWasEOL then cbufPut(#10);
1466   end;
1467 end;
1468
1469
1470 procedure g_Console_Clear();
1471 begin
1472   //ConsoleHistory := nil;
1473   cbufClear();
1474   conSkipLines := 0;
1475 end;
1476
1477 procedure AddToHistory(L: AnsiString);
1478 var
1479   len: Integer;
1480 begin
1481   len := Length(CommandHistory);
1482
1483   if (len = 0) or
1484      (LowerCase(CommandHistory[len-1]) <> LowerCase(L)) then
1485   begin
1486     SetLength(CommandHistory, len+1);
1487     CommandHistory[len] := L;
1488   end;
1489
1490   CmdIndex := Length(CommandHistory);
1491 end;
1492
1493 function g_Console_CommandBlacklisted(C: AnsiString): Boolean;
1494 var
1495   Arr: SSArray;
1496   i: Integer;
1497 begin
1498   Result := True;
1499
1500   Arr := nil;
1501
1502   if Trim(C) = '' then
1503     Exit;
1504
1505   Arr := ParseString(C);
1506   if Arr = nil then
1507     Exit;
1508
1509   for i := 0 to High(Whitelist) do
1510     if Whitelist[i] = LowerCase(Arr[0]) then
1511       Result := False;
1512 end;
1513
1514 procedure g_Console_Process(L: AnsiString; quiet: Boolean = False);
1515 var
1516   Arr: SSArray;
1517   i: Integer;
1518 begin
1519   Arr := nil;
1520
1521   if Trim(L) = '' then
1522     Exit;
1523
1524   conSkipLines := 0; // "unscroll"
1525
1526   if L = 'goobers' then
1527   begin
1528     Line := '';
1529     CPos := 1;
1530     gCheats := true;
1531     g_Console_Add('Your memory serves you well.');
1532     exit;
1533   end;
1534
1535   if not quiet then
1536   begin
1537     g_Console_Add('> '+L);
1538     Line := '';
1539     CPos := 1;
1540   end;
1541
1542   Arr := ParseString(L);
1543   if Arr = nil then
1544     Exit;
1545
1546   if commands = nil then
1547     Exit;
1548
1549   if not quiet then
1550     AddToHistory(L);
1551
1552   for i := 0 to High(commands) do
1553   begin
1554     if commands[i].cmd = LowerCase(Arr[0]) then
1555     begin
1556       if commands[i].action >= 0 then
1557       begin
1558         if bindProcess then
1559         begin
1560           if bindDown then
1561             gPlayerAction[commands[i].player, commands[i].action] := commands[i].cmd[1] = '+'
1562           else
1563             gPlayerAction[commands[i].player, commands[i].action] := gDefaultAction[commands[i].player, commands[i].action]
1564         end
1565         else
1566         begin
1567           gPlayerAction[commands[i].player, commands[i].action] := commands[i].cmd[1] = '+';
1568           gDefaultAction[commands[i].player, commands[i].action] := commands[i].cmd[1] = '+'
1569         end;
1570         exit
1571       end
1572       else if bindProcess and not bindDown then
1573       begin
1574         (* command is not action, so do not execute it again after button release *)
1575         exit
1576       end;
1577
1578       if assigned(commands[i].procEx) then
1579       begin
1580         commands[i].procEx(@commands[i], Arr);
1581         exit
1582       end;
1583       if assigned(commands[i].proc) then
1584       begin
1585         commands[i].proc(Arr);
1586         exit
1587       end
1588     end
1589   end;
1590
1591   g_Console_Add(Format(_lc[I_CONSOLE_UNKNOWN], [Arr[0]]));
1592 end;
1593
1594
1595 function g_Console_Interactive: Boolean;
1596 begin
1597   Result := not bindProcess
1598 end;
1599
1600 function g_Console_Action (action: Integer): Boolean;
1601   var i, len: Integer;
1602 begin
1603   ASSERT(action >= 0);
1604   ASSERT(action <= LAST_ACTION);
1605   i := 0;
1606   len := Length(gPlayerAction);
1607   while (i < len) and (not gPlayerAction[i, action]) do inc(i);
1608   Result := i < len
1609 end;
1610
1611 procedure g_Console_ProcessBind (key: Integer; down: Boolean);
1612   var i: Integer;
1613 begin
1614   if (not gChatShow) and (not gConsoleShow) and (key >= 0) and (key < e_MaxInputKeys) and (gInputBinds[key].commands <> nil) then
1615   begin
1616     bindDown := down;
1617     bindProcess := True;
1618     for i := 0 to High(gInputBinds[key].commands) do
1619       g_Console_Process(gInputBinds[key].commands[i], True);
1620     bindProcess := False;
1621   end
1622 end;
1623
1624
1625 procedure g_Console_ReadConfig (filename: String);
1626   var f: TextFile; s: AnsiString; i, len: Integer;
1627 begin
1628   if FileExists(filename) then
1629   begin
1630     AssignFile(f, filename);
1631     Reset(f);
1632     while not EOF(f) do
1633     begin
1634       ReadLn(f, s);
1635       len := Length(s);
1636       if len > 0 then
1637       begin
1638         i := 1;
1639         (* skip spaces *)
1640         while (i <= len) and (s[i] <= ' ') do inc(i);
1641         (* skip comments *)
1642         if (i <= len) and ((s[i] <> '#') and ((i + 1 > len) or (s[i] <> '/') or (s[i + 1] <> '/'))) then
1643           g_Console_Process(s, True)
1644       end
1645     end;
1646     CloseFile(f)
1647   end
1648 end;
1649
1650
1651 end.