Chrido: New page: = Crematory macro = Copy this macro into notepad and save as "crematory.au3".

 ; ; Crematory macro by Chrido. Tuned for the crematory in my workshop. ; HotKeySet("^z", "SetPoint") H...

2009-08-20T20:57:05Z

New page: = Crematory macro = Copy this macro into notepad and save as "crematory.au3". <pre> ; ; Crematory macro by Chrido. Tuned for the crematory in my workshop. ; HotKeySet("^z", "SetPoint") H...

New page

= Crematory macro =

Copy this macro into notepad and save as "crematory.au3".

<pre>
;
; Crematory macro by Chrido. Tuned for the crematory in my workshop.
;
HotKeySet("^z", "SetPoint")
HotKeySet("^q", "Terminate")
HotKeySet("{PAUSE}", "TogglePause")

Global $Paused
Global $HOLD = 1

WinActivate("eGenesis Client")
WinWaitActive("eGenesis Client")
$size = WinGetClientSize("[active]")
$SCREEN_WIDTH = $size[0]
$SCREEN_HEIGHT = $size[1]

Opt("MouseCoordMode", 2);
Opt("PixelCoordMode", 2);
Opt("MouseClickDelay", 100)
Opt("MouseClickDragDelay", 500)
Opt("MouseClickDownDelay", 100)
Opt("SendKeyDownDelay", 100)

MouseMove($SCREEN_WIDTH / 2, $SCREEN_HEIGHT / 2);

ToolTip("Crematory - Hoover over the central button and hit Ctrl+Z", 300, 8);

While $HOLD = 1
Sleep(100)
WEnd

$pos = MouseGetPos()

$central_x = $pos[0]
$central_y = $pos[1]

ToolTip("Crematory - Press Ctrl+q to QUIT", 300, 8);

; Slider lines 0x92918F
; Slider cross 0x7b7567
; Slider dot 0x000000
; Background all RGB values above 160, red above 200
;

; Find left-most slider
$coord = PixelSearch($central_x - 140, $central_y - 60, $central_x - 80, $central_y - 60, 0x92918F, 0x10)
If @error Then
$coord = PixelSearch($central_x - 140, $central_y - 50, $central_x - 80, $central_y - 50, 0x92918F, 0x10)
EndIf

If @error Then
MsgBox(0, "Crematory", "Failed to find first slider")
Exit
EndIf

$slider_x = $coord[0]

; Find slider mid point
$coord = PixelSearch($slider_x - 3, $central_y - 120, $slider_x - 3, $central_y - 40, 0x7b7567, 0x10)

If @error Then
MsgBox(0, "Crematory", "Failed to find slider mid point")
Exit
EndIf

$slider_y = $coord[1]

; When all are black:
; 1d 2d 3d 4d 5u 6d 7u
;
; Buttons:
; 1=3u 2=2u 3=5d 4=1u,7d 5=4u,6u
;
Dim $crematory_sliders[8]
$crematory_sliders[1] = -4 ; Slider 1 goes DOWN when button 4 is black
$crematory_sliders[2] = -2 ; Slider 2 goes DOWN when button 2 is black
$crematory_sliders[3] = -1 ; Slider 3 goes DOWN when button 1 is black
$crematory_sliders[4] = -5 ; Slider 4 goes DOWN when button 5 is black
$crematory_sliders[5] = 3 ; Slider 5 goes UP when button 3 is black
$crematory_sliders[6] = -5 ; Slider 6 goes DOWN when button 6 is black
$crematory_sliders[7] = 4 ; Slider 7 goes UP when button 7 is black

; Which slider to always keep above the line
$keep_positive = 3
; Which slider to always keep below the line
$keep_negative = 2

;
; We are ready to go
;
; Algorithm is: Find the most extreme value and try to correct it
;
Dim $slider_values[8]
Dim $wanted_button_states[6]

; Wanted button states
$WHITE = -1
$DONTCARE = 0
$BLACK = 1

While True
For $i = 1 to 5
$wanted_button_states[$i] = $DONTCARE
Next

; Store current slider values
For $slider = 1 To 7
$slider_values[$slider] = GetSlider($slider)
Next

; Keep fetching the worst value until it is 0
$worst_slider = AbsMaxIndexOfArray($slider_values)
$worst_value = $slider_values[$worst_slider]

While $worst_value <> 0
; Clear this value
$slider_values[$worst_slider] = 0

