| Welcome, Guest |
You have to register before you can post on our site.
|
| Latest Threads |
_CONSOLEINPUT is blocking
Forum: General Discussion
Last Post: SMcNeill
6 minutes ago
» Replies: 1
» Views: 7
|
Most efficient way to bui...
Forum: General Discussion
Last Post: SMcNeill
28 minutes ago
» Replies: 5
» Views: 26
|
Fun with Ray Casting
Forum: a740g
Last Post: a740g
9 hours ago
» Replies: 10
» Views: 205
|
Very basic key mapping de...
Forum: SMcNeill
Last Post: a740g
Today, 02:33 AM
» Replies: 1
» Views: 44
|
Who wants to PLAY?
Forum: QBJS, BAM, and Other BASICs
Last Post: grymmjack
Today, 01:25 AM
» Replies: 2
» Views: 48
|
Methods in types
Forum: General Discussion
Last Post: bobalooie
Today, 01:02 AM
» Replies: 0
» Views: 37
|
QBJS - ANSI Draw
Forum: QBJS, BAM, and Other BASICs
Last Post: dbox
Yesterday, 04:09 PM
» Replies: 3
» Views: 96
|
Cautionary tale of open, ...
Forum: General Discussion
Last Post: doppler
Yesterday, 10:23 AM
» Replies: 3
» Views: 103
|
Extended KotD #23 and #24...
Forum: Keyword of the Day!
Last Post: SMcNeill
Yesterday, 09:51 AM
» Replies: 0
» Views: 52
|
Big problem for me.
Forum: General Discussion
Last Post: JRace
Yesterday, 05:11 AM
» Replies: 11
» Views: 200
|
|
|
| Zoom_Trek |
|
Posted by: James D Jarvis - 10-10-2022, 06:16 PM - Forum: Works in Progress
- Replies (1)
|
 |
