[Скрипт] ТП по клику на карте

[c-lavr]

Наконец воплотил мечту в жизнь)

Скрипт на ТП по локации, в который вы находитесь (дополнения взял тут ссылка)
Работает на всех серверах, где запускается пакетик (иначе вы делаете что-то не так - пишите, решим проблему)

Команды:

Место 40 - ТП по карте (отправляем команду в чат)
тпм  - ТП "мигалка" в указанную точку (отправляем команду в чат и и указываем мышкой место на местности)
тпс  - ТП "сидя" в указанную точку (отправляем команду в чат и и указываем мышкой место на местности)
тпв  - ТП в перед на на небольшое расстояние (отправляем  команду в чат делаем пару шагов в перед)
тпн  - ТП назад на на небольшое расстояние (отправляем  команду в чат делаем пару шагов в перед)
тпп  - ТП большой прыжок (отправляем  команду в чат и делаем прыжок или пару шагов в перед)

Место - указываете на карте место с нажатым контролом
40 - задайте высоту на которой появитесь в выбранной точке (можно не указывать, по умолчанию прописывается +10 м к вашей текущей высоте)

Сам скрипт

//Script by CLAVR
var
x,y,z:single;
x1,y1,z1:single;
ps,tmp:string;
coordinat:array[0..1,0..3] of integer;
xyzh,pak: array[0..3] of integer;
packet,blick_mode,mouse_mode:byte;
blick_start,mouse_start:boolean;

procedure blick(mode:integer);
var 
i:integer;
    begin  
        if blick_start=true then 
            begin
                xyzh[0]:=readD(6);  
                xyzh[1]:=readD(10);
                xyzh[2]:=readD(14);
                xyzh[3]:=readc(18); 
                if packet=0 then
                     begin 
                        for i:=0 to 3 do coordinat[0,i]:=xyzh[i];
                        packet:=1;
                     end
                else
                    begin
                        for i:=0 to 3 do coordinat[1,i]:=xyzh[i];
                        packet:=0; 
                        case blick_mode of
                            1:
                                begin
                                    pak[0]:=coordinat[1,0]+((coordinat[1,0]-coordinat[0,0])*10);
                                    pak[1]:=coordinat[1,1]+((coordinat[1,1]-coordinat[0,1])*10);  
                                    pak[2]:=coordinat[1,2]+((coordinat[1,2]-coordinat[0,2])*10)+5000;
                                    pak[3]:=coordinat[1,3];
                                end; 
                            2:
                                begin
                                    pak[0]:=coordinat[1,0]-((coordinat[1,0]-coordinat[0,0])*10);
                                    pak[1]:=coordinat[1,1]-((coordinat[1,1]-coordinat[0,1])*10);  
                                    pak[2]:=coordinat[1,2]-((coordinat[1,2]-coordinat[0,2])*10)+5000;
                                    pak[3]:=coordinat[1,3];
                                end;
                            3:
                                begin
                                    pak[0]:=coordinat[1,0]+((coordinat[1,0]-coordinat[0,0]));
                                    pak[1]:=coordinat[1,1]+((coordinat[1,1]-coordinat[0,1]));  
                                    pak[2]:=coordinat[1,2]+((coordinat[1,2]-coordinat[0,2]))+100000;
                                    pak[3]:=coordinat[1,3];
                                end;
                        end;   
            
                        buf:=hstr('9F 00 57 5C FF ');
                        for i:=0 to 2 do writed(pak[i]);
                        writec(xyzh[3]); 
                        sendtoserver;
                        buf:=HStr('68 00 57 07 FF');
                        SendToServer;  
                        buf:='';   
                        blick_start:=false;   
                        blick_mode:=0;
            
                    end; 
             end
        else 
            begin
                blick_start:=true;
                blick_mode:=mode;
            end;  
        pck:='';   
    end;
          
    procedure mouse(mode:integer);   
    var
    i:integer;
    begin
        if mouse_start then 
            begin   
                 if Length(pck)=31 then 
                     begin   
                         xyzh[0]:=readD(20);  
                         xyzh[1]:=readD(24);
                         xyzh[2]:=readD(28);
                         xyzh[3]:=readc(18); 
                         pck:='';  
                         buf:=hstr('9F 00 57 5C FF ');
                         for i:=0 to 3 do writed(xyzh[i]);
                         writec(0); 
                         sendtoserver;
                          case mouse_mode of
                            1: buf:=HStr('68 00 57 07 FF');
                            2: buf:=HStr('C2 00 57 61 FF 04');
                          end; 
                         sendtoserver;  
                         buf:='';  
                         mouse_start:=false;   
                         mouse_mode:=0;    
                     end
                else 
                    begin
                        message('Wrong point',8);
                        mouse_mode:=0;
                    end;  
            end
            else
                begin  
                    mouse_start:=true;
                    mouse_mode:=mode;
                end;
        pck:='';        
    end;  
        
 procedure message(msg:string;chatID:byte);
    begin                             
         buf:=HStr('16 00 54 D5 FF 00 00 E3 10 37 00 '); 
         writec(chatID,6);
         WriteS('PHX');
         WriteS(msg);
         SendToClient;
    end;    



