Assassins 64: Blast from the past

[kinem]

Here's my latest version of the old (2001) game. I've worked a bit on the bad guys' behavior recently, so it's a bit better (I think) than the version I posted recently on the old forum.

Code: (Select All)

'1PSA64-3.BAS by Dr. Jacques Mallah (jackmallah@yahoo.com)
'Compile with QB64
DECLARE SUB endit () : DECLARE SUB onscreen () : DECLARE SUB paintsprites ()
DECLARE SUB medkit.etc () : DECLARE SUB showhealth () : DECLARE SUB badguys ()
DECLARE SUB yourmove () : DECLARE SUB time () : DECLARE SUB yourshot ()
DECLARE SUB crashtest (bx!, by!, vx!, vy!) : DECLARE FUNCTION atan2! (y!, x!)
DECLARE SUB showbadguy (b%) : DECLARE SUB showbadshot (x%) : DECLARE SUB showurshot (x%)
DECLARE SUB raycast () : DECLARE SUB btexture (xx%, dd%, bcc%, c%, bcc2%)
DECLARE SUB putcircle (x%, y%, R%, col%, circdis!) : DECLARE SUB showmed (b%)
DECLARE SUB putbox (x1!, y1%, x2!, y2%, col%, boxdis!): declare sub readmap()
DECLARE SUB intro () : DECLARE SUB maketables () : DECLARE SUB makeworld ()
DECLARE SUB hLINE (x1%, x2%, y%, c%) : DECLARE SUB vline (x%, yt%, yb%, c%), keys()
declare function lsight%(b%): ntx% = 7: sizey% = 30: sizex% = 60: shift = 49
Dim kbmatrix%(128), odd%(319)
Dim fmap%(sizex% - 1, sizey% - 1), wdis(319), testin%(ntx%, 63, 63), dsfc(319)
Dim cmap%(sizex% - 1, sizey% - 1), sb1%(159, 199), st(1800), ct(1800), hicol%(255)
Dim map%(sizex% - 1, sizey% - 1), tant(1800), xb%(1800), yb%(1800), sb2%(160 * 192 + 1)
Dim lowcol%(-128 To 127), bicol%(255), atx%(319), ammo%(2), oammo%(2), stt(1800), ctt(1800)
Call readmap: c% = nmeds% + nammo% - 1: ReDim med%(c%), scmed(c%), mx(c%), my(c%)
ReDim medis(c%), medx(c%), medy(c%), dis(nspr%), spord%(nspr%), disi%(nspr%)
ReDim sht(nshots%), shosht%(nshots%), shtx(nshots%), shty(nshots%), vshx(nshots%), vshy(nshots%)
ReDim shtang%(nshots%), shtdis(nshots%), dela%(nshots%), shtht%(nshots%), plasma%(nshots%)
ReDim bgh%(nbguysm1%), bgx(nbguysm1%), bgy(nbguysm1%), robo%(nbguysm1%)
ReDim x(nbguysm1%), y(nbguysm1%), vbx(nbguysm1%), vby(nbguysm1%)
ReDim scbg(nbguysm1%), bgang%(nbguysm1%), bgsht(nbguysm1%), lastx(nbguysm1%), lasty(nbguysm1%)
ReDim bgshosht%(nbguysm1%), bgshtx(nbguysm1%), bgshty(nbguysm1%)
ReDim bgvshx(nbguysm1%), bgvshy(nbguysm1%), bgshtdis(nbguysm1%)
ReDim bgdela%(nbguysm1%), bgshtht%(nbguysm1%), active%(nbguysm1%): _FullScreen: delta.t = .1
Call intro: maketables: makeworld: Get (0, 8)-(319, 199), sb2%()

main: raycast: keys: yourshot: time: yourmove: badguys: showhealth: medkit.etc
Call paintsprites: onscreen: endit: GoTo main

spritedata:
Data 0,6,2,1,0,4,""

'Map: each character (>"0") is a color or texture
'0 is empty space.  Outer walls must not contain any 0's, ?'s, or r's
'1, 2, 3, 4, 5, 6, 7, 8, 9, :, ;, <, +, >, @, A are wall textures
'4 is the map, A is the rainbow
'? is an ice block "door"
'r is random: 50% chance of ice, else texture @

'. = empty, B = bad guy, R = robot, M = medkit, L = ammo, P = the President / player
mapdata:
Data "666666667546C66666666666666666666666666666666666666666666666"
Data "6.R..?.......6....M6L..................RR?................L6"
Data "6....1.......A.....?...................BB3................M6"
Data "6....1.......@.....6662?266666662526666666666664?766666666?6"
Data "6....1.......?.....6.....................6.................6"
Data "6....1.......>.....6.....................?.................6"
Data "6....1.......=.....6.....................6.................1"
Data "6....?.......<.....666666666444666666666?6.................1"
Data "6....2.......;.....6.........1...........6.......BBBB......1"
Data "6....2.......:.....6..BBBB...2......B....?.................6"
Data "6....2.......9.....6..BBBB...3...........6.................6"
Data "6....2.......8.....6.........4...........6.................6"
Data "6....?.......7.....6.........A777777777776666664?76666666666"
Data "6....3.......6.....6.......................................6"
Data "6....3.......5.....6.......................................6"
Data "6....3.......4.....7.......................................6"
Data "6....?.......3.....6.......................................6"
Data "6....4BBB....2..R..6.......................................6"
Data "6....4BBB....1LMMM612?45633?333333333333?33336.............6"
Data "6....4BBB....6657666.....6...................6.............6"
Data "6....4BBB....?.LLL.6.....6...................6.............6"
Data "6....4BBB....?.MMM.6.....6.......BBB.........?.............6"
Data "6....555555555555556.....r...................6.............6"
Data "6.........?.....M..6.....6...................6666666466666?6"
Data "6.........r........6.....6AAAAAAA?AAAAAAAAAA46.............3"
Data "6.........r........A.........................6.............4"
Data "6..B......r........A..BBBB...................?.............1"
Data "6.........r.....P..A.........................6...RRRR......2"
Data "6.........r.....L..A.............LLLLMMMM....6.............6"
Data "6155555555555556AAA66666666666666AAA666656666666666656666666"

Rem $STATIC
Function atan2 (y, x)
    If x = 0 Then
        If y > 0 Then atan2 = 90 Else If y < 0 Then atan2 = 270
    ElseIf x > 0 Then
        atan2 = (Atn(y / x) * 57.2958 + 360) Mod 360
    Else
        atan2 = (Atn(y / x) * 57.2958 + 180)
    End If
End Function

Sub badguys
    Shared nbguysm1%, testin%(), bgx(), bgy(), delta.t, bgh%(), dis()
    Shared px, py, bx, by, vx, vy, fdt, scbg(), bgang%(), x(), y(), fram%, ph%
    Shared bgsht(), bgshosht%(), bgvshx(), bgvshy(), ct(), st(), bgshtdis()
    Shared inx%, iny%, map%(), fmap%(), bsa%, bgshtx(), bgshty(), bgdela%()
    Shared bgshtht%(), nbguys%, vbx(), vby(), snd%, kills%, robo%(), active%(), lastx(), lasty()

    For x% = 0 To nbguysm1%
    testin%(4, Int(bgx(x%)) + 2, Int(bgy(x%)) + 19) = 0: Next

    'bad guys: Note: I want to add some AI!
    damp = .8 ^ fdt: sqrdt = Sqr(delta.t) * 6
    For x% = 0 To nbguysm1%

        If bgh%(x%) > 0 Then
            If lsight%(x%) Then
                active%(x%) = 1: lastx(x%) = bx: lasty(x%) = by
            Else
                If active%(x%) = 1 Then active%(x%) = 2
            End If

            bbgx = px - bgx(x%): bbgy = py - bgy(x%)
            dis(x%) = Sqr(bbgx * bbgx + bbgy * bbgy) + .01

            chase = 2 * delta.t * (1 + robo%(x%)) * -(active%(x%) > 0)
            bbgx = lastx(x%) - bgx(x%): bbgy = lasty(x%) - bgy(x%)
            cdis = Sqr(bbgx * bbgx + bbgy * bbgy) + .01
            If active%(x%) = 2 And cdis < .3 Then active%(x%) = 0

            vbx(x%) = vbx(x%) * damp + (Rnd - .5) * sqrdt + bbgx / cdis * chase
            vby(x%) = vby(x%) * damp + (Rnd - .5) * sqrdt + bbgy / cdis * chase
            If (px - bgx(x%)) ^ 2 + (py - bgy(x%)) ^ 2 < 1 Then
                vbx(x%) = vbx(x%) - bbgx / dis(x%) * fdt
                vby(x%) = vby(x%) - bbgy / dis(x%) * fdt
                vx = vx + bbgx / dis(x%) * fdt
                vy = vy + bbgy / dis(x%) * fdt
            End If

            'don't crowd bad guys
            For y% = 0 To nbguysm1%
                If x% <> y% And bgh%(y%) > 0 Then
                    bsdis = Sqr((bgy(x%) - bgy(y%)) ^ 2 + (bgx(x%) - bgx(y%)) ^ 2 + .01)
                    If bsdis < 1 Then
                        vbx(x%) = vbx(x%) - (bgx(y%) - bgx(x%)) / bsdis * fdt
                        vby(x%) = vby(x%) - (bgy(y%) - bgy(x%)) / bsdis * fdt
                    End If
            End If: Next

            svx% = Sgn(vbx(x%)): svy% = Sgn(vby(x%))
            crashtest bgx(x%) + .15 * svx%, bgy(x%) + .15 * svy%, vbx(x%), vby(x%)
            If map%(inx%, iny%) = 15 And active%(x%) = 0 Then active%(x%) = 3: icex = inx%: icey = iny%
            crashtest bgx(x%) - .15 * svx%, bgy(x%) + .15 * svy%, vbx(x%), vby(x%)
            If map%(inx%, iny%) = 15 And active%(x%) = 0 Then active%(x%) = 3: icex = inx%: icey = iny%
            crashtest bgx(x%) + .15 * svx%, bgy(x%) - .15 * svy%, vbx(x%), vby(x%)
            If map%(inx%, iny%) = 15 And active%(x%) = 0 Then active%(x%) = 3: icex = inx%: icey = iny%

            bgx(x%) = bgx(x%) + vbx(x%) * delta.t: bgy(x%) = bgy(x%) + vby(x%) * delta.t
            scbg(x%) = 2 / (dis(x%) + .01)
            bgang%(x%) = atan2(bgy(x%) - by, bgx(x%) - bx) * 5
            delba% = (bgang%(x%) - bsa% + 1800) Mod 1800
            x(x%) = delba% - scbg(x%) * 20: y(x%) = 100 - 25 * scbg(x%)

            'bad guy's shot
            If bgsht(x%) <= 0 And active%(x%) = 1 Or active%(x%) = 3 Then
                bgsht(x%) = 20 + Rnd: bgshosht%(x%) = 1: 'create shot
                bgshtx(x%) = bgx(x%): bgshty(x%) = bgy(x%)
                If active%(x%) = 3 Then active%(x%) = 0: bgang%(x%) = atan2(bgy(x%) - icey, bgx(x%) - icex) * 5
                bgsta% = (bgang%(x%) + 900) Mod 1800
                bgvshx(x%) = ct(bgsta%) * 7
                bgvshy(x%) = st(bgsta%) * 7

                'test if other bad guys are blocking the shot; if so don't shoot
                tbsx = bgx(x%): tbsy = bgy(x%): tbsvx = bgvshx(x%): tbsvy = bgvshy(x%)
                Do: tbsx = tbsx + tbsvx * delta.t: tbsy = tbsy + tbsvy * delta.t
                    crashtest tbsx, tbsy, tbsvx, tbsvy: k% = map%(inx%, iny%)
                    For y% = 0 To nbguysm1%
                        If x% <> y% And bgh%(y%) > 0 Then
                            bsdis = Sqr((tbsy - bgy(y%)) ^ 2 + (tbsx - bgx(y%)) ^ 2 + .01)
                            If bsdis < .5 Then k% = -1
                    End If: Next
                    bsdis = Sqr((tbsy - by) ^ 2 + (tbsx - bx) ^ 2 + .01)
                    If bsdis < .5 Then k% = -2
                Loop Until k%
                If k% = -1 Then bgsht(x%) = 0: bgshosht%(x%) = 0
            End If
        End If

        'bad guy's shot
        If bgsht(x%) > 0 And bgshosht%(x%) Then
            crashtest bgshtx(x%), bgshty(x%), bgvshx(x%), bgvshy(x%)
            k% = map%(inx%, iny%)
            If k% Then
                bgshosht%(x%) = 0
                If k% = 15 And bgsht(x%) > 0 Then
                    map%(inx%, iny%) = 0
                    testin%(4, inx% + 2, iny% + 19) = 0
                End If
            Else
                bgshtx(x%) = bgshtx(x%) + bgvshx(x%) * delta.t
                bgshty(x%) = bgshty(x%) + bgvshy(x%) * delta.t
                bbx = bgshtx(x%) - bx: bby = bgshty(x%) - by
                bgshtang% = atan2(bby, bbx) * 5
                bgshtdis(x%) = Sqr(bby * bby + bbx * bbx + .01)
                dis(x% + nbguys%) = bgshtdis(x%)
                'fix damage test
                If bgshtdis(x%) < .5 Then
                    ph% = ph% - bgsht(x%) / 4 - 2.5 * (1 + robo%(x%)): bgshosht%(x%) = 0
                    If snd% Then Sound 150, 1
                    vx = vx + bgvshx(x%) * .05: vy = vy + bgvshy(x%) * .05
                End If
                'kill each other?
                For y% = 0 To nbguysm1%
                    If x% <> y% And bgh%(y%) > 0 Then
                        bsdis = Sqr((bgshty(x%) - bgy(y%)) ^ 2 + (bgshtx(x%) - bgx(y%)) ^ 2 + .01)
                        If bsdis < .5 Then
                            bgh%(y%) = bgh%(y%) - bgsht(x%) / 2 - 1: bgshosht%(x%) = 0
                            vbx(y%) = vbx(y%) + bgvshx(x%) * .5: vby(y%) = vby(y%) + bgvshy(x%) * .5
                            If bgh%(y%) < 1 Then
                                fmap%(Int(bgx(y%)), Int(bgy(y%))) = 4 + 4 * robo%(y%)
                                kills% = kills% + 1: Exit For
                            End If
                        End If
                End If: Next
                bgdela%(x%) = (bgshtang% - bsa% + 1800) Mod 1800
                bgshtht%(x%) = 30 / bgshtdis(x%)
            End If
        End If
        If bgsht(x%) > 0 Then bgsht(x%) = bgsht(x%) - fdt

        If fram% / 2 = fram% \ 2 Then
            testin%(4, Int(px) + 2, Int(py) + 19) = 1
            If bgh%(x%) > 0 Then testin%(4, Int(bgx(x%)) + 2, Int(bgy(x%)) + 19) = 4 + 4 * robo%(x%)
        End If
    Next x%
