Intelligenter Ball

Übersicht BlitzBasic Codearchiv

Neue Antwort erstellen

Travis

Betreff: Intelligenter Ball

 BeitragDo, Jan 29, 2004 21:01
Antworten mit Zitat
Benutzer-Profile anzeigen
Ihr kennt doch sicherlich alle dieses Spiel, wo man einen Ball steuert und dabei versuchen muß anderen Bällen, die sich von oben nach unten bewegen auszuweichen. Ich habe das ganze mal automatisiert, so daß der Ball automatisch ausweicht.

Code: [AUSKLAPPEN]

Graphics 400,700,16,2
AppTitle "Crafty Gotcha"

Ball = CreateImage(50,50)
SetBuffer ImageBuffer(Ball)
Cls
Color 255,0,0
Oval 0,0,50,50,1


Spieler = CreateImage(30,30)
SetBuffer ImageBuffer(Spieler)
Cls
Color 0,0,200
Oval 0,0,30,30,1

SetBuffer BackBuffer()

;Ball = LoadImage("Ball.png")
;Spieler = LoadImage("Player.png")

MidHandle Spieler
MidHandle Ball

x=200 ; Spielerplatzieren
y=650

Type ball
 Field x,y,speed
End Type

.firstrun
For b.ball = Each ball
 Delete b
Next


SeedRnd MilliSecs()

ImpulsTimer = MilliSecs() ; Impulstimer einstellen
start = MilliSecs()       ; Startzeit merken



Repeat
Cls


; Gitter anzeigen
For gx = 0 To 400 Step 24
 For gy = 0 To 700 Step 24
  Color 0,50,0
  Rect gx,gy, 25,25,0
 Next
Next


; Punkte aktualisieren
punkte = + ((MilliSecs()-start)/100)
level = punkte / 100
If level = 0 Then level = 1


; Statistik darstellen
Color 255,255,255
Text 0,0, "Punkte: " + punkte
Text 0,10, "Level:  " + level
Text 0,20, "Gefahr: " + gefahr

If MilliSecs() - ImpulsTimer > Rnd(2000,8000) Then ; Neue Bälle erschaffen
 Impulstimer = MilliSecs()
 b.ball = New ball
 b\x=Rnd(50,350)
 b\y=50
 b\speed = level
EndIf


If gefahr = 1 Then          ; Wenn Gefahrstufe 1
 gefahraufruf = MilliSecs() ; Aufrufzeit merken
 gefahr = 2                 ; Ausweichen einleiten
EndIf


For b.ball = Each ball
 If MilliSecs() - gefahraufruf > 250 Then ;And abstand(b\x,b\y,x,y) > 150 Then
  gefahr = 0   ; Gefahr nach Zeitspanne wieder abschalten
 EndIf
Next


For b.ball = Each ball
 b\y = b\y + b\speed      ; Bälle bewegen
 DrawImage ball, b\x, b\y ; Balle zeichnen

 If abstand(b\x, b\y, x, y)  < 100 Then ; Gefahrensituation aufrufen
  Color 255,0,0
  Text x-100,600, "G E F A H R !"
  If gefahr = 0 Then gefahr = 1         ; Gefahrstufe 1 aktiv
 EndIf

 If gefahr = 2 Then       ; Bei Gefahrstufe 2 ausweichen
  If x =< b\x And x > 25 Then x = x - 1 - (level/2) ; Speed ist Levelabhängig
  If x => b\x And x < 375 Then x = x + 1 + (level/2)
 EndIf
Next


If gefahr = 0 ; Keine Gefahr / Spieler zentrieren
 If x < 200 Then x = x + 1
 If x > 200 Then x = x - 1
EndIf


For b.ball = Each ball  ; Bälle außerhalb Bildschirm löschen
 If b\y > 700 Then Delete b
Next


DrawImage Spieler, x, y ; Spieler zeichnen


For b.ball = Each ball  ; Kollision Ball-Spieler (GAME OVER)
 If ImagesCollide(Spieler, x, y, 0, Ball, b\x, b\y, 0) Then
  Text 150, 350, "G A M E  O V E R"
  Flip
  FlushKeys
  WaitKey
  Goto firstrun
 EndIf
Next


Flip
Until KeyHit(1)
End


Function Abstand#(x1#,y1#,x2#,y2#)
xhypo# = x1# - x2#
yhypo# = y1# - y2#

Abstand# = Abs(Sqr((xhypo# ^ 2) + (yhypo# ^2)))
Return Abstand#
End Function
www.funforge.org

Ich hasse WASD-Steuerung.

Man kann alles sagen, man muss es nur vernünftig begründen können.
 

HOT-BIT

Gast

BeitragDo, Jan 29, 2004 22:13
Antworten mit Zitat
Hi !

Habs mir mal angeschaut.

Nichts für ungut, aber ich würde sowas nie hierher stellen.

