(*

 * Hedgewars, a worms-like game

 * Copyright (c) 2004, 2005 Andrey Korotaev <unC0Rr@gmail.com>

 *

 * Distributed under the terms of the BSD-modified licence:

 *

 * Permission is hereby granted, free of charge, to any person obtaining a copy

 * of this software and associated documentation files (the "Software"), to deal

 * with the Software without restriction, including without limitation the

 * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or

 * sell copies of the Software, and to permit persons to whom the Software is

 * furnished to do so, subject to the following conditions:

 *

 * 1. Redistributions of source code must retain the above copyright notice,

 *    this list of conditions and the following disclaimer.

 * 2. Redistributions in binary form must reproduce the above copyright notice,

 *    this list of conditions and the following disclaimer in the documentation

 *    and/or other materials provided with the distribution.

 * 3. The name of the author may not be used to endorse or promote products

 *    derived from this software without specific prior written permission.

 *

 * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED

 * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF

 * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO

 * EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,

 * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,

 * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;

 * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,

 * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR

 * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF

 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

 *)

unit uConsole;

interface

uses SDLh;

{$INCLUDE options.inc}

const isDeveloperMode: boolean = true;

type TVariableType = (vtCommand, vtInteger, vtReal, vtBoolean);

     TCommandHandler = procedure (var params: shortstring);

procedure DrawConsole(Surface: PSDL_Surface);

procedure WriteToConsole(s: shortstring);

procedure WriteLnToConsole(s: shortstring);

procedure KeyPressConsole(Key: Longword);

procedure ParseCommand(CmdStr: shortstring);

implementation

{$J+}

uses uMisc, uStore, Types, uConsts, uGears, uTeams, uIO, uKeys, uSound, uWorld, uLand;

const cLineWidth: integer = 0;

      cLinesCount = 256;

type  PVariable = ^TVariable;

      TVariable = record

                     Next: PVariable;

                     Name: string[15];

                    VType: TVariableType;

                  Handler: pointer;

                  end;

var   ConsoleLines: array[byte] of ShortString;

      CurrLine: integer = 0;

      InputStr: shortstring;

      Variables: PVariable = nil;

function RegisterVariable(Name: string; VType: TVariableType; p: pointer): PVariable;

begin

New(Result);

TryDo(Result <> nil, 'RegisterVariable: Result = nil', true);

FillChar(Result^, sizeof(TVariable), 0);

Result.Name:= Name;

Result.VType:= VType;

Result.Handler:= p;

if Variables = nil then Variables:= Result

                   else begin

                        Result.Next:= Variables;

                        Variables:= Result

                        end

end;

procedure FreeVariablesList;

var t, tt: PVariable;

begin

tt:= Variables;

Variables:= nil;

while tt<>nil do

      begin

      t:= tt;

      tt:= tt.Next;

      Dispose(t)

      end;

end;

procedure SplitBySpace(var a, b: shortstring);

var i, t: integer;

begin

i:= Pos(' ', a);

