Wandering In The Cave

[James D Jarvis]

version 0.5
added a little more terrain variation and gave it a tiny bit more visual pop.  Added fungus and crystals.... crystals are just dangerous obstacles for now and the fungus is just eye candy but that shall change as features are added.

Code: (Select All)

'wandering in the cave
'By James D. Jarvis   sept 26,2022
_Title "Wandering In The Cave v0.5"
'use the number keys of  W,S,A,D to find the exit
'press 5 or .  to rest briefly
'
' this is a work in progress and may generate an impossible starting position
'
_Define K As _UNSIGNED LONG
Dim Shared kk, kblack, kfloor, krock, kwater, kslime, klava, krubble, kcrystal, kexit, kfungus
Dim Shared cave(24, 6), caverunlimit, lightradius
Dim Shared phealth, pstamina, pwounds, ptemp, ppx, ppy, lastx, lasty, rubblefreq, crystalfreq, fungusfreq
Dim cmap As _Unsigned Long
Dim ms As _Unsigned Long
cmap = _NewImage(800, 800, 32)
ms = _NewImage(800, 500, 32)
Screen ms
Print "Wandering In The Cave v0.5"
Print "By James D. Jarvis"
Print
Print "You must escape the cave."
Print
Print "Navigate with the numberpad or WASD"
Print "press any key to start and get a preview of the cave map"
Print "press spacebar after that to start your wandering."
any$ = Input$(1)
Screen cmap
_FullScreen _SquarePixels
_ControlChr Off
Const csx = 1, csy = 2, ctx = 3, cty = 4, cmx = 5, cmy = 6
kfloor = _RGB32(200, 180, 160): kwater = _RGB32(10, 30, 240)
krock = _RGB32(40, 30, 20): kslime = _RGB32(20, 240, 100): klava = _RGB32(200, 5, 5)
krubble = _RGB32(80, 80, 80): kcrystal = _RGB32(250, 250, 0): kexit = _RGB32(255, 0, 255)
kfungus = _RGB32(200, 50, 150)
Randomize Timer
check$ = "off"
caverunlimit = 500
Do
    _Limit 10
    restartcaves:
    rubblefreq = Int(3 + Rnd * 100)
    crystalfreq = Int(1 + Rnd * 200)
    fungusfreq = Int(3 + Rnd * 100)

    Line (0, 0)-(_Width, _Height), krock, BF
    cave(1, csx) = Int(100 + Rnd * 600)
    cave(1, csy) = Int(100 + Rnd * 600)
    Do
        cave(1, ctx) = Int(100 + Rnd * 600)
        cave(1, cty) = Int(100 + Rnd * 600)
        dx = Abs(cave(1, csx) - cave(1, ctx))
        dy = Abs(cave(1, csy) - cave(1, cty))
        dl = Sqr(dx * dx + dy * dy)
    Loop Until dy > 20 And dx > 20

    cave(1, cmx) = Int((cave(1, csx) + cave(1, ctx)) / 2 + (10 + Rnd * 50) - (10 + Rnd * 50))
    cave(1, cmy) = Int((cave(1, csy) + cave(1, cty)) / 2 + (10 + Rnd * 50) - (10 + Rnd * 50))
    For c = 2 To 24

        Select Case Int(1 + Rnd * 8)
            Case 1, 2, 3
                cave(c, csx) = cave(c - 1, csx)
                cave(c, csy) = cave(c - 1, csy)

            Case 4, 5
                cave(c, csx) = cave(c - 1, cmx)
                cave(c, csy) = cave(c - 1, cmy)

            Case 6, 7, 8
                cave(c, csx) = cave(c - 1, ctx)
                cave(c, csy) = cave(c - 1, cty)
        End Select
        cpl = 0
        Do

            Select Case Int(1 + Rnd * 6)
                Case 1, 2, 3
                    cave(c, ctx) = Int(100 + Rnd * 600)
                    cave(c, cty) = Int(100 + Rnd * 600)
                Case 4, 5, 6
                    If cave(c, csx) <= 400 Then
                        cave(c, ctx) = cave(c, csx) + Int(50 + Rnd * 200)
                    Else
                        cave(c, ctx) = cave(c, csx) - Int(50 + Rnd * 200)
                    End If
                    If cave(c, csy) <= 400 Then
                        cave(c, cty) = cave(c, csy) + Int(50 + Rnd * 200)
                    Else
                        cave(c, cty) = cave(c, csy) - Int(50 + Rnd * 200)
                    End If
            End Select
            dx = Abs(cave(c, csx) - cave(c, ctx))
            dy = Abs(cave(c, csy) - cave(c, cty))
            dl = Sqr(dx * dx + dy * dy)
            cpl = cpl + 1
            If cave(c, ctx) < 50 Then GoTo restartcaves
            If cpl > caverunlimit Then GoTo restartcaves
        Loop Until dy > 20 And dx > 20
        cave(c, cmx) = Int((cave(c, csx) + cave(c, ctx)) / 2 + (10 + Rnd * 50) - (10 + Rnd * 50))
        cave(c, cmy) = Int((cave(c, csy) + cave(c, cty)) / 2 + (10 + Rnd * 50) - (10 + Rnd * 50))
        ' Print cave(c, csx), cave(c, csy), cave(c, ctx), cave(c, cty), dl
    Next c

    For c = 1 To 24
        r = (1 + (1 + Rnd * 6) + (1 + Rnd * 6)) / 2
        xx = cave(c, csx)
        yy = cave(c, csy)
        xtrend = 0: ytrend = 0
        If xx < cave(c, cmx) Then xtrend = 3
        If xx > cave(c, cmx) Then xtrend = -3
        If yy < cave(c, cmy) Then ytrend = 3
        If yy > cave(c, cmy) Then ytrend = -3
        cpl = 0
        Do
            nx = xx + xtrend + xtrend * Int(Rnd * (r * 2)) - Int(Rnd * (r * 2))
            ny = yy + ytrend + ytrend * Int(Rnd * (r * 2)) - Int(Rnd * (r * 2))
            dx = Abs(cave(c, cmx) - nx)
            dy = Abs(cave(c, cmy) - ny)
            dd = Sqr(dx * dx + dy * dy)
            If dx < (r * 10) Then
                nx = cave(c, cmx)
                ny = ny + Int(r + Rnd * (r * 2)) - Int(r + Rnd * (r * 2))
            End If
            If dy < (r * 10) Then
                ny = cave(c, cmy)
                nx = nx + Int(r + Rnd * (r * 2)) - Int(r + Rnd * (r * 2))
            End If
            bumpyline xx, yy, nx, ny, r, kfloor
            xx = nx
            yy = ny
            cpl = cpl + 1
            If cpl > caverunlimit Then GoTo restartcaves
            If cave(c, cmx) < 50 Then GoTo restartcaves
        Loop Until xx = cave(c, cmx) And yy = cave(c, cmy)
    Next

    For c = 1 To 24
        xx = cave(c, cmx)
        yy = cave(c, cmy)
        xtrend = 0: ytrend = 0
        If xx < cave(c, ctx) Then xtrend = 2
        If xx > cave(c, ctx) Then xtrend = -2
        If yy < cave(c, cty) Then ytrend = 2
        If yy > cave(c, cty) Then ytrend = -2
        cpl = 0
        Do
            nx = xx + xtrend + xtrend * Int(Rnd * (r * 2)) - Int(Rnd * (r * 2))
            ny = yy + ytrend + ytrend * Int(Rnd * (r * 2)) - Int(Rnd * (r * 2))
            dx = Abs(cave(c, ctx) - nx)
            dy = Abs(cave(c, cty) - ny)
            dd = Sqr(dx * dx + dy * dy)
            If dx < r * 7 Then
                nx = cave(c, ctx)
                ny = ny + Int(r / 4 + Rnd * (r / 2)) - Int(r / 4 + Rnd * (r / 2))
            End If
            If dy < r * 7 Then
                ny = cave(c, cty)
                nx = nx + Int(r / 4 + Rnd * (r / 2)) - Int(r / 4 + Rnd * (r / 2))
            End If
            bumpyline xx, yy, nx, ny, r, kfloor
            xx = nx
            yy = ny
            cpl = cpl + 1
            If cpl > caverunlimit Then GoTo restartcaves
            If cave(c, ctx) < 50 Then GoTo restartcaves
        Loop Until xx = cave(c, ctx) And yy = cave(c, cty)
    Next

    For c = 1 To 24
        If Rnd * 6 < 3.5 Then
            reps = Int(2 + Rnd * 3)
            For e = 1 To reps
                If Rnd * 10 < 8.5 Then bumpypoly cave(c, csx), cave(c, csy), Int(5 + Int(Rnd * (5 * e))), Int(20 + Rnd * 100), Rnd * 30, 2 + Rnd * 4, kfloor
                If Rnd * 10 < 8.5 Then bumpypoly cave(c, ctx), cave(c, cty), Int(5 + Int(Rnd * (5 * e))), Int(20 + Rnd * 100), Rnd * 30, 2 + Rnd * 4, kfloor
            Next
        End If
    Next c

    'streams
    ns = Int(1 + Rnd * 12)
    If ns < 9 Then addstreams ns, kwater

    'lava flows
    nf = Int(1 + Rnd * 12)
    If nf < 5 Then addstreams nf, klava
    'slime flows
    nf = Int(1 + Rnd * 30)
    If nf < 9 Then addstreams nf, kslime


    'add rubble and more
    For yy = 1 To 799
        For xx = 1 To 799
            If Int(1 + Rnd * 10) < 4 Then
                For gx = -1 To 1
                    For gy = -1 To 1
                        If Point(xx, yy) = kfloor And Point(xx + gx, yy + gy) = krock Then PSet (xx, yy), krubble
                        If Point(xx, yy) = klava And Point(xx + gx, yy + gy) = krock Then
                            Select Case Int(1 + Rnd * 100)
                                Case 1
                                    PSet (xx + gx, yy + gy), kcrystal
                                Case 2, 3, 4, 5, 6, 7, 8, 9, 10
                                    PSet (xx + gx, yy + gy), krubble
                                Case 11, 12, 13
                                    PSet (xx + gx, yy + gy), kfloor
                            End Select
                        End If
                        If Point(xx, yy) = klava And Point(xx + gx, yy + gy) = kwater Then
                            Select Case Int(1 + Rnd * 300)
                                Case 1
                                    PSet (xx + gx, yy + gy), kcrystal
                                Case 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25
                                    PSet (xx + gx, yy + gy), krubble
                                Case 26, 27, 28, 29, 30, 31, 32, 33
                                    PSet (xx + gx, yy + gy), kfloor
                            End Select
                        End If

                    Next
                Next
            End If
            If Int(1 + Rnd * 1000) < rubblefreq Then
                If Point(xx, yy) = kfloor Then
                    PSet (xx, yy), krubble
                    For gx = -1 To 1
                        For gy = -1 To 1
                            If Int(1 + Rnd * 10) < 3 Then
                                If Point(xx + gx, yy + gy) = kfloor Then PSet (xx + gx, yy + gy), krubble
                            End If
                        Next
                    Next

                End If
            End If
            If Int(1 + Rnd * 5000) < crystalfreq Then
                If Point(xx, yy) = kfloor Then
                    PSet (xx, yy), kcrystal
                    For gx = -1 To 1
                        For gy = -1 To 1
                            If Int(1 + Rnd * 100) < 3 Then
                                If Point(xx + gx, yy + gy) = kfloor Then PSet (xx + gx, yy + gy), kcrystal
                            End If
                        Next
                    Next

                End If
            End If
            If Int(1 + Rnd * 1000) < fungusfreq Then
                If Point(xx, yy) = kfloor Then
                    PSet (xx, yy), kfungus
                    For gx = -1 To 1
                        For gy = -1 To 1
                            If Int(1 + Rnd * 20) < 3 Then
                                If Point(xx + gx, yy + gy) = kfloor Then PSet (xx + gx, yy + gy), kfungus
                            End If
                        Next
                    Next

                End If
            End If

        Next
    Next
    For puddles = 1 To 20
        pl = Int(1 + Rnd * 6)
        cc = Int(1 + Rnd * 24)
        Select Case pl
            Case 1
                addwater cave(cc, csx), cave(cc, csy), 2
            Case 2
                addwater cave(cc, cmx), cave(cc, cmy), 1
            Case 3
                addwater cave(cc, ctx), cave(cc, cty), 2
            Case 4, 5, 6
                addwater 0, 0, 3
        End Select
    Next

    For slimedrops = 1 To 16
        pl = Int(1 + Rnd * 7)
        cc = Int(1 + Rnd * 24)
        Select Case pl
            Case 1
                addslime cave(cc, csx), cave(cc, csy), 1
            Case 2
                addslime cave(cc, cmx), cave(cc, cmy), 1
            Case 3
                addslime cave(cc, ctx), cave(cc, cty), 1
            Case 4, 5, 6, 7
                addslime 0, 0, 1.5
        End Select
    Next
    For lavapools = 1 To 12
        pl = Int(1 + Rnd * 8)
        cc = Int(3 + Rnd * 22)
        Select Case pl
            Case 1, 2, 3
                addlava cave(cc, csx), cave(cc, csy), 3
            Case 4
                addlava cave(cc, cmx), cave(cc, cmy), 1
            Case 5, 6, 7
                addlava cave(cc, ctx), cave(cc, cty), 2
            Case 8
                addlava 0, 0, 2
        End Select
    Next


    If check$ = "on" Then
        For c = 1 To 24
            Line (cave(c, csx), cave(c, csy))-(cave(c, cmx), cave(c, cmy)), _RGB32(250, 250, 250)
            Line (cave(c, cmx), cave(c, cmy))-(cave(c, ctx), cave(c, cty)), _RGB32(250, 250, 250)
            _PrintString (cave(c, cmx), cave(c, cmy)), _Trim$(Str$(c))
        Next c
    End If
    Do
        _Limit 60
        kk$ = InKey$
    Loop Until kk$ <> ""
    ' Cls              n
