Fast Plasma... again

Source-code only - please, don't post questions here.
Zamaster
Posts: 1020
Joined: Jun 20, 2005 21:40
Contact:

Fast Plasma... again

Postby Zamaster » Jul 01, 2007 20:30

I know many have already seen this, but I dug it up today and modified the code to make it faster and a lot better looking. The palette is now random and the plasmas take up the whole screen with a new varying persistence value. It looks neat:

Code: Select all


'+++++ IMPORTANT +++++
' - The only reason this
'   code doesnt generate
'   plasma instantaneously
'   is because it draws
'   each iteration instead
'   of the final product.
'   It looks cooler this
'   way : )


Dim shared as integer Grad(0 To 255)


'+=============================================================+
Sub Rainbow()
    Dim as integer i, b, badd, g, gadd, r, radd, rx, gx, bx
    rx =  2
    gx = -2
    bx = -2
    b=int(rnd * 256):badd= bx
    g=int(rnd * 256):gadd= gx
    r=int(rnd * 256):radd= rx
    For i = 0 To 255
        b += badd
        g += gadd
        r += radd
        If b < 0   Then badd = -bx: b = 0
        If b > 255 Then badd =  bx: b = 255
        If g < 0   Then gadd = -gx: g = 0
        If g > 255 Then gadd =  gx: g = 255
        If r > 255 Then radd = -rx: r = 255
        If r < 0   Then radd =  rx: r = 0
        Grad(i) = RGB(r,g,b)
    Next i
end sub
'+==============+MAKE THIS WHATEVER YOU WANT : )+==============+


Rainbow


Sub GenPlasma(byval w     as integer, byval h     as integer, _
              byval crnr1 as integer, byval crnr2 as integer, _
              byval crnr3 as integer, byval crnr4 as integer, _
              byval rough as integer, byval iter  as integer, _
              byval prs   as double)
    Dim as double prex, prey, d1, d2, d3, d4, hr, fv, Image(0 to w,0 to h)
    hr = rough * 2
    prex = w / 2: prey = h / 2
    Image(0,0)=crnr1
    Image(w,0)=crnr2: d1 = (crnr1+crnr2) / 2: Image(prex,0)=d1
    Image(w,h)=crnr3: d2 = (crnr2+crnr3) / 2: Image(w,prey)=d2
    Image(0,h)=crnr4: d3 = (crnr3+crnr4) / 2: Image(prex,h)=d3
                      d4 = (crnr4+crnr1) / 2: Image(0,prey)=d4
    fv = ((d1+d2+d3+d4) / 4) + (Int(rnd * hr) - rough)
    If fv>255 Then
        fv=255
    ELseif fv<0 Then
        fv=0
    Endif
    Image(Cint(prex),Cint(prey))=fv
    Dim as double divisor, mdivx, mdivy, i, xs, ys, c1,c2,c3,c4, cx,cy, dx,dy
    mdivx = w / 2: mdivy = h / 2
    w -= 1: h -= 1
    For i = 1 to iter
        For ys = 0 To h Step mdivy
            For xs = 0 To w Step mdivx
                prex = mdivx / 2: prey = mdivy / 2
                cx   = xs + mdivx : cy   = ys + mdivy
                c1 = Image(Cint(xs),Cint(ys)): c2 = Image(Cint(cx),Cint(ys))
                c3 = Image(Cint(cx),Cint(cy)): c4 = Image(Cint(xs),Cint(cy))
                d1 = (c1+c2) / 2: d2 = (c2+c3) / 2
                d3 = (c3+c4) / 2: d4 = (c4+c1) / 2
                dx = xs + prex: dy = ys + prey
                Image(Cint(dx),Cint(ys))=d1
                Image(Cint(cx),Cint(dy))=d2
                Image(Cint(dx),Cint(cy))=d3
                Image(Cint(xs),Cint(dy))=d4
                fv = ((d1+d2+d3+d4) / 4) + (Int(rnd * hr) - rough)
                If fv>255 Then
                    fv=255
                ELseif fv<0 Then
                    fv=0
                Endif
                Image(Cint(dx),Cint(dy))=fv
            Next xs
        Next ys
        mdivx = mdivx / 2
        mdivy = mdivy / 2
        hr    = rough
        rough = rough * prs
        screenlock
        For ys = 0 To h step mdivy
            For xs = 0 To w step mdivx
                Line (xs,ys)-(xs+mdivx,ys+mdivy), Grad(Image(xs,ys)), BF
            Next xs
        Next ys
        screenunlock
    Next i
End Sub



'test code

#Include "fbgfx.bi"
Using FB
#define ri(x) (int(rnd*x))
Screenres 1280,1024,32,,1
randomize Timer

Do
    Rainbow
    GenPlasma 1280,1024,ri(256),ri(256),ri(256),ri(256),300,8,rnd
    Locate 1,1: Print "Press the spacebar for another pattern. Press ESC to quit"
    Do
        If multikey(&h01) Then
            end
        Elseif multikey(SC_SPACE) Then
            Goto ExitDo
        Endif
    Loop
    ExitDo:
Loop
Pritchard
Posts: 5425
Joined: Sep 12, 2005 20:06
Location: Ohio, USA

Postby Pritchard » Jul 01, 2007 21:17

Wow. I ended up with this really effin cool plasma that looked like clouds over a dark and hellish land. I happened to take a screenshot. ^.^;;

Return to “Tips and Tricks”

Who is online

Users browsing this forum: No registered users and 0 guests