Joshy
Code: Select all
type vector2d
as integer x,y
end type
sub FilledPolygon(TargetPtr as any ptr, _ ' 0 = screen otherwise image ptr
p() as vector2d , _ ' the screen coords (x,y)
n as integer , _ ' how many coords in array
red as ubyte , _ ' color
green as ubyte , _
blue as ubyte)
static as integer palflag=0
dim as integer TargetWidth=any,TargetHeight=any,TargetBytes=any,TargetPitch=any
dim as integer f=any,t=any,b=any,l=any,r=any
dim as integer lc=any,nlc=any,rc=any,nrc=any
dim as integer d1=any,s1=any,d2=any,s2 =any,cl=any,cr=any
dim as ubyte c8 =any
dim as ushort c16=any
dim as ulong c24=any
dim as any ptr row=any
n-=1
if n<2 then exit sub
if TargetPtr=0 then
TargetPtr=screenptr() ' first pixel top left on screen
if TargetPtr=0 then exit sub
ScreenInfo _
TargetWidth , _
TargetHeight,, _
TargetBytes , _
TargetPitch
else
ImageInfo _
TargetPtr , _
TargetWidth , _
TargetHeight, _
TargetBytes , _
TargetPitch , _
TargetPtr
end if
select case as const TargetBytes
case 1
if palflag=0 then ' define a RGB palette only once
dim as integer r8,g8,b8
for i as uinteger= 0 to 255
r8=(((i shr 5) and &H07) * 255) / 7
g8=(((i shr 2) and &H07) * 255) / 7
b8=(((i shr 0) and &H03) * 255) / 3
palette i,r8,g8,b8
next
palflag=1
end if
#define RGB8(_r,_g,_b) ( (_r and &HE0) or ((_g and &HE0) shr 3) or ((_b and &HC0) shr 6) )
c8=rgb8(red,green,blue)
#undef RGB8
case 2
palflag=0
#define RGB16(_r,_g,_b) (((_r shr 3) shl 11) or ((_g shr 2) shl 5) or (_b shr 3))
c16=rgb16(red,green,blue)
#undef RGB16
case 4
palflag=0
c24=rgb(red,green,blue)
end select
' top bottom left right (clipping)
#define mr 1000000
t= mr: b=-mr : l= mr : r=-mr
#undef mr
for nc as integer=0 to n
with p(nc)
if .y<t then t=.y:f=nc ' top
if .y>b then b=.y ' bottom
if .x<l then l=.x ' left
if .x>r then r=.x ' right
end with
next
' clip
if l>=TargetWidth then exit sub ' left is outside
if r<1 then exit sub ' right is outside
if t>=TargetHeight then exit sub ' top is outside
if b<0 then exit sub ' bottom is outside
if (r-l)<1 then exit sub ' 0 pixels width
if b>=TargetHeight then b=TargetHeight-1 ' clip bottom
if (b-t)<1 then exit sub ' 0 pixels height
' left and next left counter
lc=f:nlc=lc-1:if nlc<0 then nlc=n
' right and next right counter
rc=f:nrc=rc+1:if nrc>n then nrc=0
if p(nlc).x>p(nrc).x then exit sub
row=TargetPtr+t*TargetPitch
#define SHIFTS 8 ' fixed point format
' from top to bottom
while t<b
if t=p(lc).y then
while p(lc).y=p(nlc).y
lc=nlc:nlc-=1:if nlc<0 then nlc=n
wend
d1=p(lc).x shl SHIFTS
s1=((p(nlc).x-p(lc).x) shl SHIFTS)/(p(nlc).y-p(lc).y)
lc = nlc
end if
if t=p(rc).y then
while p(rc).y=p(nrc).y
rc=nrc:nrc+=1:if nrc>n then nrc=0
wend
d2=p(rc).x shl SHIFTS
s2=((p(nrc).x-p(rc).x) shl SHIFTS)/(p(nrc).y-p(rc).y)
rc=nrc
end if
if t>-1 then
l=d1 shr SHIFTS ' most left pixel
r=d2 shr SHIFTS ' most right pixel
if l>r then swap l,r
if l<TargetWidth andalso r>-1 then
if l<0 then l=0
if r>=TargetWidth then r=TargetWidth-1
select case as const TargetBytes
case 1
var s=cptr(ubyte ptr,row)+l
var e=cptr(ubyte ptr,row)+r
while s<e : *s=c8 : s+=1:wend
*e=c8
case 2
var s=cptr(ushort ptr,row)+l
var e=cptr(ushort ptr,row)+r
while s<e : *s=c16 : s+=1:wend
*e=c16
case 4
var s=cptr(ulong ptr,row)+l
var e=cptr(ulong ptr,row)+r
while s<e : *s=c24 : s+=1:wend
*e=c24
end select
end if
end if
t+=1
d1+=s1
d2+=s2
row+=TargetPitch
wend
#undef SHIFTS
end sub
'
' main
'
const n=11
dim as vector2d t(2),q(3),p(n)
dim as integer fps,frames,mx,my,ox,oy
dim as single w1,w2,w3
dim as double t1,t2
screenres 640,480,8,2
screenset 1,0
t1=timer
while inkey=""
if getmouse(ox,oy)=0 then
mx=ox:my=oy
end if
for i as integer=0 to 2
with t(i) ' triangle
.x=mx+cos(w1+i*6.28/3)*50-100
.y=my+sin(w1+i*6.28/3)*50
end with
next
for i as integer=0 to 3
with q(i) ' quad
.x=mx+cos(w2+i*6.28/4)*50
.y=my+sin(w2+i*6.28/4)*50
end with
next
for i as integer=0 to n
with p(i) ' polygon
.x=mx+cos(w3+i*6.28/n)*50+100
.y=my+sin(w3+i*6.28/n)*50
end with
next
w1+=0.0001
w2+=0.0002
w3+=0.0003
cls
FilledPolygon 0,t(),3, 255, 32, 32 ' triangle
FilledPolygon 0,q(),4, 32, 32,255 ' quad
FilledPolygon 0,p(),n, 32,255, 32 ' polygon
draw string (0,0),"move the mouse ... fps: " & fps,255
flip
frames+=1
if frames mod 1000=0 then
t2=timer
fps=1000/(t2-t1): t1=t2
end if
' sleep 10 ' disabled only for fps measurement
wend