Blöder Ball

Spiele, Demos, Grafikzeug und anderes unterhaltendes.
Antworten
Wolf Benrath
Beiträge: 57
Registriert: 04.10.2004 10:20

Beitrag von Wolf Benrath »

Hallo !

Und was passiert, wenn ich keine Wheel-Maus habe ?

MfG
Wolf Benrath
Bild
Nach oben
Benutzeravatar
dllfreak2001
Beiträge: 2925
Registriert: 07.09.2004 23:44
Wohnort: Bayern

Beitrag von dllfreak2001 »

:mrgreen: Bisschen spät, aber dann passiert nichts...

Mir war langweilig und da hab ich mal eine Art Seil/Gumiband programmiert... Ist zwar nicht schön aber sieht ganz lustig aus.

Oben im Kopf kann man die Parameter verstellen, mit der Linkemaustaste kann man den Ball anziehen.

Code: Alles auswählen

InitSprite()
InitKeyboard()
InitMouse()

#kcount = 6 ; Anzahl der Knotenpunkte des Seils/Gummibandes
brems.f = 2.5 ; je niedriger desto strammer
dampf.f = 1.5 ; je mehr desto stärker wird gedämpgt
kgrav.f = 0.1 ; gravitationswirkung auf das Seil
Procedure.f Angle(p1x.f, p1y.f,p2x.f,p2y.f)
  tsx.f = p1x - p2x
  tsy.f = p1y - p2y
  
  If tsx = 0 And tsy = 0
    ProcedureReturn 0
  Else
    
    ang.f = ATan(tsy/tsx)
    
    If p1x < p2x
      ang + #PI
    EndIf 
    ProcedureReturn ang
  EndIf
EndProcedure


Procedure.f Radius(p1x.f,p1y.f,p2x.f,p2y.f)
  ProcedureReturn Sqr(Pow(p1x-p2x,2)+Pow(p1y-p2y,2))
EndProcedure



