+- QB64 Phoenix Edition (https://staging.qb64phoenix.com)
+-- Forum: QB64 Rising (https://staging.qb64phoenix.com/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://staging.qb64phoenix.com/forumdisplay.php?fid=3)
+---- Forum: Programs (https://staging.qb64phoenix.com/forumdisplay.php?fid=7)
+---- Thread: Assassins 64: Blast from the past (/showthread.php?tid=27)
Assassins 64: Blast from the past - kinem - 04-18-2022
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 SubRE: Assassins 64: Blast from the past - johnno56 - 04-18-2022
Cool game... Unfortunately, my playing skills are not what they used to be.... lol
RE: Assassins 64: Blast from the past - kinem - 04-20-2022
(04-18-2022, 01:21 AM)johnno56 Wrote: Cool game... Unfortunately, my playing skills are not what they used to be.... lol
Thanks. Let me know if you have suggestions.
RE: Assassins 64: Blast from the past - Pete - 04-20-2022
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
RE: Assassins 64: Blast from the past - kinem - 04-24-2022
(04-20-2022, 03:25 AM)Pete Wrote: 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 = a3D-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 SubSomething 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 FunctionRE: Assassins 64: Blast from the past - James D Jarvis - 04-26-2022
It was fun and worked smoothly. Definitely needs a level builder or randomizer.
RE: Assassins 64: Blast from the past - kinem - 04-28-2022
Thanks. I might add that. In the meantime, it shouldn't be hard to modify the level in the code.