## FAST Plasma

Zamaster
Posts: 1024
Joined: Jun 20, 2005 21:40
Contact:

### FAST Plasma

My contribution for the day. It be vera-fast.

Code: Select all

`Option ExplicitDim shared as integer Grad(0 To 255)'+=============================================================+Sub Rainbow()    Dim as integer i, b, badd, g, gadd, r, radd    b=256:badd= -2    g=128:gadd= -2    r=0  :radd=  2    For i = 0 To 255        b += badd        g += gadd        r += radd        If b < 0   Then badd =  2: b = 0        If b > 255 Then badd = -2: b = 255        If g < 0   Then gadd =  2: g = 0        If g > 255 Then gadd = -2: g = 255        If r > 255 Then radd = -2: r = 255        If r < 0   Then radd =  2: r = 0        Grad(i) = RGB(r,g,b)    Next iend sub'+==============+MAKE THIS WHATEVER YOU WANT : )+==============+RainbowSub 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)                  Dim as integer prex, prey, d1, d2, d3, d4, hr, fv, Image(0 to w,0 to h)    hr = rough SHL 1    prex = w SHR 1: prey = h SHR 1    Image(0,0)=crnr1    Image(w,0)=crnr2: d1 = (crnr1+crnr2) SHR 1: Image(prex,0)=d1    Image(w,h)=crnr3: d2 = (crnr2+crnr3) SHR 1: Image(w,prey)=d2    Image(0,h)=crnr4: d3 = (crnr3+crnr4) SHR 1: Image(prex,h)=d3                      d4 = (crnr4+crnr1) SHR 1: Image(0,prey)=d4        fv = ((d1+d2+d3+d4) SHR 2) + (Int(rnd * hr) - rough)    If fv>255 Then fv=255    If fv<0 Then fv=0        Image(prex,prey)=fv        Dim as integer divisor, mdivx, mdivy, i, xs, ys, c1,c2,c3,c4, cx,cy, dx,dy    mdivx = w SHR 1: mdivy = h SHR 1    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 SHR 1: prey = mdivy SHR 1                cx   = xs + mdivx : cy   = ys + mdivy                c1 = Image(xs,ys): c2 = Image(cx,ys)                c3 = Image(cx,cy): c4 = Image(xs,cy)                d1 = (c1+c2) SHR 1: d2 = (c2+c3) SHR 1                d3 = (c3+c4) SHR 1: d4 = (c4+c1) SHR 1                dx = xs + prex: dy = ys + prey                Image(dx,ys)=d1                Image(cx,dy)=d2                Image(dx,cy)=d3                Image(xs,dy)=d4                                fv = ((d1+d2+d3+d4) SHR 2) + (Int(rnd * hr) - rough)                If fv>255 Then fv=255                If fv<0 Then fv=0                Image(dx,dy)=fv                        Next xs        Next ys        mdivx = mdivx SHR 1        mdivy = mdivy SHR 1                    hr    = rough         rough = rough SHR 1            Next i        screenlock    For ys = 0 To h        For xs = 0 To w           Pset (xs,ys), Grad(Image(xs,ys))        Next xs    Next ys    screenunlockEnd Sub'test code#Include "fbgfx.bi"#define ri(x) (int(rnd*x))Screenres 512,512,32',,1randomize TimerDim as double T, ET, DTDo    T = TIMER    GenPlasma 512,512,ri(256),ri(256),ri(256),ri(256),200,8    ET = TIMER    DT = ET-T    Locate 1,1: Print "It took: ";DT;" seconds"    Locate 2,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 `
voodooattack
Posts: 605
Joined: Feb 18, 2006 13:30
Location: Alexandria / Egypt
Contact:
Cool! xD

couldn't resist :p

Code: Select all

