R0b0t1
2007-08-16 18:53:18
Well, at least test this as soon as SRL is fixed :p.
Yep… My interesting procedures.
Remember you need to run my R0bGetPickColor function before you attempt to run the R0bFindPickHead function.
DDTM:
Function to get the pick color:
Pick head finding procedure:
Note that you can remake the DDTM anytime and the color will still be in the variable, AS LONG AS IT HAS NOT CHANGED (Meaning the mainpoint DTM color will be as you left it).
If you want to test it, try it with a normal pick on the ground. Remember to edit out the "else" parts of the if statements, as you won't be able to test it completely.
Yep… My interesting procedures.
Remember you need to run my R0bGetPickColor function before you attempt to run the R0bFindPickHead function.
DDTM:
Var MPHDTMTol, PHDTMTol, MPHDTMColor, PHDTMColor, PHDTMSize: Integer;
Var PickHeadMP: TDTMPointDef;
Var PickHeadSP: Array[0..4] of TDTMPointDef;
Var PickHeadSkele: TDTM;
Var r0bPickDTM: Integer;
Procedure MakePickHeadDDTM;
begin;
MPHDTMTol:= 255;
PHDTMTol:= 5;
MPHDTMColor:= 3680034;
PHDTMColor:= 65536;
PHDTMSize:= 1;
PickHeadMP.x:= 29;
PickHeadMP.y:= 16;
PickHeadMP.AreaSize:= 1;
PickHeadMP.AreaShape:= 0;
PickHeadMP.Color:= MPHDTMColor;
PickHeadMP.Tolerance:= MPHDTMTol;
PickHeadSP[0].x:= 14;
PickHeadSP[0].y:= 19;
PickHeadSP[0].AreaSize:= PHDTMSize;
PickHeadSP[0].AreaShape:= 0;
PickHeadSP[0].Color:= PHDTMColor;
PickHeadSP[0].Tolerance:= PHDTMTol;
PickHeadSP[1].x:= 28;
PickHeadSP[1].y:= 14;
PickHeadSP[1].AreaSize:= PHDTMSize;
PickHeadSP[1].AreaShape:= 0;
PickHeadSP[1].Color:= PHDTMColor;
PickHeadSP[1].Tolerance:= PHDTMTol;
PickHeadSP[2].x:= 31;
PickHeadSP[2].y:= 14;
PickHeadSP[2].AreaSize:= PHDTMSize;
PickHeadSP[2].AreaShape:= 0;
PickHeadSP[2].Color:= PHDTMColor;
PickHeadSP[2].Tolerance:= PHDTMTol;
PickHeadSP[3].x:= 42;
PickHeadSP[3].y:= 25;
PickHeadSP[3].AreaSize:= PHDTMSize;
PickHeadSP[3].AreaShape:= 0;
PickHeadSP[3].Color:= PHDTMColor;
PickHeadSP[3].Tolerance:= PHDTMTol;
PickHeadSP[4].x:= 24;
PickHeadSP[4].y:= 20;
PickHeadSP[4].AreaSize:= PHDTMSize;
PickHeadSP[4].AreaShape:= 0;
PickHeadSP[4].Color:= PHDTMColor;
PickHeadSP[4].Tolerance:= PHDTMTol;
PickHeadSkele.MainPoint:= PickHeadMP;
PickHeadSkele.SubPoints:= PickHeadSP;
r0bPickDTM:= AddDTM(PickHeadSkele);
end;
Function to get the pick color:
Function R0bGetPickColor(Var PickColHolder:Integer; SetDTMNewCol: Boolean): Boolean;
Var I, XDTM, YDTM: Integer;
begin;
If not (FindDTM(r0bPickDTM, XDTM, YDTM, MIX1, MIY1, MIX2, MIY2)) Then
begin;
For I:=0 to 6 do
begin;
MakePickHeadDDTM;
PHDTMSize:= PHDTMSize + 1;
PHDTMTol:= PHDTMTol + 5;
FindDTM(r0bPickDTM, XDTM, YDTM, MIX1, MIY1, MIX2, MIY2);
If (I = 6) Then
Result:= False;
end;
end;
PHDTMSize:= 1;
PHDTMTol:= 10;
PickColHolder:= GetColor(XDTM, YDTM);
Result:= True;
If (SetDTMNewCol) Then
begin;
PickHeadMP.Color:= PickColHolder;
PickHeadMP.Tolerance:= PHDTMTol;
end;
If not (Result) Then
WriteLn('Pick not found');
FreeDTM(r0bPickDTM);
end;
Pick head finding procedure:
Function R0bFindPickHead(Var r0bPickCol: Integer): Boolean; //Input pick color.
Var I, B, C, PX, PY, x1, x2, y1, y2:Integer; //Same as used in above func.
Var LoopCount, r0bPickHeadColor, r0bPickHandle: Integer;
Var FoundHead, BreakLoop, Dropped: Boolean;
begin;
MakePickHeadDDTM;
r0bPickHandle:= DTMFromString('78DA63B461606038CE8002C4045918FE03694' +
'620FE0F048C0E40C61E0634C0C8C00A5503E6390189FD44A8D94B' +
'408D3990B84A408D2990B8885F0D00A6FC0B62');
r0bPickHead:= DTMFromString('78DA63CC63606038CA80028C8C5219FE03694' +
'620FE0F048C3940C6610634C0C8C00A5503E61503899304D49400' +
'893D04D42412360700DC550BDF');
For I:=0 to 6 do
begin;
Case I of
1: LoopCount:= 1;
2: LoopCount:= 2;
3: LoopCount:= 3;
4: LoopCount:= 4;
5: LoopCount:= 5;
end;
PX:= MSCX;
PY:= MSCY;
For B:=0 to 6 do
begin;
Case B of //Case by WT-Fakawi. I changed the letter :p
1: begin x1:= MSx1; y1 := MSy1 + 20; x2 := MSCx; y2:= MSCy; end;
2: begin x1:= MSCx; y1 := MSy1 + 20; x2 := MSx2; y2:= MSCy; end;
3: begin x1:= MSx1; y1 := MSCy; x2 := MSCx; y2:= MSy2; end;
4: begin x1:= MSCx; y1 := MSCy; x2 := MSx2; y2:= MSy2; end;
5: begin x1:= MSCx - 50; y1 := MSCy - 50; x2 := MSCx + 50; y2:= MSCy + 50; end;
6: begin x1:= MSx1; y1 := MSy1 + 20; x2 := MSx2; y2:= MSy2; end;
end;
For C:=0 to 10 do
begin;
BreakLoop:= FindColorSpiralTolerance(PX, PY, r0bPickCol, x1, y1, x2, y2, C);
If (BreakLoop) Then
Break;
end;
If not (BreakLoop) Then //If it doesn't find the pick color in the part
Continue; //of the MainScreen (above case) it goes to the
If BreakLoop Then //next loop.
begin;
Mouse(PX, PY, 1, 1, False);
Wait(500+Random(150));
If (ChooseOption(x, y, 'ake') Then
begin;
FFlag(0);
Wait(3000+Random(500));
FoundHead:= True;
Break;
end else
begin;
WriteLn('Did not find ''take'' option');
Result:= False;
Exit;
end;
end;
If (FoundHead) Then
Break;
end;
If (FoundHead) Then
Break;
end;
If (FoundHead) Then
begin;
WriteLn('Found Head, Attaching...');
If not (GameTab(4)) Then
GameTab(4);
Wait(300+Random(200));
If (InvFull) Then
begin;
MouseItem(10+Random(5), False);
Wait(500+Random(200));
ChooseOption(x, y, 'rop');
Dropped:= True;
end;
end;
If (FindDTM(r0bPickHandle, PX, PY, MIX1, MIY1, MIX2, MIY2) Then
begin;
Mouse(PX, PY, 1, 1, False);
ChooseOption(x, y, 'se');
If (FindDTM(r0bPickHead, PX, PY, MIX1, MIY1, MIX2, MIY2)) Then
Mouse(PX, PY, 2, 2, True);
end else
begin;
WriteLn('Pick head not found in inventory');
Exit;
end;
end else
begin;
WriteLn('Pick Handle not found in inventory');
Exit;
end;
If (Dropped) and (EquipPick) Then
begin;
If not (FindDTM(r0bPickDTM, PX, PY, MIX1, MIY1, MIX2, MIY2)) Then
begin;
WriteLn('Problem locating finished pick');
Exit;
end;
Mouse(PX, PY, 3, 3, True);
WriteLn('We have attached the head.');
WriteLn('But we have dropped an item.');
WriteLn('Sorry. :)');
end;
end;
FreeDTM(r0bPickHandle);
FreeDTM(r0bPickHead);
FreeDTM(r0bPickDTM);
end;
Note that you can remake the DDTM anytime and the color will still be in the variable, AS LONG AS IT HAS NOT CHANGED (Meaning the mainpoint DTM color will be as you left it).
If you want to test it, try it with a normal pick on the ground. Remember to edit out the "else" parts of the if statements, as you won't be able to test it completely.