FPC Procedural Pointer Oversight?

[code_glitch]

For my game, I'm relying heavily on variables such as:
array [1..10] of procedure

which is rather nice in that I can let the program 'modify itself' and do some rather nice things (especially for performance) ;D

Anyways, the following works:


PProc := @Halt;


I tried to pass variables, but I'll just say its ugly and leave it at that... My bone with FPC though lies not in any of the above but rather that the whole @standard_proc is rather patchy. For example, I'm trying to break out of a main loop for a menu in my game thus a @break would make sense right? FPC disagrees...

Specifically I get a:


oGame.pas(35,32) Error: Incompatible types: got "untyped" expected "<procedure variable type of procedure;Register>"

error in fpc so if anyone has done this other than writing a specific procedure in each object to flip a bool variable I would very much appreciate that pointer (pun of the day :D)

[Ñuño Martínez]

AFAIK "BREAK" isn't implemented as a procedure but as a keyword so you can't get the address of the subroutine just because it doesn't exists.

There are some Pascal RTL procedures and functions that Free Pascal doesn't implement as actual subroutines; i. e. INC, DEC, Length, POS... Take a look to the "system.pas" source file, IIRC there are comments about all those functions and procedures.

[Carver413]

what your doing makes no since. the beauty of Procedure vars is that you can define them. set your loop up in a way that if any of your functions return true then terminate the loop


program Project1;

{$mode objfpc}{$H+}

uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Classes, SysUtils, CustApp
{ you can add units after this };

type
TTerminateIfTrue=Function(vPassSomeVars:String):Bo olean of Object;
{ TMyApplication }

TMyApplication = class(TCustomApplication)
protected
procedure DoRun; override;
public
ExitIfTrue:TTerminateIfTrue;
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
function RandomExit(vPassSomeVars:String):Boolean;
end;

{ TMyApplication }

procedure TMyApplication.DoRun;
var
ErrorMsg: String;
begin
while not ExitIfTrue('Maybe') do
begin
{ add your program here }
end;
Terminate;
end;

constructor TMyApplication.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
StopOnException:=True;
end;

destructor TMyApplication.Destroy;
begin
inherited Destroy;
end;

function TMyApplication.RandomExit(vPassSomeVars:String):Bo olean;
begin
result:=random(100000000)<1;
end;
var
Application: TMyApplication;

{$R *.res}

begin
Application:=TMyApplication.Create(nil);
Application.Title:='My Application';
Application.ExitIfTrue:=@Application.RandomExit;
Application.Run;
Application.Free;

end.

[code_glitch]

@Nuno: Ah. I had my suspicions but since it worked with Halt etc I doubted myself...

@carver: Yes, that is the intention at this point, unfortunately due to my wish to experiment with new game engine design techniques that style is 'hard' at best and I really need to do a rewrite but that is the basic idea. However thats a nice idea using contructors and destructors (I use them once in a very blue moon :D)... Looking into it as it were now that you mention that snippet.

[Carver413]

perhaps you will find this a little more useful.
TGameFunction can be any parameters you need to send, a record might be easiest.
if a game function requires you to exit the loop it only needs to return a True. in this way you can exit the loop gracefully instead of brute force.


program Project1;

{$mode objfpc}{$H+}

uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Classes,SysUtils
{ you can add units after this };

{$R *.res}
Type
TMessage = record
x,y:Integer;
end;

TGameFunction= Function(vMessage:TMessage):Boolean;
TGameArray=Array of TGameFunction;
Function MoveForward(vMessage:TMessage):Boolean;
begin
result:=False;
end;
Function MoveBack(vMessage:TMessage):Boolean;
begin
result:=False;
end;
Function MoveTurnLeft(vMessage:TMessage):Boolean;
begin
result:=False;
end;
Function MoveTurnRight(vMessage:TMessage):Boolean;
begin
result:=False;
end;
Function ShowMenu(vMessage:TMessage):Boolean;
begin
result:=True;
end;

Var
GameArray:TGameArray;
Message:TMessage;
i,Count:Integer;
begin
Message.x:=10;
Message.y:=10;;
Count:=5;
SetLength(GameArray,Count);
GameArray[0]:=@MoveBack;
GameArray[1]:=@MoveForward;
GameArray[2]:=@MoveTurnLeft;
GameArray[3]:=@MoveTurnRight;
GameArray[4]:=@ShowMenu;
i:=0;
While True do
begin
if GameArray[i](Message) then break;
Inc(i);
sleep(100);
end;
end.

[21o6]

What you're trying to do is nice. I've been using this on x86 to avoid conditionals.
I'd never use the IF there in the main loop, tbh.


if anyone has done this other than writing a specific procedure in each object to flip a bool variable I would very much appreciate that pointer (pun of the day )

If you want this technique to work, you have to put enough code in a procedure so it pays off.

This helps you save a lot of conditionals, if you do it right ...
but you should remember that your code needs to lie in the instruction-cache.

Errr ...
what i mean is, that i don't know how the prefetch works nowadays, but ...



var
y : array of procedure;
x : byte;

begin
x:= random(256);
y[x];
end;


... as an extreme example, will probably kill your cache.

*lol* This needs some checking i guess ...

[21o6]

Edit: Scratch that ... i need to learn programming again. -.-

[Ñuño Martínez]

var
y : array of procedure;
x : byte;

begin
x:= random(256);
y[x];
end;


... as an extreme example, will probably kill your cache.

*lol* This needs some checking i guess ...


var
y : array of procedure;
x : byte;

begin
x:= random(HIGH (y) - LOW (Y)) + LOW (Y);
y[x];
end;


Fixed, but don't ask me what it actually does. ::)

[21o6]

What's fixed there ? It ran the other way too and it was pseudo anyway.

Yeah it doesn't really do anything usefull, actually. ^^

I believe i forgot a loop ... *lol*

[User137]

My brains ???


// Variables in a class far far away...
var
y : array of procedure;

// Here somewhere tons of code
// initializing y array and setting its procedure pointers...

// Some part of program
var
x : byte;
begin
// ...
x:= random(HIGH (y) - LOW (Y)) + LOW (Y);
y[x];
// ...
end;

Fixt more :D

[21o6]

*lol* wtf are you doing to the poor code ? ^^

It didn't need any fixing ! *lol*

[Ñuño Martínez]

Just for fun... :D