Loop Until kk$ = " "

'Do
ecave = Int(6 + Rnd * 16)
exitX = cave(ecave, ctx)
exitY = cave(excave, cty)
'Loop Until Point(exitX, exitY) <> krock
PSet (exitX, exitY), kexit

kk$ = ""
'turn based cave exploration
Screen ms
Cls
_Source cmap
_Dest ms
ppx = cave(1, csx): ppy = cave(1, csy)
lightradius = 9: pstamina = 100: phealth = 100: pwounds = 0: ptemp = 98
turn = 0
_PrintMode _KeepBackground
View Print 25 To 30
Do
    'draw location
    rsqrd = lightradius * lightradius
    y = -lightradius
    While y <= lightradius
        x = Int(Sqr(rsqrd - y * y))
        For x2 = ppx - x To ppx + x
            vx = x2 - ppx + 12
            kk = Point(x2, ppy + y)
            Line (vx * 8, (y + 12) * 16)-(vx * 8 + 7, (y + 12) * 16 + 15), kk, BF
            If kk = kfungus Then
                Color _RGB32(250, 100, 200)
                _PrintString (vx * 8, (y + 12) * 16), Chr$(234)
                Color _RGB32(255, 255, 255)
            End If
            If kk = kcrystal Then _PrintString (vx * 8, (y + 12) * 16), Chr$(127)
            If kk = krubble Then
                Color _RGB32(150, 150, 150)
                _PrintString (vx * 8, (y + 12) * 16), Chr$(177)
                Color _RGB32(255, 255, 255)
            End If
            If kk = kslime Then
                Color _RGB32(250, 250, 150)
                sb = Int(Rnd * 4)
                If sb = 1 Then _PrintString (vx * 8, (y + 12) * 16), Chr$(247)

                If sb = 2 Then _PrintString (vx * 8, (y + 12) * 16), Chr$(126)

                Color _RGB32(255, 255, 255)
            End If
        Next
        y = y + 1
    Wend
    Line (598, 18)-(795, 124), krock, BF
    _PrintString ((12) * 8, (12) * 16), "@"
    o$ = "Stamina " + Str$(pstamina)
    _PrintString (600, 20), o$
    o$ = "Health " + Str$(phealth)
    _PrintString (600, 40), o$
    o$ = "Wounds " + Str$(pwounds)
    _PrintString (600, 60), o$
    o$ = "Temperature " + Str$(ptemp)
    _PrintString (600, 80), o$
    edd = Int(Sqr((ppx - exitX) * (ppx - exitX) + (ppy - exitY) * (ppy - exitY)))
    o$ = "Distance to Exit " + Str$(edd)
    _PrintString (600, 100), o$
    Print "Turn", turn

    Do
        _Limit 60
        kk$ = InKey$
    Loop Until kk$ <> ""
    turn = turn + 1
    lastx = ppx
    lasty = ppy
    Select Case kk$
        Case "w", "8"
            If pstamina > 0 And Point(ppx, ppy - 1) <> krock Then ppy = ppy - 1
        Case "s", "2"
            If pstamina > 0 And Point(ppx, ppy + 1) <> krock Then ppy = ppy + 1
        Case "a", "4"
            If pstamina > 0 And Point(ppx - 1, ppy) <> krock Then ppx = ppx - 1
        Case "d", "6"
            If pstamina > 0 And Point(ppx + 1, ppy) <> krock Then ppx = ppx + 1
        Case "7"
            If pstamina > 0 And Point(ppx - 1, ppy - 1) <> krock Then
                ppy = ppy - 1
                ppx = ppx - 1
            End If
        Case "9"
            If pstamina > 0 And Point(ppx + 1, ppy - 1) <> krock Then
                ppy = ppy - 1
                ppx = ppx + 1
            End If

        Case "1"
            If pstamina > 0 And Point(ppx - 1, ppy + 1) <> krock Then
                ppy = ppy + 1
                ppx = ppx - 1
            End If

        Case "3"
            If pstamina > 0 And Point(ppx + 1, ppy + 1) <> krock Then
                ppy = ppy + 1
                ppx = ppx + 1
            End If
        Case "5", "."
            If Int(1 + Rnd * 50) < phealth And pstamina < 100 Then pstamina = pstamina + 1 + Int(Rnd * (phealth / 25))
    End Select
    If Point(ppx, ppy) = krubble Then pwounds = pwounds + checkrubble(ppx, ppy)
    If Point(ppx, ppy) = kcrystal Then pwounds = pwounds + checkcrystal(ppx, ppy)

    If Int(1 + Rnd * 80 + pwounds) > phealth Then pstamina = pstamina - 1
    If Point(ppx, ppy) = kslime Then
        Print "The slime is nauseating...";
        If Int(Rnd * 120) > phealth Then phealth = phealth - Int(Rnd * 4)
        If Int(Rnd * 120) > phealth Then
            Select Case Int(1 + Rnd * 6)
                Case 1, 2, 3
                    Print " it's making you itch."
                Case 4, 5, 6
                    Print " it's feel's like it is burning you."
                    wounds = wounds + Abs(Int(Rnd * 2 - Rnd * 2))
            End Select
        End If
    End If
    If Point(ppx, ppy) = kwater Then ptemp = ptemp - Int(Abs(Rnd * 2 - Rnd * 2))
    If Point(ppx, ppy) = klava Then
        ptemp = ptemp + 100
        dmg = 10 + Int(Rnd * 20)
        pwounds = pwounds + dmg
        Print "YOU ARE STANDING IN LAVA !!!"
        Print "....suffering "; dmg; " points of damage !"
    End If
    If ptemp < 0 Then
        Print "You are dangerously COLD .... brrrrr"
        pstamina = pstamina - Int(Rnd * 2)
        If Int(1 + Rnd * (50 + Abs(ptemp))) > pstamina Then
            pwounds = pwounds + Int(1 + Rnd * 2)
            phealth = phealth - Int(Rnd * 2)
        End If
    End If
    tcheck = ptemp + Rnd * 10
    If tcheck > 108 Then
        pstamina = pstamina - 1
        Print "You are dangerously warm!"
        If Int(1 + Rnd * ptemp) > pstamina Then
            pwounds = pwounds + 1
            phealth = phealth - Int(Rnd * 2)
        End If
    End If
    If Point(ppx, ppy) = kfloor Then
        If ptemp < 98 Then ptemp = ptemp + 1
        If ptemp > 98 Then ptemp = Int((ptemp + 98) / 2)
    End If
    If pstamina < 20 Then
        Print "You are ";
        If pstamina < 1 Then
            Print "exhausted."
        Else
            Print "fatigued."
        End If
    End If
    If wounds > phealth Then
        Print "You are in intense pain !"
        pstamina = pstamina = Int(Rnd * 2)
    End If
    If Point(ppx, ppy) = kexit Then
        Print
        Print "YOU HAVE FOUND THE EXIT"
        Print
        Print "it took you "; turns; " turns after starting ", start_X, " spaces away from the exit."
        Print
        kk$ = Chr$(27)
    End If

    If phealth < 1 Or pwounds > 99 Then
        Print "YOU HAVE PERISHED DUE TO YOUR POOR CONDITION."
        Print
        Print "(press any key to continue)"
        any$ = Input$(1)
        kk$ = Chr$(27)

    End If


