It is currently Sat Jul 11, 2020 6:55 pm

All times are UTC + 1 hour




Post new topic Reply to topic  [ 4 posts ] 
Author Message
 Post subject: Meteors - simple but very nice
PostPosted: Mon Nov 27, 2017 12:37 pm 
Offline
Addict
Addict

Joined: Sat Mar 02, 2013 9:17 am
Posts: 930
This little code i have maked before a long time for testing how PB works

Its a simple but very nice effect

Code:
; 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

_________________
http://www.nachtoptik.de


Top
 Profile  
Reply with quote  
 Post subject: Re: Meteors - simple but very nice
PostPosted: Mon Nov 27, 2017 1:20 pm 
Offline
Addict
Addict
User avatar

Joined: Sat Feb 13, 2010 3:45 pm
Posts: 1117
Nice effect, but when I see this, I think more to my little swimmers than meteors :mrgreen:

_________________
sorry for my bad english


Top
 Profile  
Reply with quote  
 Post subject: Re: Meteors - simple but very nice
PostPosted: Mon Nov 27, 2017 1:35 pm 
Offline
Addict
Addict

Joined: Sat Mar 02, 2013 9:17 am
Posts: 930
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:
; 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

_________________
http://www.nachtoptik.de


Top
 Profile  
Reply with quote  
 Post subject: Re: Meteors - simple but very nice
PostPosted: Mon Nov 27, 2017 2:25 pm 
Offline
Moderator
Moderator
User avatar

Joined: Thu Dec 31, 2009 11:05 pm
Posts: 1112
Location: Gernsbach (Germany)
Image

_________________
ImageImageImageImage Image


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 4 posts ] 

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 12 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye