Сообщений в теме: 2

[VcSaJen]

Вот порт на Alice моих скриптов для езды по стенам и подствольный гранатомёт.
Управление:
Подствольный гранатомёт:
Выбрать AK-47 или M-4 и нажать E для пуска гранат. Если у вас гранаты, то будет стрелять гранатами, а если коктейль Молотова, то будет стрелять горючими бутылками. Правда, из-за особенностей физики GTA4 и большого сопротивления воздуха гранаты не летят далеко.
Езда по стенам:
J - подпрыгнуть
Shift - ускориться
Из-за особенностей физики GTA4 мотоциклы будут уходить вбок при повороте.
Из-за особенностей работы скрипта машина если перевернётся то будет подпрыгивать.
Если у вас другой FPS чем у меня, то настройте UpperForce под себя.
Другое:
I - Скопировать в буфер обмена текущие координаты
U - Переместиться в координаты из буфера обмена
N -
K - Получить санчез
J - получить Mule

library StickyAndGrenade; {$R *.res} {$E ext}

uses
  Windows,
  SysUtils,
  Clipbrd,
  ScriptNatives,
  ScriptTypes,
  ScriptUseful;

const
  Rus	   ='АБВГДЕЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯабвгдежзийклмнопрстуфхцчшщъыьэюя';
  EncodedRus='ЋЏђ‘’””•–—˜™љ›њќћџ ЎўЈ¤Ґ¦§Ё©Є«¬­®Ї°±Ііґµ¶·ё№є»јЅѕїАБВГДЕЖЗИЙКЛМН';

function EncodeRus(const text: string): string;
var I,p: Integer;
begin
  Result:=Text;
  for I:=1 to Length(Result) do
  begin
	if Result[i]='ё' then Result[i]:='е';
	if Result[i]='Ё' then Result[i]:='Е';
	p:=pos(Result[i], Rus);
	if p>0 then Result[i]:=EncodedRus[p];
  end;
end;

function DecodeRus(const text: string): string;
var I,p: Integer;
begin
  Result:=Text;
  for I:=1 to Length(Result) do
  begin
	p:=pos(Result[i], EncodedRus);
	if p>0 then Result[i]:=Rus[p];
  end;
end;

procedure ShowText(text: string; time: integer = 5000);
begin
  PrintStringWithLiteralStringNow('string', PChar(EncodeRus(text)), time, 1);
end;

function Round(X: Extended): Int64;
begin
  Result:=System.Round(X);
end;

function FTS(Value: Extended): string;
begin
  DecimalSeparator:='.';
  Result:=FloatToStrF(Value,ffFixed,10,3);
end;

function ReadNum(S: string; var I: Integer): Single;
var ts: string;
begin
  while not (S[I] in ['0'..'9', '-', '.']) and (I<=Length(S)) do Inc(I);
  ts:='';
  while (S[I] in ['0'..'9', '-', '.']) and (I<=Length(S)) do
  begin
	ts:=ts+S[I];
	Inc(I);
  end;
  //ShowText(ts,2000);
  //Wait(2000);
  Result:=StrToFloat(ts);
end;

procedure SpawnCar(Name : PChar);
var
  PlayerId : Player;
  PlayerChar : Ped;
  Car : Vehicle;
  Hash : Cardinal;
  X, Y, Z : f32;
begin
  PlayerId := GetPlayerId();
  if PlayerId >= 0 then
  if IsPlayerPlaying(PlayerId) then
  if PlayerHasChar(PlayerId) then
  begin
	GetPlayerChar(PlayerId, @PlayerChar);
	if PlayerChar > 0 then
	begin
	  Hash := GetHashKey(Name);
	  RequestModel(Hash);
	  while not HasModelLoaded(Hash) do Wait(10);
	  GetOffsetFromCharInWorldCoords(PlayerChar, 0, 5, 0, @X, @Y, @Z);
	  CreateCar(Hash, X, Y, Z, @Car, True);
	  MarkModelAsNoLongerNeeded(Hash);
	  MarkCarAsNoLongerNeeded(@Car);
	  PrintStringWithLiteralStringNow('string', PChar(Name + ' spawned !'), 5000, 1);
	end;  
  end;
end;

var
  MemInfo: TMemoryBasicInformation;
  ModName: array[0..MAX_PATH] of Char;
  S: string;

//Если что не понятно, спрашивайте в темке.
procedure main(); export;
const
  MaxObjs=16; // Максимальное кол-во летящих одновременно гранат
  ReloadTime=500;// Время перезарядки в мс
