//
// This unit is part of the GLScene Engine https://github.com/glscene
//
{
   The console is a popdown window that appears on a game for text output/input.

    History :  
       16/03/11 - Yar - Fixes after emergence of GLMaterialEx
       02/04/07 - DaStr - All cross-version stuff abstracted into GLCrossPlatform
       30/03/07 - DaStr - Replaced GLWin32Viewer with GLViewer
       25/02/07 - DaStr - Made some fixes for Delphi5 compatibility
       23/02/07 - DaStr - Cosmetic changes, replaced some strings with
                              resource strings from GLStrings.pas
       15/02/07 - DaStr - Some properties are not stored now, because they are
                              read directly from HUDSprite and HUDText
       07/02/07 - DaStr - Initial version (donated to GLScene)

   What is different compared to the original component?
     1) Can be aded to any object, not just the root one
     2) Has a *wide* range of built-in commands
     3) TGLConsoleCommand.UnknownCommand added
         it is set to True, if no internal command recognized
     4) Internal console help added
     5) By default does not remove quotes ("), but this option can be
         turned on (property RemoveQuotes)
     6) Command list added. All user commands are saved there
     7) All previously typed commands can be accessed in a usual way (arrow up/down)
     8) Commands can be auto-completed by pressing TConsoleControls.AutoCompleteCommand key,
        or setting AutoCompleteCommandsOnKeyPress, AutoCompleteCommandsOnEnter to True
        Dbl-pressing the key, defined in the TConsoleControls.AutoCompleteCommand
        property, gives you a list  of all posible internal-external commands that
        start with your letters
     9) Batch command execution support added
    10) Short help is shown when user calls the global 'help' function
        Long help is shown elsewhere
    11) Show command help by "/?", "-?", "--?" etc
    12) Assign() added for every class

    TODO:
      [new command] Redirection with the | operator, like in any othe console (optional)
      [new command] File browser stuff... (this one's optional ;)

      Blinking cursor, "Delete" key support
      Allow long lines to continue on the next line
      May be SceneViewer should be a TControl to support the FullScreenViewer...

    Previous version history:
      v1.0    23 November   '2005  Creation (based on TGLConsole from http://caperaven.co.za/
      v1.1    17 June       '2006  Load/Save stuff upgraded
      v1.2    07 July       '2006  Component completely rewritten
                                     (New command classes added)
      v1.2.4  31 August     '2006  A few memory leaks fixed
                                   TGLCustomConsole.Size added
                                   Fixed a bug in TGLCustomConsole.RefreshHud
                                   "Console.Color" command fixed
                                   Bug with saving of TypedCommands fixed
      v1.2.5  11 September  '2006  TGLCustomConsole.AutoCompleteCommand() bugfixed
      v1.2.6  08 October    '2006  Made compatible with the new persistance mechanism
      1.3     23 October    '2006  TGLCustomConsole made descendant of TGLBaseSceneObject
      1.4     07 February   '2007  TGLCustomConsole.NumLines bugfixed
                                   TGLCustomConsole.RefreshHud bugfixed
                                   TGLConsoleCommand.GetDisplayName added
                                   TGLConsoleCommand default values added
                                   TGLConsoleStringList.Changed fixed
                                   TGLConsoleOptions added (united 4 Boolean properties)
                                   Code ready to be donated to GLScene
}

unit GLConsole;

interface

{$I GLScene.inc}

uses
  Classes, SysUtils, TypInfo, Graphics,
   
  GLScene, GLObjects, GLHUDObjects, GLViewer, GLBitmapFont,
  GLPersistentClasses, GLContext, GLTexture, GLUtils, GLStrings,
  GLCrossPlatform, GLMaterial, GLVectorTypes;

const
  CONSOLE_MAX_COMMANDS = 120;

