Isometric shadow casting light.

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

Re: Isometric shadow casting light.

Post by leopardpm »

OMG! I think I got it fixed - just went off my last thought and decided to check for the yvalues instead of the icky x-values which were doubles, not naturally integers... so it was missing....

... and I discovered this works for ALL simple polygons, either concave OR convex... yeah! something useful!

This needs optimizing (is messy and there might be some shortcuts) and especially make it work with with direct memory graphics instead of the dopey LINE command and it will be good to go! I am gonna cross my fingers and say, "wow.. I am getting better at this programming stuff!"

Here is the code:

Code: Select all

' =====================================================
' =====  CONVEX or CONVEX POLYGON FILL ROUTINE  =======
' =====================================================

type vertice
    x as integer
    y as integer
    side as integer
    NLP as integer   ' the next left side 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!
    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)
    
    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
        else
            points(p).side = 1
        end if
        'print MainSlope, curSlope, p, points(p).side
    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!
    dim as integer curleftpoint = TLP, currightpoint = TRP, nextLeft, nextRight
    dim as integer q
    
    ' 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
    
    
'    locate 2,1 : print "Main Slope = ";MainSlope
'
'    for p as integer = 1 to NumOfPoints
'        print
'        print using "(#) (### / ###) side(##) Lslp(###.###)  Rslp(###.###)";p;points(p).x;points(p).y;points(p).side;points(p).Lslp;points(p).Rslp;
'    next p
'       

' ok, now we got a sorted array of points, each identified as to which 'side' they are on
' 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
    
    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

        ' draw the line between the to xvalues at this yvalue
        line (int(Lx), yvalue) - (int(Rx), yvalue), rgb(0,255,0)

        ' check to see if reached next left/right points...
        if yvalue >= points(points(CLP).NLP).y then
            ' change current left point to the next left point!
            CLP = points(CLP).NLP
        end if

        if yvalue >= points(points(CRP).NRP).y then
            ' change current right point to the next right point!
            CRP = points(CRP).NRP
        end if
        sleep 10
    next yvalue
beep

    Key = getkey
loop until Key = 27
leopardpm
Posts: 1795
Joined: Feb 28, 2009 20:58

Re: Isometric shadow casting light.

Post by leopardpm »

ok, apparently this routine is keeping me up tonight...

before I put the new polyfill routine into the existing shadow casting routine, I felt the overwhelming desire to do some housecleaning... besides some basic organizing, take a look at the actual Shadowcast subroutine and how I looped it up and made it more... something... hope you don't mind...

