Tiny Maze Maker - ASCII

[James D Jarvis]

oooh I love me some mazes.  Good work!

Here's one I made a little while ago that I slowed down because it was fun to watch.

Code: (Select All)

Screen _NewImage(300, 200, 256)

_FullScreen

Cls , 0

Randomize Timer

dig$ = ""

Type point_type

    x As Integer

    y As Integer

    score As Integer

End Type

Dim Shared runl 'i was palnnign on making this more complicaated eventually so variables are shared to share with subds and functions

Dim Shared pnt(maxpoints) As point_type

Dim Shared curp, pointcount

Do

    Cls

    runl = Int(2 + Rnd * 3 + Rnd * 3 + Rnd * 3)

    lastgo = Int(1 + Rnd * 4)

    startx = Int(_Width / 2 + Rnd * (_Width / 4) - Rnd * (_Width / 4))

    starty = Int(_Height / 2 + Rnd * (_Height / 4) - Rnd * (_Height / 4))

    maxpoints = ((_Width - 1) * (_Height - 1)) \ (((runl - 1) * runl))

    ReDim Shared pnt(maxpoints) As point_type

    curp = 1

    pointcount = 1

    pnt(curp).x = startx: pnt(curp).y = starty

    PSet (pnt(curp).x, pnt(curp).y), 6

    Do

        _Limit ((runl ^ 2) * 600)

        cx = pnt(curp).x: cy = pnt(curp).y



        dgo = Int(1 + Rnd * 7)

        If dgo = 5 Then dig$ = "jump"

        If dgo = 6 Then dig$ = "back"

        If dgo > 5 Then

            dgo = lastgo

        End If

        Select Case dgo

            Case 1

                If cy - runl > 0 Then

                    gy = cy - runl: gx = cx

                    If Point(gx, gy) = 0 Then dig$ = "dig" Else If Point(gx, gy) = 6 Then dig$ = "move"

                End If

            Case 2

                If cx + runl < (_Width - runl) Then

                    gx = cx + runl: gy = cy

                    If Point(gx, gy) = 0 Then dig$ = "dig" Else If Point(gx, gy) = 6 Then dig$ = "move"

                End If



            Case 3

                If cy + runl < (_Height - runl) Then

                    gy = cy + runl: gx = cx

                    If Point(gx, gy) = 0 Then dig$ = "dig" Else If Point(gx, gy) = 6 Then dig$ = "move"

                End If



            Case 4

                If cx - runl > 0 Then

                    gx = cx - runl: gy = cy

                    If Point(gx, gy) = 0 Then dig$ = "dig" Else If Point(gx, gy) = 6 Then dig$ = "move"

                End If

        End Select

        If dgo > 0 Then lastgo = dgo

        Select Case dig$

            Case "dig"

                Line (cx, cy)-(gx, gy), 6

                curp = curp + 1

                pointcount = pointcount + 1

                pnt(pointcount).x = gx

                pnt(pointcount).y = gy

            Case "move"

                curp = findp(gx, gy)

            Case "jump"

                curp = Int(1 + Rnd * pointcount)

            Case "back"

                curp = pointcount - Int(1 + Rnd * Sqr(pointcount))

        End Select

        dig$ = ""

        kk$ = InKey$

    Loop Until pointcount >= maxpoints Or kk$ <> ""

    Sleep

    kk$ = InKey$

Loop Until kk$ = Chr$(27)



Function findp (xx, yy)

    fd = 0

    For f = 1 To pointcount

        If pnt(f).x = xx And pnt(f).y = yy Then

            fd = f

        End If

        If fd > 0 Then Exit For

    Next f

    findp = fd

End Function