GLConsole.pas 52 KB

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