Loop Until kk$ = Chr$(27)
Print "GAME OVER"
Print "play again?"
Print "Y or N?"
Do
    ask$ = Input$(1)
    ask$ = UCase$(ask$)
Loop Until ask$ = "Y" Or ask$ = "N"
If ask$ = "Y" Then
    Screen cmap
    GoTo restartcaves
End If
System

Function checkrubble (xx, yy)
    stumblecheck = Int(1 + Rnd * 120)
    dmg = 0
    If stumblecheck > health Then
        Print "whooops.... you stumbled on the rubble...";
        Select Case Int(1 + Rnd * 20)
            Case 1
                If Point(ppx - 1, ppy - 1) <> krock Then
                    ppx = ppx - 1
                    ppy = ppy - 1
                End If
            Case 2
                If Point(ppx, ppy - 1) <> krock Then
                    ppy = ppy - 1
                End If
            Case 3
                If Point(ppx + 1, ppy + 1) <> krock Then
                    ppx = ppx + 1
                    ppy = ppy + 1
                End If
            Case 4
                If Point(ppx - 1, ppy) <> krock Then
                    ppx = ppx - 1
                End If
            Case 6
                If Point(ppx + 1, ppy) <> krock Then
                    ppx = ppx + 1
                End If
            Case 7
                If Point(ppx - 1, ppy + 1) <> krock Then
                    ppx = ppx - 1
                    ppy = ppy + 1
                End If
            Case 8
                If Point(ppx, ppy + 1) <> krock Then
                    ppy = ppy + 1
                End If
            Case 9
                If Point(ppx + 1, ppy + 1) <> krock Then
                    ppy = ppy + 1
                    ppx = ppx + 1
                End If
            Case 10, 11, 12, 13, 14
                Print " knocking the wind out of you... ";
                pstamina = Int(pstamina / 4)
            Case 15, 16, 17, 18, 19, 20
                ppx = lastx
                ppy = lasty
                Print "you tumble back...";
        End Select
        dmg = Abs(Int((Rnd * 3) - (Rnd * 3)))
        If dmg > 0 Then
            Print "you suffer "; dmg; " points of damage!"
        Else
            Print "."
        End If

    End If
    checkrubble = dmg
