Recent Posts

Pages: 1 ... 3 4 [5] 6 7 ... 10
41
QB64 Discussion / Re: Small graphics programming challenge
« Last post by bplus on April 14, 2022, 10:56:54 am »
Hi @Richard Frost

There is naming problem with the Flag files see attached snap
  [ You are not allowed to view this attachment ]  
42
QB64 Discussion / Re: Small graphics programming challenge
« Last post by SMcNeill on April 14, 2022, 10:50:35 am »
He stopped halfway...  I've got this on here somewhere, except my version lets you click on the circles and use them as a pop-up menu.  :P
43
QB64 Discussion / Small graphics programming challenge
« Last post by Richard Frost on April 14, 2022, 10:31:33 am »
' Small programming challenge contained at:
'

' It's a boring hour and a half of some guy creating CSS code for a simple animation to:
' 1) Have 8 icons/pictures rotating in a circle, while pulsing
' 2) when one selected, stop all rotation, the pulsing of the selected item, and
'    identify the selected item
' Use any 8 pix you've got handy, or the flags I've attached here.
Code: QB64: [Select]
  1. Data albania,britain,canada,eu,us,japan,israel,china
  2. Screen _NewImage(800, 600, 32)
  3. For i = 1 To 8
  4.     Read name$(i)
  5.     pix(i) = _LoadImage("f_" + name$(i) + ".png")
  7. td = 1 '                                         throb direction
  10.         mx = _MouseX
  11.         my = _MouseY
  12.         mb = _MouseButton(1)
  13.     Wend
  14.     Cls
  15.     hl = 0 '                                     highlight
  16.     For i = 1 To 8
  17.         r = _D2R(i * 45 + aa) '                  angle in radians
  18.         x = 400 + 200 * Cos(r)
  19.         y = 300 + 200 * Sin(r)
  20.         tt = th '                                temporary throb = current
  21.         If mb And (Abs(x - mx) < 30) And (Abs(y - my) < 30) Then ' selected
  22.             tt = 0 '                             temporary throb off
  23.             hl = 1 '                             highlight on
  24.             _PrintString (x - 26, y - 50), name$(i)
  25.         End If
  26.         _PutImage (x - 30 + tt, y - 30 + tt)-(x + 30 - tt, y + 30 - tt), pix(i), 0
  27.     Next i
  28.     _Display '                                   optional, eliminates flickering
  29.     aa = (aa - (hl = 0)) Mod 360 '               angle advance
  30.     th = th + td '                               throb
  31.     If Abs(th) = 3 Then td = -td '               throb direction
  33.  
44
QB64 Discussion / Re: QB64 Bounty List
« Last post by SMcNeill on April 14, 2022, 09:01:10 am »
Quote from: mdijkens on April 14, 2022, 03:27:47 am
1. A good Inkey$ like alternative for $console:only on Win and Linux would give much business value for me

There's _CINP for Windows, which does what you're talking about, though it's never been ported into Linux yet.
45
QB64 Discussion / Re: QB64 Bounty List
« Last post by mdijkens on April 14, 2022, 03:27:47 am »
1. A good Inkey$ like alternative for $console:only on Win and Linux would give much business value for me
2. Shell with stdin and stdout; preferably with _Nowait (to get some multitasking functionality)
46
QB64 Discussion / Re: Has $Debug been working well for you?
« Last post by Richard on April 13, 2022, 11:14:06 am »
Although not going into specifics here, it was/is a great help - although floating point handling, as already noted is (and probably always still will be) an issue (and not referring to FLOAT which is a "problem" in itself).

Probably the best thing for me with $Debug was that it brought QB64 much closer to the already existing functionality of MS PDS 7.1 (upgrade to QB45) which I still use a lot (QB64 has a lot of catching up to what PDS could do).
47
QB64 Discussion / Re: QB64 Bounty List
« Last post by madscijr on April 13, 2022, 10:07:49 am »
One wish list item I'd offer a bounty for (if it's within my modest means!) would be getting QB64 to read separate input from multiple USB mice plugged into the computer.

Preferably this would be cross-platform (I did research a while back and it looked like it was possible for PC, Linux and Mac using different methods, not sure about DOS) but at least for Windows.

Microsoft's RawInput API can do it, and I found a ton of examples, but alas this is just beyond my capabilities and/or free time :-( so to anyone who can get it done, what's it worth to ya? LoL

Here are the discussions about it with links to research findings / related libraries / sample code / etc.:

reading multiple mice input with _DEVICES and _DEVICE$, or RawInput ?:

https://qb64forum.alephc.xyz/index.php?topic=3348.0

reading multiple mice input revisited / external library question:

https://qb64forum.alephc.xyz/index.php?topic=3695.0

events and malloc in QB64?:

https://qb64forum.alephc.xyz/index.php?topic=3766.0
48
QB64 Discussion / Re: QB64 Bounty List
« Last post by wiggins on April 12, 2022, 09:53:58 pm »
I just remembered that there is a bug list out there. 
49
QB64 Discussion / Re: QB64 Bounty List
« Last post by wiggins on April 12, 2022, 09:51:50 pm »
M1 Support is needed
Generate a smaller executable
50
Programs / Assassins 64: Blast from the past
« Last post by kinem on April 12, 2022, 09:39:22 pm »
This is a QB 64 version of the first-person shooter game that I made in QB 4.5 back in 2001. It was impressive back then simply because it was such a fast engine for QB 4.5; that's not really an issue anymore. The sprites are rather basic (no pun intended?), but this version features improved gameplay compared to the original, and a third weapon. The look of the game is otherwise the same, and most of the code is unchanged.