it is now ready to figure out the missing polygon points (light box corners) and then do our new polyfill (non-optimized yet, but I still bet it is faster than paint, even with slow FB line commands...

Code: Select all

'2d Quad-Shadow caster
'by Ezekiel Gutierrez and Leopardpm
'
'requires light.bmpx 800x400 for the glow
'
' ==============================================================================
' ================================== All CONST Here =============================
' ==============================================================================
    const scrw = 1280
    const scrh = 1024
    const pi = 4 * atn(1)
    const lw = 800, lh = 400, lwh = lw/2, lhh = lh/2
    const DtoR as double = pi / 180   ' degrees * DtoR = radians
' ==============================================================================
' ================================== All UDTs Here =============================
' ==============================================================================
    type point2d
        x as integer
        y as integer
    end type
    
    type box
        p(4) as point2d
        cntr as point2d
        declare sub draw(img as any ptr)
    end type
    
    type vertice
        x as integer
        y as integer
        side as integer
        NLP as integer   ' the next left side 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!
        Rslp as double   ' this is the slope from this point towards the next point ON THE RIGHT SIDE!
    end type

' ==============================================================================
' ================================== All DIMs Here =============================
' ==============================================================================
    dim as box boxes(99)
    dim as point2d plight1,plight2
    
' for PolyFill Routine
    dim shared as vertice points(5)

' for FPS routine
    dim as integer fps,frames
    dim as double prevtime

' for images
    dim as any ptr light, light1, light2, back, front
' ==============================================================================
' ================================== All Subroutines Here ======================
' ==============================================================================
Public Sub Lined(p1 as point2d,p2 as point2d,xs as integer,ys as integer,sw as integer,sh as integer,byref p3 as point2d)
    dim as Single xnew,ynew
    Dim As Single dx,dy,x3,y3,x2,y2,ynum,den,num,numadd,xinc1,xinc2,yinc1,yinc2
    
    x3 = p1.x : y3 = p1.y
    x2 = p2.x : y2 = p2.y
    dx = abs(x2 - x3) : dy = abs(y2 - y3) : xnew = x3 : ynew = y3
    
    if x2 >= x3 Then xinc1 = 1 : xinc2 = 1 else xinc1 = -1 : xinc2 = -1
    if y2 >= y3 Then yinc1 = 1 : yinc2 = 1 else yinc1 = -1 : yinc2 = -1
    
    if dx >= dy Then
        xinc1 = 0 : yinc2 = 0 : den = dx : num = dx / 2 : numadd = dy
    Else
        xinc2 = 0 : yinc1 = 0 : den = dy : num = dy / 2 : numadd = dx
    end if
    
    While 1
        if xnew > xs+sw then p3.x = xnew : p3.y=ynew : exit sub
        if xnew < xs    then p3.x = xnew : p3.y=ynew : exit sub
        if ynew > ys+sh then p3.x = xnew : p3.y=ynew : exit sub
        if ynew < ys    then p3.x = xnew : p3.y=ynew : exit sub
        num += numadd
        if num >= den Then num -= den : xnew += xinc1 : ynew += yinc1
        xnew += xinc2 : ynew += yinc2
    Wend
End Sub

public function getslope(p1 as point2d, _
                  p2 as point2d) as integer
        dim as integer xdif,ydif
        xdif = p2.x - p1.x
        ydif = p2.y - p1.y
        return atan2(ydif, xdif)*(180 / pi)
end function

public sub makepoint(angle as integer, plight as point2d, _
              p1 as point2d, _
              byref p2 as point2d)
    p2.x = p1.x - (Cos(angle*DtoR)*(200))
    p2.y = p1.y - (Sin(angle*DtoR)*(200))
    lined(p1,p2,plight.x-(lwh),plight.y-(lhh),lw,lh,p2)
end sub

sub box.draw(img as any ptr)
    line img,(p(1).x,p(1).y-20) - (p(2).x,p(2).y-20) ,rgb(255,0,0)
    line img,(p(2).x,p(2).y-20) - (p(2).x,p(2).y)    ,rgb(255,0,0)
    line img,(p(2).x,p(2).y)    - (p(4).x,p(4).y)    ,rgb(255,0,0)
    line img,(p(3).x,p(3).y)    - (p(4).x,p(4).y)    ,rgb(255,0,0)
    line img,(p(3).x,p(3).y)    - (p(3).x,p(3).y-20) ,rgb(255,0,0)
    line img,(p(3).x,p(3).y-20) - (p(1).x,p(1).y-20) ,rgb(255,0,0)
    line img,(p(4).x,p(4).y)    - (p(4).x,p(4).y-20) ,rgb(255,0,0)
    line img,(p(2).x,p(2).y-20) - (p(4).x,p(4).y-20) ,rgb(255,0,0)
    line img,(p(3).x,p(3).y-20) - (p(4).x,p(4).y-20) ,rgb(255,0,0)
    paint img,(p(1).x+1,p(1).y+3) ,rgb(50,0,0),  rgb(255,0,0)
    paint img,(p(1).x-1,p(1).y+3) ,rgb(100,0,0), rgb(255,0,0)
    paint img,(p(1).x,p(1).y-1)   ,rgb(255,0,0), rgb(255,0,0)
end sub

sub shadowcast(box1 as box,plight as point2d,img as any ptr,col as Integer)
    dim as point2d polyPNT(5)
    dim as integer slope(4), k(4)
    dim as integer HiVal=-9999, LoVal = 9999, midPNT = (box1.p(2).x + box1.p(3).x)/2
    
    'calculate differences for each point
    with box1
        for p as integer = 1 to 4
            slope(p) = getslope(.p(p),plight)'+180
            if slope(p) > 0 andalso plight.x < midPNT then slope(p) -= 360
            ' find points with the highest and lowest slopes
            if slope(p) > HiVal then HiVal = slope(p) : polyPNT(2) = .p(p)
            if slope(p) < LoVal then LoVal = slope(p) : polyPNT(3) = .p(p)
        next p
    end with
    
    'use selected points
    makepoint(HiVal, plight, polyPNT(2), polyPNT(1))'create first point
    makepoint(LoVal, plight, polyPNT(3), polyPNT(4))'create second point
    
    'P(1-4) are all the polygon points EXCEPT any corners of the light box...

    ' adjust values for light box position on screen
    for p as integer = 1 to 4
        polyPNT(p).x -= plight.x - lwh
        polyPNT(p).y -= plight.y - lhh
    next p
    
    for p as integer = 1 to 3
        Line img,(polyPNT(p).x, polyPNT(p).y)-(polyPNT(p+1).x, polyPNT(p+1).y), rgba(col,0,0,0)
    next p
    
    'fill shadow outline
    paint img,((polyPNT(1).x+polyPNT(2).x+polyPNT(3).x+polyPNT(4).x)/4, _
               (polyPNT(1).y+polyPNT(2).y+polyPNT(3).y+polyPNT(4).y)/4),rgba(col,0,0,0),rgba(col,0,0,0)
end sub
' ==============================================================================================
' ================================================== END OF SUBS
' ==============================================================================================


' ==============================================================================================
' ================================================== Initialization
' ==============================================================================================

    screenres scrw,scrh,32
    color rgb(255,255,255),rgb(0,0,0)
    
' Define Boxes
    for y as integer=0 to 9
        For x As Integer=0 To 10
            with boxes(x+(y*10))
                .p(1).x=100+(x*80) 'box
                .p(1).y=90 +(y*80)'    co-ordinate 1
                .p(2).x=80+(x*80)'box
                .p(2).y=100+(y*80)'    co-ordinate 2
                .p(3).x=120+(x*80)'box
                .p(3).y=100+(y*80)'    co-ordinate 3
                .p(4).x=100+(x*80)'box
                .p(4).y=110+(y*80)'    co-ordinate 4
                .cntr.x=100+(x*80)'(.p(1).x+.p(2).x+.p(3).x+.p(4).x)/4
                .cntr.y=100+(y*80)'(.p(1).y+.p(2).y+.p(3).y+.p(4).y)/4
            end With
        Next x
    next y

'create light glow from 32 bit bitmap
    light  = imagecreate(lw,lh)
    light1 = imagecreate(lw,lh)
    light2 = imagecreate(lw,lh)
    bload "light big.bmpx",light
    
' Make the Background image (the isometric grid)
    back = imagecreate(scrw,scrh,rgb(0,0,0))
    For i As Integer=0 To 1700 Step 20
        Line back,(0,i)-(scrw,i-scrw/2),RGB(150,0,50)
    Next
    
    For i As Integer=-700 To 1024 Step 20
        Line back,(0,i)-(scrw,i+scrw/2),RGB(150,0,100)
    Next

' Make the foreground image (all the boxes)
    front = imagecreate(scrw,scrh,rgb(0,0,0))
    line front, (0,0)-(scrw-1,scrh-1), rgb(255,0,255),bf ' make all of it magic pink

    For i as Integer=0 To UBound(boxes) ' draw all boxes into the front buffer
        boxes(i).draw(front)
    next i


    prevtime = timer
    plight2.x = 200
    plight2.y = 200
    
' ==============================================================================================
' ================================================== MAIN LOOP
' ==============================================================================================
    
Do
    GetMouse plight1.x,plight1.y'put light.x and y at mouse
    
    screenlock
        Put (0,0), back, pset
        
        Put light1,(0,0), light, pSet
        Put light2,(0,0), light, pset
        
        For i as integer=0 to UBound(boxes)
           If boxes(i).cntr.x > plight1.x-lwh Andalso boxes(i).cntr.x < plight1.x+lwh Andalso boxes(i).cntr.y > plight1.y-lhh Andalso boxes(i).cntr.y < plight1.y+lhh  Then
              shadowcast(boxes(i),plight1,light1,i)'cast shadow
           End If
        next i
        for i as integer=0 to UBound(boxes)
           If boxes(i).cntr.x > plight2.x-lwh Andalso boxes(i).cntr.x < plight2.x+lwh Andalso boxes(i).cntr.y > plight2.y-lhh Andalso boxes(i).cntr.y < plight2.y+lhh  Then
              shadowcast(boxes(i),plight2,light2,i)'cast shadow
           End if
        next i
        
        put (plight1.x-lwh,plight1.y-lhh), light1, alpha
        put (plight2.x-lwh,plight2.y-lhh), light2, alpha
        
        Put (0,0),front,trans

        Locate 1,1
        print "fps ";fps
    screenunlock
    
    sleep 1
    frames+=1
    if timer-1>prevtime then fps=frames:frames=0:prevtime=timer
loop until multikey(1)

Last edited by leopardpm on Apr 02, 2017 10:40, edited 1 time in total.
leopardpm
Posts: 1795
Joined: Feb 28, 2009 20:58

Re: Isometric shadow casting light.

Post by leopardpm »

I am having trouble figuring out this portion of the shadow cast routine:

Code: Select all

    with box1
        slope1=getslope(.p(2),plight)'+180
        slope2=getslope(.p(4),plight)'+180
        slope3=getslope(.p(1),plight)'+180
        slope4=getslope(.p(3),plight)'+180
        dim as integer k,k1,k2,k3,k4
        if slope1>0 then k+=1:k1=1
        if slope2>0 then k+=1:k2=1
        if slope3>0 then k+=1:k3=1
        if slope4>0 then k+=1:k4=1
        if k>0 andalso k<4 andalso plight.x<(box1.p(2).x+box1.p(3).x)/2 then
            if k1=1 then slope1-=360
            if k2=1 then slope2-=360
            if k3=1 then slope3-=360
            if k4=1 then slope4-=360
        end if
        '===================================================
        if slope1>testval then testval=slope1:ch1=.p(2)      ':chx2=x:chy2=y2
        if slope2>testval then testval=slope2:ch1=.p(4)     ':chx2=x:chy2=y
        if slope3>testval then testval=slope3:ch1=.p(1)       ':chx2=x2:chy2=y2
        if slope4>testval then testval=slope4:ch1=.p(3)      ':chx2=x2:chy2=y
        testval2=testval
        if slope1<testval2 then testval2=slope1:ch2=.p(2)
        if slope2<testval2 then testval2=slope2:ch2=.p(4)
        if slope3<testval2 then testval2=slope3:ch2=.p(1)
        if slope4<testval2 then testval2=slope4:ch2=.p(3)
        '===================================================
    end with
what is all this 'K' stuff?

I see that you use 'K' as a counter to keep track of how many of the slopes are > zero (positive?), and each of the k1 - k4 vars keep track of which slopes are positive.... and then if:

- at least 1 slope is positive
and also
"plight.x<(box1.p(2).x+box1.p(3).x)/2" <----- what is this calc????

then you subtract 360 from all the positive slopes.... so confusing, seems like we can make simpler... but I don't know what issue it is solving, or how it solves it....

can you explain?

anyways, I reduced all that code there to this simple bit, and it seems to still work...:

Code: Select all

    with box1
        for p as integer = 1 to 4
            slope(p) = getslope(.p(p),plight)'+180
            if slope(p) > 0 andalso plight.x < midPNT then slope(p) -= 360
            ' find points with the highest and lowest slopes
            if slope(p) > HiVal then HiVal = slope(p) : polyPNT(2) = .p(p)
            if slope(p) < LoVal then LoVal = slope(p) : polyPNT(3) = .p(p)
        next p
    end with
leopardpm
Posts: 1795
Joined: Feb 28, 2009 20:58

Re: Isometric shadow casting light.

Post by leopardpm »

ok, this is where I leave off... tried to incorporate the new PolyFill routine, but getting artifacts and stuff...

BUT, there are positives: it 'almost' works

PLUS - even with using the slow FB line command to fill the poly, the net result, so far, on the original frame rate is huge! I am getting about 43 - 44 fps.... so once we optimize with direct memory line making, I bet we might get closer to 50+ fps! Still seems like something is slowing things down as we really are not doing much at all.... we shall see, don't know if I can work on this tomorrow since I stay up all night.... drats

in looking over the code, I am noticing some very strange things in both the 'makepoint' and the 'lined' subs... these probably are not the problem that the new polyfill routine created... but they are definite slow downs... for instance, with the lined routine, there should be no need to even do the sin/cos calcs anymore, but something is screwy in the whole logic there... will have to decypher with you later...


here is PolyFill code incorporated into the Shadowcaster code....with problems...

Code: Select all

'2d Quad-Shadow caster
'by Ezekiel Gutierrez and Leopardpm
'
'requires light.bmpx 800x400 for the glow
'
' ==============================================================================
' ================================== All CONST Here =============================
' ==============================================================================
    const scrw = 1280
    const scrh = 1024
    const pi = 4 * atn(1)
    const lw = 800, lh = 400, lwh = lw/2, lhh = lh/2
    const DtoR as double = pi / 180   ' degrees * DtoR = radians
' ==============================================================================
' ================================== All UDTs Here =============================
' ==============================================================================
    type point2d
        x as integer
        y as integer
    end type
    
    type box
        p(4) as point2d
        cntr as point2d
        declare sub draw(img as any ptr)
    end type
    
    type vertice
        x as integer
        y as integer
        side as integer
        NLP as integer   ' the next left side 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!
        Rslp as double   ' this is the slope from this point towards the next point ON THE RIGHT SIDE!
    end type

' ==============================================================================
' ================================== All DIMs Here =============================
' ==============================================================================
    dim as box boxes(99)
    dim as point2d plight1,plight2
    
' for PolyFill Routine
    dim shared as vertice points(5)

' for FPS routine
    dim as integer fps,frames
    dim as double prevtime

' for images
    dim as any ptr light, light1, light2, back, front
' ==============================================================================
' ================================== All Subroutines Here ======================
' ==============================================================================
Public Sub Lined(p1 as point2d,p2 as point2d,xs as integer,ys as integer,sw as integer,sh as integer,byref p3 as point2d)
    dim as Single xnew,ynew
    Dim As Single dx,dy,x3,y3,x2,y2,ynum,den,num,numadd,xinc1,xinc2,yinc1,yinc2
    
    x3 = p1.x : y3 = p1.y
    x2 = p2.x : y2 = p2.y
    dx = abs(x2 - x3) : dy = abs(y2 - y3) : xnew = x3 : ynew = y3
    
    if x2 >= x3 Then xinc1 = 1 : xinc2 = 1 else xinc1 = -1 : xinc2 = -1
    if y2 >= y3 Then yinc1 = 1 : yinc2 = 1 else yinc1 = -1 : yinc2 = -1
    
    if dx >= dy Then
        xinc1 = 0 : yinc2 = 0 : den = dx : num = dx / 2 : numadd = dy
    Else
        xinc2 = 0 : yinc1 = 0 : den = dy : num = dy / 2 : numadd = dx
    end if
    
    While 1
        if xnew > xs+sw then p3.x = xnew : p3.y=ynew : exit sub
        if xnew < xs    then p3.x = xnew : p3.y=ynew : exit sub
        if ynew > ys+sh then p3.x = xnew : p3.y=ynew : exit sub
        if ynew < ys    then p3.x = xnew : p3.y=ynew : exit sub
        num += numadd
        if num >= den Then num -= den : xnew += xinc1 : ynew += yinc1
        xnew += xinc2 : ynew += yinc2
    Wend
End Sub

public function getslope(p1 as point2d, _
                  p2 as point2d) as integer
        dim as integer xdif,ydif
        xdif = p2.x - p1.x
        ydif = p2.y - p1.y
        return atan2(ydif, xdif)*(180 / pi)
end function

public sub makepoint(angle as integer, plight as point2d, _
              p1 as point2d, _
              byref p2 as point2d)
    p2.x = p1.x - (Cos(angle*DtoR)*(200))
    p2.y = p1.y - (Sin(angle*DtoR)*(200))
    lined(p1,p2,plight.x-(lwh),plight.y-(lhh),lw,lh,p2)
end sub

sub box.draw(img as any ptr)
    line img,(p(1).x,p(1).y-20) - (p(2).x,p(2).y-20) ,rgb(255,0,0)
    line img,(p(2).x,p(2).y-20) - (p(2).x,p(2).y)    ,rgb(255,0,0)
    line img,(p(2).x,p(2).y)    - (p(4).x,p(4).y)    ,rgb(255,0,0)
    line img,(p(3).x,p(3).y)    - (p(4).x,p(4).y)    ,rgb(255,0,0)
    line img,(p(3).x,p(3).y)    - (p(3).x,p(3).y-20) ,rgb(255,0,0)
    line img,(p(3).x,p(3).y-20) - (p(1).x,p(1).y-20) ,rgb(255,0,0)
    line img,(p(4).x,p(4).y)    - (p(4).x,p(4).y-20) ,rgb(255,0,0)
    line img,(p(2).x,p(2).y-20) - (p(4).x,p(4).y-20) ,rgb(255,0,0)
    line img,(p(3).x,p(3).y-20) - (p(4).x,p(4).y-20) ,rgb(255,0,0)
    paint img,(p(1).x+1,p(1).y+3) ,rgb(50,0,0),  rgb(255,0,0)
    paint img,(p(1).x-1,p(1).y+3) ,rgb(100,0,0), rgb(255,0,0)
    paint img,(p(1).x,p(1).y-1)   ,rgb(255,0,0), rgb(255,0,0)
end sub

sub PolyFill(img as any ptr, col as Integer)
' ======================================================================
' ============== ENTER ROUTINE HERE 
' ==============   with all points in array points(5)
' ==============   points(0).x = NumberOfPoints  (should be four or five)
' ======================================================================

    dim as integer 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)
    
    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
        else
            points(p).side = 1
        end if
        'print MainSlope, curSlope, p, points(p).side
    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!
    dim as integer curleftpoint = TLP, currightpoint = TRP, nextLeft, nextRight
    dim as integer q
    
    ' 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
