Hmmm... det ville måske være bedst hvis du viste hele koden i sammenhæng, da jeg har lidt svært ved at overskue dit kode! 
Tja, ok... Men det er 500 linjer eller noget i den stil
... Here goes:
unit Console;
{
Console system
CHANGELOG:
21/3/05: Updated parser code(It had bugs)
21/3/05: Added String type
20/3/05: Added Exec and Help commands
20/3/05: Added TGLConsole descendant from TConsole
20/3/05: Fixed typo. orError = otError
19/3/05: First version
END OF CHANGELOG
}
interface
uses
SysUtils, Classes, GLHUDObjects, GLScene, GLObjects, GLBitmapFont, Dialogs;
type
// Command types
TConCommandType = (CTYPE_BYTE, // 0..255, 1 bit Unsigned
CTYPE_SHORT, // -128..127, 8 bit Signed
CTYPE_WORD, // 0..65535, 16 bit Unsigned
CTYPE_INT, // -2148483648..2147483647, 32 bit Signed
CTYPE_DWORD, // 0..4294397295, 32 bit Unsigned
CTYPE_INT64, // -2^63..2^63-1, 64 bit Signed
CTYPE_FLOAT, // Double, 64 bit Signed float
CTYPE_BOOLEAN, // True, False, 1 bit
CTYPE_STRING, // String
CTYPE_FUNCTION); // Function
TConFunction = procedure(Params: String);
// Describes a console command
// NOTE: Mismatch between T and P could cause serious trouble
TConCommand = record
Name: String; // Name of the command
Help: String; // Optional helptext
T: TConCommandType; // Type of command
P: Pointer; // A pointer to the data
end;
// Types of output for the console
TConOutputType = (otNormal, otWarning, otError, otFatal);
// Describes an output line
TConOutput = record
Text: String; // The lines content
T: TConOutputType; // The type of line
end;
// Base Console class. Other console types is based on this!
TConsole = class
private
fCmdLine: String; // Contains the commandline
fCommands: array of TConCommand; // Contains the commands
function FindCommand(Name: String): Integer; // Finds a command
function GetBufferGet: String;
protected
TextBuffer: array of TConOutput; // Contains all the output lines
public
constructor Create;
procedure Parse(CmdLine: String; Echo: Boolean = True; F: String = ''); // This parses the current commandline in fCmdLine
procedure PassChar(C: Char); // This add a char to the commandline
procedure PassBack; // Deletes last char on the commandline
procedure PassEnter; // Starts parsing of the commandline and clears it
procedure Print(Text: String; T: TConOutputType = otNormal); // Outputs text
procedure RegisterCommand(Name, Help: String;
T: TConCommandType; P: Pointer); // Adds a command
procedure DeleteCommand(Name: String); // Removes a command
property CommandLine: String read fCmdLine write fCmdLine;
property TextBufferText: String read GetBufferGet;
procedure Clear;
end;
TGLConsole = class(TConsole)
private
fScene: TGLScene;
fFont: TGLCustomBitmapFont;
fHudText: TGLHudText;
fMaxLines: Integer;
fOldText: String;
fVisible: Boolean;
function GetVis: Boolean;
procedure SetVis(B: Boolean);
public
constructor Create(Scene: TGLScene; BmpFont: TGLCustomBitmapFont);
destructor Destroy;
procedure Update;
property MaxLines: Integer read fMaxLines write fMaxLines;
property Visible: Boolean read GetVis write SetVis;
end;
implementation
// TConsole start
constructor TConsole.Create;
begin
RegisterCommand('exec', 'Executes commands in a file',
CTYPE_FUNCTION, nil);
RegisterCommand('help', 'Shows help for requestet command',
CTYPE_FUNCTION, nil);
end;
function TConsole.GetBufferGet: String;
var
I: Integer;
begin
for I := 0 to High(TextBuffer) do begin
case TextBuffer[I].T of
otNormal: Result := Result + TextBuffer[I].Text + #13#10;
otWarning: Result := Result + 'WARNING: ' + TextBuffer[I].Text + #13#10;
otError: Result := Result + 'ERROR: ' + TextBuffer[I].Text + #13#10;
otFatal: Result := Result + 'FATAL ERROR: ' + TextBuffer[I].Text + #13#10;
end;
end;
end;
function TConsole.FindCommand(Name: String): Integer;
var
I: Integer;
begin
Result := -1;
for I := 0 to High(fCommands) do begin
if Lowercase(fCommands[I].Name) = Lowercase(Name) then begin
Result := I;
Exit;
end;
end;
end;
procedure TConsole.PassChar(C: Char);
begin
fCmdLine := fCmdLine + C;
end;
procedure TConsole.PassBack;
begin
Delete(fCmdLine, Length(fCmdLine), 1);
end;
procedure TConsole.PassEnter;
begin
Parse(fCmdLine);
fCmdLine := '';
end;
procedure TConsole.Clear;
begin
SetLength(TextBuffer, 0);
end;
procedure TConsole.Parse(CmdLine: String; Echo: Boolean = True; F: String = '');
function FirstChar(S: String): Char;
var
I: Integer;
begin
for I := 1 to Length(S) do begin
if (S[I] <> ' ') and (S[I] <> '') then begin
Result := S[I];
Exit;
end;
end;
end;
var
I, J: Integer;
Arguments: array of String;
ToPass: String;
Tmp: String;
Test: String;
SL: TStringList;
begin
try
// Echo the commandline to the console
if Echo then
Print('] ' + CmdLine);
if CmdLine = '' then Exit;
// Add an ending space
CmdLine := CmdLine + ' ';
// Remove ending spaces
for I := Length(CmdLine) downto 1 do begin
if CmdLine <> ' ' then begin
J := I;
Break;
end;
end;
Delete(CmdLine, J, Length(CmdLine));
// Add an ending space
CmdLine := CmdLine + ' ';
// Tokenize the commandline
for I := 1 to Length(CmdLine) do begin
if CmdLine[I] <> ' ' then
Tmp := Tmp + CmdLine[I]
else begin
if (Tmp <> ' ') and (Tmp <> '') then begin
SetLength(Arguments, High(Arguments)+2);
Arguments[High(Arguments)] := Tmp;
Tmp := '';
end;
end;
end;
Arguments[0] := Lowercase(Arguments[0]);
for I := 1 to High(Arguments) do
ToPass := ToPass + Arguments[I] + ' ';
Delete(ToPass, Length(ToPass), 1);
if Arguments[0] = 'exec' then begin
if Length(Arguments) > 2 then
Print('To many arguments', otError)
else if Length(Arguments) = 1 then
Print('Missing argument')
else begin
if FileExists(Arguments[1]) then begin
Print('Reading from ''' + Arguments[1] + '''');
SL := TStringList.Create;
SL.LoadFromFile(Arguments[1]);
for I := 0 to SL.Count-1 do
if (FirstChar(SL.Strings[I]) <> '#') and
(FirstChar(SL.Strings[I]) <> '//') then
Parse(SL.Strings[I], False, Arguments[1]);
SL.Destroy;
Print('Finished reading from ''' + Arguments[1] + '''');
end else
Print('Could not open file ''' + Arguments[1] + '''');
end;
end else if Arguments[0] = 'help' then begin
if Length(Arguments) > 2 then
Print('To many arguments')
else begin
I := FindCommand(Arguments[1]);
if I <= -1 then Exit;
case fCommands[I].T of
CTYPE_BYTE: begin
Print(' ''' + fCommands[I].Name + ''' = ''' +
IntToStr(Byte(fCommands[I].P^)) + '''');
Print(' Type: Byte. Range ' +
IntToStr(Low(Byte)) + '..' +
IntToStr(High(Byte)));
Print(' ''' + fCommands[I].Help + '''');
end;
CTYPE_SHORT: begin
Print(' ''' + fCommands[I].Name + ''' = ''' +
IntToStr(ShortInt(fCommands[I].P^)) + '''');
Print(' Type: Short. Range ' +
IntToStr(Low(ShortInt)) + '..' +
IntToStr(High(ShortInt)));
Print(' ''' + fCommands[I].Help + '''');
end;
CTYPE_WORD: begin
Print(' ''' + fCommands[I].Name + ''' = ''' +
IntToStr(Word(fCommands[I].P^)) + '''');
Print(' Type: word. Range ' +
IntToStr(Low(Word)) + '..' +
IntToStr(High(Word)));
Print(' ''' + fCommands[I].Help + '''');
end;
CTYPE_INT: begin
Print(' ''' + fCommands[I].Name + ''' = ''' +
IntToStr(Integer(fCommands[I].P^)) + '''');
Print(' Type: integer. Range ' +
IntToStr(Low(Integer)) + '..' +
IntToStr(High(Integer)));
Print(' ''' + fCommands[I].Help + '''');
end;
CTYPE_DWORD: begin
Print(' ''' + fCommands[I].Name + ''' = ''' +
IntToStr(Cardinal(fCommands[I].P^)) + '''');
Print(' Type: dword. Range ' +
IntToStr(Low(Cardinal)) + '..' +
IntToStr(High(Cardinal)));
Print(' ''' + fCommands[I].Help + '''');
end;
CTYPE_INT64: begin
Print(' ''' + fCommands[I].Name + ''' = ''' +
IntToStr(Int64(fCommands[I].P^)) + '''');
Print(' Type: Int64. Range ' +
IntToStr(Low(Int64)) + '..' +
IntToStr(High(Int64)));
Print(' ''' + fCommands[I].Help + '''');
end;
CTYPE_FLOAT: begin
Print(' ''' + fCommands[I].Name + ''' = ''' +
FloatToStr(Extended(fCommands[I].P^)) + '''');
Print(' Type: Float');
Print(' ''' + fCommands[I].Help + '''');
end;
CTYPE_BOOLEAN: begin
Print(' ''' + fCommands[I].Name + ''' = ''' +
BoolToStr(Boolean(fCommands[I].P^), True) + '''');
Print(' Type: Boolean');
Print(' ''' + fCommands[I].Help + '''');
end;
CTYPE_STRING: begin
Print(' ''' + fCommands[I].Name + ''' = ''' +
String(fCommands[I].P^) + '''');
Print(' Type: String');
Print(' ''' + fCommands[I].Help + '''');
end;
CTYPE_FUNCTION: begin
Print(' Function ''' + fCommands[I].Name + '''');
Print(' ''' + fCommands[I].Help + '''');
end;
end;
end;
end else begin
I := FindCommand(Arguments[0]);
if I > -1 then begin
case fCommands[I].T of
CTYPE_BYTE: begin
if Length(Arguments) > 2 then begin
Print('To many arguments!', otError);
Exit;
end;
if Length(Arguments) = 2 then begin
Byte(fCommands[I].P^) := StrToInt(Arguments[1]);
end else begin
Print(' ''' + fCommands[I].Name + ''' = ''' +
IntToStr(Byte(fCommands[I].P^)) + '''');
Print(' Type: Byte. Range ' +
IntToStr(Low(Byte)) + '..' +
IntToStr(High(Byte)));
Print(' ''' + fCommands[I].Help + '''');
end;
end;
CTYPE_SHORT: begin
if Length(Arguments) > 2 then begin
Print('To many arguments!', otError);
Exit;
end;
if Length(Arguments) = 2 then begin
ShortInt(fCommands[I].P^) := StrToInt(Arguments[1]);
end else begin
Print(' ''' + fCommands[I].Name + ''' = ''' +
IntToStr(ShortInt(fCommands[I].P^)) + '''');
Print(' Type: Short. Range ' +
IntToStr(Low(ShortInt)) + '..' +
IntToStr(High(ShortInt)));
Print(' ''' + fCommands[I].Help + '''');
end;
end;
CTYPE_WORD: begin
if Length(Arguments) > 2 then begin
Print('To many arguments!', otError);
Exit;
end;
if Length(Arguments) = 2 then begin
Word(fCommands[I].P^) := StrToInt(Arguments[1]);
end else begin
Print(' ''' + fCommands[I].Name + ''' = ''' +
IntToStr(Word(fCommands[I].P^)) + '''');
Print(' Type: word. Range ' +
IntToStr(Low(Word)) + '..' +
IntToStr(High(Word)));
Print(' ''' + fCommands[I].Help + '''');
end;
end;
CTYPE_INT: begin
if Length(Arguments) > 2 then begin
Print('To many arguments!', otError);
Exit;
end;
if Length(Arguments) = 2 then begin
Integer(fCommands[I].P^) := StrToInt(Arguments[1]);
end else begin
Print(' ''' + fCommands[I].Name + ''' = ''' +
IntToStr(Integer(fCommands[I].P^)) + '''');
Print(' Type: integer. Range ' +
IntToStr(Low(Integer)) + '..' +
IntToStr(High(Integer)));
Print(' ''' + fCommands[I].Help + '''');
end;
end;
CTYPE_DWORD: begin
if Length(Arguments) > 2 then begin
Print('To many arguments!', otError);
Exit;
end;
if Length(Arguments) = 2 then begin
Cardinal(fCommands[I].P^) := StrToInt(Arguments[1]);
end else begin
Print(' ''' + fCommands[I].Name + ''' = ''' +
IntToStr(Cardinal(fCommands[I].P^)) + '''');
Print(' Type: dword. Range ' +
IntToStr(Low(Cardinal)) + '..' +
IntToStr(High(Cardinal)));
Print(' ''' + fCommands[I].Help + '''');
end;
end;
CTYPE_INT64: begin
if Length(Arguments) > 2 then begin
Print('To many arguments!', otError);
Exit;
end;
if Length(Arguments) = 2 then begin
Int64(fCommands[I].P^) := StrToInt(Arguments[1]);
end else begin
Print(' ''' + fCommands[I].Name + ''' = ''' +
IntToStr(Int64(fCommands[I].P^)) + '''');
Print(' Type: Int64. Range ' +
IntToStr(Low(Int64)) + '..' +
IntToStr(High(Int64)));
Print(' ''' + fCommands[I].Help + '''');
end;
end;
CTYPE_FLOAT: begin
if Length(Arguments) > 2 then begin
Print('To many arguments!', otError);
Exit;
end;
if Length(Arguments) = 2 then begin
Extended(fCommands[I].P^) := StrToFloat(Arguments[1]);
end else begin
Print(' ''' + fCommands[I].Name + ''' = ''' +
FloatToStr(Extended(fCommands[I].P^)) + '''');
Print(' Type: Float');
Print(' ''' + fCommands[I].Help + '''');
end;
end;
CTYPE_BOOLEAN: begin
if Length(Arguments) > 2 then begin
Print('To many arguments!', otError);
Exit;
end;
if Length(Arguments) = 2 then begin
Boolean(fCommands[I].P^) := StrToBool(Arguments[1]);
end else begin
Print(' ''' + fCommands[I].Name + ''' = ''' +
BoolToStr(Boolean(fCommands[I].P^), True) + '''');
Print(' Type: Boolean');
Print(' ''' + fCommands[I].Help + '''');
end;
end;
CTYPE_STRING: begin
if Length(Arguments) > 2 then begin
Print('To many arguments!', otError);
Exit;
end;
if Length(Arguments) = 2 then begin
String(fCommands[I].P^) := Arguments[1];
end else begin
Print(' ''' + fCommands[I].Name + ''' = ''' +
String(fCommands[I].P^) + '''');
Print(' Type: String');
Print(' ''' + fCommands[I].Help + '''');
end;
end;
CTYPE_FUNCTION: begin
TConFunction(fCommands[I].P)(ToPass);
end;
end;
end else begin
if F = '' then
Print('No command or variable named ''' + Arguments[0] + '''!', otError)
else
Print('No command or variable named ''' + Arguments[0] + ''' in file'''
+ F + '''!', otError);
end;
end;
except
on E: Exception do Print('Argument Error: ' + E.Message, otError);
end;
end;
procedure TConsole.Print(Text: String; T: TConOutputType = otNormal);
begin
SetLength(TextBuffer, High(TextBuffer)+2);
TextBuffer[High(TextBuffer)].Text := Text;
TextBuffer[High(TextBuffer)].T := T;
end;
procedure TConsole.RegisterCommand(Name, Help: String;
T: TConCommandType; P: Pointer);
begin
if FindCommand(Name) = -1 then begin
SetLength(fCommands, High(fCommands)+2);
fCommands[High(fCommands)].Name := Lowercase(Name);
fCommands[High(fCommands)].Help := Help;
fCommands[High(fCommands)].T := T;
fCommands[High(fCommands)].P := P;
end;
end;
procedure TConsole.DeleteCommand(Name: String);
var
I: Integer;
begin
I := FindCommand(Name);
if I > -1 then begin
for I := I to High(TextBuffer)-1 do
TextBuffer[I] := TextBuffer[I+1];
SetLength(TextBuffer, High(TextBuffer));
end;
end;
// TConsole end
// TGLConsole start
constructor TGLConsole.Create(Scene: TGLScene; BmpFont: TGLCustomBitmapFont);
begin
if (Scene <> nil) and (BmpFont <> nil)
and (Scene is TGLScene) and (BmpFont is TGLCustomBitmapFont) then begin
fScene := Scene;
fFont := BmpFont;
fHudText := TGLHudText(fScene.Objects.AddNewChild(TGLHudText));
FHudText.BitmapFont := fFont;
fHudText.Name := 'ConsoleText';
fHudText.Visible := False;
fOldText := 'Just something. User will never see it anyway!';
fMaxLines := 8;
end else
raise Exception.Create('Could not create console!');
inherited Create;
end;
destructor TGLConsole.Destroy;
begin
fHudText.Free;
inherited;
end;
procedure TGLConsole.Update;
var
I: Integer;
Output: String;
begin
if High(TextBuffer)-(MaxLines-1) < 0 then begin
for I := 0 to High(TextBuffer) do
Output := Output + TextBuffer[I].Text + #13#10;
end else begin
for I := High(TextBuffer)-(MaxLines-1) to High(TextBuffer) do
Output := Output + TextBuffer[I].Text + #13#10;
end;
Output := Output + '> ' + CommandLine;
if fOldText <> Output then begin
fHudText.Text := Output;
fOldText := Output;
end;
end;
procedure TGLConsole.SetVis(B: Boolean);
begin
fHudText.Visible := not fHudText.Visible;
end;
function TGLConsole.GetVis: Boolean;
begin
Result := fHudText.Visible;
end;
// TGLConsole end
end.
Det er konsol uniten. Og her er uniten der bliver kaldt i:
unit MainEngine;
interface
{
Console system
CHANGELOG:
21/3/05: Added 'screenres' console command
21/3/05: Added 'clear' console command
21/3/05: Added 'echo' console command
21/3/05: Added basic keyboard handler
21/3/05: Added 'exit' console command
21/3/05: Added 'togglecon' console command
21/3/05: Updated some console stuff
20/3/05: Changed back to Fullscreen
20/3/05: Changed to SDL viewer
20/3/05: Added console
19/3/05: First version
END OF CHANGELOG
}
uses
SysUtils, Classes, GLScene, GLSDLContext, Forms, SDL, GLObjects, GLMisc,
ExtCtrls, GLCadencer, SDLWindow, GLWin32FullScreenViewer, Console,
GLBitmapFont, GLWindowsFont, GLHUDObjects, Dialogs, KeyBoard, Explode;
type
TEngineModule = class(TDataModule)
Scene: TGLScene;
Cam: TGLCamera;
CamTargetCube: TGLDummyCube;
Cadencer: TGLCadencer;
TestPlane: TGLPlane;
RealTargetCube: TGLDummyCube;
Font: TGLWindowsBitmapFont;
MainLight: TGLLightSource;
Trigger: TTimer;
Viewer: TGLFullScreenViewer;
procedure DataModuleCreate(Sender: TObject);
procedure CadencerProgress(Sender: TObject; const deltaTime,
newTime: Double);
procedure TriggerTimer(Sender: TObject);
procedure ViewerKeyPress(Sender: TObject; var Key: Char);
procedure Exit(Params: String);
procedure ToggleVisible(Params: String);
private
{ Private declarations }
public
{ Public declarations }
end;
var
EngineModule: TEngineModule;
Console: TGLConsole;
Keyboard: TKeyBoardHandler;
implementation
{$R *.dfm}
procedure TEngineModule.Exit(Params: String);
begin
// Det er så den her der laver fuckup:
// Viewer.Active := False;
// Flg. virker fint:
EngineModule.Viewer.Active := False;
end;
procedure TEngineModule.ToggleVisible(Params: String);
begin
Console.Visible := not Console.Visible;
end;
procedure AddLine(Params: String);
begin
Console.Print(Params);
end;
procedure Clear(Params: String);
begin
Console.Clear;
end;
procedure TEngineModule.DataModuleCreate(Sender: TObject);
begin
SDL_Init(0);
Keyboard := TKeyBoardHandler.Create;
Keyboard.AddKey(#27, 'exit');
Keyboard.AddKey('c', 'togglecon');
Keyboard.AddKey('p', 'echo Testing');
Console := TGLConsole.Create(Scene, Font);
Console.Print('Starting engine');
Console.RegisterCommand('togglecon', 'Toggles console visibility',
CTYPE_FUNCTION, @TEngineModule.ToggleVisible);
Console.RegisterCommand('exit', 'Exits the engine', CTYPE_FUNCTION,
@TEngineModule.Exit);
Console.RegisterCommand('echo', 'Prints something to the console',
CTYPE_FUNCTION, @AddLine);
Console.RegisterCommand('clear', 'Clears the console', CTYPE_FUNCTION,
@Clear);
Console.Parse('exec config.cfg');
// Show the viewer
Viewer.Active := True;
Viewer.Render;
// Make a loop to run while the Viewer is active
while Viewer.Active do begin
// Process messages so something happens
Application.ProcessMessages;
// Sleep a little to avoid 100% CPU usage
SDL_Delay(1);
end;
Console.Free;
Keyboard.Free;
SDL_Quit();
end;
procedure TEngineModule.CadencerProgress(Sender: TObject; const deltaTime,
newTime: Double);
begin
if Viewer.Active then begin
if Console.Visible then
Console.Update;
Viewer.Render();
TestPlane.Roll(deltaTime * 90);
end;
end;
procedure TEngineModule.TriggerTimer(Sender: TObject);
begin
Cadencer.Progress;
end;
procedure TEngineModule.ViewerKeyPress(Sender: TObject; var Key: Char);
begin
if Console.Visible then begin
if Key = #13 then
Console.PassEnter
else if Key = #8 then
Console.PassBack
else if Key = #27 then
Console.Visible := False
else
Console.PassChar(Key);
end else
if Keyboard <> nil then
Keyboard.DoAction(Key);
end;
end.
PS. Til alle der ville vide det, Koden ER copyright by The BNW project!
MH.
The-Freak
Livet er for kort til at kede sig.