Ohh yeah should be simple enough, I think I have a good idea of fixing this now.
[edit]
Alright
It works now!
Made a second Sort routine that will search for the array indexs with the same Y coordinates and call QuickSort to sort just thoese. The best part, the FPS didn't slow down one bit.
REM ********************************************************************
REM Paste Priority
REM ********************************************************************
set display mode 640,480,32
create bitmap 1,640,480
sync on
sync rate 0
REM Set Amount Here
ObjectMax = 1000
gosub setup
wait 500
REM ********************************************************************
REM Main Loop
REM ********************************************************************
do
mx = mousex()
my = mousey()
ObjectX(0) = mx
ObjectY(0) = my
gosub DrawObject
ink 0,0
text 0,0,"FPS: " + str$(screen fps())
copy bitmap 1,0
sync : cls rgb(50,200,200)
loop
REM ********************************************************************
REM Setup
REM ********************************************************************
Setup:
REM Circle Image
ink rgb(10,10,10),0
FillCircle(100,100,16)
ink rgb(255,255,255),0
FillCircle(100,100,15)
get image 1,100-16,100-16,100+16,100+16,1
REM Array for Objects
dim ObjectX(ObjectMax)
dim ObjectY(ObjectMax)
for ObjectLP = 0 to ObjectMax
rx = rnd(607)+1
ry = rnd(447)+1
ObjectX(ObjectLP) = rx
ObjectY(ObjectLP) = ry
next ObjectLP
REM Priority
dim Priority(ObjectMax)
return
REM ********************************************************************
REM Draw Object
REM ********************************************************************
DrawObject:
REM Setup Priority
for ObjectLP = 0 to ObjectMax
Priority(ObjectLP) = ObjectLP
next ObjectLP
REM Sorting Priority
QuickSort(0,ObjectMax,0)
REM 2nd Sorting Check
gosub SortHorz
REM Draw to Screen
for ObjectLP = 0 to ObjectMax
p = Priority(ObjectLP)
x = ObjectX(p)
y = ObjectY(p)
paste image 1,x,y,1
next ObjectLP
return
REM *********************************************************************
REM Sort Horz
REM *********************************************************************
SortHorz:
for SortLP = 0 to ObjectMax-1
p1 = Priority(SortLP)
y1 = ObjectY(p1)
p2 = Priority(SortLP+1)
y2 = ObjectY(p2)
REM If they have the same Y corrdinate
if y1 = y2 and Left = 0
Left = SortLP
Right = Left+1
do
if Right => ObjectMax then exit
p2 = Priority(Right+1)
y2 = ObjectY(p2)
if y2 <> y1 then exit
Right = Right + 1
loop
REM Sorting
QuickSort(Left,Right,1)
REM Reset Left
Left = 0
SortLP = Right
endif
next SortLP
return
REM *********************************************************************
REM Quick Sort
REM *********************************************************************
Function QuickSort(L,R,Mode)
if R > L
CheckL = L
CheckR = R
if Mode = 0 then Check = ObjectY(Priority((L+R)/2))
if Mode = 1 then Check = ObjectX(Priority((L+R)/2))
repeat
REM Vert Check
if Mode = 0
while ObjectY(Priority(CheckL)) < Check
CheckL = CheckL + 1
endwhile
while Check < ObjectY(Priority(CheckR))
CheckR = CheckR - 1
endwhile
endif
REM Horz Check
if Mode = 1
while ObjectX(Priority(CheckL)) < Check
CheckL = CheckL + 1
endwhile
while Check < ObjectX(Priority(CheckR))
CheckR = CheckR - 1
endwhile
endif
if CheckL <= CheckR
REM Swap
buffer = Priority(CheckL)
Priority(CheckL) = Priority(CheckR)
Priority(CheckR) = buffer
CheckL = CheckL + 1
CheckR = CheckR - 1
endif
until CheckL >= CheckR
REM Calling this same Function multiple times
if L < CheckR then QuickSort(L,CheckR,Mode)
if CheckL < R then QuickSort(CheckL,R,Mode)
endif
EndFunction
REM --------------------------------------------------------------------
REM Function FillCircle()
REM --------------------------------------------------------------------
Function FillCircle(cx,cy,r)
sr = r*r
for i = 1 to r
h = sqrt( sr - i*i )
x1 = cx - i
y1 = cy - h
x2 = cx + i
y2 = cy + h
if x1 < 0 then x1 = 0
if y1 < 0 then y1 = 0
if x2 > 639 then x2 = 639
if y2 > 479 then y2 = 479
box x1, y1, x2, y2
next i
EndFunction
