Isometric shadow casting light.

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

Re: Isometric shadow casting light.

Postby leopardpm » Apr 02, 2017 23:02

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: 1597
Joined: Feb 28, 2009 20:58

Re: Isometric shadow casting light.

Postby leopardpm » Apr 02, 2017 23:21

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

leopardpm
Posts: 1597
Joined: Feb 28, 2009 20:58

Re: Isometric shadow casting light.

Postby leopardpm » Apr 03, 2017 0:18

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

Re: Isometric shadow casting light.

Postby dodicat » Apr 03, 2017 0:58

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

Re: Isometric shadow casting light.

Postby leopardpm » Apr 03, 2017 1:14

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

Re: Isometric shadow casting light.

Postby leopardpm » Apr 03, 2017 1:17

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: 1597
Joined: Feb 28, 2009 20:58

Re: Isometric shadow casting light.

Postby leopardpm » Apr 03, 2017 1:39

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

Re: Isometric shadow casting light.

Postby leopardpm » Apr 03, 2017 2:06

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

Re: Isometric shadow casting light.

Postby dodicat » Apr 03, 2017 2:42

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: 1597
Joined: Feb 28, 2009 20:58

Re: Isometric shadow casting light.

Postby leopardpm » Apr 03, 2017 2:49

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

Re: Isometric shadow casting light.

Postby leopardpm » Apr 03, 2017 2:59

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: 1597
Joined: Feb 28, 2009 20:58

Re: Isometric shadow casting light.

Postby leopardpm » Apr 03, 2017 3:06

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: 5164
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Isometric shadow casting light.

Postby dodicat » Apr 03, 2017 3:08

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: 1597
Joined: Feb 28, 2009 20:58

Re: Isometric shadow casting light.

Postby leopardpm » Apr 03, 2017 3:53

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:

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)


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: 1597
Joined: Feb 28, 2009 20:58

Re: Isometric shadow casting light.

Postby leopardpm » Apr 03, 2017 4:11

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

Return to “Game Dev”

Who is online

Users browsing this forum: No registered users and 2 guests