1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693 |
- //
- // The multimedia graphics platform GLScene https://github.com/glscene
- //
- unit GLS.Console;
- (*
- The console is a popdown window that appears on a game for text output/input.
- 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...
- *)
- interface
- {$I GLScene.inc}
- uses
- Winapi.Windows,
- System.Classes,
- System.SysUtils,
- System.TypInfo,
- Vcl.Graphics,
- GLS.Scene,
- GLS.Coordinates,
- GLS.Objects,
- GLS.HudObjects,
- GLS.SceneViewer,
- GLS.BitmapFont,
- GLS.PersistentClasses,
- GLS.Context,
- GLS.Texture,
- GLS.Utils,
- GLS.Strings,
- GLS.Material,
- GLS.VectorTypes;
- 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
- procedure ShowHelp; virtual;
- procedure ShowShortHelp; virtual;
- procedure Assign(Source: TPersistent); override;
- constructor Create(Collection: TCollection); override;
- destructor Destroy; override;
- published
- 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 VK_HOME;
- property NavigateDown: Byte read FNavigateDown write FNavigateDown default VK_END;
- property NavigatePageUp: Byte read FNavigatePageUp write FNavigatePageUp default VK_PRIOR;
- property NavigatePageDown: Byte read FNavigatePageDown write FNavigatePageDown default VK_NEXT;
- property NextCommand: Byte read FNextCommand write FNextCommand default VK_DOWN;
- property PreviousCommand: Byte read FPreviousCommand write FPreviousCommand default VK_UP;
- property AutoCompleteCommand: Byte read FAutoCompleteCommand write FAutoCompleteCommand default VK_CONTROL;
- property DblClickDelay: Integer read FDblClickDelay write FDblClickDelay default 300;
- end;
- 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;
- procedure SetHUDSpriteColor(const Color: TColor); virtual;
- function GetHUDSpriteColor: TColor;
- function NumLines: Integer;
- 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;
- 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 methods in 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;
- // 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(' - ' + strErrorEx + strSceneViewerNotDefined);
- 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(' - ' + strErrorEx + strSceneViewerNotDefined);
- 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(' - ' + strErrorEx + strSceneViewerNotDefined);
- 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(' - ' + strErrorEx + strSceneViewerNotDefined);
- 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 //VK_BACK
- FInputLine := copy(FInputLine, 1, Length(FInputLine) - 1)
- else if c = #13 then //VK_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 := GetTickCount;
- 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 := VK_HOME;
- FNavigateDown := VK_END;
- FNavigatePageUp := VK_PRIOR;
- FNavigatePageDown := VK_NEXT;
- FNextCommand := VK_DOWN;
- FPreviousCommand := VK_UP;
- FAutoCompleteCommand := VK_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.
|