hedgewars/uScript.pas
changeset 2786 85f6425a4d74
child 2790 83630d5f94db
equal deleted inserted replaced
2785:de6406cd6b25 2786:85f6425a4d74
       
     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.