Das deutsche QBasic- und FreeBASIC-Forum

[mkfezzo]

(hat sich erledigt...hab die Fehler gefunden! Wen's interessiert hier der funktionierende code)


Hi!
Habe beschlossen ein Projekt zu bearbeiten: Soll ein Weltraumhandelsspiel werden (ist noch weit davon entfernt), weil ich mich über Star Wolfes 2 geägert habe (gutes Spiel, gute Ansätze, kein Tiefgang und in 4h durchgespielt). Da ich zu faul bin Riesenmaps zu zeichnen, will ich diese generieren lassen, was auch klappt. Jeder Sektor wird, wenn noch nicht besucht neu generiert. Fliegt man zurück, sollte der Sektor zumindest das selbe Bild zeigen (Planeten an der selben Stelle). Klappt zur Hälfte. Das Raumschiff kann man mit der Maustaste lenken (linke Maustaste gedrückt halten). In X-Richtung funktioniert das. In der Y-Richtung jedoch so gar nicht! Obwohl die selbe Logik dahinter steckt. Hab ich einen an der Waffel (oder liegts an meinen Felddimensionen? (dim shared galax(1000,1000)???
Schaut mal rein und sagt mal was dazu.
[code]
randomize timer

dim shared galax(500,500) as string
dim shared as integer spx,spy
dim shared as integer locx,locy,xnew,ynew
dim shared as integer z,z1,z2,c,c1,c2,c3,c4,r,r1,t,x,y,x1,y1,mx,my,mr,ms,old,tim
dim shared as integer mov,i,bwec
dim shared as string a,tx,txt
dim shared hg(26,15) as integer
dim shared ship(26,15) as integer
dim shared ship1(26,15) as integer


sub drawspace (spx as integer, spy as integer)
'galax(spx,spy)="110010040220025030"
txt="":tx="":c=0=0:y=0:t=0
c=rnd(1)*50
c1=rnd(1)*50
c2=rnd(1)*50
for x=0 to 799

z=rnd(1)*10
if z=1 and c+1<256 then c=c+1
if z=2 and c1+1<256 then c1=c1+1
if z=3 and c2+1<256 then c2=c2+1
'if z=4 and c-1>-1 then c=c-1
'if z=5 and c1-1>-1 then c1=c1-1
'if z=6 and c2-1>-1 then c2=c2-1

line(x,0)-(x,599),rgb(c,c1,c2)
next x


z=(rnd(1)*4)+1
for t=1 to z*100
z1=rnd(1)*15
c=100+z1*10
x=(rnd(1)*799)+1
y=(rnd(1)*599)+1
r=rnd(1)*3
pset(x,y),rgb(c,c,c)
next t
t=0
do
x=(rnd(1)*790)+1
y=(rnd(1)*590)+1
c=point(x,y)
z=(rnd(1)*2)+1

if z=1 then
pset(x-1,y), rgb(250,250,250)
pset(x+1,y), rgb(250,250,250)
pset(x,y-1), rgb(250,250,250)
pset(x,y+1), rgb(250,250,250)
pset(x-2,y), rgb(200,200,200)
pset(x+2,y), rgb(200,200,200)
pset(x,y-2), rgb(200,200,200)
pset(x,y+2), rgb(200,200,200)
pset(x-3,y), rgb(150,150,150)
pset(x+3,y), rgb(150,150,150)
pset(x,y-3), rgb(150,150,150)
pset(x,y+3), rgb(150,150,150)
t=t+1
end if
if z=2 then
c1=rnd(1)*50+100
c2=rnd(1)*50+100
c3=rnd(1)*50+100

r=(rnd(1)*3)+1
if r=1 then
circle(x,y),2,rgb(c1,c2,c3),,,,f
circle(x,y),1,rgb(c1+30,c2+30,c3+30),,,,f
end if
if r=2 then
circle(x,y),3,rgb(c1,c2,c3),,,,f
circle(x,y),2,rgb(c1+20,c2+20,c3+20),,,,f
circle(x,y),1,rgb(c1+40,c2+40,c3+40),,,,f
end if
if r=3 then
circle(x,y),4,rgb(c1,c2,c3),,,,f
circle(x,y),3,rgb(c1+10,c2+10,c3+10),,,,f
circle(x,y),2,rgb(c1+20,c3+20,c3+20),,,,f
circle(x,y),1,rgb(c1+30,c2+30,c3+30),,,,f
end if
t=t+1
end if

loop until t=50

if galax(spx,spy)<>"" then
t=len(galax(spx,spy))
tx=galax(spx,spy)
'locate 2,1
for z=0 to (t/9)-1
i=val(mid(tx,z*9+1,1)):'? i
x=val(mid(tx,z*9+2,3)):'? x
y=val(mid(tx,z*9+5,3)):'? y
r1=val(mid(tx,z*9+8,2)):'? r1
c=int(rnd(1)*50)+100
for r=r1 to 1 step-1
circle(x,y),r,rgb(c,c,c),,,,f
c=c+2
next r
line(x-r1-10,y-r1-10)-(x-r1,y-r1),rgb(100,100,200),bf
next z

end if


if galax(spx,spy)="" then
old=0:t=0:txt=""
for x=50 to 750
z=int(rnd(1)*150)+1
if z=1 and x-old>100 then
y=int(rnd(1)*400)+100
r1=int(rnd(1)*40)+10
c=int(rnd(1)*50)+100
for r=r1 to 1 step-1
circle(x,y),r,rgb(c,c,c),,,,f
c=c+2
next r
old=x:t=t+1
line(x-r1-10,y-r1-10)-(x-r1,y-r1),rgb(100,100,200),bf

z1=int(rnd(1)*2)+1
tx=str(z1)
txt=txt+tx
tx=str(x)
txt=txt+tx
tx=str(y)
txt=txt+tx
tx=str(r1)
txt=txt+tx

galax(spx,spy)=txt
end if
next t

end if
'locate 1,1 galax(spx,spy),len(galax(spx,spy)),spx,spy
end sub



screen 19,32,,1
color rgb(200,200,200),rgb(0,0,0)
cls

c=160
line(0,0)-(24,14),rgb(255,0,255),bf
for y=3 to 12
line(3,y)-(23,7),rgb(c,c,c)
c=c+10
next y
line(6,6)-(8,,rgb(50,50,50),bf
get(0,0)-(24,14),ship
cls

c=250
line(0,0)-(24,14),rgb(255,0,255),bf
for y=3 to 12
line(3,y)-(23,7),rgb(c,c,c)
c=c-10
next y
line(6,6)-(8,,rgb(50,50,50),bf
get(0,0)-(24,14),ship1
cls

drawspace 250,250
spx=250:spy=250
locx=400:locy=300
get(locx,locy)-(locx+24,locy+14),hg
put(locx,locy),ship,trans
tim=-10
bwec=0
main:
do
getmouse mx,my,mr,ms
mov=0
a=inkey$
tim=tim+1
if tim=11 then tim=-10:bwec=0
if tim<0 then put(locx,locy),ship,trans:screensync
if tim>=0 then put(locx,locy),ship1,trans:screensync

if ms=1 and mov=0 and bwec=0 then xnew=mx:ynew=my:mov=1

if mov=1 then
put(locx,locy),hg,pset
if xnew<locx then locx=locx-1
if xnew>locx then locx=locx+1
if ynew<locy then locy=locy-1
if ynew>locy then locy=locy+1
get(locx,locy)-(locx+24,locy+14),hg
end if


if xnew=locx and ynew=locy then mov=0


if locx>770 and spx+1<=1000 and bwec=0 then
locx=30
mov=0
spx=spx+1
drawspace spx,spy

get(locx,locy)-(locx+24,locy+14),hg
bwec=1:goto main
end if
if locx<30 and spx-1>=0 and bwec=0 then
locx=770
mov=0
spx=spx-1
drawspace spx,spy

get(locx,locy)-(locx+24,locy+14),hg
bwec=1:goto main
end if

if locy>570 and spy+1<=1000 and bwec=0 then
locy=30:spy=spy+1
mov=0
drawspace spx,spy
get(locx,locy)-(locx+24,locy+14),hg
bwec=1
end if
if locy<30 and spy-1>=0 and bwec=0 then
locy=570:spy=spy-1
mov=0
drawspace spx,spy
get(locx,locy)-(locx+24,locy+14),hg
bwec=1
end if
loop until a=chr$(27)
end

[ytwinky]

Ich hatte ein (ziemlich böses) Statement schon fast fertig, da habe ich gesehen, daß das Problem ja schon gelöst ist..
So bleibt mir nur, anzumerken, daß der abschließende Code-Tag fehlt..
..dann wären die Goto-Anweisungen leichter zu finden, die verhindern, daß ich den Code kopieren und ausführen kann
Gruß
ytwinky
_________________