End Sub

Sub crashtest (bx, by, vx, vy): 'note vx & vy args must be byref
    Shared map%(), delta.t, inx%, iny%
    Static oinx%, oiny%, nallcl%, chn2%, xsign%, ysign%, k%, kx%, ky%

    oinx% = Int(bx): oiny% = Int(by): nallcl% = 1
    px = bx + vx * delta.t: py = by + vy * delta.t
    inx% = Int(px): iny% = Int(py)
    ysign% = Sgn(vy): xsign% = Sgn(vx)
    chn2% = (inx% - oinx%) * xsign% + (iny% - oiny%) * ysign%
    k% = map%(inx%, iny%)
    If inx% = oinx% Then horz% = 1
    If iny% = oiny% Then vert% = 1
    If chn2% = 2 Then
        ys% = (1 + ysign%) \ 2: xs% = (1 + xsign%) \ 2
        kx% = map%(oinx%, iny%): ky% = map%(inx%, oiny%)
        tstang% = Sgn((px - bx) * (iny% + 1 - ys% - by) - (py - by) * (inx% + 1 - xs% - bx))
        tst% = xsign% * ysign% * tstang%
        If tst% = 1 And k% + ky% = 0 Then nallcl% = 0
        If tst% = -1 And k% + kx% = 0 Then nallcl% = 0
        If ky% = 0 Then
            horz% = 1
        Else
            vert% = 1: k% = ky%: If tst% = 1 Then iny% = oiny%
        End If
        If kx% Then
            horz% = 1: k% = kx%: If tst% = -1 Then inx% = oinx%
        Else
            vert% = 1
        End If
    End If: If k% = 0 Then nallcl% = 0
    If nallcl% Then
        If horz% And vert% And ky% = 0 And kx% = 0 Then
            If tst% = 1 Then horz% = 0 Else vert% = 0
        End If
        If vert% Then vx = 0
        If horz% Then vy = 0
    End If
End Sub

Function lsight% (b%)
    Shared map%(), delta.t, inx%, iny%, px, py, bgx(), bgy()
    delx = bgx(b%) - px: dely = bgy(b%) - py: delmag = Sqr(delx ^ 2 + dely ^ 2)
    lx = px: ly = py: delx = delx / delmag / delta.t: dely = dely / delmag / delta.t: lt% = 0
    Do: crashtest lx, ly, delx, dely: lx = lx + delx * delta.t: ly = ly + dely * delta.t
        lt% = lt% + 1
    Loop Until map%(inx%, iny%) Or lt% >= delmag
    lsight% = (map%(inx%, iny%) = 0)
End Function

Sub endit
    Shared kills%, nbguysm1%, nbguys%, kbmatrix%(), goon%, ph%, bgh%(), snd%

    If kbmatrix%(1) - 1 And ph% > 0 And kills% < nbguys% Then
        goon% = 2
    Else
        goon% = goon% - 1
    End If
    If goon% = 0 Then
        Locate 2, 1:
        If kills% = nbguys% And ph% > 0 Then
            Print "President Snore, you made it!": If snd% Then Play "mf gcfde"
        Else
            Print "You die"
            For t% = 400 To 200 Step -20
                If snd% Then Sound t%, 1
                tim = Timer: Do: Loop Until Timer > tim
            Next
        End If
        tim = Timer + .5: Do: Loop Until Timer > tim
        Sleep 1: End
    End If
End Sub

Sub hLINE (x1%, x2%, y%, c%)
    Shared sb1%(), hicol%(): ccc% = hicol%(c%) + c%
    If x1% < 0 Then x1% = 0
    If x2% > 319 Then x2% = 319
    For x% = Int(x1% / 2) To Int(x2% / 2)
        sb1%(x%, y%) = ccc%
    Next
End Sub

Sub intro: Shared snd%, nbguys%, nrobo%
    Cls: Print "By Dr. Jacques Mallah", , "Assassins Edition.64"
    Print: Print "In the year 3001 AD:"
    Print "You, President Sal Snore of the United Snows of Antarctica,"
    Print "are trapped in the Wight House with a bunch of guys trying to kill you. "
    Print "They also reprogrammed your robot bodyguard(s).": Print
    Print "Luckily, you have your trusty plasma gun (press 1) and machine gun (press 2)"
    Print "and plas-cannon (press 3; uses plasma gun ammo)."
    Print "Hiding's not your style.  You'll show them who's the boss!"
    Print "Kill 'em all to win.  ("; nbguys% - nrobo%; " guy(s) and "; nrobo%; " robot(s))": Print
    Print "use arrow forward, back to move; use arrow left, right to rotate"
    Print "Alt to strafe with arrow left, right"
    Print "Ctrl to shoot"
    Print "To fight, try getting some distance and using strafe"
    Print "Try shooting out some ice blocks"
    Print "pick up ";: Color 0, 2: Print "-";: Color 7, 0: Print " ammo, and ";
    Color 4, 15: Print "+";: Color 7, 0: Print " medical kits when needed"
    Print "After starting, press Esc to take the easy way out - suicide!"
    Print "press any key to start, SPACE for no sound": Print
    Print "The # at the top left corner is frames per second"
    Print "The bar at the bottom is your health."
    Print "j to toggle cheat mode";
    i$ = Input$(1): If i$ <> " " Then snd% = 1
End Sub

Sub maketables
    Shared st(), ct(), dsfc(), hicol%(), lowcol%(), bicol%(), atx%(), tant()
    Shared xb%(), yb%(), spord%(), nspr%, stt(), ctt()
    For tmp1% = 0 To 1800
        st(tmp1%) = Sin(tmp1% * Atn(1) / 225): stt(tmp1%) = st(tmp1%) * 256
        ct(tmp1%) = Cos(tmp1% * Atn(1) / 225): ctt(tmp1%) = ct(tmp1%) * 256
    Next tmp1%
    st(0) = 10 ^ -9: st(900) = 10 ^ -9: st(1800) = st(0)
    stt(0) = 10 ^ -7: stt(900) = 10 ^ -7
    ct(450) = 10 ^ -9: ct(1350) = 10 ^ -9
    ctt(450) = 10 ^ -7: ctt(1350) = 10 ^ -7
    For t% = 0 To 1800
        sqct = Abs(1 / ct(t%)): sqt = Abs(1 / st(t%))
        If sqt > sqct Then nn = sqct * 255 Else nn = sqt * 255
        xb%(t%) = ct(t%) * nn: yb%(t%) = st(t%) * nn
    tant(t%) = st(t%) / ct(t%): Next
    yb%(0) = 0: yb%(900) = 0
    xb%(450) = 0: xb%(1350) = 0
    For x% = 0 To 319
        atx%(x%) = Atn((x% - 160) * 3.14159 / 900) * 900 / 3.14159
        dsfc(x%) = 100 / Abs(ct((atx%(x%) + 1800) Mod 1800))
    Next
    For c% = 0 To 255
        hicol%(c%) = &H100 * (c% + &H100 * (c% > &H7F))
        lowcol%(c% - 128) = c% - 128 - &H100 * ((c% - 128) < 0)
        bicol%(c%) = &H100 * (c% + &H100 * (c% > &H7F)) + c%
    Next
    For x% = 0 To nspr%: spord%(x%) = x%: Next
End Sub

Sub readmap
    Shared fmap%(), sizex%, sizey%, testin%(), hicol%(), cmap%(), map%(), ntx%
    Shared ph%, nbguysm1%, bgh%(), bgy(), bgx(), oldtim, nmeds%, medx(), medy()
    Shared nshots%, med%(), ammo%(), weap$, px, py, sa, nmeds%, nammo%, robo%()
    Shared maxshots%, nbguys%, nshots%, nspr%, nbguyst2%, nrobo%
    Shared scmed(), mx(), my(), medis()
    Shared F0%, F1%, F2%, F3%, F4%, F5%, bg$
    DefInt N
    Randomize Timer: nmeds% = 0: nammo% = 0: px = 17.5: py = 27.5: sa = 1190
    Read F0%, F1%, F2%, F3%, F4%, F5%, bg$: nb = 0

    For y = 0 To sizey% - 1: Read i$: For x = 0 To sizex% - 1
        ii$ = Mid$(i$, x + 1, 1): map%(x, y) = Asc(ii$) - 48
        If ii$ = "." Then map%(x, y) = 0
            If ii$ = "B" Or ii$ = "R" Then nb = nb + 1: If ii$ = "R" Then nrobo% = nrobo% + 1
            If map%(x, y) = 66 Then map%(x, y) = 16 + (Rnd < .5)
            If map%(x, y) < 0 Then map%(x, y) = map%(x, y) + 256
            If y = 0 Or x = 0 Or y = sizey% - 1 Or x = sizex% - 1 Then
                If map%(x, y) = 0 Then map%(x, y) = 14
                If map%(x, y) = 15 Then map%(x, y) = 14
            End If
            If ii$ = "M" Then nmeds% = nmeds% + 1
            If ii$ = "L" Then nammo% = nammo% + 1
            If ii$ = "P" Then px = x + .5: py = y + .5: map%(x, y) = 0
    Next: Next

    maxshots% = 9: nbguys% = nb: nbguysm1% = nbguys% - 1: nbguyst2% = nbguys% * 2
    nshots% = maxshots%: nspr% = maxshots% + nbguyst2% + nmeds% + nammo%
End Sub