type
  EGLConsoleException = class(Exception);

  TGLConsoleOption = (coAutoCompleteCommandsOnKeyPress,
    //commands are auto-completed as user types them
    coAutoCompleteCommandsOnEnter, //commands are auto-completed when user presses the "Enter" key
    coShowConsoleHelpIfUnknownCommand, //take a wild guess ;)
    coRemoveQuotes); //remove quotes when a command line is parsed

  TGLConsoleOptions = set of TGLConsoleOption;

  TGLCustomConsole = class;
  TGLConsoleCommandList = class;
  TGLConsoleCommand = class;

  { Stores info on a command. A command is a parsed input line.
    Should be transformed into a class, I think...}
  TGLUserInputCommand = record
    CommandCount: Integer;
    Strings: array of string;
    UnknownCommand: Boolean;
      //if user identifies a command, he must set this to  "True"
  end;

  { Event called when used presses the "Enter"}
  TGLlConsoleEvent = procedure(const ConsoleCommand: TGLConsoleCommand;
    const Console: TGLCustomConsole;
    var Command: TGLUserInputCommand) of object;

  TGLConsoleMatchList = set of 0..CONSOLE_MAX_COMMANDS {Byte};

  { A class that checks for duplicates. }
  TGLConsoleStringList = class(TStringList)
  private
    FConsole: TGLCustomConsole;
  protected
    procedure Changed; override;
    function GetOwner: TPersistent; override;
  public
    function CommandExists(const Command: string): Boolean;
    constructor Create(const Owner: TGLCustomConsole);
  end;

  { A wrapper for a console command. }
  TGLConsoleCommand = class(TCollectionItem)
  private
    FVisible: Boolean;
    FEnabled: Boolean;
    FSilentDisabled: Boolean;
    FCommandList: TGLConsoleCommandList;
    FCommandName: string;
    FShortHelp: string;
    FLongHelp: TStringList;
    FOnCommand: TGLlConsoleEvent;
    FOnHelp: TNotifyEvent;
    procedure SetCommandName(const Value: string);
  protected
    procedure ShowInvalidUseOfCommandError; virtual;
    procedure ShowInvalidNumberOfArgumentsError(const ShowHelpAfter: Boolean =
      True); virtual;
    procedure DoOnCommand(var UserInputCommand: TGLUserInputCommand); virtual;
    function GetDisplayName: string; override;
  public
    //procedures
    procedure ShowHelp; virtual;
    procedure ShowShortHelp; virtual;

    procedure Assign(Source: TPersistent); override;
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;

  published
    //properties
    property CommandName: string read FCommandName write SetCommandName;
    property ShortHelp: string read FShortHelp write FShortHelp;
    property LongHelp: TStringList read FLongHelp;
    property OnCommand: TGLlConsoleEvent read FOnCommand write FOnCommand;
    property OnHelp: TNotifyEvent read FOnHelp write FOnHelp;

    // Disabled commands won't execute
    property Enabled: Boolean read FEnabled write FEnabled default True;
    { If command is disabled and user calls it, no error report will be
       generated if SilentDisabled is enabled }
    property SilentDisabled: Boolean read FSilentDisabled write FSilentDisabled
      default False;
    { Hidden commands won't show when user requests command list
      or uses auto-complete }
    property Visible: Boolean read FVisible write FVisible default True;
  end;

  TGLConsoleCommandList = class(TCollection)
  private
    FConsole: TGLCustomConsole;
    function GetItems(const Index: Integer): TGLConsoleCommand;
  protected
    function GetOwner: TPersistent; override;
  public
    procedure SortCommands(const Ascending: Boolean = True);
    function CommandExists(const Command: string): Boolean;
    function GetCommandIndex(const Command: string): Integer;

    // General list stuff.
    function LastConsoleCommand: TGLConsoleCommand;
    function Add: TGLConsoleCommand; overload;

    // Standard stuff.
    constructor Create(const AOwner: TGLCustomConsole);
    destructor Destroy; override;

    property Items[const Index: Integer]: TGLConsoleCommand read GetItems;
      default;
  end;

  TGLConsoleControls = class(TPersistent)
  private
    FOwner: TPersistent;

    FNavigatePageUp: Byte;
    FAutoCompleteCommand: Byte;
    FPreviousCommand: Byte;
    FNextCommand: Byte;
    FNavigateUp: Byte;
    FNavigatePageDown: Byte;
    FNavigateDown: Byte;
    FDblClickDelay: Integer;
  protected
    function GetOwner: TPersistent; override;
  public
    constructor Create(AOwner: TPersistent);
    procedure Assign(Source: TPersistent); override;
  published
    property NavigateUp: Byte read FNavigateUp write FNavigateUp default
      glKey_HOME;
    property NavigateDown: Byte read FNavigateDown write FNavigateDown default
      glKey_END;
    property NavigatePageUp: Byte read FNavigatePageUp write FNavigatePageUp
      default glKey_PRIOR;
    property NavigatePageDown: Byte read FNavigatePageDown write
      FNavigatePageDown default glKey_NEXT;
    property NextCommand: Byte read FNextCommand write FNextCommand default
      glKey_DOWN;
    property PreviousCommand: Byte read FPreviousCommand write FPreviousCommand
      default glKey_UP;
    property AutoCompleteCommand: Byte read FAutoCompleteCommand write
      FAutoCompleteCommand default glKey_CONTROL;
    property DblClickDelay: Integer read FDblClickDelay write FDblClickDelay
      default 300;
  end;

  { TGLCustomConsole }
  TGLCustomConsole = class(TGLBaseSceneObject)
  private
    FHudSprite: TGLHudSprite;
    FHudText: TGLHudText;
    FSceneViewer: TGLSceneViewer;

    FInputLine: string;
    FStartLine: Integer;
    FCurrentCommand: Integer;
    FPreviousTickCount: Integer;
    FSize: Single;

    FColsoleLog: TStringList;
    FCommands: TGLConsoleCommandList;
    FAdditionalCommands: TGLConsoleStringList;
    FTypedCommands: TStringList;
    FControls: TGLConsoleControls;

    FOnCommandIssued: TGLlConsoleEvent;

    FOptions: TGLConsoleOptions;
    FHint: string;

    procedure SetSize(const Value: Single);
    procedure SetSceneViewer(const Value: TGLSceneViewer);
    function GetFont: TGLCustomBitmapFont;
    procedure SetFont(const Value: TGLCustomBitmapFont);
  protected
    { Misc }
    procedure DoOnCommandIssued(var UserInputCommand: TGLUserInputCommand);
      virtual;
    procedure SetFontColor(const Color: TColor); virtual;
    function GetFontColor: TColor; virtual;
    procedure SetHUDSpriteColor(const Color: TColor); virtual;
    function GetHUDSpriteColor: TColor; virtual;
    function NumLines: Integer; virtual;
    procedure ShowConsoleHelp; virtual;
    procedure HandleUnknownCommand(const Command: string); virtual;

    { Auto Complete Command }
    procedure AutoCompleteCommand; overload; virtual;
    procedure AutoCompleteCommand(var MatchCount: Integer; var
      AdditionalCommandsMatchList: TGLConsoleMatchList; var CommandsMatchList:
      TGLConsoleMatchList); overload;

    { Command interpreters }
    procedure CommandIssued(var UserInputCommand: TGLUserInputCommand); virtual;
    procedure FixCommand(var UserInputCommand: TGLUserInputCommand); virtual;
    function ParseString(str, caract: string): TGLUserInputCommand; virtual;
    procedure ProcessInput; virtual;

    { Refreshes the Hud (clip lines outside the visible console). }
    procedure RefreshHud; virtual;

    // Register built-in commands (onCreate)
    procedure RegisterBuiltInCommands; virtual;

    // Internal command handlers:

    procedure ProcessInternalCommandHelp(const ConsoleCommand:
      TGLConsoleCommand; const Console: TGLCustomConsole; var Command:
      TGLUserInputCommand); virtual;
    procedure ProcessInternalCommandClearScreen(const ConsoleCommand:
      TGLConsoleCommand; const Console: TGLCustomConsole; var Command:
      TGLUserInputCommand); virtual;

    procedure ProcessInternalCommandConsoleHide(const ConsoleCommand:
      TGLConsoleCommand; const Console: TGLCustomConsole; var Command:
      TGLUserInputCommand); virtual;
    procedure ProcessInternalCommandConsoleColor(const ConsoleCommand:
      TGLConsoleCommand; const Console: TGLCustomConsole; var Command:
      TGLUserInputCommand); virtual;
    procedure ProcessInternalCommandConsoleRename(const ConsoleCommand:
      TGLConsoleCommand; const Console: TGLCustomConsole; var Command:
      TGLUserInputCommand); virtual;
    procedure ProcessInternalCommandConsoleClearTypedCommands(const
      ConsoleCommand: TGLConsoleCommand; const Console: TGLCustomConsole; var
      Command: TGLUserInputCommand); virtual;

    procedure ProcessInternalCommandSystemTime(const ConsoleCommand:
      TGLConsoleCommand; const Console: TGLCustomConsole; var Command:
      TGLUserInputCommand); virtual;
    procedure ProcessInternalCommandSystemDate(const ConsoleCommand:
      TGLConsoleCommand; const Console: TGLCustomConsole; var Command:
      TGLUserInputCommand); virtual;

    procedure ProcessInternalCommandViewerFPS(const ConsoleCommand:
      TGLConsoleCommand; const Console: TGLCustomConsole; var Command:
      TGLUserInputCommand); virtual;
    procedure ProcessInternalCommandViewerResetPerformanceMonitor(const
      ConsoleCommand: TGLConsoleCommand; const Console: TGLCustomConsole; var
      Command: TGLUserInputCommand); virtual;
    procedure ProcessInternalCommandViewerVSync(const ConsoleCommand:
      TGLConsoleCommand; const Console: TGLCustomConsole; var Command:
      TGLUserInputCommand); virtual;
    procedure ProcessInternalCommandViewerAntiAliasing(const ConsoleCommand:
      TGLConsoleCommand; const Console: TGLCustomConsole; var Command:
      TGLUserInputCommand); virtual;

    // Internal command help handlers:
    procedure GetHelpInternalCommandRename(Sender: TObject); virtual;

    procedure Notification(AComponent: TComponent; Operation: TOperation);
      override;
    procedure SetName(const Value: TComponentName); override;
  public
    // Methods:
    // User *must* call these methodsin his code.
    procedure ProcessKeyPress(const c: Char); virtual;
    procedure ProcessKeyDown(const key: word); virtual;

    // Navigation through code from outside
    procedure NavigateUp;
    procedure NavigateDown;
    procedure NavigatePageUp;
    procedure NavigatePageDown;

    { Refreshes the size of the hud to reflect changes on the viewer.
       Should be called whenever the viewer's size changes. }
    procedure RefreshHudSize; virtual;
    { Adds a line (which is not treated as a command). }
    procedure AddLine(const str: string);
    { TypedCommands are cleared and current command index is reset. }
    procedure ClearTypedCommands;

    procedure ExecuteCommand(const Command: string);
    procedure ExecuteCommands(const Commands: TStrings);

    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    { Properties. }
    { Changes the console font color. }
    property FontColor: TColor read GetFontColor write SetFontColor stored
      False;
    property HUDSpriteColor: TColor read GetHUDSpriteColor write
      SetHUDSpriteColor stored False;

    // Where user enters his commands.
    property InputLine: string read FInputLine write FInputLine;

    // List of commands that user typed.
    property TypedCommands: TStringList read FTypedCommands;

    // Commands have events that are called when user types a sertauin command
    property Commands: TGLConsoleCommandList read FCommands;
    { Aditional commands can be registered to participate in command auto-completion.
     They can be interpreted in the global OnCommandIssued event handler. }
    property AdditionalCommands: TGLConsoleStringList read FAdditionalCommands;
    { User controls. }
    property Controls: TGLConsoleControls read FControls;
    { list of commands that user typed and console's responces. }
    property ColsoleLog: TStringList read FColsoleLog;

    { Allows to change consol's height from 0 to 1. }
    property Size: Single read FSize write SetSize;
    { Visual stuff. }
    property SceneViewer: TGLSceneViewer read FSceneViewer write SetSceneViewer;
    property HudSprite: TGLHudSprite read FHudSprite;
    property HudText: TGLHudText read FHudText;
    property Font: TGLCustomBitmapFont read GetFont write SetFont stored False;

    property Options: TGLConsoleOptions read FOptions write FOptions;

    { Main event of the console. Happens whenever the enter key is pressed.
      First the input line is compared to all registered commands, then everything
      is parsed into a TGLUserInputCommand record and  sent to the event.
      Empty lines are  not  ignored (i.e. they also trigger events)}
    property OnCommandIssued: TGLlConsoleEvent read FOnCommandIssued write
      FOnCommandIssued;

    { Standard stuff }
    property Hint: string read FHint write FHint;
    property Visible default False;
  end;

  TGLConsole = class(TGLCustomConsole)
  published
    property FontColor;
    property HUDSpriteColor;
    property InputLine;
    property TypedCommands;
    property Commands;
    property AdditionalCommands;
    property Controls;
    property ColsoleLog;
    property SceneViewer;
    property HudSprite;
    property HudText;
    property Font;
    property Options;
    property OnCommandIssued;

    property Hint;
    property Tag;
    property ObjectsSorting;
    property Visible;
    property OnProgress;
  end;

implementation

const
  STR_NO_DUPLICATE_NAMES_ALLOWED = 'Duplicate names not allowed!';
  STR_UNRECOGNIZED_PARAMETER = 'Unrecognized parameter: ';

  conDefaultFontCharHeight = 15;
  conDefaultConsoleWidth = 400;
  conDefaultConsoleHeight = 100;

  { TGLCustomConsole }

procedure TGLCustomConsole.ProcessInternalCommandClearScreen(const
  ConsoleCommand: TGLConsoleCommand; const Console: TGLCustomConsole; var Command:
  TGLUserInputCommand);
begin
  Console.FInputLine := '';
  Console.ColsoleLog.Clear;
end;

procedure TGLCustomConsole.ProcessInternalCommandConsoleHide(const
  ConsoleCommand: TGLConsoleCommand; const Console: TGLCustomConsole; var Command:
  TGLUserInputCommand);
begin
  Console.Visible := False;
  AddLine(' - Console hidden');
end;

procedure TGLCustomConsole.ProcessInternalCommandConsoleColor(const
  ConsoleCommand: TGLConsoleCommand; const Console: TGLCustomConsole; var Command:
  TGLUserInputCommand);
var
  NewColor: TColor;
begin
  with Console, ConsoleCommand do
  begin
    if Command.CommandCount = 1 then
      AddLine(' - Current console font color is ' +
        ColorToString(FHudText.ModulateColor.AsWinColor))
    else if Command.CommandCount = 2 then
    begin
      if TryStringToColorAdvanced(Command.Strings[1], NewColor) then
      begin
        //color changed successfully
        SetFontColor(NewColor);
        AddLine(' - Current console font changed to ' +
          ColorToString(NewColor));
      end
      else
      begin
        //color unidentified!
        AddLine(' - Color unidentified!');
      end;
    end
    else
      ConsoleCommand.ShowInvalidNumberOfArgumentsError;
  end;
end;

procedure TGLCustomConsole.ProcessInternalCommandConsoleRename(const
  ConsoleCommand: TGLConsoleCommand; const Console: TGLCustomConsole; var Command:
  TGLUserInputCommand);
var
  CommandIndex: Integer;
begin
  if (Command.CommandCount <> 3) then
    ConsoleCommand.ShowInvalidNumberOfArgumentsError
  else
  begin
    CommandIndex :=
      ConsoleCommand.FCommandList.GetCommandIndex(Command.Strings[1]);

    if CommandIndex = -1 then
    begin
      AddLine(' - Could not rename  command +"' + Command.Strings[1] + '" to "'
        +
        Command.Strings[2] + '": such command was not found!');
      ConsoleCommand.ShowHelp;
    end
    else if ConsoleCommand.FCommandList.CommandExists(Command.Strings[2]) or
      Console.FAdditionalCommands.CommandExists(Command.Strings[2]) then
    begin
      AddLine(' - Could not rename  command +"' + Command.Strings[1] + '" to "'
        +
        Command.Strings[2] + '": command "' + Command.Strings[2] +
          '" already exists!');
      ConsoleCommand.ShowHelp;
    end
    else
    begin
      ConsoleCommand.FCommandName := Command.Strings[2];
      AddLine(' - Command "' + Command.Strings[1] + '" successfully renamed to "'
        +
        Command.Strings[2] + '"!');
    end;
  end;
end;

procedure TGLCustomConsole.ProcessInternalCommandConsoleClearTypedCommands(const
  ConsoleCommand: TGLConsoleCommand; const Console: TGLCustomConsole; var Command:
  TGLUserInputCommand);
begin
  if (Command.CommandCount = 1) then
    Console.ClearTypedCommands
  else
    ConsoleCommand.ShowInvalidNumberOfArgumentsError;
end;

procedure TGLCustomConsole.ProcessInternalCommandSystemDate(const
  ConsoleCommand: TGLConsoleCommand; const Console: TGLCustomConsole; var Command:
  TGLUserInputCommand);
begin
  if (Command.CommandCount = 1) then
    AddLine(' - Current system date is: ' + DateToStr(now))
  else
    ConsoleCommand.ShowInvalidNumberOfArgumentsError;
end;

procedure TGLCustomConsole.ProcessInternalCommandHelp(const ConsoleCommand:
  TGLConsoleCommand; const Console: TGLCustomConsole; var Command:
  TGLUserInputCommand);
var
  MainCommand: string;
  I: Integer;
begin
  if Command.CommandCount = 1 then
    Console.ShowConsoleHelp
  else if (Command.CommandCount = 2) then
  begin
    MainCommand := LowerCase(Command.Strings[1]);

    if FCommands.Count <> 0 then
      for I := 0 to FCommands.Count - 1 do
        if MainCommand = LowerCase(FCommands[I].FCommandName) then
        begin
          FCommands[I].ShowHelp;
          Exit;
        end;

    if FAdditionalCommands.Count <> 0 then
      for I := 0 to FAdditionalCommands.Count - 1 do
        if MainCommand = LowerCase(FAdditionalCommands[I]) then
        begin
          AddLine(' - Command "' + Command.Strings[1] +
            '" exists, but help is unavaible,');
          AddLine(' - because it is an external command');
          Exit;
        end;

    HandleUnknownCommand(Command.Strings[1]);
  end
  else
    ConsoleCommand.ShowInvalidNumberOfArgumentsError;
end;

procedure TGLCustomConsole.ProcessInternalCommandSystemTime(const
  ConsoleCommand: TGLConsoleCommand; const Console: TGLCustomConsole; var Command:
  TGLUserInputCommand);
begin
  if Command.CommandCount = 1 then
    AddLine(' - Current system time is: ' + TimeToStr(now))
  else
    ConsoleCommand.ShowInvalidNumberOfArgumentsError;
end;

procedure TGLCustomConsole.GetHelpInternalCommandRename(Sender: TObject);
begin
  with TGLConsoleCommand(Sender) do
  begin
    Addline(' - The "' + FCommandName + '" command can rename any command');
    AddLine(' - Usage:');
    AddLine(' - ' + FCommandName + ' [old_command_name] [new_command_name]');
  end;
end;

procedure TGLCustomConsole.ProcessInternalCommandViewerFPS(const ConsoleCommand:
  TGLConsoleCommand; const Console: TGLCustomConsole; var Command:
  TGLUserInputCommand);
begin
  if Command.CommandCount = 1 then
  begin
    if Console.FSceneViewer <> nil then
      AddLine(' - Current SceneViewer has ' +
        Console.FSceneViewer.FramesPerSecondText)
    else
      AddLine(' - ' + glsErrorEx + glsSceneViewerNotDefined);
  end
  else
    ConsoleCommand.ShowInvalidNumberOfArgumentsError;
end;

procedure
  TGLCustomConsole.ProcessInternalCommandViewerResetPerformanceMonitor(const
  ConsoleCommand: TGLConsoleCommand; const Console: TGLCustomConsole; var Command:
  TGLUserInputCommand);
begin
  if Command.CommandCount = 1 then
  begin
    if Console.FSceneViewer <> nil then
    begin
      Console.FSceneViewer.ResetPerformanceMonitor;
      AddLine(' - ResetPerformanceMonitor for Current SceneViewer completed');
    end
    else
      AddLine(' - ' + glsErrorEx + glsSceneViewerNotDefined);
  end
  else
    ConsoleCommand.ShowInvalidNumberOfArgumentsError;
end;

procedure TGLCustomConsole.ProcessInternalCommandViewerVSync(const
  ConsoleCommand: TGLConsoleCommand; const Console: TGLCustomConsole; var Command:
  TGLUserInputCommand);
const
  ON_OFF: array[Boolean] of string = ('Off', 'On');
begin
  if Console.FSceneViewer <> nil then
  begin
    if Command.CommandCount = 1 then
    begin
      AddLine(' - Current SceneViewer VSync is ' +
        ON_OFF[Console.FSceneViewer.VSync = vsmSync]);
    end
    else if (Command.CommandCount = 2) then
    begin
      if Command.Strings[1] = ON_OFF[False] then
        Console.FSceneViewer.VSync := vsmNoSync
      else if Command.Strings[1] = ON_OFF[True] then
        Console.FSceneViewer.VSync := vsmSync
      else
      begin
        AddLine(' - ' + STR_UNRECOGNIZED_PARAMETER + Command.Strings[1]);
        Exit;
      end;

      AddLine(' - Current SceneViewer VSync was changed to ' +
        ON_OFF[Console.FSceneViewer.VSync = vsmSync]);
    end
    else
      HandleUnknownCommand(Command.Strings[1]);
  end
  else
    AddLine(' - ' + glsErrorEx + glsSceneViewerNotDefined);
end;

procedure TGLCustomConsole.ProcessInternalCommandViewerAntiAliasing(
  const ConsoleCommand: TGLConsoleCommand;
  const Console: TGLCustomConsole; var Command: TGLUserInputCommand);
var
  Temp: Integer;
begin
  if Console.FSceneViewer <> nil then
  begin
    if Command.CommandCount = 1 then
      AddLine(' - Current SceneViewer AntiAliasing = ' +
        GetEnumName(TypeInfo(TGLAntiAliasing),
        Ord(Console.FSceneViewer.Buffer.AntiAliasing)))
    else if (Command.CommandCount = 2) then
    begin
      Temp := GetEnumValue(TypeInfo(TGLAntiAliasing), Command.Strings[1]);
      if Temp = -1 then
      begin
        AddLine(' - ' + STR_UNRECOGNIZED_PARAMETER + Command.Strings[1]);
      end
      else
      begin
        Console.FSceneViewer.Buffer.AntiAliasing := TGLAntiAliasing(Temp);
        AddLine(' - Current SceneViewer AntiAliasing was changed to  ' +
          GetEnumName(TypeInfo(TGLAntiAliasing),
          Ord(Console.FSceneViewer.Buffer.AntiAliasing)))
      end;
    end
    else
      ConsoleCommand.ShowInvalidNumberOfArgumentsError;
  end
  else
    AddLine(' - ' + glsErrorEx + glsSceneViewerNotDefined);
end;

function TGLCustomConsole.ParseString(str, caract: string): TGLUserInputCommand;
var
  p1: Integer;
begin
  Result.CommandCount := 0;
  while True do
  begin
    p1 := pos(caract, str);
    if (p1 = 0) or (p1 = -1) then
      break;
    SetLength(Result.Strings, Result.CommandCount + 1);
    Result.Strings[Result.CommandCount] := copy(str, 1, p1 - 1);
    str := copy(str, p1 + 1, Length(str));
    Result.CommandCount := Result.CommandCount + 1;
  end;
  if Length(str) > 0 then
  begin
    setlength(Result.Strings, Result.CommandCount + 1);
    Result.Strings[Result.CommandCount] := str;
    Result.CommandCount := Result.CommandCount + 1;
  end;
end;

procedure TGLCustomConsole.FixCommand(var UserInputCommand:
  TGLUserInputCommand);
var
  nCount, I: Integer;
  openq: Boolean;
begin
  for I := 0 to UserInputCommand.CommandCount - 1 do
    UserInputCommand.Strings[I] := trim(UserInputCommand.Strings[I]);

  nCount := 0;
  I := 0;
  openq := False;
  while nCount < UserInputCommand.CommandCount do
  begin
    if UserInputCommand.Strings[I] = '' then
    begin
      if UserInputCommand.Strings[nCount] <> '' then
        UserInputCommand.Strings[I] := UserInputCommand.Strings[nCount];
    end
    else if openq then
      UserInputCommand.Strings[I] := UserInputCommand.Strings[I] + ' ' +
        UserInputCommand.Strings[nCount];

    if (Length(UserInputCommand.Strings[I]) > 0) then
    begin
      if coRemoveQuotes in FOptions then
      begin
        if (UserInputCommand.Strings[I][1] = '"') and
          (UserInputCommand.Strings[I][Length(UserInputCommand.Strings[I])] =
            '"') then
          UserInputCommand.Strings[I] := copy(UserInputCommand.Strings[I], 2,
            Length(UserInputCommand.Strings[I]) - 2);

        if (UserInputCommand.Strings[I][1] = '"') and not openq then
        begin
          openq := True;
          UserInputCommand.Strings[I] := copy(UserInputCommand.Strings[I], 2,
            Length(UserInputCommand.Strings[I]));
        end;

        if (UserInputCommand.Strings[I][Length(UserInputCommand.Strings[I])] =
          '"') and openq then
        begin
          openq := False;
          UserInputCommand.Strings[I] := copy(UserInputCommand.Strings[I], 1,
            Length(UserInputCommand.Strings[I]) - 1);
        end;
      end;

      if not openq then
        Inc(I);
    end;
    Inc(nCount);
  end;

  if I < UserInputCommand.CommandCount then
  begin
    setLength(UserInputCommand.Strings, I);
    UserInputCommand.CommandCount := I;
  end;
end;

constructor TGLCustomConsole.Create(AOwner: TComponent);
begin
  inherited;
  FColsoleLog := TStringList.Create;
  FTypedCommands := TStringList.Create;
  FCommands := TGLConsoleCommandList.Create(Self);
  FAdditionalCommands := TGLConsoleStringList.Create(Self);
  FControls := TGLConsoleControls.Create(Self);

  FHudSprite := TGLHudSprite.Create(Self);
  MakeSubComponent(FHudSprite, True);
  AddChild(FHudSprite);
  FHudSprite.FreeNotification(Self);
  with FHudSprite.Material do
  begin
    BlendingMode := bmTransparency;
    FrontProperties.Diffuse.Alpha := 0.5;
    Texture.TextureMode := tmModulate;
    Texture.Enabled := True;
  end;

  FHudText := TGLHudText.Create(Self);
  MakeSubComponent(FHudText, True);
  AddChild(FHUDText);
  FHudText.FreeNotification(Self);
  FHudText.Position.Y := 2;
  FHudText.Position.X := 3;

  FSize := 0.35;

  RegisterBuiltIncommands;
  SetVisible(False);
  SetHUDSpriteColor(clWhite);
  SetFontColor(clBlue);
end;

destructor TGLCustomConsole.Destroy;
begin
  Controls.Destroy;
  FCommands.Destroy;
  FAdditionalCommands.Destroy;
  FTypedCommands.Destroy;
  FColsoleLog.Destroy;
  FreeAndNil(FHudSprite);
  FreeAndNil(FHudText);
  inherited;
end;

procedure TGLCustomConsole.ProcessKeyPress(const c: Char);
begin
  if not Visible then
    Exit;

  if c = #8 then //glKey_BACK
    FInputLine := copy(FInputLine, 1, Length(FInputLine) - 1)
  else if c = #13 then //glKey_RETURN
  begin
    if coAutoCompleteCommandsOnEnter in FOptions then
      AutoCompleteCommand;

    //remmember the current entered command
    if (FInputLine <> '') and (FInputLine <> #13) then
    begin
      if FTypedCommands.Count = 0 then
        FCurrentCommand := FTypedCommands.Add(FInputLine) + 1
      else
      begin
        if FTypedCommands[FTypedCommands.Count - 1] <> FInputLine then
          FCurrentCommand := FTypedCommands.Add(FInputLine) + 1;
      end;
    end;

    ProcessInput;
  end
  else
    FInputLine := FinputLine + c;

  if coAutoCompleteCommandsOnKeyPress in FOptions then
    AutoCompleteCommand;

  RefreshHud;
end;

procedure TGLCustomConsole.ProcessKeyDown(const key: word);
var
  MatchCount: Integer;
  AdditionalCommandsMatchList: TGLConsoleMatchList;
  CommandsMatchList: TGLConsoleMatchList;
  CurrentTickCount: Integer;
  I: Integer;
begin
  if not Visible then
    Exit;

  if (key = FControls.NextCommand) then
    if FCurrentCommand <> FTypedCommands.Count then
    begin
      if FCurrentCommand <> FTypedCommands.Count - 1 then
        Inc(FCurrentCommand);
      FinputLine := FTypedCommands[FCurrentCommand];
    end;

  if (key = FControls.PreviousCommand) then
    if FTypedCommands.Count <> 0 then
    begin
      if FCurrentCommand <> 0 then
        Dec(FCurrentCommand);
      FinputLine := FTypedCommands[FCurrentCommand];
    end;

  if (key = FControls.AutoCompleteCommand) then
  begin
    CurrentTickCount := GLGetTickCount;
    AutoCompleteCommand(MatchCount, AdditionalCommandsMatchList,
      CommandsMatchList);
    if MatchCount = 0 then
      Beep;

    if CurrentTickCount - FPreviousTickCount < Controls.FDblClickDelay then
      if MatchCount > 1 then
      begin
        if CommandsMatchList <> [] then
        begin
          AddLine(' - Registered commands:');
          for I := 0 to CONSOLE_MAX_COMMANDS do
            if I in CommandsMatchList then
              AddLine('   - ' + FCommands[I].FCommandName);
        end;

        if AdditionalCommandsMatchList <> [] then
        begin
          AddLine(' - Additional registered commands:');
          for I := 0 to CONSOLE_MAX_COMMANDS do
            if I in AdditionalCommandsMatchList then
              AddLine('   - ' + FAdditionalCommands[I]);
        end;
      end;

    FPreviousTickCount := CurrentTickCount;
  end;

  if (key = FControls.NavigateUp) then
    Dec(FStartLine);
  if (key = FControls.NavigateDown) then
    Inc(FStartLine);
  if (key = FControls.NavigatePageUp) then
    Dec(FStartLine, NumLines);
  if key = FControls.NavigatePageDown then
    Inc(FStartLine, NumLines);

  RefreshHud;
end;

procedure TGLCustomConsole.RefreshHud;
var
  outStr: string;
  endLine, I: Integer;
begin
  //beware! This stuf is messy

  if FStartLine > FColsoleLog.Count - numlines then
    FStartLine := FColsoleLog.Count - numlines;
  if FStartLine < 0 then
    FStartLine := 0;

  endLine := FStartLine + numlines - 1;

  if FColsoleLog.Count < numLines then
    outStr := FColsoleLog.Text
  else
  begin
    for I := FStartLine to endLine do
      outStr := outStr + FColsoleLog[I] + #13;
  end;

  FHudText.Text := outStr + '> ' + FInputLine;
end;

function TGLCustomConsole.NumLines: Integer;
begin
  if GetFont = nil then
    Result := Trunc(FHudSprite.Height / conDefaultFontCharHeight - 1.7)
  else
    Result := Trunc(FHudSprite.Height / GetFont.CharHeight - 1.7);
end;

procedure TGLCustomConsole.ProcessInput;
var
  info: TGLUserInputCommand;
begin
  //Add the current line
  AddLine(FInputLine);

  //Get everything between spaces
  info := ParseString(FInputLine, ' ');
  info.UnknownCommand := True;
  //Remove empty strings and " sequences
  FixCommand(info);
  //Execute the command
  CommandIssued(info);

  //Clear the current line
  FinputLine := '';
end;

procedure TGLCustomConsole.ExecuteCommands(const Commands: TStrings);
var
  I: Integer;
begin
  if Commands.Count = 0 then
    Exit;
  for I := 0 to Commands.Count - 1 do
    ExecuteCommand(Commands[I]);
end;

procedure TGLCustomConsole.ExecuteCommand(const Command: string);
begin
  FInputLine := Command;
  ProcessInput;
end;

procedure TGLCustomConsole.AddLine(const str: string);
begin
  FColsoleLog.Text := FColsoleLog.Text + str + #10;
  FStartLine := FColsoleLog.Count - numLines;
  RefreshHud;
end;

procedure TGLCustomConsole.CommandIssued(var UserInputCommand:
  TGLUserInputCommand);
var
  MainCommand: string;
  I: Integer;
begin
  if UserInputCommand.CommandCount = 0 then
    Exit;

  MainCommand := LowerCase(UserInputCommand.Strings[0]);

  if FCommands.Count <> 0 then
    for I := 0 to FCommands.Count - 1 do
      if MainCommand = LowerCase(FCommands[I].FCommandName) then
      begin
        //show help
        if UserInputCommand.CommandCount > 1 then
        begin
          //I hope I didn't forget anything ;)
          if (UserInputCommand.Strings[1] = '/?') or
            (UserInputCommand.Strings[1] = '\?') or
            (UserInputCommand.Strings[1] = '-?') or
            (UserInputCommand.Strings[1] = '--?') or
            (UserInputCommand.Strings[1] = '/help') or
            (UserInputCommand.Strings[1] = '\help') or
            (UserInputCommand.Strings[1] = '-help') or
            (UserInputCommand.Strings[1] = '--help') then
            FCommands[I].ShowHelp
          else
            //or execute the asosiated event
            FCommands[I].DoOnCommand(UserInputCommand);
        end
        else
          //or execute the asosiated event
          FCommands[I].DoOnCommand(UserInputCommand);

        //recognize the command
        UserInputCommand.UnknownCommand := False;
        break;
      end;

  //external command processing event
  DoOnCommandIssued(UserInputCommand);

  if UserInputCommand.UnknownCommand then
    HandleUnknownCommand(UserInputCommand.Strings[0]);
end;

procedure TGLCustomConsole.RefreshHudSize;
begin
  if FSceneViewer <> nil then
  begin
    FHudSprite.Width := FSceneViewer.Width;
    FHudSprite.Height := FSceneViewer.Height * FSize;
  end
  else
  begin
    FHudSprite.Width := conDefaultConsoleWidth;
    FHudSprite.Height := conDefaultConsoleHeight;
  end;

  FHudSprite.Position.X := FHudSprite.Width / 2;
  FHudSprite.Position.Y := FHudSprite.Height / 2;
  RefreshHud;
end;

procedure TGLCustomConsole.SetFontColor(const Color: TColor);
begin
  FHUDText.ModulateColor.AsWinColor := Color;
  FHUDText.Material.FrontProperties.Ambient.AsWinColor := Color;
end;

procedure TGLCustomConsole.ShowConsoleHelp;
var
  I: Integer;

begin
  if (FCommands.Count = 0) and (FAdditionalCommands.Count = 0) then
    AddLine(' - There are no registered commands!')
  else
  begin
    if FCommands.Count <> 0 then
    begin
      AddLine(' - List of registered console commands:');
      for I := 0 to FCommands.Count - 1 do
        FCommands[I].ShowShortHelp;
    end;

    if FAdditionalCommands.Count <> 0 then
    begin
      AddLine(' - List of additional console commands:');
      for I := 0 to FAdditionalCommands.Count - 1 do
        AddLine('   - ' + FAdditionalCommands[I]);
    end;
  end;
end;

procedure TGLCustomConsole.ClearTypedCommands;
begin
  FTypedCommands.Clear;
  FCurrentCommand := 0;
end;

{$WARNINGS off}

procedure TGLCustomConsole.AutoCompleteCommand(var MatchCount: Integer;
  var AdditionalCommandsMatchList: TGLConsoleMatchList;
  var CommandsMatchList: TGLConsoleMatchList);
var
  I: Integer;
  HasEnterKey: Boolean;
  NewInputLine, FirstMatch: string;
  NewMatchCount, FirstMatchIndex: Integer;
begin
  MatchCount := 0;
  AdditionalCommandsMatchList := [];
  CommandsMatchList := [];
  if FInputLine <> '' then
  begin
    //delete the last "Enter" key, if there is any
    if FInputLine[Length(FInputLine)] = #13 then
    begin
      Delete(FInputLine, Length(FInputLine), 1);
      HasEnterKey := True;
    end;

    //find all the matches
    if FAdditionalCommands.Count <> 0 then
      for I := 0 to FAdditionalCommands.Count - 1 do
        if AnsiStartsText(FInputLine, FAdditionalCommands[I]) then
        begin
          Inc(MatchCount);
          AdditionalCommandsMatchList := AdditionalCommandsMatchList + [I];
        end;

    if FCommands.Count <> 0 then
      for I := 0 to FCommands.Count - 1 do
        if FCommands[I].FVisible then
          if AnsiStartsText(FInputLine, FCommands[I].FCommandName) then
          begin
            Inc(MatchCount);
            CommandsMatchList := CommandsMatchList + [I];
          end;

    //if there is only one, fill it up!
    if MatchCount = 1 then
    begin
      if AdditionalCommandsMatchList <> [] then
        for I := 0 to CONSOLE_MAX_COMMANDS do
          if I in AdditionalCommandsMatchList then
          begin
            FInputLine := FAdditionalCommands[I];
            break;
          end;
      if CommandsMatchList <> [] then
        for I := 0 to CONSOLE_MAX_COMMANDS do
          if I in CommandsMatchList then
          begin
            FInputLine := FCommands[I].FCommandName;
            break;
          end;
    end
    else
      {//if more than 1, try to complete other letters} if MatchCount > 1 then
      begin
        NewInputLine := FInputLine;
        //find 1st match
        if AdditionalCommandsMatchList <> [] then
          for I := 0 to CONSOLE_MAX_COMMANDS do
            if I in AdditionalCommandsMatchList then
            begin
              FirstMatch := FAdditionalCommands[I];
              FirstMatchIndex := I;
              break;
            end;

        if AdditionalCommandsMatchList = [] then
          for I := 0 to CONSOLE_MAX_COMMANDS do
            if I in CommandsMatchList then
            begin
              FirstMatch := FCommands[I].FCommandName;
              FirstMatchIndex := I;
              break;
            end;

        NewMatchCount := MatchCount;
        while (NewMatchCount = MatchCount) and (Length(NewInputLine) <>
          Length(FirstMatch)) do
        begin
          NewInputLine := NewInputLine + FirstMatch[Length(NewInputLine) + 1];
          NewMatchCount := 0;

          if AdditionalCommandsMatchList <> [] then
            for I := FirstMatchIndex to FAdditionalCommands.Count - 1 do
              if AnsiStartsText(NewInputLine, FAdditionalCommands[I]) then
                Inc(NewMatchCount);

          if AdditionalCommandsMatchList = [] then
          begin
            for I := FirstMatchIndex to FCommands.Count - 1 do
              if AnsiStartsText(NewInputLine, FCommands[I].FCommandName) then
                Inc(NewMatchCount);
          end
          else if CommandsMatchList <> [] then
          begin
            for I := 0 to FCommands.Count - 1 do
              if AnsiStartsText(NewInputLine, FCommands[I].FCommandName) then
                Inc(NewMatchCount);
          end;
        end;

        FInputLine := NewInputLine;

        if NewMatchCount <> MatchCount then
          Delete(FInputLine, Length(NewInputLine), 1);
      end;

    //Restore the #13 key
    if HasEnterKey then
      FInputLine := FInputLine + #13;
  end;
end;
{$WARNINGS on}

procedure TGLCustomConsole.AutoCompleteCommand;
var
  MatchCount: Integer;
  AdditionalCommandsMatchList: TGLConsoleMatchList;
  CommandsMatchList: TGLConsoleMatchList;
begin
  AutoCompleteCommand(MatchCount, AdditionalCommandsMatchList,
    CommandsMatchList);
end;

procedure TGLCustomConsole.RegisterBuiltInCommands;
begin
  { Special commands }
  with FCommands.Add do
  begin
    FCommandName := '?';
    FShortHelp := 'displays help for a single command or all commands';
    FLongHelp.Add(FShortHelp);
    FOnCommand := ProcessInternalCommandHelp;
  end;

  with FCommands.Add do
  begin
    FCommandName := 'Help';
    FShortHelp := 'displays help for a single command or all commands';
    FLongHelp.Add(FShortHelp);
    FOnCommand := ProcessInternalCommandHelp;
  end;

  with FCommands.Add do
  begin
    FCommandName := 'cls';
    FShortHelp := 'clears screen';
    FLongHelp.Add(FShortHelp);
    FOnCommand := ProcessInternalCommandClearScreen;
  end;

  { Console commands }
  with FCommands.Add do
  begin
    FCommandName := 'Console.Hide';
    FShortHelp := 'hides the console';
    FLongHelp.Add(FShortHelp);
    FOnCommand := ProcessInternalCommandConsoleHide;
  end;

  with FCommands.Add do
  begin
    FCommandName := 'Console.Color';
    FShortHelp := 'displays and allows to change the color of the console';
    FLongHelp.Add(FShortHelp);
    FOnCommand := ProcessInternalCommandConsoleColor;
  end;

  with FCommands.Add do
  begin
    FCommandName := 'Console.Ren';
    FShortHelp := 'renames any command';
    // FLongHelp.Add('') not needed here, because is has an OnHelp event
    FOnCommand := ProcessInternalCommandConsoleRename;
    FOnHelp := GetHelpInternalCommandRename;
  end;

  with FCommands.Add do
  begin
    FCommandName := 'Console.ClearTypedCommands';
    FShortHelp := 'clears Typed Commands list';
    FLongHelp.Add(FShortHelp);
    FOnCommand := ProcessInternalCommandConsoleClearTypedCommands;
  end;

  { System commands }
  with FCommands.Add do
  begin
    FCommandName := 'System.Time';
    FShortHelp := 'displays current system time';
    FLongHelp.Add(FShortHelp);
    FOnCommand := ProcessInternalCommandSystemTime;
  end;

  with FCommands.Add do
  begin
    FCommandName := 'System.Date';
    FShortHelp := 'displays current system date';
    FLongHelp.Add(FShortHelp);
    FOnCommand := ProcessInternalCommandSystemDate;
  end;

  { Viewer commands }
  with FCommands.Add do
  begin
    FCommandName := 'Viewer.FPS';
    FShortHelp := 'displays GLSceneViewer FPS';
    FLongHelp.Add(FShortHelp);
    FOnCommand := ProcessInternalCommandViewerFPS;
  end;

  with FCommands.Add do
  begin
    FCommandName := 'Viewer.ResetPerformanceMonitor';
    FShortHelp := 'resets GLSceneViewer FPS monitor';
    FLongHelp.Add(FShortHelp);
    FOnCommand := ProcessInternalCommandViewerResetPerformanceMonitor;
  end;

  with FCommands.Add do
  begin
    FCommandName := 'Viewer.VSync';
    FShortHelp := 'displays and allows to change GLSceneViewer VSync';
    FLongHelp.Add(FShortHelp);
    FOnCommand := ProcessInternalCommandViewerVSync;
  end;

  with FCommands.Add do
  begin
    FCommandName := 'Viewer.AntiAliasing';
    FShortHelp := 'displays and allows to change GLSceneViewer AntiAliasing';
    FLongHelp.Add(FShortHelp);
    FOnCommand := ProcessInternalCommandViewerAntiAliasing;
  end;
end;

procedure TGLCustomConsole.HandleUnknownCommand(const Command: string);
begin
  AddLine(' - Command "' + Command + '" not recognized!');
  if coShowConsoleHelpIfUnknownCommand in FOptions then
    ShowConsoleHelp;
end;

procedure TGLCustomConsole.NavigateDown;
begin
  Inc(FStartLine);
  if FStartLine > FColsoleLog.Count - numlines then
    FStartLine := FColsoleLog.Count - numlines;
  if FStartLine < 0 then
    FStartLine := 0;
end;

procedure TGLCustomConsole.NavigatePageDown;
begin
  Inc(FStartLine, NumLines);
  if FStartLine > FColsoleLog.Count - numlines then
    FStartLine := FColsoleLog.Count - numlines;
  if FStartLine < 0 then
    FStartLine := 0;
end;

procedure TGLCustomConsole.NavigatePageUp;
begin
  Dec(FStartLine, NumLines);
  if FStartLine > FColsoleLog.Count - numlines then
    FStartLine := FColsoleLog.Count - numlines;
  if FStartLine < 0 then
    FStartLine := 0;
end;

procedure TGLCustomConsole.NavigateUp;
begin
  Dec(FStartLine);
  if FStartLine > FColsoleLog.Count - numlines then
    FStartLine := FColsoleLog.Count - numlines;
  if FStartLine < 0 then
    FStartLine := 0;
end;

function TGLCustomConsole.GetFontColor: TColor;
begin
  Result := FHUDText.ModulateColor.AsWinColor;
end;

function TGLCustomConsole.GetHUDSpriteColor: TColor;
begin
  if Assigned(HUDSprite.Material.MaterialLibrary)
    and (HUDSprite.Material.MaterialLibrary is TGLMaterialLibrary)
    and (HUDSprite.Material.LibMaterialName <> '') then
    Result :=
      TGLMaterialLibrary(HUDSprite.Material.MaterialLibrary).LibMaterialByName(HUDSprite.Material.LibMaterialName).Material.FrontProperties.Ambient.AsWinColor
  else
    Result := HUDSprite.Material.FrontProperties.Ambient.AsWinColor;
end;

procedure TGLCustomConsole.SetHUDSpriteColor(const Color: TColor);
begin
  if Assigned(HUDSprite.Material.MaterialLibrary)
    and (HUDSprite.Material.MaterialLibrary is TGLMaterialLibrary)
    and (HUDSprite.Material.LibMaterialName <> '') then
      TGLMaterialLibrary(HUDSprite.Material.MaterialLibrary).LibMaterialByName(HUDSprite.Material.LibMaterialName).Material.FrontProperties.Ambient.AsWinColor := Color
  else
    HUDSprite.Material.FrontProperties.Ambient.AsWinColor := Color;
end;

procedure TGLCustomConsole.SetSize(const Value: Single);
begin
  if (Value <= 0) or (Value > 1) then
    raise EGLConsoleException.Create('Size must be between 0 and 1!')
  else
  begin
    FSize := Value;
    RefreshHudSize;
  end;
end;

procedure TGLCustomConsole.DoOnCommandIssued(var UserInputCommand:
  TGLUserInputCommand);
begin
  if Assigned(FOnCommandIssued) then
    FOnCommandIssued(nil, Self, UserInputCommand);
end;

procedure TGLCustomConsole.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited;
  if Operation = opRemove then
  begin
    if AComponent = FSceneViewer then
      FSceneViewer := nil;

    if AComponent = FHudSprite then
      FHudSprite := nil;

    if AComponent = FHudText then
      FHudText := nil;
  end;
end;

procedure TGLCustomConsole.SetSceneViewer(
  const Value: TGLSceneViewer);
begin
  if FSceneViewer <> nil then
    FSceneViewer.RemoveFreeNotification(Self);

  FSceneViewer := Value;

  if FSceneViewer <> nil then
  begin
    FSceneViewer.FreeNotification(Self);
    RefreshHudSize;
  end;
end;

function TGLCustomConsole.GetFont: TGLCustomBitmapFont;
begin
  Result := FHudText.BitmapFont;
end;

procedure TGLCustomConsole.SetFont(const Value: TGLCustomBitmapFont);
begin
  FHudText.BitmapFont := Value;
end;

procedure TGLCustomConsole.SetName(const Value: TComponentName);
begin
  inherited;
  FHudSprite.Name := Value + 'HudSprite';
  FHudText.Name := Value + 'HudText';
end;

{ TGLConsoleControls }

procedure TGLConsoleControls.Assign(Source: TPersistent);
begin
  if Source is TGLConsoleControls then
  begin
    FNavigateUp := TGLConsoleControls(Source).FNavigateUp;
    FNavigateDown := TGLConsoleControls(Source).FNavigateDown;
    FNavigatePageUp := TGLConsoleControls(Source).FNavigatePageUp;
    FNavigatePageDown := TGLConsoleControls(Source).FNavigatePageDown;
    FNextCommand := TGLConsoleControls(Source).FNextCommand;
    FPreviousCommand := TGLConsoleControls(Source).FPreviousCommand;
    FAutoCompleteCommand := TGLConsoleControls(Source).FAutoCompleteCommand;
    FDblClickDelay := TGLConsoleControls(Source).FDblClickDelay;
  end;
end;

constructor TGLConsoleControls.Create(AOwner: TPersistent);
begin
  FOwner := AOwner;

  FNavigateUp := glKey_HOME;
  FNavigateDown := glKey_END;
  FNavigatePageUp := glKey_PRIOR;
  FNavigatePageDown := glKey_NEXT;
  FNextCommand := glKey_DOWN;
  FPreviousCommand := glKey_UP;
  FAutoCompleteCommand := glKey_CONTROL;

  FDblClickDelay := 300;
end;

function TGLConsoleControls.GetOwner: TPersistent;
begin
  Result := FOwner;
end;

{ TGLConsoleCommand }

procedure TGLConsoleCommand.Assign(Source: TPersistent);
begin
  Assert(Source <> nil);
  inherited;
  SetCommandName(TGLConsoleCommand(Source).FCommandName);
  FShortHelp := TGLConsoleCommand(Source).FShortHelp;
  FLongHelp.Assign(TGLConsoleCommand(Source).FLongHelp);

  FVisible := TGLConsoleCommand(Source).FVisible;
  FEnabled := TGLConsoleCommand(Source).FEnabled;
  FSilentDisabled := TGLConsoleCommand(Source).FSilentDisabled;
end;

constructor TGLConsoleCommand.Create(Collection: TCollection);
begin
  inherited;
  Assert((Collection is TGLConsoleCommandList) or (Collection = nil));

  FCommandList := TGLConsoleCommandList(Collection);
  FLongHelp := TStringList.Create;

  FVisible := True;
  FEnabled := True;
end;

destructor TGLConsoleCommand.Destroy;
begin
  FLongHelp.Destroy;
  inherited;
end;

procedure TGLConsoleCommand.ShowInvalidUseOfCommandError;
begin
  FCommandList.FConsole.AddLine('   - Invalid use of command!');
end;

procedure TGLConsoleCommand.ShowInvalidNumberOfArgumentsError(const
  ShowHelpAfter: Boolean);
begin
  FCommandList.FConsole.AddLine('   - Invalid number of arguments!');
  if ShowHelpAfter then
    ShowHelp;
end;

procedure TGLConsoleCommand.SetCommandName(const Value: string);
begin
  //the name must be unique
  if FCommandList.CommandExists(Value) or
    FCommandList.FConsole.FAdditionalCommands.CommandExists(Value) then
  begin
    raise EGLConsoleException.Create(STR_NO_DUPLICATE_NAMES_ALLOWED);
    Exit;
  end;

  FCommandName := Value;
end;

procedure TGLConsoleCommand.ShowHelp;
var
  I: Integer;
begin
  if Assigned(FOnHelp) then
    FOnHelp(Self)
  else if FLongHelp.Count <> 0 then
    for I := 0 to FLongHelp.Count - 1 do
      FCommandList.FConsole.AddLine('   - ' + FLongHelp[I]);
end;

procedure TGLConsoleCommand.DoOnCommand(var UserInputCommand:
  TGLUserInputCommand);
begin
  Assert(Assigned(FOnCommand));
  if FEnabled then
    FOnCommand(Self, FCommandList.FConsole, UserInputCommand)
  else
  begin
    if not FSilentDisabled then
      FCommandList.FConsole.AddLine(' - Command "' + FCommandName +
        '" has been disabled!');
  end;
end;

procedure TGLConsoleCommand.ShowShortHelp;
begin
  if FVisible then
    FCommandList.FConsole.AddLine('   - ' + FCommandName + ' - ' + FShortHelp);
end;

function TGLConsoleCommand.GetDisplayName: string;
begin
  if FCommandName = '' then
    Result := inherited GetDisplayName
  else
    Result := FCommandName;
end;

{ TGLConsoleCommandList }

function TGLConsoleCommandList.Add: TGLConsoleCommand;
begin
  Result := TGLConsoleCommand(inherited Add);
end;

constructor TGLConsoleCommandList.Create(const AOwner: TGLCustomConsole);
begin
  Assert(AOwner <> nil);
  FConsole := TGLCustomConsole(AOwner);
  inherited Create(TGLConsoleCommand);
end;

destructor TGLConsoleCommandList.Destroy;
begin
  Clear;
  inherited;
end;

function TGLConsoleCommandList.GetItems(const Index: Integer):
  TGLConsoleCommand;
begin
  Result := TGLConsoleCommand(inherited Items[Index]);
end;

function TGLConsoleCommandList.LastConsoleCommand: TGLConsoleCommand;
begin
  Result := GetItems(Count - 1);
end;

procedure TGLConsoleCommandList.SortCommands(const Ascending: Boolean);
begin
  Assert(False, 'Not implemented yet....');
end;

function TGLConsoleCommandList.CommandExists(const Command: string): Boolean;
var
  I: Integer;
begin
  Result := True;
  if Count <> 0 then
    for I := 0 to Count - 1 do
      if GetItems(I).FCommandName = Command then
        Exit;
  Result := False;
end;

function TGLConsoleCommandList.GetCommandIndex(const Command: string): Integer;
begin
  if Count <> 0 then
    for Result := 0 to Count - 1 do
      if GetItems(Result).FCommandName = Command then
        Exit;

  Result := -1;
end;

function TGLConsoleCommandList.GetOwner: TPersistent;
begin
  Result := FConsole;
end;

{ TGLConsoleStringList }

procedure TGLConsoleStringList.Changed;
begin
  inherited;
  //we'll just assume that user added a command and check it,
  //other cases are not dealt with

  if Count = 0 then
    Exit;

  //check if this command does not duplicate any existing
  if FConsole.FCommands.CommandExists(Strings[Count - 1]) then
    Delete(Count - 1);
end;

function TGLConsoleStringList.CommandExists(const Command: string): Boolean;
begin
  Result := IndexOf(Command) <> -1;
end;

constructor TGLConsoleStringList.Create(const Owner: TGLCustomConsole);
begin
  Assert(Owner <> nil);
  Duplicates := dupError;
  FConsole := Owner;
end;

function TGLConsoleStringList.GetOwner: TPersistent;
begin
  Result := FConsole;
end;

initialization
  RegisterClasses([TGLCustomConsole, TGLConsole, TGLConsoleStringList,
    TGLConsoleCommand, TGLConsoleCommandList, TGLConsoleControls]);

end.

