Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
Muhbles 1.0 final
| Uploader: |  The_Muh |
| Datum/Zeit: | 20.01.2008 14:25:46 |
dim shared red as integer = 900
dim shared blue as integer = 980
dim shared green as integer = 950
dim shared wachstum as integer = 1
declare sub spiel()
declare sub menu()
declare sub highscore(punkte as integer, laenge as integer)
screenres 400,400,32
menu()
sub list()
dim i as integer
dim nam (1 to 10) as string
dim punkte (1 to 10) as integer
dim laenge (1 to 10) as integer
cls
open "highscore.dat" for input as #1
for i = 1 to 10
input #1 ,Punkte(i), laenge(i), nam(i)
print nam(i), Punkte(i), laenge(i)
next i
close #1
sleep
cls
end sub
sub highscore(punkte as integer, laenge as integer)
dim punkteA(1 to 10) as integer
dim nam(1 to 10) as string * 3
dim laengeA(1 to 10) as integer
dim as ubyte i, i2, i3,i4
open "highscore.dat" for input as #1
for i = 1 to 10
input #1 ,PunkteA(i), laengeA(i), nam(i)
next i
close #1
for i2 = 1 to 10
if Punkte > punkteA(i2) then
for i3 = 10 to i2 step -1
punkteA(i3+1) = punkteA(i3)
nam(i3+1) = nam(i3)
laengeA(i3+1) = laengeA(i3)
next i3
PunkteA(i2) = Punkte
laengeA(i2) = laenge
locate 25, 25-9 :input "Name eingeben:", Nam(i2)
exit for
end if
next i2
open "highscore.dat" for output as #1
for i4 = 1 to 10
print #1, PunkteA(i4), laengeA(i4), nam(i4)
next
close #1
cls
end sub
sub optionen()
cls
dim key as string
locate 21,20 : print "L = Leicht"
locate 23,20 : print "N = normal"
locate 25,20 : print "S = schwer"
do : sleep 1 : key = inkey : loop until key <>"
select case key
case "l"
print "l"
wachstum = 1
red = 900
green = 950
blue = 980
case "n"
wachstum = 2
red = 920
green = 970
blue = 990
case "s"
wachstum = 5
red = 950
green = 990
blue = 999
end select
end sub
sub menu()
dim as string key,key2
dim punkteA(1 to 10) as integer
dim nam(1 to 10) as string
dim laengeA(1 to 10) as integer
do
locate 21, 25 -12 :print "F1 = Neues Spiel starten"
locate 23, 25 -7 :print "Esc = Beenden"
locate 25, 25 -6 :Print "O = Optionen"
locate 27, 25 -9 :print "H = Highscoreliste"
do : sleep 1 : key = inkey : loop until key <>""
CLS
select case key
case chr(255,59) : spiel()
case chr(255,107) : end
case chr(27) : end
case "o" : optionen()
case "h" : list()
case else : continue do
end select
loop
end sub
sub spiel() ' AB HIER STARTET DAS SPIEL!!!!
dim punkte as integer
dim as integer speed = 130
dim as integer laenge = 1
dim as integer spielerY(1 to 9999)
dim as integer spielerX(1 to 9999)
dim as integer zeichnen, position, pruefen,pruefen2
dim as integer objektx, objekty,bonusX = -8, bonusY = -8,Bonus2X = -8, bonus2Y = -8
dim as integer bonus3x = -8,bonus3y = -8
dim as string key, newkey,ch
CLS
'grafiken initialisieren:
dim bonus as any ptr
bonus = imagecreate(8,8)
bload exepath + "/Bonus.bmp",bonus
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
dim bonus2 as any ptr
bonus2=imagecreate(8,8)
bload exepath + "/Bonus2.bmp",bonus2
dim bonus3 as any ptr
bonus3=imagecreate(8,8)
bload exepath + "/Bonus3.bmp",bonus3
dim black as any ptr
black =imagecreate(8,8,0)
'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
'futter:
screenunlock
if ((spielerX(1)-objektx)*(spielerX(1)-objektx) + (spielerY(1)-objekty)*(spielerY(1)-objekty)) < 60 then
laenge += Wachstum
Punkte += 10 * (laenge/ 1.5) * (wachstum/2)
if speed > 15 then speed -= wachstum
if speed < 15 then speed = 15 'wird benötigt falls die 15 unterschritten wird... unter 15 ist nicht mehr spielbar
if bonusx > 0 then put (bonusx ,bonusy ),black,pset
if bonus2x > 0 then put (bonus2x,bonus2y),black,pset
if bonus3x > 0 then put (bonus3x,bonus3y),black,pset
bonusx = -8
bonus2x = -8
bonus3x = -8
if laenge = 1 then put (spielerY(1),spielerX(1)),black,pset
randomize timer
if int(rnd*1000) > blue then 'blau
bonusX = int((rnd*48)+1)*8+8
bonusY = int((rnd*48)+1)*8+8
end if
if int(rnd*1000) > red then 'rot
bonus2X = int((rnd*48)+1)*8+8
bonus2Y = int((rnd*48)+1)*8+8
end if
if int(rnd*1000) > green then 'grün
bonus3X = int((rnd*48)+1)*8+8
bonus3Y = int((rnd*48)+1)*8+8
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
end if
if bonusy = spielery(pruefen) and bonusx = spielery(pruefen) then
bonusX = int((rnd*48)+1)*8+8
bonusY = int((rnd*48)+1)*8+8
end if
if bonus2y = spielery(pruefen) and bonus2x = spielery(pruefen) then
bonus2X = int((rnd*48)+1)*8+8
bonus2Y = int((rnd*48)+1)*8+8
end if
if bonus3y = spielery(pruefen) and bonus3x = spielery(pruefen) then
bonus3X = int((rnd*48)+1)*8+8
bonus3Y = int((rnd*48)+1)*8+8
end if
next pruefen2
continue do
end if
'bonus (blau):
if ((spielerX(1)-bonusx)*(spielerX(1)-bonusx) + (spielerY(1)-bonusy)*(spielerY(1)-bonusy)) < 60 then
speed -= wachstum
punkte += 200*(rnd*laenge+(laenge/2))
bonusy = -8
bonusx = -8
windowtitle punkte &" Punkte Laenge = "& laenge
end if
'Bonus2 (rot):
if ((spielerX(1)-bonus2x)*(spielerX(1)-bonus2x) + (spielerY(1)-bonus2y)*(spielerY(1)-bonus2y)) < 60 then
punkte += 5*(rnd*laenge)
bonus2y = -8
bonus2x = -8
windowtitle punkte &" Punkte Laenge = "& laenge
end if
'bonus3 (grün):
if ((spielerX(1)-bonus3x)*(spielerX(1)-bonus3x) + (spielerY(1)-bonus3y)*(spielerY(1)-bonus3y)) < 60 then
speed += 10
bonus3y = -8
bonus3x = -8
windowtitle punkte &" Punkte Laenge = "& laenge
end if
sleep speed,1
'tastendruck:
newkey = inkey
While Inkey<>"":ch=Inkey:Wend
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 else : key = key
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
'pruefen ob crash
for pruefen = 2 to laenge
if spielerX(1) = SpielerX(pruefen+1) and spielerY(1) = spielerY(pruefen+1) then
exit do
end if
next pruefen
'schlange ausgeben:
screenlock
if bonusx > 0 then put (bonusx,bonusy),bonus,pset
if bonus2x > 0 then put (bonus2x,bonus2y),bonus2,pset
if bonus3x > 0 then put (bonus3x,bonus3y),bonus3,pset
put (objektx,objekty),futter,pset
put (spielerX(1),spielerY(1)),grafik,pset
loop
cls
locate 25,20 : print "Game Over!" :
Locate 26,20 : print punkte & " Punkte!"
sleep : cls
highscore(punkte, laenge)
cls
menu()
end sub