Sub makeworld
    Shared fmap%(), sizex%, sizey%, testin%(), hicol%(), cmap%(), map%(), ntx%
    Shared ph%, nbguysm1%, bgh%(), bgy(), bgx(), oldtim, nmeds%, medx(), medy()
    Shared nshots%, med%(), ammo%(), weap$, px, py, sa, nmeds%, nammo%, robo%()
    Shared maxshots%, nbguys%, nshots%, nspr%, snd%
    Shared scmed(), mx(), my(), medis()
    Shared F0%, F1%, F2%, F3%, F4%, F5%, bg$
    DefInt N, T, X-Y
    Screen 13: nb = 0: nm = 0: nam = nmeds%: If snd% Then Play "mb"
    nshots% = 1: weap$ = " plasma gun": ammo%(0) = 24: ammo%(1) = 200

    For y = 1 To sizey% - 2: For x = 1 To sizex% - 2

        If map%(x, y) = 18 Then map%(x, y) = 0: bgx(nb) = x + .5: bgy(nb) = y + .5: nb = nb + 1
            If map%(x, y) = 34 Then
                map%(x, y) = 0: bgx(nb) = x + .5: bgy(nb) = y + .5: robo%(nb) = 1: nb = nb + 1
            End If
            If map%(x, y) = Asc("M") - 48 Then
                medx(nm) = x + .5: medy(nm) = y + .5: map%(x, y) = 0: med%(nm) = 1: nm = nm + 1 'meds
            End If
            If map%(x, y) = Asc("L") - 48 Then
                medx(nam) = x + .5: medy(nam) = y + .5: map%(x, y) = 0: med%(nam) = 1: nam = nam + 1 'ammo
            End If

    Next: Next

    For t = 0 To ntx%: For x = 0 To 63: For y = 0 To 63
        testin%(t, x, y) = (t * 14 + Sqr((x - 32) ^ 2 + (y - 32 - Rnd * t) ^ 2)) Mod 256
        testin%(t, x, y) = testin%(t, x, y) + hicol%(t + 1 + (Rnd < .1))
    Next: Next: Next

    For x = 2 To 61: For y = 19 To 48
    testin%(4, x, y) = map%(x - 2, y - 19): Next: Next
    For x = 0 To 59: For y = 0 To 29: fmap%(x, y) = ((x + y) Mod 16) + 128
        If map%(x, y) = 15 Then fmap%(x, y) = 15
            Next: Next: For x = 16 To 18: For y = 26 To 28
    fmap%(x, y) = 208: Next: Next
    fmap%(39, 15) = -7: fmap%(24, 10) = -2: fmap%(17, 25) = 0
    For x = 20 To 35: fmap%(x, 25) = 20 - x: Next

    For x = 0 To 59: For y = 0 To 29: cmap%(x, y) = 26
        If x / 2 = x \ 2 Or y / 2 = y \ 2 Then cmap%(x, y) = 27
            If x / 2 = x \ 2 And y / 2 = y \ 2 Then cmap%(x, y) = 15
            Next: Next: For x = 16 To 18: For y = 26 To 28
    cmap%(x, y) = 208: Next: Next: cmap%(17, 27) = 15

    Color 16: Print "Abandon": Print "all dope"
    Print "Your ad": Print "  here:": Print " $100": Print " Call"
    Print " 1-800-": Print " EATS": Print "  ???": Print " QB 64"
    Print " I  $": Print: Print " Wight": Print " House": Print " HIT"
    Print: Print " Who's": Print "da man?": Print " Please": Print "recycle"
    Print "   JM": For x = 0 To 63: For y = 0 To 15
        If Point(x, y) Then testin%(1, x, y + 1) = 15
            If Point(x, y + 16) Then testin%(5, x, y + 8) = 0
            If Point(x, y + 32) Then testin%(5, x, y + 24) = 0
            If Point(x, y + 48) Then testin%(5, x, y + 40) = 0
            If Point(x, y + 64) Then testin%(6, x, y + 32) = 7
            If Point(x, y + 80) Then testin%(2, x, y + 1) = 4
            If Point(x, y + 96) Then testin%(4, x, y + 1) = 15
            If Point(x, y + 112) And y < 8 Then testin%(5, x, y + 56) = 0
            If Point(x, y + 128) Then testin%(3, x, y + 48) = 1
            If Point(x, y + 144) Then testin%(0, x, y + 48) = 6
            If Point(x, y + 160) Then testin%(7, x, y + 32) = 9
    Next: Next: Color 15
    For x = 0 To 63: For y = 0 To 63
        t = 15: If (Rnd * 60 > y) Then t = 24 + Rnd * 6
            testin%(7, x, y) = (testin%(7, x, y) And &HFF) + hicol%(t)
    Next: Next

    ph% = 100: For x% = 0 To nbguysm1%: bgh%(x%) = 100: If robo%(x%) Then bgh%(x%) = 1250
        If bgx(x%) = 0 Then
            randloc:
            bgx(x%) = Int(Rnd * (sizex% - 1) + 1) + .5
            bgy(x%) = Int(Rnd * (sizey% - 1) + 1) + .5
            If map%(Int(bgx(x%)), Int(bgy(x%))) GoTo randloc
        End If
    Next: oldtim = Timer

End Sub

DefSng T, X-Y
Sub medkit.etc: 'medkits and ammo boxes
    Shared nmeds%, medis(), nbguyst2%, maxshots%, medx(), medy(), scmed(), dis()
    Shared mx(), my(), ph%, bx, by, bgx(), bgy(), bgh%(), med%(), nbguysm1%, bsa%
    Shared ammo%(), nammo%, robo%()

    For x% = 0 To nmeds% + nammo% - 1
        If med%(x%) Then
            medis(x%) = Sqr((bx - medx(x%)) ^ 2 + (by - medy(x%)) ^ 2)
            dis(x% + nbguyst2% + maxshots% + 1) = medis(x%)
            scmed(x%) = 3 / (dis(x% + nbguyst2% + maxshots% + 1) + .01)
            bgang% = atan2(medy(x%) - by, medx(x%) - bx) * 5
            delba% = (bgang% - bsa% + 1800) Mod 1800
            mx(x%) = delba% - scmed(x%) * 10: my(x%) = 100 + 15 * scmed(x%)
            If medis(x%) < .36 Then
                If x% < nmeds% And ph% < 95 Then
                    med%(x%) = 0: ph% = ph% + 35: If ph% > 98 Then ph% = 98
                End If
                If x% >= nmeds% Then
                    med%(x%) = 0: ammo%(0) = ammo%(0) + 16: ammo%(1) = ammo%(1) + 100
                End If
            End If
            For y% = 0 To nbguysm1%
                If bgh%(y%) > 0 And robo%(y%) = 0 Then
                    bsdis = (bgx(y%) - medx(x%)) * (bgx(y%) - medx(x%)) + (bgy(y%) - medy(x%)) * (bgy(y%) - medy(x%))
                    If med%(x%) And bsdis < .6 And bgh%(y%) < 95 And y% <> 8 And x% < nmeds% Then
                        med%(x%) = 0: bgh%(y%) = bgh%(y%) + 35: If bgh%(y%) > 98 Then bgh%(y%) = 98
                    End If
            End If: Next
    End If: Next

End Sub

Sub onscreen
    Shared bitex%, fire, sb1%(), mg%, omg%, weap$, ammo%(), oammo%(), sb2%()
    Shared kills%, okills%, oofram%, ofram%

    bitex% = 1: t% = (fire > 0) * 15: hLINE 155, 166, 100, -t%
    vline 160, 96, 104, 15 + t%: bitex% = 0

    'draw on screen
    Wait &H3DA, 8: 'wait for screen refresh

    For x% = 0 To 159: For y% = 8 To 199
        sb2%(2 + x% + 160 * (y% - 8)) = sb1%(x%, y%)
    Next: Next
    Put (0, 8), sb2%(), PSet


    If mg% <> omg% Or kills% > okills% Or ammo%(mg% And 1) <> oammo%(mg% And 1) Then
        Locate 1, 10: Print weap$;
        Print Using " ####"; ammo%(mg% And 1);
        Print Using " ammo ### "; kills%;: Print "kill";
        If kills% <> 1 Then Print "s"; Else Print " ";
        omg% = mg%: okills% = kills%: oammo%(mg% And 1) = ammo%(mg% And 1)
    End If
    If oofram% <> ofram% Then
        Locate 1, 1: Print Using "### fps"; ofram%;: oofram% = ofram%
    End If

End Sub

Sub paintsprites
    Shared nspr%, spord%(), dis(), nbguyst2%, nbguys%, maxshots%, disi%()

    'This uses the painter's algorithm with an exchange sort to show sprites
    For x% = 0 To nspr%: disi%(spord%(x%)) = dis(spord%(x%)) * 512: Next
    For x% = 0 To nspr% - 1: For y% = x% + 1 To nspr%
        If disi%(spord%(y%)) > disi%(spord%(x%)) Then Swap spord%(x%), spord%(y%)
        Next: Next: For xx% = 0 To nspr%
        If spord%(xx%) < nbguys% Then
            showbadguy spord%(xx%)
        ElseIf spord%(xx%) < nbguyst2% Then
            showbadshot spord%(xx%) - nbguys%
        ElseIf spord%(xx%) < nbguyst2% + maxshots% + 1 Then
            showurshot spord%(xx%) - nbguyst2%
        Else
            showmed spord%(xx%) - nbguyst2% - maxshots% - 1
    End If: Next xx%

End Sub

Sub putbox (x1, y1%, x2, y2%, col%, boxdis)
    Shared wdis()
    For x% = x1 To x2
        If x% >= 0 And x% < 320 Then
            If boxdis < wdis(x%) Then vline x%, y1%, y2%, col%
        End If
    Next
End Sub

Sub putcircle (x%, y%, R%, col%, circdis)
    Shared wdis()
    xb% = x% - R% + 1: xt% = x% + R% - 1
    If xb% > -1 And xb% < 320 Then
        If circdis < wdis(xb%) Then showc% = 1
    End If
    If xt% > -1 And xt% < 320 Then
        If circdis < wdis(xt%) Then showc% = showc% + 1
    End If
    If showc% = 1 Then
        For xx% = xb% To xt%
            If xx% > -1 And xx% < 320 Then
                If circdis < wdis(xx%) Then
                    shthtx% = R% * Sqr(1 - (xx% - x%) * (xx% - x%) / R% / R%) * .8
                    vline xx%, y% - shthtx%, y% + shthtx%, col%
                End If
            End If
        Next
    ElseIf showc% = 2 Then
        For xx% = xb% To xt%
            shthtx% = R% * Sqr(1 - (xx% - x%) * (xx% - x%) / R% / R%) * .8
            vline xx%, y% - shthtx%, y% + shthtx%, col%
        Next
    End If
End Sub

