Billard ähnlichens Spiel
Übersicht![](/themes/Standard/arrow.png)
![](/themes/Standard/arrow.png)
![]() |
Markus2Betreff: Billard ähnlichens Spiel |
![]() Antworten mit Zitat ![]() |
---|---|---|
Meine erste Umsetzung von BB3D nach BMax
Man muß immer eine große Kugel auf eine kleinere stoßen dann gibt es mehr Punkte . LMT oder RMT N=Neues Spiel ESC=Ende Code: [AUSKLAPPEN] '----------------------------------------------------------------------- ' Kleines BallSpiel in BlitzMax von M.Rauch 2005 '----------------------------------------------------------------------- 'Color = SetColor <- beeinflußt auch Bilder wenn sie angezeigt werden ! 'Line = DrawLine 'Text = DrawText Strict Graphics 800, 600,0, 72 'vorher 800,600,16,2 SeedRnd MilliSecs() SetClsColor 64,128,64 'vorher ClsColor AutoImageFlags MASKEDIMAGE '----------------------------------------------------------------------- 'Local mFont=LoadFont("Tahoma",18,1) <- BlitzBasic 'SetFont mFont 'Global mFont:TImagefont=LoadImageFont("Arial",24,BOLDFONT) '??? 'SetImageFont mFont '------------------------------------------ Type CircleType Field x:Float,y:Float 'position Field ox:Float,oy:Float 'original position Field dx:Float,dy:Float 'x and y speed Field w:Float 'winkel Field wspeed:Float Field speed:Float 'speed gesamt Field radius:Float 'radius of ball Field mass:Float 'mass of ball Field img:TImage Field hit:Int Field MoveBack:Int 'Neue Struktur anlegen und in Liste anfügen Method New() clist.addlast Self End Method 'Bild und Struktur freigeben und aus Liste entfernen Method Free() img=Null clist.remove Self End Method 'Rollt aus und verschwindet Method FreeAtHit() If Self.Hit=1 And Self.speed<1.0 Then Free End Method End Type '------------------------------------------ Global Punkte Global LastOne Global GameOver Global cue:CircleType Global clist:TList=CreateList() '= New TList '----------------------------------------------------------------------- Main() End '----------------------------------------------------------------------- Function Main() Reset() While Not KeyHit(KEY_ESCAPE) 'Escape Cls SetBlend MASKBLEND SetAlpha 1 DrawLine 0,GraphicsHeight()/2.0,GraphicsWidth()-1,GraphicsHeight()/2.0 UpdateCirclePhysics() RenderCircles() Ordnung() If KeyHit(KEY_N) Then 'N wie Neu oder New GameOver=1 EndIf If GameOver=0 Then GameInput() '---------------------------------- Überblenden :-) SetColor 255,255,255 SetBlend LIGHTBLEND SetAlpha 0.8 Text 10, 10, "Punkte " + Punkte If GameOver=1 Then Text 10, 25, "Game Over" If MouseHit(1) Then Reset() EndIf EndIf '---------------------------------- Flip Wend End Function '----------------------------------------------------------------------- Function Reset() '------------------------------- Punkte=0 LastOne=0 GameOver=0 '------------------------------- Local c:CircleType For c = EachIn clist c.free Next FlushMem 'alles was auf NULL gesetzt wurde wird jetzt entfernt '------------------------------- Local db=0 Local ballTriangleSize=12 Local xloop,yloop For xloop = ballTriangleSize To 1 Step -1 db=db+1;If db>2 Then db=0 For yloop = 1 To xloop c=New CircleType c.x = (5-xloop)*27 + 240 c.y = yloop*32-16-(xloop*32)/2.0+GraphicsHeight()/2.0 c.ox=c.x c.oy=c.y c.dx=0 c.dy=0 c.radius = 10 c.mass =c.radius*2.0 If db=1 Then c.radius = c.radius/2.0 c.mass =c.radius*2.0 EndIf If db=2 Then c.radius = c.radius/1.5 c.mass = c.radius*2.0 EndIf CImage c Next Next '------------------------------- CueStart() End Function '----------------------------------------------------------------------- Function Ordnung() Local c:CircleType Local x#,y#,dx#,dy#,entf# For c = EachIn clist If c<>cue Then If c.hit=1 And c.MoveBack=1 Then c.MoveBack=0 If c.hit=0 And (c.speed<0.5 Or c.MoveBack=1) Then dx=c.ox-c.x dy=c.oy-c.y entf=Sqr(dx*dx+dy*dy) If entf<=4 Then c.MoveBack=0 c.speed=c.speed*0.5 EndIf If entf>4 Or c.MoveBack=1 Then c.MoveBack=1 c.w=ATan2(c.ox-c.x,c.oy-c.y) c.speed=entf/10.0 If c.speed>2 Then c.speed=2 c.dx = Sin(c.w)*c.speed c.dy = Cos(c.w)*c.speed EndIf EndIf EndIf Next End Function '----------------------------------------------------------------------- Function CueStart() 'Spiel Ball cue=New CircleType cue.x = GraphicsWidth()-32 cue.y = GraphicsHeight()/2.0 cue.w=-90 cue.wspeed=1.0 cue.dx = Sin(cue.w)*cue.speed cue.dy = Cos(cue.w)*cue.speed cue.speed= 2 cue.radius =15 cue.mass = cue.radius*2.0 CImage cue End Function '----------------------------------------------------------------------- Function GameInput() Local dx:Float,dy:Float '--------------------------------------------- 'Richtung Maus schießen If MouseHit(1) Then cue.w=ATan2(MouseX()-cue.x,MouseY()-cue.y) cue.speed=20 cue.dx = Sin(cue.w)*cue.speed cue.dy = Cos(cue.w)*cue.speed End If '--------------------------------------------- 'Bis Maus bewegen If MouseDown(2) Then cue.w=ATan2(MouseX()-cue.x,MouseY()-cue.y) dx=MouseX()-cue.x dy=MouseY()-cue.y cue.speed=Sqr(dx*dx+dy*dy) If cue.speed>10 Then cue.speed=10 cue.dx = Sin(cue.w)*cue.speed cue.dy = Cos(cue.w)*cue.speed End If '--------------------------------------------- End Function '----------------------------------------------------------------------- Function UpdateCirclePhysics() Local anz=0 Local c:CircleType Local c2:CircleType For c = EachIn clist anz=anz+1 c.dx = Sin(c.w)*c.speed c.dy = Cos(c.w)*c.speed 'update positions c.x=c.x+c.dx c.y=c.y+c.dy 'gradually slow down c.speed=c.speed*0.98 '------------------------------------------ 'COLLISION CHECKING '------------------------------------------ ' Check each circle in the loop against ' every other (c against c2) For c2= EachIn clist If c<>c2 Then Local collisionDistance# = c.radius+c2.radius Local actualDistance# = Sqr((c2.x-c.x)^2.0+(c2.y-c.y)^2.0) 'Collided or not? If actualDistance<collisionDistance Then Local collNormalAngle#=ATan2(c2.x-c.x, c2.y-c.y) 'Position exactly touching, no intersection Local moveDist1#=(collisionDistance-actualDistance)*(c2.mass/Float((c.mass+c2.mass))) Local moveDist2#=(collisionDistance-actualDistance)*(c.mass/Float((c.mass+c2.mass))) c.x=c.x + moveDist1*Sin(collNormalAngle+180.0) c.y=c.y + moveDist1*Cos(collNormalAngle+180.0) c2.x=c2.x + moveDist2*Sin(collNormalAngle) c2.y=c2.y + moveDist2*Cos(collNormalAngle) 'Hit and Points If (c2.mass<c.mass And LastOne=0) Or (c2.mass<=c.mass Or LastOne=1) Then If (c2<>cue And c<>cue) Or (c2<>cue And LastOne=1) Then If c2.Hit=0 Then c2.Hit=1 If c2.mass<c.mass Then punkte=punkte+c.mass*2.0 If c2.mass=c.mass Then punkte=punkte+(c2.mass/2.0) EndIf EndIf EndIf If 1=1 Then 'wenn die Kugeln sich auch bewegen sollen '------------------------------------------ 'COLLISION RESPONSE '------------------------------------------ 'n = vector connecting the centers of the circles. 'we are finding the components of the normalised vector n Local nX#=Sin(collNormalAngle) Local nY#=Cos(collNormalAngle) 'now find the length of the components of each movement vectors 'along n, by using dot product. Local a1# = c.dx*nX + c.dy*nY Local a2# = c2.dx*nX + c2.dy*nY 'optimisedP = 2(a1 - a2) ' ---------- ' m1 + m2 Local optimisedP# = (2.0 * (a1-a2)) / (c.mass + c2.mass) 'now find out the resultant vectors 'r1 = c1\v - optimisedP * mass2 * n c.dx = c.dx - (optimisedP*c2.mass*nX) c.dy = c.dy - (optimisedP*c2.mass*nY) 'r2 = c2\v - optimisedP * mass1 * n c2.dx = c2.dx - (optimisedP*c.mass*-nX) c2.dy = c2.dy - (optimisedP*c.mass*-nY) c.w=collNormalAngle+180.0 SpeedFromDXDY(c) c2.w=collNormalAngle SpeedFromDXDY(c2) EndIf 'Move or Not EndIf 'colli ? EndIf 'c<>c2 Next 'c2 '------------------------------------------ '------------------------------------------ If 1=1 Then 'Wand Colli An/Aus 'Simple Bouncing off walls. If c.x<c.radius Then c.x=c.radius c.dx=-c.dx c.w=ATan2(c.dx,c.dy) SpeedFromDXDY(c) c.speed=c.speed*0.9 End If If c.x>GraphicsWidth()-c.radius Then c.x=GraphicsWidth()-c.radius c.dx=-c.dx c.w=ATan2(c.dx,c.dy) SpeedFromDXDY(c) c.speed=c.speed*0.9 End If If c.y<c.radius Then c.y=c.radius c.dy=-c.dy c.w=ATan2(c.dx,c.dy) SpeedFromDXDY(c) c.speed=c.speed*0.9 End If If c.y>GraphicsHeight()-c.radius Then c.y=GraphicsHeight()-c.radius c.dy=-c.dy c.w=ATan2(c.dx,c.dy) SpeedFromDXDY(c) c.speed=c.speed*0.9 End If EndIf c.FreeAtHit Next If anz=2 Then LastOne=1 If anz=1 Then GameOver=1 End Function '----------------------------------------------------------------------- Function SpeedFromDXDY(c:CircleType) c.Speed=Sqr(c.dx^2.0+c.dy^2.0) c.dx = Sin(c.w)*c.speed c.dy = Cos(c.w)*c.speed End Function '----------------------------------------------------------------------- Function RenderCircles() 'Bilder können jetzt in BlitzMax eingefärbt angezeigt werden ! Local c:CircleType For c:CircleType= EachIn clist If c=cue Then SetColor 255,255,0 'Gelb Else If c.hit=0 Then SetColor 255,255,255 'Weiß Else SetColor 255,128,64 'Orange EndIf EndIf DrawImage c.img,c.x-c.radius,c.y-c.radius Next End Function '----------------------------------------------------------------------- Function CImage(c:CircleType) 'in Bild Speicher malen geht wohl nicht mehr 'aber den Backbuffer kann ich nutzen :-) SetBlend MASKBLEND SetAlpha 1 SetClsColor 0,0,0 Cls c.img=CreateImage(c.radius*2,c.radius*2,DYNAMICIMAGE) Local r:Float Local f:Float Local o:Float f=128 o=0 For r=c.radius To 1.0 Step -1.0 SetColor f,f,f If c.radius=r Then SetColor 4,4,4 f=f+(128.0/(c.radius)) Oval c.radius-r-o,c.radius-r-o,r*2.0,r*2.0,True If c.radius<>r Then o=o+0.5 Next GrabImage c.img,0,0 SetClsColor 64,128,64 'vorher ClsColor Cls End Function '----------------------------------------------------------------------- Function Text(x:Int,y:Int,t:String) 'BB3D kompatibel DrawText t$,x,y End Function Function Oval(x:Float,y:Float,r1:Float,r2:Float,fill:Float) 'BB3D 50% kompatibel weil immer gefüllt DrawOval x,y,r1,r2 ',fill ? End Function |
||
- Zuletzt bearbeitet von Markus2 am Mo, Mai 16, 2005 12:18, insgesamt einmal bearbeitet
![]() |
Suco-XBetreff: ........ |
![]() Antworten mit Zitat ![]() |
---|---|---|
Hi
Na da scheint sich ja jemand schon gut mit Bmax eingeübt zu haben. Nettes Spielchen. Mfg Suco |
||
Intel Core 2 Quad Q8300, 4× 2500 MHz, 4096 MB DDR2-Ram, GeForce 9600GT 512 MB |
![]() |
Markus2 |
![]() Antworten mit Zitat ![]() |
---|---|---|
@Suco-X
Habe die Demo seit gestern ![]() Habe gerade noch SetBlend MASKBLEND SetAlpha 1 eingefügt ![]() |
||
Übersicht
![](/themes/Standard/arrow.png)
![](/themes/Standard/arrow.png)
Powered by phpBB © 2001 - 2006, phpBB Group