I always appreciate you chiming in, if I pay attention I can learn something with every interaction - you are a code warrior!dodicat wrote:It's different.
I know that you are both working in this together.
Don't mind me, If I see something similar to what I have done in the past I have posted it here.
InPolygon uses the winding number method.
No matter the polygon size/type it returns non 0 if a point is inside it.
Isometric shadow casting light.
Re: Isometric shadow casting light.
Re: Isometric shadow casting light.
Dodicat, I always have pointer problems, especially when I am out of practice and haven't used them in a while...
so here is my attempt att drawing direct access lines... but not working, what is the problem?
I keep getting type mismatch (my favorite error) in line 190, this one:
here are the types:
complete program:
so here is my attempt att drawing direct access lines... but not working, what is the problem?
I keep getting type mismatch (my favorite error) in line 190, this one:
Code: Select all
pixel = row + (int(Lx) * 4)
Code: Select all
ScreenInfo w, h, , bypp, pitch
Dim buffer As Any Ptr = ScreenPtr()
Dim As Any Ptr row = buffer + (pitch * points(1).y)
Dim As UInteger Ptr pixel
Code: Select all
' =====================================================
' ===== CONVEX or CONVEX POLYGON FILL ROUTINE =======
' =====================================================
type vertice
x as integer
y as integer
side as integer ' this value is either -1,0, or 1... -1 means left side, 0 means both sides, 1 means right side (both sides is a top or bottom point)
NLP as integer ' the next left side point ...most points will only have a value in one of these, depending if it is a left or right point
NRP as integer ' the next right side point
Lslp as double ' this is the slope from this point towards the next point ON THE LEFT SIDE! ...most points will only have a value in one of these, depending if it is a left or right point
Rslp as double ' this is the slope from this point towards the next point ON THE RIGHT SIDE!
end type
dim shared as vertice points(5)
dim shared as integer NumOfPoints
dim shared as integer Key, extraspace, loops = 0
' for direct screen access
Dim As Integer w, h, bypp, pitch
screenres 800,600,32
randomize timer
do
loops +=1
cls
color rgb(255,255,255)
'
' make random points (within designated areas...) and show them
'
NumOfPoints = 5 : Points(0).x = NumOfPoints
points(1).x = int(rnd*390)+11 'upper left
points(1).y = int(rnd*290)+11
points(2).x = int(rnd*390)+401 'upper right
points(2).y = int(rnd*290)+11
points(3).x = int(rnd*190)+11 'center left
points(3).y = int(rnd*200)+301
points(4).x = int(rnd*190)+601 'center right
points(4).y = int(rnd*200)+301
points(5).x = int(rnd*400)+201 'bottom center
points(5).y = int(rnd*90)+501
for p as integer = 1 to NumOfPoints
Circle (points(p).x, points(p).y), 4, RGB(255,0,0) ,,,, f
next p
' ======================================================================
' ============== ENTER ROUTINE HERE
' ============== with all points in array points(5)
' ============== points(0).x = NumberOfPoints (should be four or five)
' ======================================================================
NumOfPoints = Points(0).x
'
'sort the array of points, from top to bottom, and left to right
'
dim as integer exchange = 1, passnum = NumOfPoints - 1
while passnum > 0 and exchange = 1
exchange = 0
for i as integer = 1 to passnum
if points(i).y > points(i+1).y then
exchange = 1
swap points(i), points(i+1)
end if
' if the Y values are same, then sort based on x values...
if points(i).y = points(i+1).y then
if points(i).x > points(i+1).x then
exchange = 1
swap points(i), points(i+1)
end if
end if
next i
passnum -= 1
wend
'
' find Top-Most and Bottom-Most points, show them
'
circle (points(1).x, points(1).y), 5, RGB(255,255,255) ' top
circle (points(NumOfPoints).x, points(NumOfPoints).y), 5, RGB(255,255,255) ' bottom
'
' calc main left/right dividing slope...
'
dim as integer TLP, TRP
dim as double MainSlope, CurSlope
MainSlope = (points(1).x - points(NumOfPoints).x) / (points(1).y - points(NumOfPoints).y) '<--- this is the slope of the line from top to bottom points
'
' compare the Main Slope to the slope to each of the other points to determine if each point is 'left' or 'right'
for p as integer = 2 to NumOfPoints-1
CurSlope = (points(1).x - points(p).x) / (points(1).y - points(p).y)
if CurSlope < MainSlope then
points(p).side = -1 '<---left side
else
points(p).side = 1 '<---right side
end if
next p
TLP = 1 ' set top Left Point to the first point
TRP = 1 ' set Top Right Point same as Top Left Point
points(1).side = 0 ' set first point side to 0 (means is on BOTH sides)
' check for same y value of first two points
if points(1).y = points(2).y then
points(2).side = 1 ' set second point to RIGHT side only
points(1).side = -1 ' set first point to LEFT side only, 0 means BOTH sides
TRP = 2 ' set Top Right Point to the second point
end if
' NOW, figure out the slopes of each point ot the next point on same side!
' This is where we figure out all the slopes, from one point to the next in line, for each side
' we will need these as we start filling the polygon and come to the next point/corner where we
' will change the slope value that we add to the left side X-value
dim as integer curleftpoint = TLP, currightpoint = TRP, nextLeft, nextRight
' find all the left points, calc each slope
do
' find next left point
nextLeft = curleftpoint
do
nextLeft += 1
loop while points(nextLeft).side > 0
' got the next left, now calc slope to it from current left
points(curleftpoint).Lslp = (points(curleftpoint).x - points(nextLeft).x) / (points(curleftpoint).y - points(nextLeft).y)
' save this next point
points(curleftpoint).NLP = nextLeft
curleftpoint = nextLeft
loop while points(nextleft).side <> 0 'until at bottom point
' find all the right points, calc each slope
do
' find next right point
nextRight = currightpoint
do
nextRight += 1
loop while points(nextRight).side < 0
' got the next right, now calc slope to it from current right
points(currightpoint).Rslp = (points(currightpoint).x - points(nextRight).x) / (points(currightpoint).y - points(nextRight).y)
' save this next point
points(currightpoint).NRP = nextRight
currightpoint = nextRight
loop while points(nextRight).side <> 0 'until at bottom point
' ok, now we got a sorted array of points, each identified as to which 'side' they are on, with the slopes from one point to the next point on the same side stored
' lets determine how many yvalues there will be in total...
dim as integer NumOfYvalues = points(NumOfPoints).y - points(1).y + 1
' set the initial x-values for both sides..
dim as double Lx = points(TLP).x , Rx = points(TRP).x
' set the current point for each side
dim as integer CLP = TLP, CRP = TRP
' this is where the magic happens....
' Lx and Rx are the current x-values for each side
' points(CLP).Lslp and points(CRP).Rslp are the slopes (change in X) for the current point on each side (CLP=Current Left Point, CRP=Current Right Point)
' Lslp = Left Slope, Rslp = Right Slope... these are DOUBLES, not integers
'
' determine starting address of the ROW for top most Y value (points(1).y)
' for direct screen access
ScreenInfo w, h, , bypp, pitch
Dim buffer As Any Ptr = ScreenPtr()
Dim As Any Ptr row = buffer + (pitch * points(1).y)
Dim As UInteger Ptr pixel
for yvalue as integer = points(1).y + 1 to points(NumOfPoints).y 'iterate through all the yvalues
' calc the x-value for this y value for both Left and Right
Lx += points(CLP).Lslp : Rx += points(CRP).Rslp
' increment the row address (y-value) each time...
row += pitch
' calc the x-value for this y value for both Left and Right
Lx += points(CLP).Lslp : Rx += points(CRP).Rslp
' calc starting x-value address
pixel = row + (int(Lx) * 4)
' draw the line between the to xvalues at this yvalue
'line (int(Lx), yvalue) - (int(Rx), yvalue), rgb(0,255,0)
' fast line draw!
for q as integer = 0 to (int(Rx)-int(Lx)) ' length of row
*pixel= (RGBA(0,128,128,0))
pixel += 1
next q
' pixel = row + pitch *( _y) + (_x)*4
' *pixel = (colour)
' check to see if reached next left/right points...
' change current left point to the next left point!
if yvalue >= points(points(CLP).NLP).y then CLP = points(CLP).NLP
' change current right point to the next right point!
if yvalue >= points(points(CRP).NRP).y then CRP = points(CRP).NRP
sleep 5
next yvalue
beep
Key = getkey
loop until Key = 27
Re: Isometric shadow casting light.
almost got it, but something still not right...
Code: Select all
' =====================================================
' ===== CONVEX or CONVEX POLYGON FILL ROUTINE =======
' =====================================================
type vertice
x as integer
y as integer
side as integer ' this value is either -1,0, or 1... -1 means left side, 0 means both sides, 1 means right side (both sides is a top or bottom point)
NLP as integer ' the next left side point ...most points will only have a value in one of these, depending if it is a left or right point
NRP as integer ' the next right side point
Lslp as double ' this is the slope from this point towards the next point ON THE LEFT SIDE! ...most points will only have a value in one of these, depending if it is a left or right point
Rslp as double ' this is the slope from this point towards the next point ON THE RIGHT SIDE!
end type
dim shared as vertice points(5)
dim shared as integer NumOfPoints
dim shared as integer Key, extraspace, loops = 0
' for direct screen access
Dim As Integer w, h, bypp, pitch
screenres 800,600,32
randomize timer
do
loops +=1
cls
color rgb(255,255,255)
'
' make random points (within designated areas...) and show them
'
NumOfPoints = 5 : Points(0).x = NumOfPoints
points(1).x = int(rnd*390)+11 'upper left
points(1).y = int(rnd*290)+11
points(2).x = int(rnd*390)+401 'upper right
points(2).y = int(rnd*290)+11
points(3).x = int(rnd*190)+11 'center left
points(3).y = int(rnd*200)+301
points(4).x = int(rnd*190)+601 'center right
points(4).y = int(rnd*200)+301
points(5).x = int(rnd*400)+201 'bottom center
points(5).y = int(rnd*90)+501
for p as integer = 1 to NumOfPoints
Circle (points(p).x, points(p).y), 4, RGB(255,0,0) ,,,, f
next p
' ======================================================================
' ============== ENTER ROUTINE HERE
' ============== with all points in array points(5)
' ============== points(0).x = NumberOfPoints (should be four or five)
' ======================================================================
NumOfPoints = Points(0).x
'
'sort the array of points, from top to bottom, and left to right
'
dim as integer exchange = 1, passnum = NumOfPoints - 1
while passnum > 0 and exchange = 1
exchange = 0
for i as integer = 1 to passnum
if points(i).y > points(i+1).y then
exchange = 1
swap points(i), points(i+1)
end if
' if the Y values are same, then sort based on x values...
if points(i).y = points(i+1).y then
if points(i).x > points(i+1).x then
exchange = 1
swap points(i), points(i+1)
end if
end if
next i
passnum -= 1
wend
'
' find Top-Most and Bottom-Most points, show them
'
circle (points(1).x, points(1).y), 5, RGB(255,255,255) ' top
circle (points(NumOfPoints).x, points(NumOfPoints).y), 5, RGB(255,255,255) ' bottom
'
' calc main left/right dividing slope...
'
dim as integer TLP, TRP
dim as double MainSlope, CurSlope
MainSlope = (points(1).x - points(NumOfPoints).x) / (points(1).y - points(NumOfPoints).y) '<--- this is the slope of the line from top to bottom points
'
' compare the Main Slope to the slope to each of the other points to determine if each point is 'left' or 'right'
for p as integer = 2 to NumOfPoints-1
CurSlope = (points(1).x - points(p).x) / (points(1).y - points(p).y)
if CurSlope < MainSlope then
points(p).side = -1 '<---left side
else
points(p).side = 1 '<---right side
end if
next p
TLP = 1 ' set top Left Point to the first point
TRP = 1 ' set Top Right Point same as Top Left Point
points(1).side = 0 ' set first point side to 0 (means is on BOTH sides)
' check for same y value of first two points
if points(1).y = points(2).y then
points(2).side = 1 ' set second point to RIGHT side only
points(1).side = -1 ' set first point to LEFT side only, 0 means BOTH sides
TRP = 2 ' set Top Right Point to the second point
end if
' NOW, figure out the slopes of each point ot the next point on same side!
' This is where we figure out all the slopes, from one point to the next in line, for each side
' we will need these as we start filling the polygon and come to the next point/corner where we
' will change the slope value that we add to the left side X-value
dim as integer curleftpoint = TLP, currightpoint = TRP, nextLeft, nextRight
' find all the left points, calc each slope
do
' find next left point
nextLeft = curleftpoint
do
nextLeft += 1
loop while points(nextLeft).side > 0
' got the next left, now calc slope to it from current left
points(curleftpoint).Lslp = (points(curleftpoint).x - points(nextLeft).x) / (points(curleftpoint).y - points(nextLeft).y)
' save this next point
points(curleftpoint).NLP = nextLeft
curleftpoint = nextLeft
loop while points(nextleft).side <> 0 'until at bottom point
' find all the right points, calc each slope
do
' find next right point
nextRight = currightpoint
do
nextRight += 1
loop while points(nextRight).side < 0
' got the next right, now calc slope to it from current right
points(currightpoint).Rslp = (points(currightpoint).x - points(nextRight).x) / (points(currightpoint).y - points(nextRight).y)
' save this next point
points(currightpoint).NRP = nextRight
currightpoint = nextRight
loop while points(nextRight).side <> 0 'until at bottom point
' ok, now we got a sorted array of points, each identified as to which 'side' they are on, with the slopes from one point to the next point on the same side stored
' lets determine how many yvalues there will be in total...
dim as integer NumOfYvalues = points(NumOfPoints).y - points(1).y + 1
' set the initial x-values for both sides..
dim as double Lx = points(TLP).x , Rx = points(TRP).x
' set the current point for each side
dim as integer CLP = TLP, CRP = TRP
' this is where the magic happens....
' Lx and Rx are the current x-values for each side
' points(CLP).Lslp and points(CRP).Rslp are the slopes (change in X) for the current point on each side (CLP=Current Left Point, CRP=Current Right Point)
' Lslp = Left Slope, Rslp = Right Slope... these are DOUBLES, not integers
'
' determine starting address of the ROW for top most Y value (points(1).y)
' for direct screen access
ScreenInfo w, h, , bypp, pitch
Dim buffer As Any Ptr = ScreenPtr()
Dim As Any Ptr row = buffer + (pitch * points(1).y) ' address of the row where the top Y-value is
Dim As UInteger Ptr pixel
for yvalue as integer = points(1).y + 1 to points(NumOfPoints).y 'iterate through all the yvalues
' calc the x-value for this y value for both Left and Right
Lx += points(CLP).Lslp : Rx += points(CRP).Rslp
' increment the row address (y-value) each time...
row += pitch
' calc the x-value for this y value for both Left and Right
Lx += points(CLP).Lslp : Rx += points(CRP).Rslp
' calc starting x-value address
pixel = row + CUint(Lx) * 4
'pixel += CUint(int(Lx) * 4)
' draw the line between the to xvalues at this yvalue
'line (int(Lx), yvalue) - (int(Rx), yvalue), rgb(0,255,0)
' fast line draw!
screenlock
for q as integer = int(Lx) to int(Rx)+1 ' length of row
*pixel= RGB(0,0,255)
pixel += 1
next q
screenunlock
' pixel = row + pitch *( _y) + (_x)*4
' *pixel = (colour)
' check to see if reached next left/right points...
' change current left point to the next left point!
if yvalue >= points(points(CLP).NLP).y then CLP = points(CLP).NLP
' change current right point to the next right point!
if yvalue >= points(points(CRP).NRP).y then CRP = points(CRP).NRP
sleep 5
next yvalue
beep
Key = getkey
loop until Key = 27
Re: Isometric shadow casting light.
Direct pixels always in a locked screen.
reset row=screenptr each loop otherwise it accumulates.
and reset row for the starting address.
Nearly forgot , I use sleep 1 here to speed it up a bit.
reset row=screenptr each loop otherwise it accumulates.
and reset row for the starting address.
Nearly forgot , I use sleep 1 here to speed it up a bit.
Code: Select all
' =====================================================
' ===== CONVEX or CONVEX POLYGON FILL ROUTINE =======
' =====================================================
type vertice
x as integer
y as integer
side as integer ' this value is either -1,0, or 1... -1 means left side, 0 means both sides, 1 means right side (both sides is a top or bottom point)
NLP as integer ' the next left side point ...most points will only have a value in one of these, depending if it is a left or right point
NRP as integer ' the next right side point
Lslp as double ' this is the slope from this point towards the next point ON THE LEFT SIDE! ...most points will only have a value in one of these, depending if it is a left or right point
Rslp as double ' this is the slope from this point towards the next point ON THE RIGHT SIDE!
end type
dim shared as vertice points(5)
dim shared as integer NumOfPoints
dim shared as integer Key, extraspace, loops = 0
' for direct screen access
Dim As Integer w, h, bypp, pitch
screenres 800,600,32
' for direct screen access
ScreenInfo w, h, , bypp, pitch
Dim buffer As Any Ptr = ScreenPtr()
Dim As Any Ptr row = screenptr'buffer
'randomize timer
do
row=screenptr
screenlock
loops +=1
cls
color rgb(255,255,255)
'
' make random points (within designated areas...) and show them
'
NumOfPoints = 5 : Points(0).x = NumOfPoints
points(1).x = int(rnd*390)+11 'upper left
points(1).y = int(rnd*290)+11
points(2).x = int(rnd*390)+401 'upper right
points(2).y = int(rnd*290)+11
points(3).x = int(rnd*190)+11 'center left
points(3).y = int(rnd*200)+301
points(4).x = int(rnd*190)+601 'center right
points(4).y = int(rnd*200)+301
points(5).x = int(rnd*400)+201 'bottom center
points(5).y = int(rnd*90)+501
for p as integer = 1 to NumOfPoints
Circle (points(p).x, points(p).y), 4, RGB(255,0,0) ,,,, f
next p
' ======================================================================
' ============== ENTER ROUTINE HERE
' ============== with all points in array points(5)
' ============== points(0).x = NumberOfPoints (should be four or five)
' ======================================================================
NumOfPoints = Points(0).x
'
'sort the array of points, from top to bottom, and left to right
'
dim as integer exchange = 1, passnum = NumOfPoints - 1
while passnum > 0 and exchange = 1
exchange = 0
for i as integer = 1 to passnum
if points(i).y > points(i+1).y then
exchange = 1
swap points(i), points(i+1)
end if
' if the Y values are same, then sort based on x values...
if points(i).y = points(i+1).y then
if points(i).x > points(i+1).x then
exchange = 1
swap points(i), points(i+1)
end if
end if
next i
passnum -= 1
wend
'
' find Top-Most and Bottom-Most points, show them
'
circle (points(1).x, points(1).y), 5, RGB(255,255,255) ' top
circle (points(NumOfPoints).x, points(NumOfPoints).y), 5, RGB(255,255,255) ' bottom
'
' calc main left/right dividing slope...
'
dim as integer TLP, TRP
dim as double MainSlope, CurSlope
MainSlope = (points(1).x - points(NumOfPoints).x) / (points(1).y - points(NumOfPoints).y) '<--- this is the slope of the line from top to bottom points
'
' compare the Main Slope to the slope to each of the other points to determine if each point is 'left' or 'right'
for p as integer = 2 to NumOfPoints-1
CurSlope = (points(1).x - points(p).x) / (points(1).y - points(p).y)
if CurSlope < MainSlope then
points(p).side = -1 '<---left side
else
points(p).side = 1 '<---right side
end if
next p
TLP = 1 ' set top Left Point to the first point
TRP = 1 ' set Top Right Point same as Top Left Point
points(1).side = 0 ' set first point side to 0 (means is on BOTH sides)
' check for same y value of first two points
if points(1).y = points(2).y then
points(2).side = 1 ' set second point to RIGHT side only
points(1).side = -1 ' set first point to LEFT side only, 0 means BOTH sides
TRP = 2 ' set Top Right Point to the second point
end if
' NOW, figure out the slopes of each point ot the next point on same side!
' This is where we figure out all the slopes, from one point to the next in line, for each side
' we will need these as we start filling the polygon and come to the next point/corner where we
' will change the slope value that we add to the left side X-value
dim as integer curleftpoint = TLP, currightpoint = TRP, nextLeft, nextRight
' find all the left points, calc each slope
do
' find next left point
nextLeft = curleftpoint
do
nextLeft += 1
loop while points(nextLeft).side > 0
' got the next left, now calc slope to it from current left
points(curleftpoint).Lslp = (points(curleftpoint).x - points(nextLeft).x) / (points(curleftpoint).y - points(nextLeft).y)
' save this next point
points(curleftpoint).NLP = nextLeft
curleftpoint = nextLeft
loop while points(nextleft).side <> 0 'until at bottom point
' find all the right points, calc each slope
do
' find next right point
nextRight = currightpoint
do
nextRight += 1
loop while points(nextRight).side < 0
' got the next right, now calc slope to it from current right
points(currightpoint).Rslp = (points(currightpoint).x - points(nextRight).x) / (points(currightpoint).y - points(nextRight).y)
' save this next point
points(currightpoint).NRP = nextRight
currightpoint = nextRight
loop while points(nextRight).side <> 0 'until at bottom point
' ok, now we got a sorted array of points, each identified as to which 'side' they are on, with the slopes from one point to the next point on the same side stored
' lets determine how many yvalues there will be in total...
dim as integer NumOfYvalues = points(NumOfPoints).y - points(1).y + 1
' set the initial x-values for both sides..
dim as double Lx = points(TLP).x , Rx = points(TRP).x
' set the current point for each side
dim as integer CLP = TLP, CRP = TRP
' this is where the magic happens....
' Lx and Rx are the current x-values for each side
' points(CLP).Lslp and points(CRP).Rslp are the slopes (change in X) for the current point on each side (CLP=Current Left Point, CRP=Current Right Point)
' Lslp = Left Slope, Rslp = Right Slope... these are DOUBLES, not integers
'
' determine starting address for top most Y value (points(1).y)
Dim As UInteger Ptr pixel '= row + pitch * points(1).y+points(1).x * 4
dim as integer yy=points(1).y
row+=pitch*yy 'reset row for starters
for yvalue as integer = points(1).y + 1 to points(NumOfPoints).y 'iterate through all the yvalues
' calc the x-value for this y value for both Left and Right
Lx += points(CLP).Lslp : Rx += points(CRP).Rslp
' increment the row address (y-value) each time...
row += pitch
' calc the x-value for this y value for both Left and Right
' Lx += points(CLP).Lslp : Rx += points(CRP).Rslp (you did this twice ???????)
' calc starting x-value address
pixel = row + (cint(Lx) shl 2) ' shl2 = times 4
' draw the line between the to xvalues at this yvalue
' line (int(Lx), yvalue) - (int(Rx), yvalue), rgb(0,255,0)
' fast line draw!
for q as integer = int(lx) to int(rx)'0 to (int(rx)-int(Lx)) ' length of row
*pixel= RGBA(0,128,128,0)
pixel += 1
next q
' check to see if reached next left/right points...
' change current left point to the next left point!
if yvalue >= points(points(CLP).NLP).y then CLP = points(CLP).NLP
' change current right point to the next right point!
if yvalue >= points(points(CRP).NRP).y then CRP = points(CRP).NRP
screenunlock
sleep 1
next yvalue
beep
Key = getkey
loop until Key = 27
Re: Isometric shadow casting light.
yup, I was able to catch most of that... here is what I came up with also... same same.... really appreciate your help!!
This is still slow for two reasons:
(1) screenlock / unlock is inside the Y loop, needs put outside for 'real' use
(2) currently it writes each pixel value in a line (albeit very fast), a faster way would be to use the mem_clear or mem_copy functions (forgot their actual names...), but this will probably be unnecessary.
I will now put it into the speed test program so we can compare apples to apples... need to beat the 500 fps you were getting!
THEN, will compare to Dodicats polyfill routines... the ULTIMATE speed test!
This is still slow for two reasons:
(1) screenlock / unlock is inside the Y loop, needs put outside for 'real' use
(2) currently it writes each pixel value in a line (albeit very fast), a faster way would be to use the mem_clear or mem_copy functions (forgot their actual names...), but this will probably be unnecessary.
I will now put it into the speed test program so we can compare apples to apples... need to beat the 500 fps you were getting!
THEN, will compare to Dodicats polyfill routines... the ULTIMATE speed test!
Code: Select all
' =====================================================
' ===== CONVEX or CONVEX POLYGON FILL ROUTINE =======
' =====================================================
type vertice
x as integer
y as integer
side as integer ' this value is either -1,0, or 1... -1 means left side, 0 means both sides, 1 means right side (both sides is a top or bottom point)
NLP as integer ' the next left side point ...most points will only have a value in one of these, depending if it is a left or right point
NRP as integer ' the next right side point
Lslp as double ' this is the slope from this point towards the next point ON THE LEFT SIDE! ...most points will only have a value in one of these, depending if it is a left or right point
Rslp as double ' this is the slope from this point towards the next point ON THE RIGHT SIDE!
end type
dim shared as vertice points(5)
dim shared as integer NumOfPoints
dim shared as integer Key, extraspace, loops = 0
screenres 800,600,32
'randomize timer
do
loops +=1
cls
color rgb(255,255,255)
'
' make random points (within designated areas...) and show them
'
NumOfPoints = 5 : Points(0).x = NumOfPoints
points(1).x = int(rnd*390)+11 'upper left
points(1).y = int(rnd*290)+11
points(2).x = int(rnd*390)+401 'upper right
points(2).y = int(rnd*290)+11
points(3).x = int(rnd*190)+11 'center left
points(3).y = int(rnd*200)+301
points(4).x = int(rnd*190)+601 'center right
points(4).y = int(rnd*200)+301
points(5).x = int(rnd*400)+201 'bottom center
points(5).y = int(rnd*90)+501
for p as integer = 1 to NumOfPoints
Circle (points(p).x, points(p).y), 4, RGB(255,0,0) ,,,, f
next p
' ======================================================================
' ============== ENTER ROUTINE HERE
' ============== with all points in array points(5)
' ============== points(0).x = NumberOfPoints (should be four or five)
' ======================================================================
NumOfPoints = Points(0).x
'
'sort the array of points, from top to bottom, and left to right
'
dim as integer exchange = 1, passnum = NumOfPoints - 1
while passnum > 0 and exchange = 1
exchange = 0
for i as integer = 1 to passnum
if points(i).y > points(i+1).y then
exchange = 1
swap points(i), points(i+1)
end if
' if the Y values are same, then sort based on x values...
if points(i).y = points(i+1).y then
if points(i).x > points(i+1).x then
exchange = 1
swap points(i), points(i+1)
end if
end if
next i
passnum -= 1
wend
'
' find Top-Most and Bottom-Most points, show them
'
circle (points(1).x, points(1).y), 5, RGB(255,255,255) ' top
circle (points(NumOfPoints).x, points(NumOfPoints).y), 5, RGB(255,255,255) ' bottom
'
' calc main left/right dividing slope...
'
dim as integer TLP, TRP
dim as double MainSlope, CurSlope
MainSlope = (points(1).x - points(NumOfPoints).x) / (points(1).y - points(NumOfPoints).y) '<--- this is the slope of the line from top to bottom points
'
' compare the Main Slope to the slope to each of the other points to determine if each point is 'left' or 'right'
for p as integer = 2 to NumOfPoints-1
CurSlope = (points(1).x - points(p).x) / (points(1).y - points(p).y)
if CurSlope < MainSlope then
points(p).side = -1 '<---left side
else
points(p).side = 1 '<---right side
end if
next p
TLP = 1 ' set top Left Point to the first point
TRP = 1 ' set Top Right Point same as Top Left Point
points(1).side = 0 ' set first point side to 0 (means is on BOTH sides)
' check for same y value of first two points
if points(1).y = points(2).y then
points(2).side = 1 ' set second point to RIGHT side only
points(1).side = -1 ' set first point to LEFT side only, 0 means BOTH sides
TRP = 2 ' set Top Right Point to the second point
end if
' NOW, figure out the slopes of each point ot the next point on same side!
' This is where we figure out all the slopes, from one point to the next in line, for each side
' we will need these as we start filling the polygon and come to the next point/corner where we
' will change the slope value that we add to the left side X-value
dim as integer curleftpoint = TLP, currightpoint = TRP, nextLeft, nextRight
' find all the left points, calc each slope
do
' find next left point
nextLeft = curleftpoint
do
nextLeft += 1
loop while points(nextLeft).side > 0
' got the next left, now calc slope to it from current left
points(curleftpoint).Lslp = (points(curleftpoint).x - points(nextLeft).x) / (points(curleftpoint).y - points(nextLeft).y)
' save this next point
points(curleftpoint).NLP = nextLeft
curleftpoint = nextLeft
loop while points(nextleft).side <> 0 'until at bottom point
' find all the right points, calc each slope
do
' find next right point
nextRight = currightpoint
do
nextRight += 1
loop while points(nextRight).side < 0
' got the next right, now calc slope to it from current right
points(currightpoint).Rslp = (points(currightpoint).x - points(nextRight).x) / (points(currightpoint).y - points(nextRight).y)
' save this next point
points(currightpoint).NRP = nextRight
currightpoint = nextRight
loop while points(nextRight).side <> 0 'until at bottom point
' ok, now we got a sorted array of points, each identified as to which 'side' they are on, with the slopes from one point to the next point on the same side stored
' lets determine how many yvalues there will be in total...
dim as integer NumOfYvalues = points(NumOfPoints).y - points(1).y + 1
' set the initial x-values for both sides..
dim as double Lx = points(TLP).x , Rx = points(TRP).x
' set the current point for each side
dim as integer CLP = TLP, CRP = TRP
' this is where the magic happens....
' Lx and Rx are the current x-values for each side
' points(CLP).Lslp and points(CRP).Rslp are the slopes (change in X) for the current point on each side (CLP=Current Left Point, CRP=Current Right Point)
' Lslp = Left Slope, Rslp = Right Slope... these are DOUBLES, not integers
'
' for direct screen access
Dim As Integer w, h, bypp, pitch
ScreenInfo w, h, , bypp, pitch
Dim buffer As Any Ptr = ScreenPtr()
Dim As Any Ptr row = buffer + (pitch * Cint(points(1).y))
Dim As UInteger Ptr pixel
for yvalue as integer = points(1).y + 1 to points(NumOfPoints).y 'iterate through all the yvalues
' calc the x-value for this y value for both Left and Right
Lx += points(CLP).Lslp : Rx += points(CRP).Rslp
screenlock
' OLD SLOW LINE DRAW METHOD
'
' draw the line between the to xvalues at this yvalue
'line (int(Lx), yvalue) - (int(Rx), yvalue), rgb(0,255,0)
' -------------------------------------------------------
' fast line draw!
' increment the row address (y-value) each time...
row += pitch
' calc starting x-value address
pixel = row + (CUint(Lx)*4)
for q as integer = int(Lx) to int(Rx)+1 ' length of row in pixels
*pixel= RGB(0,0,255)
pixel += 1
next q
screenunlock
' check to see if reached next left/right points...
' change current left point to the next left point!
if yvalue >= points(points(CLP).NLP).y then CLP = points(CLP).NLP
' change current right point to the next right point!
if yvalue >= points(points(CRP).NRP).y then CRP = points(CRP).NRP
sleep 1
next yvalue
beep
Key = getkey
loop until Key = 27
Re: Isometric shadow casting light.
Dodi, I am confused... how does this statement 'reset' the row? Doesn't it ADD more to it?
oh, wait... I found where you actually reset it - you added a statement at beginning of DO loop... got it
Code: Select all
row+=pitch*yy 'reset row for starters
Re: Isometric shadow casting light.
Dang nabbit! for some reason my system has some sort of a 'speed limit' on it - I can't get higher than 60 fps (is it somehow tied to vsync?) Even when I try to run the previous speed test where I got 300+ fps, same exact program now gets 60-65 fps...
here is the new speed test code - there is a variable called 'Tester' which you change from either 0 or 1 depending on which way you want to test, also removed the randomize timer so that both ways were using the same random test data... I get 60 fps on both ways so can't really test... wanna try on your systems?
Dodi, do you have any ideas why my fps would be limited? I have encountered this before but there seems to be no rhyme or reason to when/how it happens....
Just restarted puter, and had only FB running, and still limited - tested with different sleep values: sleep 1 - 11 ALL produce same result of 65, sleep 12 gets about 55... this is frustraing... going to make a standalone exe and see if problem follows..
speed limiting bug does follow program into its standalone EXE form... is it my system settings? wtf?!
here is the new speed test code - there is a variable called 'Tester' which you change from either 0 or 1 depending on which way you want to test, also removed the randomize timer so that both ways were using the same random test data... I get 60 fps on both ways so can't really test... wanna try on your systems?
Dodi, do you have any ideas why my fps would be limited? I have encountered this before but there seems to be no rhyme or reason to when/how it happens....
Just restarted puter, and had only FB running, and still limited - tested with different sleep values: sleep 1 - 11 ALL produce same result of 65, sleep 12 gets about 55... this is frustraing... going to make a standalone exe and see if problem follows..
speed limiting bug does follow program into its standalone EXE form... is it my system settings? wtf?!
Code: Select all
' =====================================================
' ===== CONVEX or CONVEX POLYGON FILL ROUTINE =======
' =====================================================
type vertice
x as integer
y as integer
side as integer ' this value is either -1,0, or 1... -1 means left side, 0 means both sides, 1 means right side (both sides is a top or bottom point)
NLP as integer ' the next left side point ...most points will only have a value in one of these, depending if it is a left or right point
NRP as integer ' the next right side point
Lslp as double ' this is the slope from this point towards the next point ON THE LEFT SIDE! ...most points will only have a value in one of these, depending if it is a left or right point
Rslp as double ' this is the slope from this point towards the next point ON THE RIGHT SIDE!
end type
dim shared as vertice points(5)
dim shared as integer NumOfPoints
dim shared as integer Key, extraspace, loops = 0
Dim As Integer fps,fp
Dim As Double times
screenres 800,600,32
'randomize timer
Do
ScreenLock
Cls
If Timer-1>times Then times=Timer:fps=fp:fp=0
fp+=1
locate 1,1
Print fps
'
' make random points (within designated areas...) and show them
'
NumOfPoints = 5 : Points(0).x = NumOfPoints
points(1).x = int(rnd*390)+11 'upper left
points(1).y = int(rnd*290)+11
points(2).x = int(rnd*390)+401 'upper right
points(2).y = int(rnd*290)+11
points(3).x = int(rnd*190)+11 'center left
points(3).y = int(rnd*200)+301
points(4).x = int(rnd*190)+601 'center right
points(4).y = int(rnd*200)+301
points(5).x = int(rnd*400)+201 'bottom center
points(5).y = int(rnd*90)+501
for p as integer = 1 to NumOfPoints
Circle (points(p).x, points(p).y), 4, RGB(255,0,0) ,,,, f
next p
' ======================================================================
' ============== ENTER ROUTINE HERE
' ============== with all points in array points(5)
' ============== points(0).x = NumberOfPoints (should be four or five)
' ======================================================================
NumOfPoints = Points(0).x
'
'sort the array of points, from top to bottom, and left to right
'
dim as integer exchange = 1, passnum = NumOfPoints - 1
while passnum > 0 and exchange = 1
exchange = 0
for i as integer = 1 to passnum
if points(i).y > points(i+1).y then
exchange = 1
swap points(i), points(i+1)
end if
' if the Y values are same, then sort based on x values...
if points(i).y = points(i+1).y then
if points(i).x > points(i+1).x then
exchange = 1
swap points(i), points(i+1)
end if
end if
next i
passnum -= 1
wend
'
' find Top-Most and Bottom-Most points, show them
'
circle (points(1).x, points(1).y), 5, RGB(255,255,255) ' top
circle (points(NumOfPoints).x, points(NumOfPoints).y), 5, RGB(255,255,255) ' bottom
'
' calc main left/right dividing slope...
'
dim as integer TLP, TRP
dim as double MainSlope, CurSlope
MainSlope = (points(1).x - points(NumOfPoints).x) / (points(1).y - points(NumOfPoints).y) '<--- this is the slope of the line from top to bottom points
'
' compare the Main Slope to the slope to each of the other points to determine if each point is 'left' or 'right'
for p as integer = 2 to NumOfPoints-1
CurSlope = (points(1).x - points(p).x) / (points(1).y - points(p).y)
if CurSlope < MainSlope then
points(p).side = -1 '<---left side
else
points(p).side = 1 '<---right side
end if
next p
TLP = 1 ' set top Left Point to the first point
TRP = 1 ' set Top Right Point same as Top Left Point
points(1).side = 0 ' set first point side to 0 (means is on BOTH sides)
' check for same y value of first two points
if points(1).y = points(2).y then
points(2).side = 1 ' set second point to RIGHT side only
points(1).side = -1 ' set first point to LEFT side only, 0 means BOTH sides
TRP = 2 ' set Top Right Point to the second point
end if
' NOW, figure out the slopes of each point ot the next point on same side!
' This is where we figure out all the slopes, from one point to the next in line, for each side
' we will need these as we start filling the polygon and come to the next point/corner where we
' will change the slope value that we add to the left side X-value
dim as integer curleftpoint = TLP, currightpoint = TRP, nextLeft, nextRight
' find all the left points, calc each slope
do
' find next left point
nextLeft = curleftpoint
do
nextLeft += 1
loop while points(nextLeft).side > 0
' got the next left, now calc slope to it from current left
points(curleftpoint).Lslp = (points(curleftpoint).x - points(nextLeft).x) / (points(curleftpoint).y - points(nextLeft).y)
' save this next point
points(curleftpoint).NLP = nextLeft
curleftpoint = nextLeft
loop while points(nextleft).side <> 0 'until at bottom point
' find all the right points, calc each slope
do
' find next right point
nextRight = currightpoint
do
nextRight += 1
loop while points(nextRight).side < 0
' got the next right, now calc slope to it from current right
points(currightpoint).Rslp = (points(currightpoint).x - points(nextRight).x) / (points(currightpoint).y - points(nextRight).y)
' save this next point
points(currightpoint).NRP = nextRight
currightpoint = nextRight
loop while points(nextRight).side <> 0 'until at bottom point
' ok, now we got a sorted array of points, each identified as to which 'side' they are on, with the slopes from one point to the next point on the same side stored
' lets determine how many yvalues there will be in total...
dim as integer NumOfYvalues = points(NumOfPoints).y - points(1).y + 1
' set the initial x-values for both sides..
dim as double Lx = points(TLP).x , Rx = points(TRP).x
' set the current point for each side
dim as integer CLP = TLP, CRP = TRP
' this is where the magic happens....
' Lx and Rx are the current x-values for each side
' points(CLP).Lslp and points(CRP).Rslp are the slopes (change in X) for the current point on each side (CLP=Current Left Point, CRP=Current Right Point)
' Lslp = Left Slope, Rslp = Right Slope... these are DOUBLES, not integers
'
' for direct screen access
Dim As Integer w, h, bypp, pitch
ScreenInfo w, h, , bypp, pitch
Dim buffer As Any Ptr = ScreenPtr()
Dim As Any Ptr row = buffer + (pitch * Cint(points(1).y))
Dim As UInteger Ptr pixel
dim as integer tester = 0 ' change to 0 for OldWay line draw, 1 = new way
for yvalue as integer = points(1).y + 1 to points(NumOfPoints).y 'iterate through all the yvalues
' calc the x-value for this y value for both Left and Right
Lx += points(CLP).Lslp : Rx += points(CRP).Rslp
select case tester
case 0 ' OLD SLOW LINE DRAW METHOD
' draw the line between the to xvalues at this yvalue
line (int(Lx), yvalue) - (int(Rx), yvalue), rgb(0,255,0)
case 1 ' NEW WAY
' fast line draw!
' increment the row address (y-value) each time...
row += pitch
' calc starting x-value address
pixel = row + (Cint(Lx) shl 2)
for q as integer = int(Lx) to int(Rx)+1 ' length of row in pixels
*pixel= RGB(0,0,255)
pixel += 1
next q
end select
' check to see if reached next left/right points...
' change current left point to the next left point!
if yvalue >= points(points(CLP).NLP).y then CLP = points(CLP).NLP
' change current right point to the next right point!
if yvalue >= points(points(CRP).NRP).y then CRP = points(CRP).NRP
next yvalue
screenunlock
Sleep 1
loop until MultiKey(1)
Re: Isometric shadow casting light.
to try to get a speed comparision while getting around my FPS limit bug, I used Dodi's timer method
I am getting something like average speed New Way = .0019, Old Way = .0018
the new way should be faster, significantly faster - no boundary checks, no other crap.....
will now incorporate the mem_clear business and see what is going on there....
here is test code:
I am getting something like average speed New Way = .0019, Old Way = .0018
the new way should be faster, significantly faster - no boundary checks, no other crap.....
will now incorporate the mem_clear business and see what is going on there....
here is test code:
Code: Select all
' =====================================================
' ===== CONVEX or CONVEX POLYGON FILL ROUTINE =======
' =====================================================
type vertice
x as integer
y as integer
side as integer ' this value is either -1,0, or 1... -1 means left side, 0 means both sides, 1 means right side (both sides is a top or bottom point)
NLP as integer ' the next left side point ...most points will only have a value in one of these, depending if it is a left or right point
NRP as integer ' the next right side point
Lslp as double ' this is the slope from this point towards the next point ON THE LEFT SIDE! ...most points will only have a value in one of these, depending if it is a left or right point
Rslp as double ' this is the slope from this point towards the next point ON THE RIGHT SIDE!
end type
dim shared as vertice points(5)
dim shared as integer NumOfPoints
dim shared as integer Key, extraspace, loops = 0
Dim As Integer fps,fp
Dim As Double times
screenres 800,600,32
'randomize timer
Dim As Double t, avTime
for looper as integer = 1 to 30
t=Timer
ScreenLock
Cls
If Timer-1>times Then times=Timer:fps=fp:fp=0
fp+=1
locate 1,1
Print fps
'
' make random points (within designated areas...) and show them
'
NumOfPoints = 5 : Points(0).x = NumOfPoints
points(1).x = int(rnd*390)+11 'upper left
points(1).y = int(rnd*290)+11
points(2).x = int(rnd*390)+401 'upper right
points(2).y = int(rnd*290)+11
points(3).x = int(rnd*190)+11 'center left
points(3).y = int(rnd*200)+301
points(4).x = int(rnd*190)+601 'center right
points(4).y = int(rnd*200)+301
points(5).x = int(rnd*400)+201 'bottom center
points(5).y = int(rnd*90)+501
for p as integer = 1 to NumOfPoints
Circle (points(p).x, points(p).y), 4, RGB(255,0,0) ,,,, f
next p
' ======================================================================
' ============== ENTER ROUTINE HERE
' ============== with all points in array points(5)
' ============== points(0).x = NumberOfPoints (should be four or five)
' ======================================================================
NumOfPoints = Points(0).x
'
'sort the array of points, from top to bottom, and left to right
'
dim as integer exchange = 1, passnum = NumOfPoints - 1
while passnum > 0 and exchange = 1
exchange = 0
for i as integer = 1 to passnum
if points(i).y > points(i+1).y then
exchange = 1
swap points(i), points(i+1)
end if
' if the Y values are same, then sort based on x values...
if points(i).y = points(i+1).y then
if points(i).x > points(i+1).x then
exchange = 1
swap points(i), points(i+1)
end if
end if
next i
passnum -= 1
wend
'
' find Top-Most and Bottom-Most points, show them
'
circle (points(1).x, points(1).y), 5, RGB(255,255,255) ' top
circle (points(NumOfPoints).x, points(NumOfPoints).y), 5, RGB(255,255,255) ' bottom
'
' calc main left/right dividing slope...
'
dim as integer TLP, TRP
dim as double MainSlope, CurSlope
MainSlope = (points(1).x - points(NumOfPoints).x) / (points(1).y - points(NumOfPoints).y) '<--- this is the slope of the line from top to bottom points
'
' compare the Main Slope to the slope to each of the other points to determine if each point is 'left' or 'right'
for p as integer = 2 to NumOfPoints-1
CurSlope = (points(1).x - points(p).x) / (points(1).y - points(p).y)
if CurSlope < MainSlope then
points(p).side = -1 '<---left side
else
points(p).side = 1 '<---right side
end if
next p
TLP = 1 ' set top Left Point to the first point
TRP = 1 ' set Top Right Point same as Top Left Point
points(1).side = 0 ' set first point side to 0 (means is on BOTH sides)
' check for same y value of first two points
if points(1).y = points(2).y then
points(2).side = 1 ' set second point to RIGHT side only
points(1).side = -1 ' set first point to LEFT side only, 0 means BOTH sides
TRP = 2 ' set Top Right Point to the second point
end if
' NOW, figure out the slopes of each point ot the next point on same side!
' This is where we figure out all the slopes, from one point to the next in line, for each side
' we will need these as we start filling the polygon and come to the next point/corner where we
' will change the slope value that we add to the left side X-value
dim as integer curleftpoint = TLP, currightpoint = TRP, nextLeft, nextRight
' find all the left points, calc each slope
do
' find next left point
nextLeft = curleftpoint
do
nextLeft += 1
loop while points(nextLeft).side > 0
' got the next left, now calc slope to it from current left
points(curleftpoint).Lslp = (points(curleftpoint).x - points(nextLeft).x) / (points(curleftpoint).y - points(nextLeft).y)
' save this next point
points(curleftpoint).NLP = nextLeft
curleftpoint = nextLeft
loop while points(nextleft).side <> 0 'until at bottom point
' find all the right points, calc each slope
do
' find next right point
nextRight = currightpoint
do
nextRight += 1
loop while points(nextRight).side < 0
' got the next right, now calc slope to it from current right
points(currightpoint).Rslp = (points(currightpoint).x - points(nextRight).x) / (points(currightpoint).y - points(nextRight).y)
' save this next point
points(currightpoint).NRP = nextRight
currightpoint = nextRight
loop while points(nextRight).side <> 0 'until at bottom point
' ok, now we got a sorted array of points, each identified as to which 'side' they are on, with the slopes from one point to the next point on the same side stored
' lets determine how many yvalues there will be in total...
dim as integer NumOfYvalues = points(NumOfPoints).y - points(1).y + 1
' set the initial x-values for both sides..
dim as double Lx = points(TLP).x , Rx = points(TRP).x
' set the current point for each side
dim as integer CLP = TLP, CRP = TRP
' this is where the magic happens....
' Lx and Rx are the current x-values for each side
' points(CLP).Lslp and points(CRP).Rslp are the slopes (change in X) for the current point on each side (CLP=Current Left Point, CRP=Current Right Point)
' Lslp = Left Slope, Rslp = Right Slope... these are DOUBLES, not integers
'
' for direct screen access
Dim As Integer w, h, bypp, pitch
ScreenInfo w, h, , bypp, pitch
Dim buffer As Any Ptr = ScreenPtr()
Dim As Any Ptr row = buffer + (pitch * Cint(points(1).y))
Dim As UInteger Ptr pixel
dim as integer tester = 0 ' change to 0 for OldWay line draw, 1 = new way
for yvalue as integer = points(1).y + 1 to points(NumOfPoints).y 'iterate through all the yvalues
' calc the x-value for this y value for both Left and Right
Lx += points(CLP).Lslp : Rx += points(CRP).Rslp
select case tester
case 0 ' OLD SLOW LINE DRAW METHOD
' draw the line between the to xvalues at this yvalue
line (int(Lx), yvalue) - (int(Rx), yvalue), rgb(0,255,0)
case 1 ' NEW WAY
' fast line draw!
' increment the row address (y-value) each time...
row += pitch
' calc starting x-value address
pixel = row + (Cint(Lx) shl 2)
for q as integer = int(Lx) to int(Rx)+1 ' length of row in pixels
*pixel= RGB(0,0,255)
pixel += 1
next q
case 2 ' SUPER New Way with mem_clear method
end select
' check to see if reached next left/right points...
' change current left point to the next left point!
if yvalue >= points(points(CLP).NLP).y then CLP = points(CLP).NLP
' change current right point to the next right point!
if yvalue >= points(points(CRP).NRP).y then CRP = points(CRP).NRP
next yvalue
screenunlock
Locate 3,3
Print "Time taken ";Timer-t
avTime += (Timer-t)
Sleep 1
Locate 5,3
Print "Average Time taken for 30 loops ";avTime/30
next looper
sleep
'loop until MultiKey(1)
Re: Isometric shadow casting light.
I am getting around 500 fps with line and *pixel, but *pixel is a few fps faster.
Sometimes this box drops to 60 fps and stays there in graphics applications.
I think it is OS stuff.
Are you online during testing, sometimes java script in web pages in the background affects speed.
You could try
SetEnviron("fbgfx=GDI")
at the top of the code.
Sometimes this box drops to 60 fps and stays there in graphics applications.
I think it is OS stuff.
Are you online during testing, sometimes java script in web pages in the background affects speed.
You could try
SetEnviron("fbgfx=GDI")
at the top of the code.
Re: Isometric shadow casting light.
getting weird test readings, i don't trust my rig right now, stupid 60fps limiter!
... there are 4 different methods in this... check them out and see what you get....
... there are 4 different methods in this... check them out and see what you get....
Code: Select all
' =====================================================
' ===== CONVEX or CONVEX POLYGON FILL ROUTINE =======
' =====================================================
type vertice
x as integer
y as integer
side as integer ' this value is either -1,0, or 1... -1 means left side, 0 means both sides, 1 means right side (both sides is a top or bottom point)
NLP as integer ' the next left side point ...most points will only have a value in one of these, depending if it is a left or right point
NRP as integer ' the next right side point
Lslp as double ' this is the slope from this point towards the next point ON THE LEFT SIDE! ...most points will only have a value in one of these, depending if it is a left or right point
Rslp as double ' this is the slope from this point towards the next point ON THE RIGHT SIDE!
end type
dim shared as vertice points(5)
dim shared as integer NumOfPoints
dim shared as integer Key, extraspace, loops = 0
Dim As Integer fps,fp
Dim As Double times
screenres 800,600,32
'randomize timer
Dim As Double t, avTime
' including CRT.bi for memory functions...
#Include "crt.bi"
for looper as integer = 1 to 30
t=Timer
ScreenLock
Cls
If Timer-1>times Then times=Timer:fps=fp:fp=0
fp+=1
locate 1,1
Print fps
'
' make random points (within designated areas...) and show them
'
NumOfPoints = 5 : Points(0).x = NumOfPoints
points(1).x = int(rnd*390)+11 'upper left
points(1).y = int(rnd*290)+11
points(2).x = int(rnd*390)+401 'upper right
points(2).y = int(rnd*290)+11
points(3).x = int(rnd*190)+11 'center left
points(3).y = int(rnd*200)+301
points(4).x = int(rnd*190)+601 'center right
points(4).y = int(rnd*200)+301
points(5).x = int(rnd*400)+201 'bottom center
points(5).y = int(rnd*90)+501
for p as integer = 1 to NumOfPoints
Circle (points(p).x, points(p).y), 4, RGB(255,0,0) ,,,, f
next p
' ======================================================================
' ============== ENTER ROUTINE HERE
' ============== with all points in array points(5)
' ============== points(0).x = NumberOfPoints (should be four or five)
' ======================================================================
NumOfPoints = Points(0).x
'
'sort the array of points, from top to bottom, and left to right
'
dim as integer exchange = 1, passnum = NumOfPoints - 1
while passnum > 0 and exchange = 1
exchange = 0
for i as integer = 1 to passnum
if points(i).y > points(i+1).y then
exchange = 1
swap points(i), points(i+1)
end if
' if the Y values are same, then sort based on x values...
if points(i).y = points(i+1).y then
if points(i).x > points(i+1).x then
exchange = 1
swap points(i), points(i+1)
end if
end if
next i
passnum -= 1
wend
'
' find Top-Most and Bottom-Most points, show them
'
circle (points(1).x, points(1).y), 5, RGB(255,255,255) ' top
circle (points(NumOfPoints).x, points(NumOfPoints).y), 5, RGB(255,255,255) ' bottom
'
' calc main left/right dividing slope...
'
dim as integer TLP, TRP
dim as double MainSlope, CurSlope
MainSlope = (points(1).x - points(NumOfPoints).x) / (points(1).y - points(NumOfPoints).y) '<--- this is the slope of the line from top to bottom points
'
' compare the Main Slope to the slope to each of the other points to determine if each point is 'left' or 'right'
for p as integer = 2 to NumOfPoints-1
CurSlope = (points(1).x - points(p).x) / (points(1).y - points(p).y)
if CurSlope < MainSlope then
points(p).side = -1 '<---left side
else
points(p).side = 1 '<---right side
end if
next p
TLP = 1 ' set top Left Point to the first point
TRP = 1 ' set Top Right Point same as Top Left Point
points(1).side = 0 ' set first point side to 0 (means is on BOTH sides)
' check for same y value of first two points
if points(1).y = points(2).y then
points(2).side = 1 ' set second point to RIGHT side only
points(1).side = -1 ' set first point to LEFT side only, 0 means BOTH sides
TRP = 2 ' set Top Right Point to the second point
end if
' NOW, figure out the slopes of each point ot the next point on same side!
' This is where we figure out all the slopes, from one point to the next in line, for each side
' we will need these as we start filling the polygon and come to the next point/corner where we
' will change the slope value that we add to the left side X-value
dim as integer curleftpoint = TLP, currightpoint = TRP, nextLeft, nextRight
' find all the left points, calc each slope
do
' find next left point
nextLeft = curleftpoint
do
nextLeft += 1
loop while points(nextLeft).side > 0
' got the next left, now calc slope to it from current left
points(curleftpoint).Lslp = (points(curleftpoint).x - points(nextLeft).x) / (points(curleftpoint).y - points(nextLeft).y)
' save this next point
points(curleftpoint).NLP = nextLeft
curleftpoint = nextLeft
loop while points(nextleft).side <> 0 'until at bottom point
' find all the right points, calc each slope
do
' find next right point
nextRight = currightpoint
do
nextRight += 1
loop while points(nextRight).side < 0
' got the next right, now calc slope to it from current right
points(currightpoint).Rslp = (points(currightpoint).x - points(nextRight).x) / (points(currightpoint).y - points(nextRight).y)
' save this next point
points(currightpoint).NRP = nextRight
currightpoint = nextRight
loop while points(nextRight).side <> 0 'until at bottom point
' ok, now we got a sorted array of points, each identified as to which 'side' they are on, with the slopes from one point to the next point on the same side stored
' lets determine how many yvalues there will be in total...
dim as integer NumOfYvalues = points(NumOfPoints).y - points(1).y + 1
' set the initial x-values for both sides..
dim as double Lx = points(TLP).x , Rx = points(TRP).x
' set the current point for each side
dim as integer CLP = TLP, CRP = TRP
' this is where the magic happens....
' Lx and Rx are the current x-values for each side
' points(CLP).Lslp and points(CRP).Rslp are the slopes (change in X) for the current point on each side (CLP=Current Left Point, CRP=Current Right Point)
' Lslp = Left Slope, Rslp = Right Slope... these are DOUBLES, not integers
'
' for direct screen access
Dim As Integer w, h, bypp, pitch
ScreenInfo w, h, , bypp, pitch
Dim buffer As Any Ptr = ScreenPtr()
Dim As Any Ptr row = buffer + (pitch * Cint(points(1).y))
Dim As UInteger Ptr pixel
dim as integer tester = 0 ' change to 0 for OldWay line draw, 1 = new way
for yvalue as integer = points(1).y + 1 to points(NumOfPoints).y 'iterate through all the yvalues
' calc the x-value for this y value for both Left and Right
Lx += points(CLP).Lslp : Rx += points(CRP).Rslp
dim as uinteger NumOfBytes = (int(Rx)-int(Lx)+1) shl 2
select case tester
case 0 ' OLD SLOW LINE DRAW METHOD
' draw the line between the to xvalues at this yvalue
line (int(Lx), yvalue) - (int(Rx), yvalue), rgb(0,255,0)
case 1 ' NEW WAY
' fast line draw!
' increment the row address (y-value) each time...
row += pitch
' calc starting x-value address
pixel = row + (Cint(Lx) shl 2)
for q as integer = int(Lx) to int(Rx)+1 ' length of row in pixels
*pixel= RGB(0,0,255)
pixel += 1
next q
case 2 ' SUPER New Way with mem_set method
' fast line draw!
' increment the row address (y-value) each time...
row += pitch
' calc starting x-value address
pixel = row + (Cint(Lx) shl 2)
memset pixel, &hFFFFFFFF, NumOfBytes
case 3 ' another SUPER New Way with mem_clear method
' fast line draw!
' increment the row address (y-value) each time...
row += pitch
' calc starting x-value address
pixel = row + (Cint(Lx) shl 2)
Clear *pixel, 0, NumOfBytes
end select
' check to see if reached next left/right points...
' change current left point to the next left point!
if yvalue >= points(points(CLP).NLP).y then CLP = points(CLP).NLP
' change current right point to the next right point!
if yvalue >= points(points(CRP).NRP).y then CRP = points(CRP).NRP
next yvalue
screenunlock
Locate 3,3
Print "Time taken ";Timer-t
avTime += (Timer-t)
Sleep 1
Locate 5,3
Print "Average Time taken for 30 loops ";avTime/30
next looper
sleep
'loop until MultiKey(1)
Re: Isometric shadow casting light.
"SetEnviron("fbgfx=GDI")" didn't have effect... its really strange. Since I did tests with various SLEEP values (1 thru 11 all resulted in same FPS), that tells me that it might be video related? I don't know.... I would gues the program is running fast, but (maybe in conjunction with either screenlock/unlock and/or sleep, something caps the video speed.... no, that doesn't make sense unless somehow the program was 'waiting' for something during that time, like a vsync (which would explain the 60 fps limit, right?)dodicat wrote:I am getting around 500 fps with line and *pixel, but *pixel is a few fps faster.
Sometimes this box drops to 60 fps and stays there in graphics applications.
I think it is OS stuff.
Are you online during testing, sometimes java script in web pages in the background affects speed.
You could try
SetEnviron("fbgfx=GDI")
at the top of the code.
what Π$/- me off is that 'sometimes' I get to see the real speed... I ran that test program and was getting 300fps, then it dropped down to 65.... cant get it to over 65 now though...
I did test running code with no other programs running (not online or anything), from a fresh restart of computer...
Re: Isometric shadow casting light.
another strange thing... when I run the speed test which just shows how much time the routine takes, I get around .0019 or .0018... but those translate to 1/.0018 = 555fps! so it is speeding through them, repeatedly, because the times are averaged over 30 loops... its like the fps counter is off somehow?! lol
Re: Isometric shadow casting light.
With this box (Win 10)
If I am online (The forum page) with Google Chrome I get full speed.
If I stop Google (shut down the browser) I get 60 ish fps.
If I am online (The forum page) with Google Chrome I get full speed.
If I stop Google (shut down the browser) I get 60 ish fps.
Re: Isometric shadow casting light.
totally weird! I use FireFox, maybe should start using Chrome! but I think I gots me some sort of virus also... figures....dodicat wrote:With this box (Win 10)
If I am online (The forum page) with Google Chrome I get full speed.
If I stop Google (shut down the browser) I get 60 ish fps.
Here is something for ya:
Test Results from adjusted code:
Method.....With CLS.....No CLS
___0______684_________2399
___0______754_________2404
___0______760_________2527
___1______604
___1______606
___1______584
___2______722
___2______740
___2______736
___3______821_________3355
___3______788_________3106
___3______797_________3219
looks like it is hard to beat using the LINE command in FB, except for method #3.... best thing in ALL cases is to get rid of CLS! lol
here is code, I ran it 3 times for each test method to get the scores above
Code: Select all
'' =====================================================
' ===== CONVEX or CONVEX POLYGON FILL ROUTINE =======
' =====================================================
type vertice
x as integer
y as integer
side as integer ' this value is either -1,0, or 1... -1 means left side, 0 means both sides, 1 means right side (both sides is a top or bottom point)
NLP as integer ' the next left side point ...most points will only have a value in one of these, depending if it is a left or right point
NRP as integer ' the next right side point
Lslp as double ' this is the slope from this point towards the next point ON THE LEFT SIDE! ...most points will only have a value in one of these, depending if it is a left or right point
Rslp as double ' this is the slope from this point towards the next point ON THE RIGHT SIDE!
end type
dim shared as vertice points(5)
dim shared as integer NumOfPoints
dim shared as integer Key, extraspace, loops = 0
Dim As Integer fps,fp
Dim As Double times
screenres 800,600,32
'randomize timer
Dim As Double t, tf, totalTime=0, averTime=0, totalTimeFILL=0
' including CRT.bi for memory functions...
#Include "crt.bi"
for looper as integer = 1 to 300
ScreenLock
t=Timer
Cls
' If Timer-1>times Then times=Timer:fps=fp:fp=0
' fp+=1
' locate 1,1
' Print fps
'
' make random points (within designated areas...) and show them
'
NumOfPoints = 5 : Points(0).x = NumOfPoints
points(1).x = int(rnd*390)+11 'upper left
points(1).y = int(rnd*290)+11
points(2).x = int(rnd*390)+401 'upper right
points(2).y = int(rnd*290)+11
points(3).x = int(rnd*190)+11 'center left
points(3).y = int(rnd*200)+301
points(4).x = int(rnd*190)+601 'center right
points(4).y = int(rnd*200)+301
points(5).x = int(rnd*400)+201 'bottom center
points(5).y = int(rnd*90)+501
for p as integer = 1 to NumOfPoints
Circle (points(p).x, points(p).y), 4, RGB(255,0,0) ,,,, f
next p
' ======================================================================
' ============== ENTER ROUTINE HERE
' ============== with all points in array points(5)
' ============== points(0).x = NumberOfPoints (should be four or five)
' ======================================================================
NumOfPoints = Points(0).x
'
'sort the array of points, from top to bottom, and left to right
'
dim as integer exchange = 1, passnum = NumOfPoints - 1
while passnum > 0 and exchange = 1
exchange = 0
for i as integer = 1 to passnum
if points(i).y > points(i+1).y then
exchange = 1
swap points(i), points(i+1)
end if
' if the Y values are same, then sort based on x values...
if points(i).y = points(i+1).y then
if points(i).x > points(i+1).x then
exchange = 1
swap points(i), points(i+1)
end if
end if
next i
passnum -= 1
wend
'
' find Top-Most and Bottom-Most points, show them
'
circle (points(1).x, points(1).y), 5, RGB(255,255,255) ' top
circle (points(NumOfPoints).x, points(NumOfPoints).y), 5, RGB(255,255,255) ' bottom
'
' calc main left/right dividing slope...
'
dim as integer TLP, TRP
dim as double MainSlope, CurSlope
MainSlope = (points(1).x - points(NumOfPoints).x) / (points(1).y - points(NumOfPoints).y) '<--- this is the slope of the line from top to bottom points
'
' compare the Main Slope to the slope to each of the other points to determine if each point is 'left' or 'right'
for p as integer = 2 to NumOfPoints-1
CurSlope = (points(1).x - points(p).x) / (points(1).y - points(p).y)
if CurSlope < MainSlope then
points(p).side = -1 '<---left side
else
points(p).side = 1 '<---right side
end if
next p
TLP = 1 ' set top Left Point to the first point
TRP = 1 ' set Top Right Point same as Top Left Point
points(1).side = 0 ' set first point side to 0 (means is on BOTH sides)
' check for same y value of first two points
if points(1).y = points(2).y then
points(2).side = 1 ' set second point to RIGHT side only
points(1).side = -1 ' set first point to LEFT side only, 0 means BOTH sides
TRP = 2 ' set Top Right Point to the second point
end if
' NOW, figure out the slopes of each point ot the next point on same side!
' This is where we figure out all the slopes, from one point to the next in line, for each side
' we will need these as we start filling the polygon and come to the next point/corner where we
' will change the slope value that we add to the left side X-value
dim as integer curleftpoint = TLP, currightpoint = TRP, nextLeft, nextRight
' find all the left points, calc each slope
do
' find next left point
nextLeft = curleftpoint
do
nextLeft += 1
loop while points(nextLeft).side > 0
' got the next left, now calc slope to it from current left
points(curleftpoint).Lslp = (points(curleftpoint).x - points(nextLeft).x) / (points(curleftpoint).y - points(nextLeft).y)
' save this next point
points(curleftpoint).NLP = nextLeft
curleftpoint = nextLeft
loop while points(nextleft).side <> 0 'until at bottom point
' find all the right points, calc each slope
do
' find next right point
nextRight = currightpoint
do
nextRight += 1
loop while points(nextRight).side < 0
' got the next right, now calc slope to it from current right
points(currightpoint).Rslp = (points(currightpoint).x - points(nextRight).x) / (points(currightpoint).y - points(nextRight).y)
' save this next point
points(currightpoint).NRP = nextRight
currightpoint = nextRight
loop while points(nextRight).side <> 0 'until at bottom point
' ok, now we got a sorted array of points, each identified as to which 'side' they are on, with the slopes from one point to the next point on the same side stored
' lets determine how many yvalues there will be in total...
dim as integer NumOfYvalues = points(NumOfPoints).y - points(1).y + 1
' set the initial x-values for both sides..
dim as double Lx = points(TLP).x , Rx = points(TRP).x
' set the current point for each side
dim as integer CLP = TLP, CRP = TRP
' this is where the magic happens....
' Lx and Rx are the current x-values for each side
' points(CLP).Lslp and points(CRP).Rslp are the slopes (change in X) for the current point on each side (CLP=Current Left Point, CRP=Current Right Point)
' Lslp = Left Slope, Rslp = Right Slope... these are DOUBLES, not integers
'
' for direct screen access
Dim As Integer w, h, bypp, pitch
ScreenInfo w, h, , bypp, pitch
Dim buffer As Any Ptr = ScreenPtr()
Dim As Any Ptr row = buffer + (pitch * Cint(points(1).y))
Dim As UInteger Ptr pixel
dim as integer tester = 0 ' change to 0 for OldWay line draw, 1 = new way
tf = Timer
for yvalue as integer = points(1).y + 1 to points(NumOfPoints).y 'iterate through all the yvalues
' calc the x-value for this y value for both Left and Right
Lx += points(CLP).Lslp : Rx += points(CRP).Rslp
dim as uinteger NumOfBytes = (int(Rx)-int(Lx)+1) shl 2
select case tester
case 0 ' OLD SLOW LINE DRAW METHOD
' draw the line between the to xvalues at this yvalue
line (int(Lx), yvalue) - (int(Rx), yvalue), rgb(0,255,0)
case 1 ' NEW WAY
' fast line draw!
' increment the row address (y-value) each time...
row += pitch
' calc starting x-value address
pixel = row + (Cint(Lx) shl 2)
for q as integer = int(Lx) to int(Rx)+1 ' length of row in pixels
*pixel= &hFFFFFFFF 'RGB(0,0,255)
pixel += 1
next q
case 2 ' SUPER New Way with mem_set method
' fast line draw!
' increment the row address (y-value) each time...
row += pitch
' calc starting x-value address
pixel = row + (Cint(Lx) shl 2)
memset pixel, &hFF, NumOfBytes
case 3 ' another SUPER New Way with mem_clear method
' fast line draw!
' increment the row address (y-value) each time...
row += pitch
' calc starting x-value address
pixel = row + (Cint(Lx) shl 2)
Clear *pixel, 0, NumOfBytes
end select
' check to see if reached next left/right points...
' change current left point to the next left point!
if yvalue >= points(points(CLP).NLP).y then CLP = points(CLP).NLP
' change current right point to the next right point!
if yvalue >= points(points(CRP).NRP).y then CRP = points(CRP).NRP
next yvalue
totalTimeFILL += (Timer-tf)
totalTime += (Timer-t)
screenunlock
Sleep 1
next looper
Locate 5,3
averTime = totalTime / 300
Print "Average Time taken for 300 loops ";averTime
Locate 7,3
fps = 1/averTime
Print "Which translates into ";fps;" FPS"
Locate 9,3
averTime = totalTimeFILL / 300
Print "Average Time taken for 300 loops(FILL ONLY) ";averTime
Locate 11,3
fps = 1/averTime
Print "Which translates into ";fps;" FPS (FILL ONLY)"
sleep
'loop until MultiKey(1)
limitations with method 2 & 3 are they only fill using a single byte... so clear to black or white or alpha grays....
Last edited by leopardpm on Apr 03, 2017 4:34, edited 2 times in total.
Re: Isometric shadow casting light.
just saw I made a mistake on method 2, it is currently:
memset pixel, &hFFFFFFFF, NumOfBytes
it should be:
memset pixel, &hFF, NumOfBytes
as it does it byte by byte, this change makes method 2 consistently a 'bit' faster than method 0 (LINE method) by maybe 20 FPS
memset pixel, &hFFFFFFFF, NumOfBytes
it should be:
memset pixel, &hFF, NumOfBytes
as it does it byte by byte, this change makes method 2 consistently a 'bit' faster than method 0 (LINE method) by maybe 20 FPS