obsolete.computer

the-maze/game.bas

File Type: text/plain

DECLARE FUNCTION LineofSight (x1, y1, x2, y2)
DECLARE SUB Warp (x, y)
DECLARE SUB Drawscreen (ndiamond, cur, nky, tries)
DECLARE SUB Drlin (x1, y1, x2, y2)
DECLARE SUB Drblock (x1, y1, x2, y2)
DECLARE SUB Killdude (x1(), y1(), p, n)
DECLARE FUNCTION Whichone (xx(), yy(), x, y, n)

Randomize Timer
bombtime = 125 'set up speeds of enemies
arrowtime = 150 '(in milliseconds per update)
enemytime = 500
youtime = 125 'and you
x = 40: y = 10
ar = 0: en = 0: bm = 0
bb = 0: ldtim = 0: ld = 0
t$ = "": ensp = 50
Dim room$(30, 100), items(30)
Dim ky(30), cn(30), dr(30), bx(10), by(10)
Dim ax(10), ay(10), ex(10), ey(10), adr(10), lastc(30)
Screen 9
Open "game.ini" For Input As #1
Input #1, n$
Close #1

start:
GoSub load
For t = 1 To 30
    cn(t) = 0
    dr(t) = 0
    ky(t) = 0
    lastc(t) = 0
Next t
og1 = 0
tries = 4: lastsav = 1
lastx = x: lasty = y
lastn = 0: dead = 0
pc = 24: cur = 1
nky = 0: ndiamond = 0
count = 0
Drawscreen ndiamond, cur, nky, tries
GoSub gtdat
lytim& = Int(Timer * 1000)

mnlp:
Do
    ox = x: oy = y
    Select Case InKey$
        Case Chr$(0) + "H"
            up = 1: dn = 0: lt = 0: rt = 0
        Case Chr$(0) + "P"
            dn = 1: up = 0: lt = 0: rt = 0
        Case Chr$(0) + "K"
            lt = 1: rt = 0: up = 0: dn = 0
        Case Chr$(0) + "M"
            rt = 1: lt = 0: up = 0: dn = 0
        Case Chr$(27)
            System
        Case "="
            ensp = ensp + 10: If ensp > 200 Then ensp = 200
        Case "-"
            ensp = ensp - 10: If ensp < 10 Then ensp = 10
        Case "l"
            GoTo loadnew
        Case "e"
            Open "editor.ini" For Output As #1
            Print #1, n$
            Close #1
            Chain "editor.exe"
        Case " "
            up = 0: dn = 0: lt = 0: rt = 0
    End Select

    locate 0,0: print lytim&
    If Int(Timer * 1000) - lytim& >= youtime Then
        If up Then y = y - 1: pc = 24: If y < 1 Then GoTo nwroom
        If dn Then y = y + 1: pc = 25: If y > 20 Then GoTo nwroom
        If lt Then x = x - 1: pc = 27: If x < 1 Then GoTo nwroom
        If rt Then x = x + 1: pc = 26: If x > 80 Then GoTo nwroom
        lytim& = Int(Timer * 1000)
    End If

    Select Case Screen(y, x)
        Case 21
            GoSub savspot
            x = ox: y = oy: up = 0: dn = 0: lt = 0: rt = 0
        Case 233
            GoTo youredead
        Case 176
            Call Warp(x, y)
        Case 4
            GoSub addiamond
        Case 8
            GoSub opndoor
            x = ox: y = oy: up = 0: dn = 0: lt = 0: rt = 0
        Case 5
            GoTo youwin
        Case 244
            GoSub adky
        Case 32 'nothing
        Case 88 'go right over it
        Case pc 'yep
        Case Else
            x = ox: y = oy: up = 0: dn = 0: lt = 0: rt = 0
    End Select
    ld = 0
    If bm Then GoSub Updatebomb
    If ar Then GoSub Updatearrow
    If en Then GoSub Updateenemy
    If ld Then GoSub losediamond
    Locate y, x 'places you on the screen at x, y
    Color 2 '
    Print Chr$(pc) 'pc is the ASCII code, selected above,
    Color 7 'for the facing you have on the screen.
    If oy <> y Or ox <> x Then
        Locate oy, ox
        Print Chr$(32)
    End If
Loop

