Stack

ParadoX · Post by **ParadoX** » 17.05.2005 13:27

первое что приходит в голову от такого щастья это стак )

procedure stack(tpe : word);
begin
findtype(tpe,backpack);
if findCount>0 then DragItem(finditem, 0);

findtype(tpe,ground);
if findCount>0 then DropItem(finditem,0,0,0);
end;

ну это самый простенький.. без проверок на заполненость кучки.. как нить напишу еще..

вот также стрижка овец..

Code: Select all

program Ovtca;

var i,count : integer;

procedure Hungry(NeededLevel : Integer); 
var HArray : array [0..10] of String; 
    CurrentLevel : Integer; 
    HasError : Boolean; 
    TimeSayHungry : TDateTime; 
    FoodID : Cardinal; 
    i,c,difference : Integer; 
begin 
findtype($097B,0);
FoodID := FindItem; {You must SET FoodID!} 
if (NeededLevel < 0) or (NeededLevel > 10) then Exit; 
   HArray[0] := 'You are absolutely stuffed!'; 
   HArray[1] := 'You are stuffed'; 
   HArray[2] := 'hungry at all'; 
   HArray[3] := 'You are a little hungry'; 
   HArray[4] := 'You are somewhat hungry'; 
   HArray[5] := 'You are REALLY hungry'; 
   HArray[6] := 'Your stomash hurts'; 
   HArray[7] := 'Your stomash hurts and you feel dizzy'; 
   HArray[8] := 'You are starving'; 
   HArray[9] := 'You are almost dying of hunger'; 
   HArray[10] := 'You are DYING of hunger...'; 
HasError := true; 
TimeSayHungry := Now; 
UOSay('.hungry'); 
wait(100); 
i:=0; 
while i < 100 do 
   begin 
   for c := 0 to 10 do 
   	if InJournalBetweenTimes(HArray[c],TimeSayHungry,Now) >= 0 then 
   	begin 
   	CurrentLevel := c; 
   	HasError := false; 
   	i := 100; 
   	end; 
   	wait(100); 
   	i := i + 1; 
   	end; 
if HasError then 
   begin 
   AddToSystemJournal('Error with Hungry: Lag? No connect? Something else?'); 
   Exit; 
   end; 
difference := CurrentLevel - NeededLevel; 
if difference > 0 then for i := 1 to difference do 
   begin 
   UseObject(FoodID); 
   wait(2000); 
   end; 
end; 
 

procedure IsCurMessages;
var D : TDateTime; 
begin 
{5 minutes in DateTime = 5 / 1440 = 0.00347} 
D := Now - (0.00347);
InJournalBetweenTimes(CharName + ': I am already performing another action.',D,Now); 

if LineCount > 5 then 
   begin 
   AddToSystemJournal('Error with target. Disconnected'); 
   Disconnect; 
   end; 

end;                                   



procedure stack(tpe : word);
begin
findtype(tpe,backpack);
if findCount>0 then DragItem(finditem, 0);
AddToSystemJournal(IntToStr(findcount));

findtype(tpe,ground);
if findCount>0 then DropItem(finditem,0,0,0);
AddToSystemJournal(IntToStr(findcount));
end;







begin
SetARStatus(true);
while True do
begin


findtype($00CF,0);

while findcount>0 do
begin
	findtype($00CF,0);
	WaitTargetObject(finditem);
	useobject($795D7688);
	wait(5000);
end;

stack($0DF8);
wait(300000);
	IsCurMessages;
	hungry(0);
end;
End.

Miralex · Post by **Miralex** » 17.05.2005 13:47

procedure stack(tpe : word);
begin
findtype(tpe,backpack);
if findCount>0 then DragItem(finditem, 0);

findtype(tpe,ground);
if findCount>0 then DropItem(finditem,0,0,0);
end;

Код неверный и содержит грубые ошибки.
Ф-ции DragItem и DropItem предназначены в основном только для выполнения каких либо действий с айтимом в руках (на "пальце").

Используй MoveItem ... смотри примеры в папке Demo.

ParadoX · Post by **ParadoX** » 17.05.2005 15:00

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

вот скажи чтобы переместить итем нужно всетаки его сначала взять и потом положить...

ParadoX · Post by **ParadoX** » 17.05.2005 15:08

я же сказал... пока этот хорошо работает... будет время сделаю класный.. а именно переведу это

Code: Select all

Sub Main()
Stack('0x097B')
end sub


