Game development specific discussions.
leopardpm
Posts: 1795
Joined: Feb 28, 2009 20:58

### Re: Isometric shadow casting light.

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.
I always appreciate you chiming in, if I pay attention I can learn something with every interaction - you are a code warrior!
leopardpm
Posts: 1795
Joined: Feb 28, 2009 20:58

### 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:

Code: Select all

`        pixel = row + (int(Lx) * 4)`

here are the types:

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`

complete program:

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 typedim shared as vertice points(5)dim shared as integer NumOfPointsdim shared as integer Key, extraspace, loops = 0' for direct screen accessDim As Integer w, h, bypp, pitchscreenres 800,600,32randomize timerdo    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 = getkeyloop until Key = 27`
leopardpm
Posts: 1795
Joined: Feb 28, 2009 20:58

### 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 typedim shared as vertice points(5)dim shared as integer NumOfPointsdim shared as integer Key, extraspace, loops = 0' for direct screen accessDim As Integer w, h, bypp, pitchscreenres 800,600,32randomize timerdo    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 = getkeyloop until Key = 27`
dodicat
Posts: 6357
Joined: Jan 10, 2006 20:30
Location: Scotland

### 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.

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 typedim shared as vertice points(5)dim shared as integer NumOfPointsdim shared as integer Key, extraspace, loops = 0' for direct screen accessDim As Integer w, h, bypp, pitchscreenres 800,600,32' for direct screen accessScreenInfo w, h, , bypp, pitchDim buffer As Any Ptr = ScreenPtr()Dim As Any Ptr row = screenptr'buffer'randomize timerdo    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).NRPscreenunlock        sleep 1     next yvalue    beep    Key = getkeyloop until Key = 27 `
leopardpm
Posts: 1795
Joined: Feb 28, 2009 20:58

### 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!

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 typedim shared as vertice points(5)dim shared as integer NumOfPointsdim shared as integer Key, extraspace, loops = 0screenres 800,600,32'randomize timerdo    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 = getkeyloop until Key = 27`
leopardpm
Posts: 1795
Joined: Feb 28, 2009 20:58

### Re: Isometric shadow casting light.

Dodi, I am confused... how does this statement 'reset' the row? Doesn't it ADD more to it?

Code: Select all

`    row+=pitch*yy   'reset row for starters`

oh, wait... I found where you actually reset it - you added a statement at beginning of DO loop... got it
leopardpm
Posts: 1795
Joined: Feb 28, 2009 20:58

### 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?!

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 typedim shared as vertice points(5)dim shared as integer NumOfPointsdim shared as integer Key, extraspace, loops = 0Dim As Integer fps,fpDim As Double timesscreenres 800,600,32'randomize timerDo   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 1loop until MultiKey(1)`
leopardpm
Posts: 1795
Joined: Feb 28, 2009 20:58

### 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:

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 typedim shared as vertice points(5)dim shared as integer NumOfPointsdim shared as integer Key, extraspace, loops = 0Dim As Integer fps,fpDim As Double timesscreenres 800,600,32'randomize timerDim As Double t, avTimefor 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/30next loopersleep'loop until MultiKey(1)`
dodicat
Posts: 6357
Joined: Jan 10, 2006 20:30
Location: Scotland

### 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.
leopardpm
Posts: 1795
Joined: Feb 28, 2009 20:58

### 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....

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 typedim shared as vertice points(5)dim shared as integer NumOfPointsdim shared as integer Key, extraspace, loops = 0Dim As Integer fps,fpDim As Double timesscreenres 800,600,32'randomize timerDim 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/30next loopersleep'loop until MultiKey(1)`
leopardpm
Posts: 1795
Joined: Feb 28, 2009 20:58

### Re: Isometric shadow casting light.

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.

"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?)

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...
leopardpm
Posts: 1795
Joined: Feb 28, 2009 20:58

### 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
dodicat
Posts: 6357
Joined: Jan 10, 2006 20:30
Location: Scotland

### 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.
leopardpm
Posts: 1795
Joined: Feb 28, 2009 20:58

### Re: Isometric shadow casting light.

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.

totally weird! I use FireFox, maybe should start using Chrome! but I think I gots me some sort of virus also... figures....

Here is something for ya:

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 typedim shared as vertice points(5)dim shared as integer NumOfPointsdim shared as integer Key, extraspace, loops = 0Dim As Integer fps,fpDim As Double timesscreenres 800,600,32'randomize timerDim 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 1next 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)`

updated code to reflect a FILL ONLY time as well, method 3 is about 20% faster than method 0, method 2 is 5% faster, and method 1 is 20% SLOWER than method 0... very surprising to me....

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.
leopardpm
Posts: 1795
Joined: Feb 28, 2009 20:58

### 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