' 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
    
    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

        ' draw the line between the to xvalues at this yvalue
        line img, (int(Lx), yvalue) - (int(Rx), yvalue), rgba(col,0,0,0)

        ' check to see if reached next left/right points...
        if yvalue >= points(points(CLP).NLP).y then
            ' change current left point to the next left point!
            CLP = points(CLP).NLP
        end if

        if yvalue >= points(points(CRP).NRP).y then
            ' change current right point to the next right point!
            CRP = points(CRP).NRP
        end if
        'sleep 10
    next yvalue
end sub


sub shadowcast(box1 as box,plight as point2d,img as any ptr,col as Integer)
    dim as point2d polyPNT(5)
    dim as integer slope(4), k(4)
    dim as integer HiVal=-9999, LoVal = 9999, midPNT = (box1.p(2).x + box1.p(3).x)/2
    
    ' calculate differences for each point
    with box1
        for p as integer = 1 to 4
            slope(p) = getslope(.p(p),plight)'+180
            if slope(p) > 0 andalso plight.x < midPNT then slope(p) -= 360
            ' find points with the highest and lowest slopes
            if slope(p) > HiVal then HiVal = slope(p) : polyPNT(2) = .p(p)
            if slope(p) < LoVal then LoVal = slope(p) : polyPNT(3) = .p(p)
        next p
    end with
    
    ' use selected points to find the points on the light box rectangle edges
    makepoint(HiVal, plight, polyPNT(2), polyPNT(1))'create first point
    makepoint(LoVal, plight, polyPNT(3), polyPNT(4))'create second point
    
    ' P(1-4) are all the polygon points EXCEPT any corners of the light box...

    ' adjust values for light box position on screen
    for p as integer = 1 to 4
        polyPNT(p).x -= plight.x - lwh
        polyPNT(p).y -= plight.y - lhh
        ' transfer the polygon points to right data type for the polyfill routine
        Points(p).x = polyPNT(p).x
        Points(p).y = polyPNT(p).y
    next p
    Points(0).x = 4 ' this tells the routine how many polygon points there are...
    PolyFill(img, col)
    