Denn der Algorhytmus läßt sehr zu wünschen übrig.

Diesen mußt noch verbessern. Ansonsten ist es aber ok !

Toni

Travis

 BeitragDo, Jan 29, 2004 23:01
Antworten mit Zitat
Benutzer-Profile anzeigen
Hmpf. Na gut, es ist vielleicht noch nicht 100%ig, aber immer noch besser als einen 4. Input-Ersatz, oder? Ich schäme mich jedenfalls nicht Wink
www.funforge.org

Ich hasse WASD-Steuerung.

Man kann alles sagen, man muss es nur vernünftig begründen können.
 

Eisrabe

 BeitragFr, Jan 30, 2004 5:01
Antworten mit Zitat
Benutzer-Profile anzeigen
über den code kann ich nicht viel sagen, aber das prog funktioniert auch nicht richtig. 2 testläufe und 2x versagt. der 2. lauf sogar vom ersten ball getroffen !!!!
ich habe einCode: [AUSKLAPPEN]
GOTO
und ich bin bereit es einzusetzen!

Travis

 BeitragFr, Jan 30, 2004 15:23
Antworten mit Zitat
Benutzer-Profile anzeigen
Manchmalscheint er die anderen Bälle absichtlich zu rammen, das ist mir leider auch aufgefallen. Mein Rekord war aber bisher bis Level 19 zu kommen.
www.funforge.org

Ich hasse WASD-Steuerung.

Man kann alles sagen, man muss es nur vernünftig begründen können.

Mr.Keks

 BeitragFr, Jan 30, 2004 15:51
Antworten mit Zitat
Benutzer-Profile anzeigen
die ganze sache hatte gravierende fehler... ich habe einige löcher gestopft, aber ganz neu schreiben wäre ratsam ^^


Code: [AUSKLAPPEN]
Graphics 400,700,16,2
AppTitle "Crafty Gotcha"

Ball = CreateImage(50,50)
SetBuffer ImageBuffer(Ball)
Cls
Color 255,0,0
Oval 0,0,50,50,1


Spieler = CreateImage(30,30)
SetBuffer ImageBuffer(Spieler)
Cls
Color 0,0,200
Oval 0,0,30,30,1

SetBuffer BackBuffer()

;Ball = LoadImage("Ball.png")
;Spieler = LoadImage("Player.png")

MidHandle Spieler
MidHandle Ball

x=200 ; Spielerplatzieren
y=650

Type ball
 Field x,y,speed
End Type

.firstrun
For b.ball = Each ball
 Delete b
Next


SeedRnd MilliSecs()

ImpulsTimer = MilliSecs() ; Impulstimer einstellen
start = MilliSecs()       ; Startzeit merken

Local gefball


Repeat
Cls


; Gitter anzeigen
For gx = 0 To 400 Step 24
 For gy = 0 To 700 Step 24
  Color 0,50,0
  Rect gx,gy, 25,25,0
 Next
Next


; Punkte aktualisieren
punkte = + ((MilliSecs()-start)/100)
level = punkte / 100
If level = 0 Then level = 1


; Statistik darstellen
Color 255,255,255
Text 0,0, "Punkte: " + punkte
Text 0,10, "Level:  " + level
Text 0,20, "Gefahr: " + gefahr
Text 0,30, "Gefball: " + gefball

If MilliSecs() - ImpulsTimer > Rnd(2000,8000) Then ; Neue Bälle erschaffen
 Impulstimer = MilliSecs()
 b.ball = New ball
 b\x=Rnd(50,350)
 b\y=50
 b\speed = level
EndIf


If gefahr = 1 Then          ; Wenn Gefahrstufe 1
 gefahraufruf = MilliSecs() ; Aufrufzeit merken
 gefahr = 2                 ; Ausweichen einleiten
EndIf


For b.ball = Each ball
 b\y = b\y + b\speed      ; Bälle bewegen
 DrawImage ball, b\x, b\y ; Balle zeichnen

 If abstand(b\x, b\y, x, y)  < 100 Then ; Gefahrensituation aufrufen
  Color 255,0,0
  Text x-100,600, "G E F A H R !"
  If gefahr = 0 Then gefahr = 1         ; Gefahrstufe 1 aktiv
  gefball = Handle(b)
 EndIf

 
 If ImagesOverlap(Spieler, x, y, Ball, b\x, b\y) Then
  If ImagesCollide(Spieler, x, y, 0, Ball, b\x, b\y, 0)
   Text 150, 350, "G A M E  O V E R"
   Flip
   FlushKeys
   WaitKey
   Goto firstrun
  EndIf
 EndIf
 If b\y > 700 Then
  If Handle(b) = gefball Then gefball = 0 gefahr = 0
  Delete b
 EndIf
Next

