search

blackdtools / Blackd-Proxy-CLASSIC

Blackd Proxy CLASSIC
MIT License
9 stars 7 forks source link

new cavebot function: moveToCreature name #72

Closed divinity76 closed 8 years ago

divinity76 commented 8 years ago

this function allows using the cavebot to follow creatures, people, whatever, even across floors.

For instance, i want to have 4 MCs, and have the 3 others follow me automatically wherever i go. the cavebot script for the 3 MCs will just be like: moveToCreature Master gotoScriptLine 0

^ now the cavebot will follow Master wherever he goes, even across floors.

divinity76 commented 8 years ago

there is something weird about the PerformMove function, making it somewhat laggy, like, if the timer is "300 -> 700" secs, the character may wait several seconds after the target creature has moved, before it follows. this won't be "good enough" if you're using the function as a magebomb to use several characters at once to chase a target (a guy you're trying to kill, using 4 MCed palladins shooting SDs, the MCs needs to move quickly to keep up with the running target...)

here i have a hacked version of performMove, with a new optional parameter "hhbhacks", which, when enabled, makes PerformMove much more responsive.... i don't recommend adding this code, but fixing PerformMove lag would make a magebomb hunting with moveToCreature much better in pvp settings.. do you know why performMove lags? (and even with "hhbhacks", its still lags sometimes, but much less, and i don't know why)

Public Sub PerformMove(Sid As Integer, parx As Long, pary As Long, parz As Long, Optional hhbhacks As Boolean = False)
' adrXgo = &H49D070 ' goto this x
' adrYgo = &H49D06C ' goto this y
' adrGo = &H49D0DC ' start goto process
  Dim b1 As Byte
  Dim b2 As Byte
  Dim pid As Long
  Dim aRes As Long
  Dim myBpos As Long
  Dim xinc As Long
  Dim yinc As Long
  Dim sCheat As String
  Dim cPacket() As Byte
  Dim inRes As Integer
  Dim gotDestChange As Boolean
  Dim queue As String
  Dim strDebug As String
  Dim cfRes As TypeChangeFloorResult
  Dim X As Long
  Dim y As Long
  Dim z As Long
  Dim shouldBeExact As Boolean
  Dim status As Integer
  Dim completed As Boolean
  Dim iterac As Integer
  Dim awesomeStatus As Integer
  Dim tmpByte As Byte
  #If FinalMode Then
  On Error GoTo goterr
  #End If
'  Exit Sub
  status = 1
  completed = False
  'Exit Sub
  iterac = 0
  awesomeStatus = 0
  Do
  If hhbhacks Then
  ignoreNext(Sid) = 0
  'cancelAllMove(Sid) = 0
  End If

  Select Case status

Case 1
  ' initial state
  strDebug = "01"
  X = parx
  y = pary
  z = parz
  shouldBeExact = False
  pid = ProcessID(Sid)
  If pid >= 0 Then
    status = 2
  Else
    frmCavebot.lblInfo.Caption = "Error. Your pID=" & pid & " (!)"
    completed = True
  End If
Case 2
  ' there is any active exception?
  strDebug = strDebug & " > 02"
  If cancelAllMove(Sid) > GetTickCount() Then ' uh'ing ?
    status = 32
  ElseIf makingRune(Sid) = True Then ' making a rune ?
    status = 32
  ElseIf GetTickCount() < lootTimeExpire(Sid) Then ' looting ?
    status = 32
  Else
  ' ok to move
    status = 3
  End If
Case 3
  '  should reset moveretry? ?
  strDebug = strDebug & " > 03"
  If (X = lastDestX(Sid)) And (y = lastDestY(Sid)) And _
   (z = lastDestZ(Sid)) Then
    ' no
    lastAttackedIDstatus(Sid) = lastAttackedID(Sid)
    status = 4
  ElseIf (lastAttackedID(Sid) <> 0) And (lastAttackedID(Sid) = lastAttackedIDstatus(Sid)) Then
    'special no
    lastDestX(Sid) = X
    lastDestY(Sid) = y
    lastDestZ(Sid) = z
    lastAttackedIDstatus(Sid) = lastAttackedID(Sid)
    status = 4
  Else
    ' yes
    lastAttackedIDstatus(Sid) = lastAttackedID(Sid)
    status = 7
    If hhbhacks Then
    status = 4
    End If
  End If