'    ' draw the Shadow Polygon Outline
'    for p as integer = 1 to 3
'        Line img,(polyPNT(p).x, polyPNT(p).y)-(polyPNT(p+1).x, polyPNT(p+1).y), rgba(col,0,0,0)
'    next p
'    
'    ' fill the Shadow Polygon Outline
'    paint img,((polyPNT(1).x+polyPNT(2).x+polyPNT(3).x+polyPNT(4).x)/4, _
'               (polyPNT(1).y+polyPNT(2).y+polyPNT(3).y+polyPNT(4).y)/4),rgba(col,0,0,0),rgba(col,0,0,0)
end sub

' ==============================================================================================
' ================================================== END OF SUBS
' ==============================================================================================


' ==============================================================================================
' ================================================== Initialization
' ==============================================================================================

    screenres scrw,scrh,32
    color rgb(255,255,255),rgb(0,0,0)
    
' Define Boxes
    for y as integer=0 to 9
        For x As Integer=0 To 10
            with boxes(x+(y*10))
                .p(1).x=100+(x*80) 'box
                .p(1).y=90 +(y*80)'    co-ordinate 1
                .p(2).x=80+(x*80)'box
                .p(2).y=100+(y*80)'    co-ordinate 2
                .p(3).x=120+(x*80)'box
                .p(3).y=100+(y*80)'    co-ordinate 3
                .p(4).x=100+(x*80)'box
                .p(4).y=110+(y*80)'    co-ordinate 4
                .cntr.x=100+(x*80)'(.p(1).x+.p(2).x+.p(3).x+.p(4).x)/4
                .cntr.y=100+(y*80)'(.p(1).y+.p(2).y+.p(3).y+.p(4).y)/4
            end With
        Next x
    next y