End Function

Function checkcrystal (xx, yy)
    climbcheck = Int(1 + Rnd * 100)
    If climbcheck > phealth Then
        Print "You just can't gain any purchase to climbe the crystal."
    Else
        stumblecheck = Int(1 + Rnd * 120)
        dmg = 0
        If stumblecheck > health Then
            Print ".... you fell from the crytsal...";
            Select Case Int(1 + Rnd * 9)
                Case 1
                    If Point(ppx - 1, ppy - 1) <> krock Then
                        ppx = ppx - 1
                        ppy = ppy - 1
                    End If
                Case 2
                    If Point(ppx, ppy - 1) <> krock Then
                        ppy = ppy - 1
                    End If
                Case 3
                    If Point(ppx + 1, ppy + 1) <> krock Then
                        ppx = ppx + 1
                        ppy = ppy + 1
                    End If
                Case 4
                    If Point(ppx - 1, ppy) <> krock Then
                        ppx = ppx - 1
                    End If
                Case 5
                    ppx = lastx
                    ppy = lasty
                Case 6
                    If Point(ppx + 1, ppy) <> krock Then
                        ppx = ppx + 1
                    End If
                Case 7
                    If Point(ppx - 1, ppy + 1) <> krock Then
                        ppx = ppx - 1
                        ppy = ppy + 1
                    End If
                Case 8
                    If Point(ppx, ppy + 1) <> krock Then
                        ppy = ppy + 1
                    End If
                Case 9
                    If Point(ppx + 1, ppy + 1) <> krock Then
                        ppy = ppy + 1
                        ppx = ppx + 1
                    End If
            End Select
            dmg = Abs(Int((Rnd * 4) - (Rnd * 4)))
            If dmg > 0 Then
                Print "you suffer "; dmg; " points of damage!"
            Else
                Print "."
            End If

        End If
    End If
    checkcrystal = dmg
