Qbasicnews.com
October 20, 2018, 08:52:03 PM *
Welcome, Guest. Please login or register.

Login with username, password and session length
News: Back to Qbasicnews.com | QB Online Help | FAQ | Chat | All Basic Code | QB Knowledge Base
 
   Home   Help Search Login Register  
Pages: [1]
  Print  
Author Topic: Screensaver  (Read 10267 times)
Skyler
Ancient Guru
****
Posts: 564



« on: December 31, 2006, 07:06:37 PM »

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!
Logged

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
red_Marvin
Na_th_an
*****
Posts: 1509



WWW
« Reply #1 on: January 01, 2007, 07:25:09 PM »

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 Smiley
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!
Logged

/post]
Skyler
Ancient Guru
****
Posts: 564



« Reply #2 on: January 01, 2007, 10:42:48 PM »

Good, no ASM shortcuts. That means I can understand it easily!
Logged

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
Dr_Davenstein
Na_th_an
*****
Posts: 2052


« Reply #3 on: January 01, 2007, 11:02:23 PM »

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. Wink



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. Wink
http://qbnz.com/dr_davenstein/flag.zip
Logged
Skyler
Ancient Guru
****
Posts: 564



« Reply #4 on: January 02, 2007, 11:36:25 AM »

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.
Logged

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
Skyler
Ancient Guru
****
Posts: 564



« Reply #5 on: January 05, 2007, 07:02:44 PM »

NO MORE POSTS?!?!?!
Come on!
Logged

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
red_Marvin
Na_th_an
*****
Posts: 1509



WWW
« Reply #6 on: January 07, 2007, 08:27:39 PM »

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
Logged

/post]
Skyler
Ancient Guru
****
Posts: 564



« Reply #7 on: January 07, 2007, 10:11:02 PM »

Whoa...:wow: Lots of neurons...  :lol:
Logged

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
Dr_Davenstein
Na_th_an
*****
Posts: 2052


« Reply #8 on: January 07, 2007, 10:31:01 PM »

Nice demo man. Wink
Logged
Skyler
Ancient Guru
****
Posts: 564



« Reply #9 on: January 08, 2007, 11:54:44 AM »

Davenstein! Come on, make an entry!
Logged

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
Skyler
Ancient Guru
****
Posts: 564



« Reply #10 on: February 01, 2007, 10:59:00 AM »

Okay, the winner!
RedMarvin's fractal screensaver. Very good. Unfortunately, there weren't as many entries as I thought.
Logged

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
Pages: [1]
  Print  
 
Jump to:  

Powered by MySQL Powered by PHP Powered by SMF 1.1.21 | SMF © 2015, Simple Machines Valid XHTML 1.0! Valid CSS!