Meteors - simple but very nice

Advanced game related topics
walbus
Addict
Addict
Posts: 929
Joined: Sat Mar 02, 2013 9:17 am

Meteors - simple but very nice

Post by walbus »

This little code i have maked before a long time for testing how PB works

Its a simple but very nice effect

Code: Select all

; Meteors - by Werner Albus - www.nachtoptik.de

UsePNGImageDecoder()
UseJPEGImageDecoder()

Define b_meteor_add_yy_y.f ,b_meteor_add_yy_yy.f ,meteor.f ,meteor_1.f
Global timer_event_1

;landscape$="C:\Users\Werner\Desktop\Polarlicht.jpg" ; Set here the pad to your Landscape Picture

meteor_start=1       ; Meteor - start Quantity
meteor_max=100       ; Meteor maximal Quantity 
meteor_1=0.1         ; Increment accrete Quantity Speed
animation_speed=30   ; Animation Speed
fall_speed=5         ; Felocity of Fall
drift=-2             ; drift - as sample -3 = left // +3 = right
alpha=255            ; Meteor Brightness
full_at_startup=0    ; 1 = Filling Screen at Startup  //  0 = Filling Screen slowly at startup
                     ; For filling at Startup set also meteor_start many bigger or equal meteor_max

win_x=1200 ; Window width
win_y=800  ; Window height

If landscape$<>""
  LoadImage(0,landscape$) ; Load a dark landscape Image
Else
  CreateImage(0,1200,800) ; Or load nothing
EndIf
ResizeImage(0,win_x,win_y)
CopyImage(0,1)

meteor=meteor_start
  
ExamineDesktops()
OpenWindow(0,DesktopWidth(0)/2-win_x/2,DesktopHeight(0)/2-win_y/2,win_x,win_y,"Meteor´s")

If Not InitSprite() Or Not OpenWindowedScreen(WindowID(0),0,0,win_x,win_y,0,0,0)
  MessageRequester("Error", "Can not init",0)
  End
EndIf

Procedure timer_events()
  Select EventTimer()
    Case 1
      timer_event_1=1
  EndSelect
EndProcedure

