Electricity Effects . . . please bear with me!!!!

Shockwave · September 11, 2006

Now impliment this routine into your electricity for the ultimate electrifying experience

http://dbfinteractive.com/index.php?topic=632.0

ninogenio · September 11, 2006

i was bored so heres a quick bash up from me


'THE MAIN DIFFRENCE IN USING TINYPTC I CAN THINK OF IS THAT YOU GET NO GRAPHICS FUNCTIONS
'ALL YOU GET IS A 1D FRAME BUFFER IE INSTED OF BUFFER(0 TO 640, 0 TO 480) YOU GET BUFFER(0 TO 640*480)
'NOW TO PLOT A POINT AT SAY 10,100 YOU NEED AN AGORITHM HER IT IS Y*SCR_WIDTH+X SO THE LINE OF CODE
'WOULD BE BUFFER(100*640+10)=COLOR_VALUE THATS BASICALLY THE FUNDEMENTALLS TO IT NOW TO DRAW DIFFRENT
'SHAPES AND EFFECTS YOU USE THAT FORMULA WITH YOUR OWN CODE AND VWALLA

#include once "windows.bi"
#include once "gl/gl.bi"
#include once "gl/glext.bi"
#include once "fbgfx.bi"

defint a-z


dim shared SCR_WIDTH as integer
dim shared SCR_HEIGHT as integer
dim shared SCR_SIZE as integer

'HERE I JUST DECLARE THE FUNCTIONS IM GOINGTO USE
declare function flip_buffer()
declare function clear_buffer()
declare function electric_line(byval x1 as double ,byval y1 as double ,byval x2 as double ,byval y2 as double)
declare function setrgb(byval index as double,byval red as double,byval green as double,byval blue as double)
declare function my_circle(byval x as double, byval y as double, byval r as double)
declare function my_line(byval x1 as double,byval y1 as double,byval x2 as double,byval y2 as double)
declare function open_window(byval xres as double,byval yres as double)
declare function smooth( screen_ptr() )
declare function ptc_open(byval title as zstring ptr, byval width as integer, byval height as integer ) as integer
declare function ptc_update(byval buff as integer ptr) as integer
declare function ptc_close() as integer
declare sub ptc_setflip(byval interval as integer)

'i use option dynamic on the buffer array so i can resize it in the open window
'function to the size of the screen
'$DYNAMIC
dim shared buffer(0) as integer
dim shared forground_pallette_color as integer
dim shared background_pallette_color as integer

'these two lines just set the background to black and forground to white by default
forground_pallette_color = rgb( 255 , 255 , 255 )
background_pallette_color = rgb( 0 , 0 , 0 )

'here we open the ptc window with my own function thats not really needed but i find
'its a bit cleaner
open_window(640,480)

dim a as integer
dim r as integer
dim r2 as integer
dim i as integer
dim o as integer
dim frames as integer

randomize
r = INT(RND(25)*75)+1
r2 = INT(RND(25)*75)+1
   
i=15
   
o = int(rnd(1)*4)
if o = 0 then r2 =- r2
if o = 2 then r=-r

dim no_frames = 18

'heres our main loop
do
    if frames>no_frames then 
       r = INT(RND(25)*75)+1
       r2 = INT(RND(25)*75)+1
   
       i=15
   
       o = int(rnd(1)*4)
       if o = 0 then r2 =- r2
       if o = 2 then r=-r
       frames = 0
       no_frames = 25+int(rnd(1)*10)
       electric_blue = int(rnd(1)*255)
       elecric_green = int(rnd(1)*255)
       electric_red = int(rnd(1)*255)

    endif 
    
    'HERES THE MAIN DIFFRENCE FROM MY TINY CODE TO THE FB CODE
    'SETRGB SETS EITHER THE BACKGROUND COLOR OR FORGROUND COLOR AS SO
    'SETRGB INDEX(1 OR 0) 1 = FORGROUND 0 = BACKGROUND , RED(0 TO 255) , GREEN(0 TO 255) , BLUE(0 TO 255)

   
    'AGAIN THE SAME APPLIES TO MY LINE
    'MY LINE X1,Y1,X2,Y2
    setrgb 1,electric_red,electric_green,electric_blue
    if frames >= 0 and frames < 4 then electric_line 0 , 240 , 100+r , 200+r2
    if frames >= 4 and frames <6 then 
              electric_line 100+r , 200+r2 , 225+r , 295+r2
              electric_line 0 , 240 , 100+r , 200+r2
    endif
    if frames >= 6 and frames < 8 then 
              electric_line 100+r , 200+r2 , 225+r , 295+r2
              electric_line 0 , 240 , 100+r , 200+r2
              electric_line 225+r , 295+r2 , 265+r , 220+r2
    endif
    if frames >= 8 then 
              electric_line 100+r , 200+r2 , 225+r , 295+r2
              electric_line 0 , 240 , 100+r , 200+r2
              electric_line 225+r , 295+r2 , 265+r , 220+r2
              electric_line 265+r , 220+r2 , 305+r , 315+r2
    endif
    if frames >= 10 and frames < 12 then  
              electric_line 305+r , 315+r2 , 450+r , 150+r2
              electric_line 100+r , 200+r2 , 225+r , 295+r2
              electric_line 0 , 240 , 100+r , 200+r2
              electric_line 225+r , 295+r2 , 265+r , 220+r2
              electric_line 265+r , 220+r2 , 305+r , 315+r2
    endif
    if frames >= 12 and frames < 14 then  
              electric_line 450+r , 150+r2 , 550+r , 300+r2
              electric_line 305+r , 315+r2 , 450+r , 150+r2
              electric_line 100+r , 200+r2 , 225+r , 295+r2
              electric_line 0 , 240 , 100+r , 200+r2
              electric_line 225+r , 295+r2 , 265+r , 220+r2
              electric_line 265+r , 220+r2 , 305+r , 315+r2
    endif
    if frames >= 14 and frames < 16 then
              electric_line 550+r , 300+r2 , 585+r , 200+r2
              electric_line 450+r , 150+r2 , 550+r , 300+r2
              electric_line 305+r , 315+r2 , 450+r , 150+r2
              electric_line 100+r , 200+r2 , 225+r , 295+r2
              electric_line 0 , 240 , 100+r , 200+r2
              electric_line 225+r , 295+r2 , 265+r , 220+r2
              electric_line 265+r , 220+r2 , 305+r , 315+r2
    endif
    if frames >= 16 then
              electric_line 550+r , 300+r2 , 585+r , 200+r2
              electric_line 450+r , 150+r2 , 550+r , 300+r2
              electric_line 305+r , 315+r2 , 450+r , 150+r2
              electric_line 100+r , 200+r2 , 225+r , 295+r2
              electric_line 0 , 240 , 100+r , 200+r2
              electric_line 225+r , 295+r2 , 265+r , 220+r2
              electric_line 265+r , 220+r2 , 305+r , 315+r2
              electric_line 585+r , 200+r2 , 639 , 240
    endif
    
    'MY CIRCLE DIFFRERS IN THAT ALL YOU NEED SEING AS YOUVE JUST SET THE COLOR IS
    'MY CIRCLE X1,Y1,RAD
    setrgb 1,int(rnd(1)*255),int(rnd(1)*255),int(rnd(1)*255)
    my_circle 0, 240 , 6
    my_circle 639,240 , 6
    
    smooth buffer()
    'NOW TO SIMULATE DOUBLE BUFFERING WY PUSH THE BUFFER ARRAY UP TO THE ACTUALLY SCREEN WITH FLIP_BUFFER
    flip_buffer
    
    frames += 1
    
