# Qbasicnews.com

Full Version: Screensaver
You're currently viewing a stripped down version of our content. View the full version with proper formatting.
Pages: 1 2
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.

If you want me to revise anything, let me know and I'll consider it.

Happy New Year's!
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!
Good, no ASM shortcuts. That means I can understand it easily!
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
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.
```' 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```
Nice demo man. 