PureBasic Forums - English

Posted: **Tue May 25, 2010 4:06 pm**

I would like to learn how to make Plasma, raster bar and starfields if possible...

could anyone point me in right directions pls...

cheers

Posted: **Tue May 25, 2010 10:19 pm**

The code was from blitz website but I have convert to purebasic but cant seem get working....

Code: Select all

MAX_STAR=5000
STAR_SPEED=2
WIDTH=640
HEIGHT=480

Dim star_x(MAX_STAR)
Dim star_y(MAX_STAR)
Dim star_z(MAX_STAR)

OpenScreen(WIDTH,HEIGHT,32,"")


SetFrameRate(60)

setup_stars()

InitKeyboard()
ExamineKeyboard()  

Repeat  
	    ClearScreen(0)
	    UpdateStar()
	    FlipBuffers()

Until KeyboardPushed(#PB_Key_Escape) 
End

Procedure setup_stars()
  	For c=0 To MAX_STAR
	      star_x(c)=Rnd(-(WIDTH/2),(WIDTH/2))Shl 8
	      star_y(c)=Rnd(-(HEIGHT/2),(HEIGHT/2))Shl 8
        star_z(c)=Rnd(STAR_SPEED,255)
	  Next 
EndProcedure

Procedure UpdateStar()
	For c=0 To MAX_STAR
	    star_z(c)=star_z(c)-STAR_SPEED
	    If star_z(c)<=STAR_SPEED Then star_z(c)=255
	    s_x=(star_x(c)/star_z(c))+(WIDTH/2)
	    s_y=(star_y(c)/star_z(c))+(HEIGHT/2)
	    col=255-star_z(c)
	    FrontColor(Col)
	    Plot s_x,s_y,255
      Plot(s_x, s_y, RGB(255), (255), (255))
	Next
EndProcedure

Posted: **Tue May 25, 2010 11:56 pm**

Code: Select all

Global MAX_STAR = 25000
Global STAR_SPEED.f = 0.1
Global Width = 1024
Global Height = 768

Structure VECTOR3f
  X.f
  Y.f
  Z.f
EndStructure

Global Dim Star.VECTOR3f(MAX_STAR)

InitSprite()
InitKeyboard()

OpenScreen(Width,Height,32,"")

Procedure setup_stars()
  For c=0 To MAX_STAR
    Star(c)\X = Random(Width)-(Width/2)
    Star(c)\Y = Random(Height)-(Height/2) 
    Star(c)\Z = (Random(100000)/100000.0)*255
  Next
EndProcedure

Procedure UpdateStar()
  StartDrawing(ScreenOutput())
  For c = 0 To MAX_STAR
    Star(c)\Z - STAR_SPEED
    If Star(c)\Z < 1 : Star(c)\Z + 255 : EndIf
    s_x.f = (Star(c)\X / (Star(c)\Z)+(Width/2.0))
    s_y.f = (Star(c)\Y / (Star(c)\Z)+(Height/2.0))
    col=255 - Star(c)\Z
    
    If s_x < 0 : s_x = 0 : EndIf
    If s_y < 0 : s_y = 0 : EndIf

    If s_x >= Width-1  : s_x = Width -1 : EndIf
    If s_y >= Height-1 : s_y = Height - 1 : EndIf
    
    Plot(s_x, s_y, RGB(col,col,col))
  Next
  StopDrawing()
EndProcedure

SetFrameRate(60)
setup_stars()

Repeat  
  ExamineKeyboard()
  ClearScreen(0)
  UpdateStar()
  FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape) 
End

Posted: **Wed May 26, 2010 4:20 pm**

hi all

for demomaking try this website for ways of making its

in c++ but examples before

so

http://www.devils.ch/alain/codz/amiga/t ... l#rotozoom

to translate if no french by you

from a geek team named devils, peoples would know

regards

yogg

Posted: **Wed May 26, 2010 4:52 pm**

I did something as an example for someone else with a similar request:
http://www.purebasic.fr/english/viewtop ... =7&t=32869

Posted: **Sat May 29, 2010 4:24 pm**

thanks everyone

I have try to make 2D Starfields but it wont run for some reason

Code: Select all

Global Width = 1024
Global Height = 768

Global num_stars = 200

InitSprite()
InitKeyboard()

OpenScreen(Width,Height,32,"")

Dim X(num_stars,4)
Dim y(num_stars,3)

SetFrameRate(60)

; Generate the stars
For i=0 To num_stars-1      
   x(i,2)=Random(639)+1  ; X
   y(i,2)=Random(479)+ 1 ; Y
   x(i,3)=Random(5)+1    ; Speed
Next
   
Repeat 
  ExamineKeyboard()
  ClearScreen(0)
  UpdateStar()
  FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape)
End

Procedure UpdateStar()

   StartDrawing(ScreenOutput())
   For i = 0 To num_stars-1
   
       x(i,2)= x(i,2)-x(i,3)
   
       ;' If Starfield go pass go off the screen
       ; ' Restart the starfield 
       
      If x(i,2)=<0
         x(i,2) = 800
         ;(i,2) = Rnd(479) +1
      EndIf
      
      col = 255
     
      Plot(x(i,2), y(i,2), RGB(col,col,col)))
   Next 
   StopDrawing()
EndProcedure

Posted: **Sat May 29, 2010 4:38 pm**

Swos2009 wrote:thanks everyone

I have try to make 2D Starfields but it wont run for some reason

Add this at the top of your code:

Code: Select all

Declare UpdateStar()

and remove the extra right paren so the line with Plot() reads like this:

Code: Select all

Plot(x(i,2), y(i,2), RGB(Col,Col,Col))

Posted: **Sat May 29, 2010 5:53 pm**