sub ggglol(type)
var Gitem
UO.FindType(type,-1,'ground')
while UO.findcount()
UO.FindType(type,-1,'ground')
GItem=UO.GetSerial('finditem') 	
If UO.GetQuantity(GItem)==60000 then 
uo.ignore(Gitem)  
else
return Gitem
endif
WEnd
return 0
end sub




sub stack(type) 
var PackItem, GroundItem

###############################
UO.Findtype(type,-1,'backpack') 
If UO.FindCount() then 
PackItem=UO.GetSerial('finditem')
end if

###############################

GroundItem=ggglol(type)

###############################

uo.print(packitem)
uo.print(grounditem)

	if PackItem< and GroundItem then
			UO.MoveItem(PackItem,Str(60000-UO.GetQuantity(GroundItem)),GroundItem,'0','0','0')
		else
			UO.drophere(Packitem)
			uo.print('ggg')
	endif
###############################
end sub

на паскаль + дополю стакк по цвету.. только разберусь с уроками )

Miralex · Post by **Miralex** » 17.05.2005 15:38

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

DragItem и DropItem - две взаимосвязанные комманды. Они всегда должны работать в паре. В твоем случае есть варианты когда эта пара разрывается и приведет к нежелательным последствиям.

вот скажи чтобы переместить итем нужно всетаки его сначала взять и потом положить...

Да. Именно. Причем если взял - не забыть положить. А чтобы этим делом не морочить голову - существует команда MoveItem, которая сама за тебя все просчитает.

я же сказал... пока этот хорошо работает...

"Пока" не считается.
Код хорошо работает, когда он рабочий во всех ситуациях.
Вот ты щас уберешь вещи с пола и будешь говорить почему скрипт пишет i am already doing something else.
Отвечу тебе заранее:
Потому, что нельзя использовать что-то, когда какая-то вешь в руках.

ParadoX · Post by **ParadoX** » 17.05.2005 16:22

а на сфере она сама падает ) ладно так и быть уговорил ) я тебе хотел съекономить целых 2 переменных! )

вопщем кука готова.. выложу ща

Code: Select all

procedure stack(tpe : word);
var g,p : cardinal;

begin
findtype(tpe,backpack);
if findCount>0 then p:=finditem;


findtype(tpe,ground);
if findCount>0 then g:=finditem;

if (g<>0) and (p<>0) then moveitem(p, 0, g, 0,0,0);
end;

ParadoX · Post by **ParadoX** » 18.05.2005 17:56

Code: Select all

procedure stack(SType : word);
var pID : cardinal;
    pC  : word;
    pQ  : integer;
    label start;

begin
start:
 while (findtype(SType,backpack)<>0) do
  begin
  pID:=finditem;
  pQ :=findquantity;
  pC :=GetColor(finditem);
     while (FindTypeEx(SType, pC, ground, false)<>0) do
        begin
        if (FindQuantity<60000) then
          begin
            if (pQ<FindQuantity)then  MoveItem(pID,0,finditem,0,0,0)
            else MoveItem(pID, 60000-FindQuantity, finditem, 0,0,0)	
          end
        else Ignore(finditem);
	goto start;
        end;
  MoveItem(pID,0,ground,0,0,0);
  wait(500);
  end;

end;





begin
ignorereset;
stack($097B);
End.

вот почему то ругается
21:51:44: Compiler: [Error] (23:12): Invalid jump

Miralex · Post by **Miralex** » 18.05.2005 18:26

Нельзя выпрыгивать из цикла командой goto.

Вообще использование goto - плохой стиль программирования.

ParadoX · Post by **ParadoX** » 18.05.2005 20:08

почему не работает ">=" и "=<" а вапще в учеебнаке K & R так и описано что через два цикла можно выпрыгнуть только гото... кароче я понял как я протупил... вот вроде вполне работающий скрипт

Code: Select all

procedure stack(SType : word);
var pID : cardinal;
    pC  : word;
    pQ  : integer;

begin
 while (findtype(SType,backpack)<>0) do
  begin
  pID:=finditem;
  pQ :=findquantity;
  pC :=GetColor(finditem);
     if (FindTypeEx(SType, pC, ground, false)<>0) then
        begin
        if (FindQuantity<>60000) then
        begin
         	 if (pQ<FindQuantity)then  MoveItem(pID,0,finditem,0,0,0)
         	 else MoveItem(pID, 60000-FindQuantity, finditem, 0,0,0)	
         	 end
        	 else Ignore(finditem);
        end
	begin
		Ignore(finditem);
		MoveItem(pID,0,ground,0,0,0);
	end;

  wait(500);
  end;

end;





begin
ignorereset;
stack($097B);
End.

home api manuals about Forum

Stack

Stack

грусно не работает goto