Building a Trek shooter based on the zoom_circle program I posted a few days ago. Currently the player space ship can just zoom about the screen while an enemy craft crawls along.
Code: (Select All) 'Zoom Trek
'by James D. Jarvis, still very ealry in development
'
'low end control example with angular navigation, dubious physics, and screenwrap
' w - accelerate
' s - decelerate
' a - turn to port
' d- turn to starboard
't - activate tracking to tragte alien vessel
'<esc> - end program
Screen _NewImage(900, 680, 32)
_FullScreen
Dim Shared klr As _Unsigned Long
Type shiptype
shape As Integer
nm As String
fuel As Double
hdg As Double
hc As Double
mr As Double
px As Double
py As Double
shield As Integer
shieldmax As Integer
shieldregen As Integer
shieldrc As Integer
sregenon As Integer
hull As Integer
k As _Unsigned Long
br As Double
beamname As String
torpname As String
bcost As Integer
tcost As Integer
tnum As Integer
bdam As Integer
tdam As Integer
brange As Integer
trange As Integer
End Type
Dim Shared ps As shiptype
Dim Shared AV(10) As shiptype
Dim Shared na As Integer
Dim Shared stardate, target
defineship 0, ps 'player starting as commonwealth you can chage this but missions will not reflect change beyond player ship
For msn = 1 To 1
View Print 35 To 40
tx = ps.px + 3.5 * Sin(0.01745329 * hdg)
ty = ps.py + 3.5 * Cos(0.01745329 * hdg)
stardate = Timer
missions msn
Cls
Do
Line (0, 0)-(_Width, 535), _RGB32(0, 0, 0), BF
_Limit 30
' Circle (ppx, ppy), 4, _RGB32(250, 250, 100) 'the zoom_circle saucer
' drawcraft 1, ppx, ppy, hdg, _RGB32(250, 250, 250)
drawcraft ps.shape, ps.px, ps.py, ps.hdg, ps.k
shipdatadisplay
handlealiens "draw"
Line (1, 1)-(535, 535), _RGB32(100, 200, 100), B
Line (10, 10)-(525, 525), _RGB32(100, 200, 100), B
'Circle (tx, ty), 2, _RGB32(255, 255, 255) 'this nubbin is to show where the cricle is heading
kk$ = InKey$
'Locate 1, 1: Print "Fuel : "; Int(ps.fuel)
'Locate 1, 20: Print "Velocity :"; Int(ps.mr * 200)
_Display
Select Case kk$
Case "w"
If ps.fuel > 0 Then
ps.mr = ps.mr + 0.05 * (100000 / ps.fuel)
ps.fuel = ps.fuel - (1 * ps.br)
End If
Case "s"
If ps.fuel > 0 Then
ps.fuel = ps.fuel - Sqr(ps.mr / (0.05 * ps.br))
ps.mr = ps.mr - 0.05
If ps.mr < 0 Then ps.mr = 0
End If
Case "a"
If ps.fuel > 0 Then
ps.fuel = ps.fuel - Sqr(Sqr(ps.mr / (0.05 * ps.br)))
ps.hc = ps.hc + 2
ps.mr = ps.mr * 0.995
End If
Case "d"
If ps.fuel > 0 Then
ps.fuel = ps.fuel - Sqr(Sqr(ps.mr / 0.05))
ps.hc = ps.hc - 2
ps.mr = ps.mr * .995
End If
Case " ", "b" 'fire beam weapon
If target < 1 Then
Sound 880, 3
Print "NO TARGET DECLARED (Press T to activate target tracking)"
End If
Case "t" 'activate or shift tracking
If na > 1 Then Print "SENSORS REPORT VALID TARGETS"
For a = 1 To na
Print a; ") "; AV(a).nm,
Next a
Print
Input "Enter Target # "; target
If target > 0 Or target <= na Then
For t = 1 To na
If t = target And AV(t).px > 0 Then
Print "TARGET TRACKING FOR "; AV(t).nm; " CONFIRMED!"
Else
Print "NO VALID TARGET SELECTED"
target = 0
End If
Next t
Else
Beep
Print "NO VALID TARGET SELECTED"
target = 0
End If
End Select
handlealiens "move"
ps.px = ps.px + ps.mr * Sin(0.01745329 * ps.hdg)
ps.py = ps.py + ps.mr * Cos(0.01745329 * ps.hdg)
ps.hdg = ps.hdg + ps.hc
ps.hc = ps.hc * .75
If ps.px < 15 Then ps.px = 500
If ps.px > 515 Then ps.px = 15
If ps.py < 15 Then ps.py = 500
If ps.py > 515 Then ps.py = 15
tx = ps.px + 3.5 * Sin(0.01745329 * ps.hdg)
ty = ps.py + 3.5 * Cos(0.01745329 * ps.hdg)
Loop Until kk$ = Chr$(27) Or kk$ = "ABORT"
If kk$ = "ABORT" Then
Print "MISSION "; msn; " ABORT"
Print
Print "Attempt next mission? (Y or N)"
Do
ask$ = Input$(1)
ask$ = UCase$(ask$)
Loop Until aks$ = "Y" Or ask$ = "N"
If ask$ = "N" GoTo endgame
Else
GoTo endgame
End If
Next msn
endgame:
End
Sub drawcraft (craftid, cx, cy, hdg, klr As _Unsigned Long)
Select Case craftid
Case 1
Draw "bm" + Str$(cx) + "," + Str$(cy) + "C" + Str$(klr) + "ta" + Str$(hdg) + " bu5l4d5u10br8d10u5l4d10"
tx = cx + 5 * Sin(0.01745329 * hdg)
ty = cy + 5 * Cos(0.01745329 * hdg)
Circle (tx, ty), 3, klr
Case 2
Draw "bm" + Str$(cx) + "," + Str$(cy) + "C" + Str$(klr) + "ta" + Str$(hdg) + " bu5l4d5u6br8d6u5l4d10"
tx = cx + 5 * Sin(0.01745329 * hdg)
ty = cy + 5 * Cos(0.01745329 * hdg)
Circle (tx, ty), 2, klr
Case 3
Circle (cx, cy), 6, klr
Draw "bm" + Str$(cx) + "," + Str$(cy) + "C" + Str$(klr) + "ta" + Str$(hdg) + " l6u6br12d6l6u6"
Case 4
Circle (cx, cy), 9, klr
Circle (cx, cy), 3, klr
tx = cx + 6 * Sin(0.01745329 * hdg)
ty = cy + 6 * Cos(0.01745329 * hdg)
Circle (tx, ty), 2, klr
End Select
End Sub
Sub defineship (id As Integer, ds As shiptype)
Select Case id
Case 0 'Commonwealth cruiser
ds.shape = 1
ds.fuel = 100000
ds.hdg = 90
ds.br = 1.1
ds.hc = 0
ds.mr = 0
ds.px = 0
ds.py = 0
ds.shield = 1000
ds.shieldmax = 1000
ds.shieldregen = 10
ds.shieldrc = 10
ds.sregenon = 1
ds.hull = 3000
ds.k = _RGB32(250, 250, 250)
ds.nm = "Commonwealth Cruiser"
ds.beamname = "Maser"
ds.torpname = "Proton Torpedo MII"
ds.bcost = 1
ds.tcost = 1
ds.tnum = 300
ds.bdam = 300
ds.tdam = 1500
ds.brange = 200
ds.trange = 300
Case 1 'Kraal Destroyer
ds.shape = 2
ds.fuel = 90000
ds.br = 1.0
ds.hdg = 90
ds.hc = 0
ds.mr = 0
ds.px = 0
ds.py = 0
ds.shield = 900
ds.shieldmax = 900
ds.shieldregen = 9
ds.shieldrc = 10
ds.sregenon = 1
ds.hull = 2000
ds.k = _RGB32(250, 50, 0)
ds.nm = "Kraal Destroyer"
ds.beamname = "UVaser"
ds.torpname = "Proton Torpedo MI"
ds.bcost = 1
ds.tcost = 1
ds.tnum = 300
ds.bdam = 250
ds.tdam = 1000
ds.brange = 100
ds.trange = 200
Case 2 'Gorgon Raider
ds.shape = 3
ds.fuel = 125000
ds.br = 2
ds.hdg = 90
ds.hc = 0
ds.mr = 0
ds.px = 0
ds.py = 0
ds.shield = 500
ds.shieldmax = 500
ds.shieldregen = 8
ds.shieldrc = 15
ds.sregenon = -1
ds.hull = 5000
ds.k = _RGB32(100, 250, 50)
ds.nm = "Gorgon Imperial Raider"
ds.beamname = "Laser"
ds.torpname = "Atomic-WarpStorm"
ds.bcost = 1
ds.tcost = 3000
ds.tnum = -99
ds.bdam = 200
ds.tdam = 3000
ds.brange = 150
ds.trange = 200
Case 3 'Andromeda Invader
ds.shape = 4
ds.fuel = 250000
ds.br = 1
ds.hdg = 90
ds.hc = 0
ds.mr = 0
ds.px = 0
ds.py = 0
ds.shield = 2000
ds.shieldmax = 2000
ds.shieldregen = 20
ds.shieldrc = 10
ds.sregenon = 1
ds.hull = 6000
ds.k = _RGB32(100, 250, 50)
ds.nm = "Andromeda Invader"
ds.beamname = "Demat Beam"
ds.torpname = "Quark Torpedo"
ds.bcost = 1
ds.tcost = 30
ds.tnum = 1000
ds.bdam = 400
ds.tdam = 5000
ds.brange = 150
ds.trange = 100
Case 4 'Kraal Corsair
ds.shape = 2
ds.fuel = 100000
ds.br = 1.05
ds.hdg = 90
ds.hc = 0
ds.mr = 0
ds.px = 0
ds.py = 0
ds.shield = 950
ds.shieldmax = 950
ds.shieldregen = 10
ds.shieldrc = 11
ds.sregenon = 1
ds.hull = 1800
ds.k = _RGB32(240, 50, 40)
ds.nm = "Kraal Corsair"
ds.beamname = "UVaser"
ds.torpname = "Proton Torpedo MI"
ds.bcost = 1
ds.tcost = 1
ds.tnum = 100
ds.bdam = 250
ds.tdam = 1000
ds.brange = 100
ds.trange = 200
Case 5 'Kraal
ds.shape = 2
ds.fuel = 150000
ds.br = 1.2
ds.hdg = 90
ds.hc = 0
ds.mr = 0
ds.px = 0
ds.py = 0
ds.shield = 1150
ds.shieldmax = 1150
ds.shieldregen = 12
ds.shieldrc = 15
ds.sregenon = 1
ds.hull = 2500
ds.k = _RGB32(240, 50, 40)
ds.nm = "Kraal BattleCruiser"
ds.beamname = "Overcharged UVaser"
ds.torpname = "Proton Torpedo MII"
ds.bcost = 2
ds.tcost = 1
ds.tnum = 200
ds.bdam = 300
ds.tdam = 1500
ds.brange = 150
ds.trange = 280
End Select
End Sub
Sub shipdatadisplay
_PrintString (580, 10), "Stardate " + Str$(Timer)
_PrintString (580, 60), ps.nm
_PrintString (580, 80), "Fuel " + Str$(Int(ps.fuel))
_PrintString (580, 100), "Velocity " + Str$(Int(ps.mr * 200))
_PrintString (580, 120), "Shields " + Str$(ps.shield)
_PrintString (580, 140), "Hull Integrity " + Str$(ps.hull)
_PrintString (580, 160), ps.torpname
If ps.tnum > -1 Then
_PrintString (580, 180), "Ammo: " + Str$(ps.tnum)
Else
Select Case ps.tnum
Case -99
_PrintString (580, 180), "-- Online --"
Case -13
_PrintString (580, 180), "** OFFLINE **"
End Select
End If
If target > 0 Then
_PrintString (580, 200), "************************"
_PrintString (580, 216), " TARGET TRACKING REPORT "
_PrintString (580, 232), "************************"
_PrintString (580, 250), AV(target).nm
If Int(Rnd * 100) < 20 Then
msg$ = "Shields : ?????????????????"
Else
msg$ = "Shields : " + Str$(AV(target).shield)
End If
_PrintString (580, 270), msg$
If Int(Rnd * 100) < 20 Then
msg$ = "Hull : ?????????????????"
Else
msg$ = "Hull : " + Str$(AV(target).hull)
End If
_PrintString (580, 290), msg$
dx = Abs(ps.px - AV(target).px): dy = Abs(ps.py - AV(target).py)
dd = Sqr(dx * dx + dy + dy)
_PrintString (580, 310), "Range to Target :" + Str$(Int(dd))
End If
End Sub
Sub missions (m)
Select Case m
Case 1
Print "**** STARWATCH COMMAND to "; ps.nm; " ****"
Print "!!!! NEUTRAL ZONE VIOLATION DETECTED !!!!"
Print "!!!! ENGAGE HOSTILE KRAAL VESSEL !!!!"
Print
Print " <press any key to engage warp drive> "
_KeyClear
any$ = Input$(1)
na = 1
defineship 1, AV(1)
AV(1).hdg = 90: AV(1).mr = .1: AV(1).px = 300: AV(1).py = 100: AV(1).hull = AV(1).hull / 2
For a = 2 To 10
defineship 1, AV(a)
AV(a).fuel = 0: AV(a).px = 0
Next a
ps.px = 250: ps.py = 250: ps.hdg = 90: ps.hc = 0: ps.mr = 0
target = 0
End Select
End Sub
Sub handlealiens (sequence$)
Select Case sequence$
Case "draw"
For a = 1 To na
If AV(a).px > 0 Then
drawcraft AV(a).shape, AV(a).px, AV(a).py, AV(a).hdg, AV(a).k
End If
Next a
Case "move"
For a = 1 To na
If AV(a).px > 0 And AV(a).mr > 0 Then
xtp = AV(a).px - ps.px
ytp = AV(a).py - ps.py
dtp = Sqr(Abs(xtp) * Abs(xtp) + Abs(ytp) * Abs(ytp))
AV(a).hdg = AV(a).hdg + AV(a).hc
AV(a).hc = AV(a).hc * .75
AV(a).px = AV(a).px + AV(a).mr * Sin(0.01745329 * AV(a).hdg)
AV(a).py = AV(a).py + AV(a).mr * Cos(0.01745329 * AV(a).hdg)
If AV(a).px < 15 Then AV(a).px = 500
If AV(a).px > 515 Then AV(a).px = 15
If AV(a).py < 15 Then AV(a).py = 500
If AV(a).py > 515 Then AV(a).py = 15
End If
Next a
End Select
End Sub
|
|
|
| Aliens Among Us |
|
Posted by: bplus - 10-10-2022, 05:20 PM - Forum: Works in Progress
- Replies (4)
|
 |
