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

                                    ` This code was downloaded from The Game Creators
                                    ` It is reproduced here with full permission
                                    ` http://www.thegamecreators.com
                                    
                                    rem
rem
rem  Subdivide a n_polygon surface in triangles
rem
rem  downloaded from www.darkbasic.com
rem
rem
rem  ********************************
rem  *    Laurent Casaregola 2004   *
rem  *                              *
rem  *     Pidouf gris software     *
rem  ********************************
rem
rem
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
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
endif

if nppb>nppa and nppb>nppc
p1=nppb
if nppa>nppc
p2=nppa
p3=nppc
else
p2=nppc
p3=nppa
endif
endif

if nppc>nppa and nppc>nppb
p1=nppc
if nppa>nppb
p2=nppa
p3=nppb
else
p2=nppb
p3=nppa
endif
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


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)
   if ((x1-x2)*(y3-y2))-((y1-y2)*(x3-x2)) > 0 then exitfunction 1
endfunction 0