AddWindowTimer(0,1,animation_speed)
BindEvent(#PB_Event_Timer, @timer_events())

Dim meteor (meteor_max,2)

For i=0 To meteor_max
  meteor(i,0)=Random(win_x)
  If full_at_startup
    meteor(i,1)=Random(win_y)
  Else
    meteor(i,1)=-Random(win_y)
  EndIf
Next i

Repeat

  If timer_event_1
    timer_event_1=0
    
    StartDrawing(ImageOutput(0))
  
    DrawingMode(#PB_2DDrawing_AlphaBlend) 
    
    DrawAlphaImage(ImageID(1),0,0,50)
    
    If meteor<meteor_max ; Add meteor slowly
      meteor+meteor_1
      If meteor>meteor_max
        meteor=meteor_max
      EndIf
    EndIf
    
    For i=0 To meteor
      
      If drift
        meteor(i,0)+drift
      Else
        meteor(i,0)+-Random(2)+1
      EndIf
      
      If meteor(i,0)>win_x
        meteor(i,0)=0
      EndIf
      If meteor(i,0)<0
        meteor(i,0)=win_x
      EndIf
      If meteor(ii,0)>win_x
        meteor(ii,0)=0
      EndIf
      If meteor(ii,0)<0
        meteor(ii,0)=win_x
      EndIf
      
       Select Random(2)
        Case 0,1
          Circle(meteor(i,0)+Random(1),meteor(i,1)+meteor_add_y,Random(1),RGBA(255,255,0,alpha)) 
        Case 2
           Circle(meteor(i,0)+Random(1),meteor(i,1)+meteor_add_y,0,RGBA(255,255,0,alpha))
      EndSelect

      meteor(i,1)+Random(fall_speed+1)
      
      If meteor(i,1)>win_y
        meteor(i,1)=0
      EndIf
    Next i 
    
  StopDrawing()
  EndIf
   
  StartDrawing(WindowOutput(0))
  DrawAlphaImage(ImageID(0),0,0)
  StopDrawing()
  
  Repeat
    event=WindowEvent()
    If event=#PB_Event_CloseWindow
      End
    EndIf
  Until Not event
  
ForEver

AddWindowTimer(0,1,animation_speed)
BindEvent(#PB_Event_Timer, @timer_events())

Dim meteor (meteor_max,2)

For i=0 To meteor_max
  meteor(i,0)=Random(win_x)
  If full_at_startup
    meteor(i,1)=Random(win_y)
  Else
    meteor(i,1)=-Random(win_y)
  EndIf
Next i

Repeat

  If timer_event_1
    timer_event_1=0
    
    StartDrawing(ImageOutput(0))
  
    DrawingMode(#PB_2DDrawing_AlphaBlend) 
    
    DrawAlphaImage(ImageID(1),0,0,50)
    
    If meteor<meteor_max ; Add meteor slowly
      meteor+meteor_1
      If meteor>meteor_max
        meteor=meteor_max
      EndIf
    EndIf
    
    For i=0 To meteor
      
      If drift
        meteor(i,0)+drift
      Else
        meteor(i,0)+-Random(2)+1
      EndIf
      
      If meteor(i,0)>win_x
        meteor(i,0)=0
      EndIf
      If meteor(i,0)<0
        meteor(i,0)=win_x
      EndIf
      If meteor(ii,0)>win_x
        meteor(ii,0)=0
      EndIf
      If meteor(ii,0)<0
        meteor(ii,0)=win_x
      EndIf
      
       Select Random(2)
        Case 0,1
          Circle(meteor(i,0)+Random(1),meteor(i,1)+meteor_add_y,Random(1),RGBA(255,255,0,alpha)) 
        Case 2
           Circle(meteor(i,0)+Random(1),meteor(i,1)+meteor_add_y,0,RGBA(255,255,0,alpha))
      EndSelect

      meteor(i,1)+Random(fall_speed+1)
      
      If meteor(i,1)>win_y
        meteor(i,1)=0
      EndIf
    Next i 
    
  StopDrawing()
  EndIf
   
  StartDrawing(WindowOutput(0))
  DrawAlphaImage(ImageID(0),0,0)
  StopDrawing()

Until WindowEvent()=#PB_Event_CloseWindow
User avatar
Josh
Addict
Addict
Posts: 1183
Joined: Sat Feb 13, 2010 3:45 pm

Re: Meteors - simple but very nice

Post by Josh »

Nice effect, but when I see this, I think more to my little swimmers than meteors :mrgreen:
sorry for my bad english
walbus
Addict
Addict
Posts: 929
Joined: Sat Mar 02, 2013 9:17 am

Re: Meteors - simple but very nice

Post by walbus »

Yep Josh, you are right

You probably only see a big meteor once in your life, then it's over.....
Just like dinosaurs :wink:

Primary it are snow flakes :lol:

A little hint : Both codes works and looking very nice with a Landscape or a image as background

Code: Select all

; Tanzender Schnee - Dancing Snow - by Werner Albus - www.nachtoptik.de

Define b_snow_add_yy_y.f ,b_snow_add_yy_yy.f ,flakes.f ,flakes_1.f

flakes_start=1       ; Flocken - Startwert
flakes_max=3000      ; Flocken - Anzahl
flakes_1=1.0         ; Geschwindigkeit der Schneezunahme (Fließkomma)
animation_speed=70   ; Animations Geschwindigkeit
fall_speed=1         ; Fallgeschwindigkeit

win_x=800 ; Fenster Breite
win_y=600  ;Fenster Höhe

flakes=flakes_start
Global timer_event_1

Procedure timer_events()
  Select EventTimer()
    Case 1
      timer_event_1=1
  EndSelect
EndProcedure

ExamineDesktops()
OpenWindow(0,DesktopWidth(0)/2-win_x/2,DesktopHeight(0)/2-win_y/2,win_x,win_y,"Dancing Snow")

If InitSprite() = 0 Or InitKeyboard() = 0 Or OpenWindowedScreen(WindowID(0),0,0,win_x,win_y,0,0,0,#PB_Screen_WaitSynchronization) = 0
  MessageRequester("Error", "Can not init Spritesystem",0)
  End
EndIf

AddWindowTimer(0,1,animation_speed)
BindEvent(#PB_Event_Timer, @timer_events())

CreateImage (0,win_x,win_y) ; Create Background
StartDrawing(ImageOutput (0))
DrawingMode ( #PB_2DDrawing_Gradient )
BackColor (0)
FrontColor ($FF901E)
LinearGradient (0,-300,0,1500)
Box (0,0,win_x,win_y)
StopDrawing()

Dim flake (flakes_max,2)

Dim settle(win_x)      ; Addon - settle a little Snow
Dim settle_hat(200)  ; Addon - settle a little Snow on the Hat

For i=0 To flakes_max
  flake(i,0)=Random(win_x)
  flake(i,1)=-Random(win_y)
Next i

Repeat
  
  If timer_event_1
    timer_event_1=0
    FlipBuffers ()
    StartDrawing(ScreenOutput())
    DrawImage(ImageID(0),0,0)
    
    Circle(450,win_y-75,15,$EFEFEF) ; Addon - Simple Snowman :-)
    Circle(450,win_y-50,20,$EFEFEF) : Circle(450,win_y-72,6,0)
    Circle(450,win_y-75,7, $EFEFEF) : Circle(450,win_y-75,2,$0045FF)
    Circle(450,win_y-25,30,$EFEFEF) : Circle(450,win_y-55,1,0)
    Circle(443,win_y-80,1, 0)       : Circle(457,win_y-80,1,0)
    Circle(450,win_y-50,1,  0)       : Circle(450,win_y-45,1,0)
    Circle(450,win_y-30,1, 0)       : Circle(450,win_y-25,1,0) ; ----
    
    ;--------------------------- 
    
    If flakes<flakes_max ; Flocken Anzahl langsam erhöhen
      flakes+flakes_1
      If flakes>flakes_max
        flakes=flakes_max
      EndIf
    EndIf
    
    For i=0 To flakes
      flake(i,0)+-Random(2)+1
      If flake(i,0)>win_x+5
        flake(i,0)=Random(win_x)
      EndIf
      If flake(i,0)<-5
        flake(i,0)=Random(win_x)
      EndIf
      If flake(ii,0)>win_x+5
        flake(ii,0)=Random(win_x)
      EndIf
      If flake(ii,0)<-5
        flake(ii,0)=Random(win_x)
      EndIf

      Select Random(3)
        Case 0
          Circle(flake(i,0)+Random(1),flake(i,1)+snow_add_y,Random(1)) 
        Case 1
          Circle(flake(i,0)+Random(1),flake(i,1)+snow_add_y,Random(1),$A9A9A9)
        Case 2,3
           Circle(flake(i,0)+Random(1),flake(i,1)+snow_add_y,0)
       EndSelect
       
      flake(i,1)+Random(fall_speed+1)
      
      If flake(i,1)>win_y
        flake(i,1)=0
      EndIf
    Next i 
    
    ;--------------------------- 
    
    For ii=1 To win_x-1 ; Addon - settle a little Snow -------------
      If Point(ii,win_y-2)=$FFFFFF
        settle(ii)=1
      EndIf
      If settle(ii)
        Circle(ii,win_y-1,1)
      EndIf
    Next ii
    For ii = 1 To 3 : settle(Random(win_x))=0 : Next ii ;--------
    
    For ii=1 To 26 ; Addon - settle a little Snow on the Hat --
      If Point(ii+436,win_y-100)=$FFFFFF
        settle_hat(ii)=1
      EndIf
      If settle_hat(ii)
        Circle(ii+436,win_y-99,1)
      EndIf
    Next ii
    settle_hat(Random(200))=0 ;---------------------------------
    
    Box(437,win_y-98,26,15,$828282) ;-- Addon Snowman´s Hat --
    
    StopDrawing()
  EndIf
  
  ;---------------------------
  
  Repeat 
    event=WindowEvent()
    Select event
      Case #PB_Event_CloseWindow
        quit=1
    EndSelect
  Until event=0
  
  ;---------------------------
  
Until quit
User avatar
RSBasic
Moderator
Moderator
Posts: 1218
Joined: Thu Dec 31, 2009 11:05 pm
Location: Gernsbach (Germany)
Contact:

Re: Meteors - simple but very nice

Post by RSBasic »

Image
Image
Image
Post Reply