Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
LineXRider V1.34 Beta
| Uploader: |  AndT |
| Datum/Zeit: | 13.07.2008 12:27:29 |
' ----------------Dateiname:---------------------
' ----------LineXRider V1.34 Beta.bas------------
' -----------------------------------------------
'Auf dem Weg zur V2.0 ...
'Einstellungen
const w = 800
const h = 600
const colors = 8
const flag = 1
'Spiel Initalisieren
randomize timer
screenres w,h,colors,,flag
screenset 0,0
windowtitle "LineXRider V1.34 Beta - programmed by AndT"
dim as integer mx,my,mb,sr
dim as integer omx,omy
dim as integer px,py
dim as integer cp1,cp2
dim as string taste
dim shared as string gstr(1 to 10) ' //todo
dim shared as integer levelpunkte,highscore,actkpunkte
dim as integer x
dim as integer cmx,cmy
dim as integer level,g
dim shared as integer ende,goext,extt
dim as ubyte o
dim as integer renderthread,tt
DIM SHARED threadsync AS INTEGER
sub drawtimer
dim as integer x ,y
x = 720
y = 580
do
sleep 1
LINE (x,y)-(x+62,y+6),0,bf
DRAW STRING (x,y),TIME
if ende = 1 then PRINT "DRAWTIMER BEENDEN.." : exit do
loop
if ende = 1 then PRINT "ERLEDIGT" : goext = 1
end sub
sub beenden
cls
screenset 1,1
LOCATE 3,2
PRINT "WIRKLICH BEENDEN? (ESC= JA / ANDERE= NEIN)"
if ende = 0 then
dim as string eingabe = INPUT(1)
if asc(eingabe)=27 then ende = 1
end if
if ende = 1 then
sleep 100
PRINT "WARTE AUF ERLAUBNIS ZUM BEENDEN..."
dim as integer timeout = 250
do
sleep 1
timeout - = 1
if timeout <=0 then
Print "TIMEOUT! LINEXRIDER WIRD BEENDET":exit do
end if
loop until goext = 1
print "LINEXRIDER BEENDEN..."
sleep 100
end
end if
screenset 0,0
end sub
tt=threadcreate(@drawtimer) ' Zeit immer unten Rechts anzeigen
' ________________________________________________
' _____________________ Menü _____________________
' _________________________________________________
sub intro(level as integer , ix as integer , iy as integer)
dim as string introstrings(1 to 8) = { _
"AndT presentiert" , _
"LineXRider V1.34 Beta" , _
"Level mit Plus(+) unt Minus(-) einstellen und mit ENTER bestätigen" , _
"Level : " & str (level), _
"Beschreibung:" , _
"Das Spiel wird mit Maus gesteuert." , _
"Zeichne Wege mit der linken Maustaste und steuere" , _
"die weisße Linie in den gelben Kreis :-)" }
for i as integer = 1 to 8
draw string (ix,iy+(8*i)+1),introstrings(i)
next
end sub
sub control(byref Level as integer,byref Intro_Exit as integer)
dim as string taste = inkey
select case taste
case "+"
level+=1
case "-"
level-=1
case chr(13)
intro_exit = 1
case chr(27)
beenden
end select
if level > 100 then level = 100
if level < 0 then level = 0
end sub
dim as integer swx,swy,tsy = 524,tsx = 270,Intro_Exit
do
locate 10,1
select case swx
case 1
px+=1
case 0
px-=1
end select
select case swy
case 1
py+=1
case 0
py-=1
end select
if px < 1 then swx=1
if py < 1 then swy=1
if px > tsx then swx=0
if py > tsy then swy=0
intro (Level,px,py)
control(Level,Intro_Exit)
sleep 15
cls
loop until Intro_Exit = 1
color 15
' ____________________________________________________
' _____________________ End of Menü _________________________
' _____________________________________________________
sub render_text
draw string ( 8 , 7 ) ,gstr(10)
draw string ( 8 , 16 ) ,gstr(1)
draw string ( 8 , 25 ) ,gstr(2)
line (112,48)-(182,56),0,bf
DRAW STRING (8,48),"LEVELPUNKTE :"&str(LEVELPUNKTE)
DRAW STRING (8,39),gstr(4)
end sub
gstr(10) = "LineXRider V1.34 Beta"
rtr:
If Level = 0 Then Level = 1
cls
open "Highscore" for input as #1
input #1,Highscore
gstr(1) ="Highscore: " & str(HIGHSCORE)
gstr(2) = "DEINE PUNKTE:" & str(actkpunkte)
close #1
levelpunkte = 1000000000
' "Mauern" zeichnen
dim as integer scancol
cmx=w/2
cmy=0
o=1
cp1=int(rnd*w)+1
cp2=int(rnd*h)+1
for x= 1 to 20
circle (cp1,cp2),x,14
next
for x= 1 to Level
line (int(rnd*w),int(rnd*h))-(int(rnd*w),int(rnd*h)),4
next
gstr(4)="Level : " & str(level)
DO
levelpunkte -= (levelpunkte /100) 'Zeichen Engine
if sr >-1 then
omx=mx
omy=my
end if
getmouse mx, my, sr,mb
IF MB= 1 then LINE(mx,my)-(omx,omy),4
' Bedingungen für Trigger (überarbeitet)
if point (cmx,cmy+.5)=4 then
o = 1
else
if point (cmx+1,cmy)=4 then
o = 4
else
If point(cmx,cmy-1)=4 then
o = 2
else
if point (cmx-1,cmy)=4 then
o = 3
else
if point(cmx-1,cmy+1)=4 then
o=7
else
if point(cmx+1,cmy+1)=4 then
o=5
else
if point(cmx+1,cmy-1)=4 then
o=6
else
if point(cmx-1,cmy-1)=4 then
o=8
end if
end if
end if
end if
end if
end if
end if
end if
' Endscheidungen Ausführen (Trigger)
if point (cmx,cmy-1)=14 then PRINT "WINNER":g=1:exit do
if point (cmx,cmy+1)=14 then PRINT "WINNER":g=1:exit do
if point (cmx-1,cmy)=14 then PRINT "WINNER":g=1:exit do
if point (cmx+1,cmy)=14 then PRINT "WINNER":g=1:exit do
If o=1 then cmy+=1
If o=2 then cmy-=1
If o=3 then cmx-=1
If o=4 then cmx+=1
if o=5 then cmx+=1:cmy+=1
if o=7 then cmx-=1:cmy+=1
if o=6 then cmx+=1:cmy-=1
if o=8 then cmx-=1:cmy-=1
'bewegung=""
' Zeichnen
pset (cmx,cmy),15
sleep 10 ' Verhindert unnötige CPU-Auslastung
renderthread=threadcreate(@render_text,0)
if cmy=601 then exit do
if cmy=-1 then exit do
if cmx=-1 then exit do
if cmx>w then exit do
taste=inkey
loop until taste=chr(27)
' //TODO!!!
Print " LOSER!"
if Level > 100 Then Print "Du hast das Spiel durch und erhälst dafeur einen Bonus von 1000000 Punkte ;)":actkpunkte + = 1000000
if g=1 then
g=0:Level+=1
actkpunkte+=levelpunkte
goto rtr
end if
If actkpunkte > highscore then open "highscore" for output as #1:write #1,actkpunkte::Print "Highscore geknackt ;)":SLEEP : Close #1
cls
Print "Mit ESC beenden, Taste zum Neustart.."
sleep
taste = inkey
if taste = chr(27) then
beenden
else
'Neustart
Level=0:actkpunkte=0 : goto rtr
end if
Print "KRITISCHER FEHLER - Abbruch"
sleep 1000
ende = 1 : beenden