Updatebomb:
If Timer - lbtim < (bombtime / 1000) Then Return
lbtim = Timer
bb = 1
Do
    ooy = by(bb): oox = bx(bb)
    If x = bx(bb) And Not dead Then
        by(bb) = by(bb) + 1
    Else
        by(bb) = by(bb) - 1
    End If

    If by(bb) < 1 Or by(bb) > 20 Then by(bb) = ooy
    If Screen(by(bb), bx(bb)) = 233 Then 'did we hit a mine?
        Killdude bx(), by(), bb, bm
        Locate ooy, oox: Print " "
    Else
        If Screen(by(bb), bx(bb)) = pc Then ld = -1
        If Screen(by(bb), bx(bb)) = 176 Then Call Warp(bx(bb), by(bb))

        If Screen(by(bb), bx(bb)) = 234 Then
            Killdude ex(), ey(), Whichone(ex(), ey(), bx(bb), by(bb), en), en
        End If
        If Screen(by(bb), bx(bb)) = 16 Or Screen(by(bb), bx(bb)) = 17 Then
            w = Whichone(ax(), ay(), bx(bb), by(bb), ar)
            Killdude ax(), ay(), w, ar
            For t = w To ar
                If t < 10 Then adr(t) = adr(t + 1)
            Next t
        End If

        If Screen(by(bb), bx(bb)) <> 32 And Screen(by(bb), bx(bb)) <> 88 Then by(bb) = ooy

        Locate by(bb), bx(bb)
        Color 13
        Print Chr$(127)
        Color 7
        If ooy <> by(bb) Or oox <> bx(bb) Then
            Locate ooy, oox:
            Print " "
        End If
    End If
    bb = bb + 1
Loop While bb <= bm
Return

Updatearrow:
If Timer - latim < (arrowtime / 1000) Then Return
latim = Timer
bb = 1
Do
    ooy = ay(bb): oox = ax(bb)

    If y = ay(bb) And Not dead Then
        ax(bb) = ax(bb) + adr(bb)
    Else
        ax(bb) = ax(bb) - adr(bb)
    End If

    If ax(bb) < 1 Or ax(bb) > 80 Then ax(bb) = oox

    If Screen(ay(bb), ax(bb)) = 233 Then
        Killdude ax(), ay(), bb, ar
        For t = bb To ar
            If t < 10 Then adr(t) = adr(t + 1)
        Next t
        Locate ooy, oox: Print " "
    Else
        If Screen(ay(bb), ax(bb)) = pc Then ld = -1
        If Screen(ay(bb), ax(bb)) = 176 Then Call Warp(ax(bb), ay(bb))

        If Screen(ay(bb), ax(bb)) = 234 Then
            Killdude ex(), ey(), Whichone(ex(), ey(), ax(bb), ay(bb), en), en
        End If

        If Screen(ay(bb), ax(bb)) = 127 Then
            Killdude bx(), by(), Whichone(bx(), by(), ax(bb), ay(bb), bm), bm
        End If

        If Screen(ay(bb), ax(bb)) <> 88 Then
            If Screen(ay(bb), ax(bb)) <> 32 Then ax(bb) = oox
        End If

        Locate ay(bb), ax(bb)
        Color 2
        Print Chr$(-16 * (adr(bb) = 1) - 17 * (adr(bb) = -1))
        Color 7
        If oox <> ax(bb) Or ooy <> ay(bb) Then Locate ooy, oox: Print " "
    End If
    bb = bb + 1
Loop While bb <= ar
Return

Updateenemy:
If Timer - letim < (enemytime / 1000) Then Return
letim = Timer 'only updates every <enemytime> milliseconds