Select gefahr
Case 0 ; Keine Gefahr / Spieler zentrieren
 If x < 200 Then x = x + 1
 If x > 200 Then x = x - 1
Case 1 ; Wenn Gefahrstufe 1
 gefahraufruf = MilliSecs() ; Aufrufzeit merken
 gefahr = 2                 ; Ausweichen einleiten
Case 2
 g.ball = Object.ball(gefball)
 If x =< g\x And x > 25 Then x = x - 1 ; Speed ist Levelabhängig
 If x => g\x And x < 375 Then x = x + 1
End Select
DrawImage Spieler, x, y ; Spieler zeichnen 0
If MilliSecs() - gefahraufruf > 250 Then ;And abstand(b\x,b\y,x,y) > 150 Then
  gefball= 0
  gefahr = 0   ; Gefahr nach Zeitspanne wieder abschalten
 EndIf
Flip
Until KeyHit(1)
End


Function Abstand#(x1#,y1#,x2#,y2#)
xhypo# = x1# - x2#
yhypo# = y1# - y2#

Abstand# = Abs(Sqr((xhypo# ^ 2) + (yhypo# ^2))) ; nur mal so nebenbei, sqr ist immer positiv - das abs kann weg ;)
Return Abstand#
End Function


oh, als ich die levelabhängige ausweichgeschwindigkeit wieder aktivierte, war der ball unbesiegbar ^^



hätte wer lust an einem minicontest zu dem thema? also einfach so einen intelligenten ball ohne dateibefehle umsetzen Smile fände ich lustig Smile. man könnte es ja auch um kleine klauseln wie "muss menschlich sein (also auch mal fehler machen oder konzentriert sein)" oder "max. 2500 zeichen" erweitern.
MrKeks.net
 

HOT-BIT

Gast

BeitragFr, Jan 30, 2004 16:31
Antworten mit Zitat
Hi !

Ja. Ist schon etwas besser !

Aber:
Wenn eine Richtung mal eingeschlagen wurde. sollte diese beibehalten werden.
Das wäre noch eine Option, welche dazu gehört !

Toni
 

Eisrabe

 BeitragFr, Jan 30, 2004 17:14
Antworten mit Zitat
Benutzer-Profile anzeigen
ich bekomme hier die fehlermeldung: function not found!

bei BlitzBasic: [AUSKLAPPEN] 
Handle(b)


da die variable nicht mit Dim geclariert wurde, ist das verständlich. funktioniert bei euch dieses listing??
ich habe einCode: [AUSKLAPPEN]
GOTO
und ich bin bereit es einzusetzen!

Mr.Keks

 BeitragFr, Jan 30, 2004 17:19
Antworten mit Zitat
Benutzer-Profile anzeigen
wenn man sein bb seit 2 jahren nicht mehr geupdatet hat, ist es normal, dass das nicht gefunden wird Wink...
MrKeks.net
 

Eisrabe

 BeitragFr, Jan 30, 2004 17:47
Antworten mit Zitat
Benutzer-Profile anzeigen
ich habe es grad gebraucht gekauft. und updaten kann man die version nicht mehr. es gibt nur den patch, damit es überhaupt mit IE6 funktioniert.
ich habe einCode: [AUSKLAPPEN]
GOTO
und ich bin bereit es einzusetzen!

Travis

 BeitragFr, Jan 30, 2004 17:49
Antworten mit Zitat
Benutzer-Profile anzeigen
@ Inarie

Cool, das es doch jemanden interessiert und Danke für deine Mühe. Very Happy Ich habe aber noch ein paar Fragen dazu.

BlitzBasic: [AUSKLAPPEN] 

If ImagesOverlap(Spieler, x, y, Ball, b\x, b\y) Then 
 If ImagesCollide(Spieler, x, y, 0, Ball, b\x, b\y, 0)


Reicht da nicht eine Abfrage oder ist das jetzt eine Speedoptimierung, weil ImagesOverlap schneller ist als ImagesCollide und so eine (relativ langsamere) Pixelgenaue Prüfung nur stattfindet, wenn sich die Objekte auch überschneiden.

BlitzBasic: [AUSKLAPPEN] 

g.ball = Object.ball(gefball)


Das verstehe ich jetzt überhaupt nicht. Und was bedeutet denn die Variable "gefball"?
www.funforge.org

Ich hasse WASD-Steuerung.

Man kann alles sagen, man muss es nur vernünftig begründen können.

Mr.Keks

 BeitragFr, Jan 30, 2004 17:54
Antworten mit Zitat
Benutzer-Profile anzeigen
gefball ist das handle zum type des den spielerball bedrohenden balls Wink.

@eisrabe: zu der bbversion habe ich im anderen thread schon was gesagt...
MrKeks.net

Neue Antwort erstellen


Übersicht BlitzBasic Codearchiv

Nach Oben

Gehe zu:

Powered by phpBB © 2001 - 2006, phpBB Group