I just saw a video and hey they are right here in this!
Code: (Select All) _Title "Pascal Triangle display exercise 2018-01-13 bplus"
'2018-01-13 Pascal Triangle.txt for JB 2015-10-31 MGA/B+
_Define A-Z As _INTEGER64
Const xmax = 1200
Const ymax = 400
Screen _NewImage(xmax, ymax, 32)
_ScreenMove 100, 60
printline = 2
For row = 0 To 20
build$ = ""
printline = printline + 1
For column = 0 To row
build$ = build$ + Right$(Space$(7) + Str$(binom(row, column)), 7)
Next
Locate printline, (150 - Len(build$)) / 2
Print build$
Next
Sleep
Function binom (n, m)
binom = fac(n) / (fac(m) * fac((n - m)))
End Function
Function fac (n)
f = 1
For i = 1 To n
f = f * i
Next
fac = f
End Function
To be continued... as soon as I get it coded ;-))
Meanwhile wonder WTH?
Oh better yet, try to anticipate where I am going with this.
|
|
|
|
| Planetary System Animation |
|
Posted by: James D Jarvis - 10-10-2022, 03:49 PM - Forum: Programs
- Replies (11)
|
|
A simple program that randomly generates a planetary system showing the main star, some planets, and moons. There's no physics here and sizes are exaggerated so there is something to see.
EDIT: corrected the value to generate nump so it's the same in both locations in the program.
Code: (Select All) 'planetary system animation
'by James D, Jarvis 10/10/2022
'
' a simple planetary system animation generator, planets and moons orbiting a star
' <esc> to exit
' press "n" for a new system
'feel free to modify for your own use as you wish
Screen _NewImage(1200, 800, 32)
_FullScreen _SquarePixels
Randomize Timer
_Define K As _UNSIGNED LONG
stars& = _NewImage(1200, 800, 32)
_Dest stars&
For s = 1 To 1200
PSet (Rnd * _Width, Rnd * _Height), _RGB32(240 + Rnd * 15, 240 + Rnd * 15, 240 + Rnd * 15)
Next s
_Dest 0
Type planet_type
orbit As Double
size As Double
kp As _Unsigned Long
rate As Double
ppos As Double
End Type
Dim Shared sunx, suny, mooncount(20)
sunx = _Width / 2: suny = _Height / 2: sunr = 10 + Int(Rnd * 40): Ksun = _RGB32(250, 200 + sunr, 0)
Dim Shared planet(20) As planet_type
Dim Shared moon(20, 12) As planet_type
Nump = Int(1 + Rnd * 20)
For p = 1 To Nump
planet(p).orbit = p * (sunr * 1.5) + Rnd * 10
planet(p).size = 1 + Int(Rnd * 8)
planet(p).kp = _RGB32(Int(5 + Rnd * 250), Int(5 + Rnd * 250), Int(5 + Rnd * 250))
planet(p).rate = (5 / p) / (50 / Sqr(sunr))
planet(p).ppos = Int(Rnd * 360)
If p > 1 Then
nm = (Int(Rnd * (p + 3)))
If nm > 12 Then nm = Int(nm / 2)
mooncount(p) = nm
For m = 1 To mooncount(p)
moon(p, m).orbit = m * (planet(p).size * 1.5) + Rnd * 10
moon(p, m).size = .5 + Int(Rnd * (planet(p).size / 3))
moon(p, m).kp = _RGB32(Int(200 + Rnd * 53), Int(200 + Rnd * 53), Int(200 + Rnd * 53))
moon(p, m).rate = ((5 / p) / _Pi) * (1 + Rnd * 3)
moon(p, m).ppos = Int(Rnd * 360)
Next m
End If
Next p
Do
_Limit 60
Cls
_PutImage , stars&, 0
circleBF sunx, suny, sunr, Ksun
For n = 1 To Nump
drawplanet n
Next
_Display
kk$ = InKey$
If kk$ = "n" Then
stars& = _NewImage(800, 800, 32)
_Dest stars&
For s = 1 To 1200
PSet (Rnd * _Width, Rnd * _Height), _RGB32(240 + Rnd * 15, 240 + Rnd * 15, 240 + Rnd * 15)
Next s
_Dest 0
sunr = 10 + Int(Rnd * 40): Ksun = _RGB32(100 + sunr * 2 + Rnd * 50, sunr * 4 + Rnd * 50, 0)
Nump = Int(1 + Rnd * 20)
For p = 1 To Nump
planet(p).orbit = p * (sunr * 1.5) + Rnd * 10
planet(p).size = 1 + Int(Rnd * 8)
planet(p).kp = _RGB32(Int(5 + Rnd * 250), Int(5 + Rnd * 250), Int(5 + Rnd * 250))
planet(p).rate = (5 / p) / (50 / Sqr(sunr))
planet(p).ppos = Int(Rnd * 360)
If p > 1 Then
nm = (Int(Rnd * (p + 3)))
If nm > 12 Then nm = Int(nm / 2)
mooncount(p) = nm
For m = 1 To mooncount(p)
moon(p, m).orbit = (planet(p).size * 1.5) + m * planet(p).size
moon(p, m).size = .5 + Int(Rnd * (planet(p).size / 3))
moon(p, m).kp = _RGB32(Int(200 + Rnd * 53), Int(200 + Rnd * 53), Int(200 + Rnd * 53))
moon(p, m).rate = ((5 / p) / _Pi) * (1 + Rnd * 3)
moon(p, m).ppos = Int(Rnd * 360)
Next m
End If
Next p
End If
Loop Until kk$ = Chr$(27)
_FreeImage stars&
Sub circleBF (cx As Long, cy As Long, r As Long, klr As _Unsigned Long)
rsqrd = r * r
y = -r
While y <= r
x = Sqr(rsqrd - y * y)
Line (cx - x, cy + y)-(cx + x, cy + y), klr, BF
y = y + 1
Wend
End Sub
Sub drawplanet (p)
x = planet(p).orbit * Sin(0.01745329 * planet(p).ppos)
y = planet(p).orbit * Cos(0.01745329 * planet(p).ppos)
x2 = (planet(p).orbit - planet(p).size / 2) * Sin(0.01745329 * planet(p).ppos)
y2 = (planet(p).orbit - planet(p).size / 2) * Cos(0.01745329 * planet(p).ppos)
x3 = (planet(p).orbit - planet(p).size / 3) * Sin(0.01745329 * planet(p).ppos)
y3 = (planet(p).orbit - planet(p).size / 3) * Cos(0.01745329 * planet(p).ppos)
pr = _Red(planet(p).kp)
pg = _Green(planet(p).kp)
pb = _Blue(planet(p).kp)
planet(p).ppos = planet(p).ppos + planet(p).rate
circleBF sunx + x, suny + y, planet(p).size, planet(p).kp
circleBF sunx + x2, suny + y2, planet(p).size / 2.5, _RGB32(pr * 1.1, pg * 1.1, pb * 1.05)
circleBF sunx + x3, suny + y3, planet(p).size / 4, _RGB32(pr * 1.2, pg * 1.2, pb * 1.1)
If mooncount(p) > 0 Then
For m = 1 To mooncount(p)
mx = moon(p, m).orbit * Sin(0.01745329 * moon(p, m).ppos)
my = moon(p, m).orbit * Cos(0.01745329 * moon(p, m).ppos)
circleBF sunx + x + mx, suny + y + my, moon(p, m).size, moon(p, m).kp
moon(p, m).ppos = moon(p, m).ppos + moon(p, m).rate
Next m
End If
End Sub
|
|
|
|
| Zoom_Circle |
|
Posted by: James D Jarvis - 10-06-2022, 03:21 AM - Forum: Programs
- Replies (4)
|
|
Zoom_Circle. A really simple program to get the angle on using angular headings control simple sprite movement.
Code: (Select All) 'Zoom Circle
'
'low end control example with angular navigation, dubious physics, and screenwrap
' w - accelerate
' s - decelerate
' a - turn to port
' d- tunr to starboard
'<esc> - end program
'
Screen _NewImage(800, 500, 32)
Dim Shared klr As _Unsigned Long
ppx = 400
ppy = 250
hdg = 90
hc = 0
mr = 0
fuel = 100000
tx = ppx + 3.5 * Sin(0.01745329 * hdg)
ty = ppy + 3.5 * Cos(0.01745329 * hdg)
Do
Cls
_Limit 30
Circle (ppx, ppy), 4, _RGB32(250, 250, 100) 'the zoom_circle saucer
Circle (tx, ty), 2, _RGB32(255, 255, 255) 'this nubbin is to show where the cricle is heading
ppx = ppx + mr * Sin(0.01745329 * hdg)
ppy = ppy + mr * Cos(0.01745329 * hdg)
kk$ = InKey$
Locate 1, 1: Print "Fuel : "; Int(fuel)
Locate 1, 20: Print "Velocity :"; Int(mr * 200)
_Display
Select Case kk$
Case "w"
If fuel > 0 Then
mr = mr + 0.05 * (100000 / fuel)
Circle (rrx, rry), 2, _RGB32(255, 255, 255)
fuel = fuel - 1
End If
Case "s"
If fuel > 0 Then
fuel = fuel - Sqr(mr / 0.05)
mr = mr - 0.05
If mr < 0 Then mr = 0
End If
Case "a"
If fuel > 0 Then
fuel = fuel - Sqr(Sqr(mr / 0.05))
hc = hc + 2
mr = mr * 0.995
End If
Case "d"
If fuel > 0 Then
fuel = fuel - Sqr(Sqr(mr / 0.05))
hc = hc - 2
mr = mr * .995
End If
End Select
hdg = hdg + hc
hc = hc * .75
If ppx < -4 Then ppx = 800
If ppx > 804 Then ppx = 0
If ppy < -4 Then ppy = 500
If ppy > 504 Then ppy = 0
tx = ppx + 3.5 * Sin(0.01745329 * hdg)
ty = ppy + 3.5 * Cos(0.01745329 * hdg)
Loop Until kk$ = Chr$(27)
|
|
|
|
| Request: Suggestion for IDE |
|
Posted by: TerryRitchie - 10-05-2022, 05:42 PM - Forum: General Discussion
- Replies (18)
|
 |
