XProfan

Window 0,0-500,500
WindowTitle "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%] = Ins$("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%] = Ins$("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%] = Ins$("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%] = Ins$("0",k$[py%],px%)
                Case px% > 3 : Dec px%

            EndWhile

        EndIf

    EndWhile

    k$[py%] = Del$(k$[py%],px%,1)
    k$[py%] = Ins$("0",k$[py%],px%)
    k$[pyb%] = del$(k$[pyb%],pxb%,1)
    k$[pyb%] = Ins$("x",k$[pyb%],pxb%)
    e%=1
    z%=0
    SetTimer 1000

EndProc

Proc Anzeige

    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%
        TextColor @Rgb(15,15,31),@Rgb(255,255,255),

        If @Mid$(k$[py%],px%,1) = "x"

            DrawText 30,40,"Du bist im Ziel angekommen Zeit: "+Str$(z%)+" Sekunden"
            DrawText 150,200,"Neues Spiel mit der Leertaste."
            WaitInput
            Inc l%
            e%=2

        EndIf

    ElseIf  l%>=20

        DrawText 150,220,"Spielende! Vielen dank fürs Spielen."
        l%=0

    Else

        DrawText 150,200,"Neues Spiel mit der Leertaste."

    EndIf

    DrawText 30,0,"Labyrinth Level:"+Str$(l%)
    DrawText 350,30,"Zeit per Level:"+Str$(z%) : DrawText 30,410,"Symbole Weiß: Spieler|Grau: Mauer|Braun: Boden|ROT: Ziel"
    DrawText 30,390,"(Q)uit | Steuerung: W/S/D/A+Cursor Tasten | Leertaste: Neues Spiel"

EndProc

Proc Getposition

    Parameters x%,y%
    Return @Mid$(k$[py%+y%],px%+x%,1)

EndProc

While 1

    Anzeige()
    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