05-14-2022, 03:54 PM
Fixes for Linux (the font file is still in zip)
Air Hockey Dark Theme:
And Air Hockey 2-1
Air Hockey Dark Theme:
Code: (Select All)
Option _Explicit
'Air Hockey v2-1.bas for QB64
' Started in QB64 Walter fork version (B+=MGA) 2017-09-05
' The first version was a direct translation from SmallBASIC,
' Now v2.0 add some more graphic image handling, try new things.
' 2020-03-11 v2-1 (QB64 v1.4 now) cleanup some code:
' Fix _MOUSEINPUT block too newbie ;)
' Fix flat spots on strikers how long have they been there?
' Increase frames per sec and slow puck speed for less double images.
' Oh that sped up the AI player! Nice.
' Do start shots to the side instead of directly at goal. MUCH BETTER!
' Update opening screen with this info. Now pause the puck at start.
' Ran OPTION _EXPLICIT and found a type-O that has been 0 all this time!
' v2020-03-23 Dark Theme as suggested by Danlin also fix fill circle with color
' also lighten color around the puck, oh fix the rest of the _rgb to rgb32.
' 2022-05-14 fixes for Linux
Randomize Timer
Const xmax = 1200, ymax = 690 'screen dimensions
Screen _NewImage(xmax, ymax, 32)
_Title "Air Hockey v2020-03-23 Dark Theme"
_ScreenMove 90, 0
Const pr = 16 ' puck radius
Const pr2 = 2 * pr ' puck diameter = bumper width = radius of strikers
Const tl = xmax ' table length
Const tw = tl / 2 ' table width
Const tw13 = .3333 * tw \ 1 'goal end point
Const tw23 = .6667 * tw \ 1 'goal end point
Const speed = 15 ' puck speed also see _limit in main loop
Const midC = 316 ' (tl - 2 * pr2) \ 4 + pr2 'mid line of computer's sin field
Const rangeC = 252 ' 316 - 252 = 64 (bumper + pr2) 316 + 252 = 568 (mid screen - pr2)
Common Shared f&, table&, computer, player, s$, tx, px, py, pa, psx, psy, c1, csx, csy, strkr&
f& = _LoadFont("arial.ttf", 25) ' arial normal style if you have windows
_Font f& ' arial is pretty common if you don't have Windows
table& = _NewImage(xmax, tw, 32)
_Dest table&
drawTable
strkr& = _NewImage(2 * pr2 + 1, 2 * pr2 + 1, 32) ' more space to avoid right and bottom flat edges
_Dest strkr&
striker pr2, pr2
_Dest 0 ' Opening screen
cp 7, "Air Hockey, first to score 21 goals wins!"
cp 9, "Player you will be defending the goal on the right (a black slot)."
cp 10, "Your goal is on the left, defended by the computer."
cp 12, "The puck will be started going up and down in the middle of"
cp 13, "the screen at slight angle towards a randomly selected goal."
cp 16, "Press any when ready..."
Sleep
_Delay 1
_MouseHide
Cls
updateScore
_PutImage (0, 0), table&, 0
drawComputerStriker
While _MouseInput: Wend
psx = _MouseX: psy = _MouseY
drawPlayerStriker
initball
While player < 21 And computer < 21 ' play until someone scores 21
Cls
updateScore
_PutImage (0, 0), table&, 0
drawComputerStriker
While _MouseInput: Wend
psx = _MouseX: psy = _MouseY
drawPlayerStriker
drawPuck
_Display
_Limit 60 '<<<<<<<<<<<<< slow down, speeed up as needed for good game
Wend
If computer > player Then ' last report
s$ = "Game Won by Computer."
tx = 450
Else
s$ = "Game Won by Player!"
tx = 470
End If
Color _RGB32(200, 240, 140)
_PrintString (tx, tw + 30), s$
_Display
_Delay 3
Sub initball 'toss puck out to side slightly angled to one goal or the other
Dim pao
px = tl / 2: py = tw / 2: pao = _Pi(1 / 10) * Rnd
puck px, py
_Display
_Delay .3
If Rnd < .5 Then pa = _Pi(.5) Else pa = _Pi(1.5)
If Rnd < .5 Then pa = pa + pao Else pa = pa - pao
End Sub
Sub updateScore
Color _RGB32(40, 255, 255)
s$ = "Computer: " + Str$(computer) + Space$(67) + "Player: " + Str$(player)
_PrintString (200, tw + 30), s$
End Sub
Sub drawTable
Dim i, shade
For i = 0 To pr2 Step 4
shade = 64 + i / pr2 * 100
Color _RGB32(shade, shade, shade)
Line (i, i)-(tl - i, tw - i), , BF
Next
Line (pr2, pr2)-(tl - pr2, tw - pr2), _RGB32(190, 230, 255), BF 'field
Line (pr2, pr2)-(tl - pr2, tw - pr2), _RGB32(50, 0, 50), BF 'field
Line (pr, tw13)-(pr2, tw23), _RGB32(60, 60, 60), BF
Line (tl - pr2, tw13)-(tl - pr, tw23), _RGB32(60, 60, 60), BF
Line (tl \ 2 - 1, pr2)-(tl \ 2 + 1, tw - pr2), _RGB32(128, 128, 128), BF
End Sub
Sub drawPlayerStriker
If psx - pr2 < tl / 2 Then psx = tl / 2 + pr2
If psx + pr2 > tl - pr2 Then psx = tl - 2 * pr2
If psy - pr2 < pr2 Then psy = 2 * pr2
If psy + pr2 > tw - pr2 Then psy = tw - 2 * pr2
_PutImage (psx - pr2, psy - pr2), strkr&, 0
End Sub
Sub drawComputerStriker
c1 = c1 + _Pi(1 / 80)
csx = midC + rangeC * Sin(c1)
If px > csx Then csy = py + pr2 * 1.5 * Sin(c1)
If csy - pr2 < pr2 Then csy = 2 * pr2
If csy + pr2 > tw - pr2 Then csy = tw - 2 * pr2
_PutImage (csx - pr2, csy - pr2), strkr&, 0
End Sub
Sub drawPuck
'update ball x, y and see if hit anything
Dim i, shade
px = px + speed * Cos(pa)
py = py + speed * Sin(pa)
If px - pr < pr2 Then
If tw13 < py - pr And py + pr < tw23 Then 'through computer slot, player scores
player = player + 1
Cls
updateScore
drawTable
striker csx, csy
striker psx, psy
puck pr, py
For i = 0 To pr Step 4
shade = 64 + i / pr2 * 100
Color _RGB32(shade, shade, shade)
Line (i, tw13)-(pr, tw23), , BF ' wow tw13 has been 0
Next
snd 1200, 200
snd 2200, 300
_Display
initball
_Delay .5
Exit Sub
Else
snd 2600, 8
pa = _Pi(1) - pa
px = pr2 + pr
End If
End If
If px + pr > tl - pr2 Then
If tw13 < py - pr And py + pr < tw23 Then
computer = computer + 1
Cls
updateScore
drawTable
striker csx, csy
striker psx, psy
puck tl - pr, py
For i = 0 To pr Step 4
shade = 64 + i / pr2 * 100
Color _RGB32(shade, shade, shade)
Line (tl - pr, tw13)-(tl - i, tw23), , BF 't13 again!
Next
snd 2200, 300
snd 1200, 200
_Display
initball
_Delay .5
Exit Sub
Else
snd 2600, 5
pa = _Pi(1) - pa
px = tl - pr2 - pr
End If
End If
If py - pr < pr2 Then ' hit top boundry
snd 2600, 8
pa = -pa
py = pr2 + pr
End If
If py + pr > tw - pr2 Then ' hit bottom boundry
snd 2600, 8
pa = -pa
py = tw - pr2 - pr
End If
If Sqr((px - psx) ^ 2 + (py - psy) ^ 2) < (pr + pr2) Then 'contact player striker
pa = _Atan2(py - psy, px - psx)
'boost puck away
px = px + .5 * speed * Cos(pa)
py = py + .5 * speed * Sin(pa)
snd 2200, 4
End If
If Sqr((px - csx) ^ 2 + (py - csy) ^ 2) < (pr + pr2) Then 'contact computer striker
pa = _Atan2(py - csy, px - csx)
'boost puck away
px = px + .5 * speed * Cos(pa)
py = py + .5 * speed * Sin(pa)
snd 2200, 4
End If
puck px, py ' here it is!
End Sub
Sub puck (x, y)
fillcirc x, y, pr, _RGB32(160, 160, 160)
fillcirc x, y, pr - 4, _RGB32(190, 100, 0)
End Sub
Sub striker (x, y)
Dim i, shade
For i = pr2 To pr Step -1
shade = 164 - 90 * Sin(i * _Pi(2) / pr)
fillcirc x, y, i, _RGB32(shade, shade, shade)
Next
For i = pr To 0 Step -1
shade = 185 + 70 * (pr - i) / pr
fillcirc x, y, i, _RGB32(shade, shade, shade)
Next
End Sub
'Steve McNeil's copied from his forum note: Radius is too common a name
Sub fillcirc (CX As Long, CY As Long, R As Long, C As _Unsigned 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), C: 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), C, 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), C, BF
Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
End If
X = X - 1
RadiusError = RadiusError - X * 2
End If
Y = Y + 1
Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
Wend
End Sub
Sub snd (frq, dur)
Sound frq / 2.2, dur * .01
End Sub
Sub cp (lineNum, s$)
Dim x, y
'1200 pixels / 85 characters = 14.11 pixels/char wide
'700 pixels / 28 lines = 18.42 pixels / char high
x = (xmax - 11 * Len(s$)) \ 2
y = lineNum * 25
_PrintString (x, y), s$
End SubAnd Air Hockey 2-1
Code: (Select All)
Option _Explicit
'Air Hockey v2-1.bas for QB64
' Started in QB64 Walter fork version (B+=MGA) 2017-09-05
' The first version was a direct translation from SmallBASIC,
' Now v2.0 add some more graphic image handling, try new things.
' 2020-03-11 v2-1 (QB64 v1.4 now) cleanup some code:
' Fix _MOUSEINPUT block too newbie ;)
' Fix flat spots on strikers how long have they been there?
' Increase frames per sec and slow puck speed for less double images.
' Oh that sped up the AI player! Nice.
' Do start shots to the side instead of directly at goal. MUCH BETTER!
' Update opening screen with this info. Now pause the puck at start.
' Ran OPTION _EXPLICIT and found a type-O that has been 0 all this time!
' 2022-05-14 fixes for Linux
Randomize Timer
Const xmax = 1200, ymax = 690 'screen dimensions
Screen _NewImage(xmax, ymax, 32)
_Title "Air Hockey 2-1"
_ScreenMove 90, 0
Const pr = 16 ' puck radius
Const pr2 = 2 * pr ' puck diameter = bumper width = radius of strikers
Const tl = xmax ' table length
Const tw = tl / 2 ' table width
Const tw13 = .3333 * tw \ 1 'goal end point
Const tw23 = .6667 * tw \ 1 'goal end point
Const speed = 15 ' puck speed also see _limit in main loop
Const midC = 316 ' (tl - 2 * pr2) \ 4 + pr2 'mid line of computer's sin field
Const rangeC = 252 ' 316 - 252 = 64 (bumper + pr2) 316 + 252 = 568 (mid screen - pr2)
Common Shared f&, table&, computer, player, s$, tx, px, py, pa, psx, psy, c1, csx, csy, strkr&
f& = _LoadFont("arial.ttf", 25) ' arial normal style if you have windows
_Font f& ' arial is pretty common if you don't have Windows
table& = _NewImage(xmax, tw, 32)
_Dest table&
drawTable
strkr& = _NewImage(2 * pr2 + 1, 2 * pr2 + 1, 32) ' more space to avoid right and bottom flat edges
_Dest strkr&
striker pr2, pr2
_Dest 0 ' Opening screen
cp 7, "Air Hockey, first to score 21 goals wins!"
cp 9, "Player you will be defending the goal on the right (a black slot)."
cp 10, "Your goal is on the left, defended by the computer."
cp 12, "The puck will be started going up and down in the middle of"
cp 13, "the screen at slight angle towards a randomly selected goal."
cp 16, "Press any when ready..."
Sleep
_Delay 1
Cls
updateScore
_PutImage (0, 0), table&, 0
drawComputerStriker
While _MouseInput: Wend
psx = _MouseX: psy = _MouseY
drawPlayerStriker
initball
While player < 21 And computer < 21 ' play until someone scores 21
Cls
updateScore
_PutImage (0, 0), table&, 0
drawComputerStriker
While _MouseInput: Wend
psx = _MouseX: psy = _MouseY
drawPlayerStriker
drawPuck
_Display
_Limit 60 '<<<<<<<<<<<<< slow down, speeed up as needed for good game
Wend
If computer > player Then ' last report
s$ = "Game Won by Computer."
tx = 450
Else
s$ = "Game Won by Player!"
tx = 470
End If
Color _RGB(200, 240, 140)
_PrintString (tx, tw + 30), s$
_Display
_Delay 3
Sub initball 'toss puck out to side slightly angled to one goal or the other
Dim pao
px = tl / 2: py = tw / 2: pao = _Pi(1 / 10) * Rnd
puck px, py
_Display
_Delay .3
If Rnd < .5 Then pa = _Pi(.5) Else pa = _Pi(1.5)
If Rnd < .5 Then pa = pa + pao Else pa = pa - pao
End Sub
Sub updateScore
Color _RGB(40, 255, 255)
s$ = "Computer: " + Str$(computer) + Space$(67) + "Player: " + Str$(player)
_PrintString (200, tw + 30), s$
End Sub
Sub drawTable
Dim i, shade
For i = 0 To pr2 Step 4
shade = 64 + i / pr2 * 100
Color _RGB(shade, shade, shade)
Line (i, i)-(tl - i, tw - i), , BF
Next
Line (pr2, pr2)-(tl - pr2, tw - pr2), _RGB(190, 230, 255), BF 'field
Line (pr, tw13)-(pr2, tw23), _RGB(60, 60, 60), BF
Line (tl - pr2, tw13)-(tl - pr, tw23), _RGB(60, 60, 60), BF
Line (tl \ 2 - 1, pr2)-(tl \ 2 + 1, tw - pr2), _RGB(128, 128, 128), BF
End Sub
Sub drawPlayerStriker
If psx - pr2 < tl / 2 Then psx = tl / 2 + pr2
If psx + pr2 > tl - pr2 Then psx = tl - 2 * pr2
If psy - pr2 < pr2 Then psy = 2 * pr2
If psy + pr2 > tw - pr2 Then psy = tw - 2 * pr2
_PutImage (psx - pr2, psy - pr2), strkr&, 0
End Sub
Sub drawComputerStriker
c1 = c1 + _Pi(1 / 80)
csx = midC + rangeC * Sin(c1)
If px > csx Then csy = py + pr2 * 1.5 * Sin(c1)
If csy - pr2 < pr2 Then csy = 2 * pr2
If csy + pr2 > tw - pr2 Then csy = tw - 2 * pr2
_PutImage (csx - pr2, csy - pr2), strkr&, 0
End Sub
Sub drawPuck
'update ball x, y and see if hit anything
Dim i, shade
px = px + speed * Cos(pa)
py = py + speed * Sin(pa)
If px - pr < pr2 Then
If tw13 < py - pr And py + pr < tw23 Then 'through computer slot, player scores
player = player + 1
Cls
updateScore
drawTable
striker csx, csy
striker psx, psy
puck pr, py
For i = 0 To pr Step 4
shade = 64 + i / pr2 * 100
Color _RGB(shade, shade, shade)
Line (i, tw13)-(pr, tw23), , BF ' wow tw13 has been 0
Next
snd 1200, 200
snd 2200, 300
_Display
initball
_Delay .5
Exit Sub
Else
snd 2600, 8
pa = _Pi(1) - pa
px = pr2 + pr
End If
End If
If px + pr > tl - pr2 Then
If tw13 < py - pr And py + pr < tw23 Then
computer = computer + 1
Cls
updateScore
drawTable
striker csx, csy
striker psx, psy
puck tl - pr, py
For i = 0 To pr Step 4
shade = 64 + i / pr2 * 100
Color _RGB(shade, shade, shade)
Line (tl - pr, tw13)-(tl - i, tw23), , BF 't13 again!
Next
snd 2200, 300
snd 1200, 200
_Display
initball
_Delay .5
Exit Sub
Else
snd 2600, 5
pa = _Pi(1) - pa
px = tl - pr2 - pr
End If
End If
If py - pr < pr2 Then ' hit top boundry
snd 2600, 8
pa = -pa
py = pr2 + pr
End If
If py + pr > tw - pr2 Then ' hit bottom boundry
snd 2600, 8
pa = -pa
py = tw - pr2 - pr
End If
If Sqr((px - psx) ^ 2 + (py - psy) ^ 2) < (pr + pr2) Then 'contact player striker
pa = _Atan2(py - psy, px - psx)
'boost puck away
px = px + .5 * speed * Cos(pa)
py = py + .5 * speed * Sin(pa)
snd 2200, 4
End If
If Sqr((px - csx) ^ 2 + (py - csy) ^ 2) < (pr + pr2) Then 'contact computer striker
pa = _Atan2(py - csy, px - csx)
'boost puck away
px = px + .5 * speed * Cos(pa)
py = py + .5 * speed * Sin(pa)
snd 2200, 4
End If
puck px, py ' here it is!
End Sub
Sub puck (x, y)
Color _RGB(90, 90, 90)
fillcirc x, y, pr
Color _RGB(190, 100, 0)
fillcirc x, y, pr - 4
End Sub
Sub striker (x, y)
Dim i, shade
For i = pr2 To pr Step -1
shade = 164 - 90 * Sin(i * _Pi(2) / pr)
Color _RGB(shade, shade, shade)
fillcirc x, y, i
Next
For i = pr To 0 Step -1
shade = 185 + 70 * (pr - i) / pr
Color _RGB(shade, shade, shade)
fillcirc x, y, i
Next
End Sub
'Steve McNeil's copied from his forum note: Radius is too common a name
Sub fillcirc (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 snd (frq, dur)
Sound frq / 2.2, dur * .01
End Sub
Sub cp (lineNum, s$)
Dim x, y
'1200 pixels / 85 characters = 14.11 pixels/char wide
'700 pixels / 28 lines = 18.42 pixels / char high
x = (xmax - 11 * Len(s$)) \ 2
y = lineNum * 25
_PrintString (x, y), s$
End Sub
b = b + ...