This may sound like a silly suggestion but it would be nice if the mouse pointer disappeared after a few seconds of inactivity. I can't count the number of times, just today, I've had to move the mouse pointer out of the way because it was blocking the code exactly where I was typing.
Any mouse movement would then again bring the mouse pointer back into view.
I know this sounds like a simple request but I've taken a peek from time to time at the QB64 source code. Those who maintain that code are saints in my view. If it's something fairly easy to add could a future revision include this? I understand if this would be placed low on the priority list or not even considered however.
Terry
|
|
|
|
| In the spirit of Terry's Tutorials - GUARDIAN Alien Space Ship Game |
|
Posted by: Pete - 10-04-2022, 08:29 PM - Forum: Works in Progress
- Replies (24)
|
 |
When I build a program, I do so by making subs that can often act independently. It's a very easy way to join things together for bigger project. It also makes debugging a whole lot easier.
So I thought, since Terry provides excellent tutorials for newbies to fast track coding, I would join in the spirit of that perspective and put up some little project which shows step-wise development.
Alien Space Ship is an ASCII -<>- that, for starters, that flies randomly throughout the screen. The code is adaptable to various screen sizes. I'll start with a single ship for now. I'll show how to make a married ship, later.
Stage 1)
Code: (Select All) DIM SHARED top, bottom, left, right
a = 120: b = 42
WIDTH a, b
_SCREENMOVE 0, 0
top = 3: bottom = _HEIGHT: left = 0: right = _WIDTH
msg$ = "Alien space ship movement demo."
LOCATE 1, (right - left) \ 2 - LEN(msg$) \ 2
PRINT msg$;
LOCATE 1, 2: PRINT STRING$(_WIDTH, "_");
DO
_LIMIT 30
alien_move
LOOP
SUB alien_move:
STATIC a_y, a_x, olda_y, olda_x, alien$, inertia, ran, ran_y, ran_x, oldran, z5
IF ABS(z5 - TIMER) > .1 THEN ' Time delay.
y_restore = CSRLIN: x_restore = POS(0) ' Restore column and row upon exit.
IF alien$ = "" THEN alien$ = "-<>-"
IF olda_y <> 0 AND olda_x <> 0 THEN
LOCATE olda_y, olda_x: PRINT SPACE$(LEN(alien$));
ELSE
a_y = (bottom - top) \ 2: a_x = (right - left) \ 2 ' Center sreen.
END IF
IF inertia = 0 THEN
inertia = INT(RND * (bottom - top) / 2) + 1 ' How many moves to go in any one direction.
ran = INT(RND * 8) + 1 ' Choose 1 of 8 possible directions.
IF ran = oldran THEN LOCATE y_restore, x_restore: EXIT SUB ' Just hover if direction was not changed.
SELECT CASE ran ' Get changes in column and row coordinates.
CASE 1: ran_y = -1: ran_x = 0
CASE 2: ran_y = -1: ran_x = 1
CASE 3: ran_y = 0: ran_x = 1
CASE 4: ran_y = 1: ran_x = 1
CASE 5: ran_y = 1: ran_x = 0
CASE 6: ran_y = 1: ran_x = -1
CASE 7: ran_y = 0: ran_x = -1
CASE 8: ran_y = -1: ran_x = -1
END SELECT
oldran = ran ' Remember last direction.
ELSE
inertia = inertia - 1 ' Count down the number of moves in any one direction. When zero, switch direction.
END IF
a_y = a_y + ran_y: a_x = a_x + ran_x * 2 ' Next move coordinates. I use * 2 for horizontal movement to match the 16x8 pixel height over width factor.
IF a_y < top OR a_y > bottom OR a_x <= left OR a_x + LEN(alien$) > right THEN
olda_x = 0: olda_y = 0: inertia = 0: oldran = 0 ' Out of bounds and off the screen.
ELSE
LOCATE a_y, a_x: PRINT alien$; ' Move alien ship.
olda_y = a_y: olda_x = a_x ' Remember these coordinates to erase ship on next loop.
END IF
z5 = TIMER
LOCATE y_restore, x_restore ' Restore entry column and row positions.
END IF
END SUB
The next stage will demonstrate a way to start a ship on the screen from the left or right side, determined by initial right or left direction, at a somewhat random vertical starting point. Hey, if you develop a shooter game, it's not much of a challenge if you know in advance where the enemy vessel will appear.
Pete out.
|
|
|
|
| Fishing anyone? |
|
Posted by: bplus - 10-04-2022, 01:05 AM - Forum: Programs
- Replies (10)
|
|
Look what I found, anyone up for some fishing?
Code: (Select All) Option _Explicit
_Title " Fish: press m for more, l for less" 'b+ 2021-12-03
Const sw = 1024, sh = 700, LHead$ = "<*", LBody$ = ")", LTail$ = "<{", RHead$ = "*>", RBody$ = "(", RTail$ = "}<"
Type fish
As Integer LFish, X, Y, DX
As String fish
As _Unsigned Long Colr
End Type
Screen _NewImage(sw, sh, 32)
_ScreenMove 180, 40
_FullScreen ' <<<<<<<<<<<<<<< goto full screen once you know instructions for more and less fish
Color _RGB32(220), _RGB32(0, 0, 60)
Cls
_PrintMode _KeepBackground
Dim As Integer i, nFish
Dim k$
nFish = 20
restart:
ReDim Shared school(1 To nFish) As fish, kelp(sw, sh) As _Unsigned Long
growKelp
For i = 1 To nFish
NewFish i, -1
Next
Do
Cls
k$ = InKey$
If k$ = "m" Then ' more fish
nFish = nFish * 2
If nFish > 300 Then Beep: nFish = 300
GoTo restart
End If
If k$ = "l" Then ' less fish
nFish = nFish / 2
If nFish < 4 Then Beep: nFish = 4
GoTo restart
End If
For i = 1 To nFish ' draw fish behind kelp
If _Red32(school(i).Colr) < 160 Then
Color school(i).Colr
_PrintString (school(i).X, school(i).Y), school(i).fish 'draw fish
school(i).X = school(i).X + school(i).DX
If school(i).LFish Then
If school(i).X + Len(school(i).fish) * 8 < 0 Then NewFish i, 0
Else
If school(i).X - Len(school(i).fish) * 8 > _Width Then NewFish i, 0
End If
End If
Next
showKelp
For i = 1 To nFish ' draw fish in from of kelp
If _Red32(school(i).Colr) >= 160 Then
Color school(i).Colr
_PrintString (school(i).X, school(i).Y), school(i).fish 'draw fish
school(i).X = school(i).X + school(i).DX
If school(i).LFish Then
If school(i).X + Len(school(i).fish) * 8 < 0 Then NewFish i, 0
Else
If school(i).X - Len(school(i).fish) * 8 > _Width Then NewFish i, 0
End If
End If
Next
_Display
_Limit 10
Loop Until _KeyDown(27)
Sub NewFish (i, initTF)
Dim gray
gray = Rnd * 200 + 55
school(i).Colr = _RGB32(gray) ' color
If Rnd > .5 Then
school(i).LFish = -1
school(i).fish = LHead$ + String$(Int(Rnd * 5) + -2 * (gray > 160) + 1, LBody$) + LTail$
Else
school(i).LFish = 0
school(i).fish = RTail$ + String$(Int(Rnd * 5) + -2 * (gray > 160) + 1, RBody$) + RHead$
End If
If initTF Then
school(i).X = _Width * Rnd
Else
If school(i).LFish Then school(i).X = _Width + Rnd * 35 Else school(i).X = -35 * Rnd - Len(school(i).fish) * 8
End If
If gray > 160 Then
If school(i).LFish Then school(i).DX = -18 * Rnd - 3 Else school(i).DX = 18 * Rnd + 3
Else
If school(i).LFish Then school(i).DX = -6 * Rnd - 1 Else school(i).DX = 6 * Rnd + 1
End If
school(i).Y = _Height * Rnd
End Sub
Sub growKelp
Dim kelps, x, y, r
ReDim kelp(sw, sh) As _Unsigned Long
kelps = Int(Rnd * 20) + 20
For x = 1 To kelps
kelp(Int(Rnd * sw / 8), (sh - 16) / 16) = _RGB32(0, Rnd * 128, 0)
Next
For y = sh / 16 To 0 Step -1
For x = 0 To sw / 8
If kelp(x, y + 1) Then
r = Int(Rnd * 23) + 1
Select Case r
Case 1, 2, 3, 18 '1 branch node
If x - 1 >= 0 Then kelp(x - 1, y) = kelp(x, y + 1)
Case 4, 5, 6, 7, 8, 9, 21 '1 branch node
kelp(x, y) = kelp(x, y + 1)
Case 10, 11, 12, 20 '1 branch node
If x + 1 <= sw Then kelp(x + 1, y) = kelp(x, y + 1)
Case 13, 14, 15, 16, 17, 19 '2 branch node
If x - 1 >= 0 Then kelp(x - 1, y) = kelp(x, y + 1)
If x + 1 <= sw Then kelp(x + 1, y) = kelp(x, y + 1)
End Select
End If
Next
Next
End Sub
Sub showKelp
Dim y, x
For y = 0 To sh / 16
For x = 0 To sw / 8
If kelp(x, y) Then
Color kelp(x, y)
_PrintString (x * 8, y * 16), Mid$("kelp", Int(Rnd * 4) + 1, 1)
End If
Next
Next
End Sub
Nice underwater effect with kelp.
|
|
|
|
| Steve's QB64 tutorials collection |
|
Posted by: vince - 10-04-2022, 12:39 AM - Forum: General Discussion
- Replies (3)
|
 |
