GLS.Console.pas 51 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693
  1. //
  2. // The multimedia graphics platform GLScene https://github.com/glscene
  3. //
  4. unit GLS.Console;
  5. (*
  6. The console is a popdown window that appears on a game for text output/input.
  7. What is different compared to the original component?
  8. 1) Can be aded to any object, not just the root one
  9. 2) Has a *wide* range of built-in commands
  10. 3) TGLConsoleCommand.UnknownCommand added
  11. it is set to True, if no internal command recognized
  12. 4) Internal console help added
  13. 5) By default does not remove quotes ("), but this option can be
  14. turned on (property RemoveQuotes)
  15. 6) Command list added. All user commands are saved there
  16. 7) All previously typed commands can be accessed in a usual way (arrow up/down)
  17. 8) Commands can be auto-completed by pressing TConsoleControls.AutoCompleteCommand key,
  18. or setting AutoCompleteCommandsOnKeyPress, AutoCompleteCommandsOnEnter to True
  19. Dbl-pressing the key, defined in the TConsoleControls.AutoCompleteCommand
  20. property, gives you a list of all posible internal-external commands that
  21. start with your letters
  22. 9) Batch command execution support added
  23. 10) Short help is shown when user calls the global 'help' function
  24. Long help is shown elsewhere
  25. 11) Show command help by "/?", "-?", "--?" etc
  26. 12) Assign() added for every class
  27. TODO:
  28. [new command] Redirection with the | operator, like in any othe console (optional)
  29. [new command] File browser stuff... (this one's optional ;)
  30. Blinking cursor, "Delete" key support
  31. Allow long lines to continue on the next line
  32. May be SceneViewer should be a TControl to support the FullScreenViewer...
  33. *)
  34. interface
  35. {$I GLScene.inc}
  36. uses
  37. Winapi.Windows,
  38. System.Classes,
  39. System.SysUtils,
  40. System.TypInfo,
  41. Vcl.Graphics,
  42. GLS.Scene,
  43. GLS.Coordinates,
  44. GLS.Objects,
  45. GLS.HudObjects,
  46. GLS.SceneViewer,
  47. GLS.BitmapFont,
  48. GLS.PersistentClasses,
  49. GLS.Context,
  50. GLS.Texture,
  51. GLS.Utils,
  52. GLS.Strings,
  53. GLS.Material,
  54. GLS.VectorTypes;
  55. const
  56. CONSOLE_MAX_COMMANDS = 120;
  57. type
  58. EGLConsoleException = class(Exception);
  59. TGLConsoleOption = (coAutoCompleteCommandsOnKeyPress,
  60. //commands are auto-completed as user types them
  61. coAutoCompleteCommandsOnEnter, //commands are auto-completed when user presses the "Enter" key
  62. coShowConsoleHelpIfUnknownCommand, //take a wild guess ;)
  63. coRemoveQuotes); //remove quotes when a command line is parsed
  64. TGLConsoleOptions = set of TGLConsoleOption;
  65. TGLCustomConsole = class;
  66. TGLConsoleCommandList = class;
  67. TGLConsoleCommand = class;
  68. (* Stores info on a command. A command is a parsed input line.
  69. Should be transformed into a class, I think...*)
  70. TGLUserInputCommand = record
  71. CommandCount: Integer;
  72. Strings: array of string;
  73. UnknownCommand: Boolean;
  74. //if user identifies a command, he must set this to "True"
  75. end;
  76. // Event called when used presses the "Enter"
  77. TGLlConsoleEvent = procedure(const ConsoleCommand: TGLConsoleCommand;
  78. const Console: TGLCustomConsole;
  79. var Command: TGLUserInputCommand) of object;
  80. TGLConsoleMatchList = set of 0..CONSOLE_MAX_COMMANDS {Byte};
  81. // A class that checks for duplicates.
  82. TGLConsoleStringList = class(TStringList)
  83. private
  84. FConsole: TGLCustomConsole;
  85. protected
  86. procedure Changed; override;
  87. function GetOwner: TPersistent; override;
  88. public
  89. function CommandExists(const Command: string): Boolean;
  90. constructor Create(const Owner: TGLCustomConsole);
  91. end;
  92. // A wrapper for a console command.
  93. TGLConsoleCommand = class(TCollectionItem)
  94. private
  95. FVisible: Boolean;
  96. FEnabled: Boolean;
  97. FSilentDisabled: Boolean;
  98. FCommandList: TGLConsoleCommandList;
  99. FCommandName: string;
  100. FShortHelp: string;
  101. FLongHelp: TStringList;
  102. FOnCommand: TGLlConsoleEvent;
  103. FOnHelp: TNotifyEvent;
  104. procedure SetCommandName(const Value: string);
  105. protected
  106. procedure ShowInvalidUseOfCommandError; virtual;
  107. procedure ShowInvalidNumberOfArgumentsError(const ShowHelpAfter: Boolean =
  108. True); virtual;
  109. procedure DoOnCommand(var UserInputCommand: TGLUserInputCommand); virtual;
  110. function GetDisplayName: string; override;
  111. public
  112. procedure ShowHelp; virtual;
  113. procedure ShowShortHelp; virtual;
  114. procedure Assign(Source: TPersistent); override;
  115. constructor Create(Collection: TCollection); override;
  116. destructor Destroy; override;
  117. published
  118. property CommandName: string read FCommandName write SetCommandName;
  119. property ShortHelp: string read FShortHelp write FShortHelp;
  120. property LongHelp: TStringList read FLongHelp;
  121. property OnCommand: TGLlConsoleEvent read FOnCommand write FOnCommand;
  122. property OnHelp: TNotifyEvent read FOnHelp write FOnHelp;
  123. // Disabled commands won't execute
  124. property Enabled: Boolean read FEnabled write FEnabled default True;
  125. (* If command is disabled and user calls it, no error report will be
  126. generated if SilentDisabled is enabled *)
  127. property SilentDisabled: Boolean read FSilentDisabled write FSilentDisabled
  128. default False;
  129. (* Hidden commands won't show when user requests command list
  130. or uses auto-complete *)
  131. property Visible: Boolean read FVisible write FVisible default True;
  132. end;
  133. TGLConsoleCommandList = class(TCollection)
  134. private
  135. FConsole: TGLCustomConsole;
  136. function GetItems(const Index: Integer): TGLConsoleCommand;
  137. protected
  138. function GetOwner: TPersistent; override;
  139. public
  140. procedure SortCommands(const Ascending: Boolean = True);
  141. function CommandExists(const Command: string): Boolean;
  142. function GetCommandIndex(const Command: string): Integer;
  143. // General list stuff.
  144. function LastConsoleCommand: TGLConsoleCommand;
  145. function Add: TGLConsoleCommand; overload;
  146. // Standard stuff.
  147. constructor Create(const AOwner: TGLCustomConsole);
  148. destructor Destroy; override;
  149. property Items[const Index: Integer]: TGLConsoleCommand read GetItems;
  150. default;
  151. end;
  152. TGLConsoleControls = class(TPersistent)
  153. private
  154. FOwner: TPersistent;
  155. FNavigatePageUp: Byte;
  156. FAutoCompleteCommand: Byte;
  157. FPreviousCommand: Byte;
  158. FNextCommand: Byte;
  159. FNavigateUp: Byte;
  160. FNavigatePageDown: Byte;
  161. FNavigateDown: Byte;
  162. FDblClickDelay: Integer;
  163. protected
  164. function GetOwner: TPersistent; override;
  165. public
  166. constructor Create(AOwner: TPersistent);
  167. procedure Assign(Source: TPersistent); override;
  168. published
  169. property NavigateUp: Byte read FNavigateUp write FNavigateUp default VK_HOME;
  170. property NavigateDown: Byte read FNavigateDown write FNavigateDown default VK_END;
  171. property NavigatePageUp: Byte read FNavigatePageUp write FNavigatePageUp default VK_PRIOR;
  172. property NavigatePageDown: Byte read FNavigatePageDown write FNavigatePageDown default VK_NEXT;
  173. property NextCommand: Byte read FNextCommand write FNextCommand default VK_DOWN;
  174. property PreviousCommand: Byte read FPreviousCommand write FPreviousCommand default VK_UP;
  175. property AutoCompleteCommand: Byte read FAutoCompleteCommand write FAutoCompleteCommand default VK_CONTROL;
  176. property DblClickDelay: Integer read FDblClickDelay write FDblClickDelay default 300;
  177. end;
  178. TGLCustomConsole = class(TGLBaseSceneObject)
  179. private
  180. FHudSprite: TGLHudSprite;
  181. FHudText: TGLHudText;
  182. FSceneViewer: TGLSceneViewer;
  183. FInputLine: string;
  184. FStartLine: Integer;
  185. FCurrentCommand: Integer;
  186. FPreviousTickCount: Integer;
  187. FSize: Single;
  188. FColsoleLog: TStringList;
  189. FCommands: TGLConsoleCommandList;
  190. FAdditionalCommands: TGLConsoleStringList;
  191. FTypedCommands: TStringList;
  192. FControls: TGLConsoleControls;
  193. FOnCommandIssued: TGLlConsoleEvent;
  194. FOptions: TGLConsoleOptions;
  195. FHint: string;
  196. procedure SetSize(const Value: Single);
  197. procedure SetSceneViewer(const Value: TGLSceneViewer);
  198. function GetFont: TGLCustomBitmapFont;
  199. procedure SetFont(const Value: TGLCustomBitmapFont);
  200. protected
  201. // Misc
  202. procedure DoOnCommandIssued(var UserInputCommand: TGLUserInputCommand); virtual;
  203. procedure SetFontColor(const Color: TColor); virtual;
  204. function GetFontColor: TColor;
  205. procedure SetHUDSpriteColor(const Color: TColor); virtual;
  206. function GetHUDSpriteColor: TColor;
  207. function NumLines: Integer;
  208. procedure ShowConsoleHelp; virtual;
  209. procedure HandleUnknownCommand(const Command: string); virtual;
  210. // Auto Complete Command
  211. procedure AutoCompleteCommand; overload; virtual;
  212. procedure AutoCompleteCommand(var MatchCount: Integer; var
  213. AdditionalCommandsMatchList: TGLConsoleMatchList; var CommandsMatchList:
  214. TGLConsoleMatchList); overload;
  215. // Command interpreters
  216. procedure CommandIssued(var UserInputCommand: TGLUserInputCommand); virtual;
  217. procedure FixCommand(var UserInputCommand: TGLUserInputCommand); virtual;
  218. function ParseString(str, caract: string): TGLUserInputCommand;
  219. procedure ProcessInput; virtual;
  220. // Refreshes the Hud (clip lines outside the visible console).
  221. procedure RefreshHud; virtual;
  222. // Register built-in commands (onCreate)
  223. procedure RegisterBuiltInCommands; virtual;
  224. // Internal command handlers:
  225. procedure ProcessInternalCommandHelp(const ConsoleCommand:
  226. TGLConsoleCommand; const Console: TGLCustomConsole; var Command:
  227. TGLUserInputCommand); virtual;
  228. procedure ProcessInternalCommandClearScreen(const ConsoleCommand:
  229. TGLConsoleCommand; const Console: TGLCustomConsole; var Command:
  230. TGLUserInputCommand); virtual;
  231. procedure ProcessInternalCommandConsoleHide(const ConsoleCommand:
  232. TGLConsoleCommand; const Console: TGLCustomConsole; var Command:
  233. TGLUserInputCommand); virtual;
  234. procedure ProcessInternalCommandConsoleColor(const ConsoleCommand:
  235. TGLConsoleCommand; const Console: TGLCustomConsole; var Command:
  236. TGLUserInputCommand); virtual;
  237. procedure ProcessInternalCommandConsoleRename(const ConsoleCommand:
  238. TGLConsoleCommand; const Console: TGLCustomConsole; var Command:
  239. TGLUserInputCommand); virtual;
  240. procedure ProcessInternalCommandConsoleClearTypedCommands(const
  241. ConsoleCommand: TGLConsoleCommand; const Console: TGLCustomConsole; var
  242. Command: TGLUserInputCommand); virtual;
  243. procedure ProcessInternalCommandSystemTime(const ConsoleCommand:
  244. TGLConsoleCommand; const Console: TGLCustomConsole; var Command:
  245. TGLUserInputCommand); virtual;
  246. procedure ProcessInternalCommandSystemDate(const ConsoleCommand:
  247. TGLConsoleCommand; const Console: TGLCustomConsole; var Command:
  248. TGLUserInputCommand); virtual;
  249. procedure ProcessInternalCommandViewerFPS(const ConsoleCommand:
  250. TGLConsoleCommand; const Console: TGLCustomConsole; var Command:
  251. TGLUserInputCommand); virtual;
  252. procedure ProcessInternalCommandViewerResetPerformanceMonitor(const
  253. ConsoleCommand: TGLConsoleCommand; const Console: TGLCustomConsole; var
  254. Command: TGLUserInputCommand); virtual;
  255. procedure ProcessInternalCommandViewerVSync(const ConsoleCommand:
  256. TGLConsoleCommand; const Console: TGLCustomConsole; var Command:
  257. TGLUserInputCommand); virtual;
  258. procedure ProcessInternalCommandViewerAntiAliasing(const ConsoleCommand:
  259. TGLConsoleCommand; const Console: TGLCustomConsole; var Command:
  260. TGLUserInputCommand); virtual;
  261. // Internal command help handlers:
  262. procedure GetHelpInternalCommandRename(Sender: TObject); virtual;
  263. procedure Notification(AComponent: TComponent; Operation: TOperation);
  264. override;
  265. procedure SetName(const Value: TComponentName); override;
  266. public
  267. (* Methods: User *must* call these methods in his code. *)
  268. procedure ProcessKeyPress(const c: Char); virtual;
  269. procedure ProcessKeyDown(const key: word); virtual;
  270. // Navigation through code from outside
  271. procedure NavigateUp;
  272. procedure NavigateDown;
  273. procedure NavigatePageUp;
  274. procedure NavigatePageDown;
  275. (* Refreshes the size of the hud to reflect changes on the viewer.
  276. Should be called whenever the viewer's size changes. *)
  277. procedure RefreshHudSize; virtual;
  278. // Adds a line (which is not treated as a command).
  279. procedure AddLine(const str: string);
  280. // TypedCommands are cleared and current command index is reset.
  281. procedure ClearTypedCommands;
  282. procedure ExecuteCommand(const Command: string);
  283. procedure ExecuteCommands(const Commands: TStrings);
  284. constructor Create(AOwner: TComponent); override;
  285. destructor Destroy; override;
  286. // Changes the console font color.
  287. property FontColor: TColor read GetFontColor write SetFontColor stored False;
  288. property HUDSpriteColor: TColor read GetHUDSpriteColor write SetHUDSpriteColor stored False;
  289. // Where user enters his commands.
  290. property InputLine: string read FInputLine write FInputLine;
  291. // List of commands that user typed.
  292. property TypedCommands: TStringList read FTypedCommands;
  293. // Commands have events that are called when user types a sertauin command
  294. property Commands: TGLConsoleCommandList read FCommands;
  295. (* Aditional commands can be registered to participate in command auto-completion.
  296. They can be interpreted in the global OnCommandIssued event handler. *)
  297. property AdditionalCommands: TGLConsoleStringList read FAdditionalCommands;
  298. // User controls.
  299. property Controls: TGLConsoleControls read FControls;
  300. // List of commands that user typed and console's responces.
  301. property ColsoleLog: TStringList read FColsoleLog;
  302. // Allows to change consol's height from 0 to 1.
  303. property Size: Single read FSize write SetSize;
  304. // Visual stuff.
  305. property SceneViewer: TGLSceneViewer read FSceneViewer write SetSceneViewer;
  306. property HudSprite: TGLHudSprite read FHudSprite;
  307. property HudText: TGLHudText read FHudText;
  308. property Font: TGLCustomBitmapFont read GetFont write SetFont stored False;
  309. property Options: TGLConsoleOptions read FOptions write FOptions;
  310. (* Main event of the console. Happens whenever the enter key is pressed.
  311. First the input line is compared to all registered commands, then everything
  312. is parsed into a TGLUserInputCommand record and sent to the event.
  313. Empty lines are not ignored (i.e. they also trigger events) *)
  314. property OnCommandIssued: TGLlConsoleEvent read FOnCommandIssued write
  315. FOnCommandIssued;
  316. // Standard stuff
  317. property Hint: string read FHint write FHint;
  318. property Visible default False;
  319. end;
  320. TGLConsole = class(TGLCustomConsole)
  321. published
  322. property FontColor;
  323. property HUDSpriteColor;
  324. property InputLine;
  325. property TypedCommands;
  326. property Commands;
  327. property AdditionalCommands;
  328. property Controls;
  329. property ColsoleLog;
  330. property SceneViewer;
  331. property HudSprite;
  332. property HudText;
  333. property Font;
  334. property Options;
  335. property OnCommandIssued;
  336. property Hint;
  337. property Tag;
  338. property ObjectsSorting;
  339. property Visible;
  340. property OnProgress;
  341. end;
  342. //-------------------------------------------------------------------
  343. implementation
  344. //-------------------------------------------------------------------
  345. const
  346. STR_NO_DUPLICATE_NAMES_ALLOWED = 'Duplicate names not allowed!';
  347. STR_UNRECOGNIZED_PARAMETER = 'Unrecognized parameter: ';
  348. conDefaultFontCharHeight = 15;
  349. conDefaultConsoleWidth = 400;
  350. conDefaultConsoleHeight = 100;
  351. //------------------------------
  352. // TGLCustomConsole
  353. //------------------------------
  354. procedure TGLCustomConsole.ProcessInternalCommandClearScreen(const
  355. ConsoleCommand: TGLConsoleCommand; const Console: TGLCustomConsole; var Command:
  356. TGLUserInputCommand);
  357. begin
  358. Console.FInputLine := '';
  359. Console.ColsoleLog.Clear;
  360. end;
  361. procedure TGLCustomConsole.ProcessInternalCommandConsoleHide(const
  362. ConsoleCommand: TGLConsoleCommand; const Console: TGLCustomConsole; var Command:
  363. TGLUserInputCommand);
  364. begin
  365. Console.Visible := False;
  366. AddLine(' - Console hidden');
  367. end;
  368. procedure TGLCustomConsole.ProcessInternalCommandConsoleColor(const
  369. ConsoleCommand: TGLConsoleCommand; const Console: TGLCustomConsole; var Command:
  370. TGLUserInputCommand);
  371. var
  372. NewColor: TColor;
  373. begin
  374. with Console, ConsoleCommand do
  375. begin
  376. if Command.CommandCount = 1 then
  377. AddLine(' - Current console font color is ' +
  378. ColorToString(FHudText.ModulateColor.AsWinColor))
  379. else if Command.CommandCount = 2 then
  380. begin
  381. if TryStringToColorAdvanced(Command.Strings[1], NewColor) then
  382. begin
  383. //color changed successfully
  384. SetFontColor(NewColor);
  385. AddLine(' - Current console font changed to ' +
  386. ColorToString(NewColor));
  387. end
  388. else
  389. begin
  390. //color unidentified!
  391. AddLine(' - Color unidentified!');
  392. end;
  393. end
  394. else
  395. ConsoleCommand.ShowInvalidNumberOfArgumentsError;
  396. end;
  397. end;
  398. procedure TGLCustomConsole.ProcessInternalCommandConsoleRename(const
  399. ConsoleCommand: TGLConsoleCommand; const Console: TGLCustomConsole; var Command:
  400. TGLUserInputCommand);
  401. var
  402. CommandIndex: Integer;
  403. begin
  404. if (Command.CommandCount <> 3) then
  405. ConsoleCommand.ShowInvalidNumberOfArgumentsError
  406. else
  407. begin
  408. CommandIndex :=
  409. ConsoleCommand.FCommandList.GetCommandIndex(Command.Strings[1]);
  410. if CommandIndex = -1 then
  411. begin
  412. AddLine(' - Could not rename command +"' + Command.Strings[1] + '" to "'
  413. +
  414. Command.Strings[2] + '": such command was not found!');
  415. ConsoleCommand.ShowHelp;
  416. end
  417. else if ConsoleCommand.FCommandList.CommandExists(Command.Strings[2]) or
  418. Console.FAdditionalCommands.CommandExists(Command.Strings[2]) then
  419. begin
  420. AddLine(' - Could not rename command +"' + Command.Strings[1] + '" to "'
  421. +
  422. Command.Strings[2] + '": command "' + Command.Strings[2] +
  423. '" already exists!');
  424. ConsoleCommand.ShowHelp;
  425. end
  426. else
  427. begin
  428. ConsoleCommand.FCommandName := Command.Strings[2];
  429. AddLine(' - Command "' + Command.Strings[1] + '" successfully renamed to "'
  430. +
  431. Command.Strings[2] + '"!');
  432. end;
  433. end;
  434. end;
  435. procedure TGLCustomConsole.ProcessInternalCommandConsoleClearTypedCommands(const
  436. ConsoleCommand: TGLConsoleCommand; const Console: TGLCustomConsole; var Command:
  437. TGLUserInputCommand);
  438. begin
  439. if (Command.CommandCount = 1) then
  440. Console.ClearTypedCommands
  441. else
  442. ConsoleCommand.ShowInvalidNumberOfArgumentsError;
  443. end;
  444. procedure TGLCustomConsole.ProcessInternalCommandSystemDate(const
  445. ConsoleCommand: TGLConsoleCommand; const Console: TGLCustomConsole; var Command:
  446. TGLUserInputCommand);
  447. begin
  448. if (Command.CommandCount = 1) then
  449. AddLine(' - Current system date is: ' + DateToStr(now))
  450. else
  451. ConsoleCommand.ShowInvalidNumberOfArgumentsError;
  452. end;
  453. procedure TGLCustomConsole.ProcessInternalCommandHelp(const ConsoleCommand:
  454. TGLConsoleCommand; const Console: TGLCustomConsole; var Command:
  455. TGLUserInputCommand);
  456. var
  457. MainCommand: string;
  458. I: Integer;
  459. begin
  460. if Command.CommandCount = 1 then
  461. Console.ShowConsoleHelp
  462. else if (Command.CommandCount = 2) then
  463. begin
  464. MainCommand := LowerCase(Command.Strings[1]);
  465. if FCommands.Count <> 0 then
  466. for I := 0 to FCommands.Count - 1 do
  467. if MainCommand = LowerCase(FCommands[I].FCommandName) then
  468. begin
  469. FCommands[I].ShowHelp;
  470. Exit;
  471. end;
  472. if FAdditionalCommands.Count <> 0 then
  473. for I := 0 to FAdditionalCommands.Count - 1 do
  474. if MainCommand = LowerCase(FAdditionalCommands[I]) then
  475. begin
  476. AddLine(' - Command "' + Command.Strings[1] +
  477. '" exists, but help is unavaible,');
  478. AddLine(' - because it is an external command');
  479. Exit;
  480. end;
  481. HandleUnknownCommand(Command.Strings[1]);
  482. end
  483. else
  484. ConsoleCommand.ShowInvalidNumberOfArgumentsError;
  485. end;
  486. procedure TGLCustomConsole.ProcessInternalCommandSystemTime(const
  487. ConsoleCommand: TGLConsoleCommand; const Console: TGLCustomConsole; var Command:
  488. TGLUserInputCommand);
  489. begin
  490. if Command.CommandCount = 1 then
  491. AddLine(' - Current system time is: ' + TimeToStr(now))
  492. else
  493. ConsoleCommand.ShowInvalidNumberOfArgumentsError;
  494. end;
  495. procedure TGLCustomConsole.GetHelpInternalCommandRename(Sender: TObject);
  496. begin
  497. with TGLConsoleCommand(Sender) do
  498. begin
  499. Addline(' - The "' + FCommandName + '" command can rename any command');
  500. AddLine(' - Usage:');
  501. AddLine(' - ' + FCommandName + ' [old_command_name] [new_command_name]');
  502. end;
  503. end;
  504. procedure TGLCustomConsole.ProcessInternalCommandViewerFPS(const ConsoleCommand:
  505. TGLConsoleCommand; const Console: TGLCustomConsole; var Command:
  506. TGLUserInputCommand);
  507. begin
  508. if Command.CommandCount = 1 then
  509. begin
  510. if Console.FSceneViewer <> nil then
  511. AddLine(' - Current SceneViewer has ' +
  512. Console.FSceneViewer.FramesPerSecondText)
  513. else
  514. AddLine(' - ' + strErrorEx + strSceneViewerNotDefined);
  515. end
  516. else
  517. ConsoleCommand.ShowInvalidNumberOfArgumentsError;
  518. end;
  519. procedure
  520. TGLCustomConsole.ProcessInternalCommandViewerResetPerformanceMonitor(const
  521. ConsoleCommand: TGLConsoleCommand; const Console: TGLCustomConsole; var Command:
  522. TGLUserInputCommand);
  523. begin
  524. if Command.CommandCount = 1 then
  525. begin
  526. if Console.FSceneViewer <> nil then
  527. begin
  528. Console.FSceneViewer.ResetPerformanceMonitor;
  529. AddLine(' - ResetPerformanceMonitor for Current SceneViewer completed');
  530. end
  531. else
  532. AddLine(' - ' + strErrorEx + strSceneViewerNotDefined);
  533. end
  534. else
  535. ConsoleCommand.ShowInvalidNumberOfArgumentsError;
  536. end;
  537. procedure TGLCustomConsole.ProcessInternalCommandViewerVSync(const
  538. ConsoleCommand: TGLConsoleCommand; const Console: TGLCustomConsole; var Command:
  539. TGLUserInputCommand);
  540. const
  541. ON_OFF: array[Boolean] of string = ('Off', 'On');
  542. begin
  543. if Console.FSceneViewer <> nil then
  544. begin
  545. if Command.CommandCount = 1 then
  546. begin
  547. AddLine(' - Current SceneViewer VSync is ' +
  548. ON_OFF[Console.FSceneViewer.VSync = vsmSync]);
  549. end
  550. else if (Command.CommandCount = 2) then
  551. begin
  552. if Command.Strings[1] = ON_OFF[False] then
  553. Console.FSceneViewer.VSync := vsmNoSync
  554. else if Command.Strings[1] = ON_OFF[True] then
  555. Console.FSceneViewer.VSync := vsmSync
  556. else
  557. begin
  558. AddLine(' - ' + STR_UNRECOGNIZED_PARAMETER + Command.Strings[1]);
  559. Exit;
  560. end;
  561. AddLine(' - Current SceneViewer VSync was changed to ' +
  562. ON_OFF[Console.FSceneViewer.VSync = vsmSync]);
  563. end
  564. else
  565. HandleUnknownCommand(Command.Strings[1]);
  566. end
  567. else
  568. AddLine(' - ' + strErrorEx + strSceneViewerNotDefined);
  569. end;
  570. procedure TGLCustomConsole.ProcessInternalCommandViewerAntiAliasing(
  571. const ConsoleCommand: TGLConsoleCommand;
  572. const Console: TGLCustomConsole; var Command: TGLUserInputCommand);
  573. var
  574. Temp: Integer;
  575. begin
  576. if Console.FSceneViewer <> nil then
  577. begin
  578. if Command.CommandCount = 1 then
  579. AddLine(' - Current SceneViewer AntiAliasing = ' +
  580. GetEnumName(TypeInfo(TGLAntiAliasing),
  581. Ord(Console.FSceneViewer.Buffer.AntiAliasing)))
  582. else if (Command.CommandCount = 2) then
  583. begin
  584. Temp := GetEnumValue(TypeInfo(TGLAntiAliasing), Command.Strings[1]);
  585. if Temp = -1 then
  586. begin
  587. AddLine(' - ' + STR_UNRECOGNIZED_PARAMETER + Command.Strings[1]);
  588. end
  589. else
  590. begin
  591. Console.FSceneViewer.Buffer.AntiAliasing := TGLAntiAliasing(Temp);
  592. AddLine(' - Current SceneViewer AntiAliasing was changed to ' +
  593. GetEnumName(TypeInfo(TGLAntiAliasing),
  594. Ord(Console.FSceneViewer.Buffer.AntiAliasing)))
  595. end;
  596. end
  597. else
  598. ConsoleCommand.ShowInvalidNumberOfArgumentsError;
  599. end
  600. else
  601. AddLine(' - ' + strErrorEx + strSceneViewerNotDefined);
  602. end;
  603. function TGLCustomConsole.ParseString(str, caract: string): TGLUserInputCommand;
  604. var
  605. p1: Integer;
  606. begin
  607. Result.CommandCount := 0;
  608. while True do
  609. begin
  610. p1 := pos(caract, str);
  611. if (p1 = 0) or (p1 = -1) then
  612. break;
  613. SetLength(Result.Strings, Result.CommandCount + 1);
  614. Result.Strings[Result.CommandCount] := copy(str, 1, p1 - 1);
  615. str := copy(str, p1 + 1, Length(str));
  616. Result.CommandCount := Result.CommandCount + 1;
  617. end;
  618. if Length(str) > 0 then
  619. begin
  620. setlength(Result.Strings, Result.CommandCount + 1);
  621. Result.Strings[Result.CommandCount] := str;
  622. Result.CommandCount := Result.CommandCount + 1;
  623. end;
  624. end;
  625. procedure TGLCustomConsole.FixCommand(var UserInputCommand:
  626. TGLUserInputCommand);
  627. var
  628. nCount, I: Integer;
  629. openq: Boolean;
  630. begin
  631. for I := 0 to UserInputCommand.CommandCount - 1 do
  632. UserInputCommand.Strings[I] := trim(UserInputCommand.Strings[I]);
  633. nCount := 0;
  634. I := 0;
  635. openq := False;
  636. while nCount < UserInputCommand.CommandCount do
  637. begin
  638. if UserInputCommand.Strings[I] = '' then
  639. begin
  640. if UserInputCommand.Strings[nCount] <> '' then
  641. UserInputCommand.Strings[I] := UserInputCommand.Strings[nCount];
  642. end
  643. else if openq then
  644. UserInputCommand.Strings[I] := UserInputCommand.Strings[I] + ' ' +
  645. UserInputCommand.Strings[nCount];
  646. if (Length(UserInputCommand.Strings[I]) > 0) then
  647. begin
  648. if coRemoveQuotes in FOptions then
  649. begin
  650. if (UserInputCommand.Strings[I][1] = '"') and
  651. (UserInputCommand.Strings[I][Length(UserInputCommand.Strings[I])] =
  652. '"') then
  653. UserInputCommand.Strings[I] := copy(UserInputCommand.Strings[I], 2,
  654. Length(UserInputCommand.Strings[I]) - 2);
  655. if (UserInputCommand.Strings[I][1] = '"') and not openq then
  656. begin
  657. openq := True;
  658. UserInputCommand.Strings[I] := copy(UserInputCommand.Strings[I], 2,
  659. Length(UserInputCommand.Strings[I]));
  660. end;
  661. if (UserInputCommand.Strings[I][Length(UserInputCommand.Strings[I])] =
  662. '"') and openq then
  663. begin
  664. openq := False;
  665. UserInputCommand.Strings[I] := copy(UserInputCommand.Strings[I], 1,
  666. Length(UserInputCommand.Strings[I]) - 1);
  667. end;
  668. end;
  669. if not openq then
  670. Inc(I);
  671. end;
  672. Inc(nCount);
  673. end;
  674. if I < UserInputCommand.CommandCount then
  675. begin
  676. setLength(UserInputCommand.Strings, I);
  677. UserInputCommand.CommandCount := I;
  678. end;
  679. end;
  680. constructor TGLCustomConsole.Create(AOwner: TComponent);
  681. begin
  682. inherited;
  683. FColsoleLog := TStringList.Create;
  684. FTypedCommands := TStringList.Create;
  685. FCommands := TGLConsoleCommandList.Create(Self);
  686. FAdditionalCommands := TGLConsoleStringList.Create(Self);
  687. FControls := TGLConsoleControls.Create(Self);
  688. FHudSprite := TGLHudSprite.Create(Self);
  689. MakeSubComponent(FHudSprite, True);
  690. AddChild(FHudSprite);
  691. FHudSprite.FreeNotification(Self);
  692. with FHudSprite.Material do
  693. begin
  694. BlendingMode := bmTransparency;
  695. FrontProperties.Diffuse.Alpha := 0.5;
  696. Texture.TextureMode := tmModulate;
  697. Texture.Enabled := True;
  698. end;
  699. FHudText := TGLHudText.Create(Self);
  700. MakeSubComponent(FHudText, True);
  701. AddChild(FHUDText);
  702. FHudText.FreeNotification(Self);
  703. FHudText.Position.Y := 2;
  704. FHudText.Position.X := 3;
  705. FSize := 0.35;
  706. RegisterBuiltIncommands;
  707. SetVisible(False);
  708. SetHUDSpriteColor(clWhite);
  709. SetFontColor(clBlue);
  710. end;
  711. destructor TGLCustomConsole.Destroy;
  712. begin
  713. Controls.Destroy;
  714. FCommands.Destroy;
  715. FAdditionalCommands.Destroy;
  716. FTypedCommands.Destroy;
  717. FColsoleLog.Destroy;
  718. FreeAndNil(FHudSprite);
  719. FreeAndNil(FHudText);
  720. inherited;
  721. end;
  722. procedure TGLCustomConsole.ProcessKeyPress(const c: Char);
  723. begin
  724. if not Visible then
  725. Exit;
  726. if c = #8 then //VK_BACK
  727. FInputLine := copy(FInputLine, 1, Length(FInputLine) - 1)
  728. else if c = #13 then //VK_RETURN
  729. begin
  730. if coAutoCompleteCommandsOnEnter in FOptions then
  731. AutoCompleteCommand;
  732. //remmember the current entered command
  733. if (FInputLine <> '') and (FInputLine <> #13) then
  734. begin
  735. if FTypedCommands.Count = 0 then
  736. FCurrentCommand := FTypedCommands.Add(FInputLine) + 1
  737. else
  738. begin
  739. if FTypedCommands[FTypedCommands.Count - 1] <> FInputLine then
  740. FCurrentCommand := FTypedCommands.Add(FInputLine) + 1;
  741. end;
  742. end;
  743. ProcessInput;
  744. end
  745. else
  746. FInputLine := FinputLine + c;
  747. if coAutoCompleteCommandsOnKeyPress in FOptions then
  748. AutoCompleteCommand;
  749. RefreshHud;
  750. end;
  751. procedure TGLCustomConsole.ProcessKeyDown(const key: word);
  752. var
  753. MatchCount: Integer;
  754. AdditionalCommandsMatchList: TGLConsoleMatchList;
  755. CommandsMatchList: TGLConsoleMatchList;
  756. CurrentTickCount: Integer;
  757. I: Integer;
  758. begin
  759. if not Visible then
  760. Exit;
  761. if (key = FControls.NextCommand) then
  762. if FCurrentCommand <> FTypedCommands.Count then
  763. begin
  764. if FCurrentCommand <> FTypedCommands.Count - 1 then
  765. Inc(FCurrentCommand);
  766. FinputLine := FTypedCommands[FCurrentCommand];
  767. end;
  768. if (key = FControls.PreviousCommand) then
  769. if FTypedCommands.Count <> 0 then
  770. begin
  771. if FCurrentCommand <> 0 then
  772. Dec(FCurrentCommand);
  773. FinputLine := FTypedCommands[FCurrentCommand];
  774. end;
  775. if (key = FControls.AutoCompleteCommand) then
  776. begin
  777. CurrentTickCount := GetTickCount;
  778. AutoCompleteCommand(MatchCount, AdditionalCommandsMatchList,
  779. CommandsMatchList);
  780. if MatchCount = 0 then
  781. Beep;
  782. if CurrentTickCount - FPreviousTickCount < Controls.FDblClickDelay then
  783. if MatchCount > 1 then
  784. begin
  785. if CommandsMatchList <> [] then
  786. begin
  787. AddLine(' - Registered commands:');
  788. for I := 0 to CONSOLE_MAX_COMMANDS do
  789. if I in CommandsMatchList then
  790. AddLine(' - ' + FCommands[I].FCommandName);
  791. end;
  792. if AdditionalCommandsMatchList <> [] then
  793. begin
  794. AddLine(' - Additional registered commands:');
  795. for I := 0 to CONSOLE_MAX_COMMANDS do
  796. if I in AdditionalCommandsMatchList then
  797. AddLine(' - ' + FAdditionalCommands[I]);
  798. end;
  799. end;
  800. FPreviousTickCount := CurrentTickCount;
  801. end;
  802. if (key = FControls.NavigateUp) then
  803. Dec(FStartLine);
  804. if (key = FControls.NavigateDown) then
  805. Inc(FStartLine);
  806. if (key = FControls.NavigatePageUp) then
  807. Dec(FStartLine, NumLines);
  808. if key = FControls.NavigatePageDown then
  809. Inc(FStartLine, NumLines);
  810. RefreshHud;
  811. end;
  812. procedure TGLCustomConsole.RefreshHud;
  813. var
  814. outStr: string;
  815. endLine, I: Integer;
  816. begin
  817. //beware! This stuf is messy
  818. if FStartLine > FColsoleLog.Count - numlines then
  819. FStartLine := FColsoleLog.Count - numlines;
  820. if FStartLine < 0 then
  821. FStartLine := 0;
  822. endLine := FStartLine + numlines - 1;
  823. if FColsoleLog.Count < numLines then
  824. outStr := FColsoleLog.Text
  825. else
  826. begin
  827. for I := FStartLine to endLine do
  828. outStr := outStr + FColsoleLog[I] + #13;
  829. end;
  830. FHudText.Text := outStr + '> ' + FInputLine;
  831. end;
  832. function TGLCustomConsole.NumLines: Integer;
  833. begin
  834. if GetFont = nil then
  835. Result := Trunc(FHudSprite.Height / conDefaultFontCharHeight - 1.7)
  836. else
  837. Result := Trunc(FHudSprite.Height / GetFont.CharHeight - 1.7);
  838. end;
  839. procedure TGLCustomConsole.ProcessInput;
  840. var
  841. info: TGLUserInputCommand;
  842. begin
  843. //Add the current line
  844. AddLine(FInputLine);
  845. //Get everything between spaces
  846. info := ParseString(FInputLine, ' ');
  847. info.UnknownCommand := True;
  848. //Remove empty strings and " sequences
  849. FixCommand(info);
  850. //Execute the command
  851. CommandIssued(info);
  852. //Clear the current line
  853. FinputLine := '';
  854. end;
  855. procedure TGLCustomConsole.ExecuteCommands(const Commands: TStrings);
  856. var
  857. I: Integer;
  858. begin
  859. if Commands.Count = 0 then
  860. Exit;
  861. for I := 0 to Commands.Count - 1 do
  862. ExecuteCommand(Commands[I]);
  863. end;
  864. procedure TGLCustomConsole.ExecuteCommand(const Command: string);
  865. begin
  866. FInputLine := Command;
  867. ProcessInput;
  868. end;
  869. procedure TGLCustomConsole.AddLine(const str: string);
  870. begin
  871. FColsoleLog.Text := FColsoleLog.Text + str + #10;
  872. FStartLine := FColsoleLog.Count - numLines;
  873. RefreshHud;
  874. end;
  875. procedure TGLCustomConsole.CommandIssued(var UserInputCommand:
  876. TGLUserInputCommand);
  877. var
  878. MainCommand: string;
  879. I: Integer;
  880. begin
  881. if UserInputCommand.CommandCount = 0 then
  882. Exit;
  883. MainCommand := LowerCase(UserInputCommand.Strings[0]);
  884. if FCommands.Count <> 0 then
  885. for I := 0 to FCommands.Count - 1 do
  886. if MainCommand = LowerCase(FCommands[I].FCommandName) then
  887. begin
  888. //show help
  889. if UserInputCommand.CommandCount > 1 then
  890. begin
  891. //I hope I didn't forget anything ;)
  892. if (UserInputCommand.Strings[1] = '/?') or
  893. (UserInputCommand.Strings[1] = '\?') or
  894. (UserInputCommand.Strings[1] = '-?') or
  895. (UserInputCommand.Strings[1] = '--?') or
  896. (UserInputCommand.Strings[1] = '/help') or
  897. (UserInputCommand.Strings[1] = '\help') or
  898. (UserInputCommand.Strings[1] = '-help') or
  899. (UserInputCommand.Strings[1] = '--help') then
  900. FCommands[I].ShowHelp
  901. else
  902. //or execute the asosiated event
  903. FCommands[I].DoOnCommand(UserInputCommand);
  904. end
  905. else
  906. //or execute the asosiated event
  907. FCommands[I].DoOnCommand(UserInputCommand);
  908. //recognize the command
  909. UserInputCommand.UnknownCommand := False;
  910. break;
  911. end;
  912. //external command processing event
  913. DoOnCommandIssued(UserInputCommand);
  914. if UserInputCommand.UnknownCommand then
  915. HandleUnknownCommand(UserInputCommand.Strings[0]);
  916. end;
  917. procedure TGLCustomConsole.RefreshHudSize;
  918. begin
  919. if FSceneViewer <> nil then
  920. begin
  921. FHudSprite.Width := FSceneViewer.Width;
  922. FHudSprite.Height := FSceneViewer.Height * FSize;
  923. end
  924. else
  925. begin
  926. FHudSprite.Width := conDefaultConsoleWidth;
  927. FHudSprite.Height := conDefaultConsoleHeight;
  928. end;
  929. FHudSprite.Position.X := FHudSprite.Width / 2;
  930. FHudSprite.Position.Y := FHudSprite.Height / 2;
  931. RefreshHud;
  932. end;
  933. procedure TGLCustomConsole.SetFontColor(const Color: TColor);
  934. begin
  935. FHUDText.ModulateColor.AsWinColor := Color;
  936. FHUDText.Material.FrontProperties.Ambient.AsWinColor := Color;
  937. end;
  938. procedure TGLCustomConsole.ShowConsoleHelp;
  939. var
  940. I: Integer;
  941. begin
  942. if (FCommands.Count = 0) and (FAdditionalCommands.Count = 0) then
  943. AddLine(' - There are no registered commands!')
  944. else
  945. begin
  946. if FCommands.Count <> 0 then
  947. begin
  948. AddLine(' - List of registered console commands:');
  949. for I := 0 to FCommands.Count - 1 do
  950. FCommands[I].ShowShortHelp;
  951. end;
  952. if FAdditionalCommands.Count <> 0 then
  953. begin
  954. AddLine(' - List of additional console commands:');
  955. for I := 0 to FAdditionalCommands.Count - 1 do
  956. AddLine(' - ' + FAdditionalCommands[I]);
  957. end;
  958. end;
  959. end;
  960. procedure TGLCustomConsole.ClearTypedCommands;
  961. begin
  962. FTypedCommands.Clear;
  963. FCurrentCommand := 0;
  964. end;
  965. {$WARNINGS off}
  966. procedure TGLCustomConsole.AutoCompleteCommand(var MatchCount: Integer;
  967. var AdditionalCommandsMatchList: TGLConsoleMatchList;
  968. var CommandsMatchList: TGLConsoleMatchList);
  969. var
  970. I: Integer;
  971. HasEnterKey: Boolean;
  972. NewInputLine, FirstMatch: string;
  973. NewMatchCount, FirstMatchIndex: Integer;
  974. begin
  975. MatchCount := 0;
  976. AdditionalCommandsMatchList := [];
  977. CommandsMatchList := [];
  978. if FInputLine <> '' then
  979. begin
  980. //delete the last "Enter" key, if there is any
  981. if FInputLine[Length(FInputLine)] = #13 then
  982. begin
  983. Delete(FInputLine, Length(FInputLine), 1);
  984. HasEnterKey := True;
  985. end;
  986. //find all the matches
  987. if FAdditionalCommands.Count <> 0 then
  988. for I := 0 to FAdditionalCommands.Count - 1 do
  989. if AnsiStartsText(FInputLine, FAdditionalCommands[I]) then
  990. begin
  991. Inc(MatchCount);
  992. AdditionalCommandsMatchList := AdditionalCommandsMatchList + [I];
  993. end;
  994. if FCommands.Count <> 0 then
  995. for I := 0 to FCommands.Count - 1 do
  996. if FCommands[I].FVisible then
  997. if AnsiStartsText(FInputLine, FCommands[I].FCommandName) then
  998. begin
  999. Inc(MatchCount);
  1000. CommandsMatchList := CommandsMatchList + [I];
  1001. end;
  1002. //if there is only one, fill it up!
  1003. if MatchCount = 1 then
  1004. begin
  1005. if AdditionalCommandsMatchList <> [] then
  1006. for I := 0 to CONSOLE_MAX_COMMANDS do
  1007. if I in AdditionalCommandsMatchList then
  1008. begin
  1009. FInputLine := FAdditionalCommands[I];
  1010. break;
  1011. end;
  1012. if CommandsMatchList <> [] then
  1013. for I := 0 to CONSOLE_MAX_COMMANDS do
  1014. if I in CommandsMatchList then
  1015. begin
  1016. FInputLine := FCommands[I].FCommandName;
  1017. break;
  1018. end;
  1019. end
  1020. else
  1021. {//if more than 1, try to complete other letters} if MatchCount > 1 then
  1022. begin
  1023. NewInputLine := FInputLine;
  1024. //find 1st match
  1025. if AdditionalCommandsMatchList <> [] then
  1026. for I := 0 to CONSOLE_MAX_COMMANDS do
  1027. if I in AdditionalCommandsMatchList then
  1028. begin
  1029. FirstMatch := FAdditionalCommands[I];
  1030. FirstMatchIndex := I;
  1031. break;
  1032. end;
  1033. if AdditionalCommandsMatchList = [] then
  1034. for I := 0 to CONSOLE_MAX_COMMANDS do
  1035. if I in CommandsMatchList then
  1036. begin
  1037. FirstMatch := FCommands[I].FCommandName;
  1038. FirstMatchIndex := I;
  1039. break;
  1040. end;
  1041. NewMatchCount := MatchCount;
  1042. while (NewMatchCount = MatchCount) and (Length(NewInputLine) <>
  1043. Length(FirstMatch)) do
  1044. begin
  1045. NewInputLine := NewInputLine + FirstMatch[Length(NewInputLine) + 1];
  1046. NewMatchCount := 0;
  1047. if AdditionalCommandsMatchList <> [] then
  1048. for I := FirstMatchIndex to FAdditionalCommands.Count - 1 do
  1049. if AnsiStartsText(NewInputLine, FAdditionalCommands[I]) then
  1050. Inc(NewMatchCount);
  1051. if AdditionalCommandsMatchList = [] then
  1052. begin
  1053. for I := FirstMatchIndex to FCommands.Count - 1 do
  1054. if AnsiStartsText(NewInputLine, FCommands[I].FCommandName) then
  1055. Inc(NewMatchCount);
  1056. end
  1057. else if CommandsMatchList <> [] then
  1058. begin
  1059. for I := 0 to FCommands.Count - 1 do
  1060. if AnsiStartsText(NewInputLine, FCommands[I].FCommandName) then
  1061. Inc(NewMatchCount);
  1062. end;
  1063. end;
  1064. FInputLine := NewInputLine;
  1065. if NewMatchCount <> MatchCount then
  1066. Delete(FInputLine, Length(NewInputLine), 1);
  1067. end;
  1068. //Restore the #13 key
  1069. if HasEnterKey then
  1070. FInputLine := FInputLine + #13;
  1071. end;
  1072. end;
  1073. {$WARNINGS on}
  1074. procedure TGLCustomConsole.AutoCompleteCommand;
  1075. var
  1076. MatchCount: Integer;
  1077. AdditionalCommandsMatchList: TGLConsoleMatchList;
  1078. CommandsMatchList: TGLConsoleMatchList;
  1079. begin
  1080. AutoCompleteCommand(MatchCount, AdditionalCommandsMatchList,
  1081. CommandsMatchList);
  1082. end;
  1083. procedure TGLCustomConsole.RegisterBuiltInCommands;
  1084. begin
  1085. { Special commands }
  1086. with FCommands.Add do
  1087. begin
  1088. FCommandName := '?';
  1089. FShortHelp := 'displays help for a single command or all commands';
  1090. FLongHelp.Add(FShortHelp);
  1091. FOnCommand := ProcessInternalCommandHelp;
  1092. end;
  1093. with FCommands.Add do
  1094. begin
  1095. FCommandName := 'Help';
  1096. FShortHelp := 'displays help for a single command or all commands';
  1097. FLongHelp.Add(FShortHelp);
  1098. FOnCommand := ProcessInternalCommandHelp;
  1099. end;
  1100. with FCommands.Add do
  1101. begin
  1102. FCommandName := 'cls';
  1103. FShortHelp := 'clears screen';
  1104. FLongHelp.Add(FShortHelp);
  1105. FOnCommand := ProcessInternalCommandClearScreen;
  1106. end;
  1107. // Console commands
  1108. with FCommands.Add do
  1109. begin
  1110. FCommandName := 'Console.Hide';
  1111. FShortHelp := 'hides the console';
  1112. FLongHelp.Add(FShortHelp);
  1113. FOnCommand := ProcessInternalCommandConsoleHide;
  1114. end;
  1115. with FCommands.Add do
  1116. begin
  1117. FCommandName := 'Console.Color';
  1118. FShortHelp := 'displays and allows to change the color of the console';
  1119. FLongHelp.Add(FShortHelp);
  1120. FOnCommand := ProcessInternalCommandConsoleColor;
  1121. end;
  1122. with FCommands.Add do
  1123. begin
  1124. FCommandName := 'Console.Ren';
  1125. FShortHelp := 'renames any command';
  1126. // FLongHelp.Add('') not needed here, because is has an OnHelp event
  1127. FOnCommand := ProcessInternalCommandConsoleRename;
  1128. FOnHelp := GetHelpInternalCommandRename;
  1129. end;
  1130. with FCommands.Add do
  1131. begin
  1132. FCommandName := 'Console.ClearTypedCommands';
  1133. FShortHelp := 'clears Typed Commands list';
  1134. FLongHelp.Add(FShortHelp);
  1135. FOnCommand := ProcessInternalCommandConsoleClearTypedCommands;
  1136. end;
  1137. // System commands
  1138. with FCommands.Add do
  1139. begin
  1140. FCommandName := 'System.Time';
  1141. FShortHelp := 'displays current system time';
  1142. FLongHelp.Add(FShortHelp);
  1143. FOnCommand := ProcessInternalCommandSystemTime;
  1144. end;
  1145. with FCommands.Add do
  1146. begin
  1147. FCommandName := 'System.Date';
  1148. FShortHelp := 'displays current system date';
  1149. FLongHelp.Add(FShortHelp);
  1150. FOnCommand := ProcessInternalCommandSystemDate;
  1151. end;
  1152. // Viewer commands
  1153. with FCommands.Add do
  1154. begin
  1155. FCommandName := 'Viewer.FPS';
  1156. FShortHelp := 'displays GLSceneViewer FPS';
  1157. FLongHelp.Add(FShortHelp);
  1158. FOnCommand := ProcessInternalCommandViewerFPS;
  1159. end;
  1160. with FCommands.Add do
  1161. begin
  1162. FCommandName := 'Viewer.ResetPerformanceMonitor';
  1163. FShortHelp := 'resets GLSceneViewer FPS monitor';
  1164. FLongHelp.Add(FShortHelp);
  1165. FOnCommand := ProcessInternalCommandViewerResetPerformanceMonitor;
  1166. end;
  1167. with FCommands.Add do
  1168. begin
  1169. FCommandName := 'Viewer.VSync';
  1170. FShortHelp := 'displays and allows to change GLSceneViewer VSync';
  1171. FLongHelp.Add(FShortHelp);
  1172. FOnCommand := ProcessInternalCommandViewerVSync;
  1173. end;
  1174. with FCommands.Add do
  1175. begin
  1176. FCommandName := 'Viewer.AntiAliasing';
  1177. FShortHelp := 'displays and allows to change GLSceneViewer AntiAliasing';
  1178. FLongHelp.Add(FShortHelp);
  1179. FOnCommand := ProcessInternalCommandViewerAntiAliasing;
  1180. end;
  1181. end;
  1182. procedure TGLCustomConsole.HandleUnknownCommand(const Command: string);
  1183. begin
  1184. AddLine(' - Command "' + Command + '" not recognized!');
  1185. if coShowConsoleHelpIfUnknownCommand in FOptions then
  1186. ShowConsoleHelp;
  1187. end;
  1188. procedure TGLCustomConsole.NavigateDown;
  1189. begin
  1190. Inc(FStartLine);
  1191. if FStartLine > FColsoleLog.Count - numlines then
  1192. FStartLine := FColsoleLog.Count - numlines;
  1193. if FStartLine < 0 then
  1194. FStartLine := 0;
  1195. end;
  1196. procedure TGLCustomConsole.NavigatePageDown;
  1197. begin
  1198. Inc(FStartLine, NumLines);
  1199. if FStartLine > FColsoleLog.Count - numlines then
  1200. FStartLine := FColsoleLog.Count - numlines;
  1201. if FStartLine < 0 then
  1202. FStartLine := 0;
  1203. end;
  1204. procedure TGLCustomConsole.NavigatePageUp;
  1205. begin
  1206. Dec(FStartLine, NumLines);
  1207. if FStartLine > FColsoleLog.Count - numlines then
  1208. FStartLine := FColsoleLog.Count - numlines;
  1209. if FStartLine < 0 then
  1210. FStartLine := 0;
  1211. end;
  1212. procedure TGLCustomConsole.NavigateUp;
  1213. begin
  1214. Dec(FStartLine);
  1215. if FStartLine > FColsoleLog.Count - numlines then
  1216. FStartLine := FColsoleLog.Count - numlines;
  1217. if FStartLine < 0 then
  1218. FStartLine := 0;
  1219. end;
  1220. function TGLCustomConsole.GetFontColor: TColor;
  1221. begin
  1222. Result := FHUDText.ModulateColor.AsWinColor;
  1223. end;
  1224. function TGLCustomConsole.GetHUDSpriteColor: TColor;
  1225. begin
  1226. if Assigned(HUDSprite.Material.MaterialLibrary)
  1227. and (HUDSprite.Material.MaterialLibrary is TGLMaterialLibrary)
  1228. and (HUDSprite.Material.LibMaterialName <> '') then
  1229. Result :=
  1230. TGLMaterialLibrary(HUDSprite.Material.MaterialLibrary).LibMaterialByName(HUDSprite.Material.LibMaterialName).Material.FrontProperties.Ambient.AsWinColor
  1231. else
  1232. Result := HUDSprite.Material.FrontProperties.Ambient.AsWinColor;
  1233. end;
  1234. procedure TGLCustomConsole.SetHUDSpriteColor(const Color: TColor);
  1235. begin
  1236. if Assigned(HUDSprite.Material.MaterialLibrary)
  1237. and (HUDSprite.Material.MaterialLibrary is TGLMaterialLibrary)
  1238. and (HUDSprite.Material.LibMaterialName <> '') then
  1239. TGLMaterialLibrary(HUDSprite.Material.MaterialLibrary).LibMaterialByName(HUDSprite.Material.LibMaterialName).Material.FrontProperties.Ambient.AsWinColor := Color
  1240. else
  1241. HUDSprite.Material.FrontProperties.Ambient.AsWinColor := Color;
  1242. end;
  1243. procedure TGLCustomConsole.SetSize(const Value: Single);
  1244. begin
  1245. if (Value <= 0) or (Value > 1) then
  1246. raise EGLConsoleException.Create('Size must be between 0 and 1!')
  1247. else
  1248. begin
  1249. FSize := Value;
  1250. RefreshHudSize;
  1251. end;
  1252. end;
  1253. procedure TGLCustomConsole.DoOnCommandIssued(var UserInputCommand:
  1254. TGLUserInputCommand);
  1255. begin
  1256. if Assigned(FOnCommandIssued) then
  1257. FOnCommandIssued(nil, Self, UserInputCommand);
  1258. end;
  1259. procedure TGLCustomConsole.Notification(AComponent: TComponent;
  1260. Operation: TOperation);
  1261. begin
  1262. inherited;
  1263. if Operation = opRemove then
  1264. begin
  1265. if AComponent = FSceneViewer then
  1266. FSceneViewer := nil;
  1267. if AComponent = FHudSprite then
  1268. FHudSprite := nil;
  1269. if AComponent = FHudText then
  1270. FHudText := nil;
  1271. end;
  1272. end;
  1273. procedure TGLCustomConsole.SetSceneViewer(
  1274. const Value: TGLSceneViewer);
  1275. begin
  1276. if FSceneViewer <> nil then
  1277. FSceneViewer.RemoveFreeNotification(Self);
  1278. FSceneViewer := Value;
  1279. if FSceneViewer <> nil then
  1280. begin
  1281. FSceneViewer.FreeNotification(Self);
  1282. RefreshHudSize;
  1283. end;
  1284. end;
  1285. function TGLCustomConsole.GetFont: TGLCustomBitmapFont;
  1286. begin
  1287. Result := FHudText.BitmapFont;
  1288. end;
  1289. procedure TGLCustomConsole.SetFont(const Value: TGLCustomBitmapFont);
  1290. begin
  1291. FHudText.BitmapFont := Value;
  1292. end;
  1293. procedure TGLCustomConsole.SetName(const Value: TComponentName);
  1294. begin
  1295. inherited;
  1296. FHudSprite.Name := Value + 'HudSprite';
  1297. FHudText.Name := Value + 'HudText';
  1298. end;
  1299. //--------------------------------
  1300. // TGLConsoleControls
  1301. //--------------------------------
  1302. procedure TGLConsoleControls.Assign(Source: TPersistent);
  1303. begin
  1304. if Source is TGLConsoleControls then
  1305. begin
  1306. FNavigateUp := TGLConsoleControls(Source).FNavigateUp;
  1307. FNavigateDown := TGLConsoleControls(Source).FNavigateDown;
  1308. FNavigatePageUp := TGLConsoleControls(Source).FNavigatePageUp;
  1309. FNavigatePageDown := TGLConsoleControls(Source).FNavigatePageDown;
  1310. FNextCommand := TGLConsoleControls(Source).FNextCommand;
  1311. FPreviousCommand := TGLConsoleControls(Source).FPreviousCommand;
  1312. FAutoCompleteCommand := TGLConsoleControls(Source).FAutoCompleteCommand;
  1313. FDblClickDelay := TGLConsoleControls(Source).FDblClickDelay;
  1314. end;
  1315. end;
  1316. constructor TGLConsoleControls.Create(AOwner: TPersistent);
  1317. begin
  1318. FOwner := AOwner;
  1319. FNavigateUp := VK_HOME;
  1320. FNavigateDown := VK_END;
  1321. FNavigatePageUp := VK_PRIOR;
  1322. FNavigatePageDown := VK_NEXT;
  1323. FNextCommand := VK_DOWN;
  1324. FPreviousCommand := VK_UP;
  1325. FAutoCompleteCommand := VK_CONTROL;
  1326. FDblClickDelay := 300;
  1327. end;
  1328. function TGLConsoleControls.GetOwner: TPersistent;
  1329. begin
  1330. Result := FOwner;
  1331. end;
  1332. //---------------------------
  1333. // TGLConsoleCommand
  1334. //---------------------------
  1335. procedure TGLConsoleCommand.Assign(Source: TPersistent);
  1336. begin
  1337. Assert(Source <> nil);
  1338. inherited;
  1339. SetCommandName(TGLConsoleCommand(Source).FCommandName);
  1340. FShortHelp := TGLConsoleCommand(Source).FShortHelp;
  1341. FLongHelp.Assign(TGLConsoleCommand(Source).FLongHelp);
  1342. FVisible := TGLConsoleCommand(Source).FVisible;
  1343. FEnabled := TGLConsoleCommand(Source).FEnabled;
  1344. FSilentDisabled := TGLConsoleCommand(Source).FSilentDisabled;
  1345. end;
  1346. constructor TGLConsoleCommand.Create(Collection: TCollection);
  1347. begin
  1348. inherited;
  1349. Assert((Collection is TGLConsoleCommandList) or (Collection = nil));
  1350. FCommandList := TGLConsoleCommandList(Collection);
  1351. FLongHelp := TStringList.Create;
  1352. FVisible := True;
  1353. FEnabled := True;
  1354. end;
  1355. destructor TGLConsoleCommand.Destroy;
  1356. begin
  1357. FLongHelp.Destroy;
  1358. inherited;
  1359. end;
  1360. procedure TGLConsoleCommand.ShowInvalidUseOfCommandError;
  1361. begin
  1362. FCommandList.FConsole.AddLine(' - Invalid use of command!');
  1363. end;
  1364. procedure TGLConsoleCommand.ShowInvalidNumberOfArgumentsError(const
  1365. ShowHelpAfter: Boolean);
  1366. begin
  1367. FCommandList.FConsole.AddLine(' - Invalid number of arguments!');
  1368. if ShowHelpAfter then
  1369. ShowHelp;
  1370. end;
  1371. procedure TGLConsoleCommand.SetCommandName(const Value: string);
  1372. begin
  1373. //the name must be unique
  1374. if FCommandList.CommandExists(Value) or
  1375. FCommandList.FConsole.FAdditionalCommands.CommandExists(Value) then
  1376. begin
  1377. raise EGLConsoleException.Create(STR_NO_DUPLICATE_NAMES_ALLOWED);
  1378. Exit;
  1379. end;
  1380. FCommandName := Value;
  1381. end;
  1382. procedure TGLConsoleCommand.ShowHelp;
  1383. var
  1384. I: Integer;
  1385. begin
  1386. if Assigned(FOnHelp) then
  1387. FOnHelp(Self)
  1388. else if FLongHelp.Count <> 0 then
  1389. for I := 0 to FLongHelp.Count - 1 do
  1390. FCommandList.FConsole.AddLine(' - ' + FLongHelp[I]);
  1391. end;
  1392. procedure TGLConsoleCommand.DoOnCommand(var UserInputCommand:
  1393. TGLUserInputCommand);
  1394. begin
  1395. Assert(Assigned(FOnCommand));
  1396. if FEnabled then
  1397. FOnCommand(Self, FCommandList.FConsole, UserInputCommand)
  1398. else
  1399. begin
  1400. if not FSilentDisabled then
  1401. FCommandList.FConsole.AddLine(' - Command "' + FCommandName +
  1402. '" has been disabled!');
  1403. end;
  1404. end;
  1405. procedure TGLConsoleCommand.ShowShortHelp;
  1406. begin
  1407. if FVisible then
  1408. FCommandList.FConsole.AddLine(' - ' + FCommandName + ' - ' + FShortHelp);
  1409. end;
  1410. function TGLConsoleCommand.GetDisplayName: string;
  1411. begin
  1412. if FCommandName = '' then
  1413. Result := inherited GetDisplayName
  1414. else
  1415. Result := FCommandName;
  1416. end;
  1417. //---------------------------
  1418. // TGLConsoleCommandList
  1419. //---------------------------
  1420. function TGLConsoleCommandList.Add: TGLConsoleCommand;
  1421. begin
  1422. Result := TGLConsoleCommand(inherited Add);
  1423. end;
  1424. constructor TGLConsoleCommandList.Create(const AOwner: TGLCustomConsole);
  1425. begin
  1426. Assert(AOwner <> nil);
  1427. FConsole := TGLCustomConsole(AOwner);
  1428. inherited Create(TGLConsoleCommand);
  1429. end;
  1430. destructor TGLConsoleCommandList.Destroy;
  1431. begin
  1432. Clear;
  1433. inherited;
  1434. end;
  1435. function TGLConsoleCommandList.GetItems(const Index: Integer):
  1436. TGLConsoleCommand;
  1437. begin
  1438. Result := TGLConsoleCommand(inherited Items[Index]);
  1439. end;
  1440. function TGLConsoleCommandList.LastConsoleCommand: TGLConsoleCommand;
  1441. begin
  1442. Result := GetItems(Count - 1);
  1443. end;
  1444. procedure TGLConsoleCommandList.SortCommands(const Ascending: Boolean);
  1445. begin
  1446. Assert(False, 'Not implemented yet....');
  1447. end;
  1448. function TGLConsoleCommandList.CommandExists(const Command: string): Boolean;
  1449. var
  1450. I: Integer;
  1451. begin
  1452. Result := True;
  1453. if Count <> 0 then
  1454. for I := 0 to Count - 1 do
  1455. if GetItems(I).FCommandName = Command then
  1456. Exit;
  1457. Result := False;
  1458. end;
  1459. function TGLConsoleCommandList.GetCommandIndex(const Command: string): Integer;
  1460. begin
  1461. if Count <> 0 then
  1462. for Result := 0 to Count - 1 do
  1463. if GetItems(Result).FCommandName = Command then
  1464. Exit;
  1465. Result := -1;
  1466. end;
  1467. function TGLConsoleCommandList.GetOwner: TPersistent;
  1468. begin
  1469. Result := FConsole;
  1470. end;
  1471. //---------------------------
  1472. // TGLConsoleStringList
  1473. //---------------------------
  1474. procedure TGLConsoleStringList.Changed;
  1475. begin
  1476. inherited;
  1477. //we'll just assume that user added a command and check it,
  1478. //other cases are not dealt with
  1479. if Count = 0 then
  1480. Exit;
  1481. //check if this command does not duplicate any existing
  1482. if FConsole.FCommands.CommandExists(Strings[Count - 1]) then
  1483. Delete(Count - 1);
  1484. end;
  1485. function TGLConsoleStringList.CommandExists(const Command: string): Boolean;
  1486. begin
  1487. Result := IndexOf(Command) <> -1;
  1488. end;
  1489. constructor TGLConsoleStringList.Create(const Owner: TGLCustomConsole);
  1490. begin
  1491. Assert(Owner <> nil);
  1492. Duplicates := dupError;
  1493. FConsole := Owner;
  1494. end;
  1495. function TGLConsoleStringList.GetOwner: TPersistent;
  1496. begin
  1497. Result := FConsole;
  1498. end;
  1499. //---------------------------
  1500. initialization
  1501. //---------------------------
  1502. RegisterClasses([TGLCustomConsole, TGLConsole, TGLConsoleStringList,
  1503. TGLConsoleCommand, TGLConsoleCommandList, TGLConsoleControls]);
  1504. end.