Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
muhbbles von mark_aroni mit automatischer schlangensteuerung(schneller)
| Uploader: |  Michael |
| Datum/Zeit: | 15.09.2007 19:14:34 |
dim as integer spielerY(1 to 9999)
dim as integer spielerX(1 to 9999)
dim as integer zeichnen, position, pruefen,pruefen2, counter=1
dim as integer speed = 4, punkte,Laenge = 1
dim as integer objektx, objekty,bonusX, bonusY
dim as string key, newkey,cheat
screenres 400,400,32
Dim as string keyline = _
"1 3"
For i As Integer = 1 To 24
keyline += "2 3"
keyline += "1 3"
Next i
keyline += "2 4"
keyline += " "
'grafiken initialisieren:
dim futter as any ptr
futter = imagecreate(8,8)
bload exepath + "/Futter.bmp",futter
dim grafik as any ptr
grafik= IMAGECREATE(8,8)
bload exepath + "/Schlange.bmp",grafik
''hintergrund:
'dim HG as any ptr
'HG = imagecreate(400,400)
'bload "HG.bmp", HG
'Bevor das spiel anfängt:
spielerY(1) = 392
spielerX(1) = 0
'spielerY(1) = 200
'spielerX(1) = 200
put (spielerX(1),spielerY(1)),grafik
'put (1,1),hg
randomize timer
objektx = int((rnd*48)+1)*8+8
objekty = int((rnd*48)+1)*8+8
put (objektx,objekty),futter
windowtitle punkte &" Punkte Laenge = "& laenge
'auf tastendruck warten:
do : sleep 1 : key = inkey : loop until key <> ""
'nach dem ersten tastendruck:
do
'prüfen ob crash
for pruefen = 2 to laenge
if spielerX(1) = SpielerX(pruefen+1) and spielerY(1) = spielerY(pruefen+1) then exit do
next pruefen
'futter:
if ((spielerX(1)-objektx)*(spielerX(1)-objektx) + (spielerY(1)-objekty)*(spielerY(1)-objekty)) < 60 then
laenge +=1
Punkte += 10 * (laenge) / 2
if speed > 3 then
speed -= 1
end if
windowtitle punkte &" Punkte Laenge = "& laenge
'randomize timer
objektx = int((rnd*48)+1)*8+8
objekty = int((rnd*48)+1)*8+8
for pruefen2 = 1 to laenge+1
if objektX = spielerX(pruefen2) and objektY = spielerY(pruefen2) then
objektx = int((rnd*48)+1)*8+8
objekty = int((rnd*48)+1)*8+8
bonusX = int((rnd*48)+1)*8+8
bonusY = int((rnd*48)+1)*8+8
end if
next pruefen2
continue do
end if
'bonus:
if ((spielerX(1)-bonusx)*(spielerX(1)-bonusx) + (spielerY(1)-bonusy)*(spielerY(1)-bonusy)) < 60 then
speed += 5
punkte += 200*(laenge) /2
bonusy = 0
bonusx = 0
windowtitle punkte &" Punkte Laenge = "& laenge
end if
if bonusy > 0 and bonusx > 0 then put (bonusx,bonusy),futter,pset
Line (objektx, objekty)-(objektx+8, objekty+8), &H000000,bf
put (objektx,objekty),futter,pset
screenunlock
'sleep speed, 1
'tastendruck:
'newkey = inkey
If counter > len(keyline) Then counter = 1
Select Case As const keyline[counter-1]
Case Asc("1") 'rechts
newkey = chr(255, 77)
Case Asc("2") 'links
newkey = chr(255, 75)
Case Asc("3") 'oben
newkey = chr(255, 72)
Case Asc("4") 'unten
newkey = chr(255, 80)
Case Asc(" ")
newkey = ""
End Select
counter += 1
select case newkey
case chr(255,107) : end
case chr(255,72) : if key = chr(255,80) then key = key : else:key = newkey
case chr(255,80) : if key = chr(255,72) then key = key : else:key = newkey
case chr(255,77) : if key = chr(255,75) then key = key : else:key = newkey
case chr(255,75) : if key = chr(255,77) then key = key : else:key = newkey
case chr(27) : exit do
case chr(13) : sleep : continue do
case "c"
locate 1,1 : Input "", cheat
select case cheat
case "ultimate" : laenge = 200
case "smaller" : laenge = 1
case "nerd" : speed -= 10
case "kid": laenge = 1
case "slow" : speed += 20
end select
end select
'verarbeitung:
select case key
case CHR(255,72) 'oben
spielery(1) -= 8
if spielery(1) < 0 then exit do
case chr(255,80) 'unten
spielery(1) += 8
if spielery(1) > 399 then exit do
case chr(255,77) 'rechts
spielerx(1) += 8
if spielerx(1) > 399 then exit do
case chr(255,75) 'links
spielerx(1) -= 8
if spielerx(1) < 0 then exit do
end select
'durchrutschen:
Line (spielerx(laenge), spielery(laenge))-(spielerx(laenge)+8, spielery(laenge)+8), &H000000,bf
select case Key
case CHR(255,72) 'oben
for position = laenge to 1 step -1
spielerX(position+1) = spielerX(position)
spielerY(position+1) = spielerY(position)
next
case chr(255,80) 'unten
for position = laenge to 1 step -1
spielerX(position+1) = spielerX(position)
spielerY(position+1) = spielerY(position)
next
case chr(255,77) 'rechts
for position = laenge to 1 step -1
spielerX(position+1) = spielerX(position)
spielerY(position+1) = spielerY(position)
next
case chr(255,75) 'links
for position = laenge to 1 step -1
spielerX(position+1) = spielerX(position)
spielerY(position+1) = spielerY(position)
next
end select
'sleep 1, 1
screenlock
put (spielerX(1),spielerY(1)),grafik,pset
loop
locate 25,20 : print "Game Over!" :
Locate 26,20 : print punkte & " Punkte!"
sleep