Case 4
  ' process same destination
  strDebug = strDebug & " > 04"
  moveRetry(Sid) = moveRetry(Sid) + frmCavebot.TimerScript.Interval
  status = 5
Case 5
  ' standing in same point ?
  strDebug = strDebug & " > 05"
  If (myX(Sid) = lastX(Sid)) And (myY(Sid) = lastY(Sid)) And _
   (myZ(Sid) = lastZ(Sid)) Then
    ' yes
    status = 6
  Else
    ' no
    lastX(Sid) = myX(Sid)
    lastY(Sid) = myY(Sid)
    lastZ(Sid) = myZ(Sid)
    ' no, but attacking
    If lastAttackedID(Sid) <> 0 Then
      status = 6
    Else
      ignoreNext(Sid) = CteMoveDelay + GetTickCount()
      status = 32
      If hhbhacks Then
      status = 6
      End If
    End If
  End If
Case 6
  ' should wait because recent move order?
  strDebug = strDebug & " > 06"
  If ignoreNext(Sid) > GetTickCount() Then
    ' yes
    status = 32
    If hhbhacks Then
    status = 8
    End If
  Else
   ' no
    status = 8
  End If
Case 7
  ' process destination change
  strDebug = strDebug & " > 07"
  lastDestX(Sid) = X
  lastDestY(Sid) = y
  lastDestZ(Sid) = z
  moveRetry(Sid) = 0
  ignoreNext(Sid) = GetTickCount() - 1
  status = 32
Case 8
  ' destination is the same
  strDebug = strDebug & " > 08"
  xinc = X - myX(Sid)
  yinc = y - myY(Sid)
  If z <> myZ(Sid) Then
    ' must change floor
    status = 12
  ElseIf (moveRetry(Sid) > 10000) And (z = myZ(Sid)) And (onDepotPhase(Sid) = 2) Then
    ' must choose other depot
    status = 10
  ElseIf moveRetry(Sid) > TimeToGiveTrapAlarm Then
    ' must give trapalarm
    status = 11
  Else
    ' process move
    status = 9
  End If
Case 9
  ' attacking or not attacking?
  strDebug = strDebug & " > 09"
  If (lastAttackedID(Sid) = 0) Then
    status = 27
  Else
    status = 21
  End If
Case 10
  ' choose other depot
  strDebug = strDebug & " > 10 : Choosing other depot"
  onDepotPhase(Sid) = 0 'changed from 1 to 0 in 8.74
  If exeLine(Sid) > 0 Then
    'exeLine(Sid) = exeLine(Sid) - 1
    updateExeLine Sid, -1, True
  End If
  moveRetry(Sid) = 0
  status = 32
Case 11
  ' Trap alarm
  strDebug = strDebug & " > 11 : Trap alarm - Trying a reposition"
  If cavebotOnTrapGiveAlarm(Sid) = True Then
    If frmRunemaker.ChkDangerSound.Value = 1 Then
      If PlayTheDangerSound = False Then
        aRes = GiveGMmessage(Sid, "WARNING : YOU ARE TRAPPED !", "BlackdProxy")
        DoEvents
        aRes = SendLogSystemMessageToClient(Sid, "BlackdProxy: To deactivate alarm do Exiva cancel")
        DoEvents
      End If
      ChangePlayTheDangerSound True
    Else
      aRes = SendSystemMessageToClient(Sid, "WARNING : YOU ARE TRAPPED !")
      DoEvents
    End If
  End If
  moveRetry(Sid) = 0
  If AllowRepositionAtTrap(Sid) = 1 Then
    RepositionScriptAtTrap Sid
    DoRandomMove Sid
  End If
  status = 100
