Window 0,0-500,500
Window Title "Labyrinth"
var l%=0
Declare z%,k$[],e%,pos%,w%,pxb%,pyb%,px%,py%
Randomize
Proc Newgame
cls
UseBrush 1,0
Rectangle 100,100-400,350
WhileLoop 20
k$[&loop]="11111111111111111111"
EndWhile
px%=rnd(9)+7
py%=rnd(8)+7
pxb%=px%
pyb%=py%
WhileLoop 2*l%
w%=rnd(5)+4
pos% = rnd(80)
If pos% <= 20
WhileLoop w%
k$[py%] = Del$(k$[py%],px%,1)
k$[py%] = in that$("0",k$[py%],px%)
Case py% > 2 : Dec py%
EndWhile
ElseIf (pos% <= 40) And (pos% > 20)
WhileLoop w%
k$[py%] = del$(k$[py%],px%,1)
k$[py%] = in that$("0",k$[py%],px%)
Case px% <= 18 : inc px%
EndWhile
ElseIf (pos% <= 60) And (pos% > 40)
WhileLoop w%
k$[py%] = del$(k$[py%],px%,1)
k$[py%] = in that$("0",k$[py%],px%)
Case py% <= 18 : Inc py%
EndWhile
ElseIf (pos% <= 80) And (pos% > 60)
WhileLoop w%
k$[py%] = del$(k$[py%],px%,1)
k$[py%] = in that$("0",k$[py%],px%)
Case px% > 3 : Dec px%
EndWhile
EndIf
EndWhile
k$[py%] = Del$(k$[py%],px%,1)
k$[py%] = in that$("0",k$[py%],px%)
k$[pyb%] = del$(k$[pyb%],pxb%,1)
k$[pyb%] = in that$("x",k$[pyb%],pxb%)
e%=1
z%=0
SetTimer 1000
ENDPROC
Proc display
If e%=1
UseBrush 0,45
Rectangle 20,20-470,430
UseBrush 1,Rgb(250,250,250)
Rectangle 100+(px%*10),100+(py%*10)-110+(px%*10),110+(py%*10)
UseBrush 1,Rgb(60,60,60)
Case @Mid$(k$[py%-1],px%,1) = "1" : Rectangle 100+(px%*10),90+(py%*10)-110+(px%*10),100+(py%*10)
Case @Mid$(k$[py%+1],px%,1) = "1" : Rectangle 100+(px%*10),110+(py%*10)-110+(px%*10),120+(py%*10)
Case @Mid$(k$[py%],px%+1,1) = "1" : Rectangle 110+(px%*10),100+(py%*10)-120+(px%*10),110+(py%*10)
Case @Mid$(k$[py%],px%-1,1) = "1" : Rectangle 90+(px%*10),100+(py%*10)-100+(px%*10),110+(py%*10)
UseBrush 1,Rgb(90,30,30)
Case @Mid$(k$[py%-1],px%,1) = "0" : Rectangle 100+(px%*10),90+(py%*10)-110+(px%*10),100+(py%*10)
Case @Mid$(k$[py%+1],px%,1) = "0" : Rectangle 100+(px%*10),110+(py%*10)-110+(px%*10),120+(py%*10)
Case @Mid$(k$[py%],px%+1,1) = "0" : Rectangle 110+(px%*10),100+(py%*10)-120+(px%*10),110+(py%*10)
Case @Mid$(k$[py%],px%-1,1) = "0" : Rectangle 90+(px%*10),100+(py%*10)-100+(px%*10),110+(py%*10)
UseBrush 1,Rgb(190,0,00)
Case @Mid$(k$[py%-1],px%,1) = "x" : Rectangle 100+(px%*10),90+(py%*10)-110+(px%*10),100+(py%*10)
Case @Mid$(k$[py%+1],px%,1) = "x" : Rectangle 100+(px%*10),110+(py%*10)-110+(px%*10),120+(py%*10)
Case @Mid$(k$[py%],px%+1,1) = "x" : Rectangle 110+(px%*10),100+(py%*10)-120+(px%*10),110+(py%*10)
Case @Mid$(k$[py%],px%-1,1) = "x" : Rectangle 90+(px%*10),100+(py%*10)-100+(px%*10),110+(py%*10)
Case %wmtimer:Inc z%
Text Color @Rgb(15,15,31),@Rgb(255,255,255),
If @Mid$(k$[py%],px%,1) = "x"
DrawText 30,40,"Du are in the target arrived Time: "+Str $(z%)+" Sekunden"
DrawText 150,200,"Neues game with the Leertaste."
WaitInput
Inc l%
e%=2
EndIf
ElseIf l%>=20
DrawText 150,220,"Spielende! thank you very much for play."
l%=0
Else
DrawText 150,200,"Neues game with the Leertaste."
EndIf
DrawText 30,0,"Labyrinth Level:"+Str $(l%)
DrawText 350,30,"Zeit for Level:"+Str $(z%) : DrawText 30,410,"Symbole white: Spieler|Grau: Mauer|Braun: Boden|ROT: Ziel"
DrawText 30,390,"(Q)uit | Control: W/s/D/A+Cursor Keys | Leertaste: New Spiel"
ENDPROC
Proc Getposition
Parameters x%,y%
Return @Mid$(k$[py%+y%],px%+x%,1)
ENDPROC
While 1
display()
WaitInput
If l%>0
If IsKey(87) Or IsKey(38)
If ((Getposition(0,-1) = "0") Or (Getposition(0,-1) = "x"))
Dec py%
EndIf
ElseIf IsKey(68) Or Iskey(39)
If ((Getposition(1,0) = "0") Or (Getposition(1,0) = "x"))
Inc px%
EndIf
ElseIf Iskey(83) Or IsKey(40)
If ((Getposition(0,1) = "0") Or (Getposition(0,+1) = "x"))
Inc py%
EndIf
ElseIf IsKey(65) Or IsKey(37)
If ((Getposition(-1,0) = "0") Or (Getposition(-1,0) = "x"))
Dec px%
EndIf
EndIf
EndIf
If IsKey(32)
Case l%=0 : l%=1
Newgame
EndIf
If IsKey(81)
BREAK
EndIf
EndWhile
KillTimer
End