does anyone have the complete collection of Steve style run-in-qb64-slideshow tutorials? I believe there was one on data types, floating point, and colors. Here's one I happened to have saved:
Code: (Select All) Screen _NewImage(640, 640, 32)
_Title "Number Types and Colors"
Print "Welcome to Steve's Qucik Lesson on Number Types and Colors."
Print
Print "The most important thing to keep in mind in this lesson is that we're going to be talking exclusively about 32-bit color values here. For all other screen modes, this lesson holds much less importance."
Print
Print "Press <ANY KEY> to begin!"
Sleep
Cls , 0
Print "First, let's talk about how SINGLE variable types work (or DON'T work), in regards to 32-bit colors."
Print
Print "Let's choose a nice color and use it to draw a box on the screen."
Print "How about we choose a BLUE box? _RGB32(0, 0, 255)"
Print
Line (50, 90)-(250, 250), _RGB32(0, 0, 255), BF
Locate 18, 1: Print "Looks like a nice BLUE box. Right?"
Print "Press <ANY KEY> to continue!"
Sleep
Cls , 0
Print "Now, let's store that BLUE value inside a SINGLE tyoe variable."
Print "BLUE = _RGB32(0, 0, 255)"
Print ""
Print "Once we've did that, let's draw the exact same box on the screen again with the variable."
BLUE = _RGB32(0, 0, 256)
Line (50, 90)-(250, 250), BLUE, BF
Locate 18, 1: Print "Looks like a nice BLUE box. Right?"
Print "Press <ANY KEY> to continue!"
Sleep
Cls , 0
Print "What do you guys mean, 'What box?'??"
Print "Do you mean to tell me you nice folks DIDN'T see a pretty BLUE box on the last screen??"
Print
Print
Print "Just what the hell happened to it?!!"
Print
Print
Print "For the answer to that, let's print out two values to the screen:"
Print "BLUE = "; BLUE
Print "_RGB32(0, 0, 255) = "; _RGB32(0, 0, 255)
Print
Print "At first glance, those APPEAR to be the same numbers, but let's expand the scientific notation fully:"
Blue&& = BLUE
Print "BLUE = "; Blue&&
Print "_RGB32(0, 0, 255) = "; _RGB32(0, 0, 255)
Print
Print "Press <ANY KEY> to continue!"
Sleep
Cls , 0
Print "HOLY COW, BATMAN!! Was those two numbers DIFFERENT?!!"
Print "BLUE = "; Blue&&; "vs"; _RGB32(0, 0, 255)
Print
Print "Well... They're only a LITTLE different... Right?"
Print "I mean, how bad can one little number difference be? Right??"
Print
Print "For the answer to that, let's look at the HEX values of those numbers:"
Print "BLUE = "; Hex$(Blue&&)
Print "_RGB32(0, 0, 255) - "; Hex$(_RGB32(0, 0, 255))
Print
Print "And to help understand what we're seeing in HEX, break those values down into groups of 2 in your mind."
Print "(I'm too lazy to do it for you..)"
Print "The first two values are ALPHA, followed by RED, followed by GREEN, followed by BLUE."
Print
Print "So BLUE = FF alpha, 00 red 01 green, 00 blue"
Print "_RGB32(0, 0, 0) = FF alpha, 00 red, 00 green, FF blue"
Print
Print "And keep in mine that FF is HEX for the decimal value of 255."
Print
Print "Press <ANY KEY> to continue!"
Sleep
Cls , 0
Print "Since SINGLE values lose precision after numbers get so large, our variable BLUE"
Print "has to round to the nearest scientific notation point and try for the closest"
Print "possible match."
Print
Print "And even though "; Blue&&; " is only one number off from "; _RGB32(0, 0, 255); ","
Print "that number still greatly changes the color value."
Print
Print "It changes it from FF 00 00 FF (255 alpha, 0 red, 0 green, 255 blue) to"
Print "FF 00 01 00 (255 alpha, 0 red, 1 green, 0 blue)."
Print
Print "Our BLUE has become a GREEN, simply by using a SINGLE variable type!!"
Print "(And, it's such a low shade green, my poor eyes can't make it out at all."
Print "To me, the damn 'green box' was just as black as my black screen."
Print "I didn't see it at all!)"
Print "Press <ANY KEY> to continue!"
Sleep
Cls , 0
Print "So, at this point, I think it should be obvious WHY we don't want to store"
Print "color values inside SINGLE variables."
Print
Print "But what about using a normal LONG to hold the values??"
Print
Print "Let's look and see!"
Print
Print "For this, let's draw our box again:"
Line (50, 150)-(250, 250), _RGB32(0, 0, 255), BF
Locate 18, 1: Print "Looks like a nice BLUE box. Right?"
Print
Print "But let's get the POINT value from that box, and store it in a LONG variable."
BLUE& = Point(100, 200)
Print "BLUE& = "; BLUE&
p&& = Point(100, 200)
Print "POINT(100, 200) = "; Point(100, 200)
Print
Print
Print "Again, we're looking at two numbers that don't match!"
Print
Print "FOR THE LOVE OF GOD, WHYYYY??!!!!"
Print "Press <ANY KEY> to continue!"
Sleep
Cls , 0
Print BLUE&; "<>"; p&&
Print
Print "Why are those two numbers so different??"
Print
Print "For that answer, let's look at their HEX values again:"
Print "BLUE& = "; Hex$(BLUE&)
Print "POINT(100, 200) = "; Hex$(p&&)
Print
Print "."
Print "..."
Print "......"
Print
Print "WHAT THE HEX?? Those two values are EXACTLY the same??"
Print
Print "They are. It's just that one of them is stored as a SIGNED LONG, while the other is an UNSIGNED LONG."
Print
Print "HEX wise, they're the same value..."
Print
Print "BUT, can you see where the two numbers might not match if we use them in an IF statement?"
Print
Print "IF "; BLUE&; "="; p&&; "THEN...."
Print
Print "Ummm... That might not work as intended!"
Print
Print "Press <ANY KEY> to continue!"
Sleep
Cls , 0
Print "Even thought the HEX values for "; BLUE&; "and"; p&&;
Print "are EXACTLY the same, the values themselves are quite different."
Print
Print "A LONG will, indeed, hold the proper value for a 32-bit color, as it stores"
Print "all four HEX values properly for us."
Print
Print "As long as our program uses NOTHING but LONG values, you'll never have a"
Print "problem with using LONG as a variable type..."
Print
Print "BUT...."
Print
Print "The moment you start to compare LONG values directly against POINT values,"
Print "your program is going to run into serious issues!"
Print
Print "Because at the end of the day,"; BLUE&; "is not the same as "; p&&
Print
Print
Print "Press <ANY KEY> to continue!"
Sleep
Cls , 0
Print "So, with all those examples, and all that said, let's answer"
Print "the most important question:"
Print
Print "'What TYPE works best for 32-bit colors??"
Print
Print
Print "DOUBLE, _FLOAT, _UNSIGNED LONG, _INTEGER64, _UNSIGNED _INTEGER64"
Print
Print "Of all the types which QB64 offers, only the above are TRULY viable"
Print "to hold a 32-bit color value."
Print
Print "Any type not listed above is going to be problematic at one time or"
Print "another for us!"
Print
Print "And of those suitable types, I personally prefer to keep integer values"
Print "as integers, so I recommend: _UNSIGNED LONG or _INTEGER64."
Print
Print
Print "Press <ANY KEY> to continue!"
Sleep
Cls , 0
Print "And WHY _UNSIGNED LONG??"
Print
Print "Simply because it's only 4 bytes of memory (the minimal we can possibly use for"
Print "32-bit color values), and it's what QB64 uses internally with POINT and such."
Print
Print
Print "So, if _UNSIGNED LONG works so well, WHY would I *ever* use _INTEGER64??"
Print
Print "Becauses sometimes I like to code command values into my colors."
Print "(Such as: NoColor = -1)"
Print
Print "_UNSIGNED LONG *only* holds the values for the colors themselves."
Print "EVERY number from 0 to FFFFFFFF is accounted for as part of our color spectrum."
Print
Print "If I need *special* or unique values for my program, I usually just use _INTEGER64s"
Print "for my variable types and then I can assign negative numbers for those unique values."
Print
Print
Print "Press <ANY KEY> to continue!"
Sleep
Cls , 0
Print "At the end of the day though, when all is said and done, you're still the"
Print "one responsible for your own code!"
Print
Print "Use whichever type works for you, and works best for your needs."
Print
Print "Just keep in mind: Various TYPEs come with various limitations on your code."
Print
Print "_BYTE, INTEGER, (both signed and unsigned) are insane to use..."
Print "SINLGE loses precision. Expect to lose whole shades of blue...."
Print "LONG may cause issues with POINT, if compared directly...."
Print "_UNSIGNED LONG works fine, any ONLY stores 32-bit color values...."
Print "_INTEGER64 works fine, and can store extra values if necessary...."
Print "DOUBLE and _FLOAT both work, but are floating point values...."
Print
Print
Print "And with all that said and summed up, it's now up to YOU guys to decide what"
Print "works best in your own programs."
Print
Print
Print "As I said, I personally recommend _UNSIGNED LONG or _INTEGER64 in special cases."
Print "But the choice, and the debugging, is entirely up to YOU. :D"
|
|
|
|
|