Case 12
  ' change floor
  strDebug = strDebug & " > 12"
  If z < myZ(Sid) Then
    cfRes = PerformMoveUp(Sid, X, y, z)
  Else
    cfRes = PerformMoveDown(Sid, X, y, z)
  End If
  'myres.result=0 req_wait
  'myres.result=1 req_move
  'myres.result=2 req_click
  'myres.result=3 req_shovel
  'myres.result=4 req_rope
  'myres.result=5 req_random_move
  'myres.result>&H60 req_force_move
  Select Case cfRes.result
  Case &H0
    status = 32
  Case &H1
    status = 13
  Case &H2
    status = 14
  Case &H3
    status = 15
  Case &H4
    status = 16
  Case &H5
    status = 33
  Case Else
    status = 34
  End Select
Case 13
  strDebug = strDebug & " > 13"
  X = cfRes.X
  y = cfRes.y
  z = cfRes.z
  shouldBeExact = True
  status = 8
Case 14
  If ((Abs(cfRes.X - myX(Sid)) > 1) Or (Abs(cfRes.y - myY(Sid)))) > 1 Then
    strDebug = strDebug & " > 14 : Right Click required move"
    X = cfRes.X
    y = cfRes.y
    z = cfRes.z
    shouldBeExact = False
    status = 9
  Else
    strDebug = strDebug & " > 14 : Doing right click"
    PerformUseItem Sid, cfRes.X, cfRes.y, cfRes.z
    ignoreNext(Sid) = GetTickCount() + CteMoveDelay
    status = 100
  End If
Case 15
  If ((Abs(cfRes.X - myX(Sid)) > 1) Or (Abs(cfRes.y - myY(Sid)))) > 1 Then
    strDebug = strDebug & " > 14 : Shovel required move"
    X = cfRes.X
    y = cfRes.y
    z = cfRes.z
    shouldBeExact = False
    status = 9
  Else
    strDebug = strDebug & " > 15"
    aRes = PerformUseMyItem(Sid, LowByteOfLong(tileID_Shovel), HighByteOfLong(tileID_Shovel), cfRes.X, cfRes.y, cfRes.z, True, True)
    If aRes = 0 Then
      status = 18
    Else
        aRes = PerformUseMyItem(Sid, LowByteOfLong(tileID_LightShovel), HighByteOfLong(tileID_LightShovel), cfRes.X, cfRes.y, cfRes.z, , True)
        If aRes = 0 Then
          status = 18
        Else
          status = 17
        End If
    End If

  End If
Case 16
  If ((Abs(cfRes.X - myX(Sid)) > 1) Or (Abs(cfRes.y - myY(Sid)))) > 1 Then
    strDebug = strDebug & " > 16 : Rope required move"
    X = cfRes.X
    y = cfRes.y
    z = cfRes.z
    shouldBeExact = False
    status = 9
  Else
    strDebug = strDebug & " > 16"
    aRes = PerformUseMyItem(Sid, LowByteOfLong(tileID_Rope), HighByteOfLong(tileID_Rope), cfRes.X, cfRes.y, cfRes.z)
    If aRes = 0 Then
      status = 20
    Else
      aRes = PerformUseMyItem(Sid, LowByteOfLong(tileID_LightRope), HighByteOfLong(tileID_LightRope), cfRes.X, cfRes.y, cfRes.z)
      If aRes = 0 Then
        status = 20
      Else
        status = 19
      End If
    End If
  End If
Case 17
  ' Trap alarm
  strDebug = strDebug & " > 17 : Trap alarm - No shovel"
  If frmRunemaker.ChkDangerSound.Value = 1 Then
    If PlayTheDangerSound = False Then
      aRes = GiveGMmessage(Sid, "WARNING : YOU ARE TRAPPED ! (No shovel)", "BlackdProxy")
      DoEvents
      aRes = SendLogSystemMessageToClient(Sid, "BlackdProxy: To deactivate alarm do Exiva cancel")
      DoEvents
    End If
    ChangePlayTheDangerSound True
  Else
    aRes = SendSystemMessageToClient(Sid, "WARNING : YOU ARE TRAPPED ! (No shovel)")
    DoEvents
  End If
  moveRetry(Sid) = 0
  status = 100
Case 18
  strDebug = strDebug & " > 18 : Using shovel"
  ignoreNext(Sid) = GetTickCount() + CteMoveDelay
  status = 100