'create light glow from 32 bit bitmap
    light  = imagecreate(lw,lh)
    light1 = imagecreate(lw,lh)
    light2 = imagecreate(lw,lh)
    bload "light big.bmpx",light
    
' Make the Background image (the isometric grid)
    back = imagecreate(scrw,scrh,rgb(0,0,0))
    For i As Integer=0 To 1700 Step 20
        Line back,(0,i)-(scrw,i-scrw/2),RGB(150,0,50)
    Next
    
    For i As Integer=-700 To 1024 Step 20
        Line back,(0,i)-(scrw,i+scrw/2),RGB(150,0,100)
    Next

' Make the foreground image (all the boxes)
    front = imagecreate(scrw,scrh,rgb(0,0,0))
    line front, (0,0)-(scrw-1,scrh-1), rgb(255,0,255),bf ' make all of it magic pink

    For i as Integer=0 To UBound(boxes) ' draw all boxes into the front buffer
        boxes(i).draw(front)
    next i


    prevtime = timer
    plight2.x = 200
    plight2.y = 200
    
' ==============================================================================================
' ================================================== MAIN LOOP
' ==============================================================================================
    
Do
    GetMouse plight1.x,plight1.y'put light.x and y at mouse
    
    screenlock
        Put (0,0), back, pset
        
        Put light1,(0,0), light, pSet
        Put light2,(0,0), light, pset
        
        For i as integer=0 to UBound(boxes)
           If boxes(i).cntr.x > plight1.x-lwh Andalso boxes(i).cntr.x < plight1.x+lwh Andalso boxes(i).cntr.y > plight1.y-lhh Andalso boxes(i).cntr.y < plight1.y+lhh  Then
              shadowcast(boxes(i),plight1,light1,i)'cast shadow
           End If
        next i
        for i as integer=0 to UBound(boxes)
           If boxes(i).cntr.x > plight2.x-lwh Andalso boxes(i).cntr.x < plight2.x+lwh Andalso boxes(i).cntr.y > plight2.y-lhh Andalso boxes(i).cntr.y < plight2.y+lhh  Then
              shadowcast(boxes(i),plight2,light2,i)'cast shadow
           End if
        next i
        
        put (plight1.x-lwh,plight1.y-lhh), light1, alpha
        put (plight2.x-lwh,plight2.y-lhh), light2, alpha
        
        Put (0,0),front,trans

        Locate 1,1
        print "fps ";fps
    screenunlock
    
    sleep 1
    frames+=1
    if timer-1>prevtime then fps=frames:frames=0:prevtime=timer