End Function
Sub circleBF (cx As Long, cy As Long, r As Long, klr As _Unsigned Long)
    rsqrd = r * r
    y = -r
    While y <= r
        x = Sqr(rsqrd - y * y)
        Line (cx - x, cy + y)-(cx + x, cy + y), klr, BF
        y = y + 1
    Wend
End Sub

Sub rotpoly (cx, cy, rr, shapedeg, turn, klr As _Unsigned Long)
    x = rr * Sin(0.01745329 * turn)
    y = rr * Cos(0.01745329 * turn)
    Line (cx + x, cy + y)-(cx + x, cy + y), klr
    For deg = turn To turn + 360 Step shapedeg
        x2 = rr * Sin(0.01745329 * deg)
        y2 = rr * Cos(0.01745329 * deg)
        Line -(cx + x2, cy + y2), klr
    Next
End Sub
Sub bumpypoly (cx, cy, rr, shapedeg, turn, thk, klr As _Unsigned Long)
    x = rr * Sin(0.01745329 * turn)
    y = rr * Cos(0.01745329 * turn)
    'Line (cx + x, cy + y)-(cx + x, cy + y), klr
    lx = cx + x: ly = cy + y
    For deg = turn To turn + 360 Step shapedeg
        x2 = rr * Sin(0.01745329 * deg)
        y2 = rr * Cos(0.01745329 * deg)
        tv = (Rnd * 6 + Rnd * 6 + 3) / 10
        bumpyline lx, ly, cx + x2, cy + y2, thk * tv, klr
        lx = cx + x2: ly = cy + y2
    Next
End Sub
Sub addwater (pcx, pcy, scale)
    If pcx = 0 Then
        pcx = Int(100 + Rnd * 600)
        pcy = Int(100 + Rnd * 600)
    End If
    prr = Int(6 + Rnd * (12 * scale))
    preps = (3 + Int(Rnd * prr))
    For r = 1 To preps
        pcx = pcx + Int(Rnd * 4) - Int(Rnd * 4)
        pcy = pcy + Int(Rnd * 4) - Int(Rnd * 4)
        rsqrd = prr * prr
        y = -prr
        While y <= prr
            x = Int(Sqr(rsqrd - y * y))
            For x2 = pcx - x To pcx + x
                kk = Point(x2, pcy + y)
                If kk = kfloor Then
                    PSet (x2, pcy + y), kwater
                End If
            Next
            y = y + 1
        Wend
        prr = Int((prr + Int(6 + Rnd * (12 * scale))) / 2)
    Next
End Sub

Sub addslime (pcx, pcy, scale)
    If pcx = 0 Then
        pcx = Int(100 + Rnd * 600)
        pcy = Int(100 + Rnd * 600)
    End If
    prr = Int(6 + Rnd * (12 * scale))
    preps = (3 + Int(Rnd * prr))
    For r = 1 To preps
        pcx = pcx + Int(Rnd * 4) - Int(Rnd * 4)
        pcy = pcy + Int(Rnd * 4) - Int(Rnd * 4)
        rsqrd = prr * prr
        y = -prr
        While y <= prr
            x = Int(Sqr(rsqrd - y * y))
            For x2 = pcx - x To pcx + x
                kk = Point(x2, pcy + y)
                If kk = kfloor Then
                    PSet (x2, pcy + y), kslime
                End If
            Next
            y = y + 1
        Wend
        prr = Int(2 + Rnd * (12 * scale))
    Next
End Sub
Sub addlava (pcx, pcy, scale)
    If pcx = 0 Then
        pcx = Int(100 + Rnd * 600)
        pcy = Int(100 + Rnd * 600)
    End If
    prr = Int(6 + Rnd * (12 * scale))
    preps = (2 + Int(Rnd * (prr / 2)))
    For r = 1 To preps
        pcx = pcx + Int(Rnd * 4) - Int(Rnd * 4)
        pcy = pcy + Int(Rnd * 4) - Int(Rnd * 4)
        rsqrd = prr * prr
        y = -prr
        While y <= prr
            x = Int(Sqr(rsqrd - y * y))
            For x2 = pcx - x To pcx + x
                kk = Point(x2, pcy + y)
                If kk = kfloor Then
                    PSet (x2, pcy + y), klava
                End If
                If kk = kslime Then
                    PSet (x2, pcy + y), klava
                End If
                If kk = kwater Then
                    Select Case Int(1 + Rnd * 51)
                        Case 1 To 5
                            PSet (x2, pcy + y), klava
                        Case 6 To 20
                            PSet (x2, pcy + y), krock
                        Case 21 To 40
                            PSet (x2, pcy + y), kfloor
                        Case 41 To 50
                            PSet (x2, pcy + y), krubble
                        Case 51
                            PSet (x2, pcy + y), kcrystal
                    End Select
                End If
                If kk = kfungus Then
                    PSet (x2, pcy + y), klava
                End If

            Next
            y = y + 1
        Wend
        prr = Int((prr + Int(6 + Rnd * (12 * scale))) / 2)
    Next
