ya qques couilles visibles sur les img (comme la 5)
img2> test de clipping
SOURCE:
main_file:
fillpoly.9xp
fillpoly(xb0,yb0,xb1,yb1,xb2,yb2,xb3,yb3,utiling,vtiling,mapwidth,mapheigh)
Prgm
mapwidth
mapheigh
setGraph("axes","off")
ClrGraph
ClrDraw
newMat(102,6)->polymap
[[1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1]
[1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1]
[1,0,0,0,0,0,1,1,1,1,0,0,0,0,0,1]
[1,0,0,0,1,1,0,0,0,0,1,1,0,0,0,1]
[1,0,0,1,0,0,0,0,0,0,0,0,1,0,0,1]
[1,0,0,1,0,1,1,0,0,1,1,0,1,0,0,1]
[1,0,1,0,0,1,1,0,0,1,1,0,0,1,0,1]
[1,0,1,0,0,0,0,0,0,0,0,0,0,1,0,1]
[1,0,1,0,0,0,0,0,0,0,0,0,0,1,0,1]
[1,0,1,0,1,0,0,0,0,0,0,1,0,1,0,1]
[1,0,0,1,0,1,0,0,0,0,1,0,1,0,0,1]
[1,0,0,1,0,0,1,1,1,1,0,0,1,0,0,1]
[1,0,0,0,1,1,0,0,0,0,1,1,0,0,0,1]
[1,0,0,0,0,0,1,1,1,1,0,0,0,0,0,1]
[1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1]
[1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1]]->texture
4096->top
-4096->bot
If yb0<top:yb0->top
If yb1<top:yb1->top
If yb2<top:yb2->top
If yb3<top:yb3->top
If yb0>bot:yb0->bot
If yb1>bot:yb1->bot
If yb2>bot:yb2->bot
If yb3>bot:yb3->bot
bot-top->height
If height=0:Goto fin
top-1->top
yb0-top->yb0
yb1-top->yb1
yb2-top->yb2
yb3-top->yb3
(mapwidth-1)*utiling->utile
(mapheigh-1)*vtiling->vtile
drawedge(xb0,yb0,xb1,yb1,1,1,1,30)
drawedge(xb1,yb1,xb2,yb2,1,30,30,30)
drawedge(xb2,yb2,xb3,yb3,30,30,30,1)
drawedge(xb3,yb3,xb0,yb0,30,1,1,1)
1->yloop
PxlLine 50,200,50,216
PxlLine 50,216,66,216
PxlLine 66,216,66,200
PxlLine 66,200,50,200
While yloop<height
If polymap[yloop,3]!=0 Then
If polymap[yloop,4]!=0 Then
drawfrun(yloop+top,polymap[yloop,1],polymap[yloop,2],polymap[yloop,3],polymap[yloop,4],polymap[yloop,5],polymap[yloop,6],16,16)
EndIf
EndIf
yloop+1->yloop
EndWhile
PxlText "SORTING ENDED",35,80
Pause
Lbl fin
DispHome
EndPrgm
SUB_ROUTINE:
drawedge.9xp:
drawedge(xa0,ya0,xa1,ya1,ua0,ua1,va0,va1)
prgm
If xa0>xa1 Then
xa0->temp
xa1->xa0
temp->xa1
ya0->temp
ya1->ya0
temp->ya1
ua0->temp
ua1->ua0
temp->ua1
va0->temp
va1->va0
temp->va1
EndIf
xa1-xa0->dx
ya1-ya0->dy
abs(dx)->udx
abs(dy)->udy
If dy<0 Then
PxlText "<0",8,80
-1->yadd
Else
PxlText " ",8,80
1->yadd
EndIf
PxlText string(yadd)&" ",8,100
0->error
0->loops
If udx>udy Then
(ua1-ua0)*256/udx»uadd
(va1-va0)*256/udx»vadd
ua0*256->u
va0*256->v
udx->maxi
If polymap[ya0,1]=0 Then
xa0->polymap[ya0,1]
ua0->polymap[ya0,3]
va0->polymap[ya0,5]
Else
If polymap[ya0,2]=0 and polymap[ya0,1]?xa0 Then
xa0->polymap[ya0,2]
ua0->polymap[ya0,4]
va0->polymap[ya0,6]
EndIf
EndIf
While loops<maxi
error+udy->error
u+uadd->u
v+vadd->v
loops+1->loops
xa0+1->xa0
If error>=udx Then
ya0+yadd->ya0
error-udx»error
If polymap[ya0,1]=0 Then
xa0->polymap[ya0,1]
int(u)->polymap[ya0,3]
int(v)->polymap[ya0,5]
Else
If polymap[ya0,1]!=xa0 Then
xa0->polymap[ya0,2]
int(u)->polymap[ya0,4]
int(v)->polymap[ya0,6]
EndIf
EndIf
EndIf
If ya0+top>=0 and xa0>=0
PxlOn ya0+top,xa0
EndWhile
Else
If udx<udy Then
(ua1-ua0)*256/udy->uadd
(va1-va0)*256/udy->vadd
ua0*256->u
va0*256->v
udy->maxi
While loops<maxi
If polymap[ya0,1]=0 Then
xa0->polymap[ya0,1]
int(u)->polymap[ya0,3]
int(v)->polymap[ya0,5]
Else
If polymap[ya0,1]!=xa0 Then
xa0->polymap[ya0,2]
int(u)->polymap[ya0,4]
int(v)->polymap[ya0,6]
EndIf
EndIf
ya0+yadd->ya0
error+udx->error
If error>=udy Then
error-udy->error
xa0+1->xa0
EndIf
loops+1->loops
u+uadd->u
v+vadd->v
If ya0+top>=0 and xa0>=0
PxlOn ya0+top,xa0
EndWhile
Else
(ua1-ua0)*256/udy->uadd
(va1-va0)*256/udy->vadd
ua0*256->u
va0*256->v
udy->maxi
While loops<maxi
If polymap[ya0,1]=0 Then
xa0->polymap[ya0,1]
int(u)->polymap[ya0,3]
int(v)->polymap[ya0,5]
Else
If polymap[ya0,1]!=xa0 Then
xa0->polymap[ya0,2]
int(u)->polymap[ya0,4]
int(v)->polymap[ya0,6]
EndIf
EndIf
ya0+yadd->ya0
xa0+1->xa0
loops+1->loops
u+uadd->u
v+vadd->v
If ya0+top>=0 and xa0>=0
PxlOn ya0+top,xa0
EndWhile
EndIf
EndIf
endprgm
TEXTURE_FILLER:
DRAWFRUN:
drawfrun(yt,xt0,xt1,ut0,ut1,vt0,vt1,twidth,theight)
Prgm
0->loopz
If xt0>xt1 or xt0<0 Then
xt0->temp
xt1->xt0
temp->xt1
ut0->temp
ut1->ut0
temp->ut1
vt0->temp
vt1->vt0
temp->vt1
EndIf
xt1-xt0->length
ut1-ut0->du
vt1-vt0->dv
du*256/length->uadd
dv*256/length->vadd
ut0*256->u
vt0*256->v
0->loopz
While loopz<length
loopz+1->loopz
u+uadd->u
v+vadd->v
If u<0:twidth->u
If v<0:theight->v
If u>twidth:1->u
If v>theight:1->v
If texture[int(v/65536)+1,int(u/65536)+1]=1 Then
If yt>0 and xt0+loopz>0
PxlOn yt,loopz+xt0
EndIf
PxlText string(uadd)&" "&string(vadd),80,50
PxlText string(twidth)&" "&string(theight),80,10
PxlText "TEXTURE "&string(int(v*16/65536)+int(u/65536)+1)&" ",8,150
PxlText "v "&string(int(v))&" ",16,150
PxlText "u "&string(int(u))&" ",24,150
PxlChg 50+int(v/65536),200+int(u/65536)
EndWhile
EndPrgm
[edit]Edité par SbiBI le 02-07-2001 à 22:38:14[/edit]