`'Option ExplicitDim Shared As Integer Grad(0 To 255)'+=============================================================+Sub Rainbow()    Dim As Integer i, b, badd, g, gadd, r, radd    b=256:badd= -2    g=128:gadd= -2    r=0  :radd=  2    For i = 0 To 255        b += badd        g += gadd        r += radd        If b < 0   Then badd =  2: b = 0        If b > 255 Then badd = -2: b = 255        If g < 0   Then gadd =  2: g = 0        If g > 255 Then gadd = -2: g = 255        If r > 255 Then radd = -2: r = 255        If r < 0   Then radd =  2: r = 0        Grad(i) = RGB(r,g,b)    Next iEnd Sub'+==============+MAKE THIS WHATEVER YOU WANT : )+==============+RainbowSub 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)                 Dim As Integer prex, prey, d1, d2, d3, d4, hr, fv, Image(0 To w,0 To h)    hr = rough Shl 1    prex = w Shr 1: prey = h Shr 1    Image(0,0)=crnr1    Image(w,0)=crnr2: d1 = (crnr1+crnr2) Shr 1: Image(prex,0)=d1    Image(w,h)=crnr3: d2 = (crnr2+crnr3) Shr 1: Image(w,prey)=d2    Image(0,h)=crnr4: d3 = (crnr3+crnr4) Shr 1: Image(prex,h)=d3                      d4 = (crnr4+crnr1) Shr 1: Image(0,prey)=d4       fv = ((d1+d2+d3+d4) Shr 2) + (Int(Rnd * hr) - rough)    If fv>255 Then fv=255    If fv<0 Then fv=0       Image(prex,prey)=fv       Dim As Integer divisor, mdivx, mdivy, i, xs, ys, c1,c2,c3,c4, cx,cy, dx,dy    mdivx = w Shr 1: mdivy = h Shr 1    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 Shr 1: prey = mdivy Shr 1                cx   = xs + mdivx : cy   = ys + mdivy                c1 = Image(xs,ys): c2 = Image(cx,ys)                c3 = Image(cx,cy): c4 = Image(xs,cy)                d1 = (c1+c2) Shr 1: d2 = (c2+c3) Shr 1                d3 = (c3+c4) Shr 1: d4 = (c4+c1) Shr 1                dx = xs + prex: dy = ys + prey                Image(dx,ys)=d1                Image(cx,dy)=d2                Image(dx,cy)=d3                Image(xs,dy)=d4                               fv = ((d1+d2+d3+d4) Shr 2) + (Int(Rnd * hr) - rough)                If fv>255 Then fv=255                If fv<0 Then fv=0                Image(dx,dy)=fv                       Next xs        Next ys        mdivx = mdivx Shr 1        mdivy = mdivy Shr 1                  hr    = rough        rough = rough Shr 1           Next i       screenlock    For ys = 0 To h        For xs = 0 To w           Pset (xs,ys), Grad(Image(xs,ys))        Next xs    Next ys    screenunlockEnd Sub'test code#Include "fbgfx.bi"#define ri(x) (Int(Rnd*x))using FBScreenres 512,512,32, 2',,1Dim As double T, ET, DTscreenset 0, 1 dt = timeret = 10Do        If multikey(SC_ESCAPE) Then exit do        t += et    randomize dt        screenlock    GenPlasma 512,512,ri(256),ri(256),ri(256),ri(256), t , 8    screenunlock        flip        if t >= 500 then         et *= -1    elseif t <= 0 then        et *= -1        dt = timer    end if    Loop`
Zamaster
Posts: 1024
Joined: Jun 20, 2005 21:40
Contact:
Cool dude! Makes it more fun to look at.
Posts: 469
Joined: Dec 17, 2006 23:37
Contact:
Just awesome!
tinram
Posts: 88
Joined: Nov 30, 2006 13:35
Location: UK
I read on one thread that multiple calls to the randomize function really slow things down. But it seems voodooattack's animation here relies on just that for the cool animation effect.

Code: Select all