bb = 1 'enemy number
Do
    oox = ex(bb): ooy = ey(bb) 'sets old position
    seen = LineofSight(x, y, ex(bb), ey(bb)) 'tests line of sight

    If seen And Not dead Then 'they're gonna chase you!

        'this is a hugely nested IF statement!

        If Rnd(1) > .2 Then
            If Abs(ex(bb) - x) >= Abs(ey(bb) - y) Then 'move him towards you
                ex(bb) = ex(bb) + Sgn(x - ex(bb))
            Else
                ey(bb) = ey(bb) + Sgn(y - ey(bb))
            End If
        Else 'vary his step a bit
            If Abs(ex(bb) - x) >= Abs(ey(bb) - y) Then
                ey(bb) = ey(bb) + Int(Cos(Timer Mod 180 * 3.14 * 2 + bb) + .5)
            Else
                ex(bb) = ex(bb) + Int(Cos(Timer Mod 180 * 3.14 * 2 + bb) + .5)
            End If
        End If

    Else 'if you're not in sight

        If Rnd(1) > .5 Then 'walk him around in circles
            ey(bb) = ey(bb) + Int(Sin(Timer Mod 180 * 3.14 * 2 + bb) + .5) * ((bb Mod 2) - .5) * 2
        Else
            ex(bb) = ex(bb) + Int(Cos(Timer Mod 180 * 3.14 * 2 + bb) + .5)
        End If

    End If

    If ey(bb) < 1 Or ey(bb) > 20 Then ey(bb) = ooy 'checks to make sure the
    If ex(bb) < 1 Or ex(bb) > 80 Then ex(bb) = oox 'guy isn't off-screen

    If Screen(ey(bb), ex(bb)) = 233 Then ' if we've bumped into a mine
        Killdude ex(), ey(), bb, en ' blow him up
        Locate ooy, oox: Print " " ' and destroy the corpse
    Else ' otherwise...
        ' check for other stuff

        If Screen(ey(bb), ex(bb)) = 176 Then Warp ex(bb), ey(bb) 'warp tile

        If Screen(ey(bb), ex(bb)) = pc Then ld = -1 'he's taking
        'diamonds

        If Screen(ey(bb), ex(bb)) <> 32 Then 'if he's touching anything
            ex(bb) = oox: ey(bb) = ooy 'then move him back to his
        Else 'old position
            Locate ooy, oox: Print Chr$(32) 'otherwise move him
            Locate ey(bb), ex(bb)
            Color bb + 2 + (5 * (bb > 5)) 'selects colors for each enemy
            'COLOR 9 + seen * 5           'selects color based on line of sight
            Print Chr$(234)
            Color 7
        End If

    End If

    bb = bb + 1
Loop While bb <= en 'update the next guy

Return

nwroom:
If y > 20 Then cur = cur + 5: y = 1
If y < 1 Then cur = cur - 5: y = 20
If x > 80 Then cur = cur + 1: x = 1
If x < 1 Then cur = cur - 1: x = 80
ox = x: oy = y
Call Drawscreen(ndiamond, cur, nky, tries)
GoSub gtdat
GoTo mnlp

losediamond:
If Timer - ldtime < .5 Then Return
ldtime = Timer
ndiamond = ndiamond - 1
If ndiamond < 0 Then ndiamond = 0: GoTo youredead
Locate 22, 2
Color 15
Print "Diamonds: "; ndiamond
Color 7
'Play "L64O2BBAG"
Return

addiamond:
cn(cur) = -1
ndiamond = ndiamond + 1
Locate 22, 2
Color 15
Print "Diamonds: "; ndiamond
Color 7
'Play "L64O3cfa"
Return

opndoor:
If nky > 0 Then
    nky = nky - 1
    dr(cur) = -1
    Locate 23, 60
    Color 15
    Print "Keys: "; nky
    Color 7
    'Play "L64O0cfbO1e"
    For i = 1 To 80
        For j = 1 To 20
            If Screen(j, i) = 8 Then Locate j, i: Print " "
        Next j
    Next i
Else
    'Play "l64o0af"
End If
Return

adky:
nky = nky + 1
ky(cur) = -1
Color 15
Locate 23, 60
Print "*Keys: "; nky; "*"
Color 7
'Play "l64O3cf"
Return

youredead:
dead = -1
Locate oy, ox
Color 4
Print "X"
Locate 22, 35
Color 12
Print "You're Dead"
Color 7
'Play "l64O3cO2dO1eO0e"
t = Timer
Do
    nul$ = InKey$
    If bm Then GoSub Updatebomb
    If ar Then GoSub Updatearrow
    If en Then GoSub Updateenemy
Loop While Timer - t < 2
tries = tries - 1
If tries < 0 Then GoTo gameover
ndiamond = lastn
cur = lastsav
x = lastx
y = lasty
og1 = 0
For t = 1 To 30
    cn(t) = lastc(t)
