+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: QBJS, BAM, and Other BASICs (https://qb64phoenix.com/forum/forumdisplay.php?fid=50)
+--- Thread: SaucerZap (/showthread.php?tid=3312)
SaucerZap - James D Jarvis - 12-23-2024
SaucerZap. A very simple mod of a QBJS example. move your saucer with WASD, point and click with mouse to shoot.
[qbjs]'Option _Explicit
'_Title "Saucer Zap" ' for QBJS by James D. Jarvis
' A mod of Plasma Laser Canon demo prep for GUI 2020-11-11
Screen _NewImage(1200, 600, 32)
Randomize Timer
Dim Shared As Long ShipLights
Dim Shared As _Unsigned Long ShipColor
Dim As Long cx, cy, mx, my, mb, sx, sy, ix, iy
Dim As Single ma, md, dx, dy, damage
Dim targetx(10), targety(10), targetvx(10), targetvy(10), targetalive(10)
Dim targetcolor(10) As _Unsigned Long
Dim ik$
cy = _Height / 2: cx = _Width / 2
ShipColor = &HFF3366AA
' _MouseHide '??? not supported and bad idea anyway
sx = cx
sy = cy
For x = 1 To 10
Do
targetx(x) = Int(Rnd * _Width)
targety(x) = Int(Rnd * _Height)
targetvx(x) = Int(Rnd * 2) - Int(Rnd * 2)
targetvy(x) = Int(Rnd * 2) - Int(Rnd * 2)
targetcolor(x) = _RGB32(Int(100 + Rnd * 150), Int(100 + Rnd * 150), Int(100 + Rnd * 150))
targetalive(x) = 10
Loop Until Int(targetx(x) / 30) <> Int(sx / 20) And Int(targety(x) / 30) <> Int(sy / 30)
Next x
_FullScreen
Do
_Limit 300
Cls
ik$ = InKey$
While _MouseInput: Wend
mx = _MouseX: my = _MouseY: mb = _MouseButton(1)
Select Case ik$
Case "W", "w"
iy = iy - 4
ix = 0
Case "A", "a"
iy = 0
ix = ix - 4
Case "S", "s"
iy = iy + 4
ix = 0
Case "D", "d"
iy = 0
ix = ix + 2
End Select
dx = mx - sx ' ship avoids collision with mouse
dy = my - sy
ma = _Atan2(dy, dx)
md = Sqr(dy * dy + dx * dx)
If md < 80 Then md = 80
'sx = cx + md * Cos(ma + 3.1415)
' sy = cy + md * Sin(ma + 3.1415)
sx = sx + ix
sy = sy + iy
ix = ix / 2
iy = iy / 2
drawShip sx, sy, ShipColor
If mb Then
If md < 301 Then PLC sx, sy, mx, my, 10 ' Fire! aaa w
ShipColor = _RGB32(Int(Rnd * 100) + 150, Int(Rnd * 100) + 150, Int(Rnd * 100) + 150)
For x = 1 To 10
If Int(targetx(x) / 20) = Int(mx / 20) And Int(targety(x) / 20) = Int(my / 20) And targetalive(x) > 0 Then
damage = 1 + Abs((10 - Int(Rnd * Sqr(md))))
targetalive(x) = targetalive(x) - damage
cdiv = (20 - targetalive(x)) / 2
targetcolor(x) = _RGB32(Int(Rnd * (100 / cdiv)) + (150 / cdiv), Int(Rnd * (100 / cdiv)) + (150 / cdiv), Int(Rnd * (100 / cdiv)) + (150 / cdiv))
Beep
If targetalive(x) <= 0 Then score = score + 1
End If
Next x
End If
For x = 1 To 10
targetx(x) = targetx(x) + targetvx(x)
targety(x) = targety(x) + targetvy(x)
If Int(targetx(x) / 30) = Int(sx / 30) And Int(targety(x) / 20) = Int(sy / 20) And targetalive(x) > 0 Then
_PrintString (sx, sy), "BOOM!!!!"
killflag = 13
End If
If Rnd * 100 < 30 Then
Select Case Int(Rnd * 20)
Case 1, 2, 3
'seek ship
If targetx(x) < sx Then targetvx(x) = 2
If targetx(x) > sx Then targetvx(x) = -2
If targety(x) < sx Then targetvy(x) = 2
If targety(x) > sx Then targetvy(x) = -2
Case 4, 5
'flee ship
If targetx(x) < sx Then targetvx(x) = -2
If targetx(x) > sx Then targetvx(x) = 2
If targety(x) < sx Then targetvy(x) = -2
If targety(x) > sx Then targetvy(x) = 2
Case 7
'rando change
targetvy(x) = targetvy(x) + Int(Rnd * 3) - Int(Rnd * 3)
targetvx(x) = targetvx(x) + Int(Rnd * 3) - Int(Rnd * 3)
End Select
End If
If targetx(x) < -20 Then targetx(x) = _Width
If targetx(x) > _Width + 20 Then targetx(x) = 0
If targety(x) < -20 Then targety(x) = _Height
If targety(x) > _Height + 20 Then targety(x) = 0
If targetalive(x) > 0 Then drawtarget targetx(x), targety(x), targetcolor(x)
Next x
_Display
_Limit 60
Loop Until _KeyDown(27) Or killflag = 13
_AutoDisplay
_Delay 1
Cls
Color _RGB32(255, 255, 255)
Print "GAME OVER"
Print "Score "; (score * score) * 1000
Sleep
Sub PLC (baseX, baseY, targetX, targetY, targetR) ' PLC for PlasmaLaserCannon
Dim r, g, b, hp, ta, dist, dr, x, y, c, rr
r = Rnd ^ 2 * Rnd: g = Rnd ^ 2 * Rnd: b = Rnd ^ 2 * Rnd: hp = _Pi(.5) ' red, green, blue, half pi
ta = _Atan2(targetY - baseY, targetX - baseX) ' angle of target to cannon base
dist = _Hypot(targetY - baseY, targetX - baseX) ' distance cannon to target
dr = targetR / dist
For r = 0 To dist Step .25
x = baseX + r * Cos(ta)
y = baseY + r * Sin(ta)
c = c + .3
Color _RGB32(128 + 127 * Sin(r * c), 128 + 127 * Sin(g * c), 128 + 127 * Sin(b * c))
fcirc x, y, dr * r
Next
For rr = dr * r To 0 Step -.5
c = c + 1
Color _RGB32(128 + 127 * Sin(r * c), 128 + 127 * Sin(g * c), 128 + 127 * Sin(b * c))
fcirc x, y, rr
Next
End Sub
Sub drawShip (x, y, colr As _Unsigned Long) 'shipType collisions same as circle x, y radius = 30
' shared here ShipLights
Dim light As Long, r As Long, g As Long, b As Long
r = _Red32(colr): g = _Green32(colr): b = _Blue32(colr)
Color _RGB32(r, g - 120, b - 100)
fEllipse x, y, 6, 15
Color _RGB32(r, g - 60, b - 50)
fEllipse x, y, 18, 11
Color _RGB32(r, g, b)
fEllipse x, y, 30, 7
For light = 0 To 5
Color _RGB32(ShipLights * 50, ShipLights * 50, ShipLights * 50)
fcirc x - 30 + 11 * light + ShipLights, y, 1
Next
ShipLights = ShipLights + 1
If ShipLights > 5 Then ShipLights = 0
End Sub
Sub drawtarget (x, y, colr As _Unsigned Long) 'shipType collisions same as circle x, y radius = 30
' shared here ShipLights
Dim light As Long, r As Long, g As Long, b As Long
r = _Red32(colr): g = _Green32(colr): b = _Blue32(colr)
Color _RGB32(r, g - 120, b - 100)
fEllipse x, y, 3, 15
Color _RGB32(r, g - 60, b - 50)
fEllipse x, y, 9, 11
Color _RGB32(r, g, b)
fEllipse x, y, 15, 7
For light = 1 To 3
Color _RGB32(ShipLights * 50, ShipLights * 50, ShipLights * 50)
fcirc x - 30 + 11 * light + ShipLights, y, 1
Next
ShipLights = ShipLights + 1
If ShipLights > 5 Then ShipLights = 0
End Sub
' these do work in QBJS without mod see le bombe
Sub fcirc (CX As Long, CY As Long, R As Long)
Dim subRadius As Long, RadiusError As Long
Dim X As Long, Y As Long
subRadius = Abs(R)
RadiusError = -subRadius
X = subRadius
Y = 0
If subRadius = 0 Then PSet (CX, CY): Exit Sub
' Draw the middle span here so we don't draw it twice in the main loop,
' which would be a problem with blending turned on.
Line (CX - X, CY)-(CX + X, CY), , BF
While X > Y
RadiusError = RadiusError + Y * 2 + 1
If RadiusError >= 0 Then
If X <> Y + 1 Then
Line (CX - Y, CY - X)-(CX + Y, CY - X), , BF
Line (CX - Y, CY + X)-(CX + Y, CY + X), , BF
End If
X = X - 1
RadiusError = RadiusError - X * 2
End If
Y = Y + 1
Line (CX - X, CY - Y)-(CX + X, CY - Y), , BF
Line (CX - X, CY + Y)-(CX + X, CY + Y), , BF
Wend
End Sub
Sub fEllipse (CX As Long, CY As Long, xRadius As Long, yRadius As Long)
Dim scale As Single, x As Long, y As Long
scale = yRadius / xRadius
Line (CX, CY - yRadius)-(CX, CY + yRadius), , BF
For x = 1 To xRadius
y = scale * Sqr(xRadius * xRadius - x * x)
Line (CX + x, CY - y)-(CX + x, CY + y), , BF
Line (CX - x, CY - y)-(CX - x, CY + y), , BF
Next
End Sub[/qbjs]
RE: SaucerZap - bplus - 12-23-2024
Hmm... why aren't the QBJS tags working?
Killflag undefined
fixed
https://qbjs.org/?code=J09wdGlvbiBfRXhwbGljaXQKJ19UaXRsZSAiU2F1Y2VyIFphcCIgJyBmb3IgUUJKUyBieSBKYW1lcyBELiBKYXJ2aXMKJyBBIG1vZCBvZiBQbGFzbWEgTGFzZXIgQ2Fub24gZGVtbyBwcmVwxURHVUkgMjAyMC0xMS0xMQoKU2NyZWVuIF9OZXdJbWFnZSgxMjAwLCA2xAUzMikKUmFuZG9taXplIFRpbWVyCkRpbSBTaGFyZWQgQXMgTG9uZyBTaGlwTGlnaHRzzx5fVW5zaWduZWTKKENvbG/GRcg+Y3gsIGN5LCBteCwgbcQIYiwgc3gsIHN5LCBpeCwgaXksIGtpbGxmbGFnyDlTaW5nbGUgbWEsIG1kLCBkeCwgZHksIGRh5ADCxSV0YXJnZXR4KDEwKSzHDXnMDXbNG3bNHGFsaXZlxBHLSmPkALjEFPIA2MUmaWskCmN5ID0gX0hl5AELIC8gMjogY3jEEldpZHRoxBEK6QECID0gJkhGRjMzNjZBQQonICBfTW91c2VIaWRlICc/Pz8gbm90IHN1cHBvcnRlZCBhbmQgYmFkIGlkZWEgYW55d2F5CnPEXGN4CnPEdmN5CkZvciDEEzEgVG8gMTAKICAgIERvxQfEAegBEXgpID0gSW50KFJuZCAq5wCdKc8nedEn5gDW0Ch20VAyKSAtzQ/QMtFb3zLnAXrFNV9SR0IzMijELTEwMCArIMYzMTXkAbzfFssW0GLmAfDFYucBOExvb3AgVW50aWzFQesBPC8gMzApIDw+xRhzeOQB1uQCFG5kyynlAOPOKXnGEApOZXh0IHgKX0Z1bGzmA3oK5wGkX0xpbWl0IDMw5gCCQ2xzxQhpayTlAS5LZXkkxRFXaGlsZecCL0lucHV0OiBXZW5kxRxt5QJvxRtYOiBt5QKPxQ5ZOiBtYskOQnV0dG9uKDHmAQhTZWxlY3QgQ2FzZcRu6QEcxREiVyIsICJ3IskWxAFpxFlpeSAtIDTOGMR/5gC/ykFBxEFh00HKKck8aXjFVM9CU8RCc9NCaXkgK/YAg89CRMRCZP8AhMc9aXggKyAyxkJFbmTnAR/FD2TEIG3kAKRzeCAnIHNoaXAgYXZvaWRzIGNvbGxpc+QFyXdpdGggbeQBZ8Y0xGdt5AEsc3nFEW1h5AGIQXRhbjIo5QS0eOYBh21kID0gU3FyKGR5ICrENyvEcCrFIMUhSWbEJDwgODAgVGhlbsYxOOYAwifnBA0gK8QXKiBDb3MobWEgKyAzLjE0MTXGYicg5wQryCZTaW7SJsVKc8RKaXjGEcQ1c8Q1aeYAwugBJ+QE0ewBjMgQZHJhd+QE6ekFxuoF+OoAymLlAMXpAX/oAN0zMDHFGSBQTEPJQOgGGjEwICcgRmlyZSHIN9ABYWFh0hV3yWbsBX/rBEznBBowMCkgK+QEIeYENt8WxxbqBEz0BYDIAUlm8gRI5AQ45gUIbf0ER8so5QFkxyjvBLs+IOYCF813xAHmBxTlAJgrIEFicygoMTDtBXHkAnRtZCkp6wUXyAHPZD3QES3HXtE5Y2RpdiA9ICgyxGvONeUA09dq9gXr5gCn5QXGL8VaKeQBfCgxNckQ7AGb3yjfKMcQ8QCgQmVlcNEVSWbwARE8PecBhyBzY29y5AF2xggrIDHNPuQEWUlmyRPnBhbPGvgCUe0HyssNK+wHlc8u5wd2yw3JLsQOyS70AqnkBsjmAoHlBvDED/8CqeUG7/8CqclzxAFfUHJpbnRTdHJpbmcgKOYD+CksICJCT09NISEhIe4Fu+gKDuQBHDPJGu8BVElm6AfyMDDlBFnSduwG+usIgesD1MgBxSMxLCAyLCDKccwBJ3NlZWvlBhLVH+kCKuUBUzzkBWDlAibuCUbyAxfSPD7XPC3fPeUBpNF5xRbfecc80XnHPNN55QEuNCwgNdVXJ2ZsZWX/ASv/ASvVdtI9+AEs3zz9ASvfef4BLDLnBwHMAeUBLTfVVSdy5A18IGNoYW7zBWTEAc5fzA4r6wLSM+4LYjPyAuDLTO0EWMYO30zLAe8JMcgTSWbqAPjwAeAtMucFMssW6A001zU+xx/kCanUPeoFK/AB1M9txRbpDbPXNj7IINFvxz/Tb/EE7uUJFcYc6wCs6g6aygzoBwTFVecGGcUMX0Rpc3BsYeYJhOcMLjYwCusMq19LZXlEb3duKDI3KSBPcu8FKF9BdXRvyERfRGVsYXkgMQrkDGjmCRPnB3IyNTUsIMgFKQrlBZnGBiAiR0FNRSBPVkVSIs4YU+UG5SI7ICjmBu8q5gb3KeYFfjAKClNs5AdACgpTdWLlCdooYmFzZVgsIMQHWegA+ljICckSUikgJ8Uw5BC55hDa5RDZQ2Fubm/mBczkD3xyLCBnLCBiLCBocMQ6LCBkaXN0LCBkciwgeCwgeSwgYywgcnLFL+QJ+uQCul4gMiAqxAo6IOQBH88T5A0rzxNocOQCKVBpKC415ACVcmVkLCBn5A3ALCBibHVlLCBoYWxmIHBpxWZ06wvk5wDTIC3vAO3HEVjETmHlEM5v6AI+IHRvIGPlAOPFI8VT5ADTxFVIeXBv6Ad43lXEMmFuY2XIS3RvxybGUOQBCsYQUiAvxS3pCHXEGzDkCHXFdVN0ZXAgLjLqBc3kCJTFZiArIHLnDG10YeoECeQMD8QgWccg5AxnzCBj5AyFICsgLuoHS+0CgjEyOOQJMTI3xzzERGMpLCDQGGfXGGLFGMpwZmNpcmPnAgpkxE3mAgvkA1zqAPPkAPTGHeQA+TDmAPYtLuoA9ugAtuoJyf8Atf8Atf8AtewAtecCvOUAseUFYnVi5gNL6Q1qKMYpY29scvISoCkgJ+QHblR5cGXER+kOq3Mgc2FtZSBhcyDEbGxlxW4gcmFkaXVzID0gM+cOWyBz5hPQaGVyZewT6+kDf2zEEOgTzywg5QCCxgtnygtiyAvpA4dfUmVkMzIo5AC0KeYDhl9H5ANRyhTlELJCbHVlyBPFPO0Bd+QD+yAtIDEyMMRjLeUNmcUmZkVsbGlwc+YA1SwgNiwgMeYBzNQ/Nsc+6A3Pzz0xOCwgMeYB+NE+LCBi1TQzMCznB9bkAl/mASPnA1bqAlTNTuoBWyAqIOQOb98R6wqn5wItIC3kCucrIDExICrHcyvLNeYAzO4C/MtTPcwN6ALoSWbMFj4gNeYGzs03MOoClekClucEyf8CmP8CmP8CmP8CmP8CmP8CmP8CmP8CmP8CmOsCJ/8CmP0CmDn/ApfTMzE19AKX5Q5i9wWO/wKG/wKX/wKX/wKX/wKX/wKX6wKXJyB0aGVzZSBkbyB3b3JrIGlu5hlM5BOtb3V05Rk9c2VlIGxlIGJvbWJl5QLI5gC/KENY6gIuQ1nKDFLIC+YA8eQCcnN1YlLmAqfKJsUQRXJyb+kCgMkvy1nJWOYCv8pJPeURtFLGZMxNPSAtySbFHVjkEG7NElnqFQxJZs1U5wqVUFPkA6RDWOQA2Sk6IEV4aXTmATHEMycgRHJhd+QBOSBtaWRkbGUgc3BhbuYDb3NvIHfkAU5uJ3TlA+8gaXQgdHdpY2XkAVrFMmFpbiBsb29wLMdMd2hpY2ggd291bGQgYmUgYSBwcm9ibGVt5hUwYmxlbmTkD/x0dXLkBB9vbi7FOExpbmXlAYItIOYApS3EDSvHDSwgLCBCRuYAruYXF1ggPiBZ6QKA7gEvzA4rIFnkD+rtB8/kEDHLIz7oASbJIcclWOQX1eQI3OYUqs0f7wC0WeUCMi0gWOgAuMoR5wC83z3EZ889xBHTPe8Q/sQB5AIRxEnuEnv6ARUtIFjkARXJLs9T5AJOxH/KT/ABnuQAte0BosUR7wCt0TUr0DXEEcs15Rje7Qj36QTU+QOcePADh3nOEesDs2NhbGXqHFMsIHjLNe0DssYqPclLL8hm7QKq5wD3xyXlANnFEyvJE+sA2+0T4sxOxAHlF3fFdOYVpMcgICrIKiAtIOQYIesTvukBXCvkBe/mAInoAVzGESsg5BNY+AGRzzXIEc817QqI
RE: SaucerZap - dbox - 12-23-2024
(9 hours ago)bplus Wrote: Hmm... why aren't the QBJS tags working?To use the QBJS tag you paste in the share link as the tag content instead of the full source.
Code: (Select All)
[qbjs]https://qbjs.org/?code=J09wdGlvbiBfRXhwbGljaXQKJ19UaXRsZ...[/qbjs]Nice mod James!
RE: SaucerZap - Pete - 12-23-2024
Game freezes on me (full screen) as soon as I shoot a varmint. I can'tz have fun when I'm not shootin somethin'!
- Sam
RE: SaucerZap - bplus - 12-23-2024
Oh yeah, I get same when the varmit is hit.
RE: SaucerZap - bplus - 12-23-2024
OK x and score were not dim'd, try this one:
RE: SaucerZap - Pete - 12-23-2024
Eeeeew that works! Now allz we needz is longer range phasers and some photon torpedeies!
+1
- Sam