var
  Objs: array [0..MaxObjs-1] of LongWord;
  ObjsStartTimes: array [0..MaxObjs-1] of Integer;

  procedure CheckObjs;
  var
	I: Integer;
	CurTime: Integer;
	Model: LongWord;
	X,Y,Z: Single;
  begin
	GetGameTimer(@CurTime);
	for I:=0 to MaxObjs-1 do
	begin
	  if DoesObjectExist(Objs[I]) and (Objs[I]>0) then
	  begin
		if HasObjectCollidedWithAnything(Objs[I])
					   or IsObjectInWater(Objs[I])
					   or (CurTime-ObjsStartTimes[I] = 5000) then
		begin
		  GetObjectCoordinates(Objs[I], @X, @Y, @Z);
		  GetObjectModel(Objs[I], @Model);
		  if Model=GetHashKey('w_grenade') then
			AddExplosion(X,Y,Z, 0, 5.5, 1, 0, 1.0);
		  if Model=GetHashKey('w_molotov') then
			AddExplosion(X,Y,Z, 1, 5.5, 1, 0, 1.0);
		  DeleteObject(@Objs[I]);
		end;
	  end;
	end;
  end;

  function GetFreeObjIndex: Integer;
  var I: Integer;
  begin
	Result:=-1;
	for I:=0 to MaxObjs-1 do
	  if not DoesObjectExist(Objs[I]) then
	  begin
		Result:=I;
		ShowText('OK', 1000);
		Exit;
	  end;
	ShowText('~r~Fail', 1000);
  end;

var
  PlayerId : Player;
  PlayerChar : Ped;
  PlayerCar: Vehicle;
  UpperForce: Single;
  //S: string;
  X,Y,Z: Single;
  I,N: Integer;
  LastTime, CurTime: Integer;
  SLastTime, SCurTime: Integer;
  Cam, Weap, Ammo, WeapModel: Cardinal;
  RotX,RotY,RotZ,Vx,Vy,Vz: Single;
  BonePos: Vector3;
  //---------------
  ptfx: Cardinal;
