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