End Sub

Sub fatpoly (cx, cy, rr, shapedeg, turn, thk, klr As _Unsigned Long)
    x = rr * Sin(0.01745329 * turn)
    y = rr * Cos(0.01745329 * turn)
    'Line (cx + x, cy + y)-(cx + x, cy + y), klr
    lx = cx + x: ly = cy + y
    For deg = turn To turn + 360 Step shapedeg
        x2 = rr * Sin(0.01745329 * deg)
        y2 = rr * Cos(0.01745329 * deg)
        fatline lx, ly, cx + x2, cy + y2, thk, klr
        lx = cx + x2: ly = cy + y2
    Next
End Sub
Sub bumpyline (x0, y0, x1, y1, r, klr As _Unsigned Long)
    If Abs(y1 - y0) < Abs(x1 - x0) Then
        If x0 > x1 Then
            bumpylineLow x1, y1, x0, y0, r, klr

        Else
            bumpylineLow x0, y0, x1, y1, r, klr
        End If
    Else
        If y0 > y1 Then
            bumpylineHigh x1, y1, x0, y0, r, klr
        Else
            bumpylineHigh x0, y0, x1, y1, r, klr
        End If
    End If
End Sub







Sub fatline (x0, y0, x1, y1, r, klr As _Unsigned Long)
    If Abs(y1 - y0) < Abs(x1 - x0) Then
        If x0 > x1 Then
            lineLow x1, y1, x0, y0, r, klr

        Else
            lineLow x0, y0, x1, y1, r, klr
        End If
    Else
        If y0 > y1 Then
            lineHigh x1, y1, x0, y0, r, klr
        Else
            lineHigh x0, y0, x1, y1, r, klr
        End If
    End If
End Sub
Sub lineLow (x0, y0, x1, y1, r, klr As _Unsigned Long)
    dx = x1 - x0
    dy = y1 - y0
    yi = 1
    If dy < 0 Then
        yi = -1
        dy = -dy
    End If
    'D = (2 * dy) - dx
    d = (dy + dy) - dx
    y = y0
    For x = x0 To x1
        circleBF x, y, r, klr

        If d > 0 Then
            y = y + yi
            ' D = D + (2 * (dy - dx))
            d = d + ((dy - dx) + (dy - dx))
        Else
            ' D = D + 2 * dy
            d = d + dy + dy
        End If
    Next x
End Sub
Sub lineHigh (x0, y0, x1, y1, r, klr As _Unsigned Long)
    dx = x1 - x0
    dy = y1 - y0
    xi = 1
    If dx < 0 Then
        xi = -1
        dx = -dx
    End If
    ' D = (2 * dx) - dy
    D = (dx + dx) - dy
    x = x0
    For y = y0 To y1
        circleBF x, y, r, klr

        If D > 0 Then
            x = x + xi
            ' D = D + (2 * (dx - dy))
            D = D + ((dx - dy) + (dx - dy))
        Else
            ' D = D + 2 * dx
            D = D + dx + dx
        End If
    Next y
End Sub
Sub bumpylineLow (x0, y0, x1, y1, r, klr As _Unsigned Long)
    dx = x1 - x0
    dy = y1 - y0
    yi = 1
    If dy < 0 Then
        yi = -1
        dy = -dy
    End If
    'D = (2 * dy) - dx
    d = (dy + dy) - dx
    y = y0
    For x = x0 To x1
        tv = (Rnd * 6 + Rnd * 6 + 3) / 10
        circleBF x + Rnd * r - Rnd * r, y + Rnd * r - Rnd * 4, r * tv, klr

        If d > 0 Then
            y = y + yi
            ' D = D + (2 * (dy - dx))
            d = d + ((dy - dx) + (dy - dx))
        Else
            ' D = D + 2 * dy
            d = d + dy + dy
        End If
    Next x
End Sub
Sub bumpylineHigh (x0, y0, x1, y1, r, klr As _Unsigned Long)
    dx = x1 - x0
    dy = y1 - y0
    xi = 1
    If dx < 0 Then
        xi = -1
        dx = -dx
    End If
    ' D = (2 * dx) - dy
    D = (dx + dx) - dy
    x = x0
    For y = y0 To y1
        tv = (Rnd * 12 + Rnd * 6 + 3) / 10
        circleBF x + Rnd * r - Rnd * r, y + Rnd * r - Rnd * 4, r * tv, klr

        If D > 0 Then
            x = x + xi
            ' D = D + (2 * (dx - dy))
            D = D + ((dx - dy) + (dx - dy))
        Else
            ' D = D + 2 * dx
            D = D + dx + dx
        End If
    Next y