Sub raycast
    Shared wdis(), odd%(), st(), ct(), dsfc(), atx%(), hicol%(), testin%()
    Shared map%(), fmap%(), cmap%(), bicol%(), sb1%(), ntx%, gm%, xb%(), yb%()
    Shared sizex%, sizey%, lowcol%(), bx, by, efa%, px, py, bsa%, sa, stt(), ctt()
    bx = px: by = py: efa% = (sa + 1960) Mod 1800: bsa% = sa
    bxx% = bx * 256: byy% = by * 256: TIMR = Timer * 10: nttx% = 2 * ntx% + 1
    sizexf% = sizex% * 256: sizeyf% = sizey% * 256

    For x% = 0 To 319
        t% = (efa% + atx%(x%) + 1800) Mod 1800: xx% = x% \ 2

        If xx% = x% \ 2 Then
            rxx% = bxx%: ryy% = byy%: oinx% = rxx% \ 256: oiny% = ryy% \ 256
            inx% = oinx%: iny% = oiny%: ysign% = Sgn(yb%(t%)): xsign% = Sgn(xb%(t%))
            ys% = (1 - ysign%) \ 2: xs% = (1 - xsign%) \ 2
            yss& = ys% * 256 - byy%: xss& = xs% * 256 - bxx%

            'find dis & col
            oldi: Do: rxx% = rxx% + xb%(t%): ryy% = ryy% + yb%(t%)
                oinx% = inx%: oiny% = iny%
                inx% = rxx% \ &H100: iny% = ryy% \ &H100
                k% = map%(inx%, iny%)
                chn2% = (inx% - oinx%) * xsign% + (iny% - oiny%) * ysign%
            Loop Until chn2% = 2 Or k%
            If chn2% = 2 Then
                kx% = map%(oinx%, iny%)
                ky% = map%(inx%, oiny%)
                If k% + kx% + ky% = 0 GoTo oldi
                tst% = xsign% * ysign% * Sgn((rxx% - bxx%) * (iny% * 256 + yss&) - (ryy% - byy%) * (inx% * 256 + xss&))
                If (tst% = 1 And k% + ky% = 0) Or (tst% <= 0 And k% + kx% = 0) GoTo oldi
            End If
            horz% = 0: If inx% = (rxx% - xb%(t%)) \ &H100 Then horz% = chn2% And 1

            If chn2% = 2 Then
                If tst% > 0 Then
                    If ky% Then k% = ky%: iny% = oiny% Else horz% = 1
                Else
                    If kx% Then horz% = 1: k% = kx%: inx% = oinx%
                End If
            End If
        End If

        If horz% Then
            wdis(x%) = (iny% * 256 + yss&) / stt(t%)
            If t% > 1780 Or t% < 20 Or (t% > 880 And t% < 920) Then
                dis = (inx% * 256 + xss&) / ctt(t%): If dis > wdis(x%) Then wdis(x%) = dis
            End If
            xfrac = bx + wdis(x%) * ct(t%)
            bcc% = Int((xfrac - Int(xfrac)) * 63.9): If ys% = 0 Then bcc% = 63 - bcc%
        Else
            wdis(x%) = (inx% * 256 + xss&) / ctt(t%)
            If (t% > 1330 And t% < 1370) Or (t% > 430 And t% < 470) Then
                dis = (iny% * 256 + yss&) / stt(t%): If dis > wdis(x%) Then wdis(x%) = dis
            End If
            xfrac = by + wdis(x%) * st(t%)
            bcc% = Int((xfrac - Int(xfrac)) * 63.9): If xs% Then bcc% = 63 - bcc%
        End If

        dd% = dsfc(x%) / wdis(x%): odd%(x%) = dd%

        'load view to buffer
        If x% And 1 Then
            afx% = ctt(t%) * dsfc(x%): afy% = stt(t%) * dsfc(x%): yt% = dd% + 1
            fixfloor:
            If yt% < 92 Then
                fcxp% = (bxx% + afx% \ yt%): fcyp% = (byy% + afy% \ yt%)
                If fcxp% <= 0 Or fcyp% <= 0 Or fcxp% >= sizexf% Or fcyp% >= sizeyf% Then
                    sb1%(xx%, yt% + 99) = 0: sb1%(xx%, 100 - yt%) = 0: yt% = yt% + 1: GoTo fixfloor
                End If
            End If
            For y% = yt% To 92
                fcxp% = (bxx% + afx% \ y%): fcx% = fcxp% \ &H100
                fcyp% = (byy% + afy% \ y%): fcy% = fcyp% \ &H100
                flor% = fmap%(fcx%, fcy%)
                If flor% > 0 Then
                    sb1%(xx%, y% + 99) = bicol%(flor%)
                ElseIf flor% >= -ntx% Then
                    sb1%(xx%, y% + 99) = (testin%(-flor%, (fcxp% \ 4) And &H3F, (fcyp% \ 4) And &H3F) And &HFF) + hicol%(testin%(-flor%, (fcxp% \ 4) And &H3F, (fcyp% \ 4) And &H3F) And &HFF)
                Else
                    flor% = -flor% - ntx% - 1
                    fcxp% = (fcxp% \ 4) And &H3F: fcyp% = (fcyp% \ 4) And &H3F
                    tst% = (testin%(flor%, fcxp%, fcyp%) And &HFF00)
                    sb1%(xx%, y% + 99) = lowcol%((testin%(flor%, fcxp%, fcyp%) And &HFF00) \ 256) + tst%
                End If
                sb1%(xx%, 100 - y%) = bicol%(cmap%(fcx%, fcy%))
            Next
        End If
        If k% = nttx% + 1 Then k% = 0
        If k% > nttx% Then
            kx% = k%: If k% = 17 Then kx% = Int(TIMR + xfrac * 40) And &HFF
            yb% = 99 + dd%: If yb% > 191 Then yb% = 191
            yt% = 100 - dd%: If yt% < 8 Then yt% = 8
            If x% And 1 Then
                For y% = yt% To yb%: sb1%(xx%, y%) = (sb1%(xx%, y%) And &HFF) + hicol%(kx%): Next
            Else
                For y% = yt% To yb%: sb1%(xx%, y%) = (sb1%(xx%, y%) And &HFF00) + kx%: Next
            End If
        ElseIf x% And 1 Then
            If dd% > 31 Then
                hmd% = 100 - dd%: df% = (dd% + 4) \ 32: dof& = dd%: kx% = k% - ntx% - 1
                For yfrac% = 0 To 63: yt% = hmd% + (yfrac% * dof&) \ &H20: yb% = yt% + df%
                    If yt% < 8 Then yt% = 8
                    If yb% > &HBF Then yb% = &HBF
                    If k% <= ntx% Then
                        tst% = hicol%(testin%(k%, bcc%, yfrac%) And &HFF) + (testin%(k%, obcc%, yfrac%) And &HFF)
                    Else
                        tst% = (testin%(kx%, bcc%, yfrac%) And &HFF00) + lowcol%((testin%(kx%, obcc%, yfrac%) And &HFF00) \ 256)
                    End If
                For y% = yt% To yb%: sb1%(xx%, y%) = tst%: Next: Next
            Else
                yb% = 2 * dd% - 1: hmd% = 100 - dd%
                If k% <= ntx% Then
                    For y% = hmd% To 99 + dd%: yfrac% = ((y% - hmd%) * 63) \ yb%
                        sb1%(xx%, y%) = hicol%(testin%(k%, bcc%, yfrac%) And &HFF) + (testin%(k%, obcc%, yfrac%) And &HFF)
                    Next
                Else
                    kx% = k% - ntx% - 1
                    For y% = hmd% To 99 + dd%: yfrac% = ((y% - hmd%) * 63) \ yb%
                        sb1%(xx%, y%) = (testin%(kx%, bcc%, yfrac%) And &HFF00) + lowcol%((testin%(kx%, obcc%, yfrac%) And &HFF00) \ 256)
                    Next
                End If
            End If
        End If
    obcc% = bcc%: Next
End Sub

Sub showbadguy (b%)
    Shared bgh%(), scbg(), x(), y(), dis(), F0%, F1%, F2%, F3%, F4%, F5%, wdis(), robo%(), active%()
    If bgh%(b%) > 0 Then

        If x(b%) >= 0 And x(b%) <= 319 Then
            If dis(b%) < wdis(x(b%)) Then showb% = 1: 'active%(b%) = 1
        End If
        xt% = x(b%) + scbg(b%) * 40
        If xt% >= 0 And xt% < 320 Then
            If dis(b%) < wdis(xt%) Then showb% = 1: 'active%(b%) = 1
        End If
        If showb% Then
            If robo%(b%) Then F1% = 7
            putbox x(b%) + scbg(b%) * 16, y(b%) + 0, x(b%) + scbg(b%) * 24, y(b%) + scbg(b%) * 2, F0%, dis(b%)
            putbox x(b%) + scbg(b%) * 15, y(b%) + scbg(b%) * 2, x(b%) + scbg(b%) * 25, y(b%) + scbg(b%) * 10, F1%, dis(b%)
            putbox x(b%) + scbg(b%) * 10, y(b%) + scbg(b%) * 10, x(b%) + scbg(b%) * 30, y(b%) + scbg(b%) * 40, b%, dis(b%)
            putbox x(b%), y(b%) + scbg(b%) * 11, x(b%) + scbg(b%) * 10, y(b%) + scbg(b%) * 20, b%, dis(b%)
            putbox x(b%) + scbg(b%) * 30, y(b%) + scbg(b%) * 11, x(b%) + scbg(b%) * 40, y(b%) + scbg(b%) * 20, b%, dis(b%)
            putbox x(b%), y(b%) + scbg(b%) * 20, x(b%) + scbg(b%) * 5, y(b%) + scbg(b%) * 40, b%, dis(b%)
            putbox x(b%) + scbg(b%) * 35, y(b%) + scbg(b%) * 20, x(b%) + scbg(b%) * 40, y(b%) + scbg(b%) * 40, b%, dis(b%)
            putbox x(b%) + scbg(b%) * 10, y(b%) + scbg(b%) * 40, x(b%) + scbg(b%) * 18, y(b%) + scbg(b%) * 70, F3%, dis(b%)
            putbox x(b%) + scbg(b%) * 22, y(b%) + scbg(b%) * 40, x(b%) + scbg(b%) * 30, y(b%) + scbg(b%) * 70, F3%, dis(b%)
            putbox x(b%) + scbg(b%) * 18, y(b%) + scbg(b%) * 40, x(b%) + scbg(b%) * 22, y(b%) + scbg(b%) * 50, F3%, dis(b%)
            putbox x(b%) + scbg(b%) * 7, y(b%) + scbg(b%) * 70, x(b%) + scbg(b%) * 18, y(b%) + scbg(b%) * 75, F4%, dis(b%)
            putbox x(b%) + scbg(b%) * 22, y(b%) + scbg(b%) * 70, x(b%) + scbg(b%) * 33, y(b%) + scbg(b%) * 75, F4%, dis(b%)
            putbox x(b%) + scbg(b%) * 5, y(b%) + scbg(b%) * 35, x(b%) + scbg(b%) * 15, y(b%) + scbg(b%) * 40, F1%, dis(b%)
            putbox x(b%) + scbg(b%) * 25, y(b%) + scbg(b%) * 35, x(b%) + scbg(b%) * 35, y(b%) + scbg(b%) * 40, F1%, dis(b%)
            putbox x(b%) + scbg(b%) * 15, y(b%) + scbg(b%) * 25, x(b%) + scbg(b%) * 25, y(b%) + scbg(b%) * 35, F5%, dis(b%)
            putbox x(b%) + scbg(b%) * 16, y(b%) + scbg(b%) * 3, x(b%) + scbg(b%) * 18, y(b%) + scbg(b%) * 4, 0, dis(b%)
            putbox x(b%) + scbg(b%) * 22, y(b%) + scbg(b%) * 3, x(b%) + scbg(b%) * 24, y(b%) + scbg(b%) * 4, 0, dis(b%)
            putbox x(b%) + scbg(b%) * 16, y(b%) + scbg(b%) * 4, x(b%) + scbg(b%) * 18, y(b%) + scbg(b%) * 4, 7, dis(b%)
            putbox x(b%) + scbg(b%) * 22, y(b%) + scbg(b%) * 4, x(b%) + scbg(b%) * 24, y(b%) + scbg(b%) * 4, 7, dis(b%)
            putbox x(b%) + scbg(b%) * 17, y(b%) + scbg(b%) * 4, x(b%) + scbg(b%) * 17, y(b%) + scbg(b%) * 4, 0, dis(b%)
            putbox x(b%) + scbg(b%) * 23, y(b%) + scbg(b%) * 4, x(b%) + scbg(b%) * 23, y(b%) + scbg(b%) * 4, 0, dis(b%)
            putbox x(b%) + scbg(b%) * 20, y(b%) + scbg(b%) * 5, x(b%) + scbg(b%) * 20, y(b%) + scbg(b%) * 6, 114, dis(b%)
            putbox x(b%) + scbg(b%) * 18, y(b%) + scbg(b%) * 8, x(b%) + scbg(b%) * 22, y(b%) + scbg(b%) * 8, 4, dis(b%)
            F1% = 6
        End If
    End If
End Sub

Sub showbadshot (x%)
    Shared bgsht(), bgshosht%(), bgdela%(), bgshtht%(), bgshtdis(), robo%()
    If bgsht(x%) > 0 And bgshosht%(x%) Then
        putcircle bgdela%(x%), 100, bgshtht%(x%), 4 + robo%(x%), bgshtdis(x%)
    End If
End Sub

Sub showhealth
    Shared gm%, ogm%, ph%, oph%
    If gm% Then ph% = 100
    If ph% - oph% Or gm% - ogm% Then
        For y% = 194 To 199
            hLINE 0, 319 * ph% / 100, y%, 1 + 14 * gm%
            hLINE 319 * ph% / 100 + 1, 319, y%, 4
        Next: ogm% = gm%: oph% = ph%
    End If
End Sub

Sub showmed (b%)
    Shared med%(), scmed(), mx(), my(), medis(), nmeds%
    '    Print b%, nmeds%
    If med%(b%) Then
        c% = (b% < nmeds%)
        putbox mx(b%) + 0, my(b%) + 0, mx(b%) + scmed(b%) * 20, my(b%) + scmed(b%) * 20, 2 - 13 * c%, medis(b%)
        putbox mx(b%) + scmed(b%) * 8, my(b%) + scmed(b%) * 3, mx(b%) + scmed(b%) * 13, my(b%) + scmed(b%) * 17, 2 - 2 * c%, medis(b%)
        putbox mx(b%) + scmed(b%) * 3, my(b%) + scmed(b%) * 8, mx(b%) + scmed(b%) * 17, my(b%) + scmed(b%) * 13, -4 * c%, medis(b%)
    End If
End Sub

Sub showurshot (x%)
    Shared mg%, fb%, sht(), shosht%(), dela%(), shtdis(), shtht%(), plasma%()
    If plasma%(x%) = 0 And sht(x%) > 0 And shosht%(x%) Then putcircle dela%(x%), 100 + 30 / shtdis(x%), shtht%(x%) / 3 + 1, 0, shtdis(x%)
    If plasma%(x%) = 1 And sht(x%) > 0 And shosht%(x%) Then putcircle dela%(x%), 100 + 10 / shtdis(x%), shtht%(x%) * 1.5, 13, shtdis(x%)
End Sub

Sub time
    Shared ofram%, delta.t, fdt, kbmatrix%(), gm%, fram%
    Static oldtimer&, oldtim, afram%, godit

    fram% = fram% + 1
    If Int(Timer) - oldtimer& Then
        ofram% = fram%: fram% = 0: oldtimer& = Int(Timer)
    End If

    afram% = afram% + 1
    If oldtim <> Timer Then
        delta.t = delta.t * .8 + (Timer - oldtim) * .2 / afram%
        oldtim = Timer: afram% = 0
        If delta.t > .1 Or delta.t < 0 Then delta.t = .1
        fdt = 14 * delta.t
    End If

    If kbmatrix%(36) And Timer > godit Then
        If gm% Then gm% = 0 Else gm% = 1: 'cheat mode
        godit = (Timer + 1) Mod 86400
    End If

End Sub

Sub vline (x%, yt%, yb%, c%)
    Static y%, xx%
    Shared sb1%(), hicol%(), odd%(), bicol%(), bitex%: xx% = x% \ 2
    If yt% < 8 Then yt% = 8
    If yb% > 191 Then yb% = 191
    If bitex% Then
        For y% = yt% To yb%: sb1%(xx%, y%) = bicol%(c%): Next
    ElseIf x% And 1 Then
        For y% = yt% To yb%
        sb1%(xx%, y%) = (sb1%(xx%, y%) And &HFF) + hicol%(c%): Next
    Else
        For y% = yt% To yb%: sb1%(xx%, y%) = (sb1%(xx%, y%) And &HFF00) + c%: Next
    End If
