Forum in READ ONLY mode! All questions and discussions on Discord official server, invite link: https://discord.gg/VxsGzJ7

Простенькие скрипты в помощь кладоискателям

Only working scripts
Post Reply
Gauhar
Novice
Novice
Posts: 87
Joined: 08.07.2008 17:40

Простенькие скрипты в помощь кладоискателям

Post by Gauhar »

Code: Select all

{###############################################################
 # Author: Gauhar                                              #
 # Script: Treasure Hunter (lite).sc                           #
 # Stealth Client: v6.+ (http://stealth.od.ua/forum/)          #
 # Shard:                                                      #
 # Server: RunUO                                               #
 # UO Client: v7.0.23.1                                        #
 # ----------------------------------------------------------- #
 # ОПИСАНИЕ:                                                   #
 # Показывает на карте Stealth'а координаты и напрвление для   #
 # последней открытой карты сокровищ. Точность +/- 1 тайл.     #
 ###############################################################}


PROGRAM TreasureHunter;

CONST
   { РАСТОЯНИЕ ДО КЛАДА ПРИ КОТОРОМ ВКЛЮЧИТЬ ПОДСКАЗКИ КУДА ИДТИ: }
   distanceForTips = 10;

VAR
   idMap: Cardinal;
   xMap, yMap: Integer;
   xTreasure, yTreasure: Integer;
   idText, idLine: Cardinal;
   xSelf, ySelf: Integer;


Procedure Navigator(X, Y: Integer);
Var
   XS, YS, D: Integer;
   AC, BC: Integer;
   AB, cosBAC: Double;
Begin
   XS := GetX(Self);
   YS := GetY(Self);
   D := Dist(XS, YS, X, Y);
   if D = 0 then
   begin
      ClientPrint('Вы на месте!');
      EXIT;
   end;

   AC := XS - X;
   BC := YS - Y;
   AB := sqrt(AC*AC + BC*BC);
   cosBAC := abs(AC) / AB;

   if cosBAC > 0.92388 then   //0.0° .. 22.5°
   begin
      if ((AC >= 0) and (BC < 0)) or ((AC > 0) and (BC >= 0)) then
         ClientPrint('Растояние ' + IntTostr(D) + ' на Запад.')
      else
      if ((AC < 0) and (BC <= 0)) or ((AC <= 0) and (BC > 0)) then
         ClientPrint('Растояние ' + IntTostr(D) + ' на Восток.');
   end
   else
   if cosBAC > 0.38268 then   //22.5° .. 67.5°
   begin
      if (AC >= 0) and (BC < 0) then
         ClientPrint('Растояние ' + IntTostr(D) + ' на Юго-Запад.')
      else
      if (AC < 0) and (BC <= 0) then
         ClientPrint('Растояние ' + IntTostr(D) + ' на Юго-Восток.')
      else
      if (AC <= 0) and (BC > 0) then
         ClientPrint('Растояние ' + IntTostr(D) + ' на Северо-Восток')
      else
      if (AC > 0) and (BC >= 0) then
         ClientPrint('Растояние ' + IntTostr(D) + ' на Северо-Запад.');
   end
   else   //67.5° .. 90.0°
   begin
      if ((AC >= 0) and (BC < 0)) or ((AC < 0) and (BC <= 0)) then
         ClientPrint('Растояние ' + IntTostr(D) + ' на Юг.')
      else
      if ((AC <= 0) and (BC > 0)) or ((AC > 0) and (BC >= 0)) then
         ClientPrint('Растояние ' + IntTostr(D) + ' на Север.');
   end;
End;

Procedure DrawLineToTreasure(X, Y: Integer);
Var
   Figure: TMapFigure;
Begin
   if idText <> $FFFFFFFF then RemoveFigure(idText);
   Figure.kind := fkText;
   Figure.coord := fcWorld;
   Figure.x1 := X;
   Figure.y1 := Y;
   Figure.x2 := 0;
   Figure.y2 := 0;
   Figure.brushStyle := bsSolid;   //фон: bsSolid, bsClear
   Figure.brushColor := $000000;   //цвет фона
   Figure.color := $00FF00;        //цвет текста
   Figure.text := '* ' + IntToStr(X) + ' ' + IntToStr(Y);
   idText := AddFigure(Figure);

   if idLine <> $FFFFFFFF then RemoveFigure(idLine);
   Figure.kind := fkDirection;
   Figure.coord := fcWorld;
   Figure.x1 := X;
   Figure.y1 := Y;
   Figure.x2 := 0;
   Figure.y2 := 0;
   Figure.brushStyle := bsClear;
   Figure.brushColor := $000000;
   Figure.color := $FFFF00;        //цвет линии
   Figure.text := '';
   idLine := AddFigure(Figure);
End;

Procedure eventIncomingGump(Serial, GumpID, X, Y: Cardinal);
Var
   GumpInfo: TGumpInfo;
Begin
   //Remove the Treasure Chest.
   GetGumpInfo(GetGumpsCount - 1, GumpInfo);
   if Length(GumpInfo.XmfHTMLGumpColor) > 0 then
      if GumpInfo.XmfHTMLGumpColor[0].Cliloc_id = 1048125 then
         NumGumpButton(GetGumpsCount - 1, 1);
End;

Procedure eventMapMessage(ID: Cardinal; centerX, centerY: Integer);
Var
   tooltipMap: String;
Begin
   tooltipMap := LowerCase(GetTooltip(ID));
   if Pos('treasure map', tooltipMap) > 0 then
   begin
      if Pos('completed by', tooltipMap) = 0 then
      begin
         idMap := ID
         xMap := centerX;
         yMap := centerY;
      end
      else
      begin
         idMap := 0;
      end;
   end;
End;

Procedure eventMapPin(ID: Cardinal; Action: Byte; PinID: Byte; PinX, PinY: Word);
Var
   xDif, yDif: Integer;
   wMap, hMap: Integer;
   scaleMap: Byte;
Begin
   //  Пояснение по ивенту EvMapPin.
   //EvMapPin срабатывает сразу после EvMapMessage, если на карте есть метки.
   //Ивент срабатывает столько раз сколько меток есть на карте.
   //Action = 1  - Добавяет на карту метку. (другие Action не интересны)
   //PinX и PinY - Положение метки относительно верхнего левого угла карты
   //сокровищ или карты нарисованной картографом. (в пикселях)
   if Action = 1 then
   begin
      if idMap = ID then
      begin
         //Как я определяю координаты клада?
         //Данный алгоритм опирается на информацию из дефолтных скриптов RunUO:
         //размер карты = 300х300 пикселей (также можно увидеть в журнале Stealth'a),
         //маштаб карты = 1:2.
         wMap := 300;
         hMap := 300;
         scaleMap := 2;
         //Разница между центром карты и координатами метки клада (в пикселях):
         xDif := wMap/2 - PinX;
         yDif := hMap/2 - PinY;
         //Маштабировав результат получим разницу в мировых координатах:
         xDif := xDif * scaleMap;
         yDif := yDif * scaleMap;
         //Отняв полученный результат из координат центра карты, полученных в
         //ивенте EvMapMessage, узнаем мировые координаты клада:
         xTreasure := xMap - xDif;
         yTreasure := yMap - yDif;
         //Точность: +/- 1 тайл.

         if WorldNum < 2 then
         begin
            DrawLineToTreasure(xTreasure, yTreasure);
            ClientPrint('Координаты клада: ' + IntToStr(xTreasure) + ' ' + IntToStr(yTreasure));
            ClientPrint('Следуйте указателю на карте.');
         end
         else
         begin
            AddToSystemJournal('Вы должны находиться в мире Felucca или Trammel.');
            ClientPrint('Вы должны находиться в мире Felucca или Trammel.');
         end;
      end;
   end;
End;


BEGIN
   SetEventProc(EvIncomingGump, 'eventIncomingGump');
   SetEventProc(EvMapMessage, 'eventMapMessage');
   SetEventProc(EvMapPin, 'eventMapPin');
   ClearFigures;
   idText := $FFFFFFFF;
   idLine := $FFFFFFFF;

   while TRUE do
   begin
      if not Connected or Dead then
      begin
         while not Connected or Dead do wait(1000);
         wait(5000);
      end
      else
         wait(10);

      if (idMap > 0) and ((xSelf <> GetX(self)) or (ySelf <> GetY(Self))) then
      begin
         xSelf := GetX(Self);
         ySelf := GetY(Self);
         if Dist(xSelf, ySelf, xTreasure, yTreasure) <= distanceForTips then
            Navigator(xTreasure, yTreasure);
      end;

      if (idMap > 0) and (Pos('completed by', LowerCase(GetTooltip(idMap))) > 0) then
      begin
         ClientPrint('Вы выкопали клад!');
         idMap := 0;
         RemoveFigure(idLine);  //Если закомментировать, то метка к кладу будет удалена,
         RemoveFigure(idTExt);  //когда будет открыта карта с еще не найденными сокровищами.
      end;
   end;
END.

Code: Select all

{###############################################################
 # Author: Gauhar                                              #
 # Script: SOS Hunter (lite).sc                                #
 # Stealth Client: v4.3.6+ (http://stealth.od.ua/forum/)       #
 # Shard:                                                      #
 # Server: RunUO                                               #
 # UO Client: v7.0.23.1                                        #
 # ----------------------------------------------------------- #
 # ОПИСАНИЕ:                                                   #
 # Показывает на карте Stealth'а координаты и напрвление для   #
 # последнего открытого SOS сообщения.                         #
 ###############################################################}


PROGRAM SOSHunter;

TYPE
   TSextantData = record
      LatY, LonX, MinsY, MinsX: Integer;
      SouthY, EastX: String;
   end;
   TWorldCoordinates = record
      X, Y: Integer;
   end;


Function SextantToWorld(yLat, yMins: Integer; ySouth: String;
                        xLong, xMins: Integer; xEast: String;
                        NMap: Byte): TWorldCoordinates;
Var
   xCenter, yCenter: Integer;
   xWidth, yHeight: Integer;
   absLong, absLat: Double;
   x, y: Integer;
Begin
   xCenter := 0;
   yCenter := 0;
   if (NMap = 0) or (NMap = 1) then  //Felucca и Trammel только Britannia без Lost Lands.
   begin
      xCenter := 1323;
      yCenter := 1624;
      xWidth  := 5120;
      yHeight := 4096;
   end;
   if NMap = 2 then  //Ilshenar
   begin
      xWidth  := 2304;
      yHeight := 1600;
   end;
   if NMap = 3 then  //Malas
   begin
      xWidth  := 2560;
      yHeight := 2048;
   end;
   if NMap = 4 then  //Tokuno
   begin
      xWidth  := 1448;
      yHeight := 1448;
   end;
   if NMap = 5 then  //Ter-Mur
   begin
      xWidth  := 1280;
      yHeight := 4096;
   end;
   absLong := xLong + (xMins / 60.0);
   absLat  := yLat  + (yMins / 60.0);
   if xEast <> 'E' then
      absLong := 360.0 - absLong;
   if ySouth <> 'S' then
      absLat := 360.0 - absLat;
   x := xCenter + Trunc((absLong * xWidth) / 360.0);
   y := yCenter + Trunc((absLat * yHeight) / 360.0);
   if x < 0 then
      x := x + xWidth
   else if x >= xWidth then
      x := x - xWidth;
   if y < 0 then
      y := y + yHeight
   else if y >= yHeight then
      y := y - yHeight;
   Result.X := x;
   Result.Y := y;
End;

Function DeleteSubStr(StrWhere, SubStr: String): String;
Begin
   while pos(SubStr, StrWhere) > 0 do
      StrWhere := copy(StrWhere, 1, pos(SubStr, StrWhere) - 1) +
                  copy(StrWhere, pos(SubStr, StrWhere) + length(SubStr), length(StrWhere));
   Result := StrWhere;
End;

Function ParsingSextantCoordinates(S: String): TSextantData;
Begin
   //Примеры координат с двух разных шардов:
   //112° 19'N, 19° 20'E
   //112°19'N,19°20'E
   S := DeleteSubStr(S, ' ');
   if pos('°', S) > 0 then
   begin
      Result.LatY := StrToInt( copy(S, 1, pos('°', S) - 1) );
      Delete(S, 1, pos('°', S));
      Result.MinsY := StrToInt( copy(S, 1, pos('''', S) - 1) );
      Delete(S, 1, pos('''', S));
      Result.SouthY := copy(S, 1, 1);
      Delete(S, 1, pos(',', S));
      Result.LonX := StrToInt( copy(S, 1, pos('°', S) - 1) );
      Delete(S, 1, pos('°', S));
      Result.MinsX := StrToInt( copy(S, 1, pos('''', S) - 1) );
      Delete(S, 1, pos('''', S));
      Result.EastX := S;
   end;
End;

Function GetSextantCoordinatesFromGump(): String;
Var
   gumpInfo: TGumpInfo;
Begin
   GetGumpInfo(GetGumpsCount - 1, gumpInfo);
   if Length(gumpInfo.XmfHtmlGump) > 0 then
      if gumpInfo.XmfHtmlGump[0].Cliloc_id = 1018326 then  //Текст SOS сообщения.
         Result := gumpInfo.Text[0]  //Координаты в SOS сообщении.
      else
         Result := '';
End;

Procedure DrawDirectionToSOS(X, Y: Integer);
Var
   Figure: TMapFigure;
Begin
   Figure.kind := fkDirection;
   Figure.coord := fcWorld;
   Figure.x1 := X;
   Figure.y1 := Y;
   Figure.x2 := 0;
   Figure.y2 := 0;
   Figure.brushStyle := bsClear;
   Figure.brushColor := $000000;
   Figure.color := $FFFF00;        //цвет линии
   Figure.text := '';
   AddFigure(Figure);

   Figure.kind := fkText;
   Figure.coord := fcWorld;
   Figure.x1 := X;
   Figure.y1 := Y;
   Figure.x2 := 0;
   Figure.y2 := 0;
   Figure.brushStyle := bsSolid;   //фон: bsSolid, bsClear
   Figure.brushColor := $000000;   //цвет фона
   Figure.color := $00FF00;        //цвет текста
   Figure.text := '* ' + IntToStr(X) + ' ' + IntToStr(Y);
   AddFigure(Figure);

   ClientPrint('Координаты SOS отмечены на карте Stealth''a.');
End;

Procedure eventIncomingGump(Serial, GumpID, X, Y: Cardinal);
Var
   SextantCoordinates: String;
   WorldCoordinates: TWorldCoordinates;
   SextantData: TSextantData;
Begin
   SextantCoordinates := GetSextantCoordinatesFromGump();
   if SextantCoordinates <> '' then
   begin
      ClearFigures;
      if WorldNum < 2 then
      begin
         SextantData := ParsingSextantCoordinates(SextantCoordinates);
         with SextantData do
         begin
            WorldCoordinates := SextantToWorld(LatY, MinsY, SouthY, LonX, MinsX, EastX, WorldNum);
            AddToSystemJournal('Координаты кораблекрушения: ' +
               IntToStr(LatY) + '°' + IntToStr(MinsY) + '''' + SouthY + ',' +
               IntToStr(LonX) + '°' + IntToStr(MinsX) + '''' + EastX + '  ->  (' +
               IntToStr(WorldCoordinates.X) + ',' + IntToStr(WorldCoordinates.Y) + ')');
         end;
         DrawDirectionToSOS(WorldCoordinates.X, WorldCoordinates.Y);
      end
      else
      begin
         AddToSystemJournal('Вы должны находиться в мире Felucca или Trammel.');
         ClientPrint('Вы должны находиться в мире Felucca или Trammel.');
      end;
      CloseSimpleGump(GetGumpsCount - 1);
   end;
End;


BEGIN
   SetEventProc(EvIncomingGump, 'eventIncomingGump');
   ClearFigures;
   while TRUE do wait(100);
END.
Top
KOLBASOID
Neophyte
Neophyte
Posts: 13
Joined: 23.06.2013 15:03

Re: Простенькие скрипты в помощь кладоискателям

Post by KOLBASOID »

А на другие миры как юзать?
попробовую убрать условие ид мап. мож поможет)
Top
User avatar
Vizit0r
Developer
Developer
Posts: 3958
Joined: 24.03.2005 17:05
Contact:
Contact Vizit0r

Re: Простенькие скрипты в помощь кладоискателям

Post by Vizit0r »

ну так визуально кроме непонятного ограничения автором - все позволяет и в других мирах искать, SextantToWorld знает 5 миров.
"Пишите код так, как будто сопровождать его будет склонный к насилию психопат, который знает, где вы живете". (с) Макконнелл, "Совершенный код".
Top
Post Reply

Return to “Scripts”