loop until( inkey$ = chr$(27) )
'a bit of house keeping
'empty the keboard buffer
while INKEY$ <> "": wend
'after code execution you have to close ptc
ptc_close
'and then clear the buffer
erase buffer



function my_circle(byval x as double, byval y as double, byval r as double)
   
          dim r2 as double
          dim z as double
          dim w as double
          if r<0 then exit function
          r2 = (r*r)
          for z=-r to r
               w=sqr(r2-z*z)
               my_line x-w,z+y,x+w,z+y
          next
         
          return 0
         
end function




''''''''''''''''''''''''''''''''''''''''''''''''''
' my_line named so because line was already taken
' Bresenham's infamous line algorithm
''''''''''''''''''''''''''''''''''''''''''''''''''
function my_line(byval x1 as double ,byval y1 as double ,byval x2 as double ,byval y2 as double)
         
         dim i, deltax, deltay, numpixels as integer
         dim d, dinc1, dinc2 as integer
         dim x, xinc1, xinc2 as integer
         dim y, yinc1, yinc2 as integer
         
         'sort points
         if x1>x2 then
             
              tmp = x1
              x1 = x2
              x2 = tmp
             
         endif
         
         if y1<0 then
             
            tmp = y1
            y1 = y2
            y2 = tmp
           
         endif
         
         'a spot of clipping
         if x1<0 then x1 = 0
         if x2>SCR_WIDTH then x2 = SCR_WIDTH - 1
         if y1<0 then y1 = 0
         if y2>SCR_WIDTH then y2 = SCR_HEIGHT - 1
         
         'calculate deltaX and deltaY
         deltax = abs(int(x2) - int(x1))
         deltay = abs(int(y2) - int(y1))
         
         'initialize
         if(deltax >= deltay) then
                  'If x is independent variable
                  numpixels = deltax + 1
                  d = (2 * deltay) - deltax
                  dinc1 = deltay shl 1
                  dinc2 = (deltay - deltax) shl 1
                  xinc1 = 1
                  xinc2 = 1
                  yinc1 = 0
                  yinc2 = 1
         else
                  'if y is independent variable
                  numpixels = deltay + 1
                  d = ( 2 * deltax ) - deltay
                  dinc1 = deltax shl 1
                  dinc2 = ( deltax - deltay ) shl 1
                  xinc1 = 0
                  xinc2 = 1
                  yinc1 = 1
                  yinc2 = 1
         endif
         
         'move the right direction
         if ( int(x1) > int(x2) ) then
                  xinc1 = -xinc1
                  xinc2 = -xinc2
         endif
         
         if ( int(y1) > int(y2) ) then
                  yinc1 = -yinc1
                  yinc2 = -yinc2
         endif
         
         x = int(x1)
         y = int(y1)
         
         'draw the pixels
         for i = 1 to numpixels
                  buffer( y*SCR_WIDTH+x ) = forground_pallette_color
                  if ( d < 0 ) then
                          d = d + dinc1
                          x = x + xinc1
                          y = y + yinc1
                  else
                          d = d + dinc2
                          x = x + xinc2
                          y = y + yinc2
                  endif
         next
         
         return 0
         
end function