End Sub
Sub addstreams (numstreams, kklr)
    Dim stream(numstreams, 6)

    restartstreams:

    stream(1, csx) = Int(100 + Rnd * 600)
    stream(1, csy) = Int(100 + Rnd * 600)
    Do
        stream(1, ctx) = Int(100 + Rnd * 600)
        stream(1, cty) = Int(100 + Rnd * 600)
        dx = Abs(stream(1, csx) - stream(1, ctx))
        dy = Abs(stream(1, csy) - stream(1, cty))
        dl = Sqr(dx * dx + dy * dy)
    Loop Until dy > 20 And dx > 20

    stream(1, cmx) = Int((stream(1, csx) + stream(1, ctx)) / 2 + (10 + Rnd * 50) - (10 + Rnd * 50))
    stream(1, cmy) = Int((stream(1, csy) + stream(1, cty)) / 2 + (10 + Rnd * 50) - (10 + Rnd * 50))
    For c = 2 To numstreams

        Select Case Int(1 + Rnd * 8)
            Case 1, 2, 3
                stream(c, csx) = stream(c - 1, csx)
                stream(c, csy) = stream(c - 1, csy)

            Case 4, 5
                stream(c, csx) = stream(c - 1, cmx)
                stream(c, csy) = stream(c - 1, cmy)

            Case 6, 7, 8
                stream(c, csx) = stream(c - 1, ctx)
                stream(c, csy) = stream(c - 1, cty)
        End Select
        cpl = 0
        Do

            Select Case Int(1 + Rnd * 6)
                Case 1, 2, 3
                    stream(c, ctx) = Int(100 + Rnd * 600)
                    stream(c, cty) = Int(100 + Rnd * 600)
                Case 4, 5, 6
                    If stream(c, csx) <= 400 Then
                        stream(c, ctx) = stream(c, csx) + Int(50 + Rnd * 200)
                    Else
                        stream(c, ctx) = stream(c, csx) - Int(50 + Rnd * 200)
                    End If
                    If stream(c, csy) <= 400 Then
                        stream(c, cty) = stream(c, csy) + Int(50 + Rnd * 200)
                    Else
                        stream(c, cty) = stream(c, csy) - Int(50 + Rnd * 200)
                    End If
            End Select
            dx = Abs(stream(c, csx) - stream(c, ctx))
            dy = Abs(stream(c, csy) - stream(c, cty))
            dl = Sqr(dx * dx + dy * dy)
            cpl = cpl + 1
            If stream(c, ctx) < 50 Then GoTo restartstreams
            If cpl > caverunlimit Then GoTo restartstreams
        Loop Until dy > 20 And dx > 20
        stream(c, cmx) = Int((stream(c, csx) + stream(c, ctx)) / 2 + (10 + Rnd * 50) - (10 + Rnd * 50))
        stream(c, cmy) = Int((stream(c, csy) + stream(c, cty)) / 2 + (10 + Rnd * 50) - (10 + Rnd * 50))
        ' Print cave(c, csx), cave(c, csy), cave(c, ctx), cave(c, cty), dl
    Next c


    For c = 1 To numstreams
        r = (3 + (1 + Rnd * 6) + (1 + Rnd * 6)) / 4
        xx = stream(c, csx)
        yy = stream(c, csy)
        If Point(xx, yy) = krock Then
            bumpypoly xx, yy, Int(r / 2 + Int(Rnd * (r * 3))), Int(20 + Rnd * 100), Rnd * 30, 2 + Rnd * 4, kfloor
        End If



        xtrend = 0: ytrend = 0
        If xx < stream(c, cmx) Then xtrend = 3
        If xx > stream(c, cmx) Then xtrend = -3
        If yy < stream(c, cmy) Then ytrend = 3
        If yy > stream(c, cmy) Then ytrend = -3
        cpl = 0
        Do
            nx = xx + xtrend + xtrend * Int(Rnd * (r * 2)) - Int(Rnd * (r * 2))
            ny = yy + ytrend + ytrend * Int(Rnd * (r * 2)) - Int(Rnd * (r * 2))
            dx = Abs(stream(c, cmx) - nx)
            dy = Abs(stream(c, cmy) - ny)
            dd = Sqr(dx * dx + dy * dy)
            If dx < (r * 10) Then
                nx = stream(c, cmx)
                ny = ny + Int(r + Rnd * (r * 2)) - Int(r + Rnd * (r * 2))
            End If
            If dy < (r * 10) Then
                ny = stream(c, cmy)
                nx = nx + Int(r + Rnd * (r * 2)) - Int(r + Rnd * (r * 2))
            End If
            bumpyline xx, yy, nx, ny, r, kklr
            xx = nx
            yy = ny
            cpl = cpl + 1
            If cpl > caverunlimit Then GoTo restartstreams
            If stream(c, cmx) < 50 Then GoTo restartstreams
        Loop Until xx = stream(c, cmx) And yy = stream(c, cmy)
    Next
    If Point(nx, ny) = krock Then
        bumpypoly nx, ny, Int(r / 2 + Int(Rnd * r)), Int(20 + Rnd * 100), Rnd * 30, 2 + Rnd * 4, kfloor
    End If

    For c = 1 To numstreams
        xx = stream(c, cmx)
        yy = stream(c, cmy)
        xtrend = 0: ytrend = 0
        If xx < stream(c, ctx) Then xtrend = 2
        If xx > stream(c, ctx) Then xtrend = -2
        If yy < stream(c, cty) Then ytrend = 2
        If yy > stream(c, cty) Then ytrend = -2
        cpl = 0
        Do
            nx = xx + xtrend + xtrend * Int(Rnd * (r * 2)) - Int(Rnd * (r * 2))
            ny = yy + ytrend + ytrend * Int(Rnd * (r * 2)) - Int(Rnd * (r * 2))
            dx = Abs(stream(c, ctx) - nx)
            dy = Abs(stream(c, cty) - ny)
            dd = Sqr(dx * dx + dy * dy)
            If dx < r * 7 Then
                nx = stream(c, ctx)
                ny = ny + Int(r / 4 + Rnd * (r / 2)) - Int(r / 4 + Rnd * (r / 2))
            End If
            If dy < r * 7 Then
                ny = stream(c, cty)
                nx = nx + Int(r / 4 + Rnd * (r / 2)) - Int(r / 4 + Rnd * (r / 2))
            End If
            bumpyline xx, yy, nx, ny, r, kklr
            xx = nx
            yy = ny
            cpl = cpl + 1
            If cpl > caverunlimit Then GoTo restartstreams
            If stream(c, ctx) < 50 Then GoTo restartstreams
        Loop Until xx = stream(c, ctx) And yy = stream(c, cty)
        If Point(nx, ny) = krock Then
            bumpypoly nx, ny, Int(r / 2 + Int(Rnd * r)), Int(20 + Rnd * 100), Rnd * 30, 2 + Rnd * 4, kfloor
        End If
    Next
End Sub

