diff -r de6406cd6b25 -r 85f6425a4d74 hedgewars/uScript.pas
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/hedgewars/uScript.pas	Wed Feb 10 00:55:40 2010 +0000
@@ -0,0 +1,501 @@
+(*
+ * Hedgewars, a free turn based strategy game
+ * Copyright (c) 2004-2008 Andrey Korotaev <unC0Rr@gmail.com>
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; version 2 of the License
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
+ *)
+
+{$INCLUDE "options.inc"}
+
+unit uScript;
+interface
+
+procedure ScriptPrintStack;
+procedure ScriptClearStack;
+
+procedure ScriptLoad(name : string);
+procedure ScriptOnGameInit;
+
+procedure ScriptCall(fname : string);
+function ScriptCall(fname : string; par1: LongInt) : LongInt;
+function ScriptCall(fname : string; par1, par2: LongInt) : LongInt;
+function ScriptCall(fname : string; par1, par2, par3: LongInt) : LongInt;
+function ScriptCall(fname : string; par1, par2, par3, par4 : LongInt) : LongInt;
+
+procedure init_uScript;
+procedure free_uScript;
+
+implementation
+uses LuaPas in 'LuaPas.pas',
+	uConsole,
+	uMisc,
+	uConsts,
+	uGears,
+	uFloat,
+	uWorld,
+	uAmmos,
+	uSound,
+	uTeams,
+	uKeys,
+	typinfo;
+
+var luaState : Plua_State;
+	ScriptAmmoStore : string;
+	
+procedure ScriptPrepareAmmoStore; forward;
+procedure ScriptApplyAmmoStore; forward;
+procedure ScriptSetAmmo(ammo : TAmmoType; count, propability: Byte); forward;
+
+// wrapped calls //
+
+// functions called from lua:
+// function(L : Plua_State) : LongInt; Cdecl;
+// where L contains the state, returns the number of return values on the stack
+// call lua_gettop(L) to receive number of parameters passed
+
+function lc_writelntoconsole(L : Plua_State) : LongInt; Cdecl;
+begin
+	if lua_gettop(L) = 1 then
+		begin
+		WriteLnToConsole('LUA: ' + lua_tostring(L ,1));
+		end
+	else
+		AddFileLog('LUA: Wrong number of parameters passed to WriteLnToConsole!');
+	lc_writelntoconsole:= 0;
+end;
+
+function lc_parsecommand(L : Plua_State) : LongInt; Cdecl;
+begin
+	if lua_gettop(L) = 1 then
+		begin
+		ParseCommand(lua_tostring(L ,1), true);
+		end
+	else
+		AddFileLog('LUA: Wrong number of parameters passed to ParseCommand!');
+	lc_parsecommand:= 0;
+end;
+
+function lc_showmission(L : Plua_State) : LongInt; Cdecl;
+begin
+	if lua_gettop(L) = 5 then
+		begin
+		ShowMission(lua_tostring(L, 1), lua_tostring(L, 2), lua_tostring(L, 3), lua_tointeger(L, 4), lua_tointeger(L, 5));
+		end
+	else
+		AddFileLog('LUA: Wrong number of parameters passed to ShowMission!');
+	lc_showmission:= 0;
+end;
+
+function lc_hidemission(L : Plua_State) : LongInt; Cdecl;
+begin
+	HideMission;
+	lc_hidemission:= 0;
+end;
+
+function lc_addgear(L : Plua_State) : LongInt; Cdecl;
+var gear : PGear;
+	x, y, s, t: LongInt;
+	dx, dy: hwFloat;
+	gt: TGearType;
+begin
+	if lua_gettop(L) <> 7 then
+		begin
+		AddFileLog('LUA: Wrong number of parameters passed to AddGear!');
+		lua_pushnil(L); // return value on stack (nil)
+		end
+	else
+		begin
+		x:= lua_tointeger(L, 1);
+		y:= lua_tointeger(L, 2);
+		gt:= TGearType(lua_tointeger(L, 3));
+		s:= lua_tointeger(L, 4);
+		dx:= int2hwFloat(round(lua_tonumber(L, 5) * 1000)) / 1000;
+		dy:= int2hwFloat(round(lua_tonumber(L, 6) * 1000)) / 1000;
+		t:= lua_tointeger(L, 7);
+
+		gear:= AddGear(x, y, gt, s, dx, dy, t);
+		lua_pushnumber(L, LongInt(gear))
+		end;
+	lc_addgear:= 1; // 1 return value
+end;
+
+function lc_getgeartype(L : Plua_State) : LongInt; Cdecl;
+begin
+	if lua_gettop(L) <> 1 then
+		begin
+		AddFileLog('LUA: Wrong number of parameters passed to GetGearType!');
+		lua_pushnil(L); // return value on stack (nil)
+		end
+	else
+		lua_pushinteger(L, ord(PGear(lua_tointeger(L, 1))^.Kind));
+	lc_getgeartype:= 1
+end;
+
+function lc_endgame(L : Plua_State) : LongInt; Cdecl;
+begin
+	GameState:= gsExit;
+	lc_endgame:= 0
+end;
+
+function lc_findplace(L : Plua_State) : LongInt; Cdecl;
+var gear: PGear;
+	fall: boolean;
+	left, right: LongInt;
+begin
+	if lua_gettop(L) <> 4 then
+		AddFileLog('LUA: Wrong number of parameters passed to FindPlace!')
+	else
+		begin
+		gear:= PGear(lua_tointeger(L, 1));
+		fall:= lua_toboolean(L, 2);
+		left:= lua_tointeger(L, 3);
+		right:= lua_tointeger(L, 4);
+		FindPlace(gear, fall, left, right)
+		end;
+	lc_findplace:= 0
+end;
+
+function lc_playsound(L : Plua_State) : LongInt; Cdecl;
+begin
+	if lua_gettop(L) <> 1 then
+		AddFileLog('LUA: Wrong number of parameters passed to PlaySound!')
+	else
+		PlaySound(TSound(lua_tointeger(L, 1)));
+	lc_playsound:= 0;
+end;
+
+function lc_addteam(L : Plua_State) : LongInt; Cdecl;
+begin
+	if lua_gettop(L) <> 5 then
+		AddFileLog('LUA: Wrong number of parameters passed to AddTeam!')
+	else
+		begin
+		ParseCommand('addteam ' + lua_tostring(L, 2) + ' ' + lua_tostring(L, 1), true);
+		ParseCommand('grave ' + lua_tostring(L, 3), true);
+		ParseCommand('fort ' + lua_tostring(L, 4), true);
+		ParseCommand('voicepack ' + lua_tostring(L, 5), true);
+		CurrentTeam^.Binds:= DefaultBinds;
+		lua_pushinteger(L, LongInt(CurrentTeam));
+		end;
+	lc_addteam:= 1;
+end;
+
+function lc_addhog(L : Plua_State) : LongInt; Cdecl;
+begin
+	if lua_gettop(L) <> 4 then
+		begin
+		AddFileLog('LUA: Wrong number of parameters passed to AddHog!');
+		lua_pushnil(L)
+		end
+	else
+		begin
+		ParseCommand('addhh ' + lua_tostring(L, 2) + ' ' + lua_tostring(L, 3) + ' ' + lua_tostring(L, 1), true);
+		ParseCommand('hat ' + lua_tostring(L, 4), true);
+		WriteLnToConsole('last hog: ' + inttostr(LongInt(CurrentHedgehog)));
+		lua_pushinteger(L, LongInt(CurrentHedgehog^.Gear));
+		end;
+	lc_addhog:= 1;
+end;
+
+function lc_getgearposition(L : Plua_State) : LongInt; Cdecl;
+var gear: PGear;
+begin
+	if lua_gettop(L) <> 1 then
+		begin
+		AddFileLog('LUA: Wrong number of parameters passed to GetGearPosition!');
+		lua_pushnil(L);
+		lua_pushnil(L)
+		end
+	else
+		begin
+		gear:= PGear(lua_tointeger(L, 1));
+		lua_pushinteger(L, hwRound(gear^.X));
+		lua_pushinteger(L, hwRound(gear^.Y))
+		end;
+	lc_getgearposition:= 2;
+end;
+
+function lc_setgearposition(L : Plua_State) : LongInt; Cdecl;
+var gear: PGear;
+	x, y: LongInt;
+begin
+	if lua_gettop(L) <> 3 then
+		AddFileLog('LUA: Wrong number of parameters passed to SetGearPosition!')
+	else
+		begin
+		gear:= PGear(lua_tointeger(L, 1));
+		x:= lua_tointeger(L, 2);
+		y:= lua_tointeger(L, 3);
+		gear^.X:= int2hwfloat(x);
+		gear^.Y:= int2hwfloat(y);
+		end;
+	lc_setgearposition:= 0
+end;
+
+function lc_setammo(L : Plua_State) : LongInt; Cdecl;
+begin
+	if lua_gettop(L) <> 3 then
+		AddFileLog('LUA: Wrong number of parameters passed to SetAmmo!')
+	else
+		begin
+		ScriptSetAmmo(TAmmoType(lua_tointeger(L, 1)), lua_tointeger(L, 2), lua_tointeger(L, 3));
+		end;
+	lc_setammo:= 0
+end;
+///////////////////
+
+procedure ScriptPrintStack;
+var n, i : LongInt;
+begin
+	n:= lua_gettop(luaState);
+	AddFileLog('LUA: Stack (' + inttostr(n) + ' elements):');
+	for i:= 1 to n do
+		if not lua_isboolean(luaState, i) then
+			AddFileLog('LUA:  ' + inttostr(i) + ': ' + lua_tostring(luaState, i))
+		else if lua_toboolean(luaState, i) then
+			AddFileLog('LUA:  ' + inttostr(i) + ': true')
+		else
+			AddFileLog('LUA:  ' + inttostr(i) + ': false');
+end;
+
+procedure ScriptClearStack;
+begin
+lua_settop(luaState, 0)
+end;
+
+procedure ScriptSetInteger(name : string; value : LongInt);
+begin
+lua_pushinteger(luaState, value);
+lua_setglobal(luaState, Str2PChar(name));
+end;
+
+procedure ScriptSetString(name : string; value : string);
+begin
+lua_pushstring(luaState, Str2PChar(value));
+lua_setglobal(luaState, Str2PChar(name));
+end;
+
+function ScriptGetInteger(name : string) : LongInt;
+begin
+lua_getglobal(luaState, Str2PChar(name));
+ScriptGetInteger:= lua_tointeger(luaState, -1);
+lua_pop(luaState, 1);
+end;
+
+function ScriptGetString(name : string) : string;
+begin
+lua_getglobal(luaState, Str2PChar(name));
+ScriptGetString:= lua_tostring(luaState, -1);
+lua_pop(luaState, 1);
+end;
+
+procedure ScriptOnGameInit;
+begin
+		// push game variables so they may be modified by the script
+		ScriptSetInteger('GameFlags', GameFlags);
+		ScriptSetString('Seed', cSeed);
+		ScriptSetInteger('TurnTime', cHedgehogTurnTime);
+		ScriptSetInteger('CaseFreq', cCaseFactor);
+		ScriptSetInteger('LandAdds', cLandAdditions);
+		ScriptSetInteger('Delay', cInactDelay);
+		ScriptSetString('Map', '');
+		ScriptSetString('Theme', '');
+
+		ScriptCall('onGameInit');
+		
+		// pop game variables
+		ParseCommand('seed ' + ScriptGetString('Seed'), true);
+		ParseCommand('$gmflags ' + ScriptGetString('GameFlags'), true);
+		ParseCommand('$turntime ' + ScriptGetString('TurnTime'), true);
+		ParseCommand('$casefreq ' + ScriptGetString('CaseFreq'), true);
+		ParseCommand('$landadds ' + ScriptGetString('LandAdds'), true);
+		ParseCommand('$delay ' + ScriptGetString('Delay'), true);
+		if ScriptGetString('Map') <> '' then
+			ParseCommand('map ' + ScriptGetString('Map'), true);
+		if ScriptGetString('Theme') <> '' then
+			ParseCommand('theme ' + ScriptGetString('Theme'), true);	
+
+	ScriptPrepareAmmoStore;
+	ScriptCall('onAmmoStoreInit');
+	ScriptApplyAmmoStore;
+end;
+
+procedure ScriptLoad(name : string);
+var ret : LongInt;
+begin
+	ret:= luaL_loadfile(luaState, Str2PChar(name));
+	if ret <> 0 then
+		AddFileLog('LUA: Failed to load ' + name + '(error ' + IntToStr(ret) + ')')
+	else
+		begin
+		AddFileLog('LUA: ' + name + ' loaded');
+		// call the script file
+		lua_pcall(luaState, 0, 0, 0);	
+		end
+end;
+
+procedure ScriptCall(fname : string);
+begin
+	lua_getglobal(luaState, Str2PChar(fname));
+	if lua_pcall(luaState, 0, 0, 0) <> 0 then
+		begin
+		AddFileLog('LUA: Error while calling ' + fname + ': ' + lua_tostring(luaState, -1));
+		lua_pop(luaState, 1)
+		end;
+end;
+
+function ScriptCall(fname : string; par1: LongInt) : LongInt;
+begin
+ScriptCall:= ScriptCall(fname, par1, 0, 0, 0)
+end;
+
+function ScriptCall(fname : string; par1, par2: LongInt) : LongInt;
+begin
+ScriptCall:= ScriptCall(fname, par1, par2, 0, 0)
+end;
+
+function ScriptCall(fname : string; par1, par2, par3: LongInt) : LongInt;
+begin
+ScriptCall:= ScriptCall(fname, par1, par2, par3, 0)
+end;
+
+function ScriptCall(fname : string; par1, par2, par3, par4 : LongInt) : LongInt;
+begin
+	lua_getglobal(luaState, Str2PChar(fname));
+	lua_pushinteger(luaState, par1);
+	lua_pushinteger(luaState, par2);
+	lua_pushinteger(luaState, par3);
+	lua_pushinteger(luaState, par4);
+	ScriptCall:= 0;
+	if lua_pcall(luaState, 4, 1, 0) <> 0 then
+		begin
+		AddFileLog('LUA: Error while calling ' + fname + ': ' + lua_tostring(luaState, -1));
+		lua_pop(luaState, 1)
+		end
+	else
+		begin
+		ScriptCall:= lua_tointeger(luaState, -1);
+		lua_pop(luaState, 1)
+		end;
+end;
+
+procedure ScriptPrepareAmmoStore;
+var i: ShortInt;
+begin
+ScriptAmmoStore:= '';
+for i:=1 to ord(High(TAmmoType)) do
+	ScriptAmmoStore:= ScriptAmmoStore + '00';
+end;
+
+procedure ScriptSetAmmo(ammo : TAmmoType; count, propability: Byte);
+begin
+if (ord(ammo) < 1) or (count > 9) or (count < 0) or (propability < 0) or (propability > 8) then
+	exit;
+ScriptAmmoStore[ord(ammo)]:= inttostr(count)[1];
+ScriptAmmoStore[ord(ammo) + ord(high(TAmmoType))]:= inttostr(propability)[1];
+end;
+
+procedure ScriptApplyAmmoStore;
+begin
+	AddAmmoStore(ScriptAmmoStore);
+end;
+
+// small helper functions making registering enums a lot easier
+function str(const en : TGearType) : string; overload;
+begin
+str:= GetEnumName(TypeInfo(TGearType), ord(en))
+end;
+
+function str(const en : TSound) : string; overload;
+begin
+str:= GetEnumName(TypeInfo(TSound), ord(en))
+end;
+
+function str(const en : TAmmoType) : string; overload;
+begin
+str:= GetEnumName(TypeInfo(TAmmoType), ord(en))
+end;
+///////////////////
+
+procedure init_uScript;
+var at : TGearType;
+	am : TAmmoType;
+	st : TSound;
+begin
+// initialize lua
+luaState:= lua_open;
+
+// open internal libraries
+luaopen_base(luaState);
+luaopen_string(luaState);
+luaopen_math(luaState);
+
+// import some variables
+ScriptSetInteger('LAND_WIDTH', LAND_WIDTH);
+ScriptSetInteger('LAND_HEIGHT', LAND_HEIGHT);
+
+// import game flags
+ScriptSetInteger('gfForts',gfForts);
+ScriptSetInteger('gfMultiWeapon',gfMultiWeapon);
+ScriptSetInteger('gfSolidLand',gfSolidLand);
+ScriptSetInteger('gfBorder',gfBorder);
+ScriptSetInteger('gfDivideTeams',gfDivideTeams);
+ScriptSetInteger('gfLowGravity',gfLowGravity);
+ScriptSetInteger('gfLaserSight',gfLaserSight);
+ScriptSetInteger('gfInvulnerable',gfInvulnerable);
+ScriptSetInteger('gfMines',gfMines);
+ScriptSetInteger('gfVampiric',gfVampiric);
+ScriptSetInteger('gfKarma',gfKarma);
+ScriptSetInteger('gfArtillery',gfArtillery);
+ScriptSetInteger('gfOneClanMode',gfOneClanMode);
+ScriptSetInteger('gfRandomOrder',gfRandomOrder);
+ScriptSetInteger('gfKing',gfKing);
+
+// register gear types
+for at:= Low(TGearType) to High(TGearType) do
+	ScriptSetInteger(str(at), ord(at));
+
+// register sounds
+for st:= Low(TSound) to High(TSound) do
+	ScriptSetInteger(str(st), ord(st));
+
+// register ammo types
+for am:= Low(TAmmoType) to High(TAmmoType) do
+	ScriptSetInteger(str(am), ord(am));
+	
+// register functions
+lua_register(luaState, 'AddGear', @lc_addgear);
+lua_register(luaState, 'WriteLnToConsole', @lc_writelntoconsole);
+lua_register(luaState, 'GetGearType', @lc_getgeartype);
+lua_register(luaState, 'EndGame', @lc_endgame);
+lua_register(luaState, 'FindPlace', @lc_findplace);
+lua_register(luaState, 'SetGearPosition', @lc_setgearposition);
+lua_register(luaState, 'GetGearPosition', @lc_getgearposition);
+lua_register(luaState, 'ParseCommand', @lc_parsecommand);
+lua_register(luaState, 'ShowMission', @lc_showmission);
+lua_register(luaState, 'HideMission', @lc_hidemission);
+lua_register(luaState, 'SetAmmo', @lc_setammo);
+lua_register(luaState, 'PlaySound', @lc_playsound);
+lua_register(luaState, 'AddTeam', @lc_addteam);
+lua_register(luaState, 'AddHog', @lc_addhog);
+
+ScriptClearStack; // just to be sure stack is empty
+end;
+
+procedure free_uScript;
+begin
+lua_close(luaState);
+end;
+
+end.