GLS.Console.pas 51 KB

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