PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

Effektcodes und sonstiger Unnütz

https://www.purebasic.fr/german/viewtopic.php?t=18310

Seite 1 von 2

Effektcodes und sonstiger Unnütz

Verfasst: 20.11.2008 19:51
von dllfreak2001
Zeigt mal lustige kleine Codes die grafische Effekte,
Physikkramm oder sonst irgendwas lustiges machen.

Verfasst: 20.11.2008 20:05
von STARGÅTE
Hier ein kleiner Code von mir:

Er simuliert die Bewegung eines Doppelpendels, deren Bewegungsgleichung ich vorher in "Theoretische Physik = Mechanik" hergeleitet habe.

Stichwort: Differentialgleichungen, Lagrangefunktion

Im Programm einfach mal ein bisschen mit den Startbedingungen spielen

Code: Alles auswählen

InitSprite()

xP = 400
yP = 400
xP2 = xP/2
yP2 = yP/2

OpenWindow(0, 0, 0, xP+200, yP, "SCREEN", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
OpenWindowedScreen(WindowID(0), 200, 0, xP, yP, 0, 0, 0)

CreateSprite(1, xP, yP)

Phi1.f = 1
Phi1_.f = 0
Phi1__.f = 0
Phi2.f = -2
Phi2_.f = 0
Phi2__.f = 0

l1.f = 100
l2.f = 100
m1.f = 10
m2.f = 10

g.f = 9.81/70

 TextGadget(110, 10,  10, 80, 20, "Masse 1") : StringGadget(111, 100,  10, 80, 20, StrF(m1))
 TextGadget(120, 10,  40, 80, 20, "Länge 1") : StringGadget(121, 100,  40, 80, 20, StrF(l1))
 TextGadget(130, 10,  70, 80, 20, "Phi 1")   : StringGadget(131, 100,  70, 80, 20, StrF(Phi1))

 TextGadget(210, 10, 110, 80, 20, "Masse 2") : StringGadget(211, 100, 110, 80, 20, StrF(m2))
 TextGadget(220, 10, 140, 80, 20, "Länge 2") : StringGadget(221, 100, 140, 80, 20, StrF(l2))
 TextGadget(230, 10, 170, 80, 20, "Phi 2")   : StringGadget(231, 100, 170, 80, 20, StrF(Phi2))

 ButtonGadget(0, 10, 300, 180, 20, "Simulation starten")

Repeat

 Delay(5)

 Repeat
  Event = WindowEvent()
  Select Event
   Case #PB_Event_CloseWindow
    End
   Case #PB_Event_Gadget
    Select EventGadget()
     Case 0
      UseBuffer(1)
       ClearScreen(0)
      UseBuffer(-1)
      Phi1_.f = 0
      Phi1__.f = 0
      Phi2_.f = 0
      Phi2__.f = 0    
      Phi1 = ValF(GetGadgetText(131))
      Phi2 = ValF(GetGadgetText(231))
      x1_ = 0
     Case 111
      m1 = ValF(GetGadgetText(111))
     Case 121
      l1 = ValF(GetGadgetText(121))
     Case 131
      Phi1 = ValF(GetGadgetText(131))
     Case 211
      m2 = ValF(GetGadgetText(211))
     Case 221
      l2 = ValF(GetGadgetText(221))
     Case 231
      Phi2 = ValF(GetGadgetText(231))
    EndSelect
   Case #PB_Event_Menu
    Select EventMenu()
     Case 0
    EndSelect
  EndSelect
 Until Not Event
 ClearScreen(0)

 For n = 1 To 10
  Phi1__ = -g/l1*Sin(Phi1) -m2/(m1+m2)*(l2/l1)*(Cos(Phi2-Phi1)*Phi2__+Sin(Phi1-Phi2)*Phi2_*Phi2_)
  Phi2__ = -g/l2*Sin(Phi2) -(l1/l2)*(Cos(Phi2-Phi1)*Phi1__-Sin(Phi1-Phi2)*Phi1_*Phi1_)
 Next
 
 Phi1_ + Phi1__
 Phi1 + Phi1_
 Phi2_ + Phi2__
 Phi2 + Phi2_
 x1 = xP2 + Sin(Phi1)*l1
 y1 = yP2 + Cos(Phi1)*l1
 x2 = x1 + Sin(Phi2)*l2
 y2 = y1 + Cos(Phi2)*l2
 
 If x1_
  StartDrawing(SpriteOutput(1))
   LineXY(x1, y1, x1_, y1_, $5050A0)
   LineXY(x2, y2, x2_, y2_, $50A000)
  StopDrawing()
 EndIf
 
 x1_ = x1
 y1_ = y1
 x2_ = x2
 y2_ = y2
 

 DisplaySprite(1,0,0)
 
 StartDrawing(ScreenOutput())
  DrawingMode(1)
  LineXY(xP2, yP2, x1, y1, $808080)
  Circle(x1, y1, 5, $A0A0F0)
  LineXY(x1, y1, x2, y2, $808080)
  Circle(x2, y2, 5, $A0F0A0)
  DrawText(0, 50, StrF(E), $FFFFFF) 
 StopDrawing()


 FlipBuffers()

ForEver

Verfasst: 20.11.2008 20:21
von dllfreak2001
Genial :allright:

Jetzt auch was von mir...

Mit Maustaste sprüht man Partikel, der Gelbe Punkt ist der Mauscursor.

Code: Alles auswählen

InitSprite()
InitSprite3D()
InitKeyboard()
InitMouse()
ExamineDesktops()
#fieldw = 99
#fieldh = 74
#fscale = 8
#pcount = 8000
OpenScreen(800,600,32,"Feld")
CreateSprite(0,20,20,#PB_Sprite_Texture)
StartDrawing(SpriteOutput(0))
  For n = 1 To 9
    Circle(9,9,9-n,RGB(7*n,3*n,0))
  Next
StopDrawing()
CreateSprite3D(0,0)
Structure Feld
  x.f
  y.f
EndStructure
Dim field.Feld(#fieldw,#fieldh)
dfield.b = 0
Structure Partikel
  x.f
  y.f
  mx.f
  my.f
EndStructure
Dim part.Partikel(#pcount)
For n = 0 To #pcount
  part(n)\x = Random((#fieldw+1)*#fscale-1)
  part(n)\y = Random((#fieldh+1)*#fscale-1)
  part(n)\mx = (Random(200)-100)/100
  part(n)\my = (Random(200)-100)/100
Next
Repeat
  ExamineKeyboard()
  ExamineMouse()
  mx.l = MouseX()
  my.l = MouseY()
  If KeyboardReleased(#PB_Key_Q): If dfield = 0: dfield = 1 :Else: dfield = 0 :EndIf:EndIf
  StartDrawing(ScreenOutput())
    Circle(mx,my,2,RGB(255,255,0))
    If MouseButton(1)
      For k = 0 To 11
        gn + 1
        If gn > #pcount: gn = 0: EndIf
        part(gn)\x = mx
        part(gn)\y = my
        part(gn)\mx = (Random(8000)-4000)/100
        part(gn)\my = (Random(8000)-4000)/100
      Next
    EndIf
    If dfield = 1
      For x = 0 To #fieldw:For y = 0 To #fieldh
      Line(x*#fscale,y*#fscale,field(x,y)\x*10,field(x,y)\y*10,RGB(55,55,55))
      Next:Next
    EndIf
  StopDrawing()
  Start3D()
  Sprite3DBlendingMode(5,7)
  For n = 0 To #pcount
    ox.l = Round(part(n)\x/#fscale,0)
    oy.l = Round(part(n)\y/#fscale,0)
    If ox < 0 Or ox> #fieldw: CloseScreen(): MessageRequester("dsda","ox = " + Str(ox) + " x = " + StrF(part(n)\x)+ " y = " + StrF(part(n)\y)):EndIf
    If oy < 0 Or oy> #fieldh: CloseScreen(): MessageRequester("dsda","oy = " + Str(oy)+ " x = " + StrF(part(n)\x)+ " y = " + StrF(part(n)\y)):EndIf
    tx.f = field(ox,oy)\x
    ty.f = field(ox,oy)\y
    ;field(ox,oy)\x = tx + part(n)\mx/2
    ;field(ox,oy)\y = ty + part(n)\my/2
    field(ox,oy)\x = (tx + part(n)\mx)/5
    field(ox,oy)\y = (ty + part(n)\my)/5
    part(n)\mx = 4*field(ox,oy)\x
    part(n)\my = 4*field(ox,oy)\y
    ; part(n)\my + 0.002
    part(n)\x + part(n)\mx
    part(n)\y + part(n)\my
    If part(n)\x < 0
      part(n)\x = (#fieldw+1)*#fscale-1
      ;part(n)\mx = -part(n)\mx/1.5
    ElseIf part(n)\x > (#fieldw+1)*#fscale-1
      part(n)\x = 0
      ;part(n)\mx = -part(n)\mx/1.5
    EndIf
    If part(n)\y < 0
      part(n)\y =  (#fieldh+1)*#fscale-1
      ;part(n)\my = -part(n)\my/1.5
    ElseIf part(n)\y > (#fieldh+1)*#fscale-1
      part(n)\y = 0
      ;part(n)\my = -part(n)\my/1.5
    EndIf
    DisplaySprite3D(0,part(n)\x-9,part(n)\y-9,100)
  Next
  Stop3D()
  FlipBuffers()
  ClearScreen(0)
Until KeyboardPushed(#PB_Key_Escape)
CloseScreen()
End

Verfasst: 20.11.2008 20:22
von Andesdaf
@STARGATE: witzig, vor allem, wenn man etwas übertreibt und das Pendel
schleudern lässt :allright: :D
@dllfreak2001: Cool, sieht aus wie die Bewegung der Erde in der zeitlupe.
Kontinente entstehen und zerfallen wieder. Genial :allright:

Verfasst: 20.11.2008 20:24
von bobobo
ömmm

http://www.purebasic.fr/german/viewtopi ... 569#219569

Verfasst: 20.11.2008 20:31
von STARGÅTE
@dllfreak2001

wenn es nicht so laggen würde, wäre das durchaus was für ein Spiel als Effekt

Verfasst: 20.11.2008 20:32
von dllfreak2001
@bobobo
Genau so was meinte ich, perfekt.

@STARGATE

öhm, bei mir lagt nichts... Was meinste denn damit, denn außerhalb von Multiplayerspielen kenne ich keine Lags.
Ist ja auch kein Hyperspeedcode...

Verfasst: 20.11.2008 21:03
von X0r
@STARGATE:
Absolut geil!

Verfasst: 20.11.2008 21:25
von dllfreak2001
Noch mehr Unfug:
Muss aber nicht auf allen Grafikkarten laufen...

Code: Alles auswählen


InitSprite()
InitSprite3D()
InitKeyboard()
InitMouse()

OpenScreen(1024,768,32,"Nazrah-Lichtcheck")

CreateSprite(0,32,32,0)

CreateSprite(1,32,32,0)

StartDrawing(SpriteOutput(0))
  Box(0,0,32,32,RGB(255,200,100))
  Box(4,4,23,23,RGB(200,150,50))
StopDrawing()

StartDrawing(SpriteOutput(1))
  Box(0,0,32,32,RGB(10,50,0))
  For n = 0 To 1280
    Line(Random(32),Random(38),0,Random(2),RGB(Random(50),70+Random(150),Random(50)))
  Next
StopDrawing()

#Maph = 21
#Mapw = 29

Dim Map.l(#Mapw,#Maph)

For x = 0 To #Mapw : For y = 0 To #Maph
  Map(x,y) = Random(1)
Next:Next

CreateSprite(2,32,32,#PB_Sprite_Texture)
StartDrawing(SpriteOutput(2))
  Box(0,0,32,32,RGB(1,1,1))
StopDrawing()
CreateSprite3D(2,2)

CreateSprite(3,64,64,#PB_Sprite_Texture)
StartDrawing(SpriteOutput(3))
  For r = 31 To 1 Step -1
    Circle(31,31,r,RGB(1*(187-r*6),1*(187-r*6),1*(187-r*6)))
  Next
  
StopDrawing()
CreateSprite3D(3,3)

CreateSprite(4,256,256,#PB_Sprite_Texture)
StartDrawing(SpriteOutput(4))
  Box(0,0,128,128,RGB(255,255,255))
  
StopDrawing()
CreateSprite3D(4,4)

modea = 9
modeb = 9
modea2 = 5
modeb2 = 7
modea3 = 11
modeb3 = 5
inv = 1
fadenight.f = 1

Sprite3DQuality(1)

#Offsetx = 32
#Offsety = 32

StartDrawing(SpriteOutput(2))
  Box(0,0,32,32,RGB(fadenight,fadenight,fadenight))
StopDrawing()
Repeat
  ExamineKeyboard()
  ExamineMouse()
  
  mx.l = MouseX()
  my.l = MouseY()
  
  fadenight + MouseWheel()*4
  If fadenight > 255
    fadenight = 255
  ElseIf fadenight < 1
    fadenight = 1
  EndIf
  If MouseWheel() <> 0 
    StartDrawing(SpriteOutput(2))
      Box(0,0,32,32,RGB(fadenight,fadenight,fadenight))
    StopDrawing()
  EndIf
  
  
  If KeyboardReleased(#PB_Key_1)
    modea + 1
    If modea > 13
      modea = 0
    EndIf
    
  EndIf
  
  If KeyboardReleased(#PB_Key_2)
    modeb + 1
    If modeb > 13
      modeb = 0
    EndIf
  EndIf
  
  If KeyboardReleased(#PB_Key_4)
    modea2 + 1
    If modea2 > 13
      modea2 = 0
    EndIf
    
  EndIf
  
  If KeyboardReleased(#PB_Key_5)
    modeb2 + 1
    If modeb2 > 13
      modeb2 = 0
    EndIf
  EndIf
    
    
  If KeyboardReleased(#PB_Key_7)
    modea3 + 1
    If modea3 > 13
      modea3 = 0
    EndIf
    
  EndIf
  
  If KeyboardReleased(#PB_Key_8)
    modeb3 + 1
    If modeb3 > 13
      modeb3 = 0
    EndIf
  EndIf   
    
  If KeyboardReleased(#PB_Key_Space)
    If inv = 0
      inv = 1
    Else
      inv = 0
    EndIf
    
  
  EndIf
  
  For x = 0 To #Mapw : For y = 0 To #Maph
    DisplaySprite(Map(x,y),#Offsetx + x*32,#Offsety + y*32)
  Next:Next
  
  rad.f = Sqr(Pow(384-my,2)+Pow(512-mx,2))
  ang.f = ATan((384-my)/(512-mx))
  If mx > 512
    ang -#PI
  EndIf
 
  Start3D()

    Sprite3DBlendingMode(modea3, modeb3)
    DisplaySprite3D(4,0,0,150)    
    
    Sprite3DBlendingMode(modea2,modeb2)
    ZoomSprite3D(3,512,512)
    DisplaySprite3D(3,mx-256,my-256,(inv*255+fadenight*(1-2*inv))/2)
    
    
    Sprite3DBlendingMode(modea, modeb)
    ZoomSprite3D(2,1024,768)
    DisplaySprite3D(2,0,0,100)    

  Stop3D()
   
  StartDrawing(ScreenOutput())
    DrawText(0,0,"a: " +Str(modea)+" b: " + Str(modeb) + " a2: " +Str(modea2)+" b2: " + Str(modeb2)+ " a3: " +Str(modea3)+" b3: " + Str(modeb3)  + " fade: " + Str(fadenight) + " inv: " +Str(inv) )
    Line(512,384,Cos(ang)*132,Sin(ang)*132,RGB(255,255,255))
    Line(512,384,Cos(ang+#PI/2)*132,Sin(ang+#PI/2)*132,RGB(255,255,255))
  StopDrawing()
  
  FlipBuffers()
  ClearScreen(0)
  Delay(1)
Until KeyboardPushed(#PB_Key_Escape)
CloseScreen()
End
Mach aus deinem Desktop ein Picasso:

Code: Alles auswählen

Global Mem.l 
; hier werden 1024 byte speicher reserviert 
Mem = AllocateMemory(1024) 

Procedure.l DesktopOutput() 
  PokeL(Mem, 1) 
  ProcedureReturn Mem 
EndProcedure 

Maus.Point 
Global mvx.f,mvy.f,mx.f,my.f  
mvx = 12-Random(8)
mvy = 12 - Random(8)
mx = Random(1280)
my = Random(800)
Repeat 

  
  If mx > 1280
    mx = 1280
    mvx = -15-Random(800)/100
  EndIf
  If mx < 0
    mx = 0
    mvx = 15+Random(800)/100 
  EndIf
  If my > 800
    my = 800
    mvy = -15-Random(800)/100
  EndIf
  
  If my < 0
    my = 0
    mvy = 15+Random(800)/100 
  EndIf

  mx + mvx
  my+mvy
  
  ; hier werden die maus koordinaten ausgelesen 
  GetCursorPos_(Maus) 
  ; 
  ; hier beginnt die verwirrung 
  StartDrawing(DesktopOutput()) 
  
;   mx = Maus\x
;   my = Maus\y
  
  
 For m = 0 To 1280
    rot = Random(1440)
    rad = Random(128)
    
    fall = my+ Sin(2*x*((rot/4)/360))*rad

    x = mx + Cos(2*x*((rot/4)/360))*rad

      fx = x 
      c1.l = Point(fx,fall)
      c2.l = Point(fx+1,fall)
      c3.l = Point(fx-1,fall)
      c4.l = Point(fx,fall+1)
      c5.l = Point(fx,fall-1)
      c6.l = Point(fx-1,fall+1)
      c7.l = Point(fx+1,fall+1)
      c8.l = Point(fx+1,fall-1)
      c9.l = Point(fx-1,fall-1) 
      
      rd = (Red(c1)+Red(c2)+Red(c3)+Red(c4)+Red(c5)+Red(c6)+Red(c7)+Red(c8)+Red(c9))/9
      gr = (Green(c1)+Green(c2)+Green(c3)+Green(c4)+Green(c5)+Green(c6)+Green(c7)+Green(c8)+Green(c9))/9
      bl = (Blue(c1)+Blue(c2)+Blue(c3)+Blue(c4)+Blue(c5)+Blue(c6)+Blue(c7)+Blue(c8)+Blue(c9))/9 
 
      rg.l = RGB(rd,gr,bl)

      If RGB(0,0,0) <> rg
        
        LineXY(mx,my,fx,fall,rg)
        ;Box(x,fall,8,8,rg)
        ;Box(x,fall,64,64,0)
      EndIf
      Next

   ; Line(0,Random(1024),1280,0,RGB(0,0,0))
    ;Circle(Random(1280),Random(1024),Random(132),RGB(0,0,0))
    
    ;     Line(Maus\x-16, Maus\y-16,32,32, RGB(0,0,0)) 
    ;     Line(Maus\x+16, Maus\y-16,-32,32, RGB(0,0,0)) 
  StopDrawing() 
  ; 
  ; delay für cpu entlastung 
  Delay(1) 

  run + 1

Until run > 500

End

Verfasst: 20.11.2008 23:30
von KeyKon
Ein einfacher Partikeleffekt:
http://www.purebasic.fr/german/viewtopi ... 4&start=11
Alle Zeiten sind UTC+02:00
Seite 1 von 2

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de