if i>0 then

   begin

   for t:= 1 to Pred(i) do

       if (a[t] >= 'A')and(a[t] <= 'Z') then Inc(a[t], 32);

   b:= copy(a, i + 1, Length(a) - i);

   while (b[0]<>#0) and (b[1]=#32) do Delete(b, 1, 1);

   byte(a[0]):= Pred(i)

   end else b:= '';

end;

procedure DrawConsole(Surface: PSDL_Surface);

var x, y: integer;

    r: TSDL_Rect;

begin

with r do

     begin

     x:= 0;

     y:= cConsoleHeight;

     w:= cScreenWidth;

     h:= 4;

     end;

SDL_FillRect(Surface, @r, cConsoleSplitterColor);

for y:= 0 to cConsoleHeight div 256 + 1 do

    for x:= 0 to cScreenWidth div 256 + 1 do

        DrawGear(sConsoleBG, x * 256, cConsoleHeight - 256 - y * 256, Surface);

for y:= 0 to cConsoleHeight div Fontz[fnt16].Height do

    DXOutText(4, cConsoleHeight - (y + 2) * (Fontz[fnt16].Height + 2), fnt16, ConsoleLines[(CurrLine - 1 - y + cLinesCount) mod cLinesCount], Surface);

DXOutText(4, cConsoleHeight - Fontz[fnt16].Height - 2, fnt16, '> '+InputStr, Surface);

end;

procedure WriteToConsole(s: shortstring);

var Len: integer;

begin

{$IFDEF DEBUGFILE}AddFileLog('Console write: ' + s);{$ENDIF}

Write(s);

repeat

Len:= cLineWidth - Length(ConsoleLines[CurrLine]);

ConsoleLines[CurrLine]:= ConsoleLines[CurrLine] + copy(s, 1, Len);

Delete(s, 1, Len);

if byte(ConsoleLines[CurrLine][0])=cLineWidth then

   begin

   inc(CurrLine);

   if CurrLine = cLinesCount then CurrLine:= 0;

   PLongWord(@ConsoleLines[CurrLine])^:= 0

   end;

until Length(s) = 0

end;

procedure WriteLnToConsole(s: shortstring);

begin

WriteToConsole(s);

WriteLn;

inc(CurrLine);

if CurrLine = cLinesCount then CurrLine:= 0;

PLongWord(@ConsoleLines[CurrLine])^:= 0

end;

procedure InitConsole;

var i: integer;

begin

cLineWidth:= cScreenWidth div 10;

if cLineWidth > 255 then cLineWidth:= 255;

for i:= 0 to Pred(cLinesCount) do PLongWord(@ConsoleLines[i])^:= 0

end;

procedure ParseCommand(CmdStr: shortstring);

type PReal = ^real;

var i, ii: integer;

    s: shortstring;

    t: PVariable;

    c: char;

begin

//WriteLnToConsole(CmdStr);

if CmdStr[0]=#0 then exit;

{$IFDEF DEBUGFILE}AddFileLog('ParseCommand "' + CmdStr + '"');{$ENDIF}

c:= CmdStr[1];

if c in ['/', '$'] then Delete(CmdStr, 1, 1) else c:= '/';

SplitBySpace(CmdStr, s);

t:= Variables;

while t <> nil do

      begin

      if t.Name = CmdStr then

         begin

         case t.VType of

              vtCommand: if c='/' then

                         begin

                         TCommandHandler(t.Handler)(s);

                         end;

              vtInteger: if c='$' then

                         if s[0]=#0 then

                            begin

                            str(PInteger(t.Handler)^, s);

                            WriteLnToConsole('$' + CmdStr + ' is "' + s + '"');

                            end else val(s, PInteger(t.Handler)^, i);

                 vtReal: if c='$' then

                         if s[0]=#0 then

                            begin

                            str(PReal(t.Handler)^:4:6, s);

                            WriteLnToConsole('$' + CmdStr + ' is "' + s + '"');

                            end else val(s, PReal(t.Handler)^   , i);

             vtBoolean: if c='$' then

                         if s[0]=#0 then

                            begin

                            str(ord(boolean(t.Handler^)), s);

                            WriteLnToConsole('$' + CmdStr + ' is "' + s + '"');

                            end else

                            begin

                            val(s, ii, i);

                            boolean(t.Handler^):= not (ii = 0)

                            end;

              end;

         exit

         end else t:= t.Next

      end;

case c of

     '$': WriteLnToConsole(errmsgUnknownVariable + ': "$' + CmdStr + '"')

     else WriteLnToConsole(errmsgUnknownCommand  + ': "/' + CmdStr + '"') end

end;

procedure KeyPressConsole(Key: Longword);

begin

case Key of

      8: if Length(InputStr)>0 then dec(InputStr[0]);

 13,271: begin

         ParseCommand('/say ' + InputStr);

         InputStr:= ''

         end;

     96: begin

         GameState:= gsGame;

         cConsoleYAdd:= 0;

         ResetKbd

         end;

     else InputStr:= InputStr + char(Key)

     end

end;

{$INCLUDE CCHandlers.inc}

initialization

InitConsole;

RegisterVariable('quit'    , vtCommand, @chQuit         );

RegisterVariable('capture' , vtCommand, @chCapture      );

RegisterVariable('addteam' , vtCommand, @chAddTeam      );

RegisterVariable('rdriven' , vtCommand, @chTeamLocal    );

//RegisterVariable('gravity' , vtReal   , @cGravity       ); гравитация не должна быть доступна вообще

RegisterVariable('c_height', vtInteger, @cConsoleHeight );

RegisterVariable('gmflags' , vtInteger, @GameFlags      );

RegisterVariable('turntime', vtInteger, @cHedgehogTurnTime);

RegisterVariable('showfps' , vtBoolean, @cShowFPS       );

RegisterVariable('sound'   , vtBoolean, @isSoundEnabled );

RegisterVariable('name'    , vtCommand, @chName         );

RegisterVariable('fort'    , vtCommand, @chFort         );

RegisterVariable('grave'   , vtCommand, @chGrave        );

RegisterVariable('bind'    , vtCommand, @chBind         );

RegisterVariable('add'     , vtCommand, @chAdd          );

RegisterVariable('say'     , vtCommand, @chSay          );

RegisterVariable('+left'   , vtCommand, @chLeft_p       );

RegisterVariable('-left'   , vtCommand, @chLeft_m       );

RegisterVariable('+right'  , vtCommand, @chRight_p      );

RegisterVariable('-right'  , vtCommand, @chRight_m      );

RegisterVariable('+up'     , vtCommand, @chUp_p         );

RegisterVariable('-up'     , vtCommand, @chUp_m         );

RegisterVariable('+down'   , vtCommand, @chDown_p       );

RegisterVariable('-down'   , vtCommand, @chDown_m       );

RegisterVariable('+attack' , vtCommand, @chAttack_p     );

RegisterVariable('-attack' , vtCommand, @chAttack_m     );

RegisterVariable('color'   , vtCommand, @chColor        );

RegisterVariable('switch'  , vtCommand, @chSwitch       );

RegisterVariable('nextturn', vtCommand, @chNextTurn     );

RegisterVariable('timer'   , vtCommand, @chTimer        );

RegisterVariable('slot'    , vtCommand, @chSlot         );

RegisterVariable('put'     , vtCommand, @chPut          );

RegisterVariable('ljump'   , vtCommand, @chLJump        );

RegisterVariable('hjump'   , vtCommand, @chHJump        );

finalization

FreeVariablesList

end.