begin
  Wait(2000);
  try
  DecimalSeparator:='.';
  LastTime:=0;
  SLastTime:=0;
  //ShowText('Липучка (123456.654321)');
  UpperForce:=0.65;
  while True do
  begin
	PlayerId := GetPlayerId();
	if PlayerId >= 0 then
	if IsPlayerPlaying(PlayerId) then
	if PlayerHasChar(PlayerId) then
	begin
	  GetPlayerChar(PlayerId, @PlayerChar);
	  if PlayerChar > 0 then
	  begin
		if KeyPressed(Ord('U')) then
		begin
		  S:=Clipboard.AsText;
		  I:=1;
		  try
			X:=ReadNum(S,I);
			Y:=ReadNum(S,I);
			Z:=ReadNum(S,I);
			SetCharCoordinates(PlayerChar, X, Y, Z);
			ShowText('Выполнен переход на ~n~'+FTS(X)+', '+FTS(Y)+', '+FTS(Z));
		  except
			on EConvertError do ShowText('~r~Неверный формат координат телетортации!');
		  end;
		end;
		if KeyPressed(Ord('I')) then
		begin
		  GetCharCoordinates(PlayerChar, @X, @Y, @Z);
		  ShowText('Скопировано '+FTS(X)+', '+FTS(Y)+', '+FTS(Z));
		  Clipboard.AsText:=fts(X)+', '+fts(Y)+', '+fts(Z);
		end;

		CheckObjs;

		GetCurrentCharWeapon(PlayerChar, @Weap);
		GetGameTimer(@CurTime);

		if KeyPressed(Ord('E')) and
		   KeyPressed(VK_RBUTTON) and
		   (Weap in [14,15]) and
		   (CurTime-LastTime>ReloadTime) then
		begin
		  PlaySound(-1, 'ball_returned');
		  GetPedBonePosition(PlayerChar,1232,0.42,0.05,-0.15,@BonePos);
		  GetCharCoordinates(PlayerChar,@X,@Y,@Z);
		  GetDistanceBetweenCoords3D(BonePos.X,BonePos.Y,BonePos.Z,X,Y,Z,@X);
		  N:=GetFreeObjIndex;
		  GetCharWeaponInSlot(PlayerChar, 8, @Weap, @Ammo, @WeapModel);//04B8
		  if Ammo<=0 then ShowText('Нет гранат!');

		  if (X<2.0) and (N<>-1) and (Ammo>0) then
		  begin

			CreateObject(WeapModel,BonePos.X,BonePos.Y,BonePos.Z,@Objs[N],True);
			Dec(Ammo);
			SetCharAmmo(PlayerChar, Weap, Ammo);

			SetObjectVisible(Objs[N],False);
			SetActivateObjectPhysicsAsSoonAsItIsUnfrozen(Objs[N], true);

			GetGameCam(@Cam);
			GetCamRot(Cam,@rotX,@rotY,@rotZ);
			RotZ:=RotZ+90.0;
			Vx:=ScriptNatives.Cos(rotZ)*50.0;
			Vy:=ScriptNatives.Sin(rotZ)*50.0;
			Vz:=ScriptNatives.Sin(rotX)*50.0;

			ApplyForceToObject(Objs[N],1,Vx,Vy,Vz,0.0,0.0,0.0,0,1,1,1);// Эта конструкция может показаться странной: мол, зачем повторять 2 раза и делать задержку?
			Wait(0);											   // На самом деле при одинарном вызывании без задержки объект вообще не будет двигаться.
			ApplyForceToObject(Objs[N],1,Vx,Vy,Vz,0.0,0.0,0.0,0,1,1,1);//
			SetObjectVisible(Objs[N],True);
			SetObjectRecordsCollisions(Objs[N],True);
			
			GetGameTimer(@ObjsStartTimes[N]);
			GetGameTimer(@LastTime);

		  end;
		end;
		//SetPlayerInvincible(PlayerId, True);
		//SetPlayerNeverGetsTired(PlayerId, True);
		//SetPoliceIgnorePlayer(PlayerId, True);

		if KeyPressed(Ord('N')) then
		begin
		  ptfx:=StartPtfxOnPedBone('exp_trespass_mid', PlayerChar, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 1205, 1065353216);
		  Wait(5000);
		  StopPtfx(ptfx);
		end;

		if KeyPressed(Ord('K')) then
		begin
		  SpawnCar('sanchez');
		end;
		if KeyPressed(Ord('J')) then
		begin
		  SpawnCar('mule');
		end;
		{if KeyPressed(Ord('M')) then
		begin
		  GetPedBonePosition(PlayerChar,1232,0.42,0.05,-0.15,@BonePos);
		  CreateObject(GetHashKey('w_grenade'),BonePos.X,BonePos.Y,BonePos.Z,@Obj,True);
		  ShowText(fts(X));
		  SetObjectCollision(Obj,False);
		end;}

		if IsCharInAnyCar(PlayerChar) then
		begin
		  StoreCarCharIsInNoSave(PlayerChar, @PlayerCar);
		  while IsPlayerPlaying(PlayerId) and IsCharInCar(PlayerChar, PlayerCar) do
		  begin
			if KeyPressed(Ord('J')) and (SCurTime-SLastTime<200) then
			begin
			  ApplyForceToCar(PlayerCar,1,0.0,0.0,1.0,0.0,2.0,0.0,1,1,1,1);
			  //Wait(90);
			  //ApplyForceToCar(PlayerCar,1,0.0,0.0,1.0,0.0,1.0,0.0,1,1,1,1);
			end;
			if KeyPressed(VK_SHIFT) and (SCurTime-SLastTime<200) then
			begin
			  ApplyForceToCar(PlayerCar,1,0.0,1.0,0.0,0.0,0.0,0.0,1,1,1,1);
			  //Wait(90);
			  //ApplyForceToCar(PlayerCar,1,0.0,0.0,1.0,0.0,1.0,0.0,1,1,1,1);
			end;

			//ShowText(FTS(UpperForce),100);
			{TODO:Сделать мод езденья по стенам и узнать назначение остальных параметров}
			GetGameTimer(@SCurTime);
			if not IsCarInAirProper(PlayerCar) then
			begin
			  GetGameTimer(@SLastTime);
			end;
			ShowText(IntToStr(SCurTime-SLastTime),100);
			if SCurTime-SLastTime<500 then
			begin
			  ApplyForceToCar(PlayerCar,1,0.0,0.0,UpperForce,0.0,0.0,0.0,1,0,1,1);
			  ApplyForceToCar(PlayerCar,1,0.0,0.0,-UpperForce,0.0,0.0,0.0,1,1,1,1);
			end;
			Wait(25);
		  end;
		end;
	  end;
	end;
	Wait(50);
  end;
  except
	on E: Exception do
	begin

	  Windows.Beep(100, 100);
	  Windows.Beep(1600, 100);
	  Windows.Beep(100, 100);
	  Windows.Beep(1600, 100);
	  Windows.Beep(100, 100);
	  Windows.Beep(1600, 100);

	  ShowText('-------------------------------',0);
	  ShowText('или в крайнем случае на ящик VcSaJen@ya.ru',0);
	  ShowText('Пожалуйста сообщите эти данные автору в темке RaCon на [url="http://forums.gtamodding.ru/',0);"]http://forums.gtamodding.ru/',0);[/url]

	  ShowText('Адрес: '+IntToHex(Integer(ExceptAddr),8),0);
	  ShowText('Адрес Main: '+IntToHex(Integer(@main),8),0);

	  VirtualQuery(ExceptAddr, MemInfo, SizeOf(MemInfo));
	  if (MemInfo.State = MEM_COMMIT) and
		 (GetModuleFileName(THandle(MemInfo.AllocationBase), ModName, SizeOf(ModName)) <> 0) then
	  begin
		S:=ModName;
		Delete(S, Pos(GetCurrentDir,S), Length(GetCurrentDir)+1);
		//ShowText('Локальный адрес Base: '+IntToHex(Integer(ExceptAddr)-Integer(MemInfo.BaseAddress),8),0);
		ShowText('Локальный адрес: '+IntToHex(Integer(ExceptAddr)-(Integer(MemInfo.AllocationBase)+$1000),8),0);
		//ShowText('Base: '+IntToHex(Integer(MemInfo.BaseAddress),8),0);
		ShowText('Allocation base: '+IntToHex(Integer(MemInfo.AllocationBase),8),0);
		ShowText('Модуль: '+S,0);
	  end
	  else begin

	  end;

	  ShowText(E.Message,0);
	  ShowText('Класс: '+E.ClassName,0);
	  ShowText('-------------------------------',0);
	  ShowText('  Информация об ошибке:',0);
	  ShowText('-------------------------------',0);

	  AddNextMessageToPreviousBriefs(False);
	  ShowText('В RaCon возникла ошибка. Перепишите информацию об ошибке и перезагрузите игру.',5000);

	  Wait(5000);
	  {'~r~'+E.ClassName+': '+E.Message}
	  AddNextMessageToPreviousBriefs(False);
	  ShowText('Информацию об ошибке смотрите в "Истории" (Briefs) в меню (2-й пункт, сразу после "Карты").',60000);
	  //Clipboard.AsText:=E.Message;
	  Exit;
	end;
  end;