procedure GetPos;
var
i:integer;
begin
    tmp:='';
    i:=pos(' ',ps)+1;
    while (ps[i]<>' ') do
    begin
        if (ps[i]<>'.') then
            tmp:=tmp+ps[i]
        else
            tmp:=tmp+',';
        inc(i);
    end;
    x:=StrToFloat(tmp);
    tmp:='';
    i:=i+1;
    while (ps[i]<>' ') do
    begin
        if (ps[i]<>'.') then
            tmp:=tmp+ps[i]
        else
            tmp:=tmp+',';
        inc(i);
    end;
    y:=StrToFloat(tmp);
    tmp:='';
    i:=pos(']',ps)+1;
    if (i<>Length(ps)) then
        z:=z+StrToFloat(Copy(ps,i+1,Length(ps)-i));
end;

procedure SendTP;
begin
    buf:=HStr('9F 00 57 5C FF ');
    WriteN(x);
    WriteN(y);
    WriteN(z);
        SendToServer;
    buf:=HStr('68 00 57 07 FF');
        SendToServer;        
end;

begin
  if FromClient and (ReadC(1)=$B2) and (ReadC(7)=$5B) and (ReadC(9)=$70) and (ReadC(11)=$6F) and (ReadC(13)=$73) then
        begin
            ps:=ReadS(15);
            GetPos;
            SendTP;
            pck:='';
        end;
  if FromClient  then
        case pck[1] of
             #$9f: 
                 begin   
                    if blick_start then blick(0);
                    if mouse_start then mouse(0);         
                 end;
              
             #$b2:
                  case reads(7) of
                    'тпв': blick(1);
                    'тпн': blick(2);
                    'тпп': blick(3);
                    'тпм': mouse(1);
                    'тпс': mouse(2);
                  end;            
        end; 
    if FromClient and (ReadC(1)=$9F) then
        z:=ReadN(14)+10;  
end.

Тренеруемся с высотой. Не забываем открывать крылья, когда ТП сделаете - лучше полетать чем кирпичиком упасть

Для тех кто не хочет летать, а привык появляться в сидячей позе (+ этого не тратиться ХП при ТП и вы не умрёте при падении) можете в процедуре SendTP "мигалку" 68 00 57 07 FF заменить на "сесть" C2 00 57 61 FF 04

buf:=HStr('68 00 57 07 FF');

Также можите изменть высоту, которая прописана по умолчанию (находиться в самом конце скрипта):

z:=ReadN(14)+10;

Для NewAion

1. Замените все пакеты "мигалка" 68 00 57 07 FF на пакет "сесть" C2 00 57 61 FF 04. В связи с этим команды тпс и тпм станут идентичны

P.S. Выражаю огромную признательность usilok77 за помощь в написании данного скрипта. Человеку который помог закрыть мои огромные пробелы в программировании

[w00t]

Чета не работает у меня.
Когда копирую скрипт , нажимаю сохранить потом ставлю галочку а там мне красным выделяется вот это строчка

var
x,y,z:single;
x1,y1,z1:single;
ps,tmp:string;

