Springender Ball

Spiele, Demos, Grafikzeug und anderes unterhaltendes.
Benutzeravatar
onny
Beiträge: 400
Registriert: 27.04.2005 17:50
Kontaktdaten:

Beitrag von onny »

Code: Alles auswählen

speed = 7
gravity = 15

If InitMouse() = 0 Or InitSound() = 0 Or InitSprite() = 0 Or InitKeyboard() = 0 Or InitMovie() = 0 ;Or sceenid = 0
MessageRequester("Error", "Please check your computer settings and update your software", 0) : End : EndIf

screenid = OpenScreen(640, 480, 32, "DER SPRINGENDE BALL")
CreateSprite(1, 60, 60)
StartDrawing(SpriteOutput(1)) : Circle(20, 20, 20, #Blue)
StopDrawing()

CreateSprite(2, 20, 20)
StartDrawing(SpriteOutput(2)) : Circle(10, 10, 10, #Green)
StopDrawing()
  
Repeat



If MouseButton(1) : speed+1 : EndIf
If MouseButton(2) And speed > 0 : speed-1 : EndIf

If y > 430 : back = 1 : EndIf
If y < 30 : back = 0 : EndIf

If x > 590 : colision = 1 : EndIf
If x <= 1 : colision = 0 : EndIf

If back = 0 : y+speed : Else : y-speed : EndIf
If colision = 1 : x-speed : Else : x+speed : EndIf

StartDrawing(ScreenOutput()) : Locate (5,5)
DrawText("ALPHA 0.2  -  MouseX: "+Str(MouseX())+" - MouseY: "+Str(MouseY())+"  -  BallX:  "+Str(x)+" -  BallY:  "+Str(y))
StopDrawing()

DisplaySprite(1,x,y)
TransparentSpriteColor(2,255, 255, 255)
DisplayTransparentSprite(2, MouseX(), MouseY())

ExamineKeyboard() : ExamineMouse() : FlipBuffers() : ClearScreen(0, 0, 0)

If KeyboardPushed(#PB_Key_A)
StartDrawing(ScreenOutput())
LineXY(MouseX(), MouseY(), x+15, y+15,  #Green) 
StopDrawing()
If MouseX() > x : x + gravity : Else : x - gravity : EndIf
If MouseY() > y : y + gravity : Else : y - gravity : EndIf
EndIf

Until KeyboardPushed(#PB_Key_Escape) > 0 : End
neu dazugekommen ist eine anziehungskraft die durch a ausgelößt wird :)
Benutzeravatar
AND51
Beiträge: 5220
Registriert: 01.10.2005 13:15

Beitrag von AND51 »

Sooo, hier kommt meine mega fette krasse Ballspringanlage!

Ich habe möglichst 3.30 und 3.94-freundlich programmiert, damit onny uns STARGATE möglichst wenig Umwandlungsarbeit haben!

Code: Alles auswählen

#breite=1280
#hoehe=1024

#max_ball=3 ; Maximale Anzahl Bälle

InitSprite()
InitKeyboard()
OpenScreen(#breite, #hoehe, 32, "Der springende Ball")

Structure structSpur
	x.l
	y.l
	color.l
	owner.l
EndStructure
NewList spur.structSpur()
Structure structBall
	x.l
	y.l
	dirX.l
	dirY.f
	grav.f
	owner.l
EndStructure
NewList ball.structBall()

CreateSprite(0, 30, 30)
StartDrawing(SpriteOutput(0))
	Circle(15, 15, 15, #Yellow)
StopDrawing()

Repeat
	ClearScreen(0) ; 3.94 und früher: 0,0,0
	ExamineKeyboard()
	
	If CountList(ball()) < #max_ball
		AddElement(ball())
			ball()\x=Random(#breite-31)+1
			ball()\y=#hoehe/(Random(18)+2)
			ball()\dirX=(Random(2)+2)*(Random(1)*2-1) ; Range: -4 to 4
			ball()\dirY=-(Random(20)+75)/100 ; Range: -0.75 to -0.95
			ball()\grav=(Random(15)+5)/100 ; Range: 0.05 to 0.20
			ball()\owner=ElapsedMilliseconds()
			Delay(50)
	EndIf
	
	StartDrawing(ScreenOutput())
	DrawText(0, 0, "Space = Delete a ball and create a new one", $FFFFFF, 0) ; PB 4.00
		ResetList(spur()) ; extra kein ForEach, sondern "3.94 und früher"-freundliche Programmierung =)
		While NextElement(spur())
			spurX=spur()\x
			spurY=spur()\y
			spurOwner=spur()\owner
			spur()\color-2
				*spur=@spur()
				While NextElement(spur())
					If spur()\owner = spurOwner
						LineXY(spurX, spurY, spur()\x, spur()\y, spur()\color)
						Break
					EndIf
				Wend
				ChangeCurrentElement(spur(), *spur)
			If spur()\color <= 0
				DeleteElement(spur())
			EndIf
		Wend
	StopDrawing()
	
	ResetList(ball())
	While NextElement(ball())
		If ball()\x <= 0 Or ball()\x >= #breite-30
			ball()\dirX*-1
			MessageBeep_(#MB_OK) ; Einziger API-Befehl, erzeugt Ton. Rausnehmen, wenn unerwünscht
		EndIf
		If ball()\y >= #hoehe-30
			ball()\y=#hoehe-30
			ball()\dirY*-0.80
			MessageBeep_(#MB_OK) ; Einziger API-Befehl, erzeugt Ton. Rausnehmen, wenn unerwünscht
		EndIf
		ball()\x+ball()\dirX
		ball()\y+ball()\dirY
		ball()\dirY+ball()\grav
		AddElement(spur())
			spur()\x=ball()\x+7
			spur()\y=ball()\y+7
			spur()\color=255
			spur()\owner=ball()\owner
		DisplayTransparentSprite(0, ball()\x, ball()\y)
		If KeyboardReleased(#PB_Key_Space)
			DeleteElement(ball())
		EndIf
	Wend
	
	FlipBuffers()
	Delay(10)
Until KeyboardPushed(#PB_Key_Escape)
//Update: Zufällige Startposition
//Update 2: Jetzt mit Sound!

Da sach doch mal einer ich könnt's nicht! :mrgreen:
Zuletzt geändert von AND51 am 21.04.2007 01:08, insgesamt 3-mal geändert.
PB 4.30

Code: Alles auswählen

Macro Happy
 ;-)
EndMacro

Happy End
Benutzeravatar
HeX0R
Beiträge: 3040
Registriert: 10.09.2004 09:59
Computerausstattung: AMD Ryzen 7 5800X
96Gig Ram
NVIDIA GEFORCE RTX 3060TI/8Gig
Win11 64Bit
G19 Tastatur
2x 24" + 1x27" Monitore
Glorious O Wireless Maus
PB 3.x-PB 6.x
Oculus Quest 2 + 3
Kontaktdaten:

Beitrag von HeX0R »

Ich will ja nix sagen, aber wann wird denn endlich ein spielbares Spiel daraus ?
Benutzeravatar
AND51
Beiträge: 5220
Registriert: 01.10.2005 13:15

Beitrag von AND51 »

Also ich mache das nur zu Demo-Zwecken und habe nicht vor, ein Spiel zu entwickeln. War das überhaupt gewollt @ Threadersteller? Oder missverstehe ich was?


Habe meinen Code 2x upgedatet: Spielt Sounds ab, wenn die Kugeln aufprallen!!!!! :o

(So und jetzt geh ich endlich ins Land der Träume :coderselixir:)
PB 4.30

Code: Alles auswählen

Macro Happy
 ;-)
EndMacro

Happy End
Benutzeravatar
HeX0R
Beiträge: 3040
Registriert: 10.09.2004 09:59
Computerausstattung: AMD Ryzen 7 5800X
96Gig Ram
NVIDIA GEFORCE RTX 3060TI/8Gig
Win11 64Bit
G19 Tastatur
2x 24" + 1x27" Monitore
Glorious O Wireless Maus
PB 3.x-PB 6.x
Oculus Quest 2 + 3
Kontaktdaten:

Beitrag von HeX0R »

AND51 hat geschrieben:War das überhaupt gewollt @ Threadersteller? Oder missverstehe ich was?
Naja, immerhin sind wir ja im Forum Feedback-Spiele
Benutzeravatar
AND51
Beiträge: 5220
Registriert: 01.10.2005 13:15

Beitrag von AND51 »

Dann ist es entweder ein Fehler beim Posten oder es wird tatsächlich nen Spiel und ich weiß nichts davon.

Huch, was mach ich eigentlich hier? Nun aber husch ins die Heia @ mich-selbst!! :lol:
PB 4.30

Code: Alles auswählen

Macro Happy
 ;-)
EndMacro

Happy End
Andreas_S
Beiträge: 787
Registriert: 14.04.2007 16:48
Wohnort: Wien Umgebung
Kontaktdaten:

Beitrag von Andreas_S »

Code von STARGÅTE nur noch ein bischen realistischer:

Code: Alles auswählen

#breite=1024 
#hoehe=768 
#speed=3 ; From 1 (slow) to 10 (fast) 
InitSprite() 
InitKeyboard() 
OpenScreen(#breite, #hoehe, 32, "Der springende Ball") 
posX.f=#breite/2 : posY.f=#hoehe/4 : dirX.f=#speed : dirY.f=#speed : fY.d 

Structure spur 
 x.f 
 y.f 
 h.l 
EndStructure 
NewList spur.spur() 

CreateSprite(0, 30, 30) 
 StartDrawing(SpriteOutput(0)) 
  Circle(15, 15, 15, #Yellow) 
 StopDrawing() 
  
Repeat 

 ClearScreen(RGB(0,0,0)) 
  
 If (posX >= #breite-30 Or posX <= 0)
  dirX*-1 
 EndIf 
 If posY >= #hoehe-30 
  TipY=1
  dirX*0.99
  posY = #hoehe-30 
 Else
  TipY=0
 EndIf 
 If TipY=1
  If dirY>2.60
   dirY*-0.80
  Else
   lowSpeedY=1
   lowSpeedX=1
  EndIf
 EndIf
 If lowSpeedY=1
  fY+0.001
   If fY<0.80
     If TipY=1
      dirY*-(0.80-fY)
      dirX*0.99
     EndIf
    dirX*0.9999
   Else
    dirY=0
    posY=#hoehe-30
   EndIf
 EndIf
  
 AddElement(spur()) 
 spur()\x=posX+15 
 spur()\y=posY+15 
 spur()\h=255 
  
 posX+dirX 
 posY+dirY 
  
 dirY+0.1 
  
 StartDrawing(ScreenOutput()) 
  DrawText(posX+30, posY+30,"Ball("+Str(posX)+"|"+Str(posY)+")")  
  ResetList(spur()) 
  While NextElement(spur()) 
   spur()\h-1 
   Circle(spur()\x, spur()\y, 2, RGB(spur()\h,0,0)) 
   If spur()\h <= 0 : DeleteElement(spur()) : EndIf 
  Wend 
 StopDrawing() 
  
 DisplayTransparentSprite(0, posX, posY) 
  
 FlipBuffers() 
 Delay(10-#speed) 
 ExamineKeyboard() 
Until KeyboardPushed(#PB_Key_Escape) 
In PB v4.0 geschrieben/geändert!

Viel Spaß!!!
Andreas_S
Beiträge: 787
Registriert: 14.04.2007 16:48
Wohnort: Wien Umgebung
Kontaktdaten:

Beitrag von Andreas_S »

Hier noch ein Ball Spiel:

Code: Alles auswählen

Procedure MouseOver(x1,y1,Sprite2,x2,y2,TransparentColor=-1)
 Img2W=SpriteWidth(Sprite2)
 Img2H=SpriteHeight(Sprite2)
  If TransparentColor=-1
   If (x2<x1 And y2<y1) And (x1<x2+Img2W And y1<y2+Img2H)
    result=1
   Else
    result=0
   EndIf
  Else
   
  EndIf
 ProcedureReturn result
EndProcedure

InitSprite()
InitKeyboard()
InitMouse()

Structure spur
 x.f
 y.f
 Radius.d
 R.l
 G.l
 B.l
EndStructure
NewList spur.spur()

#Width=1024
#Height=768

OpenScreen(#Width,#Height,32,"Der springende Ball")

Mx=DesktopMouseX()
My=DesktopMouseY()
MouseLocate(Mx,My)
Bx.d=#Width/2-15
By.d=#Height/2-15
dirX.d:dirY.d:fY.d:GrabX=-1:GrabX=-1

CreateSprite(0,30,30)
 StartDrawing(SpriteOutput(0))
  Circle(15,15,15,RGB(255,0,0))
 StopDrawing()
CreateSprite(1,10,10)
 StartDrawing(SpriteOutput(1))
  LineXY(0,0,5,9,RGB(200,200,255))
  LineXY(0,0,9,5,RGB(200,200,255))
  Plot(2,2,RGB(255,255,255))
  FillArea(9,9,-1,RGB(255,255,255))
  LineXY(5,9,9,9,RGB(200,200,255))
  LineXY(9,5,9,9,RGB(200,200,255))
 StopDrawing()

Repeat
 ExamineMouse()
 Mx=MouseX()
 My=MouseY()
  If MouseButton(#PB_MouseButton_Left) And (MouseOver(Mx,My,0,Bx,By) Or Klick=1)
   Bx=Mx-15
   By=My-15
   dirX=0
   dirY=0
   Klick=1
   StKlick=1
   lowSpeedY=0
   fY=0
   GrabX=Mx
   GrabY=My
  Else
   Klick=0
    If GrabX<>-1 And GrabY<>-1
     dirX=(Mx-GrabX)/2
     dirY=(My-GrabY)/2
    EndIf
   GrabX=-1
   GrabX=-1
  EndIf
  If StKlick=1
   If Not (MouseButton(#PB_MouseButton_Left) And Kilck)
    Bx+dirX
    By+dirY
    dirY+0.2
   EndIf
  EndIf
  If Bx<0:Bx=0:dirX*-0.99999:EndIf
  If By<0:By=0:dirY*-1.20:EndIf
  If Bx>#Width-30:Bx=#Width-30:dirX*-1:EndIf
  If By>#Height-30:By=#Height-30:TipY=1:dirX*0.999:Else:TipY=0:EndIf
  If TipY=1
   If dirY>2.60
    dirY*-0.80
   Else
    lowSpeedY=1
   EndIf
  EndIf
  If lowSpeedY=1
   fY+0.001
    If fY<0.80
      If TipY=1
       dirY*-(0.80-fY)
       dirX*0.99
      EndIf
     dirX*0.9999
    Else
     dirY=0
     By=#Height-30
    EndIf
  EndIf
  If Klick=0 And StKlick=1
   AddElement(spur())
   spur()\x=Bx+15
   spur()\y=By+15
   spur()\Radius=2
   spur()\R=255
   spur()\G=255
   spur()\B=0
  EndIf

 ClearScreen(0)

 StartDrawing(ScreenOutput())
  ResetList(spur())
   While NextElement(spur())
     If spur()\R>=0
      spur()\R-1
     EndIf
     If spur()\R<0
      spur()\R=0
     EndIf
     If spur()\G>=0
      spur()\G-1
     EndIf
     If spur()\G<0
      spur()\G=0
     EndIf
     If spur()\B>=0
      spur()\B-1
     EndIf
     If spur()\B<0
      spur()\B=0
     EndIf
;    If spur()\Radius>=0
;     spur()\Radius-0.1
;    EndIf
;    If spur()\Radius<0
;     spur()\Radius=0
;    EndIf
    Circle(spur()\x,spur()\y,spur()\Radius,RGB(spur()\R,spur()\G,spur()\B))
     If spur()\R=0 And spur()\G=0 And spur()\B=0; And spur()\Radius=0
      DeleteElement(spur())
     EndIf
   Wend
 StopDrawing()

 DisplayTransparentSprite(0,Bx,By)
 DisplayTransparentSprite(1,Mx,My)

 FlipBuffers()
 Delay(1)
 ExamineKeyboard()
Until KeyboardPushed(#PB_Key_Escape)
Mit der Maus den Ball nehmen und dann werfen.
Könnte beim Werfen noch ein bischen unrealistik sein <)

\\Edit:
Der Ball hat sich nicht gebremst :lol: .
Benutzeravatar
Deeem2031
Beiträge: 1232
Registriert: 29.08.2004 00:16
Wohnort: Vorm Computer
Kontaktdaten:

Beitrag von Deeem2031 »

Ganz viele springende Bälle:

Code: Alles auswählen

#width=1024
#height=768

InitSprite() 
InitKeyboard() 
OpenScreen(#width, #height, 32, "Ganz viele springende Bälle") 

Global g.f = 0.1, z = 0

Structure Ball_Struc
   x.f
   y.f
   r.l
   dirX.f
   dirY.f
   color.l
EndStructure 
NewList Ball.Ball_Struc() 

AddElement(ball())
Ball()\x = #width/2
Ball()\y = 100
Ball()\r = 15
Ball()\color = Random($FFFFFF)

Repeat 
   ClearScreen(0)
    
   StartDrawing(ScreenOutput()) 
   ForEach Ball()
      If Ball()\x <= 0 Or Ball()\x >= #width
         DeleteElement(Ball())
      EndIf 
      If Ball()\y + Ball()\r * 2 >= #height
         If ListIndex(Ball()) = 0
           Ball()\dirY - g
           Ball()\dirY * -1
         Else
           Ball()\y = #height - Ball()\r * 2
           Ball()\dirY * -0.8 
         EndIf
         elem = @Ball()
         If Ball()\dirY < -1.0 And Ball()\r >= 3
           For i = 1 To 5
             x = Ball()\x
             y = Ball()\y
             r = Ball()\r
             dy = Ball()\dirY
             dx = Ball()\dirX
             AddElement(Ball())
             Ball()\x = x
             Ball()\y = y
             Ball()\r = Random(r/2)+3
             Ball()\color = Random($FFFFFF)
             Ball()\dirY = dy * 3 / 4
             Ball()\dirX = (Random(20)-10)/10 + dx
             If Ball()\dirX = 0
               DeleteElement(Ball())
             EndIf
           Next
         EndIf
         ChangeCurrentElement(Ball(),elem)
      EndIf 
      Ball()\x+Ball()\dirX 
      Ball()\y+Ball()\dirY 
      Ball()\dirY + g
      Circle(Ball()\x, Ball()\y,Ball()\r, Ball()\color)
   Next
   StopDrawing() 
    
   FlipBuffers(#True) 
   ExamineKeyboard() 
Until KeyboardPushed(#PB_Key_Escape)
Bild
[url=irc://irc.freenode.org/##purebasic.de]irc://irc.freenode.org/##purebasic.de[/url]
Andreas_S
Beiträge: 787
Registriert: 14.04.2007 16:48
Wohnort: Wien Umgebung
Kontaktdaten:

Beitrag von Andreas_S »

Nach ca. 5 sec. beginnt das zu rucken!!! Sonst aber ganz lustig :allright:

Sobesser???
Zuletzt geändert von Andreas_S am 21.04.2007 18:27, insgesamt 1-mal geändert.
Antworten