| Welcome, Guest |
You have to register before you can post on our site.
|
| Forum Statistics |
» Members: 314
» Latest member: Wingfoot
» Forum threads: 1,743
» Forum posts: 17,903
Full Statistics
|
| Latest Threads |
Learning Pallet Rack Safe...
Forum: Utilities
Last Post: Sandrapew
04-03-2025, 09:36 AM
» Replies: 0
» Views: 16
|
Choosing New Versus or Pr...
Forum: Utilities
Last Post: Sandrapew
03-18-2025, 01:11 AM
» Replies: 0
» Views: 26
|
The QB64 IDE shell
Forum: Utilities
Last Post: JasonPag
09-16-2024, 05:37 PM
» Replies: 9
» Views: 989
|
Importance regarding Ches...
Forum: Utilities
Last Post: JasonPag
09-01-2024, 06:34 PM
» Replies: 0
» Views: 61
|
Chess and Analysis and En...
Forum: Utilities
Last Post: JasonPag
08-28-2024, 02:37 PM
» Replies: 0
» Views: 61
|
DAY 009:_PutImage
Forum: Keyword of the Day!
Last Post: grymmjack
09-02-2023, 02:57 PM
» Replies: 54
» Views: 3,127
|
Fall Banner Contest?
Forum: Site Suggestions
Last Post: grymmjack
08-31-2023, 11:50 PM
» Replies: 36
» Views: 1,911
|
ColorPicker - Function th...
Forum: Dav
Last Post: Dav
08-31-2023, 11:04 PM
» Replies: 3
» Views: 424
|
Goals(1) = New Tile()
Forum: Works in Progress
Last Post: RhoSigma
08-31-2023, 09:45 PM
» Replies: 3
» Views: 210
|
micro(A)v11
Forum: QBJS, BAM, and Other BASICs
Last Post: bplus
08-31-2023, 09:14 PM
» Replies: 90
» Views: 4,901
|
|
|
External Module Player (libxmp) support |
|
Posted by: RhoSigma - 04-18-2022, 09:44 AM - Forum: RhoSigma
- No Replies
|
 |
Libxmp is a library that renders module files to PCM data. It supports over 90 mainstream and obscure module formats including Protracker (MOD), Scream Tracker 3 (S3M), Fast Tracker II (XM), and Impulse Tracker (IT)
After almost 5 years, libxmp got lots of fixes plus a couple new features and finally version 4.5.0 was released. This was a good occasion for me to complete my wrapper library for it and to improve my demo player to showcase some of the libxmp functions and give a hint how to correctly use the wrapper library.
When porting the informations over into libxmp.bi/.bm and testing it, I found several badly described things and tried to correct/improve those with my own findings from examining the libxmp sources.
The XmpPlayer.bas file will espacially show the use of the various wrapper or helper functions in libxmp.bm, which are used to retrieve informations from the internal libxmp structures.
The player itself is almost self explanatory at runtime and programmed as an endless loop, so simply hit the X button of the player window to quit it at any time. It is able to show various informations about the current module and also features a wave oscillator and frequency spectrum (FFT) display, the latter thanks to Vince's Fast Fourier algorithms.
xmpDemo.7z (Size: 2.53 MB / Downloads: 59)
--- (Dec/22)(Libxmp wrapper library & demo player)
Note that this program requires the 32-bit version of QB64, as libxmp is currently available as 32-bit version only, this will hopefully change in the future. So here it is, just move the extracted xmpDemo folder with its entire contents into your QB64 installation folder, then open the QB64 IDE, untick the Save EXE in source folder option (if active (in Run Menu)), load XmpPlayer.bas from the xmpDemo folder, hit F5 and enjoy the music.
|
|
|
| Assassins 64: Blast from the past |
|
Posted by: kinem - 04-18-2022, 12:28 AM - Forum: Programs
- Replies (6)
|
 |
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
|
|
|
|
| Forum Costs and Donations |
|
Posted by: admin - 04-17-2022, 11:40 PM - Forum: Announcements
- No Replies
|
 |
I've always been amazed by how generous our community of hobbyists have been. The forums here are no more than a few days old, and already people have started to send me private messages asking if they can help donate anything to offset the cost involved in setting things up.
First, let me be perfectly clear and say for the record: There's absolutely no reason for anyone to donate or send any money to help support the forums here, or our hosting costs!!
Here, for the record, is the receipt for how much these forums cost for me to set up, and this includes unlimited storage, along with the domain name for a year.
![[Image: web-cost.png]](https://i.ibb.co/7WFBQCQ/web-cost.png)
Less than $100.00 for a whole year for this! That's hardly going to break my bank account at all, so let me repeat once again: There's absolutely no reason for anyone to donate or send any money to help support the forums here, or our hosting costs!!
Now, with that said, if someone still wants to send me money, I'm not going to get in a fist fight with them to stop them. After all, one way I make extra cash on the side has always been from people donating to me via paypal for the books I upload to various sites in webnovel form.
If you absolutely must give a donation, do so via here: Donate to Steve!!
Paypal can sort out all the currency and tax issues, and all that good stuff, and I'll just leave whatever ends up in this paypal account alone and when time comes to renew in the future, I'll just direct hostgator to take the money from there directly. 
|
|
|
|
| Expanding Horizons |
|
Posted by: admin - 04-17-2022, 09:22 PM - Forum: Announcements
- Replies (12)
|
|
If you guys have noticed, I've added another section to our site: Expanding Horizons.
What this section is dedicated to is for any and all library creators to have a nice simple place to post and curate their work. *.BI and *.BM libraries are useful expansion which allow QB64 to do things that it couldn't do before, and it's an easy way for *anyone* to contribute to the language -- so there should also be an easy place place where they can easily keep, maintain, and make available their stuff.
If you're a creator of *BI or *.BM libraries, and you want to share them with the rest of the world, post me a comment here and I'll set you up your own little corner of the web -- with full moderator rights and authority there -- and you'll have a spot to highlight and maintain all that you do and share.
|
|
|
|
|