procedure GetPos;
var
i:integer;
begin
    tmp:='';
    i:=pos(' ',ps)+1;
    while (ps[i]<>' ') do
    begin
        if (ps[i]<>'.') then
            tmp:=tmp+ps[i]
        else
            tmp:=tmp+',';
        inc(i);
    end;
    x:=StrToFloat(tmp);
    tmp:='';
    i:=i+1;
    while (ps[i]<>' ') do
    begin
        if (ps[i]<>'.') then
            tmp:=tmp+ps[i]
        else
            tmp:=tmp+',';
        inc(i);
    end;
    y:=StrToFloat(tmp);
    tmp:='';
    i:=pos(']',ps)+1;
    if (i<>Length(ps)) then
        z:=z+StrToFloat(Copy(ps,i+1,Length(ps)-i));
end;

procedure SendTP;
begin
    buf:=HStr('9F 00 57 5C FF ');
    WriteN(x);
    WriteN(y);
    WriteN(z);
        SendToServer;
    buf:=HStr('68 00 57 07 FF');
        SendToServer;        
end;

begin
    if FromClient and (ReadC(1)=$B2) and (ReadC(7)=$5B) and (ReadC(9)=$70) and (ReadC(11)=$6F) and (ReadC(13)=$73) then
        begin
            ps:=ReadS(15);
            GetPos;
            SendTP;
            pck:='';
        end;
    
    if FromClient and (ReadC(1)=$9F) then
        z:=ReadN(14)+10;    
end.

[c-lavr]

Цитата: Сообщение от w00t Чета не работает у меня. Когда копирую скрипт , нажимаю сохранить потом ставлю галочку а там мне красным выделяется вот это строчка tmp:='';

Скорее всего плохо скопировал. Набери эту строчку вручную

[Mystmuse]

На ньюшечке работает.

[c-lavr]

могу для команд в перед, назад и вверх добавить дополнительно ввод на сколько метров. Будет выглядеть так

.тпв35
где 35 - расстояние ТП.

Если будет востребовано, то сделаю

[c-lavr]

Цитата: Сообщение от ZZtop22 на неваион неработает

Работает) Мы его там и собирали)))

Добавлено через 4 минуты
Изменил команды во 2 скрипте - убрал точки
Команды в чате теперь не высвечиваются

Пересохраните скрипт.

[mrblik]

да да на юа тоже все робит спосибки поставил))

[vs23]

На нью х75 после утреннего обновления 10.03 фикс

[c-lavr]

Цитата: Сообщение от vs23 На нью х75 после утреннего обновления 10.03 фикс

Только-что проверил на нью х75.
Отключили использование отдельно "мигалки". Ставьте вместо "мигалки" пакет "сесть", как это сделать описано в теме. И будите ТП совершать сидя

[r15]

Клавруха ))) на неве не работает ((((( зайди проверь
это тебе не в панде посохом мотать

[c-lavr]

Цитата: Сообщение от r15 Клавруха ))) на неве не работает ((((( зайди проверь это тебе не в панде посохом мотать

Читайте тему до конца, там все написано для вашего сервера.
Проверил еще днем и отписался

[Mrphx]

извените за тупой вопрос но.. Как пользоватся скриптом?

[c-lavr]

Цитата: Сообщение от Mrphx извените за тупой вопрос но.. Как пользоватся скриптом?

Ставим галочку на против скрипта (его включение), а дальше используем как описано в командах. Пишете с какой командой именно у вас затруднения?

[Bruniq]

Aion-free Работает?
Кликаю место на карте, пишу 40 и моя надпись попадает прямо в чат, что не так?
Только не надо мол поставь галочку и прочее
Проверил еще пару скриптов, других всмысле, но опять же отправляется в чат.
Сервер фриха, l2phx.3.5.33.166.rar

[plain1710]

Цитата: Сообщение от Bruniq Aion-free Работает? Кликаю место на карте, пишу 40 и моя надпись попадает прямо в чат, что не так? Только не надо мол поставь галочку и прочее Проверил еще пару скриптов, других всмысле, но опять же отправляется в чат. Сервер фриха, l2phx.3.5.33.166.rar

фри работает, попробуй пх более новую поставить, у меня на 175 всё окей)