| 12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694 |
- //
- // The graphics engine 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.Defines.inc}
- uses
- Winapi.Windows,
- System.Classes,
- System.SysUtils,
- System.TypInfo,
- Vcl.Graphics,
- GLScene.VectorTypes,
- GLScene.Strings,
- GLS.Scene,
- GLS.Coordinates,
- GLS.Objects,
- GLS.HudObjects,
- GLS.SceneViewer,
- GLS.BitmapFont,
- GLS.PersistentClasses,
- GLS.Context,
- GLS.ImageUtils,
- GLS.Texture,
- GLScene.Utils,
- GLS.Material;
- 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.
|