thanks demivec for pointing out

I still get error saying "is not function , array, marco or linked lists"

Code: Select all

Global Width = 1024
Global Height = 768

Global num_stars = 200

Declare UpdateStar()

InitSprite()
InitKeyboard()

OpenScreen(Width,Height,32,"")

Dim x(num_stars,4)
Dim y(num_stars,3)

SetFrameRate(60)

; Generate the stars
For i=0 To num_stars-1     
   x(i,2)=Random(639)+1  ; X
   y(i,2)=Random(479)+ 1 ; Y
   x(i,3)=Random(5)+1    ; Speed
Next
   
Repeat
  ExamineKeyboard()
  ClearScreen(0)
  UpdateStar()
  FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape)
End

Procedure UpdateStar()

   StartDrawing(ScreenOutput())
   For i = 0 To num_stars-1
   
       x(i,2)= x(i,2)-x(i,3)    ;  <<<<  Why error?
   
       ;' If Starfield go pass go off the screen
       ; ' Restart the starfield
       
      If x(i,2)=<0
         x(i,2) = 800
         ;(i,2) = Rnd(479) +1
      EndIf
     
      col = 255
     
      Plot(x(i,2), y(i,2), RGB(Col,Col,Col))
   Next
   StopDrawing()
EndProcedure

Posted: **Sat May 29, 2010 6:07 pm**

Swos2009 wrote:thanks demivec for pointing out

I still get error saying "is not function , array, marco or linked lists"[/code]

Add Global before each of the Dim's.

Posted: **Sat May 29, 2010 6:12 pm**

here what i have done

Code: Select all

Global Width = 1024
Global Height = 768

Global num_stars = 200

Declare UpdateStar()

InitSprite()
InitKeyboard()

OpenScreen(Width,Height,32,"")

Global x
Global y

Dim x(num_stars,4)
Dim y(num_stars,3)

SetFrameRate(60)

; Generate the stars
For i=0 To num_stars-1     
   x(i,2)=Random(639)+1  ; X
   y(i,2)=Random(479)+ 1 ; Y
   x(i,3)=Random(5)+1    ; Speed
Next
   
Repeat
  ExamineKeyboard()
  ClearScreen(0)
  UpdateStar()
  FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape)
End

Procedure UpdateStar()

   StartDrawing(ScreenOutput())
   For i = 0 To num_stars-1
   
       x(i,2)= x(i,2)-x(i,3) 
   
       ;' If Starfield go pass go off the screen
       ; ' Restart the starfield
       
      If x(i,2)=<0
         x(i,2) = 800
         ;(i,2) = Rnd(479) +1
      EndIf
     
      col = 255
     
      Plot(x(i,2), y(i,2), RGB(Col,Col,Col))
   Next
   StopDrawing()
EndProcedure

Posted: **Sat May 29, 2010 7:14 pm**

Change

Code: Select all

Global x
Global y

Dim x(num_stars,4)
Dim y(num_stars,3)

to

Code: Select all

Global Dim x(num_stars,4)
Global Dim y(num_stars,3)

Posted: **Sat May 29, 2010 8:19 pm**

Thanks Demvic

Global Dim x(num_stars,4)
Global Dim y(num_stars,3)

I didnt know puerbasic could do this and my 2D Starfields is work great

Do you think I should do 2D Starfields in Structure rather than Dim Arrays?

My next attept would be 2D Rotation Stafields

Posted: **Sat May 29, 2010 8:50 pm**

Swos2009 wrote:Thanks Demvic

Global Dim x(num_stars,4)
Global Dim y(num_stars,3)
I didnt know puerbasic could do this and my 2D Starfields is work great
Do you think I should do 2D Starfields in Structure rather than Dim Arrays?

My next attept would be 2D Rotation Stafields

You have more than a few choices on how to store the starfield information. For instance you could use an array of structures that each contain {x, y, x_speed, y_speed}. I think you should use whatever you're most comfortable with, most choices are interchangeable with only minor changes.

I noticed in your current implementation you have 5 indexes for each star's x coordinate and 4 indexes for each star's y coordinate but you only use 2 for each of them. You may not realize that an array's indexes are zero based.

If you search the forum you can probably find an example of rotating starfields in 2 dimensions and also 3 dimensions.

Posted: **Sun May 30, 2010 11:44 am**

Hello Swos2009,

Amiga Demo? It's always a great idea!

If you're interested in some small codes about, try the links (sorry german only, but the code)

http://forum.deltaforceteam.de/forum/vi ... f=11&t=522 - BootBlock Style
http://forum.deltaforceteam.de/forum/vi ... f=11&t=523 - BootBlock Style
http://forum.deltaforceteam.de/forum/vi ... f=11&t=525 - Paranoimia Style
http://forum.deltaforceteam.de/forum/vi ... .php?t=643 - BobScroller by Bobo

Hope it will help to finish a full classic Amiga Demo

Posted: **Sun May 30, 2010 4:38 pm**

thanks peace and it is going be worth learning progress for me

PureBasic Forums - English

Purebasic Amiga Demo?

Purebasic Amiga Demo?

Re: Purebasic Amiga Demo?

Re: Purebasic Amiga Demo?

Re: Purebasic Amiga Demo?

Re: Purebasic Amiga Demo?

Re: Purebasic Amiga Demo?

Re: Purebasic Amiga Demo?

Re: Purebasic Amiga Demo?

Re: Purebasic Amiga Demo?

Re: Purebasic Amiga Demo?

Re: Purebasic Amiga Demo?

Re: Purebasic Amiga Demo?

Re: Purebasic Amiga Demo?

Re: Purebasic Amiga Demo?

Re: Purebasic Amiga Demo?