End Sub

Sub yourmove
    Shared kbmatrix%(), ct(), st(), efa%, shift, delta.t, fdt
    Shared px, py, sa, va, vx, vy, testin%(), bx, by
    If kbmatrix%(56) Then
        If kbmatrix%(77) Then
            vx = vx + ct((efa% + 450) Mod 1800) * shift * delta.t
            vy = vy + st((efa% + 450) Mod 1800) * shift * delta.t
        End If
        If kbmatrix%(75) Then
            vx = vx + ct((efa% + 1350) Mod 1800) * shift * delta.t
            vy = vy + st((efa% + 1350) Mod 1800) * shift * delta.t
        End If
    Else
        If kbmatrix%(77) Then va = va + shift * 90 * delta.t
        If kbmatrix%(75) Then va = va - shift * 90 * delta.t
    End If
    If kbmatrix%(72) Then
        vx = vx + ct(efa%) * shift * delta.t
        vy = vy + st(efa%) * shift * delta.t
    End If
    If kbmatrix%(80) Then
        vx = vx - ct(efa%) * shift * delta.t
        vy = vy - st(efa%) * shift * delta.t
    End If
    svx% = Sgn(vx): svy% = Sgn(vy)
    crashtest px + .15 * svx%, py + .15 * svy%, vx, vy
    crashtest px - .15 * svx%, py + .15 * svy%, vx, vy
    crashtest px + .15 * svx%, py - .15 * svy%, vx, vy
    px = px + vx * delta.t: py = py + vy * delta.t
    sa = (sa + va * delta.t) Mod 1800
    damp = 2 ^ -fdt
    vx = vx * damp: vy = vy * damp: va = va * damp
    testin%(4, Int(bx) + 2, Int(by) + 19) = 0
End Sub

Sub yourshot
    Shared kbmatrix%(), nshots%, weap$, sht(), ammo%(), shosht%(), bx, by, mg%
    Shared fdt, delta.t, snd%, fb%, ct(), st(), vshx(), vshy(), maxshots%
    Shared sizex%, sizey%, shtx(), shty(), map%(), inx%, iny%, testin%()
    Shared shtang%(), shtdis(), dis(), dela%(), shtht%(), fmap%(), efa%, sa, plasma%()
    Shared nbguys%, nbguysm1%, bgh%(), bgx(), bgy(), vbx(), vby(), fire, kills%, robo%()
    Static kk%

    If fire > 0 Then fire = fire - fdt * nshots%

    If kbmatrix%(2) Then mg% = 0: kk% = 0: nshots% = 1: weap$ = " plasma gun"
    If kbmatrix%(3) Then mg% = 1: nshots% = 10: weap$ = "machine gun"
    If kbmatrix%(4) Then mg% = 2: nshots% = 10: weap$ = "plas-cannon"

    If kbmatrix%(29) And fire <= 0 And sht(kk%) <= 0 And ammo%(mg% And 1) > 0 Then
        sht(kk%) = 20: shosht%(kk%) = 1: ammo%(mg% And 1) = ammo%(mg% And 1) - 1: 'create shot
        shtx(kk%) = bx: shty(kk%) = by: fire = 18: If snd% Then Sound 200, 1
        vshx(kk%) = ct(efa%) * 10: vshy(kk%) = st(efa%) * 10
        plasma%(kk%) = 1 - (mg% And 1)
        kk% = kk% + 1: If kk% = nshots% Then kk% = 0
    End If

    For x% = 0 To maxshots%
        If shtx(x%) < 1 Or shtx(x%) > sizex% - 1 Or shty(x%) < 0 Or shty(x%) > sizey% - 1 Then shosht%(x%) = 0
        If sht(x%) > 0 Then sht(x%) = sht(x%) - fdt
        If sht(x%) > 0 And shosht%(x%) Then
            crashtest shtx(x%), shty(x%), vshx(x%), vshy(x%)
            k% = map%(inx%, iny%)
            If k% Then shosht%(x%) = 0
            shtx(x%) = shtx(x%) + vshx(x%) * delta.t: shty(x%) = shty(x%) + vshy(x%) * delta.t
            If k% = 15 And sht(x%) > 0 Then
                map%(inx%, iny%) = 0
                testin%(4, inx% + 2, iny% + 19) = 0
            End If

            shtang%(x%) = atan2(shty(x%) - by, shtx(x%) - bx) * 5
            shtdis(x%) = Sqr((shty(x%) - by) ^ 2 + (shtx(x%) - bx) ^ 2 + .01)
            dis(x% + nbguys% * 2) = shtdis(x%)
            dela%(x%) = (shtang%(x%) - sa + 1800) Mod 1800
            shtht%(x%) = 30 / shtdis(x%)

            'damage test
            For y% = 0 To nbguysm1%
                bsdis = (shty(x%) - bgy(y%)) * (shty(x%) - bgy(y%)) + (shtx(x%) - bgx(y%)) * (shtx(x%) - bgx(y%))
                If bsdis < .36 And bgh%(y%) > 0 Then
                    If bsdis < .16 Then bgh%(y%) = bgh%(y%) - sht(x%) / 2 - 5: shosht%(x%) = 0
                    'vbx(y%) = vbx(y%) + vshx(x%) * .1: vby(y%) = vby(y%) + vshy(x%) * .1
                    If plasma%(x%) Then
                        bgh%(y%) = bgh%(y%) - sht(x%) * 1.5 - 50: shosht%(x%) = 0
                        'vbx(y%) = vbx(y%) + vshx(x%) * .5: vby(y%) = vby(y%) + vshy(x%) * .5
                    End If
                    If bgh%(y%) < 1 Then
                        fmap%(Int(bgx(y%)), Int(bgy(y%))) = 4 + 4 * robo%(y%): kills% = kills% + 1
                        If snd% Then Sound 180, 5
                    End If
            End If: Next
    End If: Next

End Sub

Sub keys
    Shared kbmatrix%()
    i% = Inp(96): i$ = InKey$: kbmatrix%(i% And 127) = -(i% < 128)
End Sub

[johnno56]

Cool game... Unfortunately, my playing skills are not what they used to be.... lol

[kinem]

Cool game... Unfortunately, my playing skills are not what they used to be.... lol

Thanks. Let me know if you have suggestions.

[Pete]

I don't do games, either, but I got 1 kill! I guess it's just in my lovable nature.

Hey really nice 3-D effects! What else you got???

Pete

[kinem]

I don't do games, either, but I got 1 kill! I guess it's just in my lovable nature.

Hey really nice 3-D effects! What else you got???

Pete

Thanks. For the game, it helps to strafe a lot.

Here are a few somewhat related programs:

Just for fun, RAY-SH.BAS, designed to be the world's most compact code for a raycaster demo:

Code: (Select All)

a$ = "1111111110010001100409011000010120110701101101011000000112345671"
For X = 0 To 63: L(X And 7, X \ 8) = Val(Mid$(a$, X + 1, 1)): Next: X = 1.5
Y = X: F = Atn(1): u = F / 9: Screen 7: Do: Wait 986, 8: For S = -160 To 159
    t = Atn(S / 304): R = F + t: I = Cos(R) / 80: J = Sin(R) / 80: o = X: p = Y
    n = 0: Do: o = o + I: p = p + J: n = n + 1: c = L(o, p): Loop Until c
        H = 9000 / n / Cos(t): v = S + 160: Line (v, 0)-(v, 99 - H), 0
    Line -(v, 99 + H), c: Line -(v, 319), 8: Next: I = Cos(F) / 9: J = Sin(F) / 9
    a = Inp(96): m = (a = 80) - (a = 72): m = m And (L(X + I * m, Y + J * m) = 0)
X = X + I * m: Y = Y + J * m: F = F + u * ((a = 75) - (a = 77)): Loop Until 1 = a

3D-X3-64.BAS, a 2010 robots graphic demo designed to work in QB 4.5, QB 64, and FreeBasic. It's not how I would do things now, since it's using tricks that are not needed except to work within QB 4.5's limits.

Code: (Select All)

'$lang:"qb" '/' 3D-X3.BAS  'kinem
DECLARE SUB DEFSHORT (s%) : DECLARE SUB setmouse (x%, y%, M%)
Dim Shared MULTIKEY%(128): '/ 'start QB 4.5 with /l /ah
'arrows to turn left, rt; arrow+alt to strafe; a,z to move up, down
DEFINT A-Z: DECLARE SUB painttile (t) : DECLARE SUB objhdr2 (file$)
DECLARE SUB yourmove () : DECLARE SUB debuf0 () : DECLARE SUB timeit ()
DECLARE SUB getdet (t) : DECLARE FUNCTION gettn (t) : DECLARE SUB showtiles ()
DECLARE FUNCTION tileside (pt, tile) : DECLARE SUB theirmove ()
DECLARE FUNCTION crossx! (pa1, pa2, pb1, pb2) : DECLARE SUB urangle ()
DECLARE FUNCTION frontq (t1, t2) : DECLARE SUB maketables ()
DECLARE SUB TLINEFRx (p1, p2) : DECLARE SUB TLINESIDEx (p1, p2, p3)
DECLARE SUB makeworld () : DECLARE SUB keys () : DECLARE SUB objload2 (file$)
DECLARE SUB onkb () : DECLARE SUB readassembly () : DECLARE SUB offkb () '/'
Dim Shared kbcontrol(128), keyboardonflag, qbkey(128) '/

Dim Shared qb, fb: Screen 13: DEFSHORT s: setmouse 0, 0, 0: fb = (qb = 0) '/'
If qb = 45 Then Call readassembly: onkb
If qb Then ReDim Shared sbq(1, 29440) '/
If fb Then ReDim Shared sbf(1 + 29440), spf(8 To 191, 319)
If qb Then Get (0, 8)-(319, 191), sbq() Else Get (0, 8)-(319, 191), sbf()

Const cx = 159.5, cy = 99.5, scx = 258!, scy = 215!, scr = 1.2, ok = -1
Const sleft = 0, sright = 319, scrtop = 8, scrbot = 191

Dim Shared hicol(255), pi!, inlft(scrtop To scrbot)
Dim Shared px(3) As Long, py(3) As Long, pz(3) As Long, inrt(scrtop To scrbot)
Dim Shared xx(3) As Long, yy(3) As Long, trymin As Long, trymax As Long
Dim Shared trlft(scrtop To scrbot) As Long, trrt(scrtop To scrbot) As Long
Dim Shared nobj, nactpt, npts, ntri, nactri, nquad, slx, srx, sby, sty
Dim Shared obvt, obfc

ReDim Shared rtxx(0) As Long, rtyy(0) As Long, stog(3, 1) As String
ReDim Shared ptx(0), pty(0), ptz(0), ticol(0), tog(3), otog(3)
ReDim Shared rtx(0) As Single, rty(0) As Single, rtz(0) As Single
ReDim Shared tipt(3, 0), triobj(0), kno(0), froc(0), hiticol(0)
ReDim Shared obj(0), opend(0), op1(0), obz(0), obx(0), oby(0), obphi(0)
ReDim Shared tnx(0) As Single, tny(0) As Single, tnz(0) As Single
ReDim Shared wc(0) As Single, wax(0) As Single, wby(0) As Single

Dim Shared crossy As Single, crossz As Single
Dim Shared nsx As Single, theta!, psi!, phi!
Dim Shared pvx, pvy, pvz, xnx!, xny!, xnz!, ynx!, yny!, ynz!
Dim Shared znx!, zny!, znz!, obscale!, obzy, nov, nof

Call maketables: makeworld: urangle: showtiles: debuf0: Locate 1, 30
If fb Then Print "FreeBasic" Else If qb = 64 Then Print "QB 64" Else Print "QB 4.5"
Print "arrows to turn left, rt"
Print "arrow+alt to strafe": Print "a,z to move up, down"
Print "press any key to start": tog(0) = Not fb
t = 0: Do: keys: For i = 1 To 127: t = t + MULTIKEY(i): Next: Loop Until t

Do: urangle: showtiles: debuf0: keys: yourmove: theirmove: timeit
Loop Until MULTIKEY(1): If qb = 45 Then Call offkb

'/'
kbisrdata: 'Keyboard interrupt data; routine from KEYB2.BAS by Angelo
Data &HE9,&H1D,0,&HE9,&H3C,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,&H1E,&H31,&HC0,&H8E,&HD8,&HBE,&H24,0,&H0E,7
Data &HBF,&H14,0,&HFC,&HA5,&HA5,&H8C,&HC3,&H8E,&HC0,&HBF,&H24,0,&HB8
Data &H56,0,&HFA,&HAB,&H89,&HD8,&HAB,&HFB,&H1F,&HCB,&H1E,&H31,&HC0,&H8E
Data &HC0,&HBF,&H24,0,&HBE,&H14,0,&H0E,&H1F,&HFC,&HFA,&HA5,&HA5,&HFB
Data &H1F,&HCB,&HFB,&H9C,&H50,&H53,&H51,&H52,&H1E,&H56,&H06,&H57,&HE4,&H60
Data &HB4,1,&HA8,&H80,&H74,4,&HB4,0,&H24,&H7F,&HD0,&HE0,&H88,&HC3
Data &HB7,0,&HB0,0,&H2E,3,&H1E,&H12,0,&H2E,&H8E,&H1E,&H10,0
Data &H86,&HE0,&H89,&H07,&HE4,&H61,&H0C,&H82,&HE6,&H61,&H24,&H7F,&HE6,&H61
Data &HB0,&H20,&HE6,&H20,&H5F,7,&H5E,&H1F,&H5A,&H59,&H5B,&H58,&H9D,&HCF,-1
'/