Next t
dead = 0
GoTo nwroom

savspot:
lastn = ndiamond
lastsav = cur
lastx = x
lasty = y
For t = 1 To 30:
    lastc(t) = cn(t)
Next t
Color 14
Locate 23, 32
Print "*Continue Point*"
Color 7
'Play "L64O2cdefg"
Return

gameover:
For t = 1 To 80
    nul$ = InKey$
Next t
Locate 11, 32
Color 4
Print "G A M E  O V E R"
Sleep 2
Color 15
Locate 10, 31
Print "Play again? (Y/N)"
Do
    a$ = InKey$
    If a$ = "y" Then Goto start
Loop Until a$ = "n" Or a$ = Chr$(27)
System

youwin:
Cls
Locate 10, 36
Print "You Win!"
Locate 12, 29
Print "You got the treasure,"
Locate 13, 31
Print "plus"; ndiamond; " diamonds."
t = Timer
Do
    nul$ = InKey$
Loop While Timer - t < 4
Sleep 6
System

gtdat:
bm = 0
ar = 0
en = 0

For t = 1 To items(cur) Step 2
    F$ = room$(cur, t)
    x1 = Val(Right$(F$, Len(F$) - 1))
    y1 = Val(room$(cur, t + 1))
    x2 = Val(room$(cur, t + 2))
    y2 = Val(room$(cur, t + 3))
    Select Case Left$(F$, 1)
        Case "l" 'Walls ("l" for line)
            Call Drlin(x1, y1, x2, y2)
        Case "b" 'Big blue blocks
            Call Drblock(x1, y1, x2, y2)
        Case "s" 'For putting spaces in walls.
            Locate y1, x1
            Print Chr$(32)
        Case "p" 'Plot a single point
            Locate y1, x1
            Print Chr$(219)
        Case "w" 'Warp tile
            Locate y1, x1
            Color 12
            Print Chr$(176)
            Color 7
        Case "c" 'diamonds ("d" was already used for doors.)
            If Not cn(cur) Then
                Locate y1, x1
                Color 15
                Print Chr$(4)
                Color 7
            End If
        Case "k" 'Keys
            If Not ky(cur) Then
                Locate y1, x1
                Color 14
                Print Chr$(244)
                Color 7
            End If
        Case "d" 'Doors
            If Not dr(cur) Then
                Locate y1, x1
                Color 6
                Print Chr$(8)
                Color 7
            Else
                Locate y1, x1
                Print " "
            End If
        Case "e" 'Enemies
            en = en + 1
            ex(en) = x1
            ey(en) = y1
            Locate y1, x1
            Print Chr$(234)
        Case "v" 'Continue point ("v" was a random choice)
            Color 11
            Locate y1, x1
            Print Chr$(21)
            Color 7
        Case "Q" 'End of the game marker
            Color 13
            Locate y1, x1
            Print Chr$(5)
            Color 7
        Case "a" 'arrows
            ar = ar + 1
            ax(ar) = x1
            ay(ar) = y1
            Locate y1, x1
            If Screen(y1, x1 - 1) <> 32 Then
                Print Chr$(16)
                adr(ar) = 1
            ElseIf Screen(y1, x1 + 1) <> 32 Then
                Print Chr$(17)
                adr(ar) = -1
            Else
                Print Chr$(17)
                adr(ar) = (x1 >= 40) - (x1 < 40)
            End If
        Case "m" 'boMbs
            bm = bm + 1
            bx(bm) = x1
            by(bm) = y1
            Locate y1, x1:
            Print Chr$(127)
        Case "n" 'miNes
            Locate y1, x1
            Print Chr$(233)
        Case "o" 'origin
            If Not og1 Then
                x = x1: y = y1: og1 = -1
            End If
    End Select
Next t
Return

loadnew:
Cls
Locate 1, 1
Color 15
Do
    Input "Enter Filename for loading (8 characters or less): "; n$
Loop While Len(n$) < 1 And Len(n$) > 8
n$ = n$ + ".dat"
Open "game.ini" For Output As #1
Print #1, n$
Close #1

goto start

load:
Open n$ For Input As #1
For i = 1 To 30
    Input #1, k$
    items(i) = Val(k$)
    For j = 1 To items(i)
        Input #1, room$(i, j)
    Next j
