FAST Plasma

Post your FreeBASIC tips and tricks here. Please don’t post your code without including an explanation.
Zamaster
Posts: 1024
Joined: Jun 20, 2005 21:40
Contact:

FAST Plasma

Postby Zamaster » Dec 13, 2006 23:08

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

Code: Select all

Option Explicit

Dim 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 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)
             
    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
    screenunlock
End Sub







'test code

#Include "fbgfx.bi"
#define ri(x) (int(rnd*x))
Screenres 512,512,32',,1
randomize Timer
Dim as double T, ET, DT


Do
    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:

Postby voodooattack » Dec 14, 2006 7:10

Cool! xD

couldn't resist :p

Code: Select all

'Option Explicit

Dim 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 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)
             
    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
    screenunlock
End Sub


'test code

#Include "fbgfx.bi"
#define ri(x) (Int(Rnd*x))

using FB

Screenres 512,512,32, 2',,1

Dim As double T, ET, DT
screenset 0, 1

dt = timer
et = 10

Do
   
    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:

Postby Zamaster » Dec 14, 2006 17:15

Cool dude! Makes it more fun to look at.
Hezad
Posts: 469
Joined: Dec 17, 2006 23:37
Contact:

Postby Hezad » Dec 18, 2006 10:40

Just awesome!
tinram
Posts: 88
Joined: Nov 30, 2006 13:35
Location: UK

Postby tinram » May 02, 2008 23:05

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 tinram

SCREENRES 512,512,32,,&h04

#DEFINE ri(x) (INT(RND*x))

DIM AS DOUBLE dt
DIM AS INTEGER t = 0, et = 10
DIM SHARED AS INTEGER Grad(0 TO 255)

RANDOMIZE TIMER, 3
dt = TIMER


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


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)

   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

   SCREENUNLOCK

END SUB



DO

   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 IF

LOOP


Last edited by tinram on May 04, 2008 18:02, edited 1 time in total.
Qlink
Posts: 79
Joined: Jun 06, 2007 15:21

Postby Qlink » May 03, 2008 0:57

I think next iter in that code should be next i

Very cool effect though!
maddogg6
Posts: 824
Joined: Dec 07, 2005 22:58
Contact:

Postby maddogg6 » May 03, 2008 1:40

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
? i
next test
sleep
counting_pine
Site Admin
Posts: 6190
Joined: Jul 05, 2005 17:32
Location: Manchester, Lancs

Postby counting_pine » May 03, 2008 2:02

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

Postby tinram » May 04, 2008 18:05

@Qlink - yes, my late night mistake; I've amended the code.

Return to “Tips and Tricks”

Who is online

Users browsing this forum: No registered users and 7 guests