1 (*

     2  * Hedgewars, a free turn based strategy game

     3  * Copyright (c) 2004-2008 Andrey Korotaev <unC0Rr@gmail.com>

     4  *

     5  * This program is free software; you can redistribute it and/or modify

     6  * it under the terms of the GNU General Public License as published by

     7  * the Free Software Foundation; version 2 of the License

     8  *

     9  * This program is distributed in the hope that it will be useful,

    10  * but WITHOUT ANY WARRANTY; without even the implied warranty of

    11  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the

    12  * GNU General Public License for more details.

    13  *

    14  * You should have received a copy of the GNU General Public License

    15  * along with this program; if not, write to the Free Software

    16  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA

    17  *)

    18 

    19 {$INCLUDE "options.inc"}

    20 

    21 unit uScript;

    22 interface

    23 

    24 procedure ScriptPrintStack;

    25 procedure ScriptClearStack;

    26 

    27 procedure ScriptLoad(name : string);

    28 procedure ScriptOnGameInit;

    29 

    30 procedure ScriptCall(fname : string);

    31 function ScriptCall(fname : string; par1: LongInt) : LongInt;

    32 function ScriptCall(fname : string; par1, par2: LongInt) : LongInt;

    33 function ScriptCall(fname : string; par1, par2, par3: LongInt) : LongInt;

    34 function ScriptCall(fname : string; par1, par2, par3, par4 : LongInt) : LongInt;

    35 

    36 procedure init_uScript;

    37 procedure free_uScript;

    38 

    39 implementation

    40 uses LuaPas in 'LuaPas.pas',

    41 	uConsole,

    42 	uMisc,

    43 	uConsts,

    44 	uGears,

    45 	uFloat,

    46 	uWorld,

    47 	uAmmos,

    48 	uSound,

    49 	uTeams,

    50 	uKeys,

    51 	typinfo;

    52 

    53 var luaState : Plua_State;

    54 	ScriptAmmoStore : string;

    55 	

    56 procedure ScriptPrepareAmmoStore; forward;

    57 procedure ScriptApplyAmmoStore; forward;

    58 procedure ScriptSetAmmo(ammo : TAmmoType; count, propability: Byte); forward;

    59 

    60 // wrapped calls //

    61 

    62 // functions called from lua:

    63 // function(L : Plua_State) : LongInt; Cdecl;

    64 // where L contains the state, returns the number of return values on the stack

    65 // call lua_gettop(L) to receive number of parameters passed

    66 

    67 function lc_writelntoconsole(L : Plua_State) : LongInt; Cdecl;

    68 begin

    69 	if lua_gettop(L) = 1 then

    70 		begin

    71 		WriteLnToConsole('LUA: ' + lua_tostring(L ,1));

    72 		end

    73 	else

    74 		AddFileLog('LUA: Wrong number of parameters passed to WriteLnToConsole!');

    75 	lc_writelntoconsole:= 0;

    76 end;

    77 

    78 function lc_parsecommand(L : Plua_State) : LongInt; Cdecl;

    79 begin

    80 	if lua_gettop(L) = 1 then

    81 		begin

    82 		ParseCommand(lua_tostring(L ,1), true);

    83 		end

    84 	else

    85 		AddFileLog('LUA: Wrong number of parameters passed to ParseCommand!');

    86 	lc_parsecommand:= 0;

    87 end;

    88 

    89 function lc_showmission(L : Plua_State) : LongInt; Cdecl;

    90 begin

    91 	if lua_gettop(L) = 5 then

    92 		begin

    93 		ShowMission(lua_tostring(L, 1), lua_tostring(L, 2), lua_tostring(L, 3), lua_tointeger(L, 4), lua_tointeger(L, 5));

    94 		end

    95 	else

    96 		AddFileLog('LUA: Wrong number of parameters passed to ShowMission!');

    97 	lc_showmission:= 0;

    98 end;

    99 

   100 function lc_hidemission(L : Plua_State) : LongInt; Cdecl;

   101 begin

   102 	HideMission;

   103 	lc_hidemission:= 0;

   104 end;

   105 

   106 function lc_addgear(L : Plua_State) : LongInt; Cdecl;

   107 var gear : PGear;

   108 	x, y, s, t: LongInt;

   109 	dx, dy: hwFloat;

   110 	gt: TGearType;

   111 begin

   112 	if lua_gettop(L) <> 7 then

   113 		begin

   114 		AddFileLog('LUA: Wrong number of parameters passed to AddGear!');

   115 		lua_pushnil(L); // return value on stack (nil)

   116 		end

   117 	else

   118 		begin

   119 		x:= lua_tointeger(L, 1);

   120 		y:= lua_tointeger(L, 2);

   121 		gt:= TGearType(lua_tointeger(L, 3));

   122 		s:= lua_tointeger(L, 4);

   123 		dx:= int2hwFloat(round(lua_tonumber(L, 5) * 1000)) / 1000;

   124 		dy:= int2hwFloat(round(lua_tonumber(L, 6) * 1000)) / 1000;

   125 		t:= lua_tointeger(L, 7);

   126 

   127 		gear:= AddGear(x, y, gt, s, dx, dy, t);

   128 		lua_pushnumber(L, LongInt(gear))

   129 		end;

   130 	lc_addgear:= 1; // 1 return value

   131 end;

   132 

   133 function lc_getgeartype(L : Plua_State) : LongInt; Cdecl;

   134 begin

   135 	if lua_gettop(L) <> 1 then

   136 		begin

   137 		AddFileLog('LUA: Wrong number of parameters passed to GetGearType!');

   138 		lua_pushnil(L); // return value on stack (nil)

   139 		end

   140 	else

   141 		lua_pushinteger(L, ord(PGear(lua_tointeger(L, 1))^.Kind));

   142 	lc_getgeartype:= 1

   143 end;

   144 

   145 function lc_endgame(L : Plua_State) : LongInt; Cdecl;

   146 begin

   147 	GameState:= gsExit;

   148 	lc_endgame:= 0

   149 end;

   150 

   151 function lc_findplace(L : Plua_State) : LongInt; Cdecl;

   152 var gear: PGear;

   153 	fall: boolean;

   154 	left, right: LongInt;

   155 begin

   156 	if lua_gettop(L) <> 4 then

   157 		AddFileLog('LUA: Wrong number of parameters passed to FindPlace!')

   158 	else

   159 		begin

   160 		gear:= PGear(lua_tointeger(L, 1));

   161 		fall:= lua_toboolean(L, 2);

   162 		left:= lua_tointeger(L, 3);

   163 		right:= lua_tointeger(L, 4);

   164 		FindPlace(gear, fall, left, right)

   165 		end;

   166 	lc_findplace:= 0

   167 end;

   168 

   169 function lc_playsound(L : Plua_State) : LongInt; Cdecl;

   170 begin

   171 	if lua_gettop(L) <> 1 then

   172 		AddFileLog('LUA: Wrong number of parameters passed to PlaySound!')

   173 	else

   174 		PlaySound(TSound(lua_tointeger(L, 1)));

   175 	lc_playsound:= 0;

   176 end;

   177 

   178 function lc_addteam(L : Plua_State) : LongInt; Cdecl;

   179 begin

   180 	if lua_gettop(L) <> 5 then

   181 		AddFileLog('LUA: Wrong number of parameters passed to AddTeam!')

   182 	else

   183 		begin

   184 		ParseCommand('addteam ' + lua_tostring(L, 2) + ' ' + lua_tostring(L, 1), true);

   185 		ParseCommand('grave ' + lua_tostring(L, 3), true);

   186 		ParseCommand('fort ' + lua_tostring(L, 4), true);

   187 		ParseCommand('voicepack ' + lua_tostring(L, 5), true);

   188 		CurrentTeam^.Binds:= DefaultBinds;

   189 		lua_pushinteger(L, LongInt(CurrentTeam));

   190 		end;

   191 	lc_addteam:= 1;

   192 end;

   193 

   194 function lc_addhog(L : Plua_State) : LongInt; Cdecl;

   195 begin

   196 	if lua_gettop(L) <> 4 then

   197 		begin

   198 		AddFileLog('LUA: Wrong number of parameters passed to AddHog!');

   199 		lua_pushnil(L)

   200 		end

   201 	else

   202 		begin

   203 		ParseCommand('addhh ' + lua_tostring(L, 2) + ' ' + lua_tostring(L, 3) + ' ' + lua_tostring(L, 1), true);

   204 		ParseCommand('hat ' + lua_tostring(L, 4), true);

   205 		WriteLnToConsole('last hog: ' + inttostr(LongInt(CurrentHedgehog)));

   206 		lua_pushinteger(L, LongInt(CurrentHedgehog^.Gear));

   207 		end;

   208 	lc_addhog:= 1;

   209 end;

   210 

   211 function lc_getgearposition(L : Plua_State) : LongInt; Cdecl;

   212 var gear: PGear;

   213 begin

   214 	if lua_gettop(L) <> 1 then

   215 		begin

   216 		AddFileLog('LUA: Wrong number of parameters passed to GetGearPosition!');

   217 		lua_pushnil(L);

   218 		lua_pushnil(L)

   219 		end

   220 	else

   221 		begin

   222 		gear:= PGear(lua_tointeger(L, 1));

   223 		lua_pushinteger(L, hwRound(gear^.X));

   224 		lua_pushinteger(L, hwRound(gear^.Y))

   225 		end;

   226 	lc_getgearposition:= 2;

   227 end;

   228 

   229 function lc_setgearposition(L : Plua_State) : LongInt; Cdecl;

   230 var gear: PGear;

   231 	x, y: LongInt;

   232 begin

   233 	if lua_gettop(L) <> 3 then

   234 		AddFileLog('LUA: Wrong number of parameters passed to SetGearPosition!')

   235 	else

   236 		begin

   237 		gear:= PGear(lua_tointeger(L, 1));

   238 		x:= lua_tointeger(L, 2);

   239 		y:= lua_tointeger(L, 3);

   240 		gear^.X:= int2hwfloat(x);

   241 		gear^.Y:= int2hwfloat(y);

   242 		end;

   243 	lc_setgearposition:= 0

   244 end;

   245 

   246 function lc_setammo(L : Plua_State) : LongInt; Cdecl;

   247 begin

   248 	if lua_gettop(L) <> 3 then

   249 		AddFileLog('LUA: Wrong number of parameters passed to SetAmmo!')

   250 	else

   251 		begin

   252 		ScriptSetAmmo(TAmmoType(lua_tointeger(L, 1)), lua_tointeger(L, 2), lua_tointeger(L, 3));

   253 		end;

   254 	lc_setammo:= 0

   255 end;

   256 ///////////////////

   257 

   258 procedure ScriptPrintStack;

   259 var n, i : LongInt;

   260 begin

   261 	n:= lua_gettop(luaState);

   262 	AddFileLog('LUA: Stack (' + inttostr(n) + ' elements):');

   263 	for i:= 1 to n do

   264 		if not lua_isboolean(luaState, i) then

   265 			AddFileLog('LUA:  ' + inttostr(i) + ': ' + lua_tostring(luaState, i))

   266 		else if lua_toboolean(luaState, i) then

   267 			AddFileLog('LUA:  ' + inttostr(i) + ': true')

   268 		else

   269 			AddFileLog('LUA:  ' + inttostr(i) + ': false');

   270 end;

   271 

   272 procedure ScriptClearStack;

   273 begin

   274 lua_settop(luaState, 0)

   275 end;

   276 

   277 procedure ScriptSetInteger(name : string; value : LongInt);

   278 begin

   279 lua_pushinteger(luaState, value);

   280 lua_setglobal(luaState, Str2PChar(name));

   281 end;

   282 

   283 procedure ScriptSetString(name : string; value : string);

   284 begin

   285 lua_pushstring(luaState, Str2PChar(value));

   286 lua_setglobal(luaState, Str2PChar(name));

   287 end;

   288 

   289 function ScriptGetInteger(name : string) : LongInt;

   290 begin

   291 lua_getglobal(luaState, Str2PChar(name));

   292 ScriptGetInteger:= lua_tointeger(luaState, -1);

   293 lua_pop(luaState, 1);

   294 end;

   295 

   296 function ScriptGetString(name : string) : string;

   297 begin

   298 lua_getglobal(luaState, Str2PChar(name));

   299 ScriptGetString:= lua_tostring(luaState, -1);

   300 lua_pop(luaState, 1);

   301 end;

   302 

   303 procedure ScriptOnGameInit;

   304 begin

   305 		// push game variables so they may be modified by the script

   306 		ScriptSetInteger('GameFlags', GameFlags);

   307 		ScriptSetString('Seed', cSeed);

   308 		ScriptSetInteger('TurnTime', cHedgehogTurnTime);

   309 		ScriptSetInteger('CaseFreq', cCaseFactor);

   310 		ScriptSetInteger('LandAdds', cLandAdditions);

   311 		ScriptSetInteger('Delay', cInactDelay);

   312 		ScriptSetString('Map', '');

   313 		ScriptSetString('Theme', '');

   314 

   315 		ScriptCall('onGameInit');

   316 		

   317 		// pop game variables

   318 		ParseCommand('seed ' + ScriptGetString('Seed'), true);

   319 		ParseCommand('$gmflags ' + ScriptGetString('GameFlags'), true);

   320 		ParseCommand('$turntime ' + ScriptGetString('TurnTime'), true);

   321 		ParseCommand('$casefreq ' + ScriptGetString('CaseFreq'), true);

   322 		ParseCommand('$landadds ' + ScriptGetString('LandAdds'), true);

   323 		ParseCommand('$delay ' + ScriptGetString('Delay'), true);

   324 		if ScriptGetString('Map') <> '' then

   325 			ParseCommand('map ' + ScriptGetString('Map'), true);

   326 		if ScriptGetString('Theme') <> '' then

   327 			ParseCommand('theme ' + ScriptGetString('Theme'), true);	

   328 

   329 	ScriptPrepareAmmoStore;

   330 	ScriptCall('onAmmoStoreInit');

   331 	ScriptApplyAmmoStore;

   332 end;

   333 

   334 procedure ScriptLoad(name : string);

   335 var ret : LongInt;

   336 begin

   337 	ret:= luaL_loadfile(luaState, Str2PChar(name));

   338 	if ret <> 0 then

   339 		AddFileLog('LUA: Failed to load ' + name + '(error ' + IntToStr(ret) + ')')

   340 	else

   341 		begin

   342 		AddFileLog('LUA: ' + name + ' loaded');

   343 		// call the script file

   344 		lua_pcall(luaState, 0, 0, 0);	

   345 		end

   346 end;

   347 

   348 procedure ScriptCall(fname : string);

   349 begin

   350 	lua_getglobal(luaState, Str2PChar(fname));

   351 	if lua_pcall(luaState, 0, 0, 0) <> 0 then

   352 		begin

   353 		AddFileLog('LUA: Error while calling ' + fname + ': ' + lua_tostring(luaState, -1));

   354 		lua_pop(luaState, 1)

   355 		end;

   356 end;

   357 

   358 function ScriptCall(fname : string; par1: LongInt) : LongInt;

   359 begin

   360 ScriptCall:= ScriptCall(fname, par1, 0, 0, 0)

   361 end;

   362 

   363 function ScriptCall(fname : string; par1, par2: LongInt) : LongInt;

   364 begin

   365 ScriptCall:= ScriptCall(fname, par1, par2, 0, 0)

   366 end;

   367 

   368 function ScriptCall(fname : string; par1, par2, par3: LongInt) : LongInt;

   369 begin

   370 ScriptCall:= ScriptCall(fname, par1, par2, par3, 0)

   371 end;

   372 

   373 function ScriptCall(fname : string; par1, par2, par3, par4 : LongInt) : LongInt;

   374 begin

   375 	lua_getglobal(luaState, Str2PChar(fname));

   376 	lua_pushinteger(luaState, par1);

   377 	lua_pushinteger(luaState, par2);

   378 	lua_pushinteger(luaState, par3);

   379 	lua_pushinteger(luaState, par4);

   380 	ScriptCall:= 0;

   381 	if lua_pcall(luaState, 4, 1, 0) <> 0 then

   382 		begin

   383 		AddFileLog('LUA: Error while calling ' + fname + ': ' + lua_tostring(luaState, -1));

   384 		lua_pop(luaState, 1)

   385 		end

   386 	else

   387 		begin

   388 		ScriptCall:= lua_tointeger(luaState, -1);

   389 		lua_pop(luaState, 1)

   390 		end;

   391 end;

   392 

   393 procedure ScriptPrepareAmmoStore;

   394 var i: ShortInt;

   395 begin

   396 ScriptAmmoStore:= '';

   397 for i:=1 to ord(High(TAmmoType)) do

   398 	ScriptAmmoStore:= ScriptAmmoStore + '00';

   399 end;

   400 

   401 procedure ScriptSetAmmo(ammo : TAmmoType; count, propability: Byte);

   402 begin

   403 if (ord(ammo) < 1) or (count > 9) or (count < 0) or (propability < 0) or (propability > 8) then

   404 	exit;

   405 ScriptAmmoStore[ord(ammo)]:= inttostr(count)[1];

   406 ScriptAmmoStore[ord(ammo) + ord(high(TAmmoType))]:= inttostr(propability)[1];

   407 end;

   408 

   409 procedure ScriptApplyAmmoStore;

   410 begin

   411 	AddAmmoStore(ScriptAmmoStore);

   412 end;

   413 

   414 // small helper functions making registering enums a lot easier

   415 function str(const en : TGearType) : string; overload;

   416 begin

   417 str:= GetEnumName(TypeInfo(TGearType), ord(en))

   418 end;

   419 

   420 function str(const en : TSound) : string; overload;

   421 begin

   422 str:= GetEnumName(TypeInfo(TSound), ord(en))

   423 end;

   424 

   425 function str(const en : TAmmoType) : string; overload;

   426 begin

   427 str:= GetEnumName(TypeInfo(TAmmoType), ord(en))

   428 end;

   429 ///////////////////

   430 

   431 procedure init_uScript;

   432 var at : TGearType;

   433 	am : TAmmoType;

   434 	st : TSound;

   435 begin

   436 // initialize lua

   437 luaState:= lua_open;

   438 

   439 // open internal libraries

   440 luaopen_base(luaState);

   441 luaopen_string(luaState);

   442 luaopen_math(luaState);

   443 

   444 // import some variables

   445 ScriptSetInteger('LAND_WIDTH', LAND_WIDTH);

   446 ScriptSetInteger('LAND_HEIGHT', LAND_HEIGHT);

   447 

   448 // import game flags

   449 ScriptSetInteger('gfForts',gfForts);

   450 ScriptSetInteger('gfMultiWeapon',gfMultiWeapon);

   451 ScriptSetInteger('gfSolidLand',gfSolidLand);

   452 ScriptSetInteger('gfBorder',gfBorder);

   453 ScriptSetInteger('gfDivideTeams',gfDivideTeams);

   454 ScriptSetInteger('gfLowGravity',gfLowGravity);

   455 ScriptSetInteger('gfLaserSight',gfLaserSight);

   456 ScriptSetInteger('gfInvulnerable',gfInvulnerable);

   457 ScriptSetInteger('gfMines',gfMines);

   458 ScriptSetInteger('gfVampiric',gfVampiric);

   459 ScriptSetInteger('gfKarma',gfKarma);

   460 ScriptSetInteger('gfArtillery',gfArtillery);

   461 ScriptSetInteger('gfOneClanMode',gfOneClanMode);

   462 ScriptSetInteger('gfRandomOrder',gfRandomOrder);

   463 ScriptSetInteger('gfKing',gfKing);

   464 

   465 // register gear types

   466 for at:= Low(TGearType) to High(TGearType) do

   467 	ScriptSetInteger(str(at), ord(at));

   468 

   469 // register sounds

   470 for st:= Low(TSound) to High(TSound) do

   471 	ScriptSetInteger(str(st), ord(st));

   472 

   473 // register ammo types

   474 for am:= Low(TAmmoType) to High(TAmmoType) do

   475 	ScriptSetInteger(str(am), ord(am));

   476 	

   477 // register functions

   478 lua_register(luaState, 'AddGear', @lc_addgear);

   479 lua_register(luaState, 'WriteLnToConsole', @lc_writelntoconsole);

   480 lua_register(luaState, 'GetGearType', @lc_getgeartype);

   481 lua_register(luaState, 'EndGame', @lc_endgame);

   482 lua_register(luaState, 'FindPlace', @lc_findplace);

   483 lua_register(luaState, 'SetGearPosition', @lc_setgearposition);

   484 lua_register(luaState, 'GetGearPosition', @lc_getgearposition);

   485 lua_register(luaState, 'ParseCommand', @lc_parsecommand);

   486 lua_register(luaState, 'ShowMission', @lc_showmission);

   487 lua_register(luaState, 'HideMission', @lc_hidemission);

   488 lua_register(luaState, 'SetAmmo', @lc_setammo);

   489 lua_register(luaState, 'PlaySound', @lc_playsound);

   490 lua_register(luaState, 'AddTeam', @lc_addteam);

   491 lua_register(luaState, 'AddHog', @lc_addhog);

   492 

   493 ScriptClearStack; // just to be sure stack is empty

   494 end;

   495 

   496 procedure free_uScript;

   497 begin

   498 lua_close(luaState);

   499 end;

   500 

   501 end.