function electric_line(byval x1 as double ,byval y1 as double ,byval x2 as double ,byval y2 as double)
         
         dim i, deltax, deltay, numpixels as integer
         dim d, dinc1, dinc2 as integer
         dim x, xinc1, xinc2 as integer
         dim y, yinc1, yinc2 as integer
         dim garoud_color1 as integer = int(rnd(1)*255)
         dim garoud_color2 as integer = int(rnd(1)*255)
         
         'sort points
         if x1>x2 then
             
              tmp = x1
              x1 = x2
              x2 = tmp
             
         endif
         
         if y1<0 then
             
            tmp = y1
            y1 = y2
            y2 = tmp
           
         endif
         
         'a spot of clipping
         if x1<0 then x1 = 0
         if x2>SCR_WIDTH then x2 = SCR_WIDTH - 1
         if y1<0 then y1 = 0
         if y2>SCR_WIDTH then y2 = SCR_HEIGHT - 1
         
         'calculate deltaX and deltaY
         deltax = abs(int(x2) - int(x1))
         deltay = abs(int(y2) - int(y1))
         
         'initialize
         if(deltax >= deltay) then
                  'If x is independent variable
                  numpixels = deltax + 1
                  d = (2 * deltay) - deltax
                  dinc1 = deltay shl 1
                  dinc2 = (deltay - deltax) shl 1
                  xinc1 = 1
                  xinc2 = 1
                  yinc1 = 0
                  yinc2 = 1
         else
                  'if y is independent variable
                  numpixels = deltay + 1
                  d = ( 2 * deltax ) - deltay
                  dinc1 = deltax shl 1
                  dinc2 = ( deltax - deltay ) shl 1
                  xinc1 = 0
                  xinc2 = 1
                  yinc1 = 1
                  yinc2 = 1
         endif
         
         'move the right direction
         if ( int(x1) > int(x2) ) then
                  xinc1 = -xinc1
                  xinc2 = -xinc2
         endif
         
         if ( int(y1) > int(y2) ) then
                  yinc1 = -yinc1
                  yinc2 = -yinc2
         endif
         
         x = int(x1)
         y = int(y1)
         
         'draw the pixels
         for i = 1 to numpixels
                  buffer( (y-2)*SCR_WIDTH+x ) = rgb(garoud_color1,0,255)
                  buffer( (y-1)*SCR_WIDTH+x ) = rgb(0,0,garoud_color2)
                  buffer( y*SCR_WIDTH+x ) = forground_pallette_color
                  buffer( (y+1)*SCR_WIDTH+x ) = rgb(0,0,garoud_color2)
                  buffer( (y+2)*SCR_WIDTH+x ) = rgb(garoud_color1,0,255)
                  if ( d < 0 ) then
                          d = d + dinc1
                          x = x + xinc1
                          y = y + yinc1
                  else
                          d = d + dinc2
                          x = x + xinc2
                          y = y + yinc2
                  endif
         next
         
         return 0
         
end function



'this function sets your background or forground color to what ever you specify
function setrgb(byval index as double,byval red as double,byval green as double,byval blue as double)
         if index = 0 then background_pallette_color = rgb( red , green , blue )
         if index = 1 then forground_pallette_color = rgb( red , green , blue )

         return 0
         
end function



'this function will open a tinyptc window what ever valid size you specify
function open_window(byval xres as double, byval yres as double)
   
         SCR_WIDTH=xres
         SCR_HEIGHT=yres
         SCR_SIZE=xres*yres
         redim buffer( 0 to SCR_SIZE - 1) as integer
         ptc_open( "ELECTRICITY", SCR_WIDTH, SCR_HEIGHT )
         
         return 0
         
end function



'this pushes the back buffer up to the display through tinyptc
function flip_buffer()
         
         ptc_update @buffer(0)
         
         return 0
         
end function



' this function clears our screen or what i like to think of the back buffer
function clear_buffer()
         
         for x=0 to SCR_SIZE-1 'scr_size is 640*480 because remember tiny uses 1d arrays
                 buffer(x) = background_pallette_color 'flushes all the elements in our screen refrence array i.e sets the color of each screen pixel to the color specifyed by setrgb
         next
         
         return 0
         
end function


'relsofts smooth func
function smooth( screen_ptr())
    dim maxpixel as integer
    dim offset as integer
    dim pixel as unsigned integer
    dim r as integer
    dim g as integer
    dim b as integer
    dim nr as integer
    dim ng as integer
    dim nb as integer



    maxpixel = ubound(buffer)
    for offset = SCR_WIDTH to maxpixel - SCR_WIDTH
       
        pixel = buffer(offset-1)
        r = pixel shr 16
        g = pixel shr 8 and 255
        b = pixel and 255
        nr = r shr 2
        ng = g shr 2
        nb = b shr 2
       
        pixel = buffer(offset+1)
        r = pixel shr 16
        g = pixel shr 8 and 255
        b = pixel and 255
        nr = nr + ( r shr 2 )
        ng = ng + ( g shr 2 )
        nb = nb + ( b shr 2 )
       
        pixel = buffer(offset+SCR_WIDTH)
        r = pixel shr 16
        g = pixel shr 8 and 255
        b = pixel and 255
        nr = nr + ( r shr 2 )
        ng = ng + ( g shr 2 )
        nb = nb + ( b shr 2 )
       
        pixel = buffer(offset-SCR_WIDTH)
        r = pixel shr 16
        g = pixel shr 8 and 255
        b = pixel and 255
        nr = nr + ( r shr 2 )
        ng = ng + ( g shr 2 )
        nb = nb + ( b shr 2 )
       
        screen_ptr(offset) = nr shl 16 or ng shl 8 or nb
       
    next i
   
    return 0
   
end function

dim shared g_w as integer
dim shared g_h as integer

type PFNWGLSWAPINTERVALFARPROC as sub(byval interval as integer)
dim shared wglSwapIntervalEXT as PFNWGLSWAPINTERVALFARPROC

function ptc_open(byval title as zstring ptr, byval w as integer, byval h as integer) as integer
screenres w,h,32,0,2
    wglSwapIntervalEXT = cast(PFNWGLSWAPINTERVALFARPROC,wglGetProcAddress("wglSwapIntervalEXT"))
    ptc_setflip(1)
    glViewport(0, 0, w,h)
    glMatrixMode(GL_PROJECTION)
    glLoadIdentity()
    glOrtho(0,w,h,0,0,1)
    glPixelZoom(1,-1)
    glRasterPos2i(0,0)
    g_w=w
    g_h=h
return 0
end function

