new RGB macros for 8,15,16 color depth
Joshy
Code: Select all
#define scr_w 640
#define scr_h 480
#define scr_b 8 ' 8,15,16,24 or 32
#define SHIFTS 8 ' 24:8 fixed point format
#if (scr_b=8)
type pixel as ubyte
#undef RGB
#define RGB(r,g,b) ((r and &HE0) or ((g and &HE0) shr 3) or ((b and &HC0) shr 6))
sub Palette332()
dim as integer i,r,g,b
for i = 0 to 255
r=(((i shr 5) and &H07) * 255) / 7
g=(((i shr 2) and &H07) * 255) / 7
b=(((i shr 0) and &H03) * 255) / 3
palette i,r,g,b
next
end sub
#elseif (scr_b=15) or (scr_b=16)
type pixel as ushort
#undef RGB
#define RGB(r,g,b) (((r shr 3) shl 11) or ((g shr 2) shl 5) or (b shr 3))
#elseif (scr_b=24) or (scr_b=32)
type pixel as ulong
#else
#error bits per pixel (scr_b) must be 8,15,16,24 or 32
#endif
type screen2d
as integer x,y
end type
Sub Polygone(d As pixel Ptr, _ ' screen ptr
p() As screen2d , _ ' the coords (x,y)
n As Integer , _ ' how many coords in array
c As pixel , _ ' fillcolor
b As pixel =0, _ ' optional bordercolor
u as integer=0) ' optional use bordercolor
#define mr 1000000
Dim As Integer f =any,ty =any,by=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 pixel ptr row=any,cstart=any,cend=any
n-=1:If n<2 Then Exit Sub
ty=mr:by=-mr:l=mr:r=-mr
For nc as integer=0 To n
With p(nc)
If .y<ty Then ty=.y:f=nc
If .y>by Then by=.y
If .x<l Then l=.x
If .x>r Then r=.x
End With
Next
' clip
If l>=scr_w Then Exit Sub
If r<1 Then Exit Sub
If ty>=scr_h Then Exit Sub
If by<0 Then Exit Sub
If (r-l)<1 Then Exit Sub
If by>=scr_h Then by=scr_h-1
If (by-ty)<1 Then Exit Sub
lc=f:nlc=lc-1:If nlc<0 Then nlc=n
rc=f:nrc=rc+1:If nrc>n Then nrc=0
If p(nlc).x>p(nrc).x Then Exit Sub
row=d+ty*scr_w
While ty<by
If ty=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 ty=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 ty<0 Then Goto next_filled_scanline
l=d1 shr SHIFTS:r=d2 shr SHIFTS
if l>r Then swap l,r
if l>=scr_w Then Goto next_filled_scanline
If r<0 Then Goto next_filled_scanline
cl=0:cr=0 ' reset clipflag
If l<0 Then l=0 :cl=1
if r>=scr_w Then r=scr_w-1:cr=1
cstart=row+l ' first pixel
cend =row+r ' last pixel
' use border
if u then
if cl=0 then *cstart=b:cstart+=1
if cr=0 then *cend =b
end if
while cstart<cend:*cstart=c:cstart+=1:wend
next_filled_scanline:
ty+=1:d1+=s1:d2+=s2:row+=scr_w
Wend
End Sub
sub triangle(d as pixel ptr, _
p() as screen2d , _
c as pixel , _ ' fillcolor
b as pixel=0 , _ ' optional bordercolor
u as integer=0) ' optional use bordercolor
dim as integer yt =any,yb=any,l=any,r=any
dim as integer d1 =any,d2=any,s1=any,s2=any,cl=any,cr=any
dim as pixel ptr row=any,cstart=any,cend=any
dim as screen2d v0 =any,v1=any,v2=any
v0=p(0):v1=p(1):v2=p(2)
if (v1.y>v2.y) then swap v1,v2
if (v0.y>v2.y) then swap v0,v2
if (v0.y>v1.y) then swap v0,v1
if (v2.y=v0.y) then return
s1=((v2.x-v0.x) shl SHIFTS)/(v2.y-v0.y)
d1=v0.x shl SHIFTS
for i as integer=0 to 1
s2=((v1.x-v0.x) shl SHIFTS)/(v1.y-v0.y)
d2=v0.x shl SHIFTS
yt=v0.y
' begin in first row
if yt<0 then
d1-=s1*yt
d2-=s2*yt
yt=0
end if
yb=v1.y
' end in last row
if yb>=scr_h then yb=scr_h-1
if yb<=yt then goto next_triangle
row=d+yt*scr_w ' first row
yb-=yt ' how many scanlines
' from top to bottom
while yb
l=d1 shr SHIFTS:r=d2 shr SHIFTS
if l>r then swap l,r
if l>=scr_w then goto next_scanline
if r<1 then goto next_scanline
cl=0:cr=0 ' reset clipflag
if l<0 then l=0 :cl=1
if r>=scr_w then r=scr_w:cr=1
cstart=row+l ' first pixel
cend =row+r ' last pixel
if u then ' use border
if cl=0 then *cstart=b:cstart+=1
if cr=0 then *cend =b
end if
while cstart<cend:*cstart=c:cstart+=1:wend
next_scanline:
d1+=s1:d2+=s2:row+=scr_w:yb-=1
wend
next_triangle:
d1= (v0.x shl SHIFTS)+((v1.y-v0.y)*s1)
v0=v1:v1=v2
next
end sub
'
' main
'
dim as screen2d t(2),p(9)
dim as pixel fc,bc ' colors
dim as integer fps,frames,mx,my
dim as single w1,w2
dim as double t1,t2
screenres scr_w,scr_h,scr_b,,1
#if scr_b=8
Palette332
#endif
t1=timer
while inkey=""
if getmouse(mx,my)=0 then
screenlock:cls
for i as integer=0 to 2
with t(i)
.x=mx+cos(w1+i*2)*100-100
.y=my+sin(w1+i*2)*100
end with
next
for i as integer=0 to 9
with p(i)
.x=mx+cos(w2+i*0.628)*100+100
.y=my+sin(w2+i*0.628)*100
end with
next
w1+=0.01:w2-=0.02
frames+=1
'polygone screenptr,p(),10,rgb(255,0,0)
'triangle screenptr,t() ,rgb(0,0,255)
polygone screenptr,p(),10,rgb(255,0,0) ,rgb(0,255,0),1
triangle screenptr,t() ,rgb(0,0,255) ,rgb(255,255,0),1
print "fps=" & fps & " "
screenunlock
if frames=100 then
t2 =timer
fps=frames/(t2-t1)
t1 =t2:frames=0
'sleep 1
end if
end if
wend
end