Sub addlavaflows (numstreams)
    Dim stream(numstreams, 6)

    restartflows:

    stream(1, csx) = Int(100 + Rnd * 600)
    stream(1, csy) = Int(100 + Rnd * 600)
    Do
        stream(1, ctx) = Int(100 + Rnd * 600)
        stream(1, cty) = Int(100 + Rnd * 600)
        dx = Abs(stream(1, csx) - stream(1, ctx))
        dy = Abs(stream(1, csy) - stream(1, cty))
        dl = Sqr(dx * dx + dy * dy)
    Loop Until dy > 20 And dx > 20

    stream(1, cmx) = Int((stream(1, csx) + stream(1, ctx)) / 2 + (10 + Rnd * 50) - (10 + Rnd * 50))
    stream(1, cmy) = Int((stream(1, csy) + stream(1, cty)) / 2 + (10 + Rnd * 50) - (10 + Rnd * 50))
    For c = 2 To numstreams

        Select Case Int(1 + Rnd * 8)
            Case 1, 2, 3
                stream(c, csx) = stream(c - 1, csx)
                stream(c, csy) = stream(c - 1, csy)

            Case 4, 5
                stream(c, csx) = stream(c - 1, cmx)
                stream(c, csy) = stream(c - 1, cmy)

            Case 6, 7, 8
                stream(c, csx) = stream(c - 1, ctx)
                stream(c, csy) = stream(c - 1, cty)
        End Select
        cpl = 0
        Do

            Select Case Int(1 + Rnd * 6)
                Case 1, 2, 3
                    stream(c, ctx) = Int(100 + Rnd * 600)
                    stream(c, cty) = Int(100 + Rnd * 600)
                Case 4, 5, 6
                    If stream(c, csx) <= 400 Then
                        stream(c, ctx) = stream(c, csx) + Int(50 + Rnd * 200)
                    Else
                        stream(c, ctx) = stream(c, csx) - Int(50 + Rnd * 200)
                    End If
                    If stream(c, csy) <= 400 Then
                        stream(c, cty) = stream(c, csy) + Int(50 + Rnd * 200)
                    Else
                        stream(c, cty) = stream(c, csy) - Int(50 + Rnd * 200)
                    End If
            End Select
            dx = Abs(stream(c, csx) - stream(c, ctx))
            dy = Abs(stream(c, csy) - stream(c, cty))
            dl = Sqr(dx * dx + dy * dy)
            cpl = cpl + 1
            If stream(c, ctx) < 50 Then GoTo restartflows
            If cpl > caverunlimit Then GoTo restartflows
        Loop Until dy > 20 And dx > 20
        stream(c, cmx) = Int((stream(c, csx) + stream(c, ctx)) / 2 + (10 + Rnd * 50) - (10 + Rnd * 50))
        stream(c, cmy) = Int((stream(c, csy) + stream(c, cty)) / 2 + (10 + Rnd * 50) - (10 + Rnd * 50))
        ' Print cave(c, csx), cave(c, csy), cave(c, ctx), cave(c, cty), dl
    Next c


    For c = 1 To numstreams
        r = (3 + (1 + Rnd * 6) + (1 + Rnd * 6)) / 4
        xx = stream(c, csx)
        yy = stream(c, csy)

        xtrend = 0: ytrend = 0
        If xx < stream(c, cmx) Then xtrend = 3
        If xx > stream(c, cmx) Then xtrend = -3
        If yy < stream(c, cmy) Then ytrend = 3
        If yy > stream(c, cmy) Then ytrend = -3
        cpl = 0
        Do
            nx = xx + xtrend + xtrend * Int(Rnd * (r * 2)) - Int(Rnd * (r * 2))
            ny = yy + ytrend + ytrend * Int(Rnd * (r * 2)) - Int(Rnd * (r * 2))
            dx = Abs(stream(c, cmx) - nx)
            dy = Abs(stream(c, cmy) - ny)
            dd = Sqr(dx * dx + dy * dy)
            If dx < (r * 10) Then
                nx = stream(c, cmx)
                ny = ny + Int(r + Rnd * (r * 2)) - Int(r + Rnd * (r * 2))
            End If
            If dy < (r * 10) Then
                ny = stream(c, cmy)
                nx = nx + Int(r + Rnd * (r * 2)) - Int(r + Rnd * (r * 2))
            End If
            bumpyline xx, yy, nx, ny, r, klava
            xx = nx
            yy = ny
            cpl = cpl + 1
            If cpl > caverunlimit Then GoTo restartflows
            If stream(c, cmx) < 50 Then GoTo restartflows
        Loop Until xx = stream(c, cmx) And yy = stream(c, cmy)
    Next

    For c = 1 To numstreams
        xx = stream(c, cmx)
        yy = stream(c, cmy)
        xtrend = 0: ytrend = 0
        If xx < stream(c, ctx) Then xtrend = 2
        If xx > stream(c, ctx) Then xtrend = -2
        If yy < stream(c, cty) Then ytrend = 2
        If yy > stream(c, cty) Then ytrend = -2
        cpl = 0
        Do
            nx = xx + xtrend + xtrend * Int(Rnd * (r * 2)) - Int(Rnd * (r * 2))
            ny = yy + ytrend + ytrend * Int(Rnd * (r * 2)) - Int(Rnd * (r * 2))
            dx = Abs(stream(c, ctx) - nx)
            dy = Abs(stream(c, cty) - ny)
            dd = Sqr(dx * dx + dy * dy)
            If dx < r * 7 Then
                nx = stream(c, ctx)
                ny = ny + Int(r / 4 + Rnd * (r / 2)) - Int(r / 4 + Rnd * (r / 2))
            End If
            If dy < r * 7 Then
                ny = stream(c, cty)
                nx = nx + Int(r / 4 + Rnd * (r / 2)) - Int(r / 4 + Rnd * (r / 2))
            End If
            bumpyline xx, yy, nx, ny, r, klava
            xx = nx
            yy = ny
            cpl = cpl + 1
            If cpl > caverunlimit Then GoTo restartflows
            If stream(c, ctx) < 50 Then GoTo restartflows
        Loop Until xx = stream(c, ctx) And yy = stream(c, cty)
    Next
End Sub