TheGameCreators - CodeBase - Subdivide a polygon in triangles

Return to the CodeBase listing

Category: Basic 2D

Version: 1.0

Information

Uploaded: 24th Mar 2004 18:34

Modified: 1st Jan 1970 01:00

Author: Cheese eater

Summary

This routine subdivide a polygon surface in triangles like in D modelers.

Full Description

DarkBASIC Professional Source Code

` This code was downloaded from The Game Creators

` It is reproduced here with full permission

` http://www.thegamecreators.com

rem

rem  Subdivide a n_polygon surface in triangles

rem

rem  downloaded from www.darkbasic.com

rem

rem  ********************************

rem  *    Laurent Casaregola 2004   *

rem  *                              *

rem  *     Pidouf gris software     *

rem  ********************************

rem

rem  Please do NOT cross the lines...

rem

dim px(1000)

dim py(1000)

dim p(1000)

sync on

dim l1(5000)

dim l2(5000)

set display mode 800,600,32

reco:

set text opaque

set text size 12

fin=0

nb=0

ink rgb(155,155,155),0

cls

repeat

if mouseclick()=0

m=0

endif

if nb>1

for i=2 to nb

line px(i-1),py(i-1),px(i),py(i)

next i

if fin=1 and i=nb

line px(i),py(i),px(1),py(1)

endif

if fin=1

line px(nb),py(nb),px(1),py(1)

endif

if nb>0

for i=1 to nb

box px(i)-2,py(i)-2,px(i)+2,py(i)+2

text px(i)-5,py(i)-15,str$(i)

next i

endif

if mouseclick()=1 and m=0 and fin=0

m=1

if mousex()>=px(1)-2 and mousex()<=px(1)+2 and mousey()>=py(1)-2 and mousey()<=py(1)+2

fin=1

goto fini

endif

inc nb

px(nb)=mousex()

py(nb)=mousey()

fini:

endif

if fin=1

text 10,10,"Polygon closed. Press right mouse button"

text 10,20,"to tesselate the surface...    "

text 10,30,"Nb of points:"+str$(nb)+"      "

else

text 10,10,"Trace point using left buton."

text 10,20,"Close the polygon by clicking"

text 10,30,"on the first point."

text 10,40,"Please don't cross the lines!!"

endif

sync

until mouseclick()=2 and fin=1

rem a

dd=10000

for i=1 to nb

d=sqrt((px(i)-400)^2+(py(i)-0)^2)

if d<dd

dd=d

nppa=i

endif

next i

rem b

dd=10000

for i=1 to nb

d=sqrt((px(i)-0)^2+(py(i)-600)^2)

if d<dd

dd=d

nppb=i

endif

next i

rem c

dd=10000

for i=1 to nb

d=sqrt((px(i)-800)^2+(py(i)-600)^2)

if d<dd

dd=d

nppc=i

endif

next i

if nppa>nppb and nppa>nppc

p1=nppa

if nppb>nppc

p2=nppb

p3=nppc

else

p2=nppc

p3=nppb

endif

if nppb>nppa and nppb>nppc

p1=nppb

if nppa>nppc

p2=nppa

p3=nppc

else

p2=nppc

p3=nppa

endif

if nppc>nppa and nppc>nppb

p1=nppc

if nppa>nppb

p2=nppa

p3=nppb

else

p2=nppb

p3=nppa

endif

sens=triangle2d_ccw(px(p1),py(p1),px(p2),py(p2),px(p3),py(p3))

ink rgb(255,0,0),0

repeat

if mouseclick()=0

m=0

else

m=1

endif

box px(nppa)-2,py(nppa)-2,px(nppa)+2,py(nppa)+2

box px(nppb)-2,py(nppb)-2,px(nppb)+2,py(nppb)+2

box px(nppc)-2,py(nppc)-2,px(nppc)+2,py(nppc)+2

if sens=1

text 10,40,"Clock"

else

text 10,40,"Anti-clock"

endif

text 10,50,"Press right mouse button..."

sync

until mouseclick()=2 and m=0

rem tesselate

nbl=nb-3

nbsauv=nb

nbll=0

nbb=1

for i=1 to nb

p(i)=i

next i

p(nb+1)=1

c=0

cc=0

recoco:

i=1

repeat

test2=0

if triangle2d_ccw(px(p(i)),py(p(i)),px(p(i+1)),py(p(i+1)),px(p(i+2)),py(p(i+2)))<>sens

test=0

for j=1 to nbsauv

if j<>p(i) and j<>p(i+1) and j<>p(i+2) and pointintriangle(px(j),py(j),px(p(i)),py(p(i)),px(p(i+1)),py(p(i+1)),px(p(i+2)),py(p(i+2)))=0

inc test

endif

next j

if test=nbsauv-3

nbll=nbll+1

l1(nbll)=p(i)

l2(nbll)=p(i+2)

nbb=nbb+1:p(nbb)=p(i+2)

i=i+2

test2=1

endif

if test2=0

nbb=nbb+1

p(nbb)=p(i+1)

inc i

endif

inc c

sync

until i>nb-1 or nbll=nbl or c>=3000

if c>=3000

goto error

endif

if nbll=nbl

goto suite

else

nb=nbb

nbb=1

inc cc

goto recoco

endif

suite:

cls

repeat

if mouseclick()=0

m=0

else

m=1

endif

for i=1 to nbsauv-1

ink rgb(255,255,255),0

line px(i),py(i),px(i+1),py(i+1)

line px(1),py(1),px(nbsauv),py(nbsauv)

next i

for i=1 to nbll

ink rgb(0,0,255),0

line px(l1(i)),py(l1(i)),px(l2(i)),py(l2(i))

next i

text 10,10,"Tesselate complete..."

text 10,20,"Press right button to make another polygon"

text 10,30,"or left button to quit."

if mouseclick()=1

finprog=1

endif

sync

until (mouseclick()=2 and m=0) or finprog=1

if finprog=1

end

endif

goto reco

error:

text 10,70,"Error. Some lines must cross each other!!!"

sync

repeat

until mouseclick()=0

repeat

text 10,80,"Press right button..."

until mouseclick()=2

goto reco

function PointInTriangle(  x as float, y as float, x1 as float, y1 as float, x2 as float, y2 as float, x3 as float, y3 as float)

local AB as float

local BC as float

local CA as float

AB = ((y-y1)*(x2-x1)) - ((x-x1)*(y2-y1))

BC = ((y-y2)*(x3-x2)) - ((x-x2)*(y3-y2))

if AB * BC <= 0 then exitfunction 0

CA = (y-y3)*(x1-x3) - (x-x3)*(y1-y3)

if BC * CA <= 0 then exitfunction 0

endfunction 1

function Triangle2D_CCW(x1 as float, y1 as float, x2 as float, y2 as float, x3 as float, y3 as float)

CodeBase - Subdivide a polygon in triangles

Information

Summary

Full Description

DarkBASIC Professional Source Code

Download

Screen Shot

Author

Comments

Author Name:	Cheese eater
CodeBase Entries:	1