diff --git a/trunk/Projects/SAMufasaGUI/libcpascal.a b/trunk/Projects/SAMufasaGUI/libcpascal.a index 0a44dcc..234888a 100644 Binary files a/trunk/Projects/SAMufasaGUI/libcpascal.a and b/trunk/Projects/SAMufasaGUI/libcpascal.a differ diff --git a/trunk/Projects/SAMufasaGUI/libcpascal.dll b/trunk/Projects/SAMufasaGUI/libcpascal.dll index e882aa1..20d37fa 100755 Binary files a/trunk/Projects/SAMufasaGUI/libcpascal.dll and b/trunk/Projects/SAMufasaGUI/libcpascal.dll differ diff --git a/trunk/Projects/SAMufasaGUI/libcpascal.so b/trunk/Projects/SAMufasaGUI/libcpascal.so index d68e4d3..f15f9c7 100755 Binary files a/trunk/Projects/SAMufasaGUI/libcpascal.so and b/trunk/Projects/SAMufasaGUI/libcpascal.so differ diff --git a/trunk/Projects/SAMufasaGUI/testunit.lfm b/trunk/Projects/SAMufasaGUI/testunit.lfm index f08b393..d57bdaf 100644 --- a/trunk/Projects/SAMufasaGUI/testunit.lfm +++ b/trunk/Projects/SAMufasaGUI/testunit.lfm @@ -1,7 +1,7 @@ object Form1: TForm1 - Left = 593 + Left = 706 Height = 557 - Top = 321 + Top = 373 Width = 734 ActiveControl = ScriptPanel Caption = 'THA FUKING SIMBA' diff --git a/trunk/Projects/SAMufasaGUI/testunit.lrs b/trunk/Projects/SAMufasaGUI/testunit.lrs index a37bfc9..c3c7fbd 100644 --- a/trunk/Projects/SAMufasaGUI/testunit.lrs +++ b/trunk/Projects/SAMufasaGUI/testunit.lrs @@ -1,10 +1,10 @@ { This is an automatically generated lazarus resource file } LazarusResources.Add('TForm1','FORMDATA',[ - 'TPF0'#6'TForm1'#5'Form1'#4'Left'#3'Q'#2#6'Height'#3'-'#2#3'Top'#3'A'#1#5'Wid' - +'th'#3#222#2#13'ActiveControl'#7#11'ScriptPanel'#7'Caption'#6#16'THA FUKING ' - +'SIMBA'#12'ClientHeight'#3#20#2#11'ClientWidth'#3#222#2#10'KeyPreview'#9#4'M' - +'enu'#7#8'MainMenu'#7'OnClose'#7#9'FormClose'#8'OnCreate'#7#10'FormCreate'#9 + 'TPF0'#6'TForm1'#5'Form1'#4'Left'#3#194#2#6'Height'#3'-'#2#3'Top'#3'u'#1#5'Wi' + +'dth'#3#222#2#13'ActiveControl'#7#11'ScriptPanel'#7'Caption'#6#16'THA FUKING' + +' SIMBA'#12'ClientHeight'#3#20#2#11'ClientWidth'#3#222#2#10'KeyPreview'#9#4 + +'Menu'#7#8'MainMenu'#7'OnClose'#7#9'FormClose'#8'OnCreate'#7#10'FormCreate'#9 +'OnDestroy'#7#11'FormDestroy'#10'OnShortCut'#7#13'FormShortCuts'#8'Position' +#7#14'poScreenCenter'#10'LCLVersion'#6#6'0.9.29'#7'Visible'#9#0#8'TToolBar'#8 +'ToolBar1'#4'Left'#2#0#6'Height'#2#24#3'Top'#2#0#5'Width'#3#222#2#7'Caption' diff --git a/trunk/Tests/CPascal/maze.simb b/trunk/Tests/CPascal/maze.simb new file mode 100644 index 0000000..07242c6 --- /dev/null +++ b/trunk/Tests/CPascal/maze.simb @@ -0,0 +1,354 @@ +program maze; + +const small_maze = +'25' + #10 + +'13' + #10 + +'0000000000000000000000000'+ #10 + +'0301111101111110001000110'+ #10 + +'0101010101000011111110100'+ #10 + +'0111110101011010100010100'+ #10 + +'0100011101010010111011111'+ #10 + +'0101010001011010000010001'+ #10 + +'0111011101001110110010101'+ #10 + +'0010110101011000101110101'+ #10 + +'0111100101010010101001101'+ #10 + +'0100101111011111111001001'+ #10 + +'0111101001000000011111001'+ #10 + +'0010011111111111100000004'+ #10 + +'0000000000000000000000000'+ #10 ; + +const medium_maze ='61' + #10 + +'61' + #10 + +'0000000000000000000000000000000000000000000000000000000000000' + #10 + +'0111111111111100111111111111111111111111111111111111111110000' + #10 + +'0101000000000000100000000001000000000000000000000000000010000' + #10 + +'0101000000000000100100000001000111110000000000000000000010000' + #10 + +'0101000111111111100100000001000100000011111111111111110010000' + #10 + +'0101011101000100000111110001000100000010000000000000010010000' + #10 + +'0101010001000100000000010001000100000010000000000000010010000' + #10 + +'0101010001000100111111110001111111111110011100000000010010000' + #10 + +'0101011101011100000000010000000000000000000100000000010010000' + #10 + +'0101000001000000000000010011111111111111100111111100010010000' + #10 + +'0101111111111111111100010010000000000000000100000100010010000' + #10 + +'0100010000000000000100010011111111111111111100000100010011110' + #10 + +'0100011110000001000101110010000000000000000000000100010000010' + #10 + +'0100010010100001000101010010000000000000000000000100010000010' + #10 + +'0100010010111111111101010010011111111111111111111100010100010' + #10 + +'0111010000000001000101010010010000000001000010000111110100010' + #10 + +'0000011111100001000101011110010010000001000010000000000100010' + #10 + +'0000010000001111000101010000010010000001001010111111111100010' + #10 + +'3111111110100000000101010100010010000001001010100000000000010' + #10 + +'0000000010101111111101010100011111100001111010100000111110010' + #10 + +'0111111010101000001001010100010000100100000010100000100011110' + #10 + +'0100001010101000001001010100010000100100000010100000100000000' + #10 + +'0101101010101001001111010100010011100111110010100111100000000' + #10 + +'0100101010101001001000010111110000000100000010100000100000100' + #10 + +'0100101010101001001000010000100000000100000010100000100000100' + #10 + +'0100101010101001111001110000100011111100111110100000111111100' + #10 + +'0100111010101000001001000000100010000100100010100000100000000' + #10 + +'0100000010101111101001000000100010000100100010111111100000000' + #10 + +'0100000010100000101001001111100010000100100010000000100000000' + #10 + +'0111111111100000101001001000100000000100000010000000100000000' + #10 + +'0010100001000000101001001000111111111111111111111111111111114' + #10 + +'0010100001000100101001001000100000000000001001010010000000000' + #10 + +'0010111101010100101000001000100000000000001001010010000000000' + #10 + +'0010000101010100101111101000100011111111101001010011111110000' + #10 + +'0010000101010111101000101000100010000000001001010000000010000' + #10 + +'0111110101010000001000101000100010011111001001011111110010000' + #10 + +'0100000101011111111000100000100010010000001001000000010011110' + #10 + +'0100111101000000001000000000100010111111111001000000010000010' + #10 + +'0100000001111111111111111111111110100000000001110000010000010' + #10 + +'0100000000000000000000000000000000100011110100011110010000010' + #10 + +'0101111111111111111111111101111111100010000100010010010000010' + #10 + +'0101000000000000000000000101000000100010010100010010010000010' + #10 + +'0101000000111111111111100101100000100010010100010010010111110' + #10 + +'0101000000100000000000100100111110111110010100010010010100000' + #10 + +'0101000000100000000000100100000010101000010111110010010100000' + #10 + +'0101011111111111111100100101111110101000010000000010010101110' + #10 + +'0101010000000010000100100100000000101000010000000000010101010' + #10 + +'0101010111111010000110100111111111101011111111111111110101010' + #10 + +'0101010100001010000010100000000000001000100000000000000101010' + #10 + +'0101010111101010000010100000000000001000100000000000000101010' + #10 + +'0101010000101010000010100000111100001010111111111111111101010' + #10 + +'0101011111101011111010100000100100101110100000000000000101010' + #10 + +'0101000000001010001010111111100100100000100011111111100101010' + #10 + +'0101111111111010101010100000000100100000100010000000000101010' + #10 + +'0100000000000010101010100000000100100000100010000000000101010' + #10 + +'0111111111111110101010100000000000101111100010000000000101010' + #10 + +'0100000000000000101010100001111111100000100010111111111101010' + #10 + +'0100111111111111101010100001000000000000100011100000100000010' + #10 + +'0100100000000000001010111111111000000000100000000000100000010' + #10 + +'0110111111111111111010000000001111111111101111111111111111110' + #10 + +'0000000000000000000000000000000000000000000000000000000000000' + #10 ; + +type Tpoint = record + x,y: integer; +end; + +type TpointArray = array of TPoint; + +type TpointArrayArray = array of TpointArray; + +type TboolGrid = array of array of boolean; + +function readLine(raw: string; var off: integer): string; +begin + result:= ''; + while raw[off] <> #10 do + begin + result:= result + raw[off]; + off:= off + 1; + end; + off:= off + 1; +end; + + +function ParseMaze(raw: string; var start, finish: TPoint): TboolGrid; +var + tiles: TboolGrid; + c: char; + i,w,h,x,y: integer; +begin + writeln(raw); + writeln('Parsing...'); + i:= 1; + w:= strtoint(readLine(raw,i)); + h:= strtoint(readLine(raw,i)); + SetLength(tiles,w); + for x:= 0 to w - 1 do + SetLength(tiles[x],h); + x:= 0; + y:= 0; + writeln('W:' + inttostr(w) + ' H:' + inttostr(h)); + while y < h do + begin + c:= raw[i]; + i:= i + 1; + case c of + '0': begin + tiles[x][y]:= false; + x:= x + 1; + end; + '1': begin + tiles[x][y]:= true; + x:= x + 1; + end; + '3': begin + Writeln('found start!'); + start.x:= x; + start.y:= y; + tiles[x][y]:= true; + x:= x + 1; + end; + '4': begin + Writeln('found finish!'); + finish.x:= x; + finish.y:= y; + tiles[x][y]:= true; + x:= x + 1; + end; + end; + if x = w then begin x:= 0; y:= y + 1; end; + end; + result:= tiles; + writeln('Start = (' + inttostr(start.x) + ',' + inttostr(start.y) + ')'); + writeln('Finish = (' + inttostr(finish.x) + ',' + inttostr(finish.y) + ')'); + //writeln('a1:'+inttostr(length(tiles))); + //writeln('a2:'+inttostr(length(tiles[0]))); + //writeln('b1:'+inttostr(length(result))); + //writeln('b2:'+inttostr(length(result[0]))); +end; + + +function notPassed(var passed: TpointArray; x,y: integer): boolean; +var + i: integer; +begin + result:= true; + for i:= length(passed) - 1 downto 0 do + if (passed[i].x = x) and (passed[i].y = y) then begin result:= false; exit; end; +end; + +type TghettoStack = record + passed,my_path: TpointArray; + x,y: integer; +end; + +function point(x,y:integer):TPoint; +begin + result.x:= x; + result.y:= y; +end; + +function flood(var input: array of array of boolean; sx,sy,dx,dy,w,h: integer): array of TpointArray; +var + i,off,len,top,scrat:integer; + stack: array of TghettoStack; + my_path,passed: TpointArray; + x,y: integer; +begin + len:= 1000; + SetLength(stack,len); + SetLength(stack[0].passed,0); + stack[0].x:= sx; + stack[0].y:= sy; + writeln('pushing start: (' + inttostr(sx) + ',' + inttostr(sy) + ')'); + off:= 0; + top:= 1; + while top > 0 do + begin + if top+4 > len then + begin + writeln('Growing!'); + len:= len + 1000; + SetLength(stack,len); + end; + top:= top - 1; + passed:= stack[top].passed; + x:= stack[top].x; + y:= stack[top].y; + SetLength(my_path,Length(passed)+1); + //writeln('following (' + inttostr(x) + ',' + inttostr(y) + ') ' + inttostr(length(my_path))); + for i:= 0 to Length(passed) - 1 do + begin + my_path[i]:= passed[i]; + end; + my_path[Length(passed)]:= point(x,y); + if (x = dx) and (y = dy) then + begin + writeln('found path! ' + inttostr(off)); + SetLength(result,off+1); + result[off]:= my_path; + off:= off + 1; + //writeln('continuing search'); + end; + if (y-1 >= 0) then if input[x][y-1] then if notPassed(my_path,x,y-1) then + begin + stack[top].passed:= my_path; + stack[top].x:= x; + stack[top].y:= y-1; + top:= top + 1; + end; + if (y+1 < h) then if input[x][y+1] then if notPassed(my_path,x,y+1) then + begin + stack[top].passed:= my_path; + stack[top].x:= x; + stack[top].y:= y+1; + top:= top + 1; + end; + if (x-1 >= 0) then if input[x-1][y] then if notPassed(my_path,x-1,y) then + begin + stack[top].passed:= my_path; + stack[top].x:= x-1; + stack[top].y:= y; + top:= top + 1; + end; + if (x+1 < w) then if input[x+1][y] then if notPassed(my_path,x+1,y) then + begin + stack[top].passed:= my_path; + stack[top].x:= x+1; + stack[top].y:= y; + top:= top + 1; + end; + end; +end; + + +procedure prune(var input: array of array of boolean; x,y,w,h: integer); +var + nx,ny,c: integer; +begin + nx:= x; + ny:= y; + repeat + x:= nx; + y:= ny; + input[x][y]:= false; + c:= 0; + if (y-1 >= 0) then if input[x][y-1] then + begin + c:= c + 1; + ny:= y - 1; + end; + if (y+1 < h) then if input[x][y+1] then + begin + c:= c + 1; + ny:= y + 1; + end; + if (x-1 >= 0) then if input[x-1][y] then + begin + c:= c + 1; + nx:= x - 1; + end; + if (x+1 < w) then if input[x+1][y] then + begin + c:= c + 1; + nx:= x + 1; + end; + until c <> 1; + input[x][y]:= true; +end; + +procedure thin(var input: array of array of boolean; sx,sy,fx,fy,w,h: integer); +var + x,y,c: integer; +begin + //writeln('examining maze'); + for x:= 0 to w-1 do + for y:= 0 to h-1 do + if input[x][y] then + begin + c:= 0; + if (y-1 >= 0) then if input[x][y-1] then c:= c + 1; + if (y+1 < h) then if input[x][y+1] then c:= c + 1; + if (x-1 >= 0) then if input[x-1][y] then c:= c + 1; + if (x+1 < w) then if input[x+1][y] then c:= c + 1; + if c <= 1 then if ((x<>sx) or (y<>sy)) and ((x<>fx) or (y<>fy)) then prune(input,x,y,w,h); + end; +end; + +procedure benland100_solver(var jacks_path: TPointArray; var jills_routes: Integer; input: array of array of Boolean; start, finish: TPoint); +var + all_paths: array of TpointArray; + i,max_pos,max_len: integer; +begin + //writeln('d1:'+inttostr(length(maze))); + //writeln('d2:'+inttostr(length(maze[0]))); + writeln('preparing to solve maze'); + thin(input,start.x,start.y,finish.x,finish.y,length(input),length(input[0])); + writeln('thinned the maze'); + //writeln('start: (' + inttostr(start.x) + ',' + inttostr(start.y) + ') finish: (' + inttostr(finish.x) + ',' + inttostr(finish.y) + ')'); + all_paths:= flood(input,start.x,start.y,finish.x,finish.y,length(input),length(input[0])); + writeln('found all possible paths'); + jills_routes:= Length(all_paths) - 1; + max_pos:= 0; + max_len:= length(all_paths[0]); + writeln('Finding longest...'); + for i:= 1 to jills_routes do + begin + if length(all_paths[i]) > max_len then + begin + max_len:= length(all_paths[i]); + max_pos:= i; + end; + end; + jacks_path:= all_paths[max_pos]; +end; + +var + //maze: array of array of boolean; + start,finish: TPoint; + jack: TPointArray; + i,jills,t: integer; +begin + writeln('Solving maze...'); + //writeln('c1:'+inttostr(length(maze))); + //writeln('c2:'+inttostr(length(maze[0]))); + //t:= GetSystemTime(); + //writeln('start: (' + inttostr(start.x) + ',' + inttostr(start.y) + ') finish: (' + inttostr(finish.x) + ',' + inttostr(finish.y) + ')'); + benland100_solver(jack,jills,ParseMaze(small_maze,start,finish),start,finish); + //t:= GetSystemTime() - t; + //writeln('Took ' + realtostr(t / 1000.0) + ' seconds'); + writeln('Longest Path: ' + inttostr(length(jack))); + writeln('#Other Paths: ' + inttostr(jills)); +end. diff --git a/trunk/Units/MMLAddon/mmlpsthread.pas b/trunk/Units/MMLAddon/mmlpsthread.pas index 71ca40e..9439822 100644 --- a/trunk/Units/MMLAddon/mmlpsthread.pas +++ b/trunk/Units/MMLAddon/mmlpsthread.pas @@ -136,11 +136,12 @@ type end; TPrecompiler_Callback = function(name, args: PChar): boolean; stdcall; - TErrorHandeler_Callback = procedure(line, pos: integer; err: PChar); stdcall; + TErrorHandeler_Callback = procedure(line, pos: integer; err: PChar; runtime: boolean); stdcall; TCPThread = class(TMThread) protected instance: pointer; + added_methods: array of TExpMethod; public constructor Create(libname: string; CreateSuspended: Boolean; TheSyncInfo : PSyncInfo; plugin_dir: string); destructor Destroy; override; @@ -150,8 +151,10 @@ type procedure AddMethod(meth: TExpMethod); override; end; - function interp_init(ppg: PChar; precomp: TPrecompiler_Callback; err: TErrorHandeler_Callback): Pointer; cdecl; external; + function interp_init(precomp: TPrecompiler_Callback; err: TErrorHandeler_Callback): Pointer; cdecl; external; procedure interp_meth(interp: Pointer; addr: Pointer; def: PChar); cdecl; external; + procedure interp_set(interp: Pointer; ppg: PChar); cdecl; external; + function interp_comp(interp: Pointer): boolean; cdecl; external; function interp_run(interp: Pointer): boolean; cdecl; external; procedure interp_free(interp: Pointer); cdecl; external; @@ -163,11 +166,8 @@ var implementation {$ifdef LINUX} - {$linklib c} - {$linklib stdc++} {$link ./libcpascal.so} {$else} - {$linklib stdc++} {$linklib ./libcpascal.dll} {$endif} @@ -302,7 +302,8 @@ function TMThread.ProcessDirective(DirectiveName, DirectiveArgs: string): boolea var plugin_idx, i: integer; begin - if DirectiveName= 'LOADDLL' then + writeln('Running Directive: ' + DirectiveName); + if CompareText(DirectiveName,'LOADDLL') = 0 then begin if DirectiveArgs <> '' then begin; @@ -677,21 +678,6 @@ end; {***implementation TCPThread***} -constructor TCPThread.Create(libname: string; CreateSuspended: Boolean; TheSyncInfo : PSyncInfo; plugin_dir: string); -var - plugin_idx: integer; -begin - instance:= nil; - inherited Create(CreateSuspended, TheSyncInfo, plugin_dir); -end; - -destructor TCPThread.Destroy; -begin - if instance <> nil then - interp_free(instance); - inherited Destroy; -end; - function Interpreter_Precompiler(name, args: PChar): boolean; stdcall; var local_name, local_args: string; @@ -699,42 +685,62 @@ begin result:= CurrThread.ProcessDirective(name, args); end; -procedure Interpreter_ErrorHandler(line, pos: integer; err: PChar); stdcall; +procedure Interpreter_ErrorHandler(line, pos: integer; err: PChar; runtime: boolean); stdcall; begin - CurrThread.HandleError(line,pos,err,errRuntime,''); + if runtime then + CurrThread.HandleError(line,pos,err,errRuntime,'') + else + CurrThread.HandleError(line,pos,err,errCompile,'') +end; + +constructor TCPThread.Create(libname: string; CreateSuspended: Boolean; TheSyncInfo : PSyncInfo; plugin_dir: string); +var + plugin_idx: integer; +begin + instance:= interp_init(@Interpreter_Precompiler, @Interpreter_ErrorHandler); + inherited Create(CreateSuspended, TheSyncInfo, plugin_dir); +end; + +destructor TCPThread.Destroy; +begin + interp_free(instance); + inherited Destroy; end; procedure TCPThread.SetScript(script: string); -var - i: integer; begin - if instance <> nil then - interp_free(instance); - Starttime := lclintf.GetTickCount; - instance:= interp_init(PChar(@script[1]), @Interpreter_Precompiler, @Interpreter_ErrorHandler); - for i := 0 to high(ExportedMethods) do - if ExportedMethods[i].FuncPtr <> nil then - interp_meth(instance,ExportedMethods[i].FuncPtr,PChar(ExportedMethods[i].FuncDecl)); + interp_set(instance,PChar(script)); end; procedure TCPThread.AddMethod(meth: TExpMethod); begin - if instance = nil then - raise Exception.Create('Script not set, cannot add method'); interp_meth(instance,meth.FuncPtr,PChar(meth.FuncDecl)); end; procedure TCPThread.Execute; +var + i,ii: integer; begin - if instance = nil then - raise Exception.Create('Script not set, cannot run'); CurrThread := Self; - Starttime := lclintf.GetTickCount; + Starttime := GetTickCount; psWriteln('Invoking CPascal Interpreter'); - if interp_run(instance) then - psWriteln('Executed Successfully') - else - psWriteln('Execution Failed'); + if interp_comp(instance) then + begin + for i := high(PluginsToLoad) downto 0 do + for ii := 0 to PluginsGlob.MPlugins[PluginsToLoad[i]].MethodLen - 1 do + with PluginsGlob.MPlugins[PluginsToLoad[i]].Methods[ii] do + interp_meth(self.instance,FuncPtr,PChar(FuncStr)); + for i := 0 to high(ExportedMethods) do + if ExportedMethods[i].FuncPtr <> nil then + with ExportedMethods[i] do + interp_meth(self.instance,FuncPtr,PChar(FuncDecl)); + psWriteln('Compiled Successfully in ' + IntToStr(GetTickCount - Starttime) + 'ms'); + if interp_run(instance) then + psWriteln('Executed Successfully') + else + psWriteln('Execution Failed'); + end else + psWriteln('Compile Failed'); end;