loop until multikey(1)


Boromir
Posts: 463
Joined: Apr 30, 2015 19:28
Location: Oklahoma,U.S., Earth,Solar System
Contact:

Re: Isometric shadow casting light.

Post by Boromir »

Leopardpm wrote:anyways, I reduced all that code there to this simple bit, and it seems to still work...:
I talked about the k stuff here. :) Yes, your code works and performs the task better then mine.
http://www.freebasic.net/forum/viewtopi ... 45#p230534

I'm getting 80 fps on my 3.16 ghz cpu as opposed to the 58 fps I was getting previously. If we can fix the problems this will be great!

Edit: I've tried playing with routine but it extends beyond my understanding.
Does your poly fill routine know how the points connect or does it just wing it? If it doesn't know, then it could make choices that look strange to us sometimes.
See how there is multiple possibilities.
Image
leopardpm
Posts: 1795
Joined: Feb 28, 2009 20:58

Re: Isometric shadow casting light.

Post by leopardpm »

Boromir wrote:I've tried playing with routine but it extends beyond my understanding.
I have no doubt that you could understand it - I was 'in the zone' last night and the code probably looks like gibberish, even with all the attempts to comment.
Boromir wrote:Does your poly fill routine know how the points connect or does it just wing it? If it doesn't know, then it could make choices that look strange to us sometimes.
The routine makes a couple of assumptions:

(1) All the points given to it are actual corners on the outside of the polygon, not any random interior points.

(2) If all the points are sorted based on their Y-Value, and if a line were to be drawn from the Top-Most point to the Bottom-Most point, then, it assumes that all the points 'to the left' of that line are on the left-side of the polygon (in drawing order) and all the points 'to the right' of that line are on the right-side of the polygon (also in drawing order)
Image
So, in the above image, from the sorting, the routine would be able to determine that points A & E were Top and Bottom, then based on the slope of the line between them and comparing that slope to the slope between A and every other point to figure out if 'left' or 'right' side: in this examplb, B is on the left side, and C and D are on the right. Knowing this, it can draw the polygon correctly.

But, it doesn't need to actually draw the perimeter of the polygon - we just want to fill it. So what occurred to me is that a 'slope' is just the ratio of how many pixels to move in the X direction for every single movement in the Y direction. And so if we calc'd the slopes from each point to the next point on each side, then made a loop from the top Y-value to the Bottom... each iteration of the loop (Y = Y + 1), we could figure out the endpoints of the line that is used to fill the polygon by adding 'the change in X pixels' (the slope), at that y-value, for each side.