`' original Plasma program by Zamaster, 2006 ' animation by voodooattack' minor amendments (and bugs) by tinramSCREENRES 512,512,32,,&h04#DEFINE ri(x) (INT(RND*x))DIM AS DOUBLE dtDIM AS INTEGER t = 0, et = 10DIM SHARED AS INTEGER Grad(0 TO 255)RANDOMIZE TIMER, 3dt = TIMERSUB 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 iEND SUBSUB 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)   DIM AS INTEGER prex, prey, d1, d2, d3, d4, hr, fv, divisor, mdivx, mdivy, i, xs, ys, c1, c2, c3, c4, cx, cy, dx, dy   DIM AS INTEGER ImageArr(0 TO w, 0 TO h)   hr = rough SHL 1   prex = w SHR 1   prey = h SHR 1   ImageArr(0, 0) = crnr1   ImageArr(w, 0) = crnr2   d1 = (crnr1 + crnr2) SHR 1   ImageArr(prex, 0) = d1   ImageArr(w,h) = crnr3   d2 = (crnr2 + crnr3) SHR 1   ImageArr(w,prey) = d2   ImageArr(0, h) = crnr4   d3 = (crnr3 + crnr4) SHR 1   ImageArr(prex, h) = d3   d4 = (crnr4 + crnr1) SHR 1   ImageArr(0, prey) = d4   fv = ((d1 + d2 + d3 + d4) SHR 2) + (INT(RND * hr) - rough)   IF fv > 255 THEN fv = 255   IF fv < 0 THEN fv = 0   ImageArr(prex, prey) = fv   mdivx = w SHR 1   mdivy = h SHR 1   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 SHR 1            prey = mdivy SHR 1            cx = xs + mdivx            cy = ys + mdivy            c1 = ImageArr(xs, ys)            c2 = ImageArr(cx, ys)            c3 = ImageArr(cx, cy)            c4 = ImageArr(xs, cy)            d1 = (c1 + c2) SHR 1            d2 = (c2 + c3) SHR 1            d3 = (c3 + c4) SHR 1            d4 = (c4 + c1) SHR 1            dx = xs + prex            dy = ys + prey            ImageArr(dx, ys) = d1            ImageArr(cx, dy) = d2            ImageArr(dx, cy) = d3            ImageArr(xs, dy) = d4            fv = ((d1 + d2 + d3 + d4) SHR 2) + (INT(RND * hr) - rough)            IF fv > 255 THEN fv = 255            IF fv < 0 THEN fv = 0            ImageArr(dx, dy) = fv         NEXT xs      NEXT ys      mdivx = mdivx SHR 1      mdivy = mdivy SHR 1      hr = rough      rough = rough SHR 1   NEXT i   SCREENLOCK   FOR ys = 0 TO h      FOR xs = 0 TO w         PSET (xs, ys), Grad(ImageArr(xs, ys))      NEXT xs   NEXT ys   SCREENUNLOCKEND SUBDO   IF MULTIKEY(&h01) OR INKEY = CHR(255) + "k" THEN EXIT DO   Rainbow   t += et   RANDOMIZE dt, 3 ' these randomize calls are really slowing the program down, but SLEEP results in a poorer effect   GenPlasma 512, 512, ri(256), ri(256), ri(256), ri(256), t, 8   IF t >= 500 THEN      et *= -1   ELSEIF t <= 0 THEN      et *= -1      dt = TIMER   END IFLOOP`
Last edited by tinram on May 04, 2008 18:02, edited 1 time in total.
Posts: 79
Joined: Jun 06, 2007 15:21
I think next iter in that code should be next i

Very cool effect though!
Posts: 824
Joined: Dec 07, 2005 22:58
Contact:
Qlink wrote:I think next iter in that code should be next i

If I recall correctly - for lang fb, the argument after next is just for readability, it is otherwise ignored by the compiler...
Consider:

Code: Select all

`For i as integer = 1 to 10? inext testsleep`
counting_pine
Posts: 6180
Joined: Jul 05, 2005 17:32
Location: Manchester, Lancs
If I recall correctly, the NEXT parsing is the same in all dialects.

Recent versions of FreeBASIC will give an error if the variable names don't match, but yes, in any case, the variable name is optional, and its purpose is entirely for the benefit of the programmer, rather than the compiler.
tinram
Posts: 88
Joined: Nov 30, 2006 13:35
Location: UK
@Qlink - yes, my late night mistake; I've amended the code.