; Fetch the button belonging to this slider
$button = $crematory_sliders[$worst_slider]

; Check if the slider goes down or up when button is pressed
Dim $down_when_black = False
If $button < 0 Then
$down_when_black = true
$button = abs($button)
EndIf

; Only change this button if it was not changed before by an even worse value
If $wanted_button_states[$button] = $DONTCARE Then
Dim $slider_should_go_down = False
If $worst_value > 0 Then
$slider_should_go_down = True
EndIf

If $worst_slider = $keep_positive and $worst_value < 3 Then
$slider_should_go_down = False
EndIf

If $worst_slider = $keep_negative and $worst_value > -3 Then
$slider_should_go_down = True
EndIf

If $slider_should_go_down Then
If $down_when_black Then
$wanted_button_states[$button] = $BLACK
Else
$wanted_button_states[$button] = $WHITE
EndIf
Else
If $down_when_black Then
$wanted_button_states[$button] = $WHITE
Else
$wanted_button_states[$button] = $BLACK
EndIf
EndIf
EndIf

; Fetch the worst value of whats left
$worst_slider = AbsMaxIndexOfArray($slider_values)
$worst_value = $slider_values[$worst_slider]
WEnd

; We now have a list of wanted button values

; DEBUG: MsgBox(0, "Crematory", "Buttons: 1=" & $wanted_button_states[1] & " 2=" & $wanted_button_states[2] & " 3=" & $wanted_button_states[3] & " 4=" & $wanted_button_states[4] & " 5=" & $wanted_button_states[5]))

; NOTE Its very important that there are sliders on both sides of the line. Otherwise ash will be 0

; Set all buttons to their wanted states
For $button = 1 to 5
If $wanted_button_states[$button] <> $DONTCARE Then
Dim $button_is_black = ButtonIsBlack($button)

If $wanted_button_states[$button] = $BLACK Then
If Not ButtonIsBlack($button) Then
ClickButton($button)
EndIf
Else
If ButtonIsBlack($button) Then
ClickButton($button)
EndIf
EndIf

EndIf
Next

Sleep(50)
WEnd

Exit 0

;
; Fetch slider position
;
Func AbsMaxIndexOfArray($values)
Dim $max_index = 1
Dim $max_value = 0
Dim $value

For $index = 1 To 7
$value = $values[$index]
If Abs($value) > Abs($max_value) Then
$max_value = $value
$max_index = $index
EndIf
Next

return $max_index
EndFunc

;
; Fetch slider position
;
Func GetSlider($number)
Dim $x = $slider_x + (($number - 1) * 36)
$coord = PixelSearch($x, $slider_y - 62, $x, $slider_y + 62, 0x000000, 0x05)
If @error Then
MsgBox(0, "Crematory", "Failed to read slider position")
Exit
EndIf
Dim $pos = -1 * ($coord[1] + 2 - $slider_y)
return $pos
EndFunc

;
; Click button 1 to 5
;
Func ClickButton($number)
Dim $x = $central_x + (($number - 3) * 40)
MouseClick("left", $x, $central_y, 1, 1)
EndFunc

;
; Returns True if black, otherwise false
;
Func ButtonIsBlack($number)
Dim $x = $central_x + (($number - 3) * 40)
$color = PixelGetColor($x, $central_y)
If $color = 0 Then
Return True
Else
return False
EndIf
EndFunc

;
; Returns the RGB components of a colour
;
Func GetRGB($color)
Dim $red = Int($color / 65536)
$color = $color - ($red * 65536)
Dim $green = Int($color / 256)
Dim $blue = Int($color - ($green * 256))

Dim $colors[3]
$colors[0] = $red
$colors[1] = $green
$colors[2] = $blue

return $colors
EndFunc

Func SetPoint()
$HOLD = 0
EndFunc

Func Terminate()
Exit 0
EndFunc

Func TogglePause()
$Paused = NOT $Paused
While $Paused
sleep(100)
ToolTip($RESOURCE & " mining - PAUSED", 300, 8)
WEnd
ToolTip($RESOURCE & " mining", 300, 8)
EndFunc

</pre>

Guilds/Dolphine/CrematoryMacro - Revision history

Chrido: New page: = Crematory macro = Copy this macro into notepad and save as "crematory.au3".
; ; Crematory macro by Chrido. Tuned for the crematory in my workshop. ; HotKeySet("^z", "SetPoint") H...