PureBoard

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

Springender Ball

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

Seite 2 von 8

Verfasst: 21.04.2007 00:04
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 :)

Verfasst: 21.04.2007 00:44
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:

Verfasst: 21.04.2007 00:51
von HeX0R
Ich will ja nix sagen, aber wann wird denn endlich ein spielbares Spiel daraus ?

Verfasst: 21.04.2007 00:56
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:)

Verfasst: 21.04.2007 01:08
von HeX0R
AND51 hat geschrieben:War das überhaupt gewollt @ Threadersteller? Oder missverstehe ich was?
Naja, immerhin sind wir ja im Forum Feedback-Spiele

Verfasst: 21.04.2007 01:15
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:

Verfasst: 21.04.2007 14:20
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ß!!!

Verfasst: 21.04.2007 15:15
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: .

Verfasst: 21.04.2007 16:28
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)

Verfasst: 21.04.2007 16:57
von Andreas_S
Nach ca. 5 sec. beginnt das zu rucken!!! Sonst aber ganz lustig :allright:

Sobesser???
Alle Zeiten sind UTC+02:00
Seite 2 von 8

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de