It is hard to type out the explanation... basically, we are going to fill the polygon with horizontal lines drawn from left to right, starting at the top and proceeding to the bottom. The end points for these lines are determined by adding the current slope of each side to a 'x-value' we keep track of.

Using the example picture above: let us say that the slope from A--->B is -1... this means each time the Y increases by 1 pixel, we add (-1) to the Left-X-Value and will have the left side endpoint of the fill line. Also, let us say the slope of the line from A--->C is +3... this means for each Y-Value increase, we will add (+3) to the Right-X-Value... now we drawn a horizontal line between these two X values (we already have the current Y value). Now, we do it again: increase the Y-value, add -1 to the left X, add +3 to the right X, and draw a line between...and so on! The tricky part is that each side has different points on it and we will be changing the direction off the slope whenever we reach one of these points. So, as we keep increasing the Y-value, we check both sides to see if we have passed a point (left points: B, right points are C & D). Lets say we have filled the top portion and the Y value now has passed the Y value of point C... well, we need to change our slope to the slope of the line from C--->D, lets say that slope is -0.5... so instead of (+3), we will now add (-0.5) with each increase in the y-value... same thing on the left side.

hmmm, one thing that might help is to know that in the UDT for the points:

Code: Select all

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
The NLP and NRP are basically pointers to the next point, on the left or right side of the polygon... so these form a sort of 'linked list' and you can go from one to the next by accessing these.

Here is the polygon fill code separately again, with some more comments to help:

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

        ' draw the line between the to xvalues at this yvalue
        line (int(Lx), yvalue) - (int(Rx), yvalue), rgb(0,255,0)

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

Re: Isometric shadow casting light.

Post by leopardpm »

the more I think about it, the more I am convinced that this is THE FASTEST way to fill any simple polygon. Once we get the optimized line drawing in there, it will be very hard to beat this routine. I will have to remember to add this to my Fast Graphics Library....
Boromir
Posts: 463
Joined: Apr 30, 2015 19:28
Location: Oklahoma,U.S., Earth,Solar System
Contact:

Re: Isometric shadow casting light.

Post by Boromir »

Tested the speed.
It can fill over 500 polgons a second.
Removing the cls adds an extra 10 fps.

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

        ' draw the line between the to xvalues at this yvalue
        line (int(Lx), yvalue) - (int(Rx), yvalue), rgb(0,255,0)

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

Re: Isometric shadow casting light.

Post by leopardpm »

Boromir wrote:Tested the speed.
It can fill over 500 polgons a second.
Nice! I get about 300-350 on my slow notebook. (and almost 1000 if i comment out the sleep altogether and hog the CPU! lol)

and that is with using the 'slow' line method of filling.

Plus, it is calling the RND function (also slow) 5 times each loop....

I am procrastinating replacing the LINE command just yet because I always get so confused with pointers and such.... but it really is simple - just a mental block on my part... also, there is an even faster way: since we are filling the polygon with Zero's (black) we can utilize some intrinsic functions like mem_clear which zeros out a range of memory... our 'range' is from left x to right x and we want all zeros inbetween... lickitty-split fast! I like fast. Gives you more time to do all the other things you want to do beyond just having a dynamic light source with shadows...
leopardpm
Posts: 1795
Joined: Feb 28, 2009 20:58

Re: Isometric shadow casting light.

Post by leopardpm »

did my explanation help in understanding the routine? I really tried to make it clear - just ask if you have any questions.
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Isometric shadow casting light.

Post by dodicat »

The function InPolygon uses winding number method.
I draw the polygon 2 ways.
1) direct pixel by pixel
2)paint

At lines 146/147
Try each method.

Code: Select all

Screenres 800,600,32

'globals for direct pixels
#macro ppset(_x,_y,colour)
pixel=row+pitch*(_y)+(_x)*4
*pixel=(colour)
#endmacro

Dim Shared As Any Ptr row 
row=Screenptr
Dim Shared As Integer pitch,xres,yres
Dim Shared As Ulong Pointer pixel
Screeninfo xres,yres,,,pitch

Type Point
    As Long x,y
End Type

Dim Shared As Long maxx,maxy,minx,miny

'get the box holding all points
Sub Getlimits(p() As Point)
    #define q_ 1000000 'large(ish) number
    maxx=-q_:maxy=-q_:minx=q_:miny=q_
    For n As Long=1 To Ubound(p)
        If maxx<p(n).x Then maxX=p(n).x
        If maxy<p(n).y Then maxy=p(n).y
        If minx>p(n).x Then minX=p(n).x
        If miny>p(n).y Then miny=p(n).y
    Next
    
    'keep max/min on screen at all times
    If maxx>xres-1 Then maxx=xres-1
    If maxy>yres-1 Then maxy=yres-1
    If minx<0 Then minx=0
    If miny<0 Then miny=0
End Sub

Function inpolygon(p1() As Point,Byval p2 As Point) As Integer
    #macro Winder(L1,L2,p)
    ((L1.x-L2.x)*(p.y-L2.y)-(p.x-L2.x)*(L1.y-L2.y))
    #endmacro
    Dim As Integer index,nextindex,k=Ubound(p1)+1,wn
    For n As Integer=1 To Ubound(p1)
        index=n Mod k:nextindex=(n+1) Mod k
        If nextindex=0 Then nextindex=1
        If p1(index).y<=p2.y Then
            If p1(nextindex).y>p2.y Andalso  Winder(p1(index),p1(nextindex),p2)>0 Then wn+=1 
        Else
            If p1(nextindex).y<=p2.y Andalso Winder(p1(index),p1(nextindex),p2)<0 Then wn-=1
        End If
    Next n
    Return wn