Case 19
  ' Trap alarm
  strDebug = strDebug & " > 19 : Trap alarm - No rope"
  If frmRunemaker.ChkDangerSound.Value = 1 Then
    If PlayTheDangerSound = False Then
      aRes = GiveGMmessage(Sid, "WARNING : YOU ARE TRAPPED ! (No rope)", "BlackdProxy")
      DoEvents
      aRes = SendLogSystemMessageToClient(Sid, "BlackdProxy: To deactivate alarm do Exiva cancel")
      DoEvents
    End If
    ChangePlayTheDangerSound True
  Else
    aRes = SendSystemMessageToClient(Sid, "WARNING : YOU ARE TRAPPED ! (No rope)")
    DoEvents
  End If
  moveRetry(Sid) = 0
  status = 100
Case 20
  strDebug = strDebug & " > 20 : Using rope"
  ignoreNext(Sid) = GetTickCount() + CteMoveDelay
  status = 100
Case 21
  ' attacking
  strDebug = strDebug & " > 21"
  If (Abs(xinc) < 2) And (Abs(yinc) < 2) Then
    moveRetry(Sid) = 0
    status = 22
  ElseIf moveRetry(Sid) < 1500 Then
    status = 24
  Else
    status = 23
  End If
Case 22
  ' close to the monster we are attacking
  strDebug = strDebug & " > 22"
  moveRetry(Sid) = 0
  status = 32
Case 23
  ' a* short move 1
  strDebug = strDebug & " > 23"
  If (xinc < 10) And (xinc > -9) And (yinc < 8) And (yinc > -7) Then
    aRes = FindBestPath(Sid, xinc, yinc, False)
    '#if can't find short best path, pick other target
    If aRes <> 0 Then
      status = 26
    Else
      status = 25
    End If
  Else
    '#if target is too far, pick other target
    status = 26
  End If
Case 24
  ' click fast move
  strDebug = strDebug & " > 24 : Doing Fast move"
  DoUnifiedClickMove Sid, X, y, z

  status = 100
Case 25
  ' A* Short move1
  strDebug = strDebug & " > 25 : Doing A*Short move"
  moveRetry(Sid) = 0
  'ignoreNext(sid) = GetTickCount() + CteMoveDelay
  status = 100
Case 26
  ' change target
  strDebug = strDebug & " > 26 : Target rejected"
  lastAttackedID(Sid) = 0
  status = 100
Case 27
  ' not attacking
  strDebug = strDebug & " > 27"
  xinc = X - myX(Sid)
  yinc = y - myY(Sid)
  If ((Abs(xinc) < 2) And (Abs(yinc) < 2)) Then
    status = 31
  ElseIf ((xinc < 10) And (xinc > -9) And (yinc < 8) And (yinc > -7)) Then
    status = 30
  ElseIf (moveRetry(Sid) < 5000) Then
    status = 24
  Else
    status = 28
  End If
Case 28
    AstarBig Sid, myX(Sid), myY(Sid), X, y, myZ(Sid), False
    If ((RequiredMoveBuffer(Sid) = "") Or (RequiredMoveBuffer(Sid) = "X")) Then
      If publicDebugMode = True Then
        aRes = SendLogSystemMessageToClient(Sid, "[Debug] Big map failed to move to " & X & "," & y & "," & z)
        DoEvents
      End If
      strDebug = strDebug & " > 28"
      status = 11
    Else
      OptimizeBuffer Sid
      ExecuteBuffer Sid
      If publicDebugMode = True Then
        aRes = SendLogSystemMessageToClient(Sid, "[Debug] Processing big map far distance move to " & X & "," & y & "," & z)
        DoEvents
      End If
      strDebug = strDebug & " > 28"
      status = 29
    End If
Case 29
  ' A* Long Move completed
  strDebug = strDebug & " > 29 : Doing A* Long Move"
  ignoreNext(Sid) = GetTickCount() + (CteMoveDelay * 2)
  ' moveRetry(sid) = 5000
  status = 100