OpenWindow(0,0,0,185,30,"RTS-Auflösung",#PB_Window_ScreenCentered| #PB_Window_SystemMenu)
  CreateGadgetList(WindowID(0))
    ComboBoxGadget(0,5,5,120,200)
      AddGadgetItem(0,-1,"800x600")
      AddGadgetItem(0,-1,"1024x768")
      AddGadgetItem(0,-1,"1280x768")
      AddGadgetItem(0,-1,"1280x800")
      AddGadgetItem(0,-1,"1280x1024")
      SetGadgetState(0,2)
    ButtonGadget(1,130,5,50,20,"OK")
    
    
    Dim kx.f(#kcount)
    Dim ky.f(#kcount)
    Dim kxm.f(#kcount)
    Dim kym.f(#kcount)    
    
Repeat
  wevent.l = WaitWindowEvent()
  
  Select wevent
  
    Case #PB_Event_CloseWindow
      End
      
    Case #PB_Event_Gadget
    
      If EventGadget() = 1
        res.b = GetGadgetState(0)      
        CloseWindow(0)
        Break
      EndIf
      
  EndSelect

ForEver

Global screenw.l, screenh.l

Select res
  Case 0
    screenw = 800
    screenh = 600
    
  Case 1
    screenw = 1024
    screenh = 768
    
  Case 2
    screenw = 1280
    screenh = 768
  Case 3
    screenw = 1280
    screenh = 800
    
  Case 4
    screenw = 1280
    screenh = 1024
EndSelect


OpenScreen(screenw, screenh,32,"RTS-Test")
Global mx.f, my.f, mspeed.f
mx = screenw/2
my = screenh/2
mspeed = 1

Global bx.f, by.f, bxm.f , bym.f, brad.f,ratio.f

brad = 22
bx = screenw/2
by = screenh/2
bxm = 0
ratio = 0.001
Repeat
  ExamineKeyboard()
  ExamineMouse()
  mx = MouseX()
  my = MouseY()
  

  krad1.f = Radius(mx,my,kx(0),ky(0))
  krad2.f = Radius(kx(1),ky(1),kx(0),ky(0))
  
  
  kangle1.f = Angle(mx,my,kx(0),ky(0))
  kangle2.f = Angle(kx(1),ky(1),kx(0),ky(0))
  
  
  kxm(0) = (kxm(0) + Cos(kangle1)*krad1/brems+ Cos(kangle2)*krad2/brems)/dampf
  kym(0) = (kym(0) + Sin(kangle1)*krad1/brems+ Sin(kangle2)*krad2/brems)/dampf + kgrav
  
  
  kx(0) = kx(0) + kxm(0)
  ky(0) = ky(0) + kym(0)

  For n = 1 To #kcount-1
  
  
  krad1 = Radius(kx(n-1),ky(n-1),kx(n),ky(n))
  krad2 = Radius(kx(n+1),ky(n+1),kx(n),ky(n))
  
  
  kangle1 = Angle(kx(n-1),ky(n-1),kx(n),ky(n))
  kangle2 = Angle(kx(n+1),ky(n+1),kx(n),ky(n))
  
  
  kxm(n) = (kxm(n) + Cos(kangle1)*krad1/brems+ Cos(kangle2)*krad2/brems)/dampf
  kym(n) = (kym(n) + Sin(kangle1)*krad1/brems+ Sin(kangle2)*krad2/brems)/dampf + kgrav
  
  
  kx(n) = kx(n) + kxm(n)
  ky(n) = ky(n) + kym(n)
  
  
  Next
  
  
  krad1 = Radius(kx(#kcount-1),ky(#kcount-1),kx(#kcount),ky(#kcount))
  krad2 = Radius(bx,by,kx(#kcount),ky(#kcount))
  
  
  kangle1 = Angle(kx(#kcount-1),ky(#kcount-1),kx(#kcount),ky(#kcount))
  kangle2 = Angle(bx,by,kx(#kcount),ky(#kcount))
  
  
  kxm(#kcount) = (kxm(#kcount) + Cos(kangle1)*krad1/brems+ Cos(kangle2)*krad2/brems)/dampf
  kym(#kcount) = (kym(#kcount) + Sin(kangle1)*krad1/brems+ Sin(kangle2)*krad2/brems)/dampf +kgrav
  
  
  kx(#kcount) = kx(#kcount) + kxm(#kcount)
  ky(#kcount) = ky(#kcount) + kym(#kcount)

  
  If MouseButton(1)


    rad.f = Radius(mx,my,bx,by)
    
    angle.f = Angle(mx,my,bx,by)

      If rad > 128
    
    bxm = bxm + Cos(angle)*(rad*ratio)
    bym = bym + Sin(angle)*(rad*ratio)
    EndIf
    kdisp.b = 1
  
  Else
    kdisp = 0
  
  EndIf

  bym = bym + 0.1
  
  
  bxm = bxm/1.00001
  bx = bx + bxm
  by = by + bym
  If by > screenh-brad
    by = screenh-brad 
    bym = -bym/2
  EndIf
  

    StartDrawing(ScreenOutput())
      DrawText(0,0,Str(screenw)+" x "+Str(screenh))
      
      DrawText(0,32,StrF(krad))
      
      
      
      
     ; Line(bx,by,Cos(angle)*222,Sin(angle)*222,RGB(255,0,0))
      
      
      FrontColor(RGB(255,255,255))
      Line(mx-16,my,33,0)
      Line(mx,my-16,0,33)
      
        LineXY(mx,my,kx(0),ky(0))
      For n = 0 To #kcount-1
        ;Circle(kx(n),ky(n),2,RGB(255,255,255))
        LineXY(kx(n),ky(n),kx(n+1),ky(n+1))
      Next
        LineXY(kx(#kcount),ky(#kcount),bx,by)
      
      
      
      DrawingMode(#PB_2DDrawing_Outlined)
        Circle(bx,by,brad,RGB(255,255,0))
      
    StopDrawing()
  
  FlipBuffers()
  ClearScreen(0)
Until KeyboardPushed(#PB_Key_Escape)
Primär werde ich irgendwann auch daraus ein richtiges Spiel basteln.
I´a dllfreak2001
Nach oben
Benutzeravatar
RSBasic
Admin
Beiträge: 8047
Registriert: 05.10.2006 18:55
Wohnort: Gernsbach
Kontaktdaten:
Kontaktdaten von RSBasic

Beitrag von RSBasic »

Ich finds super, aber nachdem ich ein bisschen herumgespielt habe (mit der Maustaste), funktioniert das nicht mehr:
Bild
Und wenn ich wieder die Maustaste drücke, dann ist das zu schnell und hab wieder das Problem.
A.k.: Die Geschwindigkeit wird immer schneller.
Aus privaten Gründen habe ich leider nicht mehr so viel Zeit wie früher. Bitte habt Verständnis dafür.
Bild
Bild
Nach oben
Benutzeravatar
dllfreak2001
Beiträge: 2925
Registriert: 07.09.2004 23:44
Wohnort: Bayern

Beitrag von dllfreak2001 »

THX, ^^
Ja ist ja auch keine Begrenzung drin, du kannst den Ball mit einem asligen Tempo schleudern.
Ist ja auch nur ein Snippet es geht nur um das dümmliche Seil, weil
das zu dem Spiel gut passt und auch halbwegs wei eines aussehen soll.

Code: Alles auswählen

InitSprite() 
InitKeyboard() 
InitMouse() 

#kcount = 8 ; Anzahl der Knotenpunkte des Seils/Gummibandes 
brems.f = 2.2 ; je niedriger desto strammer 
dampf.f = 1.5 ; je mehr desto stärker wird gedämpft 
kgrav.f = 0.1 ; gravitationswirkung auf das Seil 
Procedure.f Angle(p1x.f, p1y.f,p2x.f,p2y.f) 
  tsx.f = p1x - p2x 
  tsy.f = p1y - p2y 
  
  If tsx = 0 And tsy = 0 
    ProcedureReturn 0 
  Else 
    
    ang.f = ATan(tsy/tsx) 
    
    If p1x < p2x 
      ang + #PI 
    EndIf 
    ProcedureReturn ang 
  EndIf 
EndProcedure 


Procedure.f Radius(p1x.f,p1y.f,p2x.f,p2y.f) 
  ProcedureReturn Sqr(Pow(p1x-p2x,2)+Pow(p1y-p2y,2)) 
EndProcedure 



OpenWindow(0,0,0,185,30,"RTS-Auflösung",#PB_Window_ScreenCentered| #PB_Window_SystemMenu) 
  CreateGadgetList(WindowID(0)) 
    ComboBoxGadget(0,5,5,120,200) 
      AddGadgetItem(0,-1,"800x600") 
      AddGadgetItem(0,-1,"1024x768") 
      AddGadgetItem(0,-1,"1280x768") 
      AddGadgetItem(0,-1,"1280x800") 
      AddGadgetItem(0,-1,"1280x1024") 
      SetGadgetState(0,4) 
    ButtonGadget(1,130,5,50,20,"OK") 
    
    
    Dim kx.f(#kcount) 
    Dim ky.f(#kcount) 
    Dim kxm.f(#kcount) 
    Dim kym.f(#kcount)    
    
Repeat 
  wevent.l = WaitWindowEvent() 
  
  Select wevent 
  
    Case #PB_Event_CloseWindow 
      End 
      
    Case #PB_Event_Gadget 
    
      If EventGadget() = 1 
        res.b = GetGadgetState(0)      
        CloseWindow(0) 
        Break 
      EndIf 
      
  EndSelect 

ForEver 

Global screenw.l, screenh.l 

Select res 
  Case 0 
    screenw = 800 
    screenh = 600 
    
  Case 1 
    screenw = 1024 
    screenh = 768 
    
  Case 2 
    screenw = 1280 
    screenh = 768 
  Case 3 
    screenw = 1280 
    screenh = 800 
    
  Case 4 
    screenw = 1280 
    screenh = 1024 
EndSelect 


OpenScreen(screenw, screenh,32,"RTS-Test") 
Global mx.f, my.f, mspeed.f 
mx = screenw/2 
my = screenh/2 
mspeed = 1 

Global bx.f, by.f, bxm.f , bym.f, brad.f,ratio.f 

brad = 22 
bx = screenw/2 
by = screenh/2 
bxm = 0 
ratio = 0.001 
Repeat 
  ExamineKeyboard() 
  ExamineMouse() 
  mx = MouseX() 
  my = MouseY() 
  

  krad1.f = Radius(mx,my,kx(0),ky(0)) 
  krad2.f = Radius(kx(1),ky(1),kx(0),ky(0)) 
  
  
  kangle1.f = Angle(mx,my,kx(0),ky(0)) 
  kangle2.f = Angle(kx(1),ky(1),kx(0),ky(0)) 
  
  
  kxm(0) = (kxm(0) + Cos(kangle1)*krad1/brems+ Cos(kangle2)*krad2/brems)/dampf 
  kym(0) = (kym(0) + Sin(kangle1)*krad1/brems+ Sin(kangle2)*krad2/brems)/dampf + kgrav 
  
  
  kx(0) = kx(0) + kxm(0) 
  ky(0) = ky(0) + kym(0) 

  For n = 1 To #kcount-1 
  
  
  krad1 = Radius(kx(n-1),ky(n-1),kx(n),ky(n)) 
  krad2 = Radius(kx(n+1),ky(n+1),kx(n),ky(n)) 
  
  
  kangle1 = Angle(kx(n-1),ky(n-1),kx(n),ky(n)) 
  kangle2 = Angle(kx(n+1),ky(n+1),kx(n),ky(n)) 
  
  
  kxm(n) = (kxm(n) + Cos(kangle1)*krad1/brems+ Cos(kangle2)*krad2/brems)/dampf 
  kym(n) = (kym(n) + Sin(kangle1)*krad1/brems+ Sin(kangle2)*krad2/brems)/dampf + kgrav 
  
  
  kx(n) = kx(n) + kxm(n) 
  ky(n) = ky(n) + kym(n) 
  
  
  Next 
  
  
  krad1 = Radius(kx(#kcount-1),ky(#kcount-1),kx(#kcount),ky(#kcount)) 
  krad2 = Radius(bx,by,kx(#kcount),ky(#kcount)) 
  
  
  kangle1 = Angle(kx(#kcount-1),ky(#kcount-1),kx(#kcount),ky(#kcount)) 
  kangle2 = Angle(bx,by,kx(#kcount),ky(#kcount)) 
  
  
  kxm(#kcount) = (kxm(#kcount) + Cos(kangle1)*krad1/brems+ Cos(kangle2)*krad2/brems)/dampf 
  kym(#kcount) = (kym(#kcount) + Sin(kangle1)*krad1/brems+ Sin(kangle2)*krad2/brems)/dampf +kgrav 
  
  
  kx(#kcount) = kx(#kcount) + kxm(#kcount) 
  ky(#kcount) = ky(#kcount) + kym(#kcount) 

  
  If MouseButton(1) 


    rad.f = Radius(mx,my,bx,by) 
    
    angle.f = Angle(mx,my,bx,by) 

      If rad > 128 
    
    bxm = bxm + Cos(angle)*(rad*ratio) 
    bym = bym + Sin(angle)*(rad*ratio) 
    EndIf 
    kdisp.b = 1 
  
  Else 
    kdisp = 0 
  
  EndIf 

  bym = bym + 0.1 
  
  
  bxm = bxm/1.00001 
  bx = bx + bxm 
  by = by + bym 
  If by > screenh-brad 
    by = screenh-brad 
    bym = -bym/2 
  EndIf 
  
  If bx > screenw-brad
    bx = screenw -brad
    bxm = -bxm/2
  EndIf   
  
  If bx < brad
    bx = brad
    bxm = -bxm/2
  EndIf 
  
  
  
  
  
    StartDrawing(ScreenOutput()) 
      DrawText(0,0,Str(screenw)+" x "+Str(screenh)) 
      
      DrawText(0,32,StrF(by)) 
      
      
      
      
     ; Line(bx,by,Cos(angle)*222,Sin(angle)*222,RGB(255,0,0)) 
      
      
      FrontColor(RGB(255,255,255)) 
      Line(mx-16,my,33,0) 
      Line(mx,my-16,0,33) 
      
      If kdisp
        LineXY(mx,my,kx(0),ky(0)) 
      For n = 0 To #kcount-1 
        Circle(kx(n),ky(n),3,RGB(255,255,255)) 
        LineXY(kx(n),ky(n),kx(n+1),ky(n+1)) 
        
      Next 
        Circle(kx(#kcount),ky(#kcount),3,RGB(255,255,255))
        LineXY(kx(#kcount),ky(#kcount),bx,by) 
      EndIf
      
      
      
      DrawingMode(#PB_2DDrawing_Outlined) 
        Circle(bx,by,brad,RGB(255,255,0)) 
      
    StopDrawing() 
  
  FlipBuffers() 
  ClearScreen(0) 
Until KeyboardPushed(#PB_Key_Escape)
Jetzt mit Begrenzung
I´a dllfreak2001
Nach oben
teks
Beiträge: 7
Registriert: 02.07.2008 19:58

Beitrag von teks »

physik kann soo spaß machen ^^
vor allem wenn man ein virtuelles mobile perpetuum erschafft

gefällt mir

mfg Martin
Nach oben
Benutzeravatar
Deeem2031
Beiträge: 1232
Registriert: 29.08.2004 00:16
Wohnort: Vorm Computer
Kontaktdaten:
Kontaktdaten von Deeem2031

Beitrag von Deeem2031 »

Hm, sehr nett - aber da durch das keine Reibung berechnet wird kommt man immer höher und ab -2^31 schlägt die umwandlung Float->Long fehl und der Kreis wird immer am oberen Rand dargestellt (also y=0). Irgendwann unter -10 Billiarden gabs dann aber anscheinend noch einen Bufferoverflow und der Ball war plötzlich bei der Höhe 10024, also unter dem Screen und bewegte sich nicht mehr...
Bild
[url=irc://irc.freenode.org/##purebasic.de]irc://irc.freenode.org/##purebasic.de[/url]
Nach oben
Benutzeravatar
dllfreak2001
Beiträge: 2925
Registriert: 07.09.2004 23:44
Wohnort: Bayern

Beitrag von dllfreak2001 »

Wie gesagt der Code soll nur das Seil demonstrieren...
In der vertikalen gibt es tatächlich keine Reibung, später wird man den Ball sowieso nicht so hoch schleudern können. Das wird dann eine abgeschlossene Karte wo man den Ball geschickt durch ein Labyrinth ins Ziel befördern muss. Dazu wird man dann erst den Ball an den Hacken nehmen müssen, das bringt auch schon eine natürlich Begrenzung.
I´a dllfreak2001
Nach oben
Antworten

Zurück zu „Feedback - Spiele“