Kleiner Partikelgenerator

[benpicco]

Dieses kleine proggi erstellt Partikel, die man in z.b. der Partikelengine von XP/Tristar/Secretly benutzen kann. Der Vorteil ist, das man so ich die Partikel vor dem Spiel generieren und danach wieder löschen kann, man braucht also keine bilder extra.

Code: Alles auswählen

; PureBasic Visual Designer v3.90 build 1361

;- Window Constants
Enumeration
  #ptcl
EndEnumeration
;- Gadget Constants
Global prog.l
;
Enumeration
  #name
  #Text_0
  #text_1
  #text_2
  #Text_3
  #text_4
  #size
  #grosse
  #Progress
  #generate
  #test
  #color
  #full
  #windowed
  #verzX
  #verzY
EndEnumeration


Procedure Open_ptcl()
  If OpenWindow(#ptcl, 312, 208, 435, 338,  #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_SizeGadget | #PB_Window_TitleBar | #PB_Window_ScreenCentered , "Partikelcreator")
    If CreateGadgetList(WindowID())
      StringGadget(#name, 50, 20, 110, 20, "Testpartikel.bmp")
      TextGadget(#Text_0, 10, 20, 30, 20, "Name:")
      TextGadget(#text_1, 10, 50, 40, 40, "Größe:")
      SpinGadget(#size, 50, 50, 70, 20, 1, 600)
      TextGadget(#text_2, 10, 100, 70, 20, "Verkleinerung:")
      SpinGadget(#grosse, 90, 100, 60, 20, 0, 1000)
      ProgressBarGadget(#Progress, 80, 210, 180, 20, 0, 100,#PB_ProgressBar_Smooth )
      ButtonGadget(#generate, 200, 20, 90, 30, "Generieren", #PB_Button_Default)
      ButtonGadget(#test, 190, 90, 100, 40, "Testen")
      ButtonGadget(#color, 10, 130, 80, 20, "Farbe wählen")
      OptionGadget(#full, 180, 140, 70, 20, "Fullscreen")
      OptionGadget(#windowed, 260, 140, 70, 20, "windowed")
      TextGadget(#Text_3,10,160,80,15,"VerzerrungX:")
      TextGadget(#text_4,10,180,80,15,"VerzerrungY:")
      StringGadget(#verzX,85,160,30,15,"1.00",#PB_String_Numeric)
      StringGadget(#verzY,85,180,30,15,"1.00",#PB_String_Numeric)
    EndIf
  EndIf
EndProcedure

InitSprite()
InitSprite3D()
InitKeyboard()
Procedure.f Gcos(winkel.f,speed.f) 
  preturn.f=Cos(winkel*(speed*3.14159265/360)) 
  ProcedureReturn preturn 
EndProcedure
Procedure.f Gsin(winkel.f,speed.f) 
  preturn.f=Sin(winkel*(speed*3.14159265/360)) 
  ProcedureReturn preturn 
EndProcedure
Procedure generate_ptcl(file$,size,color.f,grosse,xspeed.f,yspeed.f)
  grosse=510+grosse
  CreateImage(1,grosse,grosse)
  UseImage(1)
  StartDrawing(ImageOutput())
  For x=255 To 1 Step -1
    red=Red(color)-x
    green=Green(color)-x
    blue=Blue(color)-x
    If red<0
      red=0
    EndIf
    If green<0
      green=0
    EndIf
    If blue<0
      blue=0
    EndIf
    For w= 0 To 360
      Plot((grosse/2)+(Gcos(w,xspeed)*x),(grosse/2)+(Gsin(w,yspeed)*x),RGB(red,green,blue))
      Plot((grosse/2)+(Gcos(w,xspeed)*x),(grosse/2)-(Gsin(w,yspeed)*x),RGB(red,green,blue))
    Next
  Next
  ResizeImage(1,size,size)
  StopDrawing()
  SaveImage(1,file$)
  FreeImage(1)
EndProcedure

;********************************************
;**********PARTIKEL-ENGINE 1.0***************
;********************************************
;********* BY XP/TRISTAR/SECRETLY ***********
;********************************************


;***typefield
Structure ptcl
  x.w               ;startpositionx
  y.w               ;startpositiony
  image.w           ;das image
  speedx.w          ;bewegungx
  speedy.w          ;bewegungy
  lifetime.w        ;lebenszeit
  rotspeed.w        ;rotationsgeschwindigkeit
  winkel.w
  scalex.w          ;scalierung x
  scaley.w          ;scalierung y
  alpha.w           ;start-alphawert
  fade.w            ;alphawert bei animation
  zoomX.w           ;scalewert bei animation
  zoomY.w           ;scalewert y bei anim
EndStructure
NewList ptcl.ptcl()

Procedure create_ptcl(x,y,lifetime,scalex,scaley,alpha,fade,zoomX,zoomY,speedx,speedy,rot,image)
AddElement(ptcl())
  ptcl()\x        = x
  ptcl()\y        = y
  ptcl()\image    = image
  ptcl()\speedx   = speedx
  ptcl()\speedy   = speedy
  ptcl()\lifetime = lifetime
  ptcl()\rotspeed = rot
  ptcl()\winkel   = 0
  ptcl()\scalex   = scalex
  ptcl()\scaley   = scaley
  ptcl()\alpha    = alpha
  ptcl()\fade     = fade
  ptcl()\zoomX    = zoomX
  ptcl()\zoomY    = zoomY
EndProcedure


Procedure update_ptcl()
Sprite3DBlendingMode(5,7)
  ResetList(ptcl())
  While NextElement(ptcl())
    killptcl=0      ;löschbit
    If ptcl()\y < -50 Or ptcl()\y > 600     ;ob noch im bild
      killptcl=1
    EndIf
    If ptcl()\x < -50 Or ptcl()\x > 800     ;andernfalls sowieso löschen
      killptcl=1    
    EndIf
    ptcl()\lifetime-1
    If  ptcl()\lifetime<0                   ;wenn lebenszeit zu ende dann löschen
      killptcl=1
    EndIf
    ptcl()\x+ptcl()\speedx      ;bewegen x
    ptcl()\y+ptcl()\speedy      ;bewegen y
    ptcl()\scalex+ptcl()\zoomX  ;zoomen x
    ptcl()\scaley+ptcl()\zoomY  ;zoomen y
    ptcl()\alpha+ptcl()\fade    ;faden
   ZoomSprite3D   ( ptcl()\image , ptcl()\scalex , ptcl()\scaley )
   DisplaySprite3D( ptcl()\image , ptcl()\x , ptcl()\y ,ptcl()\alpha )
  If killptcl=1     ;löschen
    killptcl=0
    DeleteElement(ptcl())
  EndIf
  Wend
Sprite3DBlendingMode(0,0)
EndProcedure

Procedure free_ptcl()
ResetList(ptcl())
  While NextElement(ptcl())
 DeleteElement(ptcl())
  Wend
EndProcedure
Procedure rnd(min.w,max.w)
  a.w = max - Random (max-min)
  ProcedureReturn a
EndProcedure

Open_ptcl()
color=RGB(Random(255),Random(255),Random(255))
CreateImage(2,10,10)
UseImage(2)
StartDrawing(ImageOutput())
Box(0,0,10,10,color)
StopDrawing()

SetGadgetState(#size,32)
SetGadgetState(#grosse,100)
DisableGadget(#test,1)
SetGadgetState(#full,1)
Repeat
  SetGadgetText(#size,Str(GetGadgetState(#size)))
   SetGadgetText(#grosse,Str(GetGadgetState(#grosse)))
  Event = WaitWindowEvent()
    StartDrawing(WindowOutput())
    DrawImage(UseImage(2),100,130)
    StopDrawing()
  If Event = #PB_EventGadget
    
    ;Debug "WindowID: " + Str(EventWindowID())
    
    GadgetID = EventGadgetID()
    If GadgetID = #generate
    generate_ptcl(GetGadgetText(#name),GetGadgetState(#size),color,GetGadgetState(#grosse),ValF(GetGadgetText(#verzX)),ValF(GetGadgetText(#verzY)))
    path$=GetGadgetText(#name)
    SetGadgetState(#Progress,100)
    LoadImage(1,GetGadgetText(#name))
    StartDrawing(WindowOutput())
    DrawImage(UseImage(1),300,23)
    StopDrawing()
    DisableGadget(#test,0)
    ElseIf GadgetID = #color
    savec=color
    color=ColorRequester(color) 
    If color=-1
    color=savec
    EndIf
    UseImage(2)
    StartDrawing(ImageOutput())
    Box(0,0,10,10,color)
    StopDrawing()
    ElseIf GadgetID=#windowed
    SetGadgetState(#full,0)
    ElseIf GadgetID=#full
    SetGadgetState(#windowed,0) 
    EndIf
    ElseIf GadgetID=#test
    Goto test
    
      
    
    
  EndIf

Until Event = #PB_EventCloseWindow
End  

test:
For x=0 To 15
  DisableGadget(x,1)
Next
MessageRequester("Info","Test powered by Partikelengine 1.0 BY XP/TRISTAR/SECRETLY")
If GetGadgetState(#full)=1
OpenScreen(640,480,32,"Partikeltest")
ElseIf GetGadgetState(#windowed)=1  
OpenWindowedScreen(WindowID(),0,0,640,480,1,0,0)
EndIf
LoadSprite(1,path$,#PB_Sprite_Texture)
CreateSprite3D(1,1)
Repeat
If sini<360:sini+1:Else:sini=0:EndIf
Event=WindowEvent()
ClearScreen(10,10,10)
Start3D()
  create_ptcl( 400+(Gcos(sini,5)*150) ,300+(Gsin(sini,5)*150),50,50,50,120,1,-1,-1,0,0,0,1)
  ;fire1
  create_ptcl(400,300,49,30,30,150,-2,-1,-1,rnd(-4,4),0,0,1)
  ;fire2
  create_ptcl( 550+rnd(-4,4) ,300+(Gcos(sini,5)*150),20,40,40,120,-5,-1,-1,0,0,0,1)
  update_ptcl()
  Stop3D()
DisplaySprite(1,50+(Gcos(sini,2)*50),50+(Gsin(sini,2)*50))
FlipBuffers()
ExamineKeyboard()
Until KeyboardPushed(#PB_Key_Escape) Or Event = #PB_EventCloseWindow
End

Edit: Kleine Verzerrmöglichkeiten hinzugefügt

[bluejoke]

[nicolaus]

Sehr schön jedoch habe ich hier 100% systemauslastung wenn ich den test starte

[benny]

@nicolaus:

Hmm .. füg' doch einfach in der dritt letztden Zeile nach

Code: Alles auswählen

ExamineKeyboard()

ein

Code: Alles auswählen

Delay(20)

oder so ein Dann sollte die Prozessorleistung runtergehen

[NicTheQuick]

Vielleicht solltest du auch noch alle Gadgets verstecken, bevor du den WindowedScreen aufs Fenster legst.

[THEEX]

@benny

bei einem Delay(20) hat man max. noch 50 Frames, finde ich weniger gut. In der Regel genügt Delay(1) schon.

[ts-soft]

Besser ist ein Delay(0), der paßt sich dann autom. an.

[bluejoke]

Das Problem ist halt, dass Delay(0) immer die kompletten zur Verfügung stehenden Ressourcen ausnutzt (afaik). Bei Laptops mit Energiespar-Option und so Zeugs ist das wohl nervig.

[Ynnus]

Die Testroutine anzusehen ist ja ganz nett, wenn da die Partikel durch die Gegend fliegen. Aber zu mehr ist das Programm, so leid es mir tut, das zu sagen, nicht geeignet. So einen Partikel kann man mit jedem halbwechs anständigen Grafikprogramm binnen weniger Sekunden erstellen, das verläuft dann auch noch wesentlich flexibler und man hat mehr Möglichkeiten (Effekte) und Formate. Dazu kommt, dass der Partikel ab einer Größe von ca. 100 Pixeln recht verpixelt aussieht, nicht kein schöner fließender Übergang gegebene ist. Auch fehlen Einstellungsmöglichkeiten zur Sache Transparents des Partikels, mehrfarbig als Mischung, Verzerrungen (wer will immer runde Partikel?) und alle möglichen anderen Feinheiten.
So wie es jetzt ist, ist es mehr oder minder ein Testprogramm für die Anzeigeroutine der Partikel, nur dass man vorher die Farbe und Größe wählen kann. (Was auch im Anzeige-Programm mit 3D-Sprites schnell realisierbar wäre).
Dann der Aspekt, dass die Partikel zur Laufzeit generiert werden. Ok, ganz nette Idee, aber heutzutage unnötig. So ein Partikel braucht im PNG Format nun wirklich nicht mehr viel Speicher und bei der Größe heutiger (auch nicht kommerzieller) Spiele ist das auch kein Problem mehr. Und wie gesagt, die Einstellungsmöglichkeiten fehlen. Bis jetzt kommt ja immer nur der gleiche Partikel mit anderen Farben und Größen raus, was etwas wenig ist, wenn man ein komplexes Programm hat. Dann muss man also doch wieder auf Bitmap-Partikel zurückgreifen, die man sich vorher erstellt hat.

Also als Startprojekt kann man es so stehen lassen, funktioniert ja wie es soll. Aber viel mehr machen kann man damit noch nicht. Wenn's etwas ausgereifter ist, ändere ich da vielleicht noch meine Meinung.

[Green Snake]

hallo

2 sachen.

1. ICh finde das programm gut, da kann ich noch lernen
2. leider muss ich mich sunny anschliessen, dafür verwände ich auch immer ein gfx programm