Case 30
  ' a* short move 2
  strDebug = strDebug & " > 30"
  If (xinc < 10) And (xinc > -9) And (yinc < 8) And (yinc > -7) Then
    If shouldBeExact = True Then
      aRes = FindBestPath(Sid, xinc, yinc, False)
    Else
      aRes = FindBestPathV2(Sid, xinc, yinc, False)
    End If
    '#if can't find short best path, think alternative plan
    If aRes <> 0 Then
      If onDepotPhase(Sid) > 0 Then
        status = 10
      ElseIf lastAttackedID(Sid) <> 0 Then
        status = 24
      Else ' if not attacking, try a long path
        status = 28
      End If
    Else
      status = 35
    End If
  Else
    'try click move
    status = 24
  End If
Case 31
  ' very near move
  strDebug = strDebug & " > 31 : Doing very near move"
  tmpByte = &H0
  If xinc = -1 Then
    If yinc = -1 Then
      tmpByte = &H6D
    ElseIf yinc = 1 Then
      tmpByte = &H6C
    Else
      tmpByte = &H68
    End If
  ElseIf xinc = 1 Then
    If yinc = -1 Then
      tmpByte = &H6A
    ElseIf yinc = 1 Then
      tmpByte = &H6B
    Else
      tmpByte = &H66
    End If
  Else
    If yinc = -1 Then
      tmpByte = &H65
    ElseIf yinc = 1 Then
      tmpByte = &H67
    End If
  End If
  If tmpByte = &H0 Then
    DoManualMove Sid, tmpByte
    strDebug = strDebug & " > 31 : Waiting for floor change"
  Else
      DoManualMove Sid, tmpByte
    strDebug = strDebug & " > 31 : Doing very near move (" & GoodHex(tmpByte) & ")"
    moveRetry(Sid) = 0
    ignoreNext(Sid) = GetTickCount() + CteMoveDelay
  End If

  status = 100
Case 32
  ' end state
  strDebug = strDebug & " > 32 : Waiting..."
  If extremeDebugMode = False Then

    completed = True ' comment to log this too
  End If
  status = 100
Case 33
  strDebug = strDebug & " > 33 : Random move"
  DoRandomMove Sid
  ignoreNext(Sid) = GetTickCount() + CteMoveDelay
  status = 100
Case 34
  strDebug = strDebug & " > 34 : Force step"
  DoManualMove Sid, cfRes.result
  ignoreNext(Sid) = GetTickCount() + CteMoveDelay
  status = 100
Case 35
  ' A* Short move2
  strDebug = strDebug & " > 35 : Doing A*Short move v2"
  moveRetry(Sid) = 0
  ignoreNext(Sid) = GetTickCount() + CteMoveDelay
  status = 100
Case 100
  If publicDebugMode = True Then
    aRes = SendLogSystemMessageToClient(Sid, "[Debug] Status :" & strDebug)
    DoEvents
  End If
  completed = True
Case Else
  awesomeStatus = status
End Select
iterac = iterac + 1
If (iterac > 20) Then ' if there is no result after 20 iterations, then something is failing
  completed = True ' this avoid computer lock at least
  ' report and log the error
  If awesomeStatus = 0 Then
    LogOnFile "errors.txt", "Infinite loop detected (" & CStr(iterac) & " iterations at client " & CStr(Sid) & ") Trace : " & strDebug
    aRes = SendLogSystemMessageToClient(Sid, "Critical error on cavebot AI: Infinite loop detected. Details in errors.txt . Please report to daniel@blackdtools.com")
    DoEvents
  Else
    LogOnFile "errors.txt", "Status out of logic detected (status = " & CStr(awesomeStatus) & " at client " & CStr(Sid) & ") Trace : " & strDebug
    aRes = SendLogSystemMessageToClient(Sid, "Critical error on cavebot AI: Status out of logic detected (" & CStr(awesomeStatus) & ") Details in errors.txt . Please report to daniel@blackdtools.com")
    DoEvents
  End If
End If
Loop Until (completed = True)
  Exit Sub
goterr:
  frmMain.txtPackets.Text = frmMain.txtPackets.Text & vbCrLf & "Error during PerformMove. Number: " & Err.Number & " Description: " & Err.Description & " Source: " & Err.Source
End Sub