4k - Minigame Labyrinth

    Diese Seite verwendet Cookies. Durch die Nutzung unserer Seite erklären Sie sich damit einverstanden, dass wir Cookies setzen. Weitere Informationen

    Unsere Datenschutzerklärung wurde aktualisiert. Mit der Nutzung unseres Forums akzeptierst Du unsere Datenschutzerklärung. Du bestätigst zudem, dass Du mindestens 16 Jahre alt bist.

    • 4k - Minigame Labyrinth

      Hi, nun mein 2 Beitrag für den Wettbewerb.

      ein kleines Minigame ;-)

      [Blockierte Grafik: http://s7.postimage.org/407pj3kp3/Screen_08_03_2013_14_Uhr_39_53_Sek.jpg]

      Steuerung über W,S,D,A. + Cursortasten.
      Farberklärung: Weiß > Spieler , Grau > Wand , > Braun Boden

      Es läuft ein Zeit im Spiel um ein kleines Wettrennen machen zu können ;-)
      Viel spaß möge der schnellste gewinnen.


      Update:
      Code nochmal bischen verändert danke an Frabbing ;-)
      - Flackern beseitigt.
      - Spur hinzugefügt.
      - Cursortasten hinzugefügt.

      Quellcode

      1. Window 0,0-500,500
      2. WindowTitle "Labyrinth"
      3. Var l%=0
      4. Declare z%,k$[],e%,pos%,w%,pxb%,pyb%,px%,py%
      5. Randomize
      6. Proc Newgame
      7. Cls
      8. UseBrush 1,0
      9. Rectangle 100,100-400,350
      10. WhileLoop 20
      11. k$[&loop]="11111111111111111111"
      12. EndWhile
      13. px%=Rnd(9)+7
      14. py%=Rnd(8)+7
      15. pxb%=px%
      16. pyb%=py%
      17. WhileLoop 2*l%
      18. w%=Rnd(5)+4
      19. pos% = Rnd(80)
      20. If pos% <= 20
      21. WhileLoop w%
      22. k$[py%] = Del$(k$[py%],px%,1)
      23. k$[py%] = Ins$("0",k$[py%],px%)
      24. Case py% > 2 : Dec py%
      25. EndWhile
      26. ElseIf (pos% <= 40) And (pos% > 20)
      27. WhileLoop w%
      28. k$[py%] = Del$(k$[py%],px%,1)
      29. k$[py%] = Ins$("0",k$[py%],px%)
      30. Case px% <= 18 : Inc px%
      31. EndWhile
      32. ElseIf (pos% <= 60) And (pos% > 40)
      33. WhileLoop w%
      34. k$[py%] = Del$(k$[py%],px%,1)
      35. k$[py%] = Ins$("0",k$[py%],px%)
      36. Case py% <= 18 : Inc py%
      37. EndWhile
      38. ElseIf (pos% <= 80) And (pos% > 60)
      39. WhileLoop w%
      40. k$[py%] = Del$(k$[py%],px%,1)
      41. k$[py%] = Ins$("0",k$[py%],px%)
      42. Case px% > 3 : Dec px%
      43. EndWhile
      44. EndIf
      45. EndWhile
      46. k$[py%] = Del$(k$[py%],px%,1)
      47. k$[py%] = Ins$("0",k$[py%],px%)
      48. k$[pyb%] = Del$(k$[pyb%],pxb%,1)
      49. k$[pyb%] = Ins$("x",k$[pyb%],pxb%)
      50. e%=1
      51. z%=0
      52. SetTimer 1000
      53. EndProc
      54. Proc Anzeige
      55. If e%=1
      56. UseBrush 0,45
      57. Rectangle 20,20-470,430
      58. UseBrush 1,Rgb(250,250,250)
      59. Rectangle 100+(px%*10),100+(py%*10)-110+(px%*10),110+(py%*10)
      60. UseBrush 1,Rgb(60,60,60)
      61. Case @Mid$(k$[py%-1],px%,1) = "1" : Rectangle 100+(px%*10),90+(py%*10)-110+(px%*10),100+(py%*10)
      62. Case @Mid$(k$[py%+1],px%,1) = "1" : Rectangle 100+(px%*10),110+(py%*10)-110+(px%*10),120+(py%*10)
      63. Case @Mid$(k$[py%],px%+1,1) = "1" : Rectangle 110+(px%*10),100+(py%*10)-120+(px%*10),110+(py%*10)
      64. Case @Mid$(k$[py%],px%-1,1) = "1" : Rectangle 90+(px%*10),100+(py%*10)-100+(px%*10),110+(py%*10)
      65. UseBrush 1,Rgb(90,30,30)
      66. Case @Mid$(k$[py%-1],px%,1) = "0" : Rectangle 100+(px%*10),90+(py%*10)-110+(px%*10),100+(py%*10)
      67. Case @Mid$(k$[py%+1],px%,1) = "0" : Rectangle 100+(px%*10),110+(py%*10)-110+(px%*10),120+(py%*10)
      68. Case @Mid$(k$[py%],px%+1,1) = "0" : Rectangle 110+(px%*10),100+(py%*10)-120+(px%*10),110+(py%*10)
      69. Case @Mid$(k$[py%],px%-1,1) = "0" : Rectangle 90+(px%*10),100+(py%*10)-100+(px%*10),110+(py%*10)
      70. UseBrush 1,Rgb(190,0,00)
      71. Case @Mid$(k$[py%-1],px%,1) = "x" : Rectangle 100+(px%*10),90+(py%*10)-110+(px%*10),100+(py%*10)
      72. Case @Mid$(k$[py%+1],px%,1) = "x" : Rectangle 100+(px%*10),110+(py%*10)-110+(px%*10),120+(py%*10)
      73. Case @Mid$(k$[py%],px%+1,1) = "x" : Rectangle 110+(px%*10),100+(py%*10)-120+(px%*10),110+(py%*10)
      74. Case @Mid$(k$[py%],px%-1,1) = "x" : Rectangle 90+(px%*10),100+(py%*10)-100+(px%*10),110+(py%*10)
      75. Case %wmtimer:Inc z%
      76. TextColor @Rgb(15,15,31),@Rgb(255,255,255),
      77. If @Mid$(k$[py%],px%,1) = "x"
      78. DrawText 30,40,"Du bist im Ziel angekommen Zeit: "+Str$(z%)+" Sekunden"
      79. DrawText 150,200,"Neues Spiel mit der Leertaste."
      80. WaitInput
      81. Inc l%
      82. e%=2
      83. EndIf
      84. ElseIf l%>=20
      85. DrawText 150,220,"Spielende! Vielen dank fürs Spielen."
      86. l%=0
      87. Else
      88. DrawText 150,200,"Neues Spiel mit der Leertaste."
      89. EndIf
      90. DrawText 30,0,"Labyrinth Level:"+Str$(l%)
      91. DrawText 350,30,"Zeit für Level:"+Str$(z%) : DrawText 30,410,"Symbole Weiß: Spieler|Grau: Mauer|Braun: Boden|ROT: Ziel"
      92. DrawText 30,390,"(Q)uit | Steuerung: W/S/D/A+cursor Tasten | Leertaste: Neues Spiel"
      93. EndProc
      94. Proc Getposition
      95. Parameters x%,y%
      96. Return @Mid$(k$[py%+y%],px%+x%,1)
      97. EndProc
      98. While 1
      99. Anzeige()
      100. WaitInput
      101. If l%>0
      102. If Iskey(87) Or Iskey(38)
      103. If ((Getposition(0,-1) = "0") Or (Getposition(0,-1) = "x"))
      104. Dec py%
      105. EndIf
      106. ElseIf Iskey(68) Or Iskey(39)
      107. If ((Getposition(1,0) = "0") Or (Getposition(1,0) = "x"))
      108. Inc px%
      109. EndIf
      110. ElseIf Iskey(83) Or Iskey(40)
      111. If ((Getposition(0,1) = "0") Or (Getposition(0,+1) = "x"))
      112. Inc py%
      113. EndIf
      114. ElseIf Iskey(65) Or Iskey(37)
      115. If ((Getposition(-1,0) = "0") Or (Getposition(-1,0) = "x"))
      116. Dec px%
      117. EndIf
      118. EndIf
      119. EndIf
      120. If Iskey(32)
      121. Case l%=0 : l%=1
      122. Newgame
      123. EndIf
      124. If Iskey(81)
      125. BREAK
      126. EndIf
      127. EndWhile
      128. KillTimer
      129. End
      Alles anzeigen
      Gruß,
      Johannes



      Programmiert in Profan X2
      Gravity 2
    • Ah, du hattest deinen Beitrag überarbeitet, nicht gesehen. :-)

      Ich finde das Spiel so nun sinnvoller, Flackern ist auch weg. Und ohne die Spur wäre es auch viel zu schwer. :top2:
      Etwas Sound wäre vielleicht noch sinnvoll.

      Nach einiger Zeit spielen erhalte ich leider noch einen Abbruch durch eine Warnung:

      [Blockierte Grafik: http://s7.postimage.org/4eq1fh6mv/Screen_20_02_2013_11_Uhr_01_49_Sek.jpg]
      Gruß, Frank
    • Fehler beseitigt. Für Ton habe ich leider kein Platz mehr ^^

      Update:

      Quellcode

      1. Window 0,0-500,500
      2. WindowTitle "Labyrinth von True29"
      3. var level%=1
      4. var posx%=2
      5. var posy%=1
      6. Declare zeit%,karte$[],end%
      7. karte$[0]="111111111111111111111"
      8. karte$[1]="1000000000100010000x1"
      9. karte$[2]="101110111010101010111"
      10. karte$[3]="100000000010101011111"
      11. karte$[4]="101110111110000000001"
      12. karte$[5]="101010101000101010101"
      13. karte$[6]="100000000010001010001"
      14. karte$[7]="101110111010101010101"
      15. karte$[8]="100000000010101010101"
      16. karte$[9]="101110111110000000111"
      17. karte$[10]="111101111110001110111"
      18. karte$[11]="100000000010001010001"
      19. karte$[12]="101110111010101010111"
      20. karte$[13]="100000000010101010111"
      21. karte$[14]="101110111010000000001"
      22. karte$[15]="100000000000101010101"
      23. karte$[16]="100000000010001010001"
      24. karte$[17]="101110111000001010111"
      25. karte$[18]="101111100010101010111"
      26. karte$[19]="100000111110000000001"
      27. karte$[20]="111111111111111111111"
      28. SetTimer 1000
      29. Proc Anzeige
      30. UseBrush 1,Rgb(250,250,250)
      31. Rectangle 100+(posx%*10),100+(posy%*10)-110+(posx%*10),110+(posy%*10)
      32. UseBrush 1,Rgb(60,60,60)
      33. Case @Mid$(karte$[posy%-1],posx%,1) = "1" : Rectangle 100+(posx%*10),90+(posy%*10)-110+(posx%*10),100+(posy%*10)
      34. Case @Mid$(karte$[posy%+1],posx%,1) = "1" : Rectangle 100+(posx%*10),110+(posy%*10)-110+(posx%*10),120+(posy%*10)
      35. Case @Mid$(karte$[posy%],posx%+1,1) = "1" : Rectangle 110+(posx%*10),100+(posy%*10)-120+(posx%*10),110+(posy%*10)
      36. Case @Mid$(karte$[posy%],posx%-1,1) = "1" : Rectangle 90+(posx%*10),100+(posy%*10)-100+(posx%*10),110+(posy%*10)
      37. UseBrush 1,Rgb(90,30,30)
      38. Case @Mid$(karte$[posy%-1],posx%,1) = "0" : Rectangle 100+(posx%*10),90+(posy%*10)-110+(posx%*10),100+(posy%*10)
      39. Case @Mid$(karte$[posy%+1],posx%,1) = "0" : Rectangle 100+(posx%*10),110+(posy%*10)-110+(posx%*10),120+(posy%*10)
      40. Case @Mid$(karte$[posy%],posx%+1,1) = "0" : Rectangle 110+(posx%*10),100+(posy%*10)-120+(posx%*10),110+(posy%*10)
      41. Case @Mid$(karte$[posy%],posx%-1,1) = "0" : Rectangle 90+(posx%*10),100+(posy%*10)-100+(posx%*10),110+(posy%*10)
      42. UseBrush 1,Rgb(190,0,00)
      43. Case @Mid$(karte$[posy%-1],posx%,1) = "x" : Rectangle 100+(posx%*10),90+(posy%*10)-110+(posx%*10),100+(posy%*10)
      44. Case @Mid$(karte$[posy%+1],posx%,1) = "x" : Rectangle 100+(posx%*10),110+(posy%*10)-110+(posx%*10),120+(posy%*10)
      45. Case @Mid$(karte$[posy%],posx%+1,1) = "x" : Rectangle 110+(posx%*10),100+(posy%*10)-120+(posx%*10),110+(posy%*10)
      46. Case @Mid$(karte$[posy%],posx%-1,1) = "x" : Rectangle 90+(posx%*10),100+(posy%*10)-100+(posx%*10),110+(posy%*10)
      47. Case %wmTimer:Inc zeit%
      48. TextColor @Rgb(15,15,31),@Rgb(255,255,255),
      49. If @Mid$(karte$[posy%],posx%,1) = "x"
      50. DrawText 30,40,"Du bist im Ziel angekommen Zeit: "+Str$(zeit%)+" Sekunden"
      51. WaitInput
      52. End%=1
      53. EndIf
      54. DrawText 30,390,"(Q)uit | Steuerung: W/S/D/A+Cursor Tasten | Zeit für Level:"+Str$(zeit%)
      55. EndProc
      56. Proc Getposition
      57. Parameters x%,y%
      58. Return @Mid$(karte$[posy%+y%],posx%+x%,1)
      59. EndProc
      60. UseBrush 0,45
      61. Rectangle 20,20-470,430
      62. TextColor 0,-1
      63. DrawText 30,0,"Labyrinth Level:"+Str$(level%)
      64. UseBrush 1,0
      65. Rectangle 100,100-400,350
      66. While End%=0
      67. Anzeige()
      68. WaitInput
      69. If IsKey(87) Or IsKey(38)
      70. If ((Getposition(0,-1) = "0") Or (Getposition(0,-1) = "x"))
      71. Dec posy%
      72. EndIf
      73. ElseIf IsKey(68) Or Iskey(39)
      74. If ((Getposition(1,0) = "0") Or (Getposition(1,0) = "x"))
      75. Inc posx%
      76. EndIf
      77. ElseIf Iskey(83) Or IsKey(40)
      78. If ((Getposition(0,1) = "0") Or (Getposition(0,+1) = "x"))
      79. Inc posy%
      80. EndIf
      81. ElseIf IsKey(65) Or IsKey(37)
      82. If ((Getposition(-1,0) = "0") Or (Getposition(-1,0) = "x"))
      83. Dec posx%
      84. EndIf
      85. EndIf
      86. If IsKey(81)
      87. inc End%
      88. EndIf
      89. EndWhile
      90. KillTimer
      91. End
      Alles anzeigen
      Gruß,
      Johannes



      Programmiert in Profan X2
      Gravity 2
    • Bin gerade auch dabei das so umzubauen das es zufallsgenerierte Levels gibt.
      Is auch so weit fertig hat leider nur noch einen kleinen Fehler.

      nun gut egal hier schon mal der Code zu 90% taucht der Fehler nicht auf ^^ und wenn dann Zeigt er sich dadurch das man das Ziel nicht erreichen kann xD
      Vielleicht finde ich noch den Fehler dann gibts ein Update.


      Variante mit zufallsgenerierte Levels:
      Mit jedem Level wird das Labyrinth etwas komplizierter.


      Quellcode

      1. Window 0,0-500,500
      2. WindowTitle "Labyrinth"
      3. var l%=1
      4. Declare z%,k$[],e%,pos%,w%,pxb%,pyb%,px%,py%
      5. Randomize
      6. Proc Newgame
      7. cls
      8. UseBrush 1,0
      9. Rectangle 100,100-400,350
      10. WhileLoop 20
      11. k$[&loop]="11111111111111111111"
      12. EndWhile
      13. px%=rnd(6)+7
      14. py%=rnd(6)+7
      15. pxb%=px%
      16. pyb%=py%
      17. WhileLoop 3*l%
      18. w%=rnd(5)+2
      19. pos% = rnd(80)
      20. If pos% <= 20
      21. WhileLoop w%
      22. k$[py%] = del$(k$[py%],px%,1)
      23. k$[py%] = Ins$("0",k$[py%],px%)
      24. Case py% > 2 : Dec py%
      25. EndWhile
      26. ElseIf (pos% <= 40) And (pos% > 20)
      27. WhileLoop w%
      28. k$[py%] = del$(k$[py%],px%,1)
      29. k$[py%] = Ins$("0",k$[py%],px%)
      30. Case px% <= 18 : inc px%
      31. EndWhile
      32. ElseIf (pos% <= 60) And (pos% > 40)
      33. WhileLoop w%
      34. k$[py%] = del$(k$[py%],px%,1)
      35. k$[py%] = Ins$("0",k$[py%],px%)
      36. Case py% <= 18 : Inc py%
      37. EndWhile
      38. ElseIf (pos% <= 80) And (pos% > 60)
      39. WhileLoop w%
      40. k$[py%] = del$(k$[py%],px%,1)
      41. k$[py%] = Ins$("0",k$[py%],px%)
      42. Case px% > 3 : Dec px%
      43. EndWhile
      44. EndIf
      45. EndWhile
      46. k$[py%] = del$(k$[py%],px%,1)
      47. k$[py%] = Ins$("0",k$[py%],px%)
      48. k$[pyb%] = del$(k$[pyb%],1,1)
      49. k$[pyb%] = Ins$("x",k$[pyb%],pxb%)
      50. e%=1
      51. z%=0
      52. SetTimer 1000
      53. EndProc
      54. Proc Anzeige
      55. If e%=1
      56. UseBrush 0,45
      57. Rectangle 20,20-470,430
      58. UseBrush 1,Rgb(250,250,250)
      59. Rectangle 100+(px%*10),100+(py%*10)-110+(px%*10),110+(py%*10)
      60. UseBrush 1,Rgb(60,60,60)
      61. Case @Mid$(k$[py%-1],px%,1) = "1" : Rectangle 100+(px%*10),90+(py%*10)-110+(px%*10),100+(py%*10)
      62. Case @Mid$(k$[py%+1],px%,1) = "1" : Rectangle 100+(px%*10),110+(py%*10)-110+(px%*10),120+(py%*10)
      63. Case @Mid$(k$[py%],px%+1,1) = "1" : Rectangle 110+(px%*10),100+(py%*10)-120+(px%*10),110+(py%*10)
      64. Case @Mid$(k$[py%],px%-1,1) = "1" : Rectangle 90+(px%*10),100+(py%*10)-100+(px%*10),110+(py%*10)
      65. UseBrush 1,Rgb(90,30,30)
      66. Case @Mid$(k$[py%-1],px%,1) = "0" : Rectangle 100+(px%*10),90+(py%*10)-110+(px%*10),100+(py%*10)
      67. Case @Mid$(k$[py%+1],px%,1) = "0" : Rectangle 100+(px%*10),110+(py%*10)-110+(px%*10),120+(py%*10)
      68. Case @Mid$(k$[py%],px%+1,1) = "0" : Rectangle 110+(px%*10),100+(py%*10)-120+(px%*10),110+(py%*10)
      69. Case @Mid$(k$[py%],px%-1,1) = "0" : Rectangle 90+(px%*10),100+(py%*10)-100+(px%*10),110+(py%*10)
      70. UseBrush 1,Rgb(190,0,00)
      71. Case @Mid$(k$[py%-1],px%,1) = "x" : Rectangle 100+(px%*10),90+(py%*10)-110+(px%*10),100+(py%*10)
      72. Case @Mid$(k$[py%+1],px%,1) = "x" : Rectangle 100+(px%*10),110+(py%*10)-110+(px%*10),120+(py%*10)
      73. Case @Mid$(k$[py%],px%+1,1) = "x" : Rectangle 110+(px%*10),100+(py%*10)-120+(px%*10),110+(py%*10)
      74. Case @Mid$(k$[py%],px%-1,1) = "x" : Rectangle 90+(px%*10),100+(py%*10)-100+(px%*10),110+(py%*10)
      75. Case %wmTimer:Inc z%
      76. TextColor @Rgb(15,15,31),@Rgb(255,255,255),
      77. If @Mid$(k$[py%],px%,1) = "x"
      78. DrawText 30,40,"Du bist im Ziel angekommen Zeit: "+Str$(z%)+" Sekunden"
      79. DrawText 150,200,"Neues Spiel mit der Leertaste."
      80. WaitInput
      81. Inc l%
      82. e%=2
      83. EndIf
      84. Else
      85. DrawText 150,200,"Neues Spiel mit der Leertaste."
      86. EndIf
      87. DrawText 30,0,"Labyrinth Level:"+Str$(l%)
      88. DrawText 350,30,"Zeit für Level:"+Str$(z%) : DrawText 30,410,"Symbole Weiß: Spieler|Grau: Mauer|Braun: Boden|ROT: Ziel"
      89. DrawText 30,390,"(Q)uit | Steuerung: W/S/D/A+Cursor Tasten | Leertaste: Neues Spiel"
      90. EndProc
      91. Proc Getposition
      92. Parameters x%,y%
      93. Return @Mid$(k$[py%+y%],px%+x%,1)
      94. EndProc
      95. While 1
      96. Anzeige()
      97. WaitInput
      98. If IsKey(87) Or IsKey(38)
      99. If ((Getposition(0,-1) = "0") Or (Getposition(0,-1) = "x"))
      100. Dec py%
      101. EndIf
      102. ElseIf IsKey(68) Or Iskey(39)
      103. If ((Getposition(1,0) = "0") Or (Getposition(1,0) = "x"))
      104. Inc px%
      105. EndIf
      106. ElseIf Iskey(83) Or IsKey(40)
      107. If ((Getposition(0,1) = "0") Or (Getposition(0,+1) = "x"))
      108. Inc py%
      109. EndIf
      110. ElseIf IsKey(65) Or IsKey(37)
      111. If ((Getposition(-1,0) = "0") Or (Getposition(-1,0) = "x"))
      112. Dec px%
      113. EndIf
      114. EndIf
      115. If IsKey(32)
      116. Newgame
      117. EndIf
      118. If IsKey(81)
      119. BREAK
      120. EndIf
      121. EndWhile
      122. KillTimer
      123. End
      Alles anzeigen
      Gruß,
      Johannes



      Programmiert in Profan X2
      Gravity 2
    • Der kleine Fehler wurde behoben.

      Quellcode

      1. Window 0,0-500,500
      2. WindowTitle "Labyrinth"
      3. var l%=0
      4. Declare z%,k$[],e%,pos%,w%,pxb%,pyb%,px%,py%
      5. Randomize
      6. Proc Newgame
      7. cls
      8. UseBrush 1,0
      9. Rectangle 100,100-400,350
      10. WhileLoop 20
      11. k$[&loop]="11111111111111111111"
      12. EndWhile
      13. px%=rnd(6)+7
      14. py%=rnd(6)+7
      15. pxb%=px%
      16. pyb%=py%
      17. WhileLoop 3*l%
      18. w%=rnd(5)+2
      19. pos% = rnd(80)
      20. If pos% <= 20
      21. WhileLoop w%
      22. k$[py%] = Del$(k$[py%],px%,1)
      23. k$[py%] = Ins$("0",k$[py%],px%)
      24. Case py% > 2 : Dec py%
      25. EndWhile
      26. ElseIf (pos% <= 40) And (pos% > 20)
      27. WhileLoop w%
      28. k$[py%] = del$(k$[py%],px%,1)
      29. k$[py%] = Ins$("0",k$[py%],px%)
      30. Case px% <= 18 : inc px%
      31. EndWhile
      32. ElseIf (pos% <= 60) And (pos% > 40)
      33. WhileLoop w%
      34. k$[py%] = del$(k$[py%],px%,1)
      35. k$[py%] = Ins$("0",k$[py%],px%)
      36. Case py% <= 18 : Inc py%
      37. EndWhile
      38. ElseIf (pos% <= 80) And (pos% > 60)
      39. WhileLoop w%
      40. k$[py%] = del$(k$[py%],px%,1)
      41. k$[py%] = Ins$("0",k$[py%],px%)
      42. Case px% > 3 : Dec px%
      43. EndWhile
      44. EndIf
      45. EndWhile
      46. k$[py%] = del$(k$[py%],px%,1)
      47. k$[py%] = Ins$("0",k$[py%],px%)
      48. k$[pyb%] = del$(k$[pyb%],1,1)
      49. k$[pyb%] = Ins$("x",k$[pyb%],pxb%)
      50. e%=1
      51. z%=0
      52. SetTimer 1000
      53. EndProc
      54. Proc Anzeige
      55. If e%=1
      56. UseBrush 0,45
      57. Rectangle 20,20-470,430
      58. UseBrush 1,Rgb(250,250,250)
      59. Rectangle 100+(px%*10),100+(py%*10)-110+(px%*10),110+(py%*10)
      60. UseBrush 1,Rgb(60,60,60)
      61. Case @Mid$(k$[py%-1],px%,1) = "1" : Rectangle 100+(px%*10),90+(py%*10)-110+(px%*10),100+(py%*10)
      62. Case @Mid$(k$[py%+1],px%,1) = "1" : Rectangle 100+(px%*10),110+(py%*10)-110+(px%*10),120+(py%*10)
      63. Case @Mid$(k$[py%],px%+1,1) = "1" : Rectangle 110+(px%*10),100+(py%*10)-120+(px%*10),110+(py%*10)
      64. Case @Mid$(k$[py%],px%-1,1) = "1" : Rectangle 90+(px%*10),100+(py%*10)-100+(px%*10),110+(py%*10)
      65. UseBrush 1,Rgb(90,30,30)
      66. Case @Mid$(k$[py%-1],px%,1) = "0" : Rectangle 100+(px%*10),90+(py%*10)-110+(px%*10),100+(py%*10)
      67. Case @Mid$(k$[py%+1],px%,1) = "0" : Rectangle 100+(px%*10),110+(py%*10)-110+(px%*10),120+(py%*10)
      68. Case @Mid$(k$[py%],px%+1,1) = "0" : Rectangle 110+(px%*10),100+(py%*10)-120+(px%*10),110+(py%*10)
      69. Case @Mid$(k$[py%],px%-1,1) = "0" : Rectangle 90+(px%*10),100+(py%*10)-100+(px%*10),110+(py%*10)
      70. UseBrush 1,Rgb(190,0,00)
      71. Case @Mid$(k$[py%-1],px%,1) = "x" : Rectangle 100+(px%*10),90+(py%*10)-110+(px%*10),100+(py%*10)
      72. Case @Mid$(k$[py%+1],px%,1) = "x" : Rectangle 100+(px%*10),110+(py%*10)-110+(px%*10),120+(py%*10)
      73. Case @Mid$(k$[py%],px%+1,1) = "x" : Rectangle 110+(px%*10),100+(py%*10)-120+(px%*10),110+(py%*10)
      74. Case @Mid$(k$[py%],px%-1,1) = "x" : Rectangle 90+(px%*10),100+(py%*10)-100+(px%*10),110+(py%*10)
      75. Case %wmTimer:Inc z%
      76. TextColor @Rgb(15,15,31),@Rgb(255,255,255),
      77. If @Mid$(k$[py%],px%,1) = "x"
      78. DrawText 30,40,"Du bist im Ziel angekommen Zeit: "+Str$(z%)+" Sekunden"
      79. DrawText 150,200,"Neues Spiel mit der Leertaste."
      80. WaitInput
      81. e%=2
      82. EndIf
      83. Else
      84. DrawText 150,200,"Neues Spiel mit der Leertaste."
      85. EndIf
      86. DrawText 30,0,"Labyrinth Level:"+Str$(l%)
      87. DrawText 350,30,"Zeit für Level:"+Str$(z%) : DrawText 30,410,"Symbole Weiß: Spieler|Grau: Mauer|Braun: Boden|ROT: Ziel"
      88. DrawText 30,390,"(Q)uit | Steuerung: W/S/D/A+Cursor Tasten | Leertaste: Neues Spiel"
      89. EndProc
      90. Proc Getposition
      91. Parameters x%,y%
      92. Return @Mid$(k$[py%+y%],px%+x%,1)
      93. EndProc
      94. While 1
      95. Anzeige()
      96. WaitInput
      97. If l%>0
      98. If IsKey(87) Or IsKey(38)
      99. If ((Getposition(0,-1) = "0") Or (Getposition(0,-1) = "x"))
      100. Dec py%
      101. EndIf
      102. ElseIf IsKey(68) Or Iskey(39)
      103. If ((Getposition(1,0) = "0") Or (Getposition(1,0) = "x"))
      104. Inc px%
      105. EndIf
      106. ElseIf Iskey(83) Or IsKey(40)
      107. If ((Getposition(0,1) = "0") Or (Getposition(0,+1) = "x"))
      108. Inc py%
      109. EndIf
      110. ElseIf IsKey(65) Or IsKey(37)
      111. If ((Getposition(-1,0) = "0") Or (Getposition(-1,0) = "x"))
      112. Dec px%
      113. EndIf
      114. EndIf
      115. EndIf
      116. If IsKey(32)
      117. Inc l%
      118. Newgame
      119. EndIf
      120. If IsKey(81)
      121. BREAK
      122. EndIf
      123. EndWhile
      124. KillTimer
      125. End
      Alles anzeigen
      Gruß,
      Johannes



      Programmiert in Profan X2
      Gravity 2
    • hi Volkmar ,der Fehler ist mir bekannt jedoch is mir nicht ganz klar woher der kommt.

      Daher hatte ich den Text oben geschrieben:

      "nun gut egal hier schon mal der Code zu 90% taucht der Fehler nicht auf :-) und wenn dann Zeigt er sich dadurch das man das Ziel nicht erreichen kann xD
      Vielleicht finde ich noch den Fehler dann gibts ein Update."

      Mfg
      Gruß,
      Johannes



      Programmiert in Profan X2
      Gravity 2
    • so jetzt sollten alle Fehler beseitigt sein ;-) Levelgrenze habe ich nun mal auf 30 gesetzt.

      update:

      Quellcode

      1. Window 0,0-500,500
      2. WindowTitle "Labyrinth"
      3. var l%=0
      4. Declare z%,k$[],e%,pos%,w%,pxb%,pyb%,px%,py%
      5. Randomize
      6. Proc Newgame
      7. cls
      8. UseBrush 1,0
      9. Rectangle 100,100-400,350
      10. WhileLoop 20
      11. k$[&loop]="11111111111111111111"
      12. EndWhile
      13. px%=rnd(9)+7
      14. py%=rnd(8)+7
      15. pxb%=px%
      16. pyb%=py%
      17. WhileLoop 2*l%
      18. w%=rnd(5)+4
      19. pos% = rnd(80)
      20. If pos% <= 20
      21. WhileLoop w%
      22. k$[py%] = Del$(k$[py%],px%,1)
      23. k$[py%] = Ins$("0",k$[py%],px%)
      24. Case py% > 2 : Dec py%
      25. EndWhile
      26. ElseIf (pos% <= 40) And (pos% > 20)
      27. WhileLoop w%
      28. k$[py%] = del$(k$[py%],px%,1)
      29. k$[py%] = Ins$("0",k$[py%],px%)
      30. Case px% <= 18 : inc px%
      31. EndWhile
      32. ElseIf (pos% <= 60) And (pos% > 40)
      33. WhileLoop w%
      34. k$[py%] = del$(k$[py%],px%,1)
      35. k$[py%] = Ins$("0",k$[py%],px%)
      36. Case py% <= 18 : Inc py%
      37. EndWhile
      38. ElseIf (pos% <= 80) And (pos% > 60)
      39. WhileLoop w%
      40. k$[py%] = del$(k$[py%],px%,1)
      41. k$[py%] = Ins$("0",k$[py%],px%)
      42. Case px% > 3 : Dec px%
      43. EndWhile
      44. EndIf
      45. EndWhile
      46. k$[py%] = Del$(k$[py%],px%,1)
      47. k$[py%] = Ins$("0",k$[py%],px%)
      48. k$[pyb%] = del$(k$[pyb%],pxb%,1)
      49. k$[pyb%] = Ins$("x",k$[pyb%],pxb%)
      50. e%=1
      51. z%=0
      52. SetTimer 1000
      53. EndProc
      54. Proc Anzeige
      55. If e%=1
      56. UseBrush 0,45
      57. Rectangle 20,20-470,430
      58. UseBrush 1,Rgb(250,250,250)
      59. Rectangle 100+(px%*10),100+(py%*10)-110+(px%*10),110+(py%*10)
      60. UseBrush 1,Rgb(60,60,60)
      61. Case @Mid$(k$[py%-1],px%,1) = "1" : Rectangle 100+(px%*10),90+(py%*10)-110+(px%*10),100+(py%*10)
      62. Case @Mid$(k$[py%+1],px%,1) = "1" : Rectangle 100+(px%*10),110+(py%*10)-110+(px%*10),120+(py%*10)
      63. Case @Mid$(k$[py%],px%+1,1) = "1" : Rectangle 110+(px%*10),100+(py%*10)-120+(px%*10),110+(py%*10)
      64. Case @Mid$(k$[py%],px%-1,1) = "1" : Rectangle 90+(px%*10),100+(py%*10)-100+(px%*10),110+(py%*10)
      65. UseBrush 1,Rgb(90,30,30)
      66. Case @Mid$(k$[py%-1],px%,1) = "0" : Rectangle 100+(px%*10),90+(py%*10)-110+(px%*10),100+(py%*10)
      67. Case @Mid$(k$[py%+1],px%,1) = "0" : Rectangle 100+(px%*10),110+(py%*10)-110+(px%*10),120+(py%*10)
      68. Case @Mid$(k$[py%],px%+1,1) = "0" : Rectangle 110+(px%*10),100+(py%*10)-120+(px%*10),110+(py%*10)
      69. Case @Mid$(k$[py%],px%-1,1) = "0" : Rectangle 90+(px%*10),100+(py%*10)-100+(px%*10),110+(py%*10)
      70. UseBrush 1,Rgb(190,0,00)
      71. Case @Mid$(k$[py%-1],px%,1) = "x" : Rectangle 100+(px%*10),90+(py%*10)-110+(px%*10),100+(py%*10)
      72. Case @Mid$(k$[py%+1],px%,1) = "x" : Rectangle 100+(px%*10),110+(py%*10)-110+(px%*10),120+(py%*10)
      73. Case @Mid$(k$[py%],px%+1,1) = "x" : Rectangle 110+(px%*10),100+(py%*10)-120+(px%*10),110+(py%*10)
      74. Case @Mid$(k$[py%],px%-1,1) = "x" : Rectangle 90+(px%*10),100+(py%*10)-100+(px%*10),110+(py%*10)
      75. Case %wmTimer:Inc z%
      76. TextColor @Rgb(15,15,31),@Rgb(255,255,255),
      77. If @Mid$(k$[py%],px%,1) = "x"
      78. DrawText 30,40,"Du bist im Ziel angekommen Zeit: "+Str$(z%)+" Sekunden"
      79. DrawText 150,200,"Neues Spiel mit der Leertaste."
      80. WaitInput
      81. Inc l%
      82. e%=2
      83. EndIf
      84. ElseIf l%>=20
      85. DrawText 150,220,"Spielende! Vielen dank fürs Spielen."
      86. l%=0
      87. Else
      88. DrawText 150,200,"Neues Spiel mit der Leertaste."
      89. EndIf
      90. DrawText 30,0,"Labyrinth Level:"+Str$(l%)
      91. DrawText 350,30,"Zeit für Level:"+Str$(z%) : DrawText 30,410,"Symbole Weiß: Spieler|Grau: Mauer|Braun: Boden|ROT: Ziel"
      92. DrawText 30,390,"(Q)uit | Steuerung: W/S/D/A+Cursor Tasten | Leertaste: Neues Spiel"
      93. EndProc
      94. Proc Getposition
      95. Parameters x%,y%
      96. Return @Mid$(k$[py%+y%],px%+x%,1)
      97. EndProc
      98. While 1
      99. Anzeige()
      100. WaitInput
      101. If l%>0
      102. If IsKey(87) Or IsKey(38)
      103. If ((Getposition(0,-1) = "0") Or (Getposition(0,-1) = "x"))
      104. Dec py%
      105. EndIf
      106. ElseIf IsKey(68) Or Iskey(39)
      107. If ((Getposition(1,0) = "0") Or (Getposition(1,0) = "x"))
      108. Inc px%
      109. EndIf
      110. ElseIf Iskey(83) Or IsKey(40)
      111. If ((Getposition(0,1) = "0") Or (Getposition(0,+1) = "x"))
      112. Inc py%
      113. EndIf
      114. ElseIf IsKey(65) Or IsKey(37)
      115. If ((Getposition(-1,0) = "0") Or (Getposition(-1,0) = "x"))
      116. Dec px%
      117. EndIf
      118. EndIf
      119. EndIf
      120. If IsKey(32)
      121. Case l%=0 : l%=1
      122. Newgame
      123. EndIf
      124. If IsKey(81)
      125. BREAK
      126. EndIf
      127. EndWhile
      128. KillTimer
      129. End
      Alles anzeigen
      Gruß,
      Johannes



      Programmiert in Profan X2
      Gravity 2