Next i
Close
Return

Sub Drawscreen (ndiamond, cur, nky, tries)
    Color 7, 0
    Cls
    Locate 21, 1
    For t = 1 To 80: Print Chr$(178);: Next t
    For t = 1 To 80: Print Chr$(177);: Next t
    For t = 1 To 80: Print Chr$(176);: Next t
    Locate 22, 36
    Color 15
    Print "The Maze"
    Locate 22, 2
    Print "Diamonds: "; ndiamond
    Locate 22, 60
    Print "Room: "; cur
    Locate 23, 60
    Print "Keys: "; nky
    Locate 23, 2
    Print "Tries: "; tries
    Color 7
End Sub

Sub Drblock (x1, y1, x2, y2)
    Color 9
    Locate y1, x1
    For t = 0 To y2 - y1
        For r = 0 To x2 - x1
            Locate y1 + t, x1 + r
            Print Chr$(177);
        Next
    Next
    Color 7
End Sub

Sub Drlin (x1, y1, x2, y2)

    dy = y2 - y1: dx = x2 - x1: yc = y2: xc = x2

    If dx = 0 Then
        For yc = y2 To y1 Step Sgn(-dy)
            If yc > 0 And yc < 21 And xc > 0 And xc < 81 Then
                Locate yc, xc
                Print Chr$(219)
            End If
        Next yc
    Else dd = dy / dx
        For xc = x2 To x1 Step Sgn(-dx)
            tc = Int(dd * (xc - x2) + y2)
            Do While tc <> yc
                yc = yc + Sgn(-dy)
                If yc > 0 And yc < 21 And xc > 0 And xc < 81 Then
                    Locate yc, xc
                    Print Chr$(219)
                End If
            Loop
            If yc > 0 And yc < 21 And xc > 0 And xc < 81 Then
                Locate yc, xc
                Print Chr$(219)
            End If
        Next xc
    End If
End Sub

Sub Killdude (x1(), y1(), p, n)
    Locate y1(p), x1(p)
    Color 4
    Print Chr$(88)
    'Play "l64o1go0cabc"
    n = n - 1
    For i = p To n
        If i < 10 Then
            x1(i) = x1(i + 1)
            y1(i) = y1(i + 1)
        End If
    Next
End Sub

Function LineofSight (x1, y1, x2, y2)

    dy = y2 - y1: dx = x2 - x1: yc = y2: xc = x2

    LineofSight = -1

    If dx = 0 And dy = 0 Then Exit Function

    If dx = 0 Then
        For yc = y2 To y1 Step Sgn(-dy)
            If yc > 0 And yc < 21 And xc > 0 And xc < 81 Then
                If Screen(yc, xc) <> 32 And Not ((yc = y1 And xc = x1) Or (yc = y2 And xc = x2)) Then LineofSight = 0
                'LOCATE yc, xc: PRINT CHR$(88)
            End If
        Next yc
    Else dd = dy / dx
        For xc = x2 To x1 Step Sgn(-dx)
            tc = Int(dd * (xc - x2) + y2 + .5)
            Do While tc <> yc
                yc = yc + Sgn(-dy)
                If yc > 0 And yc < 21 And xc > 0 And xc < 81 Then
                    If Screen(yc, xc) <> 32 And Not ((yc = y1 And xc = x1) Or (yc = y2 And xc = x2)) Then LineofSight = 0
                    'LOCATE yc, xc: PRINT CHR$(88)
                End If
            Loop
            If yc > 0 And yc < 21 And xc > 0 And xc < 81 Then
                If Screen(yc, xc) <> 32 And Not ((yc = y1 And xc = x1) Or (yc = y2 And xc = x2)) Then LineofSight = 0
                'LOCATE yc, xc: PRINT CHR$(88)
            End If
        Next xc
    End If

End Function

Sub Warp (x, y)
    'Play "l64o3cego2bdfa"
    Do
        x = Int(Rnd(1) * 80) + 1
        y = Int(Rnd(1) * 20) + 1
    Loop While Screen(y, x) <> 32
End Sub

Function Whichone (xx(), yy(), x, y, n)
    For i = 1 To n
        If xx(i) = x And yy(i) = y Then Whichone = i
    Next
End Function

Meta