Cairo is good, but a bit slow on a freebasic graphics screen.
Graphics.h seems to be missing from srvaldez's link.
I tried to download one, but some are C and some C++, some go back to Turbo C, so I gave up.
Anyway, for fun, something similar jj2007's picture.
Code: Select all
Dim Shared As Integer xres,yres
Type V3
As Single x,y,z
End Type
Type Line
As v3 s,e '(s)tart,(e)nd
As Ulong col
Declare Sub Draw()
End Type
Type Circle Extends V3
As Ulong clr
As Long id
Declare Sub Draw
End Type
Function contrast(c As Ulong) As Ulong 'for superimposing colours
Randomize 1
#define Intrange(f,l) Int(Rnd*((l+1)-(f))+(f))
Dim As Ubyte r=Cptr(Ubyte Ptr,@c)[2],g=Cptr(Ubyte Ptr,@c)[1],b=Cptr(Ubyte Ptr,@c)[0],r2,g2,b2
Do
r2=Intrange(0,255):g2=IntRange(0,255):b2=IntRange(0,255)
Loop Until Abs(r-r2)>120 Andalso Abs(g-g2)>120 Andalso Abs(b-b2)>120
Return Rgb(r2,g2,b2)
End Function
Sub line.draw()
Line(s.x,s.y)-(e.x,e.y),col
End Sub
Sub circle.draw
Circle(x,y),z,clr,,,,f
Circle(x,y),z,Rgb(50,50,50)
..draw String(x-4*Len(Str(id)),y-8),Str(id),contrast(clr)
End Sub
Sub setupcircles(c() As Circle)
#define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)
Dim As Long rad=30,ctr
rad=(xres+300)/(11*4)
Dim As Single pi=4*Atn(1)
For n As Long=-150 To xres+150 Step rad
ctr+=1
Var x=n
Var p=map(-150,(xres+150),n,0,(4*pi))
Var y=map(-1,1,Sin(p),(.5*yres),(.8*yres))
Redim Preserve c(1 To ctr)
c(ctr)=Type<Circle>(x,y,.5*rad,Rgb(Rnd*255,Rnd*255,Rnd*255),ctr)
Next
Redim Preserve c(1 To Ubound(c)-1)
End Sub
Function perspective(p As V3,eyepoint As V3) As V3
Dim As Single w=1+(p.z/eyepoint.z)
Return Type<V3>((p.x-eyepoint.x)/w+eyepoint.x,_
(p.y-eyepoint.y)/w+eyepoint.y,_
(p.z-eyepoint.z)/w+eyepoint.z)
End Function
Function Regulate(Byval MyFps As Long,Byref fps As Long) As Integer
Static As Double timervalue,lastsleeptime,t3,frames
Var t=Timer
frames+=1
If (t-t3)>=1 Then t3=t:fps=frames:frames=0
Var sleeptime=lastsleeptime+((1/myfps)-T+timervalue)*1000
If sleeptime<1 Then sleeptime=1
lastsleeptime=sleeptime
timervalue=T
Return sleeptime
End Function
sub setuplines(p() as line)
#define shade(c,n) rgb(Cptr(Ubyte Ptr,@c)[2]*n,Cptr(Ubyte Ptr,@c)[1]*n,Cptr(Ubyte Ptr,@c)[0]*n)
Dim As Long counter
For n As Long=-400 To 1200 Step 10
counter+=1
Redim Preserve p(1 To counter)
dim as ulong c=Rgb(100+Rnd*155,100+Rnd*155,100+Rnd*155)
p(counter)=Type<Line>((n,350,-1500),(n,250,900),shade(c,.8))
Next n
end sub
'=====================
Screen 19,32
Color ,Rgb(207,229,255)
Screeninfo xres,yres
redim as line p()
setuplines(p())
Dim As Line w(1 To Ubound(p))'working array
Redim As Circle c()
setupcircles(c())
Dim As Single dx
Dim As Long fps
Do
dx=.5
Screenlock
Cls
Draw String(20,20),"Fps "&fps,0
For n As Long=Lbound(p) To Ubound(p)
p(n).s.x+=dx
p(n).e.x+=dx
If p(n).s.x>=1200 Then p(n).s.x=-400:p(n).e.x=-400 'pop off end pop on beginning
w(n).s=perspective(p(n).s,Type(400,300,1800))
w(n).e=perspective(p(n).e,Type(400,300,1800))
w(n).col=p(n).col
w(n).draw
Next n
For n As Long=Lbound(c) To Ubound(c)
c(n).x+=dx*4
If c(n).x>=xres+150 Then c(n).x=-150'cycle the circles
c(n).draw
Next n
Screenunlock
Sleep regulate(80,fps),1
Loop Until Len(Inkey)