End Function

Sub circulate(p() As Point)'sort the random points radially 
    #macro Circlesort() 
    '  bubblesort
    For p1 As Long  = Lbound(p) To Ubound(p)-1
        For p2 As Long  = p1 + 1 To Ubound(p)
            If Atan2(p(p1).y-c.y,p(p1).x-c.x)< Atan2(p(p2).y-c.y,p(p2).x-c.x) Then
                Swap p(p1),p(p2)
            End If
        Next p2
    Next p1
    #endmacro
    Dim As Point C '--centroid of points
    Dim As Long counter
    For n As Long=Lbound(p) To Ubound(p)
        counter+=1
        c.x+=p(n).x
        c.y+=p(n).y
    Next n
    c.x=c.x/counter
    c.y=c.y/counter
    CircleSort()
End Sub

Sub drawpolygon2(p() As Point,Byref col As Uinteger,Byval im As Any Pointer=0) 
    Dim k As Long=Ubound(p)+1
    Dim As Long index,nextindex
    Dim As Long cx,cy
    For n As Long=1 To Ubound(p)
        cx+=p(n).x:cy+=p(n).y
        index=n Mod k:nextindex=(n+1) Mod k
        If nextindex=0 Then nextindex=1
        Line im,(p(index).x,p(index).y)-(p(nextindex).x,p(nextindex).y),col
    Next
    cx/=Ubound(p):cy/=Ubound(p)
    Paint (cx,cy),col,col
End Sub

Sub DrawPolygon(P() As Point,col As Ulong)
    For x As Long=minx To maxx
        For y As Long=miny To maxy
            If inpolygon(P(),Type<Point>(x,y)) Then
                'pset(x,y),col
                ppset(x,y,col)'direct pixels
            End If
        Next
    Next
End Sub

Redim As Point points()

#define range(f,l) int(Rnd*((l+1)-(f))+(f))

Randomize Timer
Dim As Double t
Do
    t=Timer
    Var dimension=range(5,9)
    Redim points(1 To dimension)
    Screenlock
    Cls
    Color Rgb(255,255,255)
    '
    ' make random points (within designated areas...) and show them
    For n As Long=1 To dimension
        points(n).x = Int(Rnd*800)     'all over
        points(n).y = Int(Rnd*600)
    Next n
    
    ' 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
    
    circulate(points())'get the points into a radial format
    getlimits(points())
    
    For p As Integer = 1 To dimension
        Circle (points(p).x, points(p).y), 4, Rgb(255,0,0) ,,,, f
    Next p
    ' drawpolygon(points(),rgb(200,100,0))'direct pixels
    drawpolygon2(points(),Rgb(200,100,0)) 'don't need getlimits() for this paint method
    Screenunlock
    Locate 3,3
    Print "Time taken  ";Timer-t,dimension; " sides"
    Sleep
Loop Until Inkey=Chr(27)




 
Boromir
Posts: 463
Joined: Apr 30, 2015 19:28
Location: Oklahoma,U.S., Earth,Solar System
Contact:

Re: Isometric shadow casting light.

Post by Boromir »

leopardpm wrote:did my explanation help in understanding the routine? I really tried to make it clear - just ask if you have any questions.
Yeah, I think I have a basic understanding of how it works now.
It seems to work every time. Any leads on what causes the artifacts in the light implementation?
Boromir
Posts: 463
Joined: Apr 30, 2015 19:28
Location: Oklahoma,U.S., Earth,Solar System
Contact:

Re: Isometric shadow casting light.

Post by Boromir »

dodicat wrote: I draw the polygon 2 ways.
1) direct pixel by pixel
2)paint
Cool, It's fast with both methods, but the pixel set is faster!
Are you using leopardpm's method from the previous posts or is it working differently?
Edit:
dodicat wrote:The function InPolygon uses winding number method.
Oh, didn't catch that on my first read through.
So how does this work?
Last edited by Boromir on Apr 02, 2017 22:32, edited 1 time in total.
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Isometric shadow casting light.

Post by dodicat »

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

Re: Isometric shadow casting light.

Post by leopardpm »

Dodi, your code is always like experiencing magic for the first time....

I found your direct pixel method to be much slower, as it should be because of two things it does with each pixel:
(1) it checks to see if the pixel is inside the polygon (slow)

(2) and it doesn't take advantage of the direct pixel routines ability to already have things pre-calc... what I mean is, if you are directly writing on the same Y-row of pixels, you do not need to re-calc the address of that row each time, just increment the pixel pointer to get to the next pixel

viewing your routine highlighted an issue with my own.... my routine cannot done 'some' concave polygons - which is fine for our purposes here, but it is not good for a general routine like I was hoping - it is good as a general 'Convex only' polygon fill routine though...

I would like to test the speed of mine (once utilizing optimized direct pixel line drawng) vs either of those routines... I bet mine is faster, or, is at least in the same speed catagory... don't know... I do know that you use wizardy to code up your things and it is always hard to compete with THAT!

frickin' magic I tell ya!
Post Reply