Function crossx! (pa1, pa2, pb1, pb2)
    Static ax As Single, ay As Single, az As Single
    Static bx As Single, by As Single, bz As Single

    ax = rtx(pa1) - rtx(pa2): ay = rty(pa1) - rty(pa2): az = rtz(pa1) - rtz(pa2)
    bx = rtx(pb1) - rtx(pb2): by = rty(pb1) - rty(pb2): bz = rtz(pb1) - rtz(pb2)

    crossx = ay * bz - az * by
    crossy = -ax * bz + az * bx
    crossz = ax * by - ay * bx

End Function

Sub debuf0

    If qb Then
        x = 0: For xpq = 1 To 14720: x = x Xor 1
            sbq(0, xpq) = ticol(sbq(0, x)) + hiticol(sbq(1, x)): x = x + 1
        sbq(1, xpq) = ticol(sbq(0, x)) + hiticol(sbq(1, x)): Next
        Put (0, scrtop), sbq(), PSet: x = sbq(0, 0): y = sbq(1, 0): 'y = 184
        ReDim sbq(1, 29440): sbq(0, 0) = x: sbq(1, 0) = y
    Else
        For y = 8 To 191: xpq = 2 + (y - 8) * 160: For x = 0 To 159: x2 = x * 2
        sbf(xpq + x) = ticol(spf(y, x2)) + hiticol(spf(y, x2 + 1)): Next: Next
        Put (0, scrtop), sbf(), PSet: ReDim spf(8 To 191, 319)
    End If
End Sub

'/'
Sub DEFSHORT (s%)
End Sub '/

Function frontq (t1, t2)
    Dim qa(3), qb(3), sidp, csb, csf

    ftri = 0: '1 ==> t1 in front of t2, -1 ==> t1 behind t2, 0 ==> use x-buffer

    np1 = 4 + (tipt(3, t1) = 0): np2 = 4 + (tipt(3, t2) = 0)

    'check if t2 is fully in front or back of plane of t1
    csb = 0: csf = 0: For p = 0 To np2 - 1: sidp = tileside(tipt(p, t2), t1)
    csb = csb - (sidp >= 0): csf = csf - (sidp <= 0): Next
    If csb = np2 Then ftri = -1: GoTo endfq
    If csf = np2 Then ftri = 1: GoTo endfq

    'check if t1 is fully in front or back of plane of t2
    csb = 0: csf = 0: For p = 0 To np1 - 1: sidp = tileside(tipt(p, t1), t2)
    csb = csb - (sidp >= 0): csf = csf - (sidp <= 0): Next
    If csf = np1 Then ftri = -1: GoTo endfq
    If csb = np1 Then ftri = 1: 'GOTO endfq

    'else try xb

    endfq: frontq = ftri
    kno(t2) = t1: froc(t2) = ftri

End Function

Sub getdet (t)
    p1 = tipt(0, t): p2 = tipt(1, t): p3 = tipt(2, t)

    M# = rtz(p1) * (rtx(p2) * rty(p3) - rtx(p3) * rty(p2)) + rtz(p2) * (rtx(p3) * rty(p1) - rtx(p1) * rty(p3)) + rtz(p3) * (rtx(p1) * rty(p2) - rtx(p2) * rty(p1))

    If M# > 0 Then
        wax(t) = (rty(p1) * (rtz(p2) - rtz(p3)) + rty(p2) * (rtz(p3) - rtz(p1)) + rty(p3) * (rtz(p1) - rtz(p2))) / M#
        wby(t) = -scr * (rtx(p1) * (rtz(p3) - rtz(p2)) + rtx(p2) * (rtz(p1) - rtz(p3)) + rtx(p3) * (rtz(p2) - rtz(p1))) / M#
        wc(t) = scx * (rtx(p1) * (rty(p2) - rty(p3)) + rtx(p2) * (rty(p3) - rty(p1)) + rtx(p3) * (rty(p1) - rty(p2))) / M# - cx * wax(t) - cy * wby(t)
        'wc(t) = scx * C! / M# - cx * wax(t) - cy * wby(t)
        'scx / z = wc + wax * Xs + wby * Ys
    End If
End Sub

Function gettn (t)
    tp0 = tipt(0, t): tnx(t) = -crossx(tipt(1, t), tp0, tipt(2, t), tp0)
    tny(t) = -crossy: tnz(t) = -crossz
    pb = tipt(0, t)
    gettn = ((rtx(pb) * tnx(t) + rty(pb) * tny(t) + rtz(pb) * tnz(t)) < 0!)
End Function

Sub keys
    '/'
    If qb = 64 Then
        i = Inp(96): If i < 128 Then MULTIKEY(i) = -1
        If i > 127 Then MULTIKEY(i - 128) = 0
    ElseIf qb = 45 Then
        For k = 0 To 127: MULTIKEY(k) = (qbkey(k) Or (MULTIKEY(k) And qbkey(42)))
        Next
    End If '/

    If MULTIKEY(28) And otog(0) = 0 Then tog(0) = Not tog(0)
    otog(0) = MULTIKEY(28)

    If MULTIKEY(14) And otog(1) = 0 Then tog(1) = Not tog(1)
    otog(1) = MULTIKEY(14)

    'IF MULTIKEY(57) AND otog(2) = 0 THEN tog(2) = NOT tog(2)
    'otog(2) = MULTIKEY(57)

    Locate 25, 1: Print stog(0, -tog(0)); tog(1); ' stog(1, -tog(1)); stog(2, -tog(2));

End Sub

Sub maketables

    pi! = Atn(1) * 4

    For c = 0 To 255: hicol(c) = &H100 * (c + &H100 * (c > &H7F)): Next

    For y = scrtop To scrbot: trlft(y) = sright + 1: trrt(y) = -1
    inlft(y) = -1: inrt(y) = -1: Next
    trymin = scrbot + 8: trymax = -1

    stog(0, 0) = "ENTER toggle: WAITing for screen "
    stog(0, 1) = "ENTER toggle: not WAITing        "

End Sub

Sub makeworld

    obscale! = 1: obzy = 0
    file$ = "3D-X3.qo": Call objhdr2(file$)
    nobj = 10: npts = obvt * nobj: ntri = obfc * nobj
    stfl = npts + 1: nobj = nobj + 1: npts = npts + 4: ntri = ntri + 1

    ReDim rtxx(npts) As Long, rtyy(npts) As Long, hiticol(ntri)
    ReDim ptx(-1 To npts), pty(-1 To npts), ptz(-1 To npts), ticol(ntri)
    ReDim rtx(-1 To npts) As Single, rty(-1 To npts) As Single, rtz(-1 To npts) As Single
    ReDim tipt(3, ntri), triobj(1 To ntri), kno(ntri), froc(ntri)
    ReDim obj(npts), opend(nobj), op1(nobj), obz(nobj), obx(nobj), oby(nobj), obphi(nobj)
    ReDim tnx(1 To ntri) As Single, tny(1 To ntri) As Single, tnz(1 To ntri) As Single
    ReDim wc(ntri) As Single, wax(ntri) As Single, wby(ntri) As Single

    pvx = -50: pvy = 100: pvz = -175: phi! = 0 * pi! / 180

    For n = 0 To nobj - 1 - 1: obn = n + 1: Call objload2(file$)
        op1(obn) = 1 + obvt * n: opend(obn) = op1(obn) + obvt - 1
        obx(obn) = 32 + 100 * n: obz(obn) = 32: oby(obn) = 0
    For t = op1(obn) To opend(obn): obj(t) = obn: Next: Next

    op1(nobj) = stfl: opend(nobj) = stfl + 3: nactri = ntri
    For t = 0 To 3: tipt(t, ntri) = stfl + t: obj(stfl + 1) = nobj: Next
    ptx(stfl) = -4000: ptz(stfl) = -4000
    ptx(stfl + 1) = 4000: ptz(stfl + 1) = -4000
    ptx(stfl + 2) = 4000: ptz(stfl + 2) = 4000
    ptx(stfl + 3) = -4000: ptz(stfl + 3) = 4000
    ticol(ntri) = 9: oby(nobj) = 90

    For t = 1 To ntri: hiticol(t) = hicol(ticol(t)): Next

End Sub

Sub objhdr2 (file$)
    Dim geo As String * 1, geo2 As String * 1, i As Long

    obvt = 0: obfc = 0
    Open file$ For Random As #1 Len = 1
    For i = 1 To LOF(1)
        Get #1, i, geo: g = Asc(geo)
        If geo = "#" Then
            Do: i = i + 1: Get #1, i, geo: g = Asc(geo)
            Loop Until EOF(1) Or g = 13 Or g = 10 Or geo = "#"
        End If
        If geo = "v" Then
            Get #1, i + 1, geo2
            If geo2 = " " Then obvt = obvt + 1
        End If
        If geo = "f" Then
            Get #1, i + 1, geo2
            If geo2 = " " Then obfc = obfc + 1
        End If
    Next: Close #1
End Sub

Sub objload2 (file$)

    Dim pth(3) As Single, geo As String * 1, geo2 As String * 1, i As Long
    Dim orig(2) As Single
    nov0 = nov: orig(0) = 0: orig(1) = 0: orig(2) = 0: col = 8

    Open file$ For Random As #1 Len = 1
    For i = 1 To LOF(1)
        Get #1, i, geo: g = Asc(geo)
        If geo = "#" Then
            Do: i = i + 1: Get #1, i, geo: g = Asc(geo): 'PRINT geo;
            Loop Until EOF(1) Or g = 13 Or g = 10 Or geo = "#"
        End If

        If geo = "o" Then
            Get #1, i + 1, geo2
            If geo2 = " " Then
                f$ = "": p = 0
                Do: nn = 0: Do: i = i + 1: Get #1, i, geo
                    If (geo >= "0" And geo <= "9") Or geo = "." Or geo = "-" Or geo = "e" Then
                        f$ = f$ + geo
                    Else
                        nn = -1
                        End If
                    Loop Until nn = -1 Or EOF(1)
                    If Len(f$) > 0 Then pth(p) = Val(f$): p = p + 1: f$ = ""
                Loop Until p = 3 Or EOF(1): 'fix xyz
                orig(0) = pth(0): orig(1) = pth(1): orig(2) = pth(2)
            End If
        End If

        If geo = "v" Then
            Get #1, i + 1, geo2
            If geo2 = " " Then
                nov = nov + 1: f$ = "": p = 0
                Do: nn = 0: Do: i = i + 1: Get #1, i, geo
                    If (geo >= "0" And geo <= "9") Or geo = "." Or geo = "-" Or geo = "e" Then
                        f$ = f$ + geo
                    Else
                        nn = -1
                        End If
                    Loop Until nn = -1 Or EOF(1)
                    If Len(f$) > 0 Then pth(p) = Val(f$) - orig(p): p = p + 1: f$ = ""
                Loop Until p = 3 Or EOF(1): 'fix xyz
                If obzy Then
                    ptx(nov) = pth(0) * obscale!:
                    pty(nov) = pth(1) * obscale!: ptz(nov) = pth(2) * obscale!
                Else
                    ptx(nov) = pth(0) * obscale!:
                    ptz(nov) = pth(1) * obscale!: pty(nov) = pth(2) * obscale!
                End If
            Else
                vn = vn + 1
            End If
        End If

        If geo = "f" Then
            Get #1, i + 1, geo2
            If geo2 = " " Then
                nof = nof + 1: f$ = "": p = 0
                Do: nn = 0: Do: i = i + 1: Get #1, i, geo
                    If (geo >= "0" And geo <= "9") Then f$ = f$ + geo Else nn = -1
                    Loop Until nn = -1 Or EOF(1)
                    If Len(f$) > 0 Then tipt(p, nof) = Val(f$) + nov0: p = p + 1: f$ = ""

                Loop Until geo = "c" Or geo = Chr$(10) Or p = 4 Or EOF(1) ' fix for more on same line
                If p = 3 Or p = 4 Then nactri = nactri + 1

                If p = 4 Then i = i + 1: Get #1, i, geo
                If geo = "c" Then
                    Do: i = i + 1: Get #1, i, geo2: Loop Until geo2 <> " ": f$ = geo2
                    Do: i = i + 1: Get #1, i, geo2: f$ = f$ + geo2
                    Loop Until geo2 = Chr$(10) Or EOF(1)
                    col = Val(f$) Mod 256
                End If
                ticol(nof) = col
            End If
        End If
    Next: Close #1
    'PRINT vt, fc: PRINT nov, nof: SLEEP
