| Xonix - Clone 0.1 von ??? |
| Für Dirk, [code:1:37c9d7bf7f] ;============================================================== ;Game : Xonix - Clone ;Version : 0.1 ;Author : Andreas Sauer aka soli aka andsa ;Email : andsa@web.de ;Legal : (c) 2003 by Andreas Sauer ; Free use for educational purposes ; ;Control: Arrow Keys for moving ; RMB for Restart ; ;Note: Work in Progress, not optimized, ; some varis ar not necessary ;============================================================== Graphics 800,400,16,2 SeedRnd MilliSecs() Function vari() End Function Dim feld(41,21) Dim testfeld(1000); absichtlich übergroß dimensioniert Global bild Global ichx, ichy , oldx, oldy, bewa, bewb Global startx, starty, minx, maxx, miny, maxy Global feldbreit=40 , feldhoch=20 Global tilebreit=20 , tilehoch=20 Global leer=0, frei=1, spur=2, kontrollvari=3, found Global punkte=0, leben=5 Type tile Field x Field y End Type .datarichtung Dim richtung(3,2) Restore datarichtung For x=0 To 3 Read richtung(x,1) : Read richtung(x,2) Next Data 0,-1,+1,0,0,+1,-1,0 init() main() Function main() While Not KeyDown(1) AppTitle punkte steuerung() updateboard() Flip Wend End End Function Function init() zufallsbild() SetBuffer BackBuffer() Dim feld(feldbreit+1,feldhoch+1) ichx=1 : ichy=1 : bewa=0 : bewb=0 punkte=0 : leben=5 ;step lässt sich leider nicht in variablen eingeben For y=1 To feldhoch Step 19 ; waagerechter rand For x=1 To feldbreit feld(x,y)=1 Next Next For y=1 To feldhoch ; senkrechter rand For x=1 To 40 Step 39 feld(x,y)=1 Next Next End Function Function updateboard() Cls DrawBlock bild,0,0 For y=1 To feldhoch For x= 1 To feldbreit Select feld(x,y) Case 1 ; nichts Case 0 Color 0,0,0 Case 2 Color 0,0,200 Default Color 0,feld(x,y)*30,0 End Select If feld(x,y) <> 1 Rect (x-1)*tilebreit,(y-1)*tilehoch,tilebreit,tilehoch,1 Color 255,255,255 Text (x-1)*tilebreit,(y-1)*tilehoch,feld(x,y) EndIf Next Next Color 200,0,0 Rect (ichx-1)*tilebreit,(ichy-1)*tilehoch,tilebreit,tilehoch,1 End Function Function zufallsbild() ;bild=LoadImage("d:/eigene dateien/eigene bilder/vinca.jpg") ;Return bild=CreateImage(800,400) SetBuffer ImageBuffer(bild) For z=1 To 100 Color Rand(255),Rand(255),Rand(255) Rect Rand(0,800),Rand(0,600),Rand(0,800),Rand(0,600),1 Next End Function Function steuerung() oldx=ichx oldy=ichy If MouseHit(2)>0 ; neustart init() EndIf a=KeyDown(205)-KeyDown(203) b=KeyDown(208)-KeyDown(200) If (bewa + a=0) And (bewb + b=0) And feld(ichx,ichy)=spur; umkehr verhindern ichx=oldx : ichy=oldy Return ; oder auch init() = neustart ; besser spur auflösen EndIf If a<>0 Or b<>0 ; alte Bewegung festhalten bewa=a bewb=b*(a=0) EndIf ichx=limit(ichx+a,1,feldbreit) ichy=limit(ichy+(b *(a=0)),1,feldhoch) If (a<>0 Or b<>0) And feld(ichx,ichy)=spur ; orignalregel untersagt eigene Spur zu berühren leben=leben-1 spurloeschen() ichx=1 : ichy=1 If leben<=0 gameover() EndIf Return EndIf If (feld(ichx,ichy)=frei Or feld(ichx,ichy)=spur) And (ichx<>oldx Or ichy<>oldy) And (feld(oldx,oldy)=spur); kollission kontrolle() EndIf If feld(ichx,ichy)=leer If feld(oldx,oldy)=frei startx=ichx starty=ichy minx=startx maxx=startx miny=starty miny=starty EndIf ; mit diesen Werten könnte man den Scanbereich einschränken If ichx>maxx maxx=ichx EndIf If ichx<minx minx=ichx EndIf If ichy>maxy maxy=ichy EndIf If ichy<miny miny=ichy EndIf feld(ichx,ichy)=spur EndIf Delay 30 ; nur zum test End Function Function kontrolle() kontrollvari=3 For y=1 To feldhoch For x=1 To feldbreit If feld(x,y)=0 absuchen(x,y) If found>1 kontrollvari=kontrollvari+1 EndIf EndIf Next Next umkreist=checkumkreist() punkte=0 For y=1 To feldhoch For x=1 To feldbreit If feld(x,y)<>umkreist Or feld(x,y)=spur feld(x,y)=1 Else If feld(x,y)>=3 feld(x,y)=0 EndIf If feld(x,y)=1 punkte=punkte+1 EndIf Next Next If punkte>=feldbreit*feldhoch*80/100 ; Sieggrenze erreicht For y=1 To feldhoch For x=1 To feldbreit feld(x,y)=1 ; Bild vollständig zeigen Next Next updateboard() Flip AppTitle "Klicke für Neustart" FlushMouse() While MouseHit(1)<1 Wend init(); neustart EndIf End Function Function checkumkreist() ; alle flächen ausser der größten werden als füllbar ausgewiesen ; muß überarbeitet werden ; soll nur das letze umrundete Feld gefuellt werden, ; so müsste man Nähe zur Spur oder Standort checken. Dim testfeld(1000); absichtlich übergroß dimensioniert For y=1 To feldhoch For x=1 To feldbreit testfeld(feld(x,y))=testfeld(feld(x,y))+1 Next Next tmpvari=3 anzahlvari=0 For z=tmpvari To kontrollvari-1 If testfeld(z)>anzahlvari ; checkt nur auf groesstes feld tmpvari=z anzahlvari=testfeld(z) EndIf Next Return tmpvari End Function Function absuchen(a,b) zustand=feld(a,b) found=0 wo.tile=New tile wox=a woy=b Repeat For wo.tile = Each tile tmpx=wox tmpy=woy feld(wox,woy)=kontrollvari Delete wo For x=0 To 3 If feld(tmpx+richtung(x,1),tmpy+richtung(x,2))=zustand found=found+1 wo.tile=New tile wox=tmpx+richtung(x,1) woy=tmpy+richtung(x,2) feld(tmpx+richtung(x,1),tmpy+richtung(x,2))=kontrollvari EndIf Next Next wo.tile=First tile Until wo=Null End Function Function spurloeschen() For y=1 To feldhoch For x=1 To feldbreit If feld(x,y)=2 feld(x,y)=0 EndIf Next Next End Function Function gameover() ; Spielende ; Highscore End Function Function limit(a,low,high) If a<low Then a=low If a>high Then a=high Return a End Function [/code:1:37c9d7bf7f] mfg, soli |
| von ??? |
| Hallo Soli, Danke daß Du Dir die Arbeit gemacht hast. Das läuft ja schon ganz gut. Ich werde mich nacher mal durch den SourceCode arbeiten, um das alles nachverfolgen zu können. Ich kann mich allerdingst erst morgen wieder melden. Gruß, Dirk |