Code: QB64: [Select]
  1. '1PSA64-2.BAS by Dr. Jacques Mallah (jackmallah@yahoo.com)
  2. 'Compile with QB64
  3. DECLARE SUB endit () : DECLARE SUB onscreen () : DECLARE SUB paintsprites ()
  4. DECLARE SUB medkit.etc () : DECLARE SUB showhealth () : DECLARE SUB badguys ()
  5. DECLARE SUB yourmove () : DECLARE SUB time () : DECLARE SUB yourshot ()
  6. DECLARE SUB crashtest (bx!, by!, vx!, vy!) : DECLARE FUNCTION atan2! (y!, x!)
  7. DECLARE SUB showbadguy (b%) : DECLARE SUB showbadshot (x%) : DECLARE SUB showurshot (x%)
  8. DECLARE SUB raycast () : DECLARE SUB btexture (xx%, dd%, bcc%, c%, bcc2%)
  9. DECLARE SUB putcircle (x%, y%, R%, col%, circdis!) : DECLARE SUB showmed (b%)
  10. DECLARE SUB putbox (x1!, y1%, x2!, y2%, col%, boxdis!): declare sub readmap()
  11. DECLARE SUB intro () : DECLARE SUB maketables () : DECLARE SUB makeworld ()
  12. DECLARE SUB hLINE (x1%, x2%, y%, c%) : DECLARE SUB vline (x%, yt%, yb%, c%), keys()
  13. declare function lsight%(b%): ntx% = 7: sizey% = 30: sizex% = 60: shift = 49
  14. Dim kbmatrix%(128), odd%(319)
  15. Dim fmap%(sizex% - 1, sizey% - 1), wdis(319), testin%(ntx%, 63, 63), dsfc(319)
  16. Dim cmap%(sizex% - 1, sizey% - 1), sb1%(159, 199), st(1800), ct(1800), hicol%(255)
  17. Dim map%(sizex% - 1, sizey% - 1), tant(1800), xb%(1800), yb%(1800), sb2%(160 * 192 + 1)
  18. Dim lowcol%(-128 To 127), bicol%(255), atx%(319), ammo%(2), oammo%(2), stt(1800), ctt(1800)
  19. Call readmap: c% = nmeds% + nammo% - 1: ReDim med%(c%), scmed(c%), mx(c%), my(c%)
  20. ReDim medis(c%), medx(c%), medy(c%), dis(nspr%), spord%(nspr%), disi%(nspr%)
  21. ReDim sht(nshots%), shosht%(nshots%), shtx(nshots%), shty(nshots%), vshx(nshots%), vshy(nshots%)
  22. ReDim shtang%(nshots%), shtdis(nshots%), dela%(nshots%), shtht%(nshots%), plasma%(nshots%)
  23. ReDim bgh%(nbguysm1%), bgx(nbguysm1%), bgy(nbguysm1%), robo%(nbguysm1%)
  24. ReDim x(nbguysm1%), y(nbguysm1%), vbx(nbguysm1%), vby(nbguysm1%)
  25. ReDim scbg(nbguysm1%), bgang%(nbguysm1%), bgsht(nbguysm1%), lastx(nbguysm1%), lasty(nbguysm1%)
  26. ReDim bgshosht%(nbguysm1%), bgshtx(nbguysm1%), bgshty(nbguysm1%)
  27. ReDim bgvshx(nbguysm1%), bgvshy(nbguysm1%), bgshtdis(nbguysm1%)
  28. ReDim bgdela%(nbguysm1%), bgshtht%(nbguysm1%), active%(nbguysm1%): _FullScreen: delta.t = .1
  29. Call intro: maketables: makeworld: Get (0, 8)-(319, 199), sb2%()
  30.  
  31. main: raycast: keys: yourshot: time: yourmove: badguys: showhealth: medkit.etc
  32. Call paintsprites: onscreen: endit: GoTo main
  33.  
  34. spritedata:
  35. Data 0,6,2,1,0,4,""
  36.  
  37. 'Map: each character (>"0") is a color or texture
  38. '0 is empty space.  Outer walls must not contain any 0's, ?'s, or r's
  39. '1, 2, 3, 4, 5, 6, 7, 8, 9, :, ;, <, +, >, @, A are wall textures
  40. '4 is the map, A is the rainbow
  41. '? is an ice block "door"
  42. 'r is random: 50% chance of ice, else texture @
  43.  
  44. '. = empty, B = bad guy, R = robot, M = medkit, L = ammo, P = the President / player
  45. mapdata:
  46. Data "666666667546C66666666666666666666666666666666666666666666666"
  47. Data "6.R..?.......6....M6L..................RR?................L6"
  48. Data "6....1.......A.....?...................BB3................M6"
  49. Data "6....1.......@.....6662?266666662526666666666664?766666666?6"
  50. Data "6....1.......?.....6.....................6.................6"
  51. Data "6....1.......>.....6.....................?.................6"
  52. Data "6....1.......=.....6.....................6.................1"
  53. Data "6....?.......<.....666666666444666666666?6.................1"
  54. Data "6....2.......;.....6.........1...........6.......BBBB......1"
  55. Data "6....2.......:.....6..BBBB...2......B....?.................6"
  56. Data "6....2.......9.....6..BBBB...3...........6.................6"
  57. Data "6....2.......8.....6.........4...........6.................6"
  58. Data "6....?.......7.....6.........A777777777776666664?76666666666"
  59. Data "6....3.......6.....6.......................................6"
  60. Data "6....3.......5.....6.......................................6"
  61. Data "6....3.......4.....7.......................................6"
  62. Data "6....?.......3.....6.......................................6"
  63. Data "6....4BBB....2..R..6.......................................6"
  64. Data "6....4BBB....1LMMM612?45633?333333333333?33336.............6"
  65. Data "6....4BBB....6657666.....6...................6.............6"
  66. Data "6....4BBB....?.LLL.6.....6...................6.............6"
  67. Data "6....4BBB....?.MMM.6.....6.......BBB.........?.............6"
  68. Data "6....555555555555556.....r...................6.............6"
  69. Data "6.........?.....M..6.....6...................6666666466666?6"
  70. Data "6.........r........6.....6AAAAAAA?AAAAAAAAAA46.............3"
  71. Data "6.........r........A.........................6.............4"
  72. Data "6..B......r........A..BBBB...................?.............1"
  73. Data "6.........r.....P..A.........................6...RRRR......2"
  74. Data "6.........r.....L..A.............LLLLMMMM....6.............6"
  75. Data "6155555555555556AAA66666666666666AAA666656666666666656666666"
  76.  
  78. Function atan2 (y, x)
  79.     If x = 0 Then
  80.         If y > 0 Then atan2 = 90 Else If y < 0 Then atan2 = 270
  81.     ElseIf x > 0 Then
  82.         atan2 = (Atn(y / x) * 57.2958 + 360) Mod 360
  83.     Else
  84.         atan2 = (Atn(y / x) * 57.2958 + 180)
  85.     End If
  87.  
  88. Sub badguys
  89.     Shared nbguysm1%, testin%(), bgx(), bgy(), delta.t, bgh%(), dis()
  90.     Shared px, py, bx, by, vx, vy, fdt, scbg(), bgang%(), x(), y(), fram%, ph%
  91.     Shared bgsht(), bgshosht%(), bgvshx(), bgvshy(), ct(), st(), bgshtdis()
  92.     Shared inx%, iny%, map%(), fmap%(), bsa%, bgshtx(), bgshty(), bgdela%()
  93.     Shared bgshtht%(), nbguys%, vbx(), vby(), snd%, kills%, robo%(), active%(), lastx(), lasty()
  94.  
  95.     For x% = 0 To nbguysm1%
  96.     testin%(4, Int(bgx(x%)) + 2, Int(bgy(x%)) + 19) = 0: Next
  97.  
  98.     'bad guys: Note: I want to add some AI!
  99.     damp = .8 ^ fdt: sqrdt = Sqr(delta.t) * 6
  100.     For x% = 0 To nbguysm1%
  101.  
  102.         If bgh%(x%) > 0 Then
  103.             If lsight%(x%) Then
  104.                 active%(x%) = 1: lastx(x%) = bx: lasty(x%) = by
  105.             Else
  106.                 If active%(x%) = 1 Then active%(x%) = 2
  107.             End If
  108.  
  109.             bbgx = px - bgx(x%): bbgy = py - bgy(x%)
  110.             dis(x%) = Sqr(bbgx * bbgx + bbgy * bbgy) + .01
  111.  
  112.             chase = 2 * delta.t * (1 + robo%(x%)) * -(active%(x%) > 0)
  113.             bbgx = lastx(x%) - bgx(x%): bbgy = lasty(x%) - bgy(x%)
  114.             cdis = Sqr(bbgx * bbgx + bbgy * bbgy) + .01
  115.             If active%(x%) = 2 And cdis < .3 Then active%(x%) = 0
  116.  
  117.             vbx(x%) = vbx(x%) * damp + (Rnd - .5) * sqrdt + bbgx / cdis * chase
  118.             vby(x%) = vby(x%) * damp + (Rnd - .5) * sqrdt + bbgy / cdis * chase
  119.             If (px - bgx(x%)) ^ 2 + (py - bgy(x%)) ^ 2 < 1 Then
  120.                 vbx(x%) = vbx(x%) - bbgx / dis(x%) * fdt
  121.                 vby(x%) = vby(x%) - bbgy / dis(x%) * fdt
  122.                 vx = vx + bbgx / dis(x%) * fdt
  123.                 vy = vy + bbgy / dis(x%) * fdt
  124.             End If
  125.             svx% = Sgn(vbx(x%)): svy% = Sgn(vby(x%))
  126.             crashtest bgx(x%) + .15 * svx%, bgy(x%) + .15 * svy%, vbx(x%), vby(x%)
  127.             crashtest bgx(x%) - .15 * svx%, bgy(x%) + .15 * svy%, vbx(x%), vby(x%)
  128.             crashtest bgx(x%) + .15 * svx%, bgy(x%) - .15 * svy%, vbx(x%), vby(x%)
  129.             bgx(x%) = bgx(x%) + vbx(x%) * delta.t: bgy(x%) = bgy(x%) + vby(x%) * delta.t
  130.             scbg(x%) = 2 / (dis(x%) + .01)
  131.             bgang%(x%) = atan2(bgy(x%) - by, bgx(x%) - bx) * 5
  132.             delba% = (bgang%(x%) - bsa% + 1800) Mod 1800
  133.             x(x%) = delba% - scbg(x%) * 20: y(x%) = 100 - 25 * scbg(x%)
  134.  
  135.             'bad guy's shot
  136.             If bgsht(x%) <= 0 And active%(x%) = 1 Then
  137.                 bgsht(x%) = 20 + Rnd: bgshosht%(x%) = 1: 'create shot
  138.                 bgshtx(x%) = bgx(x%): bgshty(x%) = bgy(x%)
  139.                 bgsta% = (bgang%(x%) + 900) Mod 1800
  140.                 bgvshx(x%) = ct(bgsta%) * 7
  141.                 bgvshy(x%) = st(bgsta%) * 7
  142.             End If
  143.         End If
  144.  
  145.         'bad guy's shot
  146.         If bgsht(x%) > 0 And bgshosht%(x%) Then
  147.             crashtest bgshtx(x%), bgshty(x%), bgvshx(x%), bgvshy(x%)
  148.             k% = map%(inx%, iny%)
  149.             If k% Then
  150.                 bgshosht%(x%) = 0
  151.                 If k% = 15 And bgsht(x%) > 0 Then
  152.                     map%(inx%, iny%) = 0
  153.                     testin%(4, inx% + 2, iny% + 19) = 0
  154.                 End If
  155.             Else
  156.                 bgshtx(x%) = bgshtx(x%) + bgvshx(x%) * delta.t
  157.                 bgshty(x%) = bgshty(x%) + bgvshy(x%) * delta.t
  158.                 bbx = bgshtx(x%) - bx: bby = bgshty(x%) - by
  159.                 bgshtang% = atan2(bby, bbx) * 5
  160.                 bgshtdis(x%) = Sqr(bby * bby + bbx * bbx + .01)
  161.                 dis(x% + nbguys%) = bgshtdis(x%)
  162.                 'fix damage test
  163.                 If bgshtdis(x%) < .5 Then
  164.                     ph% = ph% - bgsht(x%) / 4 - 2.5 * (1 + robo%(x%)): bgshosht%(x%) = 0
  165.                     If snd% Then Sound 150, 1
  166.                     vx = vx + bgvshx(x%) * .05: vy = vy + bgvshy(x%) * .05
  167.                 End If
  168.                 'kill each other?
  169.                 For y% = 0 To nbguysm1%
  170.                     If x% <> y% And bgh%(y%) > 0 Then
  171.                         bsdis = Sqr((bgshty(x%) - bgy(y%)) ^ 2 + (bgshtx(x%) - bgx(y%)) ^ 2 + .01)
  172.                         If bsdis < .5 Then
  173.                             bgh%(y%) = bgh%(y%) - bgsht(x%) / 2 - 1: bgshosht%(x%) = 0
  174.                             vbx(y%) = vbx(y%) + bgvshx(x%) * .5: vby(y%) = vby(y%) + bgvshy(x%) * .5
  175.                             If bgh%(y%) < 1 Then
  176.                                 fmap%(Int(bgx(y%)), Int(bgy(y%))) = 4 + 4 * robo%(y%)
  177.                                 kills% = kills% + 1: Exit For
  178.                             End If
  179.                         End If
  180.                 End If: Next
  181.                 bgdela%(x%) = (bgshtang% - bsa% + 1800) Mod 1800
  182.                 bgshtht%(x%) = 30 / bgshtdis(x%)
  183.             End If
  184.         End If
  185.         If bgsht(x%) > 0 Then bgsht(x%) = bgsht(x%) - fdt
  186.  
  187.         If fram% / 2 = fram% \ 2 Then
  188.             testin%(4, Int(px) + 2, Int(py) + 19) = 1
  189.             If bgh%(x%) > 0 Then testin%(4, Int(bgx(x%)) + 2, Int(bgy(x%)) + 19) = 4 + 4 * robo%(x%)
  190.         End If
  191.     Next x%
  193.  
  194. Sub crashtest (bx, by, vx, vy): 'note vx & vy args must be byref
  195.     Shared map%(), delta.t, inx%, iny%
  196.     Static oinx%, oiny%, nallcl%, chn2%, xsign%, ysign%, k%, kx%, ky%
  197.  
  198.     oinx% = Int(bx): oiny% = Int(by): nallcl% = 1
  199.     px = bx + vx * delta.t: py = by + vy * delta.t
  200.     inx% = Int(px): iny% = Int(py)
  201.     ysign% = Sgn(vy): xsign% = Sgn(vx)
  202.     chn2% = (inx% - oinx%) * xsign% + (iny% - oiny%) * ysign%
  203.     k% = map%(inx%, iny%)
  204.     If inx% = oinx% Then horz% = 1
  205.     If iny% = oiny% Then vert% = 1
  206.     If chn2% = 2 Then
  207.         ys% = (1 + ysign%) \ 2: xs% = (1 + xsign%) \ 2
  208.         kx% = map%(oinx%, iny%): ky% = map%(inx%, oiny%)
  209.         tstang% = Sgn((px - bx) * (iny% + 1 - ys% - by) - (py - by) * (inx% + 1 - xs% - bx))
  210.         tst% = xsign% * ysign% * tstang%
  211.         If tst% = 1 And k% + ky% = 0 Then nallcl% = 0
  212.         If tst% = -1 And k% + kx% = 0 Then nallcl% = 0
  213.         If ky% = 0 Then
  214.             horz% = 1
  215.         Else
  216.             vert% = 1: k% = ky%: If tst% = 1 Then iny% = oiny%
  217.         End If
  218.         If kx% Then
  219.             horz% = 1: k% = kx%: If tst% = -1 Then inx% = oinx%
  220.         Else
  221.             vert% = 1
  222.         End If
  223.     End If: If k% = 0 Then nallcl% = 0
  224.     If nallcl% Then
  225.         If horz% And vert% And ky% = 0 And kx% = 0 Then
  226.             If tst% = 1 Then horz% = 0 Else vert% = 0
  227.         End If
  228.         If vert% Then vx = 0
  229.         If horz% Then vy = 0
  230.     End If
  232.  
  233. Function lsight% (b%)
  234.     Shared map%(), delta.t, inx%, iny%, px, py, bgx(), bgy()
  235.     delx = bgx(b%) - px: dely = bgy(b%) - py: delmag = Sqr(delx ^ 2 + dely ^ 2)
  236.     lx = px: ly = py: delx = delx / delmag / delta.t: dely = dely / delmag / delta.t: lt% = 0
  237.     Do: crashtest lx, ly, delx, dely: lx = lx + delx * delta.t: ly = ly + dely * delta.t
  238.         lt% = lt% + 1
  239.     Loop Until map%(inx%, iny%) Or lt% >= delmag
  240.     lsight% = (map%(inx%, iny%) = 0)
  242.  
  243. Sub endit
  244.     Shared kills%, nbguysm1%, nbguys%, kbmatrix%(), goon%, ph%, bgh%(), snd%
  245.  
  246.     If kbmatrix%(1) - 1 And ph% > 0 And kills% < nbguys% Then
  247.         goon% = 2
  248.     Else
  249.         goon% = goon% - 1
  250.     End If
  251.     If goon% = 0 Then
  252.         Locate 2, 1:
  253.         If kills% = nbguys% And ph% > 0 Then
  254.             Print "President Snore, you made it!": If snd% Then Play "mf gcfde"
  255.         Else
  256.             Print "You die"
  257.             For t% = 400 To 200 Step -20
  258.                 If snd% Then Sound t%, 1
  259.                 tim = Timer: Do: Loop Until Timer > tim
  260.             Next
  261.         End If
  262.         tim = Timer + .5: Do: Loop Until Timer > tim
  263.         Sleep 1: End
  264.     End If
  266.  
  267. Sub hLINE (x1%, x2%, y%, c%)
  268.     Shared sb1%(), hicol%(): ccc% = hicol%(c%) + c%
  269.     If x1% < 0 Then x1% = 0
  270.     If x2% > 319 Then x2% = 319
  271.     For x% = Int(x1% / 2) To Int(x2% / 2)
  272.         sb1%(x%, y%) = ccc%
  273.     Next
  275.  
  276. Sub intro: Shared snd%, nbguys%, nrobo%
  277.     Cls: Print "By Dr. Jacques Mallah", , "Assassins Edition.64"
  278.     Print: Print "In the year 3001 AD:"
  279.     Print "You, President Sal Snore of the United Snows of Antarctica,"
  280.     Print "are trapped in the Wight House with a bunch of guys trying to kill you. "
  281.     Print "They also reprogrammed your robot bodyguard(s).": Print
  282.     Print "Luckily, you have your trusty plasma gun (press 1) and machine gun (press 2)"
  283.     Print "and plas-cannon (press 3; uses plasma gun ammo)."
  284.     Print "Hiding's not your style.  You'll show them who's the boss!"
  285.     Print "Kill 'em all to win.  ("; nbguys% - nrobo%; " guy(s) and "; nrobo%; " robot(s))": Print
  286.     Print "use arrow forward, back to move; use arrow left, right to rotate"
  287.     Print "Alt to strafe with arrow left, right"
  288.     Print "Ctrl to shoot"
  289.     Print "To fight, try getting some distance and using strafe"
  290.     Print "Try shooting out some ice blocks"
  291.     Print "pick up ";: Color 0, 2: Print "-";: Color 7, 0: Print " ammo, and ";
  292.     Color 4, 15: Print "+";: Color 7, 0: Print " medical kits when needed"
  293.     Print "After starting, press Esc to take the easy way out - suicide!"
  294.     Print "press any key to start, SPACE for no sound": Print
  295.     Print "The # at the top left corner is frames per second"
  296.     Print "The bar at the bottom is your health."
  297.     Print "j to toggle cheat mode";
  298.     i$ = Input$(1): If i$ <> " " Then snd% = 1
  300.  
  301. Sub maketables
  302.     Shared st(), ct(), dsfc(), hicol%(), lowcol%(), bicol%(), atx%(), tant()
  303.     Shared xb%(), yb%(), spord%(), nspr%, stt(), ctt()
  304.     For tmp1% = 0 To 1800
  305.         st(tmp1%) = Sin(tmp1% * Atn(1) / 225): stt(tmp1%) = st(tmp1%) * 256
  306.         ct(tmp1%) = Cos(tmp1% * Atn(1) / 225): ctt(tmp1%) = ct(tmp1%) * 256
  307.     Next tmp1%
  308.     st(0) = 10 ^ -9: st(900) = 10 ^ -9: st(1800) = st(0)
  309.     stt(0) = 10 ^ -7: stt(900) = 10 ^ -7
  310.     ct(450) = 10 ^ -9: ct(1350) = 10 ^ -9
  311.     ctt(450) = 10 ^ -7: ctt(1350) = 10 ^ -7
  312.     For t% = 0 To 1800
  313.         sqct = Abs(1 / ct(t%)): sqt = Abs(1 / st(t%))
  314.         If sqt > sqct Then nn = sqct * 255 Else nn = sqt * 255
  315.         xb%(t%) = ct(t%) * nn: yb%(t%) = st(t%) * nn
  316.     tant(t%) = st(t%) / ct(t%): Next
  317.     yb%(0) = 0: yb%(900) = 0
  318.     xb%(450) = 0: xb%(1350) = 0
  319.     For x% = 0 To 319
  320.         atx%(x%) = Atn((x% - 160) * 3.14159 / 900) * 900 / 3.14159
  321.         dsfc(x%) = 100 / Abs(ct((atx%(x%) + 1800) Mod 1800))
  322.     Next
  323.     For c% = 0 To 255
  324.         hicol%(c%) = &H100 * (c% + &H100 * (c% > &H7F))
  325.         lowcol%(c% - 128) = c% - 128 - &H100 * ((c% - 128) < 0)
  326.         bicol%(c%) = &H100 * (c% + &H100 * (c% > &H7F)) + c%
  327.     Next
  328.     For x% = 0 To nspr%: spord%(x%) = x%: Next
  330.  
  331. Sub readmap
  332.     Shared fmap%(), sizex%, sizey%, testin%(), hicol%(), cmap%(), map%(), ntx%
  333.     Shared ph%, nbguysm1%, bgh%(), bgy(), bgx(), oldtim, nmeds%, medx(), medy()
  334.     Shared nshots%, med%(), ammo%(), weap$, px, py, sa, nmeds%, nammo%, robo%()
  335.     Shared maxshots%, nbguys%, nshots%, nspr%, nbguyst2%, nrobo%
  336.     Shared scmed(), mx(), my(), medis()
  337.     Shared F0%, F1%, F2%, F3%, F4%, F5%, bg$
  338.     DefInt N
  339.     Randomize Timer: nmeds% = 0: nammo% = 0: px = 17.5: py = 27.5: sa = 1190
  340.     Read F0%, F1%, F2%, F3%, F4%, F5%, bg$: nb = 0
  341.  
  342.     For y = 0 To sizey% - 1: Read i$: For x = 0 To sizex% - 1
  343.         ii$ = Mid$(i$, x + 1, 1): map%(x, y) = Asc(ii$) - 48
  344.         If ii$ = "." Then map%(x, y) = 0
  345.             If ii$ = "B" Or ii$ = "R" Then nb = nb + 1: If ii$ = "R" Then nrobo% = nrobo% + 1
  346.             If map%(x, y) = 66 Then map%(x, y) = 16 + (Rnd < .5)
  347.             If map%(x, y) < 0 Then map%(x, y) = map%(x, y) + 256
  348.             If y = 0 Or x = 0 Or y = sizey% - 1 Or x = sizex% - 1 Then
  349.                 If map%(x, y) = 0 Then map%(x, y) = 18
  350.                 If map%(x, y) = 15 Then map%(x, y) = 14
  351.             End If
  352.             If ii$ = "M" Then nmeds% = nmeds% + 1
  353.             If ii$ = "L" Then nammo% = nammo% + 1
  354.             If ii$ = "P" Then px = x + .5: py = y + .5: map%(x, y) = 0
  355.     Next: Next
  356.  
  357.     maxshots% = 9: nbguys% = nb: nbguysm1% = nbguys% - 1: nbguyst2% = nbguys% * 2
  358.     nshots% = maxshots%: nspr% = maxshots% + nbguyst2% + nmeds% + nammo%
  360.  
  361.  
  362. Sub makeworld
  363.     Shared fmap%(), sizex%, sizey%, testin%(), hicol%(), cmap%(), map%(), ntx%
  364.     Shared ph%, nbguysm1%, bgh%(), bgy(), bgx(), oldtim, nmeds%, medx(), medy()
  365.     Shared nshots%, med%(), ammo%(), weap$, px, py, sa, nmeds%, nammo%, robo%()
  366.     Shared maxshots%, nbguys%, nshots%, nspr%, snd%
  367.     Shared scmed(), mx(), my(), medis()
  368.     Shared F0%, F1%, F2%, F3%, F4%, F5%, bg$
  369.     DefInt N, T, X-Y
  370.     Screen 13: nb = 0: nm = 0: nam = nmeds%: If snd% Then Play "mb"
  371.     nshots% = 1: weap$ = " plasma gun": ammo%(0) = 24: ammo%(1) = 200
  372.  
  373.     For y = 1 To sizey% - 2: For x = 1 To sizex% - 2
  374.  
  375.         If map%(x, y) = 18 Then map%(x, y) = 0: bgx(nb) = x + .5: bgy(nb) = y + .5: nb = nb + 1
  376.             If map%(x, y) = 34 Then
  377.                 map%(x, y) = 0: bgx(nb) = x + .5: bgy(nb) = y + .5: robo%(nb) = 1: nb = nb + 1
  378.             End If
  379.             If map%(x, y) = Asc("M") - 48 Then
  380.                 medx(nm) = x + .5: medy(nm) = y + .5: map%(x, y) = 0: med%(nm) = 1: nm = nm + 1 'meds
  381.             End If
  382.             If map%(x, y) = Asc("L") - 48 Then
  383.                 medx(nam) = x + .5: medy(nam) = y + .5: map%(x, y) = 0: med%(nam) = 1: nam = nam + 1 'ammo
  384.             End If
  385.  
  386.     Next: Next
  387.  
  388.     For t = 0 To ntx%: For x = 0 To 63: For y = 0 To 63
  389.         testin%(t, x, y) = (t * 14 + Sqr((x - 32) ^ 2 + (y - 32 - Rnd * t) ^ 2)) Mod 256
  390.         testin%(t, x, y) = testin%(t, x, y) + hicol%(t + 1 + (Rnd < .1))
  391.     Next: Next: Next
  392.  
  393.     For x = 2 To 61: For y = 19 To 48
  394.     testin%(4, x, y) = map%(x - 2, y - 19): Next: Next
  395.     For x = 0 To 59: For y = 0 To 29: fmap%(x, y) = ((x + y) Mod 16) + 128
  396.         If map%(x, y) = 15 Then fmap%(x, y) = 15
  397.             Next: Next: For x = 16 To 18: For y = 26 To 28
  398.     fmap%(x, y) = 208: Next: Next
  399.     fmap%(39, 15) = -7: fmap%(24, 10) = -2: fmap%(17, 25) = 0
  400.     For x = 20 To 35: fmap%(x, 25) = 20 - x: Next
  401.  
  402.     For x = 0 To 59: For y = 0 To 29: cmap%(x, y) = 26
  403.         If x / 2 = x \ 2 Or y / 2 = y \ 2 Then cmap%(x, y) = 27
  404.             If x / 2 = x \ 2 And y / 2 = y \ 2 Then cmap%(x, y) = 15
  405.             Next: Next: For x = 16 To 18: For y = 26 To 28
  406.     cmap%(x, y) = 208: Next: Next: cmap%(17, 27) = 15
  407.  
  408.     Color 16: Print "Abandon": Print "all dope"
  409.     Print "Your ad": Print "  here:": Print " $100": Print " Call"
  410.     Print " 1-800-": Print " EATS": Print "  ???": Print " QB 64"
  411.     Print " I  $": Print: Print " Wight": Print " House": Print " HIT"
  412.     Print: Print " Who's": Print "da man?": Print " Please": Print "recycle"
  413.     Print "   JM": For x = 0 To 63: For y = 0 To 15
  414.         If Point(x, y) Then testin%(1, x, y + 1) = 15
  415.             If Point(x, y + 16) Then testin%(5, x, y + 8) = 0
  416.             If Point(x, y + 32) Then testin%(5, x, y + 24) = 0
  417.             If Point(x, y + 48) Then testin%(5, x, y + 40) = 0
  418.             If Point(x, y + 64) Then testin%(6, x, y + 32) = 7
  419.             If Point(x, y + 80) Then testin%(2, x, y + 1) = 4
  420.             If Point(x, y + 96) Then testin%(4, x, y + 1) = 15
  421.             If Point(x, y + 112) And y < 8 Then testin%(5, x, y + 56) = 0
  422.             If Point(x, y + 128) Then testin%(3, x, y + 48) = 1
  423.             If Point(x, y + 144) Then testin%(0, x, y + 48) = 6
  424.             If Point(x, y + 160) Then testin%(7, x, y + 32) = 9
  425.     Next: Next: Color 15
  426.     For x = 0 To 63: For y = 0 To 63
  427.         t = 15: If (Rnd * 60 > y) Then t = 24 + Rnd * 6
  428.             testin%(7, x, y) = (testin%(7, x, y) And &HFF) + hicol%(t)
  429.     Next: Next
  430.  
  431.     ph% = 100: For x% = 0 To nbguysm1%: bgh%(x%) = 100: If robo%(x%) Then bgh%(x%) = 1250
  432.         If bgx(x%) = 0 Then
  433.             randloc:
  434.             bgx(x%) = Int(Rnd * (sizex% - 1) + 1) + .5
  435.             bgy(x%) = Int(Rnd * (sizey% - 1) + 1) + .5
  436.             If map%(Int(bgx(x%)), Int(bgy(x%))) GoTo randloc
  437.         End If
  438.     Next: oldtim = Timer
  439.  
  441.  
  442. DefSng T, X-Y
  443. Sub medkit.etc: 'medkits and ammo boxes
  444.     Shared nmeds%, medis(), nbguyst2%, maxshots%, medx(), medy(), scmed(), dis()
  445.     Shared mx(), my(), ph%, bx, by, bgx(), bgy(), bgh%(), med%(), nbguysm1%, bsa%
  446.     Shared ammo%(), nammo%, robo%()
  447.  
  448.     For x% = 0 To nmeds% + nammo% - 1
  449.         If med%(x%) Then
  450.             medis(x%) = Sqr((bx - medx(x%)) ^ 2 + (by - medy(x%)) ^ 2)
  451.             dis(x% + nbguyst2% + maxshots% + 1) = medis(x%)
  452.             scmed(x%) = 3 / (dis(x% + nbguyst2% + maxshots% + 1) + .01)
  453.             bgang% = atan2(medy(x%) - by, medx(x%) - bx) * 5
  454.             delba% = (bgang% - bsa% + 1800) Mod 1800
  455.             mx(x%) = delba% - scmed(x%) * 10: my(x%) = 100 + 15 * scmed(x%)
  456.             If medis(x%) < .36 Then
  457.                 If x% < nmeds% And ph% < 95 Then
  458.                     med%(x%) = 0: ph% = ph% + 35: If ph% > 98 Then ph% = 98
  459.                 End If
  460.                 If x% >= nmeds% Then
  461.                     med%(x%) = 0: ammo%(0) = ammo%(0) + 16: ammo%(1) = ammo%(1) + 100
  462.                 End If
  463.             End If
  464.             For y% = 0 To nbguysm1%
  465.                 If bgh%(y%) > 0 And robo%(y%) = 0 Then
  466.                     bsdis = (bgx(y%) - medx(x%)) * (bgx(y%) - medx(x%)) + (bgy(y%) - medy(x%)) * (bgy(y%) - medy(x%))
  467.                     If med%(x%) And bsdis < .6 And bgh%(y%) < 95 And y% <> 8 And x% < nmeds% Then
  468.                         med%(x%) = 0: bgh%(y%) = bgh%(y%) + 35: If bgh%(y%) > 98 Then bgh%(y%) = 98
  469.                     End If
  470.             End If: Next
  471.     End If: Next
  472.  
  474.  
  475. Sub onscreen
  476.     Shared bitex%, fire, sb1%(), mg%, omg%, weap$, ammo%(), oammo%(), sb2%()
  477.     Shared kills%, okills%, oofram%, ofram%
  478.  
  479.     bitex% = 1: t% = (fire > 0) * 15: hLINE 155, 166, 100, -t%
  480.     vline 160, 96, 104, 15 + t%: bitex% = 0
  481.  
  482.     'draw on screen
  483.     Wait &H3DA, 8: 'wait for screen refresh
  484.  
  485.     For x% = 0 To 159: For y% = 8 To 199
  486.         sb2%(2 + x% + 160 * (y% - 8)) = sb1%(x%, y%)
  487.     Next: Next
  488.     Put (0, 8), sb2%(), PSet
  489.  
  490.  
  491.     If mg% <> omg% Or kills% > okills% Or ammo%(mg% And 1) <> oammo%(mg% And 1) Then
  492.         Locate 1, 10: Print weap$;
  493.         Print Using " ####"; ammo%(mg% And 1);
  494.         Print Using " ammo ### "; kills%;: Print "kill";
  495.         If kills% <> 1 Then Print "s"; Else Print " ";
  496.         omg% = mg%: okills% = kills%: oammo%(mg% And 1) = ammo%(mg% And 1)
  497.     End If
  498.     If oofram% <> ofram% Then
  499.         Locate 1, 1: Print Using "### fps"; ofram%;: oofram% = ofram%
  500.     End If
  501.  
  503.  
  504. Sub paintsprites
  505.     Shared nspr%, spord%(), dis(), nbguyst2%, nbguys%, maxshots%, disi%()
  506.  
  507.     'This uses the painter's algorithm with an exchange sort to show sprites
  508.     For x% = 0 To nspr%: disi%(spord%(x%)) = dis(spord%(x%)) * 512: Next
  509.     For x% = 0 To nspr% - 1: For y% = x% + 1 To nspr%
  510.         If disi%(spord%(y%)) > disi%(spord%(x%)) Then Swap spord%(x%), spord%(y%)
  511.         Next: Next: For xx% = 0 To nspr%
  512.         If spord%(xx%) < nbguys% Then
  513.             showbadguy spord%(xx%)
  514.         ElseIf spord%(xx%) < nbguyst2% Then
  515.             showbadshot spord%(xx%) - nbguys%
  516.         ElseIf spord%(xx%) < nbguyst2% + maxshots% + 1 Then
  517.             showurshot spord%(xx%) - nbguyst2%
  518.         Else
  519.             showmed spord%(xx%) - nbguyst2% - maxshots% - 1
  520.     End If: Next xx%
  521.  
  523.  
  524. Sub putbox (x1, y1%, x2, y2%, col%, boxdis)
  525.     Shared wdis()
  526.     For x% = x1 To x2
  527.         If x% >= 0 And x% < 320 Then
  528.             If boxdis < wdis(x%) Then vline x%, y1%, y2%, col%
  529.         End If
  530.     Next
  532.  
  533. Sub putcircle (x%, y%, R%, col%, circdis)
  534.     Shared wdis()
  535.     xb% = x% - R% + 1: xt% = x% + R% - 1
  536.     If xb% > -1 And xb% < 320 Then
  537.         If circdis < wdis(xb%) Then showc% = 1
  538.     End If
  539.     If xt% > -1 And xt% < 320 Then
  540.         If circdis < wdis(xt%) Then showc% = showc% + 1
  541.     End If
  542.     If showc% = 1 Then
  543.         For xx% = xb% To xt%
  544.             If xx% > -1 And xx% < 320 Then
  545.                 If circdis < wdis(xx%) Then
  546.                     shthtx% = R% * Sqr(1 - (xx% - x%) * (xx% - x%) / R% / R%) * .8
  547.                     vline xx%, y% - shthtx%, y% + shthtx%, col%
  548.                 End If
  549.             End If
  550.         Next
  551.     ElseIf showc% = 2 Then
  552.         For xx% = xb% To xt%
  553.             shthtx% = R% * Sqr(1 - (xx% - x%) * (xx% - x%) / R% / R%) * .8
  554.             vline xx%, y% - shthtx%, y% + shthtx%, col%
  555.         Next
  556.     End If
  558.  
  559. Sub raycast
  560.     Shared wdis(), odd%(), st(), ct(), dsfc(), atx%(), hicol%(), testin%()
  561.     Shared map%(), fmap%(), cmap%(), bicol%(), sb1%(), ntx%, gm%, xb%(), yb%()
  562.     Shared sizex%, sizey%, lowcol%(), bx, by, efa%, px, py, bsa%, sa, stt(), ctt()
  563.     bx = px: by = py: efa% = (sa + 1960) Mod 1800: bsa% = sa
  564.     bxx% = bx * 256: byy% = by * 256: TIMR = Timer * 10: nttx% = 2 * ntx% + 1
  565.     sizexf% = sizex% * 256: sizeyf% = sizey% * 256
  566.  
  567.     For x% = 0 To 319
  568.         t% = (efa% + atx%(x%) + 1800) Mod 1800: xx% = x% \ 2
  569.  
  570.         If xx% = x% \ 2 Then
  571.             rxx% = bxx%: ryy% = byy%: oinx% = rxx% \ 256: oiny% = ryy% \ 256
  572.             inx% = oinx%: iny% = oiny%: ysign% = Sgn(yb%(t%)): xsign% = Sgn(xb%(t%))
  573.             ys% = (1 - ysign%) \ 2: xs% = (1 - xsign%) \ 2
  574.             yss& = ys% * 256 - byy%: xss& = xs% * 256 - bxx%
  575.  
  576.             'find dis & col
  577.             oldi: Do: rxx% = rxx% + xb%(t%): ryy% = ryy% + yb%(t%)
  578.                 oinx% = inx%: oiny% = iny%
  579.                 inx% = rxx% \ &H100: iny% = ryy% \ &H100
  580.                 k% = map%(inx%, iny%)
  581.                 chn2% = (inx% - oinx%) * xsign% + (iny% - oiny%) * ysign%
  582.             Loop Until chn2% = 2 Or k%
  583.             If chn2% = 2 Then
  584.                 kx% = map%(oinx%, iny%)
  585.                 ky% = map%(inx%, oiny%)
  586.                 If k% + kx% + ky% = 0 GoTo oldi
  587.                 tst% = xsign% * ysign% * Sgn((rxx% - bxx%) * (iny% * 256 + yss&) - (ryy% - byy%) * (inx% * 256 + xss&))
  588.                 If (tst% = 1 And k% + ky% = 0) Or (tst% <= 0 And k% + kx% = 0) GoTo oldi
  589.             End If
  590.             horz% = 0: If inx% = (rxx% - xb%(t%)) \ &H100 Then horz% = chn2% And 1
  591.  
  592.             If chn2% = 2 Then
  593.                 If tst% > 0 Then
  594.                     If ky% Then k% = ky%: iny% = oiny% Else horz% = 1
  595.                 Else
  596.                     If kx% Then horz% = 1: k% = kx%: inx% = oinx%
  597.                 End If
  598.             End If
  599.         End If
  600.  
  601.         If horz% Then
  602.             wdis(x%) = (iny% * 256 + yss&) / stt(t%)
  603.             If t% > 1780 Or t% < 20 Or (t% > 880 And t% < 920) Then
  604.                 dis = (inx% * 256 + xss&) / ctt(t%): If dis > wdis(x%) Then wdis(x%) = dis
  605.             End If
  606.             xfrac = bx + wdis(x%) * ct(t%)
  607.             bcc% = Int((xfrac - Int(xfrac)) * 63.9): If ys% = 0 Then bcc% = 63 - bcc%
  608.         Else
  609.             wdis(x%) = (inx% * 256 + xss&) / ctt(t%)
  610.             If (t% > 1330 And t% < 1370) Or (t% > 430 And t% < 470) Then
  611.                 dis = (iny% * 256 + yss&) / stt(t%): If dis > wdis(x%) Then wdis(x%) = dis
  612.             End If
  613.             xfrac = by + wdis(x%) * st(t%)
  614.             bcc% = Int((xfrac - Int(xfrac)) * 63.9): If xs% Then bcc% = 63 - bcc%
  615.         End If
  616.  
  617.         dd% = dsfc(x%) / wdis(x%): odd%(x%) = dd%
  618.  
  619.         'load view to buffer
  620.         If x% And 1 Then
  621.             afx% = ctt(t%) * dsfc(x%): afy% = stt(t%) * dsfc(x%): yt% = dd% + 1
  622.             fixfloor:
  623.             If yt% < 92 Then
  624.                 fcxp% = (bxx% + afx% \ yt%): fcyp% = (byy% + afy% \ yt%)
  625.                 If fcxp% <= 0 Or fcyp% <= 0 Or fcxp% >= sizexf% Or fcyp% >= sizeyf% Then
  626.                     sb1%(xx%, yt% + 99) = 0: sb1%(xx%, 100 - yt%) = 0: yt% = yt% + 1: GoTo fixfloor
  627.                 End If
  628.             End If
  629.             For y% = yt% To 92
  630.                 fcxp% = (bxx% + afx% \ y%): fcx% = fcxp% \ &H100
  631.                 fcyp% = (byy% + afy% \ y%): fcy% = fcyp% \ &H100
  632.                 flor% = fmap%(fcx%, fcy%)
  633.                 If flor% > 0 Then
  634.                     sb1%(xx%, y% + 99) = bicol%(flor%)
  635.                 ElseIf flor% >= -ntx% Then
  636.                     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)
  637.                 Else
  638.                     flor% = -flor% - ntx% - 1
  639.                     fcxp% = (fcxp% \ 4) And &H3F: fcyp% = (fcyp% \ 4) And &H3F
  640.                     tst% = (testin%(flor%, fcxp%, fcyp%) And &HFF00)
  641.                     sb1%(xx%, y% + 99) = lowcol%((testin%(flor%, fcxp%, fcyp%) And &HFF00) \ 256) + tst%
  642.                 End If
  643.                 sb1%(xx%, 100 - y%) = bicol%(cmap%(fcx%, fcy%))
  644.             Next
  645.         End If
  646.         If k% = nttx% + 1 Then k% = 0
  647.         If k% > nttx% Then
  648.             kx% = k%: If k% = 17 Then kx% = Int(TIMR + xfrac * 40) And &HFF
  649.             yb% = 99 + dd%: If yb% > 191 Then yb% = 191
  650.             yt% = 100 - dd%: If yt% < 8 Then yt% = 8
  651.             If x% And 1 Then
  652.                 For y% = yt% To yb%: sb1%(xx%, y%) = (sb1%(xx%, y%) And &HFF) + hicol%(kx%): Next
  653.             Else
  654.                 For y% = yt% To yb%: sb1%(xx%, y%) = (sb1%(xx%, y%) And &HFF00) + kx%: Next
  655.             End If
  656.         ElseIf x% And 1 Then
  657.             If dd% > 31 Then
  658.                 hmd% = 100 - dd%: df% = (dd% + 4) \ 32: dof& = dd%: kx% = k% - ntx% - 1
  659.                 For yfrac% = 0 To 63: yt% = hmd% + (yfrac% * dof&) \ &H20: yb% = yt% + df%
  660.                     If yt% < 8 Then yt% = 8
  661.                     If yb% > &HBF Then yb% = &HBF
  662.                     If k% <= ntx% Then
  663.                         tst% = hicol%(testin%(k%, bcc%, yfrac%) And &HFF) + (testin%(k%, obcc%, yfrac%) And &HFF)
  664.                     Else
  665.                         tst% = (testin%(kx%, bcc%, yfrac%) And &HFF00) + lowcol%((testin%(kx%, obcc%, yfrac%) And &HFF00) \ 256)
  666.                     End If
  667.                 For y% = yt% To yb%: sb1%(xx%, y%) = tst%: Next: Next
  668.             Else
  669.                 yb% = 2 * dd% - 1: hmd% = 100 - dd%
  670.                 If k% <= ntx% Then
  671.                     For y% = hmd% To 99 + dd%: yfrac% = ((y% - hmd%) * 63) \ yb%
  672.                         sb1%(xx%, y%) = hicol%(testin%(k%, bcc%, yfrac%) And &HFF) + (testin%(k%, obcc%, yfrac%) And &HFF)
  673.                     Next
  674.                 Else
  675.                     kx% = k% - ntx% - 1
  676.                     For y% = hmd% To 99 + dd%: yfrac% = ((y% - hmd%) * 63) \ yb%
  677.                         sb1%(xx%, y%) = (testin%(kx%, bcc%, yfrac%) And &HFF00) + lowcol%((testin%(kx%, obcc%, yfrac%) And &HFF00) \ 256)
  678.                     Next
  679.                 End If
  680.             End If
  681.         End If
  682.     obcc% = bcc%: Next
  684.  
  685. Sub showbadguy (b%)
  686.     Shared bgh%(), scbg(), x(), y(), dis(), F0%, F1%, F2%, F3%, F4%, F5%, wdis(), robo%(), active%()
  687.     If bgh%(b%) > 0 Then
  688.  
  689.         If x(b%) >= 0 And x(b%) <= 319 Then
  690.             If dis(b%) < wdis(x(b%)) Then showb% = 1: 'active%(b%) = 1
  691.         End If
  692.         xt% = x(b%) + scbg(b%) * 40
  693.         If xt% >= 0 And xt% < 320 Then
  694.             If dis(b%) < wdis(xt%) Then showb% = 1: 'active%(b%) = 1
  695.         End If
  696.         If showb% Then
  697.             If robo%(b%) Then F1% = 7
  698.             putbox x(b%) + scbg(b%) * 16, y(b%) + 0, x(b%) + scbg(b%) * 24, y(b%) + scbg(b%) * 2, F0%, dis(b%)
  699.             putbox x(b%) + scbg(b%) * 15, y(b%) + scbg(b%) * 2, x(b%) + scbg(b%) * 25, y(b%) + scbg(b%) * 10, F1%, dis(b%)
  700.             putbox x(b%) + scbg(b%) * 10, y(b%) + scbg(b%) * 10, x(b%) + scbg(b%) * 30, y(b%) + scbg(b%) * 40, b%, dis(b%)
  701.             putbox x(b%), y(b%) + scbg(b%) * 11, x(b%) + scbg(b%) * 10, y(b%) + scbg(b%) * 20, b%, dis(b%)
  702.             putbox x(b%) + scbg(b%) * 30, y(b%) + scbg(b%) * 11, x(b%) + scbg(b%) * 40, y(b%) + scbg(b%) * 20, b%, dis(b%)
  703.             putbox x(b%), y(b%) + scbg(b%) * 20, x(b%) + scbg(b%) * 5, y(b%) + scbg(b%) * 40, b%, dis(b%)
  704.             putbox x(b%) + scbg(b%) * 35, y(b%) + scbg(b%) * 20, x(b%) + scbg(b%) * 40, y(b%) + scbg(b%) * 40, b%, dis(b%)
  705.             putbox x(b%) + scbg(b%) * 10, y(b%) + scbg(b%) * 40, x(b%) + scbg(b%) * 18, y(b%) + scbg(b%) * 70, F3%, dis(b%)
  706.             putbox x(b%) + scbg(b%) * 22, y(b%) + scbg(b%) * 40, x(b%) + scbg(b%) * 30, y(b%) + scbg(b%) * 70, F3%, dis(b%)
  707.             putbox x(b%) + scbg(b%) * 18, y(b%) + scbg(b%) * 40, x(b%) + scbg(b%) * 22, y(b%) + scbg(b%) * 50, F3%, dis(b%)
  708.             putbox x(b%) + scbg(b%) * 7, y(b%) + scbg(b%) * 70, x(b%) + scbg(b%) * 18, y(b%) + scbg(b%) * 75, F4%, dis(b%)
  709.             putbox x(b%) + scbg(b%) * 22, y(b%) + scbg(b%) * 70, x(b%) + scbg(b%) * 33, y(b%) + scbg(b%) * 75, F4%, dis(b%)
  710.             putbox x(b%) + scbg(b%) * 5, y(b%) + scbg(b%) * 35, x(b%) + scbg(b%) * 15, y(b%) + scbg(b%) * 40, F1%, dis(b%)
  711.             putbox x(b%) + scbg(b%) * 25, y(b%) + scbg(b%) * 35, x(b%) + scbg(b%) * 35, y(b%) + scbg(b%) * 40, F1%, dis(b%)
  712.             putbox x(b%) + scbg(b%) * 15, y(b%) + scbg(b%) * 25, x(b%) + scbg(b%) * 25, y(b%) + scbg(b%) * 35, F5%, dis(b%)
  713.             putbox x(b%) + scbg(b%) * 16, y(b%) + scbg(b%) * 3, x(b%) + scbg(b%) * 18, y(b%) + scbg(b%) * 4, 0, dis(b%)
  714.             putbox x(b%) + scbg(b%) * 22, y(b%) + scbg(b%) * 3, x(b%) + scbg(b%) * 24, y(b%) + scbg(b%) * 4, 0, dis(b%)
  715.             putbox x(b%) + scbg(b%) * 16, y(b%) + scbg(b%) * 4, x(b%) + scbg(b%) * 18, y(b%) + scbg(b%) * 4, 7, dis(b%)
  716.             putbox x(b%) + scbg(b%) * 22, y(b%) + scbg(b%) * 4, x(b%) + scbg(b%) * 24, y(b%) + scbg(b%) * 4, 7, dis(b%)
  717.             putbox x(b%) + scbg(b%) * 17, y(b%) + scbg(b%) * 4, x(b%) + scbg(b%) * 17, y(b%) + scbg(b%) * 4, 0, dis(b%)
  718.             putbox x(b%) + scbg(b%) * 23, y(b%) + scbg(b%) * 4, x(b%) + scbg(b%) * 23, y(b%) + scbg(b%) * 4, 0, dis(b%)
  719.             putbox x(b%) + scbg(b%) * 20, y(b%) + scbg(b%) * 5, x(b%) + scbg(b%) * 20, y(b%) + scbg(b%) * 6, 114, dis(b%)
  720.             putbox x(b%) + scbg(b%) * 18, y(b%) + scbg(b%) * 8, x(b%) + scbg(b%) * 22, y(b%) + scbg(b%) * 8, 4, dis(b%)
  721.             F1% = 6
  722.         End If
  723.     End If
  725.  
  726. Sub showbadshot (x%)
  727.     Shared bgsht(), bgshosht%(), bgdela%(), bgshtht%(), bgshtdis(), robo%()
  728.     If bgsht(x%) > 0 And bgshosht%(x%) Then
  729.         putcircle bgdela%(x%), 100, bgshtht%(x%), 4 + robo%(x%), bgshtdis(x%)
  730.     End If
  732.  
  733. Sub showhealth
  734.     Shared gm%, ogm%, ph%, oph%
  735.     If gm% Then ph% = 100
  736.     If ph% - oph% Or gm% - ogm% Then
  737.         For y% = 194 To 199
  738.             hLINE 0, 319 * ph% / 100, y%, 1 + 14 * gm%
  739.             hLINE 319 * ph% / 100 + 1, 319, y%, 4
  740.         Next: ogm% = gm%: oph% = ph%
  741.     End If
  743.  
  744. Sub showmed (b%)
  745.     Shared med%(), scmed(), mx(), my(), medis(), nmeds%
  746.     '    Print b%, nmeds%
  747.     If med%(b%) Then
  748.         c% = (b% < nmeds%)
  749.         putbox mx(b%) + 0, my(b%) + 0, mx(b%) + scmed(b%) * 20, my(b%) + scmed(b%) * 20, 2 - 13 * c%, medis(b%)
  750.         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%)
  751.         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%)
  752.     End If
  754.  
  755. Sub showurshot (x%)
  756.     Shared mg%, fb%, sht(), shosht%(), dela%(), shtdis(), shtht%(), plasma%()
  757.     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%)
  758.     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%)
  760.  
  761. Sub time
  762.     Shared ofram%, delta.t, fdt, kbmatrix%(), gm%, fram%
  763.     Static oldtimer&, oldtim, afram%, godit
  764.  
  765.     fram% = fram% + 1
  766.     If Int(Timer) - oldtimer& Then
  767.         ofram% = fram%: fram% = 0: oldtimer& = Int(Timer)
  768.     End If
  769.  
  770.     afram% = afram% + 1
  771.     If oldtim <> Timer Then
  772.         delta.t = delta.t * .8 + (Timer - oldtim) * .2 / afram%
  773.         oldtim = Timer: afram% = 0
  774.         If delta.t > .1 Or delta.t < 0 Then delta.t = .1
  775.         fdt = 14 * delta.t
  776.     End If
  777.  
  778.     If kbmatrix%(36) And Timer > godit Then
  779.         If gm% Then gm% = 0 Else gm% = 1: 'cheat mode
  780.         godit = (Timer + 1) Mod 86400
  781.     End If
  782.  
  784.  
  785. Sub vline (x%, yt%, yb%, c%)
  786.     Static y%, xx%
  787.     Shared sb1%(), hicol%(), odd%(), bicol%(), bitex%: xx% = x% \ 2
  788.     If yt% < 8 Then yt% = 8
  789.     If yb% > 191 Then yb% = 191
  790.     If bitex% Then
  791.         For y% = yt% To yb%: sb1%(xx%, y%) = bicol%(c%): Next
  792.     ElseIf x% And 1 Then
  793.         For y% = yt% To yb%
  794.         sb1%(xx%, y%) = (sb1%(xx%, y%) And &HFF) + hicol%(c%): Next
  795.     Else
  796.         For y% = yt% To yb%: sb1%(xx%, y%) = (sb1%(xx%, y%) And &HFF00) + c%: Next
  797.     End If
  799.  
  800. Sub yourmove
  801.     Shared kbmatrix%(), ct(), st(), efa%, shift, delta.t, fdt
  802.     Shared px, py, sa, va, vx, vy, testin%(), bx, by
  803.     If kbmatrix%(56) Then
  804.         If kbmatrix%(77) Then
  805.             vx = vx + ct((efa% + 450) Mod 1800) * shift * delta.t
  806.             vy = vy + st((efa% + 450) Mod 1800) * shift * delta.t
  807.         End If
  808.         If kbmatrix%(75) Then
  809.             vx = vx + ct((efa% + 1350) Mod 1800) * shift * delta.t
  810.             vy = vy + st((efa% + 1350) Mod 1800) * shift * delta.t
  811.         End If
  812.     Else
  813.         If kbmatrix%(77) Then va = va + shift * 90 * delta.t
  814.         If kbmatrix%(75) Then va = va - shift * 90 * delta.t
  815.     End If
  816.     If kbmatrix%(72) Then
  817.         vx = vx + ct(efa%) * shift * delta.t
  818.         vy = vy + st(efa%) * shift * delta.t
  819.     End If
  820.     If kbmatrix%(80) Then
  821.         vx = vx - ct(efa%) * shift * delta.t
  822.         vy = vy - st(efa%) * shift * delta.t
  823.     End If
  824.     svx% = Sgn(vx): svy% = Sgn(vy)
  825.     crashtest px + .15 * svx%, py + .15 * svy%, vx, vy
  826.     crashtest px - .15 * svx%, py + .15 * svy%, vx, vy
  827.     crashtest px + .15 * svx%, py - .15 * svy%, vx, vy
  828.     px = px + vx * delta.t: py = py + vy * delta.t
  829.     sa = (sa + va * delta.t) Mod 1800
  830.     damp = 2 ^ -fdt
  831.     vx = vx * damp: vy = vy * damp: va = va * damp
  832.     testin%(4, Int(bx) + 2, Int(by) + 19) = 0
  834.  
  835. Sub yourshot
  836.     Shared kbmatrix%(), nshots%, weap$, sht(), ammo%(), shosht%(), bx, by, mg%
  837.     Shared fdt, delta.t, snd%, fb%, ct(), st(), vshx(), vshy(), maxshots%
  838.     Shared sizex%, sizey%, shtx(), shty(), map%(), inx%, iny%, testin%()
  839.     Shared shtang%(), shtdis(), dis(), dela%(), shtht%(), fmap%(), efa%, sa, plasma%()
  840.     Shared nbguys%, nbguysm1%, bgh%(), bgx(), bgy(), vbx(), vby(), fire, kills%, robo%()
  841.     Static kk%
  842.  
  843.     If fire > 0 Then fire = fire - fdt * nshots%
  844.  
  845.     If kbmatrix%(2) Then mg% = 0: kk% = 0: nshots% = 1: weap$ = " plasma gun"
  846.     If kbmatrix%(3) Then mg% = 1: nshots% = 10: weap$ = "machine gun"
  847.     If kbmatrix%(4) Then mg% = 2: nshots% = 10: weap$ = "plas-cannon"
  848.  
  849.     If kbmatrix%(29) And fire <= 0 And sht(kk%) <= 0 And ammo%(mg% And 1) > 0 Then
  850.         sht(kk%) = 20: shosht%(kk%) = 1: ammo%(mg% And 1) = ammo%(mg% And 1) - 1: 'create shot
  851.         shtx(kk%) = bx: shty(kk%) = by: fire = 18: If snd% Then Sound 200, 1
  852.         vshx(kk%) = ct(efa%) * 10: vshy(kk%) = st(efa%) * 10
  853.         plasma%(kk%) = 1 - (mg% And 1)
  854.         kk% = kk% + 1: If kk% = nshots% Then kk% = 0
  855.     End If
  856.  
  857.     For x% = 0 To maxshots%
  858.         If shtx(x%) < 1 Or shtx(x%) > sizex% - 1 Or shty(x%) < 0 Or shty(x%) > sizey% - 1 Then shosht%(x%) = 0
  859.         If sht(x%) > 0 Then sht(x%) = sht(x%) - fdt
  860.         If sht(x%) > 0 And shosht%(x%) Then
  861.             crashtest shtx(x%), shty(x%), vshx(x%), vshy(x%)
  862.             k% = map%(inx%, iny%)
  863.             If k% Then shosht%(x%) = 0
  864.             shtx(x%) = shtx(x%) + vshx(x%) * delta.t: shty(x%) = shty(x%) + vshy(x%) * delta.t
  865.             If k% = 15 And sht(x%) > 0 Then
  866.                 map%(inx%, iny%) = 0
  867.                 testin%(4, inx% + 2, iny% + 19) = 0
  868.             End If
  869.  
  870.             shtang%(x%) = atan2(shty(x%) - by, shtx(x%) - bx) * 5
  871.             shtdis(x%) = Sqr((shty(x%) - by) ^ 2 + (shtx(x%) - bx) ^ 2 + .01)
  872.             dis(x% + nbguys% * 2) = shtdis(x%)
  873.             dela%(x%) = (shtang%(x%) - sa + 1800) Mod 1800
  874.             shtht%(x%) = 30 / shtdis(x%)
  875.  
  876.             'damage test
  877.             For y% = 0 To nbguysm1%
  878.                 bsdis = (shty(x%) - bgy(y%)) * (shty(x%) - bgy(y%)) + (shtx(x%) - bgx(y%)) * (shtx(x%) - bgx(y%))
  879.                 If bsdis < .36 And bgh%(y%) > 0 Then
  880.                     If bsdis < .16 Then bgh%(y%) = bgh%(y%) - sht(x%) / 2 - 5: shosht%(x%) = 0
  881.                     'vbx(y%) = vbx(y%) + vshx(x%) * .1: vby(y%) = vby(y%) + vshy(x%) * .1
  882.                     If plasma%(x%) Then
  883.                         bgh%(y%) = bgh%(y%) - sht(x%) * 1.5 - 50: shosht%(x%) = 0
  884.                         'vbx(y%) = vbx(y%) + vshx(x%) * .5: vby(y%) = vby(y%) + vshy(x%) * .5
  885.                     End If
  886.                     If bgh%(y%) < 1 Then
  887.                         fmap%(Int(bgx(y%)), Int(bgy(y%))) = 4 + 4 * robo%(y%): kills% = kills% + 1
  888.                         If snd% Then Sound 180, 5
  889.                     End If
  890.             End If: Next
  891.     End If: Next
  892.     'If sht(0) < 0 Then fb% = 0
  893.  
  895.  
  896. Sub keys
  897.     Shared kbmatrix%()
  898.     i% = Inp(96): i$ = InKey$: kbmatrix%(i% And 127) = -(i% < 128)
  900.  
Pages: 1 ... 3 4 [5] 6 7 ... 10