End Sub

Sub offkb
    '/'
    If (keyboardonflag% = 0) Then Exit Sub
    keyboardonflag% = 0
    Def Seg = VarSeg(kbcontrol%(0))
    Call Absolute(3)
    Def Seg '/
End Sub

Sub onkb
    '/'
    If keyboardonflag% Then Exit Sub
    keyboardonflag% = 1
    Def Seg = VarSeg(kbcontrol%(0))
    Call Absolute(0)
    Def Seg '/
End Sub

Sub painttile (t)

    kno(t) = 0: kno(0) = t: sgb% = 0: typ = 0: froc(0) = 1

    If tipt(3, t) = 0 Then
        For p = 0 To 2
            px(p) = rtx(tipt(p, t)): py(p) = rty(tipt(p, t)): pz(p) = rtz(tipt(p, t))
            If pz(p) > 0 Then
                xx(p) = rtxx(tipt(p, t)): yy(p) = rtyy(tipt(p, t))
            Else
                typ = typ + 1
            End If
        Next

        Select Case typ
            Case 0: If xx(0) < 0 And xx(1) < 0 And xx(2) < 0 Then Exit Sub
                If xx(0) > sright And xx(1) > sright And xx(2) > sright Then Exit Sub
                If yy(0) < scrtop And yy(1) < scrtop And yy(2) < scrtop Then Exit Sub
                If yy(0) > scrbot And yy(1) > scrbot And yy(2) > scrbot Then Exit Sub
                TLINEFRx 0, 1: TLINEFRx 0, 2: TLINEFRx 1, 2

            Case 1: pt1 = 0: pt2 = 1: pt3 = 2
                If pz(pt1) <= 0 Then
                    If pz(pt2) <= 0 Then Swap pt1, pt3 Else Swap pt1, pt2
                End If
                If pz(pt2) <= 0 Then Swap pt2, pt3
                TLINESIDEx pt1, pt2, pt3: TLINESIDEx pt1, pt3, pt2: TLINESIDEx pt2, pt3, pt1

            Case 2: pt1 = 0: pt2 = 1: pt3 = 2
                If pz(pt1) <= 0 Then
                    If pz(pt2) <= 0 Then Swap pt1, pt3 Else Swap pt1, pt2
                End If
                TLINESIDEx pt1, pt2, pt3: TLINESIDEx pt1, pt3, pt2

            Case 3: Exit Sub
        End Select

    Else

        For p = 0 To 3
            px(p) = rtx(tipt(p, t)): py(p) = rty(tipt(p, t)): pz(p) = rtz(tipt(p, t))
            If pz(p) > 0 Then
                xx(p) = rtxx(tipt(p, t)): yy(p) = rtyy(tipt(p, t))
            Else
                typ = typ + 1
            End If
        Next
        Select Case typ
            Case 4: Exit Sub
            Case 0: If xx(0) < 0 And xx(1) < 0 And xx(2) < 0 And xx(3) < 0 Then Exit Sub
                If xx(0) > sright And xx(1) > sright And xx(2) > sright And xx(3) > sright Then Exit Sub
                If yy(0) < scrtop And yy(1) < scrtop And yy(2) < scrtop And yy(3) < scrtop Then Exit Sub
                If yy(0) > scrbot And yy(1) > scrbot And yy(2) > scrbot And yy(3) > scrbot Then Exit Sub
                TLINEFRx 0, 1: TLINEFRx 1, 2: TLINEFRx 2, 3: TLINEFRx 3, 0
            Case Else 'pt1 = 0: pt2 = 1: pt3 = 2: pt4 = 3
                For pt = 0 To 3: pt1 = pt: pt2 = (pt + 1) Mod 4: pt3 = (pt + 2) Mod 4
                    If pz(pt1) > 0 Or pz(pt2) > 0 Then
                        If pz(pt1) <= 0 Then Swap pt1, pt2
                        TLINESIDEx pt1, pt2, pt3
                End If: Next
        End Select
    End If

    getdet (t)

    If qb Then
        xpq = 160 * (trymin - scrtop) - 159

        For y = trymin To trymax: xpq = xpq + 160
            If trlft(y) <= sright And trrt(y) >= 0 Then
                If trlft(y) < 0 Then trlft(y) = 0
                If trrt(y) > sright Then trrt(y) = sright

                rtyx = trrt(y): For x = trlft(y) To rtyx
                    sgb% = sbq(x And 1, x \ 2 + xpq)
                    If kno(sgb%) = t Then ft = froc(sgb%) Else ft = frontq(t, sgb%)

                    Select Case ft:
                        Case 1:
                            For x = x To rtyx: x2 = x \ 2 + xpq
                                If sgb% <> sbq(x And 1, x2) Then x = x - 1: Exit For
                                sbq(x And 1, x2) = t
                            Next
                        Case -1:
                            If sbq(rtyx And 1, rtyx \ 2 + xpq) = sgb% Then x = rtyx + 1
                            For x = x To rtyx
                                If sgb% <> sbq(x And 1, x \ 2 + xpq) Then x = x - 1: Exit For
                                x5 = x + 5: If x5 <= rtyx Then If sgb% = sbq(x5 And 1, x5 \ 2 + xpq) Then x = x5
                            Next
                        Case 0:
                            c3d! = wax(t) - wax(sgb%): xside = Sgn(c3d!)
                            c2d! = wc(sgb%) - wc(t) + y * (wby(sgb%) - wby(t))
                            If xside Then
                                x00! = c2d! / c3d!
                                If x00! > 320 Then x0 = 320 Else If x00! < -1 Then x0 = -1 Else x0 = x00!
                            Else
                                x0 = 320: xside = (x * c3d! - c2d! >= 0)
                            End If
                            If (x0 = 320 And xside = 1) Or (x0 = -1 And xside = -1) Then
                                If sbq(rtyx And 1, rtyx \ 2 + xpq) = sgb% Then x = rtyx + 1
                            End If
                            'IF x < x0 AND xside = 1 THEN
                            'IF x0 > -1 AND x0 < 320 THEN
                            'IF sbq(x0 AND 1, x0 \ 2 + xpq) = sgb% THEN x = x0
                            'END IF
                            'END IF
                            For x = x To rtyx: x2 = x \ 2 + xpq
                                If sgb% <> sbq(x And 1, x2) Then x = x - 1: Exit For
                                If Sgn(x - x0) = xside Then sbq(x And 1, x2) = t
                            Next
                    End Select
                Next x

            End If
            trlft(y) = sright + 1: trrt(y) = -1: inlft(y) = -1: inrt(y) = -1
        Next y: trymin = scrbot + 8: trymax = -1

    Else
        'fb

        For y = trymin To trymax
            If trlft(y) <= sright And trrt(y) >= 0 Then
                If trlft(y) < 0 Then trlft(y) = 0
                If trrt(y) > sright Then trrt(y) = sright

                c2! = wc(t) + y * wby(t)
                rtyx = trrt(y): For x = trlft(y) To rtyx: sgb% = spf(y, x)
                    If kno(sgb%) = t Then ft = froc(sgb%) Else ft = frontq(t, sgb%)

                    Select Case ft:
                        Case 1:
                            For x = x To rtyx
                                If sgb% <> spf(y, x) Then x = x - 1: Exit For
                                spf(y, x) = t
                            Next
                        Case -1:
                            If spf(y, rtyx) = sgb% Then x = rtyx + 1
                            For x = x To rtyx: If sgb% <> spf(y, x) Then x = x - 1: Exit For
                                x5 = x + 5: If x5 <= rtyx Then If sgb% = spf(y, x5) Then x = x5
                            Next
                        Case 0:
                            c3d! = wax(t) - wax(sgb%): xside = Sgn(c3d!)
                            c2d! = wc(sgb%) - wc(t) + y * (wby(sgb%) - wby(t))
                            If xside Then
                                x00! = c2d! / c3d!
                                If x00! > 320 Then x0 = 320 Else If x00! < -1 Then x0 = -1 Else x0 = x00!
                            Else
                                x0 = 320: xside = (x * c3d! - c2d! >= 0)
                            End If
                            If (x0 = 320 And xside = 1) Or (x0 = -1 And xside = -1) Then
                                If spf(y, rtyx) = sgb% Then x = rtyx + 1
                            End If
                            For x = x To rtyx
                                If sgb% <> spf(y, x) Then x = x - 1: Exit For
                                If Sgn(x - x0) = xside Then spf(y, x) = t
                            Next

                    End Select
                Next x

            End If
            trlft(y) = sright + 1: trrt(y) = -1: inlft(y) = -1: inrt(y) = -1
        Next y: trymin = scrbot + 8: trymax = -1

    End If

End Sub

Sub readassembly
    '/'
    Restore kbisrdata: Def Seg = VarSeg(kbcontrol%(0)): i& = 0: GoTo skip0
    Do: Poke i&, q%: i& = i& + 1
        skip0:
        Read q%:
    Loop While q% > -1: i& = 16
    n& = VarSeg(qbkey%(0)): L& = n& And 255: h& = ((n& And &HFF00) \ 256)
    Poke i&, L&: Poke i& + 1, h&: i& = i& + 2
    n& = VarPtr(qbkey%(0)): L& = n& And 255: h& = ((n& And &HFF00) \ 256)
    Poke i&, L&: Poke i& + 1, h&: i& = i& + 2
    Def Seg '/
End Sub

'/'
Sub setmouse (x%, y%, M%)
    Circle (2, 2), 2
    If Point(1, 0) Then qb = 45 Else qb = 64
    Locate 1, 1: Print " "
End Sub '/

Sub showtiles
    For t = 1 To nactri: If gettn(t) Then painttile t
    Next
End Sub

Sub theirmove
    Static otm&

    For o = 1 To nobj - 1: 'dzo = 2 * (RND - .5)
    obz(o) = obz(o) + dzo: obphi(o) = obphi(o) + (-1) ^ o: Next

    'FOR n = 0 TO nobj: ticol(27 + n * 31) = 4 * (INT(TIMER * 10 + n) AND 1): NEXT
    Palette 255, 60 * (Int(Timer * 10) And 1)

    If oby(nobj) > 0 Then
        If Int(Timer * 5) <> otm& Then oby(nobj) = oby(nobj) - 1: otm& = Int(Timer * 5)
    Else
        ticol(ntri) = 6: hiticol(ntri) = &H600
    End If

End Sub

Function tileside (pt, tile)
    Dim ts, pb

    ts = 1: For p = 0 To 3: If pt = tipt(p, tile) Then ts = 0: Exit For
    Next

    If ts Then
        pb = tipt(0, tile)
        ts = Sgn((rtx(pt) - rtx(pb)) * tnx(tile) + (rty(pt) - rty(pb)) * tny(tile) + (rtz(pt) - rtz(pb)) * tnz(tile))
    End If
    tileside = ts
End Function

Sub timeit
    Static fram, ofram, otim!
    If Not tog(0) Then Wait 986, 8
    fram = fram + 1:
    If Timer - otim! >= 1 Then
        ofram = fram: Locate 1, 6: Print fram; " ": otim! = Timer: fram = 0
    End If
End Sub

Sub TLINEFRx (pp1, pp2)
    Dim den As Long, num As Long, ymin As Long, ymax As Long

    p1 = pp1: p2 = pp2: ymin = yy(p1): ymax = yy(p2)
    If ymin > ymax Then Swap ymin, ymax: Swap p1, p2

    If ymax < scrtop Or ymin > scrbot Then Exit Sub
    If ymax > scrbot Then ymax = scrbot
    If ymin < scrtop Then ymin = scrtop

    den = yy(p2) - yy(p1)
    If den <> 0 Then
        num = xx(p2) - xx(p1)
        If num = 0 Then
            sxx = xx(p1): For y% = ymin To ymax
                If sxx > trrt(y%) Then trrt(y%) = sxx - 1
                If sxx < trlft(y%) Then trlft(y%) = sxx
            Next
        Else
            For y% = ymin To ymax: sxx = xx(p1) + (num * (y% - yy(p1))) \ den
                If sxx > trrt(y%) Then trrt(y%) = sxx - 1
                If sxx < trlft(y%) Then trlft(y%) = sxx
            Next
        End If
    Else
        xmin = xx(p1): xmax = xx(p2): If xmin > xmax Then Swap xmin, xmax
        If xmax < 0 Or xmin > sright Then Exit Sub
        If xmax > sright Then xmax = sright
        If xmin < 0 Then xmin = 0
        If xmin < trlft(ymin) Then trlft(ymin) = xmin
        If xmax > trrt(ymin) Then trrt(ymin) = xmax
    End If

    If ymin < trymin Then trymin = ymin
    If ymax > trymax Then trymax = ymax

End Sub

