Posts: 421
Threads: 22
Joined: Oct 2005
I have found several cool screensavers in this forum. Many, sadly, are out of date.(Out of date is a phrase which here means, it either runs too fast on my computer or it's not compatible with FB) So I would like to propose a new challenge:
FreeBASIC only.
No static or random circles. Really good ASCII screensavers may be accepted.
Size is, of course, important.
Comments please! Points will be deducted for no/few comments.
Deadline: Jan. 31, 2007
If you want me to revise anything, let me know and I'll consider it.
Happy New Year's!
In the beginning, there is darkness â the emptiness of a matrix waiting for the light. Then a single photon flares into existence. Then another. Soon, thousands more. Optronic pathways connect, subroutines emerge from the chaos, and a holographic consciousness is born." -The Doctor
Posts: 1,080
Threads: 87
Joined: Feb 2002
These can be screensavers if they are renamed to scr (I think). I have however not done any fancy stuff with winapi and cli switches (since I'm on linux :p)
They do also not quit on mouse movement, but by pressing the any-key.
I've recently posted them on freebasic.net/forum but i think this is a good reason to repost them (The versions might differ slightly)
Both requires cvs (for "FOR x AS INTEGER = ..." and transparent drawing primitives)
Enjoy
Code: ' Bouncing circles, by red_Marvin/insomninja 061219 - edited 070101
' A number of points randomly bounces around on the screen and if point #n is close enough to point #0 a circle is drawn
' at the center of point #n with the distance as radius. If the point is even closer a filled circle is drawn in the
' same way with a slowly cycling color and the opacity depending on the distance.
type point2d
x as single
y as single
xa as single
ya as single
end type
dim as point2d p(0 to 199)
dim as single r,a
dim as double t
dim as integer ar,x,y,ox,oy,c,rc,gc,bc
randomize timer
for n as integer=0 to 199
p(n).x=rnd*1024
p(n).y=rnd*768
while abs(p(n).xa)<1 or abs(p(n).ya)<1
p(n).xa=(rnd-rnd)*2
p(n).ya=(rnd-rnd)*2
wend
next
screenres 1024,768,32,1,&h41
setmouse ,,0
a=rnd*360
do
rc=(sin(a/360*3.141592654*2)+1)*127
gc=(sin((a+120)/360*3.141592654*2)+1)*127
bc=(sin((a+240)/360*3.141592654*2)+1)*127
a+=.1
if a>360 then a-=360
screenlock
cls
p(0).x+=p(0).xa
p(0).y+=p(0).ya
if p(0).x<=0 then p(0).xa=rnd+1
if p(0).y<=0 then p(0).ya=rnd+1
if p(0).x>=1023 then p(0).xa=-rnd-1
if p(0).y>=767 then p(0).ya=-rnd-1
getmouse x, y
if x<>ox or y<>oy or (timer<t and c=1) then
p(0).x=x
p(0).y=y
if c=0 then
c=1
t=timer+3
end if
else
c=0
end if
ox=x
oy=y
for n as integer = 1 to 199
p(n).x+=p(n).xa
p(n).y+=p(n).ya
if p(n).x<=-100 then p(n).xa=rnd+1
if p(n).y<=-100 then p(n).ya=rnd+1
if p(n).x>=1123 then p(n).xa=-rnd-1
if p(n).y>=867 then p(n).ya=-rnd-1
r=(p(n).y-p(0).y)^2+(p(n).x-p(0).x)^2
ar=r\32
if ar<255 then
circle(p(n).x,p(n).y),sqr(r),rgba(rc,gc,bc,255-ar),,,,f
end if
ar=r\2048
if ar<32 then
circle(p(n).x,p(n).y),sqr(r),rgba(255,255,255,32-ar)
end if
next
screenunlock
sleep 50
loop while inkey=""
Code: ' Bouncing triangles red_Marvin/insomninja 061219 - edited 070101
' A number of points randomly bounces around on the screen and if point the distance between point #n and #0 multiplied
' with the distance between point #0 and #n+60 a triangle is drawn between the three points. If the number is even smaller
' the triangle is filled with a cycling color and opacity depending on said number.
declare sub triangle(x1 as integer, y1 as integer, x2 as integer, y2 as integer, x3 as integer, y3 as integer, clr as integer)
declare sub swapi(a as integer ptr, b as integer ptr)
type point2d
x as single
y as single
xa as single
ya as single
end type
dim as point2d p(0 to 120)
dim as double t
dim as single a
dim as integer x,y,ox,oy,c,rc,gc,bc,px,py
dim as double s,ms
randomize timer
for n as integer=0 to 120
p(n).x=rnd*1024
p(n).y=rnd*768
while abs(p(n).xa)<1 or abs(p(n).ya)<1
p(n).xa=(rnd-rnd)*2
p(n).ya=(rnd-rnd)*2
wend
next
screenres 1024,768,32,1,&h41
setmouse ,,0
a=rnd*360
do
rc=(sin(a/360*3.141592654*2)+1)*127
gc=(sin((a+120)/360*3.141592654*2)+1)*127
bc=(sin((a+240)/360*3.141592654*2)+1)*127
a+=.1
if a>360 then a-=360
screenlock
cls
p(0).x+=p(0).xa
p(0).y+=p(0).ya
if p(0).x<=0 then p(0).xa=rnd+1
if p(0).y<=0 then p(0).ya=rnd+1
if p(0).x>=1023 then p(0).xa=-rnd-1
if p(0).y>=767 then p(0).ya=-rnd-1
getmouse x, y
if x<>ox or y<>oy or (timer<t and c=1) then
p(0).x=x
p(0).y=y
if c=0 then
c=1
t=timer+3
end if
else
c=0
end if
ox=x
oy=y
for n as integer = 1 to 60
p(n).x+=p(n).xa
p(n).y+=p(n).ya
if p(n).x<=-100 then p(n).xa=rnd+1
if p(n).y<=-100 then p(n).ya=rnd+1
if p(n).x>=1123 then p(n).xa=-rnd-1
if p(n).y>=867 then p(n).ya=-rnd-1
p(n+60).x+=p(n+60).xa
p(n+60).y+=p(n+60).ya
if p(n+60).x<=-100 then p(n+60).xa=rnd+1
if p(n+60).y<=-100 then p(n+60).ya=rnd+1
if p(n+60).x>=1123 then p(n+60).xa=-rnd-1
if p(n+60).y>=867 then p(n+60).ya=-rnd-1
s=sqr( ((p(0).x-p(n).x)^2 + (p(0).y-p(n).y)^2 )* ( (p(0).x-p(n+60).x)^2 + (p(0).y-p(n+60).y)^2 ))
ms=s\512
if ms<255 then
triangle p(0).x, p(0).y, p(n).x, p(n).y, p(n+60).x, p(n+60).y, rgba(rc,gc,bc,255-ms)
px=p(n).x
py=p(n).y
draw string (px,py), "("+str(px)+";"+str(py)+")",rgba(255,255,255,31)
line(px-10,py)-(px+10,py),rgba(255,255,255,31)
line(px,py-10)-(px,py+10),rgba(255,255,255,31)
px=p(n+60).x
py=p(n+60).y
draw string (px,py), "("+str(px)+";"+str(py)+")",rgba(255,255,255,31)
line(px-10,py)-(px+10,py),rgba(255,255,255,31)
line(px,py-10)-(px,py+10),rgba(255,255,255,31)
end if
ms=s\32768
if ms<32 then
line(p(0).x,p(0).y)-(p(n).x,p(n).y),rgba(255,255,255,32-ms)
line(p(0).x,p(0).y)-(p(n+60).x,p(n+60).y),rgba(255,255,255,32-ms)
line(p(n).x,p(n).y)-(p(n+60).x,p(n+60).y),rgba(255,255,255,32-ms)
end if
next
line(p(0).x-10,p(0).y)-(p(0).x+10,p(0).y),rgba(255,255,255,127)
line(p(0).x,p(0).y-10)-(p(0).x,p(0).y+10),rgba(255,255,255,127)
draw string (p(0).x,p(0).y), "("+str(cint(p(0).x))+";"+str(cint(p(0).y))+")",rgba(255,255,255,127)
screenunlock
sleep 50
loop while inkey=""
sub triangle(x1 as integer, y1 as integer, x2 as integer, y2 as integer, x3 as integer, y3 as integer, clr as integer)
dim as single xm12, xm13, xm23
dim as single xa,xb
if y2<y1 then swapi @x1, @x2 : swapi @y1, @y2
if y3<y1 then swapi @x1, @x3 : swapi @y1, @y3
if y3<y2 then swapi @x2, @x3 : swapi @y2, @y3
if cint(y2)>cint(y1) then
xm12=(x2-x1)/(y2-y1)
xm13=(x3-x1)/(y3-y1)
xa=x1
xb=x1
for y as integer = cint(y1) to cint(y2)-1
line (xa,y)-(xb,y),clr
xa+=xm12
xb+=xm13
next
else
xa=x2
xb=x1
end if
line (xa,y2)-(xb,y2),clr
if cint(y2)<cint(y3) then
xm13=(x3-x1)/(y3-y1)
xm23=(x3-x2)/(y3-y2)
for y as integer = cint(y2)+1 to cint(y3)
xa+=xm23
xb+=xm13
line (xa,y)-(xb,y),clr
next
end if
end sub
sub swapi(a as integer ptr, b as integer ptr)
dim t as integer
t=*a
*a=*b
*b=t
end sub
EDIt: Come on! More entries!
/post]
Posts: 421
Threads: 22
Joined: Oct 2005
Good, no ASM shortcuts. That means I can understand it easily!
In the beginning, there is darkness â the emptiness of a matrix waiting for the light. Then a single photon flares into existence. Then another. Soon, thousands more. Optronic pathways connect, subroutines emerge from the chaos, and a holographic consciousness is born." -The Doctor
Posts: 1,774
Threads: 62
Joined: Aug 2003
This is very similar to something I made in QB. I just made a version in FB to test the speed. Needless to say, FB is awesome.
Code: #Include "Fbgfx.bi"
Randomize Timer
Using FB
Const False As Integer = 0
Const True As Integer = Not False
Const Cir_Cnt As Integer = 150
Const SCR_WIDTH As Integer = 320
Const SCR_HEIGHT As Integer = 240
Const BPP As Integer = 32
Screenres SCR_WIDTH, SCR_HEIGHT, BPP,2', 1
Screenset 0,1
Setmouse 0,0,0
Type Point2D
X As Integer
Y As Integer
End Type
Type Circles
P As Point2d
Rad As Integer
Hill_Hole As Byte
End Type
Type Colors
As Integer R, G, B
End Type
Declare Function Vec_2D_Dist( Byval vA As Point2D, Byval vB As Point2D) As Integer
Declare Sub Blur_Buffer( Byval Buffer As Colors Ptr Ptr, Byref tBuffer As Colors Ptr Ptr, Byval Strength As Integer )
Dim As Circles Cir(CIR_CNT)
Dim As Integer i, X, Y, R, G, B, All_Colors_Match, Dist, Work_Page
Dim As Colors Ptr Ptr Buffer, tBuffer, Scr_Buffer
Dim As Point2D tVec
Buffer = Callocate(SCR_WIDTH * Sizeof(Colors) )
tBuffer = Callocate(SCR_WIDTH * Sizeof(Colors) )
Scr_Buffer = Callocate(SCR_WIDTH * Sizeof(Colors) )
For X = 0 To SCR_WIDTH-1
Buffer[X] = Callocate(SCR_Height * Sizeof(Colors) )
tBuffer[X] = Callocate(SCR_Height * Sizeof(Colors) )
Scr_Buffer[X] = Callocate(SCR_Height * Sizeof(Colors) )
Next
Do
For i= 0 To Ubound(Cir)
Cir(i).P.X = Rnd*SCR_WIDTH
Cir(i).P.Y = Rnd*SCR_HEIGHT
Cir(i).Rad = 25+(Rnd*150)
Select Case Int(Rnd*2)
Case 0
Cir(i).Hill_Hole = 1
Case 1
Cir(i).Hill_Hole = -1
End Select
Next
For Y = 0 To SCR_HEIGHT-1
For X = 0 To SCR_WIDTH-1
tVec.Y = Y
tVec.X = X
R = 0
G = 128
B = 0
For i = 0 To Ubound(Cir)
Dist = Vec_2D_Dist( Cir(i).P, tVec )
If Dist<=Cir(i).Rad Then
G += (((Cir(i).Rad-Dist))*Cir(i).Hill_Hole)
End If
Next
If G<0 Then G=0
If G>255 Then G=255
If G<=68 And G>=64 Then
R = 128
G = 128
B = 255
End If
If G<64 Then
B = G+Int(Rnd*64)
R = 0
G = 0
End If
If Int(Rnd*2)=0 Then
If B<G Then
G\=1.75
R=G\2.042553191489362
B=G\5.05263157894737
End If
End If
Scr_Buffer[X][Y].R = R
Scr_Buffer[X][Y].G = G
Scr_Buffer[X][Y].B = B
If Multikey(Sc_Escape) Then End
Next
Next
Blur_Buffer Scr_Buffer, tBuffer, 1
Do
Screenset Work_Page, Work_page Xor 1
ScreenSync
Screenlock
All_Colors_Match = True
For Y = 0 To SCR_HEIGHT-1
For X = 0 To SCR_WIDTH-1
Buffer[X][Y].R+=Sgn(tBuffer[X][Y].R-Buffer[X][Y].R)
Buffer[X][Y].G+=Sgn(tBuffer[X][Y].G-Buffer[X][Y].G)
Buffer[X][Y].B+=Sgn(tBuffer[X][Y].B-Buffer[X][Y].B)
If tBuffer[X][Y].R<>Buffer[X][Y].R Or tBuffer[X][Y].G<>Buffer[X][Y].G Or tBuffer[X][Y].B<>Buffer[X][Y].B Then
All_Colors_Match = False
End If
Pset(X,Y), Rgb(Buffer[X][Y].R, Buffer[X][Y].G, Buffer[X][Y].B)
If Multikey(Sc_Escape) Then End
Next
Next
Screenunlock
Work_Page Xor = 1
Loop Until All_Colors_Match
Loop Until Multikey(Sc_Escape)
For X = 0 To SCR_WIDTH-1
Deallocate Buffer[X]
Deallocate tBuffer[X]
Deallocate Scr_Buffer[X]
Next
Deallocate Buffer
Deallocate tBuffer
Deallocate Scr_Buffer
End
Private Sub Blur_Buffer( Byval Buffer As Colors Ptr Ptr, Byref tBuffer As Colors Ptr Ptr, Byval Strength As Integer )
Dim As Integer X, Y, X1, Y1, XBeg, XFin, YBeg, YFin, Hits, R, G, B
For Y = 0 To SCR_HEIGHT-1
For X = 0 To SCR_WIDTH-1
R=0
G=0
B=0
Hits = 0
XBeg = X-Strength
If XBeg<0 Then XBeg=0
YBeg = Y-Strength
If YBeg<0 Then YBeg=0
XFin = X+Strength
If XFin>SCR_WIDTH-1 Then XFin=SCR_WIDTH-1
YFin = Y+Strength
If YFin>SCR_HEIGHT-1 Then YFin=SCR_HEIGHT-1
Hits = (((XFin-XBeg)+1)*((YFin-YBeg)+1))
For Y1 = YBeg To YFin
For X1 = XBeg To XFin
R+= Buffer[X1][Y1].R
G+= Buffer[X1][Y1].G
B+= Buffer[X1][Y1].B
Next
Next
If Hits=0 Then Hits=1
R\=Hits
G\=Hits
B\=Hits
tBuffer[X][Y].R = R
tBuffer[X][Y].G = G
tBuffer[X][Y].B = B
Next
Next
End Sub
Private Function Vec_2D_Dist(Byval vA As Point2D, Byval vB As Point2D) As Integer
Dim DX As Integer, _
DY As Integer ,_
Dist As Integer, _
tD As Integer
DX = (Va.X - Vb.X)
DY = (Va.Y - Vb.Y)
tD = Dx*Dx+Dy*Dy
Dist = Sqr(tD)
Function = Dist
End Function
This one requires an image, so I put it in a zip. It actually does look lie a screensaver.
http://qbnz.com/dr_davenstein/flag.zip
Posts: 421
Threads: 22
Joined: Oct 2005
WOW! That is amazing, Dr_D!
EDIT: Red Marvin, where can I get the CVS version?
EDIT2: Never mind, I found it.
EDIT3: Nice screensavers, RedMarvin. I like the mesmerizing shifting pattern of the triangles. The circles are, in my opinion, too small.
In the beginning, there is darkness â the emptiness of a matrix waiting for the light. Then a single photon flares into existence. Then another. Soon, thousands more. Optronic pathways connect, subroutines emerge from the chaos, and a holographic consciousness is born." -The Doctor
Posts: 421
Threads: 22
Joined: Oct 2005
NO MORE POSTS?!?!?!
Come on!
In the beginning, there is darkness â the emptiness of a matrix waiting for the light. Then a single photon flares into existence. Then another. Soon, thousands more. Optronic pathways connect, subroutines emerge from the chaos, and a holographic consciousness is born." -The Doctor
Posts: 1,080
Threads: 87
Joined: Feb 2002
Surprise!
Maybe not to some, since an older version has been visible on freebasic.net forums, but I though you migh be interested here too.
Code: ' random/changing IFS fractal generator by red_Marvin/insomninja code is licensed under the GNU GPL
#define fc 6.283185308
declare sub ifs(x0 as single, y0 as single, branchcount as uinteger, l0 as single, a0 as single, lm as single ptr, am as single ptr, maxdepth as integer, depth as uinteger = 0)
randomize timer
dim as uinteger md = 10
dim as uinteger bc = 3
dim as single ptr lm = callocate(len(single)*bc)
dim as single ptr am = callocate(len(single)*bc)
dim as single ptr lma = callocate(len(single)*bc)
dim as single ptr ama = callocate(len(single)*bc)
dim as single a0=rnd*fc
for n as integer = 0 to bc-1
lma[n]=rnd*.2+.8
ama[n]=(rnd-rnd)/100
lm[n]=rnd
am[n]=rnd*fc
next
screenres 1024,768,32,1,&H41
setmouse,,0
do
screenlock
cls
ifs(512, 384, bc, 100, a0, lm, am, md)
screenunlock
for n as integer = 0 to bc-1
lma[n]*=rnd/500+.999
if lma[n]>1.01 then lma[n]=1.01
if lma[n]<.99 then lma[n]=.99
lm[n]*=lma[n]
if lm[n]>.9 then lm[n]=.9 : lma[n]=1
if lm[n]<.5 then lm[n]=.5 : lma[n]=1
ama[n]+=(rnd-rnd)/1000
if ama[n]>.01 then ama[n]=.01
if ama[n]<-.01 then ama[n]=-.01
am[n]+=ama[n]
if am[n]>fc then am[n]-=fc
if am[n]<0 then am[n]+=fc
next
sleep 15
loop while inkey=""
deallocate lm
deallocate am
deallocate lma
deallocate ama
sub ifs(x0 as single, y0 as single, branchcount as uinteger, l0 as single, a0 as single, lm as single ptr, am as single ptr, maxdepth as integer, depth as uinteger = 0)
if depth < maxdepth then
dim as single l1, a1, x1, y1
for n as uinteger = 0 to branchcount-1
l1=l0*lm[n]
a1=a0+am[n]
x1=x0+l1*cos(a1)
y1=y0+l1*sin(a1)
line(x0, y0)-(x1, y1), rgba(255,255,255,64-depth*64\maxdepth)
ifs(x1, y1, branchcount, l1, a1, lm, am, maxdepth, depth+1)
next
end if
end sub
/post]
Posts: 421
Threads: 22
Joined: Oct 2005
Whoa...:wow: Lots of neurons... :lol:
In the beginning, there is darkness â the emptiness of a matrix waiting for the light. Then a single photon flares into existence. Then another. Soon, thousands more. Optronic pathways connect, subroutines emerge from the chaos, and a holographic consciousness is born." -The Doctor
Posts: 1,774
Threads: 62
Joined: Aug 2003
Nice demo man.
Posts: 421
Threads: 22
Joined: Oct 2005
Davenstein! Come on, make an entry!
In the beginning, there is darkness â the emptiness of a matrix waiting for the light. Then a single photon flares into existence. Then another. Soon, thousands more. Optronic pathways connect, subroutines emerge from the chaos, and a holographic consciousness is born." -The Doctor
|