Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
Muhbles + 'Menu' + bug -.-
| Uploader: |  The_Muh |
| Datum/Zeit: | 18.09.2007 16:50:25 |
declare sub spiel()
declare sub menu()
screenres 400,400,32
menu()
sub menu()
dim as string key
do
locate 2, 1 :print "F1 = Neues Spiel starten"
locate 4, 1 :print "Esc = Beenden"
do : sleep 1 : key = inkey : loop until key <>""
cls
select case key
case chr(255,59) : spiel()
case chr(255,107) : exit sub
case chr(27) : end
end select
loop
end sub
sub spiel()
dim as integer spielerY(1 to 9999)
dim as integer spielerX(1 to 9999)
dim as integer zeichnen, position, pruefen,pruefen2
dim as integer laenge = 1, speed = 120, punkte
dim as integer objektx, objekty,bonusX, bonusY
dim as string key, newkey,cheat
CLS
'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
'Bevor das spiel anfaengt:
spielerY(1) = 200
spielerX(1) = 200
put (spielerX(1),spielerY(1)),grafik
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
do
'pruefen 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 > 15 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
Line (objektx, objekty)-(objektx+8, objekty+8), &H000000,bf
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
put (objektx,objekty),futter,pset
screenunlock
sleep speed
'tastendruck:
newkey = inkey
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) : Menu()
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:
Line (spielerx(laenge+1), spielery(laenge+1))-(spielerx(laenge+1)+8, spielery(laenge+1)+8), &H000000,bf
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:
for position = laenge to 1 step -1
spielerX(position+1) = spielerX(position)
spielerY(position+1) = spielerY(position)
next
'schlange ausgeben:
screenlock
put (spielerX(1),spielerY(1)),grafik,pset
loop
locate 25,20 : print "Game Over!" :
Locate 26,20 : print punkte & " Punkte!"
sleep
cls
Menu()
end sub