+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://qb64phoenix.com/forum/forumdisplay.php?fid=3)
+---- Forum: Programs (https://qb64phoenix.com/forum/forumdisplay.php?fid=7)
+---- Thread: Pinball Molly (/showthread.php?tid=3231)
Pages:
1
2
Pinball Molly - bplus - 11-26-2024
Got a complete version up and running nice.
My highest score so far:
The souce and 3 .wav files:
RE: Pinball Molly - Pete - 11-26-2024
Coincidence, or was it actually based on that big-ASCII grinning emoji I'm so overly fond of?
Pete
RE: Pinball Molly - bplus - 11-27-2024
Oh an obvious improvement to Molly!
Code: (Select All)
Option _Explicit
_Title "Pinball Molly v 1-1: left ctrl for left flipper, right ctrl for right" 'b+ 2024-11-16
' Thanks to Rod Bird at JB Forum for inspiring this Pinball Game with his from which
' I used sound effects.
' 2024-11-23 moved Weird Filpper code into here and dumped previous code I had.
' 2024-11-24 dont let bs go below zero better yet below gravity.
' Moved baseX of flippers closer to walls so ball isn't stuck in the corner.
' Increased power down line of flipper contact from i/200 to i/50 because
' gravity was increased to roll ball down flipper faster from dead stop.
' More deadening of bs when hitting walls or flippers not moving.
' 2024-11-25 now add a Circle Board BackGround numbers tweaked a bit
' 2024-11-26 add kickers now, tweak add bonus rounds I name it Molly v1.0
' 2024-11-27 mouth score v1.1
Const XMax = 740, YMax = 740
Const ScR = 370, Gravity = .5
Type FlipperType
As Single baseX, baseY ' DrawFlipper needs these
As Single tipX, tipY ' need to track collisions on ends of flipper
As Single UpA, DownA, CurA
As Long LeftFlipTF, TargetUpTF ' true false boolean
End Type
Type CircleType
As Single x, y, r
End Type
Dim As FlipperType leftFlip, rightFlip
' some parts of Type are constant declare now
leftFlip.LeftFlipTF = -1
leftFlip.baseX = ScR - 300
leftFlip.baseY = YMax - 140
leftFlip.UpA = -_Pi(1 / 6) ' 315 degrees NE
leftFlip.DownA = _Pi(1 / 6)
leftFlip.TargetUpTF = 0 ' test a key press OK
leftFlip.CurA = leftFlip.DownA ' flipper at rest in down position
rightFlip.LeftFlipTF = 0
rightFlip.baseX = ScR + 300
rightFlip.baseY = YMax - 140
rightFlip.UpA = _Pi(7 / 6) ' 180 + 45 = 225 degrees NE
rightFlip.DownA = _Pi(5 / 6)
rightFlip.TargetUpTF = 0 ' flipper at rest in down position
rightFlip.CurA = rightFlip.DownA
Dim Shared FLen, BaseR, TipR ' finish flipper setup
FLen = 250: BaseR = 30: TipR = 12
Dim Shared LFC(FLen) As CircleType, RFC(FLen) As CircleType
SetFlipperRadii
Dim bx, by, br, bs, ba, bdx, bdy ' ball stuff
Dim lffirstI, lflastI, rffirsti, rflasti ' ball collision flipper stuff
Dim As Long i, score, bell, fall, balls, bonus, f
Dim k$, s$
Dim Shared As CircleType k(2)
k(0).x = ScR: k(0).y = .5 * YMax + 25: k(0).r = 30
k(1).x = .33 * XMax: k(1).y = .25 * YMax + 25: k(1).r = 30
k(2).x = .67 * XMax: k(2).y = .25 * YMax + 25: k(2).r = 30
Dim Shared As CircleType plus(7)
For i = 0 To 7
plus(i).x = ScR + (ScR - 50) * Cos(i * _Pi(1 / 6) + _Pi(11 / 12))
plus(i).y = ScR + (ScR - 50) * Sin(i * _Pi(1 / 6) + _Pi(11 / 12))
plus(i).r = 20
Next
Screen _NewImage(XMax, YMax, 32): _ScreenMove 320, 0
bell = _SndOpen("bell.wav")
fall = _SndOpen("fall.wav")
bonus = _SndOpen("digit.wav")
f = _LoadFont("arial.ttf", 24)
_Font f
br = 25 ' ball radius
restart:
bx = ScR: by = br: bs = 10 ' ball loacation and speed
' shoot ball out towards one of the flippers randomly
If Rnd < .5 Then ba = _Pi((8 + 2 * Rnd) / 12) Else ba = _Pi((4 - 2 * Rnd) / 12)
bdx = bs * Cos(ba): bdy = bs * Sin(ba) '
Color , &HFF220044
Do
If bs > 30 Then bs = 30
Cls
FC3 ScR, ScR, ScR + 3, &HFFBB0000
FC3 ScR, ScR, ScR, &HFF888888
If _KeyDown(100306) Then leftFlip.TargetUpTF = -1 ' left side ctrl
If _KeyDown(100305) Then rightFlip.TargetUpTF = -1 ' right side ctrl
drawBall bx, by, br, _RGB32(250)
DrawFlipper leftFlip
DrawFlipper rightFlip
For i = 0 To 2
DrawKicker i
Next
For i = 0 To 7
DrawBonus i
Next
s$ = _Trim$(Str$(score))
Color &HFFFFFFFF, &HFFFF0000
_PrintString ((XMax - _PrintWidth(s$)) / 2, ScR + 150), s$
Color &HFFFFFFFF, &HFF220044
'update ball
bdy = bdy + Gravity
ba = _Atan2(bdy, bdx)
bx = bx + bdx
by = by + bdy
If bs < Gravity Then bs = Gravity ' limit lowest speed
If by > YMax - 1.25 * br Then drawBall bx, by, br, _RGB32(250): _Display: Exit Do ' drain
'keep ball inside board radius
If _Hypot(by - ScR, bx - ScR) + br > ScR Then ' move back ball
ba = _Atan2(by - ScR, bx - ScR) ' angle ball to center
bx = ScR + (ScR - br) * Cos(ba): by = ScR + (ScR - br) * Sin(ba)
ba = ba - _Pi
bs = bs - 5 * Gravity
If bs < Gravity Then bs = Gravity
bdx = bs * Cos(ba): bdy = bs * Sin(ba)
bx = bx + bdx: by = by + bdy
End If
'update flippers
lffirstI = -1: rffirsti = -1: lflastI = -1: rflasti = -1
For i = 0 To FLen
If _Hypot(by - LFC(i).y, bx - LFC(i).x) < br + LFC(i).r Then ' collision
If lffirstI < 0 Then lffirstI = i Else lflastI = i
End If
If _Hypot(by - RFC(i).y, bx - RFC(i).x) < br + RFC(i).r Then ' collision
If rffirsti < 0 Then rffirsti = i Else rflasti = i
End If
Next
If lffirstI >= 0 Then ' handle left flipper collisions
If lflastI > 0 Then
i = (lffirstI + lflastI) / 2
Else
i = lffirstI
End If
If leftFlip.TargetUpTF And leftFlip.CurA <> leftFlip.UpA Then
bs = bs + i / 25
Else
bs = bs - 3 * Gravity
If bs < Gravity Then bs = Gravity
End If
ba = _Atan2(by - LFC(i).y, bx - LFC(i).x)
bx = LFC(i).x + (br + LFC(i).r) * Cos(ba): by = LFC(i).y + (br + LFC(i).r) * Sin(ba) ' move ball back above flipper
bdx = bs * Cos(ba): bdy = bs * Sin(ba)
bx = bx + bdx: by = by + bdy
ElseIf rffirsti >= 0 Then ' handle right flipper collisions
If rflasti > 0 Then
i = (rffirsti + rflasti) / 2
Else
i = rffirsti
End If
If rightFlip.TargetUpTF And rightFlip.CurA <> rightFlip.UpA Then
bs = bs + i / 25
Else
bs = bs - 3 * Gravity
If bs < Gravity Then bs = Gravity
End If
ba = _Atan2(by - RFC(i).y, bx - RFC(i).x)
bx = RFC(i).x + (br + RFC(i).r) * Cos(ba): by = RFC(i).y + (br + RFC(i).r) * Sin(ba) ' move ball back above flipper
bdx = bs * Cos(ba): bdy = bs * Sin(ba)
bx = bx + bdx: by = by + bdy
End If
' collision Kickers
For i = 0 To 2
If _Hypot(by - k(i).y, bx - k(i).x) <= k(i).r + br Then ' left kick
FC3 k(i).x, k(i).y, k(i).r + 15, &HFFFFFFFF
_SndPlay bell
score = score + 100
ba = _Atan2(by - k(i).y, bx - k(i).x) + Rnd - .5 ' avoid infinite loops
bx = k(i).x + (br + k(i).r) * Cos(ba)
by = k(i).y + (br + k(i).r) * Sin(ba)
bs = bs * 1.3
bdx = bs * Cos(ba): bdy = bs * Sin(ba)
End If
Next
' ball over Bonus round
For i = 0 To 7
If _Hypot(by - plus(i).y, bx - plus(i).x) <= plus(i).r Then ' bonus
FC3 plus(i).x, plus(i).y, plus(i).r, &HFFFFFFFF
_SndPlay bonus
score = score + 50
End If
Next
_Display
_Limit 30
Loop Until _KeyDown(27)
If _KeyDown(27) = 0 Then
_SndPlay fall
balls = balls + 1
Color &HFFFFFFFF, &HFFFF0000
If balls >= 5 Then
s$ = "5 balls played, Game Over!"
_PrintString ((XMax - _PrintWidth(s$)) / 2, ScR + 127), s$
_Display
k$ = "" ' for some reason sleep is not working right after first time it doesn't
While k$ = ""
k$ = InKey$
_Limit 30
Wend
End
Else
s$ = "Press any for ball:" + Str$(balls + 1)
_PrintString ((XMax - _PrintWidth(s$)) / 2, ScR + 127), s$
Color &HFFFFFFFF, &HFF220044
_Display
k$ = "" ' for some reason sleep is not working right after first time it doesn't
While k$ = ""
k$ = InKey$
_Limit 30
Wend
GoTo restart
End If
End If
Function FlipAngle (f As FlipperType)
Dim da
da = _Pi(1 / 48)
If f.LeftFlipTF Then ' left flipper
If f.TargetUpTF Then ' move CCW subtract
If f.CurA - da < f.UpA Then
f.CurA = f.UpA
f.TargetUpTF = 0 'target hit
Else
f.CurA = f.CurA - da
End If
Else ' move CW
If f.CurA + da > f.DownA Then f.CurA = f.DownA Else f.CurA = f.CurA + da
End If
Else ' right flip
If f.TargetUpTF Then ' move CW
If f.CurA + da > f.UpA Then
f.CurA = f.UpA
f.TargetUpTF = 0
Else
f.CurA = f.CurA + da
End If
Else ' move CCW
If f.CurA - da < f.DownA Then f.CurA = f.DownA Else f.CurA = f.CurA - da
End If
End If
FlipAngle = f.CurA
End Function
Sub SetFlipperRadii
Dim i, f
f = (BaseR - TipR) / FLen
For i = 0 To FLen
LFC(i).r = BaseR - i * f
RFC(i).r = LFC(i).r
Next
End Sub
Sub DrawFlipper (f As FlipperType)
' setup to drawLink
Dim ang, i
ang = FlipAngle(f)
For i = 0 To FLen
If f.LeftFlipTF Then
LFC(i).x = f.baseX + i * Cos(ang)
LFC(i).y = f.baseY + i * Sin(ang)
FC3 LFC(i).x, LFC(i).y, LFC(i).r, &HFFFF4400
Else
RFC(i).x = f.baseX + i * Cos(ang)
RFC(i).y = f.baseY + i * Sin(ang)
FC3 RFC(i).x, RFC(i).y, RFC(i).r, &HFFFF4400
End If
Next
For i = 0 To FLen
If f.LeftFlipTF Then
LFC(i).x = f.baseX + i * Cos(ang)
LFC(i).y = f.baseY + i * Sin(ang)
FC3 LFC(i).x, LFC(i).y, LFC(i).r - 5, &HFFFFFFFF
Else
RFC(i).x = f.baseX + i * Cos(ang)
RFC(i).y = f.baseY + i * Sin(ang)
FC3 RFC(i).x, RFC(i).y, RFC(i).r - 5, &HFFFFFFFF
End If
Next
End Sub
Sub DrawKicker (kNum)
FC3 k(kNum).x, k(kNum).y, k(kNum).r + 20, &HFFFF0000
FC3 k(kNum).x, k(kNum).y, k(kNum).r + 18, &HFFFFFFFF
star k(kNum).x, k(kNum).y, k(kNum).r, k(kNum).r + 15, 24, 0, &HFFFF0000
End Sub
Sub DrawBonus (Num)
FC3 plus(Num).x, plus(Num).y, plus(Num).r, &HFFFF0000
FC3 plus(Num).x, plus(Num).y, plus(Num).r - 2, &HFFFFFFFF
star plus(Num).x, plus(Num).y, 5, plus(Num).r - 5, 7, 0, &HFFFF0000
End Sub
Sub FC3 (cx As Long, cy As Long, r As Long, clr~&) ' no suffix punctuation use the Global Default Type as Long or Single or Double
Dim As Long r2, x, y ' for Option _Explicit
If r < 1 Then Exit Sub
Line (cx - r, cy)-(cx + r, cy), clr~&, BF
r2 = r * r
Do
y = y + 1
x = Sqr(r2 - y * y)
Line (cx - x, cy + y)-(cx + x, cy + y), clr~&, BF
Line (cx - x, cy - y)-(cx + x, cy - y), clr~&, BF
Loop Until y = r
End Sub
Sub drawBall (x, y, r, c As _Unsigned Long)
Dim rred As Long, grn As Long, blu As Long, rr As Long, f
rred = _Red32(c): grn = _Green32(c): blu = _Blue32(c)
For rr = r To 0 Step -1
f = 1 - Sin(rr / r) ' thank OldMoses for Sin ;-))
FC3 x, y, rr, _RGB32(rred * f, grn * f, blu * f)
Next
End Sub
Sub star (x, y, rInner, rOuter, nPoints, angleOffset, K As _Unsigned Long)
' x, y are same as for circle,
' rInner is center circle radius
' rOuter is the outer most point of star
' nPoints is the number of points,
' angleOffset = angle offset IN DEGREES, it will be converted to radians in sub
' this is to allow us to spin the polygon of n sides
Dim pAngle, radAngleOffset, x1, y1, x2, y2, x3, y3, i As Long
pAngle = _D2R(360 / nPoints): radAngleOffset = _D2R(angleOffset)
x1 = x + rInner * Cos(radAngleOffset)
y1 = y + rInner * Sin(radAngleOffset)
For i = 0 To nPoints - 1
x2 = x + rOuter * Cos(i * pAngle + radAngleOffset + .5 * pAngle)
y2 = y + rOuter * Sin(i * pAngle + radAngleOffset + .5 * pAngle)
x3 = x + rInner * Cos((i + 1) * pAngle + radAngleOffset)
y3 = y + rInner * Sin((i + 1) * pAngle + radAngleOffset)
ftri x1, y1, x2, y2, x3, y3, K
'triangles leaked
Line (x1, y1)-(x2, y2), K
Line (x2, y2)-(x3, y3), K
Line (x3, y3)-(x1, y1), K
x1 = x3: y1 = y3
Next
Paint (x, y), K, K
End Sub
Sub ftri (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
Dim D As Long
Static a&
D = _Dest
If a& = 0 Then a& = _NewImage(1, 1, 32)
_Dest a&
_DontBlend a& ' '<<<< new 2019-12-16 fix
PSet (0, 0), K
_Blend a& '<<<< new 2019-12-16 fix
_Dest D
_MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
End SubUse attached zip in first post for *.wav files.
RE: Pinball Molly - Pete - 11-27-2024
The screen height is such that my task tray (bottom of my desktop) partially occludes the bottom of the game. Still playable.
The bumper action is some of the best emulation I've seen. Very realistic. +2
Pete
RE: Pinball Molly - bplus - 11-27-2024
Wow! Thanks Pete! (that's Pete factorial BTW
)I just tried a _FullScreen mod THAT ignores that pesky Taskbar. (NOT Full Screen, just fits on my screen which I thought was small!)
Now you can look at Molly 2 ways:
1. She's gained so much weight that her face is oval OR
2. She's now tilted back and you are looking at a circlular face at a slant like Pinball would show.
Ohhh just got an idea to add to that 3D slant thing
RE: Pinball Molly - bplus - 11-27-2024
Towards 3D Molly v1-2
Code: (Select All)
Option _Explicit
_Title "Pinball Molly v1-2: left ctrl for left flipper, right ctrl for right" 'b+ 2024-11-16
' Thanks to Rod Bird at JB Forum for inspiring this Pinball Game with his from which
' I used sound effects.
' 2024-11-23 moved Weird Filpper code into here and dumped previous code I had.
' 2024-11-24 dont let bs go below zero better yet below gravity.
' Moved baseX of flippers closer to walls so ball isn't stuck in the corner.
' Increased power down line of flipper contact from i/200 to i/50 because
' gravity was increased to roll ball down flipper faster from dead stop.
' More deadening of bs when hitting walls or flippers not moving.
' 2024-11-25 now add a Circle Board BackGround numbers tweaked a bit
' 2024-11-26 add kickers now, tweak add bonus rounds I name it Molly v1.0
' 2024-11-27 mouth score v1.1
' 2024-11-27 v1-2 FullScreen add some 3d effects
Const XMax = 740, YMax = 740
Const ScR = 370, Gravity = .5
Type FlipperType
As Single baseX, baseY ' DrawFlipper needs these
As Single tipX, tipY ' need to track collisions on ends of flipper
As Single UpA, DownA, CurA
As Long LeftFlipTF, TargetUpTF ' true false boolean
End Type
Type CircleType
As Single x, y, r
End Type
Dim As FlipperType leftFlip, rightFlip
' some parts of Type are constant declare now
leftFlip.LeftFlipTF = -1
leftFlip.baseX = ScR - 300
leftFlip.baseY = YMax - 140
leftFlip.UpA = -_Pi(1 / 6) ' 315 degrees NE
leftFlip.DownA = _Pi(1 / 6)
leftFlip.TargetUpTF = 0 ' test a key press OK
leftFlip.CurA = leftFlip.DownA ' flipper at rest in down position
rightFlip.LeftFlipTF = 0
rightFlip.baseX = ScR + 300
rightFlip.baseY = YMax - 140
rightFlip.UpA = _Pi(7 / 6) ' 180 + 45 = 225 degrees NE
rightFlip.DownA = _Pi(5 / 6)
rightFlip.TargetUpTF = 0 ' flipper at rest in down position
rightFlip.CurA = rightFlip.DownA
Dim Shared FLen, BaseR, TipR ' finish flipper setup
FLen = 250: BaseR = 30: TipR = 12
Dim Shared LFC(FLen) As CircleType, RFC(FLen) As CircleType
SetFlipperRadii
Dim Shared br ' for making image
Dim ball, bx, by, bs, ba, bdx, bdy ' ball stuff
Dim lffirstI, lflastI, rffirsti, rflasti ' ball collision flipper stuff
Dim As Long i, score, bell, fall, balls, bonus, f
Dim k$, s$
Dim Shared As CircleType k(2)
k(0).x = ScR: k(0).y = .5 * YMax + 25: k(0).r = 30
k(1).x = .33 * XMax: k(1).y = .25 * YMax + 25: k(1).r = 30
k(2).x = .67 * XMax: k(2).y = .25 * YMax + 25: k(2).r = 30
Dim Shared As CircleType plus(7)
For i = 0 To 7
plus(i).x = ScR + (ScR - 50) * Cos(i * _Pi(1 / 6) + _Pi(11 / 12))
plus(i).y = ScR + (ScR - 50) * Sin(i * _Pi(1 / 6) + _Pi(11 / 12))
plus(i).r = 20
Next
Screen _NewImage(XMax, YMax, 32) ': _ScreenMove 320, 0
_FullScreen
bell = _SndOpen("bell.wav")
fall = _SndOpen("fall.wav")
bonus = _SndOpen("digit.wav")
f = _LoadFont("arial.ttf", 24)
_Font f
br = 25 ' ball radius
ball = makeSkinnyBall& ' after br !!!
restart:
bx = ScR: by = br: bs = 10 ' ball loacation and speed
' shoot ball out towards one of the flippers randomly
If Rnd < .5 Then ba = _Pi((8 + 2 * Rnd) / 12) Else ba = _Pi((4 - 2 * Rnd) / 12)
bdx = bs * Cos(ba): bdy = bs * Sin(ba) '
Color , &HFF220044
Do
If bs > 30 Then bs = 30
Cls
FC3 ScR, ScR, ScR + 3, &HFFBB8800 'back circle
FC3 ScR, ScR, ScR, &HFF888888
If _KeyDown(100306) Then leftFlip.TargetUpTF = -1 ' left side ctrl
If _KeyDown(100305) Then rightFlip.TargetUpTF = -1 ' right side ctrl
For i = 0 To 7 ' draw under the ball stuff
DrawBonus i
Next
For i = 0 To 2
DrawKickerBottom i
Next
' here's the ball image
_PutImage (bx - br * 1.7786 - 1, by - br * 1.7786 - 1), ball, 0
DrawFlipper leftFlip
DrawFlipper rightFlip
For i = 0 To 2 ' Kicker tops over the ball
DrawKicker i
Next
s$ = _Trim$(Str$(score))
Color &HFFFFFFFF, &HFFFF0000
_PrintString ((XMax - _PrintWidth(s$)) / 2, ScR + 150), s$
Color &HFFFFFFFF, &HFF220044
'update ball
bdy = bdy + Gravity
ba = _Atan2(bdy, bdx)
bx = bx + bdx
by = by + bdy
If bs < Gravity Then bs = Gravity ' limit lowest speed
If by > YMax - 1.25 * br Then Exit Do ' drain
'keep ball inside board radius
If _Hypot(by - ScR, bx - ScR) + br > ScR Then ' move back ball
ba = _Atan2(by - ScR, bx - ScR) ' angle ball to center
bx = ScR + (ScR - br) * Cos(ba): by = ScR + (ScR - br) * Sin(ba)
ba = ba - _Pi
bs = bs - 5 * Gravity
If bs < Gravity Then bs = Gravity
bdx = bs * Cos(ba): bdy = bs * Sin(ba)
bx = bx + bdx: by = by + bdy
End If
'update flippers
lffirstI = -1: rffirsti = -1: lflastI = -1: rflasti = -1
For i = 0 To FLen
If _Hypot(by - LFC(i).y, bx - LFC(i).x) < br + LFC(i).r Then ' collision
If lffirstI < 0 Then lffirstI = i Else lflastI = i
End If
If _Hypot(by - RFC(i).y, bx - RFC(i).x) < br + RFC(i).r Then ' collision
If rffirsti < 0 Then rffirsti = i Else rflasti = i
End If
Next
If lffirstI >= 0 Then ' handle left flipper collisions
If lflastI > 0 Then
i = (lffirstI + lflastI) / 2
Else
i = lffirstI
End If
If leftFlip.TargetUpTF And leftFlip.CurA <> leftFlip.UpA Then
bs = bs + i / 25
Else
bs = bs - 3 * Gravity
If bs < Gravity Then bs = Gravity
End If
ba = _Atan2(by - LFC(i).y, bx - LFC(i).x)
bx = LFC(i).x + (br + LFC(i).r) * Cos(ba): by = LFC(i).y + (br + LFC(i).r) * Sin(ba) ' move ball back above flipper
bdx = bs * Cos(ba): bdy = bs * Sin(ba)
bx = bx + bdx: by = by + bdy
ElseIf rffirsti >= 0 Then ' handle right flipper collisions
If rflasti > 0 Then
i = (rffirsti + rflasti) / 2
Else
i = rffirsti
End If
If rightFlip.TargetUpTF And rightFlip.CurA <> rightFlip.UpA Then
bs = bs + i / 25
Else
bs = bs - 3 * Gravity
If bs < Gravity Then bs = Gravity
End If
ba = _Atan2(by - RFC(i).y, bx - RFC(i).x)
bx = RFC(i).x + (br + RFC(i).r) * Cos(ba): by = RFC(i).y + (br + RFC(i).r) * Sin(ba) ' move ball back above flipper
bdx = bs * Cos(ba): bdy = bs * Sin(ba)
bx = bx + bdx: by = by + bdy
End If
' collision Kickers
For i = 0 To 2
If _Hypot(by - k(i).y, bx - k(i).x) <= k(i).r + br Then ' left kick
FC3 k(i).x, k(i).y, k(i).r + 15, &HFFFFFFFF
_SndPlay bell
score = score + 100
ba = _Atan2(by - k(i).y, bx - k(i).x) + Rnd - .5 ' avoid infinite loops
bx = k(i).x + (br + k(i).r) * Cos(ba)
by = k(i).y + (br + k(i).r) * Sin(ba)
bs = bs * 1.3
bdx = bs * Cos(ba): bdy = bs * Sin(ba)
End If
Next
' ball over Bonus round
For i = 0 To 7
If _Hypot(by - plus(i).y, bx - plus(i).x) <= plus(i).r Then ' bonus
FC3 plus(i).x, plus(i).y, plus(i).r, &HFFFFFFFF
_SndPlay bonus
score = score + 50
End If
Next
_Display
_Limit 30
Loop Until _KeyDown(27)
If _KeyDown(27) = 0 Then
_SndPlay fall
balls = balls + 1
Color &HFFFFFFFF, &HFFFF0000
If balls >= 5 Then
s$ = "5 balls played, Game Over!"
_PrintString ((XMax - _PrintWidth(s$)) / 2, ScR + 127), s$
_Display
k$ = "" ' for some reason sleep is not working right after first time it doesn't
While k$ = ""
k$ = InKey$
_Limit 30
Wend
End
Else
s$ = "Press any for ball:" + Str$(balls + 1)
_PrintString ((XMax - _PrintWidth(s$)) / 2, ScR + 127), s$
Color &HFFFFFFFF, &HFF220044
_Display
k$ = "" ' for some reason sleep is not working right after first time it doesn't
While k$ = ""
k$ = InKey$
_Limit 30
Wend
GoTo restart
End If
End If
Function FlipAngle (f As FlipperType)
Dim da
da = _Pi(1 / 48)
If f.LeftFlipTF Then ' left flipper
If f.TargetUpTF Then ' move CCW subtract
If f.CurA - da < f.UpA Then
f.CurA = f.UpA
f.TargetUpTF = 0 'target hit
Else
f.CurA = f.CurA - da
End If
Else ' move CW
If f.CurA + da > f.DownA Then f.CurA = f.DownA Else f.CurA = f.CurA + da
End If
Else ' right flip
If f.TargetUpTF Then ' move CW
If f.CurA + da > f.UpA Then
f.CurA = f.UpA
f.TargetUpTF = 0
Else
f.CurA = f.CurA + da
End If
Else ' move CCW
If f.CurA - da < f.DownA Then f.CurA = f.DownA Else f.CurA = f.CurA - da
End If
End If
FlipAngle = f.CurA
End Function
Sub SetFlipperRadii
Dim i, f
f = (BaseR - TipR) / FLen
For i = 0 To FLen
LFC(i).r = BaseR - i * f
RFC(i).r = LFC(i).r
Next
End Sub
Sub DrawFlipper (f As FlipperType)
' setup to drawLink
Dim ang, i
ang = FlipAngle(f)
For i = 0 To FLen
If f.LeftFlipTF Then
LFC(i).x = f.baseX + i * Cos(ang)
LFC(i).y = f.baseY + i * Sin(ang)
FC3 LFC(i).x, LFC(i).y + 10, LFC(i).r, &HFFFF4400
Else
RFC(i).x = f.baseX + i * Cos(ang)
RFC(i).y = f.baseY + i * Sin(ang)
FC3 RFC(i).x, RFC(i).y + 10, RFC(i).r, &HFFFF4400
End If
Next
For i = 0 To FLen
If f.LeftFlipTF Then
'LFC(i).x = f.baseX + i * Cos(ang)
'LFC(i).y = f.baseY + i * Sin(ang)
FC3 LFC(i).x, LFC(i).y, LFC(i).r, &HFFFFFFFF
Else
'RFC(i).x = f.baseX + i * Cos(ang)
'RFC(i).y = f.baseY + i * Sin(ang)
FC3 RFC(i).x, RFC(i).y, RFC(i).r, &HFFFFFFFF
End If
Next
End Sub
Sub DrawKickerBottom (kNum)
FC3 k(kNum).x, k(kNum).y + 40, k(kNum).r + 20, &HFF990000
FC3 k(kNum).x, k(kNum).y + 40, k(kNum).r + 18, &HFF555555
End Sub
Sub DrawKicker (kNum)
FC3 k(kNum).x, k(kNum).y, k(kNum).r + 20, &HFFFF0000
FC3 k(kNum).x, k(kNum).y, k(kNum).r + 18, &HFFFFFFFF
star k(kNum).x, k(kNum).y, k(kNum).r, k(kNum).r + 15, 24, 0, &HFFFF0000
End Sub
Sub DrawBonus (Num)
FC3 plus(Num).x, plus(Num).y, plus(Num).r, &HFFFF0000
FC3 plus(Num).x, plus(Num).y, plus(Num).r - 2, &HFFFFFFFF
star plus(Num).x, plus(Num).y, 5, plus(Num).r - 5, 7, 0, &HFFFF0000
End Sub
Sub FC3 (cx As Long, cy As Long, r As Long, clr~&) ' no suffix punctuation use the Global Default Type as Long or Single or Double
Dim As Long r2, x, y ' for Option _Explicit
If r < 1 Then Exit Sub
Line (cx - r, cy)-(cx + r, cy), clr~&, BF
r2 = r * r
Do
y = y + 1
x = Sqr(r2 - y * y)
Line (cx - x, cy + y)-(cx + x, cy + y), clr~&, BF
Line (cx - x, cy - y)-(cx + x, cy - y), clr~&, BF
Loop Until y = r
End Sub
Sub star (x, y, rInner, rOuter, nPoints, angleOffset, K As _Unsigned Long)
' x, y are same as for circle,
' rInner is center circle radius
' rOuter is the outer most point of star
' nPoints is the number of points,
' angleOffset = angle offset IN DEGREES, it will be converted to radians in sub
' this is to allow us to spin the polygon of n sides
Dim pAngle, radAngleOffset, x1, y1, x2, y2, x3, y3, i As Long
pAngle = _D2R(360 / nPoints): radAngleOffset = _D2R(angleOffset)
x1 = x + rInner * Cos(radAngleOffset)
y1 = y + rInner * Sin(radAngleOffset)
For i = 0 To nPoints - 1
x2 = x + rOuter * Cos(i * pAngle + radAngleOffset + .5 * pAngle)
y2 = y + rOuter * Sin(i * pAngle + radAngleOffset + .5 * pAngle)
x3 = x + rInner * Cos((i + 1) * pAngle + radAngleOffset)
y3 = y + rInner * Sin((i + 1) * pAngle + radAngleOffset)
ftri x1, y1, x2, y2, x3, y3, K
'triangles leaked
Line (x1, y1)-(x2, y2), K
Line (x2, y2)-(x3, y3), K
Line (x3, y3)-(x1, y1), K
x1 = x3: y1 = y3
Next
Paint (x, y), K, K
End Sub
Sub ftri (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
Dim D As Long
Static a&
D = _Dest
If a& = 0 Then a& = _NewImage(1, 1, 32)
_Dest a&
_DontBlend a& ' '<<<< new 2019-12-16 fix
PSet (0, 0), K
_Blend a& '<<<< new 2019-12-16 fix
_Dest D
_MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
End Sub
'Sub drawBall (x, y, r, c As _Unsigned Long)
' Dim rred As Long, grn As Long, blu As Long, rr As Long, f
' rred = _Red32(c): grn = _Green32(c): blu = _Blue32(c)
' For rr = r To 0 Step -1
' f = 1 - Sin(rr / r) ' thank OldMoses for Sin ;-))
' FC3 x, y, rr, _RGB32(rred * f, grn * f, blu * f)
' Next
'End Sub
Function makeSkinnyBall& ' for this game
Dim As Long im, g, rr
Dim f
g = 200
im = _NewImage(2 * br * 1.7786 + 2, 2 * br * 1.7786 + 2, 32)
_Dest im
For rr = br To 0 Step -1
f = 1 - Sin(rr / (br + 5)) ' thank OldMoses for Sin ;-))
FEllipse br * 1.7786 + 1, br * 1.7786 + 1, rr, rr * 1.7786, _RGB32(g * f)
Next
_Dest 0
makeSkinnyBall& = im
End Function
Sub FEllipse (CX As Long, CY As Long, xr As Long, yr As Long, C As _Unsigned Long)
If xr = 0 Or yr = 0 Then Exit Sub
Dim h2 As _Integer64, w2 As _Integer64, h2w2 As _Integer64
Dim x As Long, y As Long
w2 = xr * xr: h2 = yr * yr: h2w2 = h2 * w2
Line (CX - xr, CY)-(CX + xr, CY), C, BF
Do While y < yr
y = y + 1
x = Sqr((h2w2 - y * y * w2) \ h2)
Line (CX - x, CY + y)-(CX + x, CY + y), C, BF
Line (CX - x, CY - y)-(CX + x, CY - y), C, BF
Loop
End SubWell the round ball will probabably only work on my screen but here's what it looks like for me:
EDIT: 3D Flippers a little bit too!
OK I think I can make it look like this on anyones screen, stay tuned... (The roundness of ball is what I fear will be off.)
RE: Pinball Molly - SierraKen - 11-27-2024
LOL Great game B+! I got 27,250 on a full game. Now I want to make one, if I can.
RE: Pinball Molly - bplus - 11-27-2024
Heh, heh
OK this should make the ball round on anyone's screen. I am using the _deskTopWidth/_deskTopHeight ratio as ScrF, SO when the ball is drawn with FilledEllipsii it will appear round _FullScreen Mode:
Code: (Select All)
Option _Explicit
_Title "Pinball Molly v1-2: left ctrl for left flipper, right ctrl for right" 'b+ 2024-11-16
' Thanks to Rod Bird at JB Forum for inspiring this Pinball Game with his from which
' I used sound effects.
' 2024-11-23 moved Weird Filpper code into here and dumped previous code I had.
' 2024-11-24 dont let bs go below zero better yet below gravity.
' Moved baseX of flippers closer to walls so ball isn't stuck in the corner.
' Increased power down line of flipper contact from i/200 to i/50 because
' gravity was increased to roll ball down flipper faster from dead stop.
' More deadening of bs when hitting walls or flippers not moving.
' 2024-11-25 now add a Circle Board BackGround numbers tweaked a bit
' 2024-11-26 add kickers now, tweak add bonus rounds I name it Molly v1.0
' 2024-11-27 mouth score v1.1
' 2024-11-27 v1-2 FullScreen add some 3d effects
' 2024-11-27 v1-2 make ball look round in any screen
Const XMax = 740, YMax = 740
Const ScR = 370, Gravity = .5
Type FlipperType
As Single baseX, baseY ' DrawFlipper needs these
As Single tipX, tipY ' need to track collisions on ends of flipper
As Single UpA, DownA, CurA
As Long LeftFlipTF, TargetUpTF ' true false boolean
End Type
Type CircleType
As Single x, y, r
End Type
Dim As FlipperType leftFlip, rightFlip
' some parts of Type are constant declare now
leftFlip.LeftFlipTF = -1
leftFlip.baseX = ScR - 300
leftFlip.baseY = YMax - 140
leftFlip.UpA = -_Pi(1 / 6) ' 315 degrees NE
leftFlip.DownA = _Pi(1 / 6)
leftFlip.TargetUpTF = 0 ' test a key press OK
leftFlip.CurA = leftFlip.DownA ' flipper at rest in down position
rightFlip.LeftFlipTF = 0
rightFlip.baseX = ScR + 300
rightFlip.baseY = YMax - 140
rightFlip.UpA = _Pi(7 / 6) ' 180 + 45 = 225 degrees NE
rightFlip.DownA = _Pi(5 / 6)
rightFlip.TargetUpTF = 0 ' flipper at rest in down position
rightFlip.CurA = rightFlip.DownA
Dim Shared FLen, BaseR, TipR ' finish flipper setup
FLen = 250: BaseR = 30: TipR = 12
Dim Shared LFC(FLen) As CircleType, RFC(FLen) As CircleType
SetFlipperRadii
Dim Shared br, ScrF ' for making image
ScrF = _DesktopWidth / _DesktopHeight
Dim ball, bx, by, bs, ba, bdx, bdy ' ball stuff
Dim lffirstI, lflastI, rffirsti, rflasti ' ball collision flipper stuff
Dim As Long i, score, bell, fall, balls, bonus, f
Dim k$, s$
Dim Shared As CircleType k(2)
k(0).x = ScR: k(0).y = .5 * YMax + 25: k(0).r = 30
k(1).x = .33 * XMax: k(1).y = .25 * YMax + 25: k(1).r = 30
k(2).x = .67 * XMax: k(2).y = .25 * YMax + 25: k(2).r = 30
Dim Shared As CircleType plus(7)
For i = 0 To 7
plus(i).x = ScR + (ScR - 50) * Cos(i * _Pi(1 / 6) + _Pi(11 / 12))
plus(i).y = ScR + (ScR - 50) * Sin(i * _Pi(1 / 6) + _Pi(11 / 12))
plus(i).r = 20
Next
Screen _NewImage(XMax, YMax, 32) ': _ScreenMove 320, 0
_FullScreen
bell = _SndOpen("bell.wav")
fall = _SndOpen("fall.wav")
bonus = _SndOpen("digit.wav")
f = _LoadFont("arial.ttf", 24)
_Font f
br = 25 ' ball radius
ball = makeSkinnyBall& ' after br !!!
restart:
bx = ScR: by = br: bs = 10 ' ball loacation and speed
' shoot ball out towards one of the flippers randomly
If Rnd < .5 Then ba = _Pi((8 + 2 * Rnd) / 12) Else ba = _Pi((4 - 2 * Rnd) / 12)
bdx = bs * Cos(ba): bdy = bs * Sin(ba) '
Color , &HFF220044
Do
If bs > 30 Then bs = 30
Cls
FC3 ScR, ScR, ScR + 3, &HFFBB8800 'back circle
FC3 ScR, ScR, ScR, &HFF888888
If _KeyDown(100306) Then leftFlip.TargetUpTF = -1 ' left side ctrl
If _KeyDown(100305) Then rightFlip.TargetUpTF = -1 ' right side ctrl
For i = 0 To 7 ' draw under the ball stuff
DrawBonus i
Next
For i = 0 To 2
DrawKickerBottom i
Next
' here's the ball image
_PutImage (bx - br * ScrF - 1, by - br * ScrF - 1), ball, 0
DrawFlipper leftFlip
DrawFlipper rightFlip
For i = 0 To 2 ' Kicker tops over the ball
DrawKicker i
Next
s$ = _Trim$(Str$(score))
Color &HFFFFFFFF, &HFFFF0000
_PrintString ((XMax - _PrintWidth(s$)) / 2, ScR + 150), s$
Color &HFFFFFFFF, &HFF220044
'update ball
bdy = bdy + Gravity
ba = _Atan2(bdy, bdx)
bx = bx + bdx
by = by + bdy
If bs < Gravity Then bs = Gravity ' limit lowest speed
If by > YMax - 1.25 * br Then Exit Do ' drain
'keep ball inside board radius
If _Hypot(by - ScR, bx - ScR) + br > ScR Then ' move back ball
ba = _Atan2(by - ScR, bx - ScR) ' angle ball to center
bx = ScR + (ScR - br) * Cos(ba): by = ScR + (ScR - br) * Sin(ba)
ba = ba - _Pi
bs = bs - 5 * Gravity
If bs < Gravity Then bs = Gravity
bdx = bs * Cos(ba): bdy = bs * Sin(ba)
bx = bx + bdx: by = by + bdy
End If
'update flippers
lffirstI = -1: rffirsti = -1: lflastI = -1: rflasti = -1
For i = 0 To FLen
If _Hypot(by - LFC(i).y, bx - LFC(i).x) < br + LFC(i).r Then ' collision
If lffirstI < 0 Then lffirstI = i Else lflastI = i
End If
If _Hypot(by - RFC(i).y, bx - RFC(i).x) < br + RFC(i).r Then ' collision
If rffirsti < 0 Then rffirsti = i Else rflasti = i
End If
Next
If lffirstI >= 0 Then ' handle left flipper collisions
If lflastI > 0 Then
i = (lffirstI + lflastI) / 2
Else
i = lffirstI
End If
If leftFlip.TargetUpTF And leftFlip.CurA <> leftFlip.UpA Then
bs = bs + i / 25
Else
bs = bs - 3 * Gravity
If bs < Gravity Then bs = Gravity
End If
ba = _Atan2(by - LFC(i).y, bx - LFC(i).x)
bx = LFC(i).x + (br + LFC(i).r) * Cos(ba): by = LFC(i).y + (br + LFC(i).r) * Sin(ba) ' move ball back above flipper
bdx = bs * Cos(ba): bdy = bs * Sin(ba)
bx = bx + bdx: by = by + bdy
ElseIf rffirsti >= 0 Then ' handle right flipper collisions
If rflasti > 0 Then
i = (rffirsti + rflasti) / 2
Else
i = rffirsti
End If
If rightFlip.TargetUpTF And rightFlip.CurA <> rightFlip.UpA Then
bs = bs + i / 25
Else
bs = bs - 3 * Gravity
If bs < Gravity Then bs = Gravity
End If
ba = _Atan2(by - RFC(i).y, bx - RFC(i).x)
bx = RFC(i).x + (br + RFC(i).r) * Cos(ba): by = RFC(i).y + (br + RFC(i).r) * Sin(ba) ' move ball back above flipper
bdx = bs * Cos(ba): bdy = bs * Sin(ba)
bx = bx + bdx: by = by + bdy
End If
' collision Kickers
For i = 0 To 2
If _Hypot(by - k(i).y, bx - k(i).x) <= k(i).r + br Then ' left kick
FC3 k(i).x, k(i).y, k(i).r + 15, &HFFFFFFFF
_SndPlay bell
score = score + 100
ba = _Atan2(by - k(i).y, bx - k(i).x) + Rnd - .5 ' avoid infinite loops
bx = k(i).x + (br + k(i).r) * Cos(ba)
by = k(i).y + (br + k(i).r) * Sin(ba)
bs = bs * 1.3
bdx = bs * Cos(ba): bdy = bs * Sin(ba)
End If
Next
' ball over Bonus round
For i = 0 To 7
If _Hypot(by - plus(i).y, bx - plus(i).x) <= plus(i).r Then ' bonus
FC3 plus(i).x, plus(i).y, plus(i).r, &HFFFFFFFF
_SndPlay bonus
score = score + 50
End If
Next
_Display
_Limit 30
Loop Until _KeyDown(27)
If _KeyDown(27) = 0 Then
_SndPlay fall
balls = balls + 1
Color &HFFFFFFFF, &HFFFF0000
If balls >= 5 Then
s$ = "5 balls played, Game Over!"
_PrintString ((XMax - _PrintWidth(s$)) / 2, ScR + 127), s$
_Display
k$ = "" ' for some reason sleep is not working right after first time it doesn't
While k$ = ""
k$ = InKey$
_Limit 30
Wend
End
Else
s$ = "Press any for ball:" + Str$(balls + 1)
_PrintString ((XMax - _PrintWidth(s$)) / 2, ScR + 127), s$
Color &HFFFFFFFF, &HFF220044
_Display
k$ = "" ' for some reason sleep is not working right after first time it doesn't
While k$ = ""
k$ = InKey$
_Limit 30
Wend
GoTo restart
End If
End If
Function FlipAngle (f As FlipperType)
Dim da
da = _Pi(1 / 48)
If f.LeftFlipTF Then ' left flipper
If f.TargetUpTF Then ' move CCW subtract
If f.CurA - da < f.UpA Then
f.CurA = f.UpA
f.TargetUpTF = 0 'target hit
Else
f.CurA = f.CurA - da
End If
Else ' move CW
If f.CurA + da > f.DownA Then f.CurA = f.DownA Else f.CurA = f.CurA + da
End If
Else ' right flip
If f.TargetUpTF Then ' move CW
If f.CurA + da > f.UpA Then
f.CurA = f.UpA
f.TargetUpTF = 0
Else
f.CurA = f.CurA + da
End If
Else ' move CCW
If f.CurA - da < f.DownA Then f.CurA = f.DownA Else f.CurA = f.CurA - da
End If
End If
FlipAngle = f.CurA
End Function
Sub SetFlipperRadii
Dim i, f
f = (BaseR - TipR) / FLen
For i = 0 To FLen
LFC(i).r = BaseR - i * f
RFC(i).r = LFC(i).r
Next
End Sub
Sub DrawFlipper (f As FlipperType)
' setup to drawLink
Dim ang, i
ang = FlipAngle(f)
For i = 0 To FLen
If f.LeftFlipTF Then
LFC(i).x = f.baseX + i * Cos(ang)
LFC(i).y = f.baseY + i * Sin(ang)
FC3 LFC(i).x, LFC(i).y + 10, LFC(i).r, &HFFFF4400
Else
RFC(i).x = f.baseX + i * Cos(ang)
RFC(i).y = f.baseY + i * Sin(ang)
FC3 RFC(i).x, RFC(i).y + 10, RFC(i).r, &HFFFF4400
End If
Next
For i = 0 To FLen
If f.LeftFlipTF Then
'LFC(i).x = f.baseX + i * Cos(ang)
'LFC(i).y = f.baseY + i * Sin(ang)
FC3 LFC(i).x, LFC(i).y, LFC(i).r, &HFFFFFFFF
Else
'RFC(i).x = f.baseX + i * Cos(ang)
'RFC(i).y = f.baseY + i * Sin(ang)
FC3 RFC(i).x, RFC(i).y, RFC(i).r, &HFFFFFFFF
End If
Next
End Sub
Sub DrawKickerBottom (kNum)
FC3 k(kNum).x, k(kNum).y + 40, k(kNum).r + 20, &HFF990000
FC3 k(kNum).x, k(kNum).y + 40, k(kNum).r + 18, &HFF555555
End Sub
Sub DrawKicker (kNum)
FC3 k(kNum).x, k(kNum).y, k(kNum).r + 20, &HFFFF0000
FC3 k(kNum).x, k(kNum).y, k(kNum).r + 18, &HFFFFFFFF
star k(kNum).x, k(kNum).y, k(kNum).r, k(kNum).r + 15, 24, 0, &HFFFF0000
End Sub
Sub DrawBonus (Num)
FC3 plus(Num).x, plus(Num).y, plus(Num).r, &HFFFF0000
FC3 plus(Num).x, plus(Num).y, plus(Num).r - 2, &HFFFFFFFF
star plus(Num).x, plus(Num).y, 5, plus(Num).r - 5, 7, 0, &HFFFF0000
End Sub
Sub FC3 (cx As Long, cy As Long, r As Long, clr~&) ' no suffix punctuation use the Global Default Type as Long or Single or Double
Dim As Long r2, x, y ' for Option _Explicit
If r < 1 Then Exit Sub
Line (cx - r, cy)-(cx + r, cy), clr~&, BF
r2 = r * r
Do
y = y + 1
x = Sqr(r2 - y * y)
Line (cx - x, cy + y)-(cx + x, cy + y), clr~&, BF
Line (cx - x, cy - y)-(cx + x, cy - y), clr~&, BF
Loop Until y = r
End Sub
Sub star (x, y, rInner, rOuter, nPoints, angleOffset, K As _Unsigned Long)
' x, y are same as for circle,
' rInner is center circle radius
' rOuter is the outer most point of star
' nPoints is the number of points,
' angleOffset = angle offset IN DEGREES, it will be converted to radians in sub
' this is to allow us to spin the polygon of n sides
Dim pAngle, radAngleOffset, x1, y1, x2, y2, x3, y3, i As Long
pAngle = _D2R(360 / nPoints): radAngleOffset = _D2R(angleOffset)
x1 = x + rInner * Cos(radAngleOffset)
y1 = y + rInner * Sin(radAngleOffset)
For i = 0 To nPoints - 1
x2 = x + rOuter * Cos(i * pAngle + radAngleOffset + .5 * pAngle)
y2 = y + rOuter * Sin(i * pAngle + radAngleOffset + .5 * pAngle)
x3 = x + rInner * Cos((i + 1) * pAngle + radAngleOffset)
y3 = y + rInner * Sin((i + 1) * pAngle + radAngleOffset)
ftri x1, y1, x2, y2, x3, y3, K
'triangles leaked
Line (x1, y1)-(x2, y2), K
Line (x2, y2)-(x3, y3), K
Line (x3, y3)-(x1, y1), K
x1 = x3: y1 = y3
Next
Paint (x, y), K, K
End Sub
Sub ftri (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
Dim D As Long
Static a&
D = _Dest
If a& = 0 Then a& = _NewImage(1, 1, 32)
_Dest a&
_DontBlend a& ' '<<<< new 2019-12-16 fix
PSet (0, 0), K
_Blend a& '<<<< new 2019-12-16 fix
_Dest D
_MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
End Sub
'Sub drawBall (x, y, r, c As _Unsigned Long)
' Dim rred As Long, grn As Long, blu As Long, rr As Long, f
' rred = _Red32(c): grn = _Green32(c): blu = _Blue32(c)
' For rr = r To 0 Step -1
' f = 1 - Sin(rr / r) ' thank OldMoses for Sin ;-))
' FC3 x, y, rr, _RGB32(rred * f, grn * f, blu * f)
' Next
'End Sub
Function makeSkinnyBall& ' for this game
Dim As Long im, g, rr
Dim f
g = 200
im = _NewImage(2 * br * ScrF + 2, 2 * br * ScrF + 2, 32)
_Dest im
For rr = br To 0 Step -1
f = 1 - Sin(rr / (br + 5)) ' thank OldMoses for Sin ;-))
FEllipse br * ScrF + 1, br * ScrF + 1, rr, rr * ScrF, _RGB32(g * f)
Next
_Dest 0
makeSkinnyBall& = im
End Function
Sub FEllipse (CX As Long, CY As Long, xr As Long, yr As Long, C As _Unsigned Long)
If xr = 0 Or yr = 0 Then Exit Sub
Dim h2 As _Integer64, w2 As _Integer64, h2w2 As _Integer64
Dim x As Long, y As Long
w2 = xr * xr: h2 = yr * yr: h2w2 = h2 * w2
Line (CX - xr, CY)-(CX + xr, CY), C, BF
Do While y < yr
y = y + 1
x = Sqr((h2w2 - y * y * w2) \ h2)
Line (CX - x, CY + y)-(CX + x, CY + y), C, BF
Line (CX - x, CY - y)-(CX + x, CY - y), C, BF
Loop
End SubIf this doesn't work for someone, do you have something not Windows? Can you give a screen shot?
Again, the .wav files for sound effects are in then zip of First post of this thread.
RE: Pinball Molly - SierraKen - 11-28-2024
Wow even better! I like the 3D effect you made.
RE: Pinball Molly - bplus - 11-29-2024
New opening act for Pinball Molly v1-3!