end;

exports main;

end.

Прикрепленные файлы

•  StickyAndGrenade.ext.rar   160.87К   9 загрузок

Сообщение отредактировал VcSaJen: 21 January 2011 - 14:17

[Chipsman]

блин, надо побыстрее дописывать маппер и со скриптингом разбираться у меня уже как минимум несколько идей родилось и еще вопрос, а нормальные миссии со стартом, концом, и сохранением/загрузкой результатов через Alice можно писать или нет?

[VcSaJen]

и еще вопрос, а нормальные миссии со стартом, концом, и сохранением/загрузкой результатов через Alice можно писать или нет?

Нормальные миссии в Alice можно писать, только наполовину:
1) Есть проблема с флагом миссии: SetMissionFlag только включает режим миссии, но не выключает, а также это только визуально действует, а реально можно во время миссии сохраниться или запустить другую SCO миссию. Видимо, за реальный флаг миссий отвечает какая-то глобальная переменная, но я перепробовал много переменных, не получилось.
2) Есть проблема с дублированием маркеров миссии: при перезагрузке игры маркер будет создаваться заново.
3) DrawSprite не работает
4) Сохранение результатов миссии - тоже проблема, ведь в Alice нет Cleo-сохранений и нет Cleo-переменных. Теоретически можно для этого использовать неиспользуемые глобальные переменные SCO, но практически этого я не пробовал.
5) Отправку SMS реализовать по-видимому очень сложно, т.к. в sco это делается вручную процедурой

В остальном, можно создавать полноценные миссии, вот шаблон:

uses
  ScriptNatives,
  ScriptTypes,
  ScriptUseful,
  SysUtils;

type
  EPlayerDead=class(Exception);

{...}

procedure Mission;
  procedure Wait(Time: Cardinal);
  var t1,t2: Cardinal; t: integer;
  begin
	if Time<60 then
	begin
	  ScriptNatives.Wait(Time);
	  if not IsPlayerPlaying(playerId) then
	  begin
		raise EPlayerDead.Create('Player dead or arrested!');
	  end;
	  Exit;
	end;

	GetGameTimer(@t1);
	t:=0;
	while Cardinal(Abs(t))<Time do
	begin
	  ScriptNatives.Wait(1);
	  GetGameTimer(@t2);
	  t:=t2-t1;
	  if not IsPlayerPlaying(playerId) then
	  begin
		raise EPlayerDead.Create('Player dead or arrested!');
	  end;
	end;
  end;

begin
  try
	try
	  {...Здесь пишем код миссии...}
	  
	  
	finally
	  {Очистка}
	end;
  except
	on EPlayerDead do
	begin
	  {Действия при провале}
	  Exit;
	end;
  end;
end;

{...}

Вопрос: Нумерация глобальных переменных меняется с каждым патчем?

Очень много проектов для скриптинга: DHook,Alice,C4,и др. и ни одного доделанного...
DelphiHook, основанный на C++ Script Hook 0.5.1, с поддеркой русских патчей и нормальным объявлением списка native-функций было бы здорово, если бы кто нибудь его выпустил.

Сообщение отредактировал VcSaJen: 23 January 2011 - 00:25