DefLng X-Z
Sub TLINESIDEx (p1, p2, p3): 'know this: pz(p1)>0

    delx! = px(p2) * pz(p1) - px(p1) * pz(p2)
    dely! = -(py(p2) * pz(p1) - py(p1) * pz(p2))

    If pz(p2) > 0 Then
        ymin = yy(p1): ymax = yy(p2): If ymin > ymax Then Swap ymin, ymax
    Else
        ymin = yy(p1): ymax = ymin
        If dely! > 0 Then ymax = scrbot Else If dely! < 0 Then ymin = scrtop
    End If

    If ymax < scrtop Or ymin > scrbot Then Exit Sub
    If ymax > scrbot Then ymax = scrbot
    If ymin < scrtop Then ymin = scrtop

    delx3! = px(p3) * pz(p1) - px(p1) * pz(p3)
    dely3! = -(py(p3) * pz(p1) - py(p1) * pz(p3))
    xside = -Sgn(dely!) * Sgn(delx! * dely3! - delx3! * dely!)

    If pz(p2) > 0 Then
        dely! = yy(p2) - yy(p1): delx! = xx(p2) - xx(p1)
    Else
        delx! = delx! * scr
    End If

    If CLng(dely!) <> 0 And ymax > ymin Then
        slp! = delx! / dely!: diff& = slp! * (ymax - ymin)
        sxx1& = xx(p1) + CLng(slp! * (ymin - yy(p1)))
        For y% = ymin To ymax: 'sxx& = xx(p1) + CLNG(slp! * (y% - yy(p1)))
            sxx& = sxx1& + (diff& * (y% - ymin)) \ (ymax - ymin)
            If xside = -1 Then
                trrt(y%) = sxx&: inrt(y%) = 0
                If inlft(y%) = -1 Then trlft(y%) = 0: inlft(y%) = 0
            Else 'IF xside = 1 THEN
                trlft(y%) = sxx&: inlft(y%) = 0
                If inrt(y%) Then trrt(y%) = sright: inrt(y%) = 0
            End If
        Next

    Else
        'ymax = ymin; horizontal line: '...
        If pz(p2) > 0 Then
            xmin = xx(p1): xmax = xx(p2): If xmin > xmax Then Swap xmin, xmax
        Else
            xmin = xx(p1): xmax = xmin
            If delx! > 0 Then xmax = sright Else If delx! < 0 Then xmin = 0
        End If
        If xmax < 0 Or xmin > sright Then Exit Sub
        If xmax > sright Then xmax = sright
        If xmin < 0 Then xmin = 0
        trlft(ymin) = xmin: trrt(ymin) = xmax: inlft(ymin) = 0: inrt(ymin) = 0
    End If

    If ymin < trymin Then trymin = ymin
    If ymax > trymax Then trymax = ymax

End Sub

DefInt X-Z
Sub urangle

    'left handed
    'dir relative to observer - normal vector - component in unrotated frame
    znx! = Sin(phi!)
    znz! = Cos(phi!)
    xnx! = znz!
    xnz! = -znx!

    ptx(-1) = pvx: pty(-1) = pvy: ptz(-1) = pvz

    'FOR i = 0 TO nactpt
    For o = 1 To nobj:
        xox! = Cos(obphi(o) * pi! / 180)
        xoz! = Sin(obphi(o) * pi! / 180)

        For i = op1(o) To opend(o)

            ppx! = ptx(i) * xox! + ptz(i) * xoz! + obx(o) - pvx
            ppz! = ptz(i) * xox! - ptx(i) * xoz! + obz(o) - pvz

            rtz(i) = ppx! * znx! + ppz! * znz!
            rtx(i) = ppx! * xnx! + ppz! * xnz!
            rty(i) = pty(i) + oby(o) - pvy
            If CInt(rtz(i)) > 0 Then
                rtxx(i) = CLng(cx + (rtx(i) * scx) / rtz(i))
                rtyy(i) = CLng(cy - (rty(i) * scy) / rtz(i))
            End If
    Next: Next

End Sub

Sub yourmove

    Locate 1, 10: Print Int(phi! * 180 / pi!); pvx; pvy; pvz

    If MULTIKEY(56) Then
        If MULTIKEY(77) Then
            pvx = pvx + xnx! * 8: pvy = pvy + xny! * 8: pvz = pvz + xnz! * 8
        End If
        If MULTIKEY(75) Then
            pvx = pvx - xnx! * 8: pvy = pvy - xny! * 8: pvz = pvz - xnz! * 8
        End If
    Else
        If MULTIKEY(77) Then phi! = phi! + pi! / 180
        If MULTIKEY(75) Then phi! = phi! - pi! / 180
    End If

    If MULTIKEY(72) Then
        pvx = pvx + znx! * 8: pvy = pvy + zny! * 8: pvz = pvz + znz! * 8
    End If
    If MULTIKEY(80) Then
        pvx = pvx - znx! * 8: pvy = pvy - zny! * 8: pvz = pvz - znz! * 8
    End If

    If MULTIKEY(30) Then
        pvy = pvy + 8
    End If
    If MULTIKEY(44) Then
        pvy = pvy - 8
    End If

End Sub

Something fairly recent: A sort of pathfinding demo, PATH5.BAS. There are two targets and ten starting points at each frame. Space to exit, other key for a new map.

Code: (Select All)

'$lang: "qb"
DEFINT A-Z: DECLARE SUB putbox (x, y, c) : DIM SHARED qbver, scale, xmax, ymax
DECLARE FUNCTION testline (olx, oly, x, y) '/' Multi-line comment = FreeBasic
Screen 13: Circle (2, 2), 2: If Point(1, 0) Then qbver = 45 Else qbver = 64 '/
Dim Shared xti(7), yti(7), nbd, cbd, togl, stx, sty, tgx, tgy
scale = 1: xmax = 640 / scale - 1: ymax = 480 / scale - 1
If qbver = 45 Or qbver = 64 Then xmax = 320 / scale - 1: ymax = 200 / scale - 1
If qbver = 0 Then Screen 18
'If qbver = 64 Then _FullScreen
ReDim Shared cbordx(1, xmax / 10 * ymax), cbordy(1, xmax / 10 * ymax)
Randomize Timer: xti(0) = -1: xti(1) = 1: yti(2) = -1: yti(3) = 1
xti(4) = -1: yti(4) = -1: xti(5) = 1: yti(5) = -1
xti(6) = -1: yti(6) = 1: xti(7) = 1: yti(7) = 1

10 Cls: ReDim Shared map(xmax, ymax), pathd(xmax, ymax)
npass = 0: nbd = 0: cbd = 0
For x = 0 To xmax: For y = 0 To ymax
    If x = 0 Or y = 0 Or x = xmax Or y = ymax Then map(x, y) = -1
Next: Next
For i = 1 To 40: x0 = Int(Rnd * xmax): y0 = Int(Rnd * ymax)
    Select Case (Rnd > .5)
        Case 0: For x = x0 To x0 + Rnd * 20 * xmax / 64: If x > xmax Then Exit For
            map(x, y0) = -1: Next
        Case -1: For y = y0 To y0 + Rnd * 20 * ymax / 40: If y > ymax Then Exit For
            map(x0, y) = -1: Next
End Select: Next
For i = 1 To 2: Do: x = Int(Rnd * xmax): y = Int(Rnd * ymax)
    Loop Until map(x, y) = 0 And pathd(x, y) = 0
tgx = x: tgy = y: Call putbox(tgx, tgy, 4): pathd(tgx, tgy) = 1: Next
For x = 0 To xmax: For y = 0 To ymax
    If map(x, y) Then Call putbox(x, y, 15)
        If pathd(x, y) = 1 Then
            For i = 0 To 3: xt = x + xti(i): yt = y + yti(i)
                If map(xt, yt) = 0 Then
                    cbd = cbd + 1: cbordx(0, cbd) = xt: cbordy(0, cbd) = yt
                    Call putbox(xt, yt, 4): 'WAIT &H3DA, 8
                End If
            Next
        End If
Next: Next
tim# = Timer: togl = 1

Do: change = 0: npass = npass + 1: Locate 1, 1: Print npass,
    togl = 1 - togl: togn = 1 - togl: numi = 3 + 4 * togl
    Do While cbd > 0: x = cbordx(togl, cbd): y = cbordy(togl, cbd)
        If map(x, y) = 0 And pathd(x, y) = 0 Then
            'IF map(x, y) OR pathd(x, y) = 0 THEN
            For i = 0 To numi: xt = x + xti(i): yt = y + yti(i)
                If pathd(xt, yt) Then
                    If pathd(x, y) = 0 Or pathd(x, y) > pathd(xt, yt) + 1 Then
                        pathd(x, y) = pathd(xt, yt) + 1: change = 1: Call putbox(x, y, pathd(x, y))
                        'pset (x, y), pathd(x, y)
                    End If
                ElseIf map(xt, yt) = 0 Then
                    nbd = nbd + 1: cbordx(togn, nbd) = xt: cbordy(togn, nbd) = yt: 'map(xt, yt) = 1
            End If: Next
    End If: cbd = cbd - 1: Loop: cbd = nbd: nbd = 0
Loop Until change = 0 'OR pathd(stx, sty) > 0

For s = 1 To 10
    Do: x = Int(Rnd * xmax): y = Int(Rnd * ymax): Loop Until map(x, y) = 0
    stx = x: sty = y: Call putbox(x, y, 1): olx = x: oly = y: ovy = 1000: ochg = 0: count = 0
    If pathd(stx, sty) > 0 Then
        Do: np = pathd(x, y): nx = x: ny = y: chg = 0: count = count + 1: For i = 0 To 7
            xt = x + xti(i): yt = y + yti(i)
            If pathd(xt, yt) > 0 And pathd(xt, yt) < pathd(nx, ny) Then nx = xt: ny = yt
                'If map(xt, yt) = -1 Or pathd(x, y) = 2 Then chg = 1
            Next: If pathd(x, y) = 2 Then chg = 1
            vx = nx - x: vy = ny - y: oox = oldx: ooy = oldy: oldx = x: oldy = y
            x = nx: y = ny: 'Call putbox(x, y, s + 1): 'oox = olx: ooy = oly
            chg = chg + testline(olx, oly, x, y): 'Circle (olx, oly), 4, 3
            If count > 1000 Then x = nx: y = ny
            If (x = oldx And y = oldy) Or (x = oox And y = ooy) Then x = nx: y = ny: chg = 1
            If chg > 0 And (ovx <> vx Or ovy <> vy) Then
                '    If chg > 0 Then
                ovx = vx: ovy = vy: ochg = chg
                Line (olx * scale, oly * scale)-(x * scale, y * scale), s:
                olx = x: oly = y: 'Circle (olx, oly), 4, 3
            End If
            'Locate 2, 1: Print x, y, vx, vy
        Loop Until pathd(x, y) = 1
        Line (olx * scale, oly * scale)-(x * scale, y * scale), s: Call putbox(x, y, 4)
End If: Next

'to do: keep track of wall breach starts; draw line between last good positions

Print Timer - tim#: Sleep
If InKey$ <> " " Then 10

Sub putbox (x, y, c)
    Line (x * scale, y * scale)-((x + 1) * scale - 1, (y + 1) * scale - 1), c, BF
End Sub

Function testline (olx, oly, x, y)
    x1 = olx: x2 = x: y1 = oly: y2 = y: tsl = 0
    delx = x - olx: dely = y - oly

    'If delx <> 0 And dely <> 0 Then Call putbox(x, y, 6): Call putbox(olx, oly, 5)


    If Abs(delx) >= Abs(dely) And delx <> 0 Then
        If x1 > x2 Then Swap x1, x2: Swap y1, y2
        For xx = x1 To x2: yy = y1 + dely * (xx - x1) / delx
            'If delx <> 0 And dely <> 0 Then Line (x, y)-(olx, oly), 6
            'Call putbox(xx, yy, 4)
            'If map(xx, yy) = -1 Then tsl = 1: Exit For
            For i = 0 To 7
                xt = xx + xti(i): yt = yy + yti(i)
                If map(xt, yt) = -1 Then tsl = 1
            Next: If tsl = 1 Then Exit For
        Next
    ElseIf dely <> 0 Then
        If y1 > y2 Then Swap x1, x2: Swap y1, y2
        For yy = y1 To y2: xx = x1 + delx * (yy - y1) / dely
            'If delx <> 0 And dely <> 0 Then Line (x, y)-(olx, oly), 6
            'Call putbox(xx, yy, 4)
            'If map(xx, yy) = -1 Then tsl = 1: Exit For
            For i = 0 To 7
                xt = xx + xti(i): yt = yy + yti(i)
                If map(xt, yt) = -1 Then tsl = 1
            Next: If tsl = 1 Then Exit For
        Next
    End If
    If tsl = 1 And map(xx, yy) = 0 And (xx <> olx Or yy <> oly) Then x = xx: y = yy: 'Circle (xx, yy), 4, 4
    'If tsl = 1 Then Circle (xx, yy), 4, 4: 'Print xx; yy; "c"
    testline = tsl
End Function

[James D Jarvis]

It was fun and worked smoothly. Definitely needs a level builder or randomizer.

[kinem]

Thanks. I might add that. In the meantime, it shouldn't be hard to modify the level in the code.