function ptc_update(byval buff as integer ptr) as integer
    glDrawPixels(g_w,g_h,GL_BGRA_EXT,GL_UNSIGNED_BYTE,buff)
    flip
return 0
end function

function ptc_close() as integer
return 0
end function

sub ptc_setflip(byval interval as integer)
    if wglSwapIntervalExt <> 0 then
        wglSwapIntervalEXT(interval)
    endif
end sub

Shockwave · September 11, 2006

Sweet stuff Nino

Nice one.

ninogenio · September 11, 2006

ohh sorry shockwave i never noticed your bezier curves hmm might try that out.

Shockwave · September 11, 2006

I posted it for everyone to use so feel free

I'd like to see it used in connection with your cool blur routine, it should be possible to make a really authentic effect using splines and some careful thought

ninogenio · September 11, 2006

yeah im definitly going to try it out later or tommorow depending when ive got some more spare time, i agree though we should be able to get it really authentic yousing beziers

psygate · September 11, 2006

I have over doine my routin and thought about a little random in the sparks you get with electricity, (yeah, i did experimatens too...)

This is my result: (Im working on improvements, but it looks pretty good AND its short! So it doesn't take much of your space in the source!)
On my olt pentium II i get about 400 frames per second (way too fast for the eye

)

Code Select


dim as integer x2,y2,x1,y1,x,y,xmax,ymax,range,col,fps,l
dim as double t
screenres 640,480,24,,
screeninfo xmax,ymax
x1=0
y1=ymax\2
x2=xmax-1
y2=ymax\2
x=x1
y=y1
range=100
circle (x1,y1),10,&hffffff,,,,f
circle (x2,y2),10,&hff0000,,,,f
pset (x2,y2),&h00ff00
t=timer+2
do
    if t<=timer then t=timer+1:locate 1,1:print fps:fps=0
    fps+=1
    screenlock
    cls
    for l=1 to 3
        x=x1
        y=y1    
        col=int(rnd*256)
        while (x<=x2 or y<>y2)
            x+=1
            if y>y2+range then y-=1
            
            if abs(x2-x+1)<abs(y2-y) then
                y+=sgn(y2-y)
            else
                y+=(-1)^int(rnd*2)
                if y>y2+range then y-=1
                if y<y2-range then y+=1
            end if
            pset (x,y),col
        wend
    next
    screenunlock
loop until inkey$=chr(27)

The code is pretty self explaining, if there are any questions, ASK!

Shockwave · September 11, 2006

Cool stuff Psygate, it made me make my own sound effects

Here's a little example of what you could do with Beziers though, this can easily be improved on.. Exe attached for those without fb.

Code Select



'
' HERE'S MY ATTEMPT, VERY UNOPTIMISED.
' Shockwave.
'

OPTION STATIC
OPTION EXPLICIT

    '#define PTC_WIN       
    #Include Once "tinyptc.bi"

    CONST XRES = 640
    CONST YRES = 480
    
    dim shared buffer (xres * yres ) as uinteger
    dim shared buffer2 (xres * yres ) as uinteger
    DIM SHARED AS INTEGER XPOINTS(21)
    DIM SHARED AS INTEGER YPOINTS(21)
    DIM SHARED AS INTEGER CX1(21)
    DIM SHARED AS INTEGER CY1(21)
    DIM SHARED AS INTEGER CX2(21)
    DIM SHARED AS INTEGER CY2(21)
    DIM SHARED AS INTEGER OFF(21)
    DIM SHARED AS INTEGER OFF2(21)
    DIM SHARED AS INTEGER OFFT(21)
    DIM SHARED AS INTEGER L
    DIM SHARED AS DOUBLE GADD
    dim shared cpal(500) as uinteger
    dim as double rv,gv,bv
    for l=1 to 500
        if rv<254 then rv=rv+.5
        if gv<254 then gv=gv+.75
        if bv<254 then bv=bv+1
        cpal(l)=rgb(int(rv),int(gv),int(bv))
    next
    FOR L=1 TO 21
        OFF(L) = RND*100
        OFF2(L) = RND*100
        OFFT(L) = RND*100
    NEXT

    declare sub BEZIER(BYVAL X0 AS INTEGER ,BYVAL Y0 AS INTEGER, BYVAL X3 AS INTEGER ,BYVAL Y3 AS INTEGER ,BYVAL X1 AS INTEGER ,BYVAL Y1 AS INTEGER ,BYVAL X2 AS INTEGER ,BYVAL Y2 AS INTEGER )
    DECLARE SUB ELECTRIC()
    
    If( ptc_open( "YOU CAN IMPROVE ON THIS EASILY :p", XRES, YRES ) = 0 ) Then
    End -1
End If


DO



        ELECTRIC()
        GADD=GADD+rnd*.05

        
    FOR L=1 TO XRES*YRES       
        BUFFER(L)=cpal (BUFFER2(L))
        if buffer2(l)>0 then buffer2(l)=buffer2(l)*.85
    NEXT

        
    PTC_UPDATE@BUFFER(0)
    erase buffer
LOOP UNTIL INKEY$=CHR$(27)
END

SUB ELECTRIC()
    DIM A,X,Y
    X=10
    Y=240
    FOR A=1 TO 21
       XPOINTS(A)=X+(24*SIN(GADD+A+OFF(A)*5))
       IF A>1 AND A<20 THEN 
           YPOINTS(A)=Y+(80*SIN(GADD+OFF(A)))
        ELSE
            YPOINTS(A)=Y
        END IF

            CX1(A)=X+(29*SIN(GADD+OFF2(A)/13))
            CY1(A)=Y+(34*SIN(GADD+OFF2(A)/43))

            CX2(A)=X+(28*COS(GADD+OFF(A)/23))
            CY2(A)=Y+(14*SIN(GADD+OFF(A)/11))

       

       X=X+31
       OFFT(A)=OFFT(A)-1
       IF OFFT(A)<=0 THEN
           OFF(A)=RND*(100)
           OFF2(A)=RND*(100)
           OFFT(A)=RND*(40)
       END IF
    NEXT
    
    FOR A=1 TO 20
        BEZIER (XPOINTS(A),YPOINTS(A),XPOINTS(A+1),YPOINTS(A+1),CX1(A),CY1(A),CX2(A),CY2(A))
    NEXT
    
END SUB

'
' USAGE, BEZIER(SOURCE X,SOURCE Y , DEST X , DEST Y, CONTROL X1 , CONTROL Y1 , CONTROL X2, CONTROL Y2)
'

SUB BEZIER(BYVAL X0 AS INTEGER ,BYVAL Y0 AS INTEGER, BYVAL X3 AS INTEGER ,BYVAL Y3 AS INTEGER ,BYVAL X1 AS INTEGER ,BYVAL Y1 AS INTEGER ,BYVAL X2 AS INTEGER ,BYVAL Y2 AS INTEGER )
dim as double T,t2,t3
DIM AS INTEGER L,X,Y,cx,bx,ax,cy,by,ay
dim as integer br
CX = 3*(X1-X0)
BX = 3*(X2-X1)-CX
AX = X3-X0-CX-BX
CY=3*(Y1-Y0)
BY=3*(Y2-Y1)-CY
AY=Y3-Y0-CY-BY

for t = 0 to 1 step .01
    t3=t^3
    t2=t^2
    br=X+(Y*XRES)
        x = ax * t3 + bx * t2 + cx * t + X0
        y = ay * t3 + by * t2 + cy * t + Y0
        IF X>0 AND X<XRES and buffer2(br)<400 THEN buffer2(br) =buffer2(br)+100
next

END SUB

Shockwave · September 11, 2006

Shit! I almost forgot the mandatory metal balls

so I throw in an asm based filled circle routine as a bonus (no clipping so be careful!).

Code Select



'
' HERE'S MY ATTEMPT, VERY UNOPTIMISED.
' Shockwave.
'

OPTION STATIC
OPTION EXPLICIT

    '#define PTC_WIN       
    #Include Once "tinyptc.bi"

    CONST XRES = 640
    CONST YRES = 480
    
    dim shared buffer (xres * yres ) as uinteger
    dim shared buffer2 (xres * yres ) as uinteger
    DIM SHARED AS INTEGER XPOINTS(21)
    DIM SHARED AS INTEGER YPOINTS(21)
    DIM SHARED AS INTEGER CX1(21)
    DIM SHARED AS INTEGER CY1(21)
    DIM SHARED AS INTEGER CX2(21)
    DIM SHARED AS INTEGER CY2(21)
    DIM SHARED AS INTEGER OFF(21)
    DIM SHARED AS INTEGER OFF2(21)
    DIM SHARED AS INTEGER OFFT(21)
    DIM SHARED AS INTEGER L,M
    DIM SHARED AS DOUBLE GADD
    dim shared cpal(500) as uinteger
    dim as double rv,gv,bv
    for l=1 to 500
        if rv<254 then rv=rv+.5
        if gv<254 then gv=gv+.75
        if bv<254 then bv=bv+1
        cpal(l)=rgb(int(rv),int(gv),int(bv))
    next
    FOR L=1 TO 21
        OFF(L) = RND*100
        OFF2(L) = RND*100
        OFFT(L) = RND*100
    NEXT
    
    
    declare sub dcircle(BYVAL CX AS INTEGER , BYVAL CY AS INTEGER , BYVAL R AS INTEGER, BYVAL CLR AS INTEGER)
    declare sub BEZIER(BYVAL X0 AS INTEGER ,BYVAL Y0 AS INTEGER, BYVAL X3 AS INTEGER ,BYVAL Y3 AS INTEGER ,BYVAL X1 AS INTEGER ,BYVAL Y1 AS INTEGER ,BYVAL X2 AS INTEGER ,BYVAL Y2 AS INTEGER )
    DECLARE SUB ELECTRIC()
    
    If( ptc_open( "YOU CAN IMPROVE ON THIS EASILY :p", XRES, YRES ) = 0 ) Then
    End -1
End If


DO
M=1



        ELECTRIC()
    for L=30 to 1 step -1
    dcircle(32+(M/3),(240-(M/3)),L,M*5)
    dcircle(599+(M/3),(240-(M/3)),L,M*5)
    M=M+1
    next L
        GADD=GADD+rnd*.05

        
    FOR L=1 TO XRES*YRES       
        BUFFER(L)=cpal (BUFFER2(L))
        if buffer2(l)>0 then buffer2(l)=buffer2(l)*.85
    NEXT

        
    PTC_UPDATE@BUFFER(0)
    erase buffer
LOOP UNTIL INKEY$=CHR$(27)
END

SUB ELECTRIC()
    DIM A,X,Y
    X=10
    Y=240
    FOR A=1 TO 21
       XPOINTS(A)=X+(24*SIN(GADD+A+OFF(A)*5))
       IF A>2 AND A<20 THEN 
           YPOINTS(A)=Y+(80*SIN(GADD+OFF(A)))
        ELSE
            YPOINTS(A)=Y
        END IF

            CX1(A)=X+(29*SIN(GADD+OFF2(A)/13))
            CY1(A)=Y+(34*SIN(GADD+OFF2(A)/43))

            CX2(A)=X+(28*COS(GADD+OFF(A)/23))
            CY2(A)=Y+(14*SIN(GADD+OFF(A)/11))

       

       X=X+31
       OFFT(A)=OFFT(A)-1
       IF OFFT(A)<=0 THEN
           OFF(A)=RND*(100)
           OFF2(A)=RND*(100)
           OFFT(A)=RND*(40)
       END IF
    NEXT
    
    FOR A=1 TO 20
        BEZIER (XPOINTS(A),YPOINTS(A),XPOINTS(A+1),YPOINTS(A+1),CX1(A),CY1(A),CX2(A),CY2(A))
    NEXT
    
END SUB

'
' USAGE, BEZIER(SOURCE X,SOURCE Y , DEST X , DEST Y, CONTROL X1 , CONTROL Y1 , CONTROL X2, CONTROL Y2)
'

SUB BEZIER(BYVAL X0 AS INTEGER ,BYVAL Y0 AS INTEGER, BYVAL X3 AS INTEGER ,BYVAL Y3 AS INTEGER ,BYVAL X1 AS INTEGER ,BYVAL Y1 AS INTEGER ,BYVAL X2 AS INTEGER ,BYVAL Y2 AS INTEGER )
dim as double T,t2,t3
DIM AS INTEGER L,X,Y,cx,bx,ax,cy,by,ay
dim as integer br
CX = 3*(X1-X0)
BX = 3*(X2-X1)-CX
AX = X3-X0-CX-BX
CY=3*(Y1-Y0)
BY=3*(Y2-Y1)-CY
AY=Y3-Y0-CY-BY

for t = 0 to 1 step .01
    t3=t^3
    t2=t^2
    br=X+(Y*XRES)
        x = ax * t3 + bx * t2 + cx * t + X0
        y = ay * t3 + by * t2 + cy * t + Y0
        IF X>31 AND X<XRES-31  THEN buffer2(br) =buffer2(br)+100
        IF buffer2(br)>500 THEN buffer2(br)=500
next

END SUB

SUB dCIRCLE(BYVAL CX AS INTEGER , BYVAL CY AS INTEGER , BYVAL R AS INTEGER, BYVAL CLR AS INTEGER)
DIM  as integer r2,cc,loopy,ww,l,SW
DIM PP AS INTEGER PTR
r2=r*r
cc=-r      
for loopy = cc to r        
        ww = Sqr(r2-loopy*loopy)
        SW = (CX+ww)-(CX-ww)
        IF SW>0 THEN 
    PP = @BUFFER2((CX-WW)+((LOOPY+CY)*XRES))
    asm
        MOV EAX,DWORD PTR[CLR]
        MOV ECX, [SW]
        MOV EDI, [PP]   
        REP STOSD
    end asm   
            END IF
next
END SUB

DrewPee · September 11, 2006

Shockwave - Thats just f**king awesome!

Respect to all you guys! Thankyou all so much!

Drew

Shockwave · September 11, 2006

Thanks Drew

It can still be improved a lot I think. It needs random tendrils arcing off the main stream (could be done quite easily with some more beziers) and it would look extra cool if there were two more copies of the acr, one above one below at half the brightness and with some random purples interjected into the precalculated palette (so you'd get them for free).

Anyway, I'll leave someone else to finish it off and I hope that you'll code something fucking awesome with it now

Use it freely Drew.

ninogenio · September 12, 2006

cool one shockwave heres my attempt with beziers i took some of your stuff from the expmle.

its still not that good though i tell you its not easy doing these sort of effects.

Code Select


#include once "windows.bi"
#include once "gl/gl.bi"
#include once "gl/glext.bi"
#include once "fbgfx.bi"

defint a-z


dim shared SCR_WIDTH as integer
dim shared SCR_HEIGHT as integer
dim shared SCR_SIZE as integer

declare function flip_buffer()
declare function clear_buffer()
declare function bezier(byval x0 as integer , byval y0 as integer, byval x3 as integer , byval y3 as integer , byval x1 as integer , byval y1 as integer ,byval x2 as integer ,byval y2 as integer )
declare function setrgb(byval index as double,byval red as double,byval green as double,byval blue as double)
declare function my_circle(byval x as double, byval y as double, byval r as double)
declare function my_line(byval x1 as double,byval y1 as double,byval x2 as double,byval y2 as double)
declare function open_window(byval xres as double,byval yres as double)
declare function smooth( screen_ptr() )
declare function ptc_open(byval title as zstring ptr, byval width as integer, byval height as integer ) as integer
declare function ptc_update(byval buff as integer ptr) as integer
declare function ptc_close() as integer
declare sub ptc_setflip(byval interval as integer)

'$DYNAMIC
dim shared buffer(0) as integer
dim shared forground_pallette_color as integer
dim shared background_pallette_color as integer

forground_pallette_color = rgb( 255 , 255 , 255 )
background_pallette_color = rgb( 0 , 0 , 0 )

open_window(640,480)
dim shared as integer electric_x(0 to 8),electric_x1(0 to 8),electric_y(0 to 8)_
,electric_y1(0 to 8) , cx1(0 to 8) , cy1(0 to 8) , cx2(0 to 8) , cy2(0 to 8)

randomize

dim a as integer
dim r as integer
dim r2 as integer
dim i as integer
dim o as integer
dim frames as integer
dim electric_blue as integer = int(rnd(1)*255)
dim elecric_green as integer = int(rnd(1)*255)
dim electric_red as integer = int(rnd(1)*255)

r = int(rnd(25)*75)+1
r2 = int(rnd(25)*75)+1
   
i=15
   
o = int(rnd(1)*4)
if o = 0 then r2 =- r2
if o = 2 then r=-r

dim no_frames = 18
dim gadd as double
dim e_peice as integer = 1

do
    if frames > 15 then
       r = int(rnd(25)*75)+1
       r2 = int(rnd(25)*75)+1
   
       i=15
   
       o = int(rnd(1)*4)
       if o = 0 then r2 =- r2
       if o = 2 then r=-r
       frames = 0
       electric_blue = int(rnd(1)*255)
       elecric_green = int(rnd(1)*255)
       electric_red = int(rnd(1)*255)
       e_peice = 1
    endif
   
    setrgb 1,electric_red,electric_green,electric_blue
    
    electric_x(1) = 0 : electric_y(1) = 240 : electric_x1(1) = 100 + r : electric_y1(1) = 200 + r2
    electric_x(2) = 100 + r : electric_y(2) = 200+r2 : electric_x1(2) = 225 + r : electric_y1(2) = 295 + r2
    electric_x(3) = 225 + r : electric_y(3) = 295+r2 : electric_x1(3) = 265 + r : electric_y1(3) = 220 + r2
    electric_x(4) = 265 + r : electric_y(4) = 220+r2 : electric_x1(4) = 305 + r : electric_y1(4) = 315 + r2
    electric_x(5) = 305 + r : electric_y(5) = 315+r2 : electric_x1(5) = 450 + r : electric_y1(5) = 150 + r2
    electric_x(6) = 450 + r : electric_y(6) = 150+r2 : electric_x1(6) = 550 + r : electric_y1(6) = 300 + r2
    electric_x(7) = 550 + r : electric_y(7) = 300+r2 : electric_x1(7) = 585 + r : electric_y1(7) = 200 + r2
    electric_x(8) = 585 + r : electric_y(8) = 200+r2 : electric_x1(8) = 639 : electric_y1(8) = 240
    
    for x = 1 to 8
          cx1(x) = electric_x(x)+(29*sin(gadd/13))
          cy1(x) = electric_y(x)+(14*sin(gadd/43))

          cx2(x) = electric_x(x)+(28*cos(gadd/23))
          cy2(x) = electric_y(x)+(14*sin(gadd/11))
          
          gadd = gadd + 0.00003
          
    next
    

    e_peice += 1
    if e_peice > 8 then e_peice = 8
    for x=1 to e_peice
        bezier  electric_x(x) , electric_y(x) , electric_x1(x) , electric_y1(x) ,  cx1(x) , cy1(x) , cx2(x) , cy2(x)
    next
    
    if int(rnd(1)*10) = 5 then
            bezier  electric_x(e_peice) , electric_y(e_peice) , electric_x1(e_peice) , 0 + int(rnd(1)*479) ,  cx1(e_peice) , cy1(e_peice) , cx2(e_peice) , cy2(e_peice)
    end if
    
    setrgb 1,int(rnd(1)*255),int(rnd(1)*255),int(rnd(1)*255)
    my_circle 0, 240 , 6
    my_circle 639,240 , 6
   
    smooth buffer()
    flip_buffer
   
    frames += 1
   
loop until( inkey$ = chr$(27) )
while INKEY$ <> "": wend
ptc_close
erase buffer



function bezier(byval x0 as integer , byval y0 as integer, byval x3 as integer , byval y3 as integer , byval x1 as integer , byval y1 as integer ,byval x2 as integer ,byval y2 as integer )
         dim as double t,t2,t3
         dim as integer l,x,y,cx,bx,ax,cy,by,ay
         dim as integer br
         dim garoud_color1 as integer = int(rnd(1)*255)
         dim garoud_color2 as integer = int(rnd(1)*255)
         
         cx = 3*(x1-x0)
         bx = 3*(x2-x1)-cx
         ax = x3-x0-cx-bx
         cy = 3*(y1-y0)
         by = 3*(y2-y1)-cy
         ay = y3-y0-cy-by

         for t = 0 to 1 step .001
               t3=t^3
               t2=t^2
               x = ax * t3 + bx * t2 + cx * t + x0
               y = ay * t3 + by * t2 + cy * t + y0
               br=x+(y*scr_width)
               buffer( br - scr_width ) = rgb(0,0,garoud_color2)
               buffer( br ) = forground_pallette_color
               buffer( br + scr_width ) = rgb(0,0,garoud_color2)
               buffer( br + scr_width*2 ) = rgb(garoud_color1,255,255)
         next
         
         return 0
         
end function



function my_circle(byval x as double, byval y as double, byval r as double)
   
          dim r2 as double
          dim z as double
          dim w as double
          if r<0 then exit function
          r2 = (r*r)
          for z=-r to r
               w=sqr(r2-z*z)
               my_line x-w,z+y,x+w,z+y
          next
         
          return 0
         
end function




''''''''''''''''''''''''''''''''''''''''''''''''''
' my_line named so because line was already taken
' Bresenham's infamous line algorithm
''''''''''''''''''''''''''''''''''''''''''''''''''
function my_line(byval x1 as double ,byval y1 as double ,byval x2 as double ,byval y2 as double)
         
         dim i, deltax, deltay, numpixels as integer
         dim d, dinc1, dinc2 as integer
         dim x, xinc1, xinc2 as integer
         dim y, yinc1, yinc2 as integer
         
         'sort points
         if x1>x2 then
             
              tmp = x1
              x1 = x2
              x2 = tmp
             
         endif
         
         if y1<0 then
             
            tmp = y1
            y1 = y2
            y2 = tmp
           
         endif
         
         'a spot of clipping
         if x1<0 then x1 = 0
         if x2>SCR_WIDTH then x2 = SCR_WIDTH - 1
         if y1<0 then y1 = 0
         if y2>SCR_WIDTH then y2 = SCR_HEIGHT - 1
         
         'calculate deltaX and deltaY
         deltax = abs(int(x2) - int(x1))
         deltay = abs(int(y2) - int(y1))
         
         'initialize
         if(deltax >= deltay) then
                  'If x is independent variable
                  numpixels = deltax + 1
                  d = (2 * deltay) - deltax
                  dinc1 = deltay shl 1
                  dinc2 = (deltay - deltax) shl 1
                  xinc1 = 1
                  xinc2 = 1
                  yinc1 = 0
                  yinc2 = 1
         else
                  'if y is independent variable
                  numpixels = deltay + 1
                  d = ( 2 * deltax ) - deltay
                  dinc1 = deltax shl 1
                  dinc2 = ( deltax - deltay ) shl 1
                  xinc1 = 0
                  xinc2 = 1
                  yinc1 = 1
                  yinc2 = 1
         endif
         
         'move the right direction
         if ( int(x1) > int(x2) ) then
                  xinc1 = -xinc1
                  xinc2 = -xinc2
         endif
         
         if ( int(y1) > int(y2) ) then
                  yinc1 = -yinc1
                  yinc2 = -yinc2
         endif
         
         x = int(x1)
         y = int(y1)
         
         'draw the pixels
         for i = 1 to numpixels
                  buffer( y*SCR_WIDTH+x ) = forground_pallette_color
                  if ( d < 0 ) then
                          d = d + dinc1
                          x = x + xinc1
                          y = y + yinc1
                  else
                          d = d + dinc2
                          x = x + xinc2
                          y = y + yinc2
                  endif
         next
         
         return 0
         
end function



'this function sets your background or forground color to what ever you specify
function setrgb(byval index as double,byval red as double,byval green as double,byval blue as double)
         if index = 0 then background_pallette_color = rgb( red , green , blue )
         if index = 1 then forground_pallette_color = rgb( red , green , blue )

         return 0
         
end function



'this function will open a tinyptc window what ever valid size you specify
function open_window(byval xres as double, byval yres as double)
   
         SCR_WIDTH=xres
         SCR_HEIGHT=yres
         SCR_SIZE=xres*yres
         redim buffer( 0 to SCR_SIZE - 1) as integer
         ptc_open( "ELECTRICITY", SCR_WIDTH, SCR_HEIGHT )
         
         return 0
         
end function



'this pushes the back buffer up to the display through tinyptc
function flip_buffer()
         
         ptc_update @buffer(0)
         
         return 0
         
end function



' this function clears our screen or what i like to think of the back buffer
function clear_buffer()
         
         for x=0 to SCR_SIZE-1 'scr_size is 640*480 because remember tiny uses 1d arrays
                 buffer(x) = background_pallette_color 'flushes all the elements in our screen refrence array i.e sets the color of each screen pixel to the color specifyed by setrgb
         next
         
         return 0
         
end function


'relsofts smooth func
function smooth( screen_ptr())
    dim maxpixel as integer
    dim offset as integer
    dim pixel as unsigned integer
    dim r as integer
    dim g as integer
    dim b as integer
    dim nr as integer
    dim ng as integer
    dim nb as integer



    maxpixel = ubound(buffer)
    for offset = SCR_WIDTH to maxpixel - SCR_WIDTH
       
        pixel = buffer(offset-1)
        r = pixel shr 16
        g = pixel shr 8 and 255
        b = pixel and 255
        nr = r shr 2
        ng = g shr 2
        nb = b shr 2
       
        pixel = buffer(offset+1)
        r = pixel shr 16
        g = pixel shr 8 and 255
        b = pixel and 255
        nr = nr + ( r shr 2 )
        ng = ng + ( g shr 2 )
        nb = nb + ( b shr 2 )
       
        pixel = buffer(offset+SCR_WIDTH)
        r = pixel shr 16
        g = pixel shr 8 and 255
        b = pixel and 255
        nr = nr + ( r shr 2 )
        ng = ng + ( g shr 2 )
        nb = nb + ( b shr 2 )
       
        pixel = buffer(offset-SCR_WIDTH)
        r = pixel shr 16
        g = pixel shr 8 and 255
        b = pixel and 255
        nr = nr + ( r shr 2 )
        ng = ng + ( g shr 2 )
        nb = nb + ( b shr 2 )
       
        screen_ptr(offset) = nr shl 16 or ng shl 8 or nb
       
    next i
   
    return 0
   
end function

dim shared g_w as integer
dim shared g_h as integer

type PFNWGLSWAPINTERVALFARPROC as sub(byval interval as integer)
dim shared wglSwapIntervalEXT as PFNWGLSWAPINTERVALFARPROC

function ptc_open(byval title as zstring ptr, byval w as integer, byval h as integer) as integer
screenres w,h,32,0,2
    wglSwapIntervalEXT = cast(PFNWGLSWAPINTERVALFARPROC,wglGetProcAddress("wglSwapIntervalEXT"))
    ptc_setflip(1)
    glViewport(0, 0, w,h)
    glMatrixMode(GL_PROJECTION)
    glLoadIdentity()
    glOrtho(0,w,h,0,0,1)
    glPixelZoom(1,-1)
    glRasterPos2i(0,0)
    g_w=w
    g_h=h
return 0
end function

function ptc_update(byval buff as integer ptr) as integer
    glDrawPixels(g_w,g_h,GL_BGRA_EXT,GL_UNSIGNED_BYTE,buff)
    flip
return 0
end function

function ptc_close() as integer
return 0
end function

sub ptc_setflip(byval interval as integer)
    if wglSwapIntervalExt <> 0 then
        wglSwapIntervalEXT(interval)
    endif
end sub

DrewPee · September 12, 2006

@Shockwave - I will bear in mind what you have said - I will implement the code into my new creation asap - bit tight for time at the mo though!

@Ninogenio - That is a another good example though - makes mine look like code from a zx81!!!!

What a great subject this was!!!!

DrewPee

Shockwave · September 12, 2006

You're going to hate me for this Nino but the example you posted previously was better than the one you used curves in.
Curves are definately the way to go but they need a lot of fiddling to get the effect looking authentic

ninogenio · September 12, 2006

nah its cool shockwave,

i agree with you beziers are very difficult to manage. the other thing that makes this more challenging is the type of effect it is i usually just do fork lightning coming in from the tops of the screen.

Clyde · September 12, 2006

I've done some electricity stuff for Electro that didnt get used, which I'll try and track down unless I've deleted them. If I haven't then I'll post them.

Nice stuff everyone