// Поиск скученности пикселей

set #r2 350          //радиус разброса точек
set #min 70       //минимальное количество всех пикселей в группе
set #max 500      //максимальное количество всех пикселей в группе
init_arr %xy (1) 0 0 1920 1080                             //область поиска
init_arr %color (1) 3792629 2994907 2411220 4302798                                                          //цвета для поиска (от 1 до 5 цветов)
init_arr %m (1) 0 0 0 0 0     //минимальное количество пикселей каждого цвета с учётом % отклонения (всегда должно быть 5 чисел)
init_arr %deviat (1) 1 1 1 1 1     // % отклонения для каждого цвета (всегда должно быть 5 чисел)
set #mincol 2          //минимальное количество любого из указанных цветов (от 1 до 5)
set #timeproc 0        // время для поиска, если 0 не выйдет из процедуры пока не найдётся хотя бы 1 цвет
set linedelay 0


set size(%result)      // уничтожить массив с прошлыми результатами поиска
call heap %xy %color %m %deviat #r2 #min #max #mincol #timeproc
if  size(%result) > 0                       // если найдено хотя бы 1 группа
    for #i 1 size(%result)
        set #dist #dist + 1
        set #deskX desktopwidth / 2
        set #deskY desktopheight / 2
        set #distance round(point_distance (#deskX #deskY %result [#i 1] %result [#i 2]))
        init_arr %dist (#dist) #distance %result [#i 1] %result [#i 2]
    end_for
    sort_array %dist
    set #deltaY %result [1 2] + 40
    kleft %dist [1 2] %dist [1 3]
end_if
end_script




// процедура поиска
proc heap %xy %color %m %deviat #r2 #min #max #mincol #timeproc
    set #current_script current_script
    set delimiter ' '
    set #Xstart %xy[1 1]
    set #Ystart %xy[1 2]
    set #Xend %xy[1 3]
    set #Yend %xy[1 4]
    set #deviat maxx(%deviat[1])
    set #pix 0
    set #pix1 0
    set #g 0
    set size(%b)
    set size(%result)
    while size(%a) = 0 and (#timeproc > timer or #timeproc = 0)
        set #a findcolor(#Xstart #Ystart #Xend #Yend (%color[1]) %a 2 -1 #deviat)
        wait 10
    end_while
    set #pixel.#current_script #a
    if  #a > 0
        gosub rgb
        for #i 1 size(%a)
            set #g #g +1
            set #c1 0
            set #c2 0
            set #c3 0
            set #c4 0
            set #c5 0
            for #j #i size(%a)
                set #r round(point_distance(%a[#i 1] %a[#i 2] %a[#j 1] %a[#j 2]))
                if  #r < #r2
                    set #pixl #pix
                    if  %a[#j 3] >= %color[2 1] and %a[#j 3] <= %color[3 1]
                        set #c1 #c1 +1
                    else
                        if  %a[#j 3] >= %color[2 2] and %a[#j 3] <= %color[3 2]
                            set #c2 #c2 +1
                        else
                            if  %a[#j 3] >= %color[2 3] and %a[#j 3] <= %color[3 3]
                                set #c3 #c3 +1
                            else
                                if  %a[#j 3] >= %color[2 4] and %a[#j 3] <= %color[3 4]
                                    set #c4 #c4 +1
                                else
                                    if  %a[#j 3] >= %color[2 5] and %a[#j 3] <= %color[3 5]
                                        set #c5 #c5 +1
                                    end_if
                                end_if
                            end_if
                        end_if
                    end_if
                    set #pix #c1 +#c2 +#c3 +#c4 +#c5
                    if  #pixl != #pix
                        set %a[#j 4] #g
                    else
                        set %a[#j 4] 0
                    end_if
                end_if
            end_for
            init_arr %b (#g) %a[#i 1] %a[#i 2] #pix #c1 #c2 #c3 #c4 #c5
            for #i #i size(%a)
                if  %a[#i 4] = ""
                    set #i #i -1
                    break
                end_if
            end_for
        end_for
        set #z 0
        for #l 1 size(%b)
            if  %b[#l 3] >= #min and %b[#l 3] <= #max
                if  (%b[#l 4] >= %m[1 1] or %m[1 1] = 0) and (%b[#l 5] >= %m[1 2] or %m[1 2] = 0) and (%b[#l 6] >= %m[1 3] or %m[1 3] = 0) and (%b[#l 7] >= %m[1 4] or %m[1 4] = 0) and (%b[#l 8] >= %m[1 5] or %m[1 5] = 0)
                    set #z1 0
                    for #m 4 8
                        if  %b[#l #m] > 0
                            set #z1 #z1 +1
                        end_if
                    end_for
                    if  #z1 >= #mincol
                        set #z #z +1
                        init_arr %result (#z) %b[#l]
                    end_if
                end_if
            end_if
        end_for
        for #i 1 size(%result)
            for #j 1 size(%result[])
                set %result.#current_script [#i #j] %result [#i #j]
            end_for
        end_for
    end_if
    goto end

    :rgb
        for #n 1 size(%color[1])
            set #cvet %color[1 #n]
            set #a1 colortorgb(#cvet %rgb)
            set #dev 255*%deviat[1 #n]/100
            set #bmin %rgb[1 3]-#dev
            set #bmax %rgb[1 3]+#dev
            if  #bmax > 255
                set #bmax 255
            end_if
            if  #bmin < 0
                set #bmin 0
            end_if
            set #gmin %rgb[1 2]-#dev
            set #gmax %rgb[1 2]+#dev
            if  #gmax > 255
                set #gmax 255
            end_if
            if  #gmin < 0
                set  #gmin 0
            end_if
            set #rmin %rgb[1 1]-#dev
            set #rmax %rgb[1 1]+#dev
            if  #rmax > 255
                set #rmax 255
            end_if
            if  #rmin < 0
                set #rmin 0
            end_if
            set %color[2 #n] #bmin *256*256+#gmin *256+#rmin
            set %color[3 #n] #bmax *256*256+#gmax *256+#rmax
        end_for
    return

    :end
end_proc